mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 14:50:19 +02:00
Code Activity

* srfi-1.scm (fold, fold-pair): Fixed a buggy call to apply.

Browse source 
(delete-duplicates): Now the first occurrence of an element is
	retained, as required.
	(member, assoc): Fixed wrong order of equality predicate
	application.
This commit is contained in:
Martin Grabmüller 2001-06-07 17:54:40 +00:00
parent 5b33ed3df9
commit 563058efbe
2 changed files with 23 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

9
srfi/ChangeLog
View file

@ -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> 2001-06-06 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
* README: Update. * README: Update.

20
srfi/srfi-1.scm
View file

@ -57,6 +57,7 @@
;;; Code: ;;; Code:
(define-module (srfi srfi-1) (define-module (srfi srfi-1)
:use-module (ice-9 session)
:use-module (ice-9 receive)) :use-module (ice-9 receive))
(export (export
@ -516,7 +517,7 @@
knil knil
(let ((cars (map car lists)) (let ((cars (map car lists))
(cdrs (map cdr 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) (define (fold-right kons knil clist1 . rest)
(if (null? rest) (if (null? rest)
@ -540,7 +541,7 @@
(if (any null? lists) (if (any null? lists)
knil knil
(let ((tails (map cdr lists))) (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) (define (pair-fold-right kons knil clist1 . rest)
@ -806,7 +807,7 @@
(let lp ((l list)) (let lp ((l list))
(if (null? l) (if (null? l)
#f #f
(if (l= (car l) x) (if (l= x (car l))
l l
(lp (cdr l))))))) (lp (cdr l)))))))
@ -837,7 +838,14 @@
#t #t
(lp1 (cdr l2))))) (lp1 (cdr l2)))))
(lp0 (cdr l1)) (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) (define (delete-duplicates! list . rest)
(let ((l= (if (pair? rest) (car rest) equal?))) (let ((l= (if (pair? rest) (car rest) equal?)))
@ -850,7 +858,7 @@
(let lp ((a alist)) (let lp ((a alist))
(if (null? a) (if (null? a)
#f #f
(if (k= (caar a) key) (if (k= key (caar a))
(car a) (car a)
(lp (cdr a))))))) (lp (cdr a)))))))
@ -861,7 +869,7 @@
(let lp ((a alist)) (let lp ((a alist))
(if (null? a) (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) (define (alist-delete key alist . rest)
(let ((k= (if (pair? rest) (car rest) equal?))) (let ((k= (if (pair? rest) (car rest) equal?)))