summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMartin Grabmüller <mgrabmue@cs.tu-berlin.de>2001-06-07 17:54:40 +0000
committerMartin Grabmüller <mgrabmue@cs.tu-berlin.de>2001-06-07 17:54:40 +0000
commit563058efbe03208cacb43f664c702e3979922cb6 (patch)
tree6ea10da8f2f5600845001d477da379460bbe9c30
parent5b33ed3df93a6c71b10d45e44926020c2b8e1db6 (diff)
downloadguile-563058efbe03208cacb43f664c702e3979922cb6.tar.gz
* 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.
-rw-r--r--srfi/ChangeLog9
-rw-r--r--srfi/srfi-1.scm20
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?)))