From a816b2484bae69edaf78ae2b0cb0c8f6005e0a8b Mon Sep 17 00:00:00 2001 From: Rob Browning Date: Tue, 16 Jul 2024 23:19:15 -0500 Subject: [PATCH] srfi-1 delete delete!: move from C to Scheme * libguile/srfi-1.c (scm_srfi1_delete, scm_srfi1_delete_x): delete. * libguile/srfi-1.h (scm_srfi1_delete, scm_srfi1_delete_x): delete. * module/srfi/srfi-1.scm: add delete and delete!. --- libguile/srfi-1.c | 111 ----------------------------------------- libguile/srfi-1.h | 2 - module/srfi/srfi-1.scm | 35 +++++++++++++ 3 files changed, 35 insertions(+), 113 deletions(-) diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c index be78c1f2f..a03a5469e 100644 --- a/libguile/srfi-1.c +++ b/libguile/srfi-1.c @@ -277,117 +277,6 @@ SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1, #undef FUNC_NAME -SCM_DEFINE (scm_srfi1_delete, "delete", 2, 1, 0, - (SCM x, SCM lst, SCM pred), - "Return a list containing the elements of @var{lst} but with\n" - "those equal to @var{x} deleted. The returned elements will be\n" - "in the same order as they were in @var{lst}.\n" - "\n" - "Equality is determined by @var{pred}, or @code{equal?} if not\n" - "given. An equality call is made just once for each element,\n" - "but the order in which the calls are made on the elements is\n" - "unspecified.\n" - "\n" - "The equality calls are always @code{(pred x elem)}, ie.@: the\n" - "given @var{x} is first. This means for instance elements\n" - "greater than 5 can be deleted with @code{(delete 5 lst <)}.\n" - "\n" - "@var{lst} is not modified, but the returned list might share a\n" - "common tail with @var{lst}.") -#define FUNC_NAME s_scm_srfi1_delete -{ - SCM ret, *p, keeplst; - int count; - - if (SCM_UNBNDP (pred)) - return scm_delete (x, lst); - - SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG3, FUNC_NAME); - - /* ret is the return list being constructed. p is where to append to it, - initially &ret then SCM_CDRLOC of the last pair. lst progresses as - elements are considered. - - Elements to be retained are not immediately copied, instead keeplst is - the last pair in lst which is to be retained but not yet copied, count - is how many from there are wanted. When there's no more deletions, *p - can be set to keeplst to share the remainder of the original lst. (The - entire original lst if there's no deletions at all.) */ - - keeplst = lst; - count = 0; - p = &ret; - - for ( ; scm_is_pair (lst); lst = SCM_CDR (lst)) - { - if (scm_is_true (scm_call_2 (pred, x, SCM_CAR (lst)))) - { - /* delete this element, so copy those at keeplst */ - p = list_copy_part (keeplst, count, p); - keeplst = SCM_CDR (lst); - count = 0; - } - else - { - /* keep this element */ - count++; - } - } - - /* final retained elements */ - *p = keeplst; - - /* demand that lst was a proper list */ - SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (lst), lst, SCM_ARG2, FUNC_NAME, "list"); - - return ret; -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_srfi1_delete_x, "delete!", 2, 1, 0, - (SCM x, SCM lst, SCM pred), - "Return a list containing the elements of @var{lst} but with\n" - "those equal to @var{x} deleted. The returned elements will be\n" - "in the same order as they were in @var{lst}.\n" - "\n" - "Equality is determined by @var{pred}, or @code{equal?} if not\n" - "given. An equality call is made just once for each element,\n" - "but the order in which the calls are made on the elements is\n" - "unspecified.\n" - "\n" - "The equality calls are always @code{(pred x elem)}, ie.@: the\n" - "given @var{x} is first. This means for instance elements\n" - "greater than 5 can be deleted with @code{(delete 5 lst <)}.\n" - "\n" - "@var{lst} may be modified to construct the returned list.") -#define FUNC_NAME s_scm_srfi1_delete_x -{ - SCM walk; - SCM *prev; - - if (SCM_UNBNDP (pred)) - return scm_delete_x (x, lst); - - SCM_ASSERT (scm_is_true (scm_procedure_p (pred)), pred, SCM_ARG3, FUNC_NAME); - - for (prev = &lst, walk = lst; - scm_is_pair (walk); - walk = SCM_CDR (walk)) - { - if (scm_is_true (scm_call_2 (pred, x, SCM_CAR (walk)))) - *prev = SCM_CDR (walk); - else - prev = SCM_CDRLOC (walk); - } - - /* demand the input was a proper list */ - SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (walk), walk, SCM_ARG2, FUNC_NAME,"list"); - return lst; -} -#undef FUNC_NAME - - SCM_DEFINE (scm_srfi1_delete_duplicates, "delete-duplicates", 1, 1, 0, (SCM lst, SCM pred), "Return a list containing the elements of @var{lst} but without\n" diff --git a/libguile/srfi-1.h b/libguile/srfi-1.h index e2fb2b7c6..62d20cb3b 100644 --- a/libguile/srfi-1.h +++ b/libguile/srfi-1.h @@ -29,8 +29,6 @@ SCM_INTERNAL SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail); SCM_INTERNAL SCM scm_srfi1_concatenate (SCM lstlst); SCM_INTERNAL SCM scm_srfi1_concatenate_x (SCM lstlst); SCM_INTERNAL SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest); -SCM_INTERNAL SCM scm_srfi1_delete (SCM x, SCM lst, SCM pred); -SCM_INTERNAL SCM scm_srfi1_delete_x (SCM x, SCM lst, SCM pred); 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_length_plus (SCM lst); diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm index 3411b7e3c..8d0a603cd 100644 --- a/module/srfi/srfi-1.scm +++ b/module/srfi/srfi-1.scm @@ -982,6 +982,41 @@ CLIST1 ... CLISTN, that satisfies PRED." (else (lp (map cdr lists) (+ i 1))))))) +;;; Deletion + +(define* (delete x lst #:optional (pred equal?)) + "Return a list containing the elements of @var{lst} but with +those equal to @var{x} deleted. The returned elements will be in the +same order as they were in @var{lst}. + +Equality is determined by @var{pred}, or @code{equal?} if not given. An +equality call is made just once for each element, but the order in which +the calls are made on the elements is unspecified. + +The equality calls are always @code{(pred x elem)}, ie.@: the given +@var{x} is first. This means for instance elements greater than 5 can +be deleted with @code{(delete 5 lst <)}. + +@var{lst} is not modified, but the returned list might share a common +tail with @var{lst}." + (remove (lambda (elem) (pred x elem)) lst)) + +(define* (delete! x lst #:optional (pred equal?)) + "Return a list containing the elements of @var{lst} but with +those equal to @var{x} deleted. The returned elements will be in the +same order as they were in @var{lst}. + +Equality is determined by @var{pred}, or @code{equal?} if not given. An +equality call is made just once for each element, but the order in which +the calls are made on the elements is unspecified. + +The equality calls are always @code{(pred x elem)}, ie.@: the given +@var{x} is first. This means for instance elements greater than 5 can +be deleted with @code{(delete 5 lst <)}. + +@var{lst} may be modified to construct the returned list." + (remove! (lambda (elem) (pred x elem)) lst)) + ;;; Association lists (define alist-cons acons)