diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c index e79492f65..64b4f46ee 100644 --- a/libguile/srfi-1.c +++ b/libguile/srfi-1.c @@ -331,59 +331,6 @@ SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1, } #undef FUNC_NAME -SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0, - (SCM pred, SCM lst), - "Split @var{lst} into those elements which do and don't satisfy\n" - "the predicate @var{pred}.\n" - "\n" - "The return is two values (@pxref{Multiple Values}), the first\n" - "being a list of all elements from @var{lst} which satisfy\n" - "@var{pred}, the second a list of those which do not.\n" - "\n" - "The elements in the result lists are in the same order as in\n" - "@var{lst} but the order in which the calls @code{(@var{pred}\n" - "elem)} are made on the list elements is unspecified.\n" - "\n" - "@var{lst} may be modified to construct the return lists.") -#define FUNC_NAME s_scm_srfi1_partition_x -{ - SCM tlst, flst, *tp, *fp; - - SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG1, FUNC_NAME); - - /* tlst and flst are the lists of true and false elements. tp and fp are - where to store to append to them, initially &tlst and &flst, then - SCM_CDRLOC of the last pair in the respective lists. */ - - tlst = SCM_EOL; - flst = SCM_EOL; - tp = &tlst; - fp = &flst; - - for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) - { - if (scm_is_true (scm_call_1 (pred, SCM_CAR (lst)))) - { - *tp = lst; - tp = SCM_CDRLOC (lst); - } - else - { - *fp = lst; - fp = SCM_CDRLOC (lst); - } - } - - SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); - - /* terminate whichever didn't get the last element(s) */ - *tp = SCM_EOL; - *fp = SCM_EOL; - - return scm_values_2 (tlst, flst); -} -#undef FUNC_NAME - void scm_register_srfi_1 (void) diff --git a/libguile/srfi-1.h b/libguile/srfi-1.h index 744397e9a..c0f8f8866 100644 --- a/libguile/srfi-1.h +++ b/libguile/srfi-1.h @@ -27,7 +27,6 @@ SCM_INTERNAL SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred); SCM_INTERNAL SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred); SCM_INTERNAL SCM scm_srfi1_lset_difference_x (SCM equal, SCM lst, SCM rest); -SCM_INTERNAL SCM scm_srfi1_partition_x (SCM pred, SCM list); SCM_INTERNAL void scm_register_srfi_1 (void); SCM_INTERNAL void scm_init_srfi_1 (void); diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index b44eb0341..49ee46e40 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -907,6 +907,27 @@ a common tail with @{list}." (lp (cdr lst) (cdr lst) new-tail)))) (lp (cdr lst) last-kept tail)))))))) +(define (partition! pred lst) + "Partition the elements of @var{list} with predicate @var{pred}. +Return two values: the list of elements satisfying @var{pred} and the +list of elements @emph{not} satisfying @var{pred}. The order of the +output lists follows the order of @var{list}. @var{list} is not +mutated. @var{lst} may be modified to construct the return lists." + (let ((matches (cons #f lst)) + (mismatches (list #f))) + (let lp ((matches-next matches) + (mismatches-end mismatches)) + (let ((next (cdr matches-next))) + (if (null? next) + (values (cdr matches) (cdr mismatches)) + (let ((x (car next))) + (if (pred x) + (lp (cdr matches-next) mismatches-end) + (begin + (set-cdr! matches-next (cdr next)) + (set-cdr! mismatches-end (list x)) + (lp matches-next (cdr mismatches-end)))))))))) + (define (remove! pred lst) "Return a list containing all elements from @var{list} which do not satisfy the predicate @var{pred}. The elements in the result list have