~ chicken-core (chicken-5) e96f3ee314dcfa8e4f0d8bfe76f4361888ba0b5b

commit e96f3ee314dcfa8e4f0d8bfe76f4361888ba0b5b
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Jul 29 14:37:14 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Jul 29 14:37:14 2011 +0200

    moved some list-operations into library.scm

diff --git a/csi.scm b/csi.scm
index 42228f6f..0474c874 100644
--- a/csi.scm
+++ b/csi.scm
@@ -43,10 +43,10 @@ EOF
 
 (private csi 
   print-usage print-banner
-  run hexdump del 
+  run hexdump
   parse-option-string chop-separator lookup-script-file
   report describe dump hexdump bytevector-data get-config
-  deldups tty-input?
+  tty-input?
   history-list history-count history-add history-ref history-clear history-show)
 
 (declare
@@ -908,24 +908,6 @@ EOF
 
 ;;; Start interpreting:
 
-(define (del x lst tst)
-  (let loop ([lst lst])
-    (if (null? lst)
-	'()
-	(let ([y (car lst)])
-	  (if (tst x y)
-	      (cdr lst)
-	      (cons y (loop (cdr lst))) ) ) ) ) )
-
-(define (deldups lis . maybe-=)
-  (let ((elt= (optional maybe-= equal?)))
-    (let recur ((lis lis))
-      (if (null? lis) lis
-	  (let* ((x (car lis))
-		 (tail (cdr lis))
-		 (new-tail (recur (del x tail elt=))))
-	    (if (eq? tail new-tail) lis (cons x new-tail)))))))
-
 (define (member* keys set)
   (let loop ((set set))
     (and (pair? set)
@@ -1054,7 +1036,7 @@ EOF
       (for-each register-feature! (collect-options "-D"))
       (for-each unregister-feature! (collect-options "-no-feature"))
       (set! ##sys#include-pathnames 
-	(deldups
+	(##sys#nodups
 	 (append (map chop-separator (collect-options "-include-path"))
 		 (map chop-separator (collect-options "-I"))
 		 ##sys#include-pathnames
diff --git a/expand.scm b/expand.scm
index 8ded474a..b6352340 100644
--- a/expand.scm
+++ b/expand.scm
@@ -904,6 +904,7 @@
   (cut ##sys#expand-import <> <> <> ##sys#current-environment ##sys#macro-environment 
        #f #t 'reexport) ) )
 
+;; contains only "import[-for-syntax]" and "reexport"
 (define ##sys#initial-macro-environment (##sys#macro-environment))
 
 (##sys#extend-macro-environment
@@ -1442,26 +1443,3 @@
   (##sys#fixup-macro-environment (##sys#macro-environment)))
 
 (define ##sys#meta-macro-environment (make-parameter (##sys#macro-environment)))
-
-
-;; Used by the syntax-rules implementation (and possibly handy elsewhere)
-;; (kindly contributed by Peter Bex)
-
-(define (##sys#drop-right input temp)
-  ;;XXX use unsafe accessors
-  (let loop ((len (length input))
-	     (input input))
-    (cond
-     ((> len temp)
-      (cons (car input)
-	    (loop (- len 1) (cdr input))))
-     (else '()))))
-
-(define (##sys#take-right input temp)
-  ;;XXX use unsafe accessors
-  (let loop ((len (length input))
-	     (input input))
-    (cond
-     ((> len temp)
-      (loop (- len 1) (cdr input)))
-     (else input))))
diff --git a/library.scm b/library.scm
index 4b5ff135..0f8f3df2 100644
--- a/library.scm
+++ b/library.scm
@@ -4881,3 +4881,45 @@ EOF
     (if (not (pair? lst))
 	z
 	(f (##sys#slot lst 0) (loop (##sys#slot lst 1))))))
+
+
+;; Some list-operations, used by the syntax-rules implementation, inside module
+;; implementation and in csi
+
+(define (##sys#del x lst tst)
+  (let loop ((lst lst))
+    (if (null? lst)
+	'()
+	(let ((y (car lst)))
+	  (if (tst x y)
+	      (cdr lst)
+	      (cons y (loop (cdr lst))) ) ) ) ) )
+
+(define (##sys#nodups lis elt=)
+  (let recur ((lis lis))
+    (if (null? lis) lis
+	(let* ((x (car lis))
+	       (tail (cdr lis))
+	       (new-tail (recur (##sys#del x tail elt=))))
+	  (if (eq? tail new-tail) lis (cons x new-tail))))))
+
+;; contributed by Peter Bex
+(define (##sys#drop-right input temp)
+  ;;XXX use unsafe accessors
+  (let loop ((len (length input))
+	     (input input))
+    (cond
+     ((> len temp)
+      (cons (car input)
+	    (loop (- len 1) (cdr input))))
+     (else '()))))
+
+(define (##sys#take-right input temp)
+  ;;XXX use unsafe accessors
+  (let loop ((len (length input))
+	     (input input))
+    (cond
+     ((> len temp)
+      (loop (- len 1) (cdr input)))
+     (else input))))
+