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

[Rob Browning]

rlb pushed a commit to branch main
in repository guile.

commit c62d2962d43b746643d52c2f57867f990f216449
Author: Rob Browning <rlb@defaultvalue.org>
AuthorDate: Tue Jul 16 23:30:05 2024 -0500

    srfi-1 concatenate concatenate!: move from C to Scheme
    
    * libguile/srfi-1.c (scm_srfi1_concatenate, scm_srfi1_concatenate_x): 
delete.
    * libguile/srfi-1.h (scm_srfi1_concatenate, scm_srfi1_concatenate_x): 
delete.
    * module/srfi/srfi-1.scm: add concatenate and concatenate!.
---
 libguile/srfi-1.c            | 35 -----------------------------------
 libguile/srfi-1.h            |  2 --
 module/srfi/srfi-1.scm       | 19 +++++++++++++++++++
 test-suite/tests/srfi-1.test |  4 ++--
 4 files changed, 21 insertions(+), 39 deletions(-)

diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index a03a5469e..d75e77088 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -143,41 +143,6 @@ SCM_DEFINE (scm_srfi1_append_reverse_x, "append-reverse!", 
2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_srfi1_concatenate, "concatenate", 1, 0, 0,
-            (SCM lstlst),
-           "Construct a list by appending all lists in @var{lstlst}.\n"
-           "\n"
-           "@code{concatenate} is the same as @code{(apply append\n"
-           "@var{lstlst})}.  It exists because some Scheme implementations\n"
-           "have a limit on the number of arguments a function takes, which\n"
-           "the @code{apply} might exceed.  In Guile there is no such\n"
-           "limit.")
-#define FUNC_NAME s_scm_srfi1_concatenate
-{
-  SCM_VALIDATE_LIST (SCM_ARG1, lstlst);
-  return scm_append (lstlst);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_srfi1_concatenate_x, "concatenate!", 1, 0, 0,
-            (SCM lstlst),
-           "Construct a list by appending all lists in @var{lstlst}.  Those\n"
-           "lists may be modified to produce the result.\n"
-           "\n"
-           "@code{concatenate!} is the same as @code{(apply append!\n"
-           "@var{lstlst})}.  It exists because some Scheme implementations\n"
-           "have a limit on the number of arguments a function takes, which\n"
-           "the @code{apply} might exceed.  In Guile there is no such\n"
-           "limit.")
-#define FUNC_NAME s_scm_srfi1_concatenate_x
-{
-  SCM_VALIDATE_LIST (SCM_ARG1, lstlst);
-  return scm_append_x (lstlst);
-}
-#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 62d20cb3b..c5844cf8f 100644
--- a/libguile/srfi-1.h
+++ b/libguile/srfi-1.h
@@ -26,8 +26,6 @@
 
 SCM_INTERNAL SCM scm_srfi1_append_reverse (SCM revhead, SCM tail);
 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_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 8d0a603cd..a5308b403 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -445,6 +445,25 @@ a list of those after."
 
 ;;; Miscelleneous: length, append, concatenate, reverse, zip & count
 
+(define (concatenate lists)
+  "Construct a list by appending all lists in @var{lists}.
+
+@code{concatenate} is the same as @code{(apply append @var{lists})}.
+It exists because some Scheme implementations have a limit on the number
+of arguments a function takes, which the @code{apply} might exceed.  In
+Guile there is no such limit."
+  (apply append lists))
+
+(define (concatenate! lists)
+  "Construct a list by appending all lists in @var{lists}.  Those
+lists may be modified to produce the result.
+
+@code{concatenate!} is the same as @code{(apply append!  @var{lists})}.
+It exists because some Scheme implementations have a limit on the number
+of arguments a function takes, which the @code{apply} might exceed.  In
+Guile there is no such limit."
+  (apply append! lists))
+
 (define (zip clist1 . rest)
   (let lp ((l (cons clist1 rest)) (acc '()))
     (if (any null? l)
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index d3166e5a2..04a35ed6d 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -463,10 +463,10 @@
     (pass-if-exception "too many args" exception:wrong-num-args
       (concatenate-proc '() '()))
 
-    (pass-if-exception "number" exception:wrong-type-arg
+    (pass-if-exception "number" '(wrong-type-arg . "Apply to non-list")
       (concatenate-proc 123))
 
-    (pass-if-exception "vector" exception:wrong-type-arg
+    (pass-if-exception "vector" '(wrong-type-arg . "Apply to non-list")
       (concatenate-proc #(1 2 3)))
     
     (pass-if "no lists"