620 |
} |
} |
621 |
#undef FUNC_NAME |
#undef FUNC_NAME |
622 |
|
|
623 |
|
SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0, |
624 |
|
(SCM pred, SCM list), |
625 |
|
"Partition the elements of @var{list} with predicate @var{pred}.\n" |
626 |
|
"Return two values: the list of elements satifying @var{pred} and\n" |
627 |
|
"the list of elements @emph{not} satisfying @var{pred}. The order\n" |
628 |
|
"of the output lists follows the order of @var{list}. @var{list}\n" |
629 |
|
"is not mutated. One of the output lists may share memory with @var{list}.\n") |
630 |
|
#define FUNC_NAME s_scm_srfi1_partition |
631 |
|
{ |
632 |
|
/* In this implementation, the output lists don't share memory with |
633 |
|
list, because it's probably not worth the effort. */ |
634 |
|
scm_t_trampoline_1 call = scm_trampoline_1(pred); |
635 |
|
SCM kept = scm_cons(SCM_EOL, SCM_EOL); |
636 |
|
SCM kept_tail = kept; |
637 |
|
SCM dropped = scm_cons(SCM_EOL, SCM_EOL); |
638 |
|
SCM dropped_tail = dropped; |
639 |
|
|
640 |
|
SCM_ASSERT(call, pred, 2, FUNC_NAME); |
641 |
|
|
642 |
|
for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR(list)) { |
643 |
|
SCM elt = SCM_CAR(list); |
644 |
|
SCM new_tail = scm_cons(SCM_CAR(list), SCM_EOL); |
645 |
|
if (SCM_NFALSEP(call(pred, elt))) { |
646 |
|
SCM_SETCDR(kept_tail, new_tail); |
647 |
|
kept_tail = new_tail; |
648 |
|
} |
649 |
|
else { |
650 |
|
SCM_SETCDR(dropped_tail, new_tail); |
651 |
|
dropped_tail = new_tail; |
652 |
|
} |
653 |
|
} |
654 |
|
/* re-use the initial conses for the values list */ |
655 |
|
SCM_SETCAR(kept, SCM_CDR(kept)); |
656 |
|
SCM_SETCDR(kept, dropped); |
657 |
|
SCM_SETCAR(dropped, SCM_CDR(dropped)); |
658 |
|
SCM_SETCDR(dropped, SCM_EOL); |
659 |
|
return scm_values(kept); |
660 |
|
} |
661 |
|
#undef FUNC_NAME |
662 |
|
|
663 |
void |
void |
664 |
scm_init_srfi_1 (void) |
scm_init_srfi_1 (void) |
665 |
{ |
{ |