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

* eval.c (SCM_CEVAL): Cleaned up the handling of 'apply'. Removed

Browse source 
side-effecting operations from conditions and macro calls.
Replaced SCM_N?IMP by a more explicit predicate in some places.
Minimized the scope of some variables.
This commit is contained in:
Dirk Herrmann 2002-03-05 21:10:15 +00:00
parent 7ca15449ed
commit 3f04400dd2
2 changed files with 43 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/ChangeLog
View file

@ -1,3 +1,10 @@
2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SCM_CEVAL): Cleaned up the handling of 'apply'. Removed
side-effecting operations from conditions and macro calls.
Replaced SCM_N?IMP by a more explicit predicate in some places.
Minimized the scope of some variables.
2002-03-02 Stefan Jahn <stefan@lkcc.org> 2002-03-02 Stefan Jahn <stefan@lkcc.org>
* convert.i.c: Fixed int <-> long conversions which would have * convert.i.c: Fixed int <-> long conversions which would have

63
libguile/eval.c
View file

@ -2348,18 +2348,19 @@ dispatch:
/* new syntactic forms go here. */ /* new syntactic forms go here. */
case SCM_BIT8(SCM_MAKISYM (0)): case SCM_BIT8 (SCM_MAKISYM (0)):
proc = SCM_CAR (x); proc = SCM_CAR (x);
SCM_ASRTGO (SCM_ISYMP (proc), badfun); SCM_ASRTGO (SCM_ISYMP (proc), badfun);
switch (SCM_ISYMNUM (proc)) switch (SCM_ISYMNUM (proc))
{ {
case (SCM_ISYMNUM (SCM_IM_APPLY)): case (SCM_ISYMNUM (SCM_IM_APPLY)):
proc = SCM_CDR (x); proc = SCM_CDR (x);
proc = EVALCAR (proc, env); proc = EVALCAR (proc, env);
SCM_ASRTGO (SCM_NIMP (proc), badfun); SCM_ASRTGO (!SCM_IMP (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_CDDR (x); t.arg1 = SCM_CDDR (x);
t.arg1 = EVALCAR (t.arg1, env); t.arg1 = EVALCAR (t.arg1, env);
@ -2367,36 +2368,44 @@ dispatch:
/* Go here to tail-call a closure. PROC is the closure /* Go here to tail-call a closure. PROC is the closure
and T.ARG1 is the list of arguments. Do not forget to and T.ARG1 is the list of arguments. Do not forget to
call PREP_APPLY. */ call PREP_APPLY. */
{
SCM formals = SCM_CLOSURE_FORMALS (proc);
#ifdef DEVAL #ifdef DEVAL
debug.info->a.args = t.arg1; debug.info->a.args = t.arg1;
#endif #endif
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
if (scm_badargsp (SCM_CLOSURE_FORMALS (proc), t.arg1)) if (scm_badargsp (formals, t.arg1))
goto wrongnumargs; goto wrongnumargs;
#endif #endif
ENTER_APPLY; ENTER_APPLY;
/* Copy argument list */ /* Copy argument list */
if (SCM_IMP (t.arg1)) if (SCM_NULL_OR_NIL_P (t.arg1))
argl = t.arg1; env = EXTEND_ENV (formals, SCM_EOL, SCM_ENV (proc));
else else
{ {
argl = tl = scm_cons (SCM_CAR (t.arg1), SCM_UNSPECIFIED); SCM args = scm_list_1 (SCM_CAR (t.arg1));
while (SCM_NIMP (t.arg1 = SCM_CDR (t.arg1)) SCM tail = args;
&& SCM_CONSP (t.arg1)) t.arg1 = SCM_CDR (t.arg1);
{ while (!SCM_NULL_OR_NIL_P (t.arg1))
SCM_SETCDR (tl, scm_cons (SCM_CAR (t.arg1), {
SCM_UNSPECIFIED)); SCM new_tail = scm_list_1 (SCM_CAR (t.arg1));
tl = SCM_CDR (tl); SCM_SETCDR (tail, new_tail);
} tail = new_tail;
SCM_SETCDR (tl, t.arg1); t.arg1 = SCM_CDR (t.arg1);
} }
env = EXTEND_ENV (formals, args, SCM_ENV (proc));
}
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), argl, SCM_ENV (proc)); x = SCM_CLOSURE_BODY (proc);
x = SCM_CLOSURE_BODY (proc); goto nontoplevel_begin;
goto nontoplevel_begin; }
} }
proc = scm_f_apply; else
goto evapply; {
proc = scm_f_apply;
goto evapply;
}
case (SCM_ISYMNUM (SCM_IM_CONT)): case (SCM_ISYMNUM (SCM_IM_CONT)):
{ {