[Guile-commits] 04/17: srfi-1 delete delete!: move from C to Scheme

[Rob Browning]

rlb pushed a commit to branch main
in repository guile.

commit a816b2484bae69edaf78ae2b0cb0c8f6005e0a8b
Author: Rob Browning <rlb@defaultvalue.org>
AuthorDate: Tue Jul 16 23:19:15 2024 -0500

    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)