diff options
-rw-r--r-- | srfi/ChangeLog | 9 | ||||
-rw-r--r-- | srfi/srfi-1.scm | 20 |
2 files changed, 23 insertions, 6 deletions
diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 8d03b3060..dd808e359 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,12 @@ +2001-06-07 Martin Grabmueller <mgrabmue@cs.tu-berlin.de> + + * srfi-1.scm (fold, fold-pair): Fixed a buggy call to apply. + (delete-duplicates): Now the first occurrence of an element is + retained, as required. + (member, assoc): Fixed wrong order of equality predicate + application. + + 2001-06-06 Martin Grabmueller <mgrabmue@cs.tu-berlin.de> * README: Update. diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm index a5315511f..1b2b1cab0 100644 --- a/srfi/srfi-1.scm +++ b/srfi/srfi-1.scm @@ -57,6 +57,7 @@ ;;; Code: (define-module (srfi srfi-1) + :use-module (ice-9 session) :use-module (ice-9 receive)) (export @@ -516,7 +517,7 @@ knil (let ((cars (map car lists)) (cdrs (map cdr lists))) - (f (apply kons cars (list knil)) cdrs)))))) + (f (apply kons (append! cars (list knil))) cdrs)))))) (define (fold-right kons knil clist1 . rest) (if (null? rest) @@ -540,7 +541,7 @@ (if (any null? lists) knil (let ((tails (map cdr lists))) - (f (apply kons lists (list knil)) tails)))))) + (f (apply kons (append! lists (list knil))) tails)))))) (define (pair-fold-right kons knil clist1 . rest) @@ -806,7 +807,7 @@ (let lp ((l list)) (if (null? l) #f - (if (l= (car l) x) + (if (l= x (car l)) l (lp (cdr l))))))) @@ -837,7 +838,14 @@ #t (lp1 (cdr l2))))) (lp0 (cdr l1)) - (cons (car l1) (cdr l1))))))) + (cons (car l1) (lp0 (cdr l1)))))))) + +(define (delete-duplicates list . rest) + (let ((l= (if (pair? rest) (car rest) equal?))) + (let lp ((list list)) + (if (null? list) + '() + (cons (car list) (lp (delete (car list) (cdr list) l=))))))) (define (delete-duplicates! list . rest) (let ((l= (if (pair? rest) (car rest) equal?))) @@ -850,7 +858,7 @@ (let lp ((a alist)) (if (null? a) #f - (if (k= (caar a) key) + (if (k= key (caar a)) (car a) (lp (cdr a))))))) @@ -861,7 +869,7 @@ (let lp ((a alist)) (if (null? a) '() - (cons (cons (caar a) (cdar a)) (lp (cdr a)))))) + (acons (caar a) (cdar a) (lp (cdr a)))))) (define (alist-delete key alist . rest) (let ((k= (if (pair? rest) (car rest) equal?))) |