mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00
Code Activity

(list-copy): New function, derived

Browse source 
from core list-copy but allowing improper lists, per SRFI-1 spec.
This commit is contained in:
Kevin Ryde 2003-08-22 22:36:18 +00:00
parent 01dbf76f90
commit d61261f07d
3 changed files with 37 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

33
srfi/srfi-1.c
View file

@ -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,

1
srfi/srfi-1.h
View file

@ -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);

6
srfi/srfi-1.scm
View file

@ -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)
)