diff options
author | Rob Browning <rlb@defaultvalue.org> | 2024-07-17 22:12:22 -0500 |
---|---|---|
committer | Rob Browning <rlb@defaultvalue.org> | 2024-07-30 19:28:37 -0500 |
commit | 925faf1f01106e468dde78c453595575904bc158 (patch) | |
tree | e2dd49320db92a7c84404792faa27eaf5bca435a /module | |
parent | 58246aee24be908307117b3f8ae8040460f86ce7 (diff) | |
download | guile-925faf1f01106e468dde78c453595575904bc158.tar.gz |
srfi-1 partition: move from C to Scheme
* libguile/srfi-1.c (scm_srfi1_partition): delete.
* libguile/srfi-1.h (scm_srfi1_partition): delete.
* module/srfi/srfi-1.scm: add partition.
Diffstat (limited to 'module')
-rw-r--r-- | module/srfi/srfi-1.scm | 22 |
1 files changed, 22 insertions, 0 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index 2ecdcd7ff..b44eb0341 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -841,6 +841,28 @@ the list returned." ;;; Filtering & partitioning +(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. One of the output lists may share memory with @var{list}." + (let ((matches (list #f)) + (mismatches (list #f))) + (let lp ((lst lst) + (matches-end matches) + (mismatches-end mismatches)) + (if (null? lst) + (values (cdr matches) (cdr mismatches)) + (let ((x (car lst))) + (if (pred x) + (begin + (set-cdr! matches-end (list x)) + (lp (cdr lst) (cdr matches-end) mismatches-end)) + (begin + (set-cdr! mismatches-end (list x)) + (lp (cdr lst) matches-end (cdr mismatches-end))))))))) + (define (list-prefix-and-tail lst stop) (when (eq? lst stop) (error "Prefix cannot be empty")) |