(list-copy): New function, derived

from core list-copy but allowing improper lists, per SRFI-1 spec.

diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c
index 27f7dd1..76d5678 100644 (file)
--- a/srfi/srfi-1.c
+++ b/srfi/srfi-1.c
@@ -382,6 +382,39 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
 #undef FUNC_NAME
 
 
+/* This routine differs from the core list-copy in allowing improper lists.
+   Maybe the core could allow them similarly.  */
+
+SCM_DEFINE (scm_srfi1_list_copy, "list-copy", 1, 0, 0, 
+            (SCM lst),
+           "Return a copy of the given list @var{lst}.\n"
+           "\n"
+           "@var{lst} can be a proper or improper list.  And if @var{lst}\n"
+           "is not a pair then it's treated as the final tail of an\n"
+           "improper list and simply returned.")
+#define FUNC_NAME s_scm_srfi1_list_copy
+{
+  SCM newlst;
+  SCM * fill_here;
+  SCM from_here;
+
+  newlst = lst;
+  fill_here = &newlst;
+  from_here = lst;
+
+  while (SCM_CONSP (from_here))
+    {
+      SCM c;
+      c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here));
+      *fill_here = c;
+      fill_here = SCM_CDRLOC (c);
+      from_here = SCM_CDR (from_here);
+    }
+  return newlst;
+}
+#undef FUNC_NAME
+
+
 /* Typechecking for multi-argument MAP and FOR-EACH.
 
    Verify that each element of the vector ARGV, except for the first,

diff --git a/srfi/srfi-1.h b/srfi/srfi-1.h
index a92f51b..3d23c0d 100644 (file)
--- a/srfi/srfi-1.h
+++ b/srfi/srfi-1.h
@@ -37,6 +37,7 @@ SCM_SRFI1_API SCM scm_srfi1_delete_x (SCM x, SCM lst, SCM pred);
 SCM_SRFI1_API SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred);
 SCM_SRFI1_API SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred);
 SCM_SRFI1_API SCM scm_srfi1_length_plus (SCM lst);
+SCM_SRFI1_API SCM scm_srfi1_list_copy (SCM lst);
 SCM_SRFI1_API SCM scm_srfi1_map (SCM proc, SCM arg1, SCM args);
 SCM_SRFI1_API SCM scm_srfi1_for_each (SCM proc, SCM arg1, SCM args);
 SCM_SRFI1_API SCM scm_srfi1_member (SCM obj, SCM ls, SCM pred);

diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm
index c9555bf..b22806a 100644 (file)
--- a/srfi/srfi-1.scm
+++ b/srfi/srfi-1.scm
@@ -43,7 +43,7 @@
  ;; cons*                              <= in the core
  ;; make-list                          <= in the core
  list-tabulate
- ;; list-copy                          <= in the core
+ list-copy
  circular-list
  ;; iota                               ; Extended.
 
@@ -207,14 +207,14 @@
  ;; set-car!                           <= in the core
  ;; set-cdr!                           <= in the core
  )
-  :re-export (cons list cons* make-list list-copy pair? null?
+  :re-export (cons list cons* make-list pair? null?
              car cdr caar cadr cdar cddr
              caaar caadr cadar caddr cdaar cdadr cddar cdddr
              caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
              cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
              list-ref last-pair length append append! reverse reverse!
              filter filter! memq memv assq assv set-car! set-cdr!)
-  :replace (iota map for-each map-in-order list-index member
+  :replace (iota map for-each map-in-order list-copy list-index member
            delete delete! assoc)
   )