summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--srfi/srfi-1.c33
-rw-r--r--srfi/srfi-1.h1
-rw-r--r--srfi/srfi-1.scm6
3 files changed, 37 insertions, 3 deletions
diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c
index 27f7dd12d..76d5678af 100644
--- 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 a92f51b9b..3d23c0d4a 100644
--- 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 c9555bff6..b22806ad2 100644
--- 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)
)