diff options
author | Kevin Ryde <user42@zip.com.au> | 2005-01-28 21:53:47 +0000 |
---|---|---|
committer | Kevin Ryde <user42@zip.com.au> | 2005-01-28 21:53:47 +0000 |
commit | 59747b8d2d2bb1d2172a0521da8d60dca64ec3b2 (patch) | |
tree | 1cc04d239f04e38b233ffb03a863757a0ee69ee7 /srfi/srfi-1.c | |
parent | a8109cc0ae3e7360c9abfc8aa88127daf834fd42 (diff) | |
download | guile-59747b8d2d2bb1d2172a0521da8d60dca64ec3b2.tar.gz |
(remove): Rewrite in C, a trivial adaption from scm_filter in the core.
Diffstat (limited to 'srfi/srfi-1.c')
-rw-r--r-- | srfi/srfi-1.c | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index c1f3c60eb..1cd956ce7 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -821,6 +821,37 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0, + (SCM pred, SCM list), + "Return a list containing all elements from @var{lst} which do\n" + "not satisfy the predicate @var{pred}. The elements in the\n" + "result list have the same order as in @var{lst}. The order in\n" + "which @var{pred} is applied to the list elements is not\n" + "specified.") +#define FUNC_NAME s_scm_srfi1_remove +{ + scm_t_trampoline_1 call = scm_trampoline_1 (pred); + SCM walk; + SCM *prev; + SCM res = SCM_EOL; + SCM_ASSERT (call, pred, 1, FUNC_NAME); + SCM_VALIDATE_LIST (2, list); + + for (prev = &res, walk = list; + scm_is_pair (walk); + walk = SCM_CDR (walk)) + { + if (scm_is_false (call (pred, SCM_CAR (walk)))) + { + *prev = scm_cons (SCM_CAR (walk), SCM_EOL); + prev = SCM_CDRLOC (*prev); + } + } + + return res; +} +#undef FUNC_NAME + void scm_init_srfi_1 (void) { |