[Guile-commits] 07/17: srfi-1 append-reverse!: move from C to Scheme

[Rob Browning]

rlb pushed a commit to branch main
in repository guile.

commit 3cb6309f623ad9ab242a2397cac3ede2ee289f9e
Author: Rob Browning <rlb@defaultvalue.org>
AuthorDate: Wed Jul 17 20:30:20 2024 -0500

    srfi-1 append-reverse!: move from C to Scheme
    
    * libguile/srfi-1.c (scm_srfi1_append_reverse_x): delete.
    * libguile/srfi-1.h (scm_srfi1_append_reverse_x): delete.
    * module/srfi/srfi-1.scm: add append-reverse!.
---
 libguile/srfi-1.c      | 33 ---------------------------------
 libguile/srfi-1.h      |  1 -
 module/srfi/srfi-1.scm | 22 ++++++++++++++++++++++
 3 files changed, 22 insertions(+), 34 deletions(-)

diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index ab3492422..7a8f72e15 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -85,39 +85,6 @@ list_copy_part (SCM lst, int count, SCM *dst)
 }
 #undef FUNC_NAME
 
-
-SCM_DEFINE (scm_srfi1_append_reverse_x, "append-reverse!", 2, 0, 0,
-            (SCM revhead, SCM tail),
-           "Reverse @var{rev-head}, append @var{tail} to it, and return the\n"
-           "result.  This is equivalent to @code{(append! (reverse!\n"
-           "@var{rev-head}) @var{tail})}, but its implementation is more\n"
-           "efficient.\n"
-           "\n"
-           "@example\n"
-           "(append-reverse! (list 1 2 3) '(4 5 6)) @result{} (3 2 1 4 5 6)\n"
-           "@end example\n"
-           "\n"
-           "@var{rev-head} may be modified in order to produce the result.")
-#define FUNC_NAME s_scm_srfi1_append_reverse_x
-{
-  SCM newtail;
-
-  while (scm_is_mutable_pair (revhead))
-    {
-      /* take the first cons cell from revhead */
-      newtail = revhead;
-      revhead = SCM_CDR (revhead);
-
-      /* make it the new start of tail, appending the previous */
-      SCM_SETCDR (newtail, tail);
-      tail = newtail;
-    }
-  SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (revhead), revhead, SCM_ARG1, FUNC_NAME,
-                   "list");
-  return tail;
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_srfi1_count, "count", 2, 0, 1,
             (SCM pred, SCM list1, SCM rest),
            "Return a count of the number of times @var{pred} returns true\n"
diff --git a/libguile/srfi-1.h b/libguile/srfi-1.h
index 779e216ec..f23d4b035 100644
--- a/libguile/srfi-1.h
+++ b/libguile/srfi-1.h
@@ -24,7 +24,6 @@
 
 #include "libguile/scm.h"
 
-SCM_INTERNAL SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail);
 SCM_INTERNAL SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest);
 SCM_INTERNAL SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred);
 SCM_INTERNAL SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred);
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 689d77812..f44b32909 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -481,6 +481,28 @@ result.  This is equivalent to @code{(append (reverse 
@var{rev-head})
             (wrong-type-arg 'append-reverse rev-head))
           result))))
 
+(define (append-reverse! rev-head tail)
+  "Reverse @var{rev-head}, append @var{tail} to it, and return the
+result.  This is equivalent to @code{(append! (reverse!  @var{rev-head})
+@var{tail})}, but its implementation is more efficient.
+
+@example
+(append-reverse! (list 1 2 3) '(4 5 6)) @result{} (3 2 1 4 5 6)
+@end example
+
+@var{rev-head} may be modified in order to produce the result."
+  (let lp ((rh rev-head)
+           (result tail))
+    (if (pair? rh)
+        (let ((next rh)
+              (rh (cdr rh)))
+          (set-cdr! next result)
+          (lp rh next))
+        (begin
+          (unless (null? rh)
+            (wrong-type-arg 'append-reverse! rev-head))
+          result))))
+
 (define (zip clist1 . rest)
   (let lp ((l (cons clist1 rest)) (acc '()))
     (if (any null? l)