diff options
author | Rob Browning <rlb@defaultvalue.org> | 2024-07-17 22:18:05 -0500 |
---|---|---|
committer | Rob Browning <rlb@defaultvalue.org> | 2024-07-30 19:28:37 -0500 |
commit | 3eb6afe738b313deac6b43cc4c883f70179f48cc (patch) | |
tree | b76ed3f5539e30f270f55cd020eb9ba9e9d092db /module/srfi/srfi-1.scm | |
parent | 925faf1f01106e468dde78c453595575904bc158 (diff) | |
download | guile-3eb6afe738b313deac6b43cc4c883f70179f48cc.tar.gz |
srfi-1 partition!: move from C to Scheme
* libguile/srfi-1.c (scm_srfi1_partition_x): delete.
* libguile/srfi-1.h (scm_srfi1_partition_x): delete.
* module/srfi/srfi-1.scm: add partition!.
Diffstat (limited to 'module/srfi/srfi-1.scm')
-rw-r--r-- | module/srfi/srfi-1.scm | 21 |
1 files changed, 21 insertions, 0 deletions
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 |