~ chicken-core (chicken-5) 5b3f2c5ec26914b10d8d3c9abed73550949cb6d6
commit 5b3f2c5ec26914b10d8d3c9abed73550949cb6d6
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun Apr 30 18:02:09 2017 +0200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Mon Jun 5 16:12:33 2017 +1200
Remove ##sys#nodups and ##sys#del
The ##sys#nodups and corresponding ##sys#del procedures are just
differently named (and specialisable) versions of delete-duplicates
and delete from SRFI-1. So, we load mini-srfi-1.scm into csi.scm, and
get rid of those definition in library.scm.
We also get rid of the optional arguments in the SRFI-1 "delete" and
"delete-duplicates" definitions because that's completely unnecessary
for a fast internal API.
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/batch-driver.scm b/batch-driver.scm
index 85307c4f..45bea523 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -448,7 +448,7 @@
(when (not f) (quit-compiling "cannot load extension: ~a" e))
(load f)))
extends) )
- (set! ##sys#features (delete #:compiler-extension ##sys#features))
+ (set! ##sys#features (delete #:compiler-extension ##sys#features eq?))
(set! ##sys#features (cons '#:compiling ##sys#features))
(set! upap (user-post-analysis-pass))
diff --git a/chicken-status.scm b/chicken-status.scm
index 3b957ae6..32f6b09c 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -77,7 +77,7 @@
(lambda (egg)
(any (cut string=? <> egg) patterns))
eggs)))))
- (delete-duplicates names)))
+ (delete-duplicates names string=?)))
(define (gather-eggs)
(delete-duplicates
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index df8fa01e..af617d5a 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -69,7 +69,7 @@
(lambda (egg)
(any (cut string=? <> egg) patterns))
eggs))))
- (delete-duplicates pats)))
+ (delete-duplicates pats string=?)))
(define (fini code)
(print "aborted.")
diff --git a/core.scm b/core.scm
index e73d207c..428833f6 100644
--- a/core.scm
+++ b/core.scm
@@ -999,7 +999,7 @@
;; Remove from list to avoid error
(when (pair? il)
(set! import-libraries
- (delete il import-libraries)))
+ (delete il import-libraries equal?)))
(values (reverse xs) '())))
((not enable-module-registration)
(values (reverse xs) '()))
@@ -2437,7 +2437,7 @@
(when (pair? (cdr params)) (bomb "let-node has invalid format" params))
(let ((c (gather (first subs) here locals))
(var (first params)))
- (append c (delete var (gather (second subs) here (cons var locals))))))
+ (append c (delete var (gather (second subs) here (cons var locals)) eq?))))
((set!)
(let ((var (first params))
diff --git a/csi.scm b/csi.scm
index d03c1690..583b495b 100644
--- a/csi.scm
+++ b/csi.scm
@@ -60,6 +60,7 @@ EOF
chicken.repl)
(include "banner.scm")
+(include "mini-srfi-1.scm")
;;; Parameters:
@@ -961,6 +962,7 @@ EOF
(define-constant complex-options
'("-D" "-feature" "-I" "-include-path" "-K" "-keyword-style" "-no-feature") )
+
(define (run)
(let* ([extraopts (parse-option-string (or (get-environment-variable "CSI_OPTIONS") ""))]
[args (canonicalize-args (command-line-arguments))]
@@ -1033,7 +1035,7 @@ EOF
(for-each register-feature! (collect-options "-D"))
(for-each unregister-feature! (collect-options "-no-feature"))
(set! ##sys#include-pathnames
- (##sys#nodups
+ (delete-duplicates
(append (map chop-separator (collect-options "-include-path"))
(map chop-separator (collect-options "-I"))
##sys#include-pathnames
diff --git a/library.scm b/library.scm
index 16c47833..3c55eb23 100644
--- a/library.scm
+++ b/library.scm
@@ -5737,27 +5737,6 @@ EOF
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
diff --git a/mini-srfi-1.scm b/mini-srfi-1.scm
index cd74dbe4..627aa0f7 100644
--- a/mini-srfi-1.scm
+++ b/mini-srfi-1.scm
@@ -26,8 +26,8 @@
(declare
- (unused take span drop partition split-at append-map every any cons* concatenate delete
- first second third fourth alist-cons delete-duplicates fifth remove
+ (unused take span drop partition split-at append-map every any cons* concatenate
+ first second third fourth alist-cons fifth remove
filter filter-map unzip1 last list-index lset-adjoin/eq? lset-difference/eq?
lset-union/eq? lset-intersection/eq? list-tabulate lset<=/eq? lset=/eq? length+
find find-tail iota make-list posq posv)
@@ -100,7 +100,7 @@
'()
(append (car lst) (loop (cdr lst))))))
-(define (delete x lst #!optional (test equal?))
+(define (delete x lst test)
(let loop ((lst lst))
(cond ((null? lst) lst)
((test x (car lst))
@@ -114,7 +114,7 @@
(define (fourth x) (cadddr x))
(define (fifth x) (car (cddddr x)))
-(define (delete-duplicates lst #!optional (test equal?))
+(define (delete-duplicates lst test)
(let loop ((lst lst))
(if (null? lst)
lst
diff --git a/optimizer.scm b/optimizer.scm
index 2e5381ba..99703051 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -124,7 +124,7 @@
(debugging 'p "scanning toplevel assignments...")
(scan node '())
(when (pair? safe)
- (debugging 'o "safe globals" (delete-duplicates safe)))
+ (debugging 'o "safe globals" (delete-duplicates safe eq?)))
(for-each (cut mark-variable <> '##compiler#always-bound) safe)))
diff --git a/rules.make b/rules.make
index 35a9132f..a1638563 100644
--- a/rules.make
+++ b/rules.make
@@ -866,7 +866,7 @@ endef
$(foreach obj, $(COMPILER_OBJECTS_1),\
$(eval $(call declare-bootstrap-compiler-object,$(obj))))
-csi.c: $(SRCDIR)csi.scm $(SRCDIR)banner.scm
+csi.c: $(SRCDIR)csi.scm $(SRCDIR)banner.scm $(SRCDIR)mini-srfi-1.scm
$(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@
chicken-profile.c: $(SRCDIR)chicken-profile.scm $(SRCDIR)mini-srfi-1.scm
$(CHICKEN) $< $(CHICKEN_PROGRAM_OPTIONS) -output-file $@
Trap