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

srfi-1: Rewrite 'assoc' in Scheme.

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

31
libguile/srfi-1.c
View file

@ -710,37 +710,6 @@ SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0,
(SCM key, SCM alist, SCM pred),
"Behaves like @code{assq} but uses third argument @var{pred}\n"
"for key comparison. If @var{pred} is not supplied,\n"
"@code{equal?} is used. (Extended from R5RS.)\n")
#define FUNC_NAME s_scm_srfi1_assoc
{
SCM ls = alist;
scm_t_trampoline_2 equal_p;
if (SCM_UNBNDP (pred))
equal_p = equal_trampoline;
else
{
SCM_VALIDATE_PROC (SCM_ARG3, pred);
equal_p = scm_call_2;
}
for(; scm_is_pair (ls); ls = SCM_CDR (ls))
{
SCM tmp = SCM_CAR (ls);
SCM_ASSERT_TYPE (scm_is_pair (tmp), alist, SCM_ARG2, FUNC_NAME,
"association list");
if (scm_is_true (equal_p (pred, key, SCM_CAR (tmp))))
return tmp;
}
SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME,
"association list");
return SCM_BOOL_F;
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0,
(SCM pred, SCM list),
"Partition the elements of @var{list} with predicate @var{pred}.\n"

1
libguile/srfi-1.h
View file

@ -36,7 +36,6 @@ SCM_INTERNAL SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred);
SCM_INTERNAL SCM scm_srfi1_length_plus (SCM lst);
SCM_INTERNAL SCM scm_srfi1_lset_difference_x (SCM equal, SCM lst, SCM rest);
SCM_INTERNAL SCM scm_srfi1_list_copy (SCM lst);
SCM_INTERNAL SCM scm_srfi1_assoc (SCM key, SCM alist, SCM pred);
SCM_INTERNAL SCM scm_srfi1_partition (SCM pred, SCM list);
SCM_INTERNAL SCM scm_srfi1_partition_x (SCM pred, SCM list);
SCM_INTERNAL SCM scm_srfi1_remove (SCM pred, SCM list);

17
module/srfi/srfi-1.scm
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,