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

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.
This commit is contained in:
Ludovic Courtès 2020-06-17 17:59:35 +02:00
parent cd4c747fb8
commit a15acbb828
3 changed files with 17 additions and 32 deletions

View file

@ -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,