diff options
author | Kevin Ryde <user42@zip.com.au> | 2003-07-13 23:05:31 +0000 |
---|---|---|
committer | Kevin Ryde <user42@zip.com.au> | 2003-07-13 23:05:31 +0000 |
commit | 65978fb2bdb199551ce5d693b8a78b42869ab39d (patch) | |
tree | 1ccd47059b170efe8b49e19b48ea9d3ee5608799 /srfi/srfi-1.c | |
parent | 0aacf84ee6095d1dc5491ae7eb83feeae44cef4c (diff) | |
download | guile-65978fb2bdb199551ce5d693b8a78b42869ab39d.tar.gz |
2003-07-14 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
* srfi-1.c, srfi-1.h (scm_srfi1_partition), srfi-1.scm (partition):
Re-implement in C to avoid stack overflows for long input lists.
Diffstat (limited to 'srfi/srfi-1.c')
-rw-r--r-- | srfi/srfi-1.c | 40 |
1 files changed, 40 insertions, 0 deletions
diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index 5fe78c7dd..247e0c388 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -620,6 +620,46 @@ SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0, } #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" + "Return two values: the list of elements satifying @var{pred} and\n" + "the list of elements @emph{not} satisfying @var{pred}. The order\n" + "of the output lists follows the order of @var{list}. @var{list}\n" + "is not mutated. One of the output lists may share memory with @var{list}.\n") +#define FUNC_NAME s_scm_srfi1_partition +{ + /* In this implementation, the output lists don't share memory with + list, because it's probably not worth the effort. */ + scm_t_trampoline_1 call = scm_trampoline_1(pred); + SCM kept = scm_cons(SCM_EOL, SCM_EOL); + SCM kept_tail = kept; + SCM dropped = scm_cons(SCM_EOL, SCM_EOL); + SCM dropped_tail = dropped; + + SCM_ASSERT(call, pred, 2, FUNC_NAME); + + for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR(list)) { + SCM elt = SCM_CAR(list); + SCM new_tail = scm_cons(SCM_CAR(list), SCM_EOL); + if (SCM_NFALSEP(call(pred, elt))) { + SCM_SETCDR(kept_tail, new_tail); + kept_tail = new_tail; + } + else { + SCM_SETCDR(dropped_tail, new_tail); + dropped_tail = new_tail; + } + } + /* re-use the initial conses for the values list */ + SCM_SETCAR(kept, SCM_CDR(kept)); + SCM_SETCDR(kept, dropped); + SCM_SETCAR(dropped, SCM_CDR(dropped)); + SCM_SETCDR(dropped, SCM_EOL); + return scm_values(kept); +} +#undef FUNC_NAME + void scm_init_srfi_1 (void) { |