dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* eval.c (SCM_CEVAL): Minimized scope of variable arg2.

Browse source 
Eliminated redundant SCM_IMP check.  Exlined call to EVALCAR.
Re-enabled handing of rpsubrs and asubrs.
This commit is contained in:
Dirk Herrmann 2002-03-21 00:36:03 +00:00
commit 42030fb275
2 changed files with 384 additions and 399 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/ChangeLog
View file

@ -1,3 +1,9 @@
2002-03-21 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SCM_CEVAL): Minimized scope of variable arg2.
Eliminated redundant SCM_IMP check. Exlined call to EVALCAR.
Re-enabled handing of rpsubrs and asubrs.
2002-03-20 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SIDEVAL): Removed.

41
libguile/eval.c
View file

@ -1884,7 +1884,7 @@ scm_deval (SCM x, SCM env)
SCM
SCM_CEVAL (SCM x, SCM env)
{
SCM proc, arg1, arg2;
SCM proc, arg1;
#ifdef DEVAL
scm_t_debug_frame debug;
scm_t_debug_info *debug_info_end;
@ -2925,10 +2925,12 @@ evapply: /* inputs: x, proc */
debug.info->a.args = scm_list_1 (arg1);
#endif
x = SCM_CDR (x);
{
SCM arg2;
if (SCM_NULLP (x))
{
ENTER_APPLY;
evap1:
evap1: /* inputs: proc, arg1 */
switch (SCM_TYP7 (proc))
{ /* have one argument in arg1 */
case scm_tc7_subr_2o:
@ -3047,15 +3049,8 @@ evapply: /* inputs: x, proc */
}
}
#ifdef SCM_CAUTIOUS
if (SCM_IMP (x))
goto wrongnumargs;
else if (SCM_CONSP (x))
{
if (SCM_IMP (SCM_CAR (x)))
arg2 = SCM_EVALIM (SCM_CAR (x), env);
else
arg2 = EVALCELLCAR (x, env);
}
if (SCM_CONSP (x))
arg2 = EVALCAR (x, env);
else
goto wrongnumargs;
#else
@ -3170,12 +3165,13 @@ evapply: /* inputs: x, proc */
}
}
#ifdef SCM_CAUTIOUS
if (SCM_IMP (x) || !SCM_CONSP (x))
if (!SCM_CONSP (x))
goto wrongnumargs;
#endif
#ifdef DEVAL
debug.info->a.args = scm_cons2 (arg1, arg2,
deval_args (x, env, proc, SCM_CDRLOC (SCM_CDR (debug.info->a.args))));
deval_args (x, env, proc,
SCM_CDRLOC (SCM_CDR (debug.info->a.args))));
#endif
ENTER_APPLY;
evap3:
@ -3187,7 +3183,6 @@ evapply: /* inputs: x, proc */
RETURN (SCM_SUBRF (proc) (arg1, arg2,
SCM_CADDR (debug.info->a.args)));
case scm_tc7_asubr:
#ifdef BUILTIN_RPASUBR
arg1 = SCM_SUBRF(proc)(arg1, arg2);
arg2 = SCM_CDDR (debug.info->a.args);
do
@ -3197,9 +3192,7 @@ evapply: /* inputs: x, proc */
}
while (SCM_NIMP (arg2));
RETURN (arg1);
#endif /* BUILTIN_RPASUBR */
case scm_tc7_rpsubr:
#ifdef BUILTIN_RPASUBR
if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, arg2)))
RETURN (SCM_BOOL_F);
arg1 = SCM_CDDR (debug.info->a.args);
@ -3212,12 +3205,6 @@ evapply: /* inputs: x, proc */
}
while (SCM_NIMP (arg1));
RETURN (SCM_BOOL_T);
#else /* BUILTIN_RPASUBR */
RETURN (SCM_APPLY (proc, arg1,
scm_acons (arg2,
SCM_CDDR (debug.info->a.args),
SCM_EOL)));
#endif /* BUILTIN_RPASUBR */
case scm_tc7_lsubr_2:
RETURN (SCM_SUBRF (proc) (arg1, arg2,
SCM_CDDR (debug.info->a.args)));
@ -3249,7 +3236,6 @@ evapply: /* inputs: x, proc */
SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs);
RETURN (SCM_SUBRF (proc) (arg1, arg2, EVALCAR (x, env)));
case scm_tc7_asubr:
#ifdef BUILTIN_RPASUBR
arg1 = SCM_SUBRF (proc) (arg1, arg2);
do
{
@ -3258,9 +3244,7 @@ evapply: /* inputs: x, proc */
}
while (SCM_NIMP (x));
RETURN (arg1);
#endif /* BUILTIN_RPASUBR */
case scm_tc7_rpsubr:
#ifdef BUILTIN_RPASUBR
if (SCM_FALSEP (SCM_SUBRF (proc) (arg1, arg2)))
RETURN (SCM_BOOL_F);
do
@ -3273,12 +3257,6 @@ evapply: /* inputs: x, proc */
}
while (SCM_NIMP (x));
RETURN (SCM_BOOL_T);
#else /* BUILTIN_RPASUBR */
RETURN (SCM_APPLY (proc, arg1,
scm_acons (arg2,
scm_eval_args (x, env, proc),
SCM_EOL)));
#endif /* BUILTIN_RPASUBR */
case scm_tc7_lsubr_2:
RETURN (SCM_SUBRF (proc) (arg1, arg2, scm_eval_args (x, env, proc)));
case scm_tc7_lsubr:
@ -3343,6 +3321,7 @@ evapply: /* inputs: x, proc */
goto badfun;
}
}
}
#ifdef DEVAL
exit:
if (CHECK_EXIT && SCM_TRAPS_P)