From e0fc986db8e3e42cc17be761d2a32b1b5c2f1ea6 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 26 Jan 2014 00:06:08 +0900
Subject: [PATCH] Consolidating common SRFI-1 and R7RS bindings into the core.

---
 lib/init-7.scm              |  7 +++++++
 lib/scheme/extras.scm       | 11 -----------
 lib/srfi/1/constructors.scm |  7 -------
 tests/srfi-38-tests.scm     |  7 +------
 4 files changed, 8 insertions(+), 24 deletions(-)

diff --git a/lib/init-7.scm b/lib/init-7.scm
index a57826e5..923d4ed3 100644
--- a/lib/init-7.scm
+++ b/lib/init-7.scm
@@ -23,6 +23,8 @@
 
 (define (list . args) args)
 
+(define (list-copy ls) (reverse! (reverse ls)))
+
 (define (list-tail ls k)
   (if (eq? k 0)
       ls
@@ -444,6 +446,11 @@
 
 ;; list utils
 
+(define (make-list n . o)
+  (let ((default (if (pair? o) (car o))))
+    (let lp ((n n) (res '()))
+      (if (<= n 0) res (lp (- n 1) (cons default res))))))
+
 (define (member obj ls . o)
   (let ((eq (if (pair? o) (car o) equal?)))
     (let lp ((ls ls))
diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm
index 2e168122..c8d0fb00 100644
--- a/lib/scheme/extras.scm
+++ b/lib/scheme/extras.scm
@@ -146,17 +146,6 @@
         ((>= i end))
       (write-u8 (bytevector-u8-ref vec i) out))))
 
-(define (make-list n . o)
-  (let ((init (and (pair? o) (car o))))
-    (let lp ((i 0) (res '()))
-      (if (>= i n) res (lp (+ i 1) (cons init res))))))
-
-(define (list-copy ls)
-  (let lp ((ls ls) (res '()))
-    (if (pair? ls)
-        (lp (cdr ls) (cons (car ls) res))
-        (append (reverse res) ls))))
-
 (define (list-set! ls k x)
   (cond ((null? ls) (error "invalid list index"))
         ((zero? k) (set-car! ls x))
diff --git a/lib/srfi/1/constructors.scm b/lib/srfi/1/constructors.scm
index c536b431..09eae17b 100644
--- a/lib/srfi/1/constructors.scm
+++ b/lib/srfi/1/constructors.scm
@@ -10,17 +10,10 @@
         (append-reverse rev x)
         (lp (cons x rev) (car ls) (cdr ls)))))
 
-(define (make-list n . o)
-  (let ((default (if (pair? o) (car o))))
-    (let lp ((n n) (res '()))
-      (if (<= n 0) res (lp (- n 1) (cons default res))))))
-
 (define (list-tabulate n proc)
   (let lp ((n (- n 1)) (res '()))
     (if (< n 0) res (lp (- n 1) (cons (proc n) res)))))
 
-(define (list-copy ls) (reverse! (reverse ls)))
-
 (define (circular-list x . args)
   (let ((res (cons x args)))
     (set-cdr! (last-pair res) res)
diff --git a/tests/srfi-38-tests.scm b/tests/srfi-38-tests.scm
index 56845194..cf5cee34 100644
--- a/tests/srfi-38-tests.scm
+++ b/tests/srfi-38-tests.scm
@@ -1,6 +1,6 @@
 
 (cond-expand
- (chibi (import (chibi) (chibi test) (srfi 38)))
+ (chibi (import (chibi) (chibi test) (srfi 1) (srfi 38)))
  (chicken (use chicken test srfi-38)))
 
 (test-begin "read/write")
@@ -29,11 +29,6 @@
        (test str (write-to-string value #t))
        (test str (write-to-string (read-from-string str) #t))))))
 
-(define (circular-list . args)
-  (let ((res (map (lambda (x) x) args)))
-    (set-cdr! (list-tail res (- (length res) 1)) res)
-    res))
-
 (test-io "(1)" (list 1))
 (test-io "(1 2)" (list 1 2))
 (test-io "(1 . 2)" (cons 1 2))