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): delete.
* libguile/srfi-1.h (scm_srfi1_partition): delete.
* module/srfi/srfi-1.scm: add partition.
This commit is contained in:
Rob Browning 2024-07-17 22:12:22 -05:00
parent 58246aee24
commit 925faf1f01
3 changed files with 22 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

42
libguile/srfi-1.c
View file

@ -331,48 +331,6 @@ SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
}
#undef FUNC_NAME
SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0,
(SCM pred, SCM list),
"Partition the elements of @var{list} with predicate @var{pred}.\n"
"Return two values: the list of elements satisfying @var{pred} and\n"
"the list of elements @emph{not} satisfying @var{pred}. The order\n"
"of the output lists follows the order of @var{list}. @var{list}\n"
"is not mutated. One of the output lists may share memory with @var{list}.\n")
#define FUNC_NAME s_scm_srfi1_partition
{
/* In this implementation, the output lists don't share memory with
list, because it's probably not worth the effort. */
SCM orig_list = list;
SCM kept = scm_cons(SCM_EOL, SCM_EOL);
SCM kept_tail = kept;
SCM dropped = scm_cons(SCM_EOL, SCM_EOL);
SCM dropped_tail = dropped;
SCM_VALIDATE_PROC (SCM_ARG1, pred);
for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR(list)) {
SCM elt, new_tail;
/* Make sure LIST is not a dotted list. */
SCM_ASSERT (scm_is_pair (list), orig_list, SCM_ARG2, FUNC_NAME);
elt = SCM_CAR (list);
new_tail = scm_cons (SCM_CAR (list), SCM_EOL);
if (scm_is_true (scm_call_1 (pred, elt))) {
SCM_SETCDR(kept_tail, new_tail);
kept_tail = new_tail;
}
else {
SCM_SETCDR(dropped_tail, new_tail);
dropped_tail = new_tail;
}
}
return scm_values_2 (SCM_CDR (kept), SCM_CDR (dropped));
}
#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"

1
libguile/srfi-1.h
View file

@ -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 (SCM pred, SCM list);
SCM_INTERNAL SCM scm_srfi1_partition_x (SCM pred, SCM list);
SCM_INTERNAL void scm_register_srfi_1 (void);

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

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