summaryrefslogtreecommitdiff
path: root/module/srfi/srfi-1.scm
diff options
context:
space:
mode:
authorRob Browning <rlb@defaultvalue.org>2024-07-17 22:18:05 -0500
committerRob Browning <rlb@defaultvalue.org>2024-07-30 19:28:37 -0500
commit3eb6afe738b313deac6b43cc4c883f70179f48cc (patch)
treeb76ed3f5539e30f270f55cd020eb9ba9e9d092db /module/srfi/srfi-1.scm
parent925faf1f01106e468dde78c453595575904bc158 (diff)
downloadguile-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.scm21
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