guile/guile-core/srfi ChangeLog srfi-1.scm

[Martin Grabmueller]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Martin Grabmueller <address@hidden>     01/06/07 10:54:40

Modified files:
        guile-core/srfi: ChangeLog srfi-1.scm 

Log message:
        * 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.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/ChangeLog.diff?cvsroot=OldCVS&tr1=1.29&tr2=1.30&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/srfi-1.scm.diff?cvsroot=OldCVS&tr1=1.1&tr2=1.2&r1=text&r2=text

Patches:
Index: guile/guile-core/srfi/ChangeLog
diff -u guile/guile-core/srfi/ChangeLog:1.29 
guile/guile-core/srfi/ChangeLog:1.30
--- guile/guile-core/srfi/ChangeLog:1.29        Wed Jun  6 21:27:37 2001
+++ guile/guile-core/srfi/ChangeLog     Thu Jun  7 10:54:40 2001
@@ -1,3 +1,12 @@
+2001-06-07  Martin Grabmueller  <address@hidden>
+
+       * 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  <address@hidden>
 
        * README: Update.
Index: guile/guile-core/srfi/srfi-1.scm
diff -u guile/guile-core/srfi/srfi-1.scm:1.1 
guile/guile-core/srfi/srfi-1.scm:1.2
--- guile/guile-core/srfi/srfi-1.scm:1.1        Wed Jun  6 21:27:37 2001
+++ guile/guile-core/srfi/srfi-1.scm    Thu Jun  7 10:54:40 2001
@@ -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?)))