mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

(scm_cons_star): Don't modify the rest list, it belongs to

Browse source 
the caller when cons* is reached through apply.
This commit is contained in:
Kevin Ryde 2005-04-22 23:18:59 +00:00
parent 01adf598d9
commit b906b056e4
1 changed files with 12 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/list.c
View file

@ -109,7 +109,7 @@ SCM_DEFINE (scm_list, "list", 0, 0, 1,
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1, SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1,
(SCM arg, SCM rest), (SCM arg, SCM rest),
"Like @code{list}, but the last arg provides the tail of the\n" "Like @code{list}, but the last arg provides the tail of the\n"
"constructed list, returning @code{(cons @var{arg1} (cons\n" "constructed list, returning @code{(cons @var{arg1} (cons\n"
@ -119,18 +119,20 @@ SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1,
"Schemes and in Common LISP.") "Schemes and in Common LISP.")
#define FUNC_NAME s_scm_cons_star #define FUNC_NAME s_scm_cons_star
{ {
SCM ret = SCM_EOL;
SCM *p = &ret;
SCM_VALIDATE_REST_ARGUMENT (rest); SCM_VALIDATE_REST_ARGUMENT (rest);
if (!scm_is_null (rest))
for ( ; scm_is_pair (rest); rest = SCM_CDR (rest))
{ {
SCM prev = arg = scm_cons (arg, rest); *p = scm_cons (arg, SCM_EOL);
while (!scm_is_null (SCM_CDR (rest))) p = SCM_CDRLOC (*p);
{ arg = SCM_CAR (rest);
prev = rest;
rest = SCM_CDR (rest);
}
SCM_SETCDR (prev, SCM_CAR (rest));
} }
return arg;
*p = arg;
return ret;
} }
#undef FUNC_NAME #undef FUNC_NAME