mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

* list.c (scm_reverse): Report an error if given a circular list

Browse source 
instead of filling memory.
* list.c (scm_reverse_x): Check args.
This commit is contained in:
Mikael Djurfeldt 1999-03-16 16:37:51 +00:00
parent 2251c7a4ce
commit 3946f0ded4
1 changed files with 36 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

63
libguile/list.c
View file

@ -259,42 +259,51 @@ scm_last_pair(sx)
/* reversing lists */ /* reversing lists */
SCM_PROC (s_reverse, "reverse", 1, 0, 0, scm_reverse); SCM_PROC (s_reverse, "reverse", 1, 0, 0, scm_reverse);
SCM SCM
scm_reverse(lst) scm_reverse (SCM ls)
SCM lst;
{ {
SCM res = SCM_EOL; SCM res = SCM_EOL;
SCM p = lst; SCM p = ls, t = ls;
for(;SCM_NIMP(p);p = SCM_CDR(p)) { while (SCM_NIMP (p))
SCM_ASSERT(SCM_CONSP(p), lst, SCM_ARG1, s_reverse); {
res = scm_cons(SCM_CAR(p), res); SCM_ASSERT (SCM_CONSP (p), ls, SCM_ARG1, s_reverse);
} res = scm_cons (SCM_CAR (p), res);
SCM_ASSERT(SCM_NULLP(p), lst, SCM_ARG1, s_reverse); p = SCM_CDR (p);
return res; if (SCM_IMP (p))
break;
SCM_ASSERT (SCM_CONSP (p), ls, SCM_ARG1, s_reverse);
res = scm_cons (SCM_CAR (p), res);
p = SCM_CDR (p);
t = SCM_CDR (t);
if (t == p)
scm_misc_error (s_reverse, "Circular structure: %S", SCM_LIST1 (ls));
}
SCM_ASSERT (SCM_NULLP (p), ls, SCM_ARG1, s_reverse);
return res;
} }
SCM_PROC (s_reverse_x, "reverse!", 1, 1, 0, scm_reverse_x); SCM_PROC (s_reverse_x, "reverse!", 1, 1, 0, scm_reverse_x);
SCM SCM
scm_reverse_x (lst, newtail) scm_reverse_x (ls, new_tail)
SCM lst; SCM ls;
SCM newtail; SCM new_tail;
{ {
SCM old_tail; SCM old_tail;
if (newtail == SCM_UNDEFINED) SCM_ASSERT (scm_ilength (ls) >= 0, ls, SCM_ARG1, s_reverse_x);
newtail = SCM_EOL; if (SCM_UNBNDP (new_tail))
new_tail = SCM_EOL;
else
SCM_ASSERT (scm_ilength (new_tail) >= 0, new_tail, SCM_ARG2, s_reverse_x);
loop: while (SCM_NIMP (ls))
if (!(SCM_NIMP (lst) && SCM_CONSP (lst))) {
return lst; old_tail = SCM_CDR (ls);
SCM_SETCDR (ls, new_tail);
old_tail = SCM_CDR (lst); new_tail = ls;
SCM_SETCDR (lst, newtail); ls = old_tail;
if (SCM_NULLP (old_tail)) }
return lst; return new_tail;
newtail = lst;
lst = old_tail;
goto loop;
} }