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 remove!: move from C to Scheme

Browse source 
* libguile/srfi-1.c (scm_srfi1_remove_x): delete.
* libguile/srfi-1.h (scm_srfi1_remove_x): delete.
* module/srfi/srfi-1.scm: add remove!.
This commit is contained in:
Rob Browning 2024-07-16 22:57:07 -05:00
parent 03d4a3b5df
commit c5f26d4c27
3 changed files with 21 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

29
libguile/srfi-1.c
View file

@ -772,35 +772,6 @@ SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_srfi1_remove_x, "remove!", 2, 0, 0,
(SCM pred, SCM list),
"Return a list containing all elements from @var{list} which do\n"
"not satisfy the predicate @var{pred}. The elements in the\n"
"result list have the same order as in @var{list}. The order in\n"
"which @var{pred} is applied to the list elements is not\n"
"specified. @var{list} may be modified to build the return\n"
"list.")
#define FUNC_NAME s_scm_srfi1_remove_x
{
SCM walk;
SCM *prev;
SCM_VALIDATE_PROC (SCM_ARG1, pred);
SCM_VALIDATE_LIST (2, list);
for (prev = &list, walk = list;
scm_is_pair (walk);
walk = SCM_CDR (walk))
{
if (scm_is_false (scm_call_1 (pred, SCM_CAR (walk))))
prev = SCM_CDRLOC (walk);
else
*prev = SCM_CDR (walk);
}
return list;
}
#undef FUNC_NAME
void void
scm_register_srfi_1 (void) scm_register_srfi_1 (void)

1
libguile/srfi-1.h
View file

@ -37,7 +37,6 @@ SCM_INTERNAL SCM scm_srfi1_length_plus (SCM lst);
SCM_INTERNAL SCM scm_srfi1_lset_difference_x (SCM equal, SCM lst, SCM rest); 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 (SCM pred, SCM list);
SCM_INTERNAL SCM scm_srfi1_partition_x (SCM pred, SCM list); SCM_INTERNAL SCM scm_srfi1_partition_x (SCM pred, SCM list);
SCM_INTERNAL SCM scm_srfi1_remove_x (SCM pred, SCM list);
SCM_INTERNAL void scm_register_srfi_1 (void); SCM_INTERNAL void scm_register_srfi_1 (void);
SCM_INTERNAL void scm_init_srfi_1 (void); SCM_INTERNAL void scm_init_srfi_1 (void);

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

@ -782,6 +782,27 @@ a common tail with @{list}."
(lp (cdr lst) (cdr lst) new-tail)))) (lp (cdr lst) (cdr lst) new-tail))))
(lp (cdr lst) last-kept tail)))))))) (lp (cdr lst) last-kept tail))))))))
(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
the same order as in @var{list}. The order in which @var{pred} is
applied to the list elements is not specified. @var{list} may be
modified to build the return list."
(cond
((null? lst) lst)
((pred (car lst)) (remove! pred (cdr lst)))
(else
(let lp ((prev lst))
(let ((next (cdr prev)))
(if (null? next)
lst
(let ((x (car next)))
(if (pred x)
(begin
(set-cdr! prev (cdr next))
(lp prev))
(lp next)))))))))
;;; Searching ;;; Searching