diff options
author | Andy Wingo <wingo@pobox.com> | 2011-05-05 12:59:07 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-05-05 12:59:07 +0200 |
commit | 9e775af3bf0db457eceb5a9a1f4a87968d011492 (patch) | |
tree | 6a5545f47d4ecec48055592c1bf074ecd2db805c /libguile/srfi-1.c | |
parent | 89f9dd7065971d9d9047b42f044c06cc943f5efc (diff) | |
download | guile-9e775af3bf0db457eceb5a9a1f4a87968d011492.tar.gz |
srfi-1 `member' in scheme, inlines to memq / memv in some cases
* libguile/srfi-1.c:
* libguile/srfi-1.h (scm_srfi1_member): Move implementation to Scheme.
* module/srfi/srfi-1.scm (member): Implement here, with the inlining
cases for eq? and eqv?. Speeds up a compiled bootstrap of
psyntax.scm, because lset-adjoin inlines to the memq case.
(lset<=): Reindent.
(lset-adjoin, lset-union): If the comparator is eq? or eqv?, just pass
it through to `member', so we inline to memq / memv. Use something
closer to the reference implementations.
Diffstat (limited to 'libguile/srfi-1.c')
-rw-r--r-- | libguile/srfi-1.c | 37 |
1 files changed, 0 insertions, 37 deletions
diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c index 5c0750451..f67e60082 100644 --- a/libguile/srfi-1.c +++ b/libguile/srfi-1.c @@ -956,43 +956,6 @@ scm_srfi1_for_each (SCM proc, SCM arg1, SCM args) #undef FUNC_NAME -SCM_DEFINE (scm_srfi1_member, "member", 2, 1, 0, - (SCM x, SCM lst, SCM pred), - "Return the first sublist of @var{lst} whose @sc{car} is equal\n" - "to @var{x}. If @var{x} does not appear in @var{lst}, return\n" - "@code{#f}.\n" - "\n" - "Equality is determined by @code{equal?}, or by the equality\n" - "predicate @var{=} if given. @var{=} is called @code{(= @var{x}\n" - "elem)}, ie.@: with the given @var{x} first, so for example to\n" - "find the first element greater than 5,\n" - "\n" - "@example\n" - "(member 5 '(3 5 1 7 2 9) <) @result{} (7 2 9)\n" - "@end example\n" - "\n" - "This version of @code{member} extends the core @code{member} by\n" - "accepting an equality predicate.") -#define FUNC_NAME s_scm_srfi1_member -{ - scm_t_trampoline_2 equal_p; - SCM_VALIDATE_LIST (2, lst); - if (SCM_UNBNDP (pred)) - equal_p = equal_trampoline; - else - { - SCM_VALIDATE_PROC (SCM_ARG3, pred); - equal_p = scm_call_2; - } - for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) - { - if (scm_is_true (equal_p (pred, x, SCM_CAR (lst)))) - return lst; - } - return SCM_BOOL_F; -} -#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" |