srfi-1 list-copy improper lists

[Kevin Ryde <user42@zip.com.au>]

[-- Attachment #1: Type: text/plain, Size: 448 bytes --]

A little spot of code for an item from the todo list,

        * srfi-1.c, srfi-1.h, srfi-1.scm (list-copy): New function, derived
        from core list-copy but allowing improper lists, per SRFI-1 spec.

        * tests/srfi-1.test (list-copy): New tests.

I think this should go in the 1.6 branch too.

I suppose it'd be easier to relax the core list-copy, but for now at
least a version in the srfi-1 module can do what srfi-1 says it should.


[-- Attachment #2: srfi-1.c.list-copy.diff --]
[-- Type: text/plain, Size: 1215 bytes --]

--- srfi-1.c.~1.10.~	2003-07-29 09:50:41.000000000 +1000
+++ srfi-1.c	2003-08-11 12:06:49.000000000 +1000
@@ -382,6 +382,39 @@
 #undef FUNC_NAME
 
 
+/* This routine differs from the core list-copy in allowing improper lists.
+   Maybe the core could allow them similarly, but for now this code exists
+   to satisfy the SRFI-1 spec.  */
+
+SCM_DEFINE (scm_srfi1_list_copy, "list-copy", 1, 0, 0, 
+            (SCM lst),
+	    "Return a copy of the given list @var{lst}.  @var{lst} can be a\n"
+	    "proper or improper list.  If @var{lst} is not a pair at all\n"
+	    "then it's treated as the final tail of an improper list and\n"
+	    "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,

[-- Attachment #3: srfi-1.scm.list-copy.diff --]
[-- Type: text/plain, Size: 1017 bytes --]

--- srfi-1.scm.~1.28.~	2003-07-29 09:51:02.000000000 +1000
+++ srfi-1.scm	2003-08-12 22:32:29.000000000 +1000
@@ -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)
   )
 

[-- Attachment #4: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel