mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

(funcq-assoc): Rewrite, don't assume '() is false, and

Browse source 
actually traverse the given alist.
This commit is contained in:
Kevin Ryde 2003-10-08 22:57:52 +00:00
parent df5af69a91
commit d6532dd1cf
1 changed files with 13 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

22
ice-9/poe.scm
View file

@ -58,16 +58,20 @@
(cdr arg-list)))))) (cdr arg-list))))))
it)) it))
;; return true if lists X and Y are the same length and each element is `eq?'
(define (eq?-list x y)
(if (null? x)
(null? y)
(and (not (null? y))
(eq? (car x) (car y))
(eq?-list (cdr x) (cdr y)))))
(define (funcq-assoc arg-list alist) (define (funcq-assoc arg-list alist)
(let ((it (and alist (if (null? alist)
(let and-map ((key arg-list) #f
(entry (caar alist))) (if (eq?-list arg-list (caar alist))
(or (and (and (not key) (not entry)) (car alist)
(car alist)) (funcq-assoc arg-list (cdr alist)))))
(and key entry
(eq? (car key) (car entry))
(and-map (cdr key) (cdr entry))))))))
it))