From d6532dd1cf51fa065564f2c9a5ff99a6d0a3561c Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Wed, 8 Oct 2003 22:57:52 +0000 Subject: [PATCH] (funcq-assoc): Rewrite, don't assume '() is false, and actually traverse the given alist. --- ice-9/poe.scm | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/ice-9/poe.scm b/ice-9/poe.scm index bd7f2422d..2f3879b9e 100644 --- a/ice-9/poe.scm +++ b/ice-9/poe.scm @@ -58,16 +58,20 @@ (cdr arg-list)))))) 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) - (let ((it (and alist - (let and-map ((key arg-list) - (entry (caar alist))) - (or (and (and (not key) (not entry)) - (car alist)) - (and key entry - (eq? (car key) (car entry)) - (and-map (cdr key) (cdr entry)))))))) - it)) + (if (null? alist) + #f + (if (eq?-list arg-list (caar alist)) + (car alist) + (funcq-assoc arg-list (cdr alist)))))