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:
parent
cd4c747fb8
commit
a15acbb828
3 changed files with 17 additions and 32 deletions
|
@ -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,
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue