diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-06-17 17:59:35 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-06-17 17:59:35 +0200 |
commit | a15acbb828dd2e75b35bbc76d48858b230591639 (patch) | |
tree | eda7a8054c59f08cf108adcb366402cd9e7e7a56 /module/srfi/srfi-1.scm | |
parent | cd4c747fb8cd6c65f18471aad54427d87b884ebc (diff) | |
download | guile-a15acbb828dd2e75b35bbc76d48858b230591639.tar.gz |
srfi-1: Rewrite 'assoc' in Scheme.
* libguile/srfi-1.c (scm_srfi1_assoc): Remove.
* libguile/srfi-1.h (scm_srfi1_assoc): Likewise.
* module/srfi/srfi-1.scm (assoc): New procedure.
Diffstat (limited to 'module/srfi/srfi-1.scm')
-rw-r--r-- | module/srfi/srfi-1.scm | 17 |
1 files changed, 17 insertions, 0 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index 1fc7a0e26..680ee94b5 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -923,6 +923,23 @@ and those making the associations." ;;; Delete / assoc / member +(define* (assoc key alist #:optional (= equal?)) + "Behaves like @code{assq} but uses third argument @var{pred} for key +comparison. If @var{pred} is not supplied, @code{equal?} is +used. (Extended from R5RS.)" + (cond + ((eq? = eq?) (assq key alist)) + ((eq? = eqv?) (assv key alist)) + (else + (check-arg procedure? = assoc) + (let loop ((alist alist)) + (and (pair? alist) + (let ((item (car alist))) + (check-arg pair? item assoc) + (if (= key (car item)) + item + (loop (cdr alist))))))))) + (define* (member x ls #:optional (= equal?)) (cond ;; This might be performance-sensitive, so punt on the check here, |