diff options
-rw-r--r-- | srfi/srfi-1.c | 33 | ||||
-rw-r--r-- | srfi/srfi-1.h | 1 | ||||
-rw-r--r-- | srfi/srfi-1.scm | 6 |
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) ) |