* append is moved to ikarus.lists

src/ikarus.core.ss

@@ -173,41 +173,6 @@
 
 
 
-(let ()
-  (define reverse
-    (lambda (h t ls ac)
-      (if (pair? h)
-          (let ([h ($cdr h)] [a1 ($car h)])
-             (if (pair? h)
-                 (if (not (eq? h t))
-                     (let ([a2 ($car h)])
-                       (reverse ($cdr h) ($cdr t) ls (cons a2 (cons a1 ac))))
-                     (error 'append "circular list ~s" ls))
-                 (if (null? h)
-                     (cons a1 ac)
-                     (error 'append "~s is not a proper list" ls))))
-          (if (null? h)
-              ac 
-              (error 'append "~s is not a proper list" ls)))))
-  (define revcons
-    (lambda (ls ac)
-      (cond
-        [(null? ls) ac]
-        [else
-         (revcons ($cdr ls) (cons ($car ls) ac))])))
-  (define append
-    (lambda (ls ls*)
-      (cond
-        [(null? ls*) ls]
-        [else 
-         (revcons (reverse ls ls ls '())
-            (append ($car ls*) ($cdr ls*)))])))
-  (primitive-set! 'append
-    (case-lambda
-      [() '()]
-      [(ls) ls]
-      [(ls . ls*)
-       (append ls ls*)])))
 
 
 

src/ikarus.lists.ss

@@ -1,11 +1,11 @@
 
 (library (ikarus lists)
-  (export $memq list? length list-ref reverse last-pair 
+  (export $memq list? append length list-ref reverse last-pair 
           memq memv member assq assv assoc
           map for-each andmap ormap)
   (import 
     (only (scheme) $car $cdr $fx+ $fxadd1 $fxsub1 $fxzero? $fx>=)
-    (except (ikarus) list? reverse last-pair length list-ref
+    (except (ikarus) list? append reverse last-pair length list-ref
             memq memv member assq assv assoc
             map for-each andmap ormap))
 
@@ -65,6 +65,42 @@
         (error 'list-ref "~s is not a valid index" index))
       (f list index)))
 
+  (module (append)
+    (define reverse
+      (lambda (h t ls ac)
+        (if (pair? h)
+            (let ([h ($cdr h)] [a1 ($car h)])
+               (if (pair? h)
+                   (if (not (eq? h t))
+                       (let ([a2 ($car h)])
+                         (reverse ($cdr h) ($cdr t) ls (cons a2 (cons a1 ac))))
+                       (error 'append "circular list ~s" ls))
+                   (if (null? h)
+                       (cons a1 ac)
+                       (error 'append "~s is not a proper list" ls))))
+            (if (null? h)
+                ac 
+                (error 'append "~s is not a proper list" ls)))))
+    (define revcons
+      (lambda (ls ac)
+        (cond
+          [(null? ls) ac]
+          [else
+           (revcons ($cdr ls) (cons ($car ls) ac))])))
+    (define append1
+      (lambda (ls ls*)
+        (cond
+          [(null? ls*) ls]
+          [else 
+           (revcons (reverse ls ls ls '())
+              (append1 ($car ls*) ($cdr ls*)))])))
+    (define append
+      (case-lambda
+        [() '()]
+        [(ls) ls]
+        [(ls . ls*)
+         (append1 ls ls*)])))
+
   (define reverse
     (letrec ([race
               (lambda (h t ls ac)