(remove): Rewrite in C, a trivial adaption from scm_filter in the core.

This commit is contained in:
Kevin Ryde 2005-01-28 21:53:47 +00:00
commit 59747b8d2d
2 changed files with 33 additions and 1 deletions

View file

@ -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)
{

View file

@ -2,7 +2,7 @@
#define SCM_SRFI_1_H
/* srfi-1.h --- SRFI-1 procedures for Guile
*
* Copyright (C) 2002, 2003 Free Software Foundation, Inc.
* Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -44,6 +44,7 @@ SCM_SRFI1_API SCM scm_srfi1_for_each (SCM proc, SCM arg1, SCM args);
SCM_SRFI1_API SCM scm_srfi1_member (SCM obj, SCM ls, SCM pred);
SCM_SRFI1_API SCM scm_srfi1_assoc (SCM key, SCM alist, SCM pred);
SCM_SRFI1_API SCM scm_srfi1_partition (SCM pred, SCM list);
SCM_SRFI1_API SCM scm_srfi1_remove (SCM pred, SCM list);
SCM_SRFI1_API void scm_init_srfi_1 (void);