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

* eval.c (SCM_CEVAL, SCM_APPLY): In SCM_IM_APPLY and in the

Browse source 
procedure apply: Copy argument lists before pushing them unto the
environment so that the environment won't get mutated due to
manipulation of procedure arguments.  This should perhaps be
regarded as a temporary solution until someone finds a more
efficient one.  (Thanks to Maciej Stachowiak.)
This commit is contained in:
Mikael Djurfeldt 1998-04-12 10:10:29 +00:00
parent 4b8a63cc8c
commit 1609038c87
2 changed files with 45 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

9
libguile/ChangeLog
View file

@ -1,3 +1,12 @@
1998-04-12 Mikael Djurfeldt <mdj@kenneth>
* eval.c (SCM_CEVAL, SCM_APPLY): In SCM_IM_APPLY and in the
procedure apply: Copy argument lists before pushing them unto the
environment so that the environment won't get mutated due to
manipulation of procedure arguments. This should perhaps be
regarded as a temporary solution until someone finds a more
efficient one. (Thanks to Maciej Stachowiak.)
1998-04-10 Mikael Djurfeldt <mdj@kenneth> 1998-04-10 Mikael Djurfeldt <mdj@kenneth>
* script.c (scm_compile_shell_switches): Use "guile" as default * script.c (scm_compile_shell_switches): Use "guile" as default

38
libguile/eval.c
View file

@ -1922,6 +1922,7 @@ dispatch:
SCM_ASRTGO (SCM_NIMP (proc), badfun); SCM_ASRTGO (SCM_NIMP (proc), badfun);
if (SCM_CLOSUREP (proc)) if (SCM_CLOSUREP (proc))
{ {
SCM argl, tl;
PREP_APPLY (proc, SCM_EOL); PREP_APPLY (proc, SCM_EOL);
t.arg1 = SCM_CDR (SCM_CDR (x)); t.arg1 = SCM_CDR (SCM_CDR (x));
t.arg1 = EVALCAR (t.arg1, env); t.arg1 = EVALCAR (t.arg1, env);
@ -1932,7 +1933,23 @@ dispatch:
if (scm_badargsp (SCM_CAR (SCM_CODE (proc)), t.arg1)) if (scm_badargsp (SCM_CAR (SCM_CODE (proc)), t.arg1))
goto wrongnumargs; goto wrongnumargs;
#endif #endif
env = EXTEND_ENV (SCM_CAR (SCM_CODE (proc)), t.arg1, SCM_ENV (proc)); /* Copy argument list */
if (SCM_IMP (t.arg1))
argl = t.arg1;
else
{
argl = tl = scm_cons (SCM_CAR (t.arg1), SCM_UNSPECIFIED);
while (SCM_NIMP (t.arg1 = SCM_CDR (t.arg1))
&& SCM_CONSP (t.arg1))
{
SCM_SETCDR (tl, scm_cons (SCM_CAR (t.arg1),
SCM_UNSPECIFIED));
tl = SCM_CDR (tl);
}
SCM_SETCDR (tl, t.arg1);
}
env = EXTEND_ENV (SCM_CAR (SCM_CODE (proc)), argl, SCM_ENV (proc));
x = SCM_CODE (proc); x = SCM_CODE (proc);
goto cdrxbegin; goto cdrxbegin;
} }
@ -2883,7 +2900,24 @@ tail:
if (scm_badargsp (SCM_CAR (SCM_CODE (proc)), arg1)) if (scm_badargsp (SCM_CAR (SCM_CODE (proc)), arg1))
goto wrongnumargs; goto wrongnumargs;
#endif #endif
args = EXTEND_ENV (SCM_CAR (SCM_CODE (proc)), arg1, SCM_ENV (proc));
/* Copy argument list */
if (SCM_IMP (arg1))
args = arg1;
else
{
SCM tl = args = scm_cons (SCM_CAR (arg1), SCM_UNSPECIFIED);
while (SCM_NIMP (arg1 = SCM_CDR (arg1))
&& SCM_CONSP (arg1))
{
SCM_SETCDR (tl, scm_cons (SCM_CAR (arg1),
SCM_UNSPECIFIED));
tl = SCM_CDR (tl);
}
SCM_SETCDR (tl, arg1);
}
args = EXTEND_ENV (SCM_CAR (SCM_CODE (proc)), args, SCM_ENV (proc));
proc = SCM_CODE (proc); proc = SCM_CODE (proc);
while (SCM_NNULLP (proc = SCM_CDR (proc))) while (SCM_NNULLP (proc = SCM_CDR (proc)))
arg1 = EVALCAR (proc, args); arg1 = EVALCAR (proc, args);