summaryrefslogtreecommitdiff
path: root/srfi/srfi-1.c
diff options
context:
space:
mode:
authorKevin Ryde <user42@zip.com.au>2003-07-13 23:05:31 +0000
committerKevin Ryde <user42@zip.com.au>2003-07-13 23:05:31 +0000
commit65978fb2bdb199551ce5d693b8a78b42869ab39d (patch)
tree1ccd47059b170efe8b49e19b48ea9d3ee5608799 /srfi/srfi-1.c
parent0aacf84ee6095d1dc5491ae7eb83feeae44cef4c (diff)
downloadguile-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.c40
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)
{