mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

srfi-1 partition!: move from C to Scheme

Browse source 
* 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!.
This commit is contained in:
Rob Browning 2024-07-17 22:18:05 -05:00
parent 925faf1f01
commit 3eb6afe738
3 changed files with 21 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

21
module/srfi/srfi-1.scm
View file

@ -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