mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

* eval.c (SIDEVAL): Removed.

Browse source 
(SCM_CEVAL): Minimized scope of variable orig_sym.  Eliminated
goto-labels cdrxnoap, cdrxbegin and nontoplevel_cdrxnoap.  Changed
argument checking order for set! to locals, variables and symbols.
Improvements to control structure.  Removed some uses of arg1 and
arg2 as temporary variables.
This commit is contained in:
Dirk Herrmann 2002-03-20 23:53:13 +00:00
parent f29dc30246
commit e050d4f824
2 changed files with 55 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

10
libguile/ChangeLog
View file

@ -1,3 +1,13 @@
2002-03-20 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SIDEVAL): Removed.
(SCM_CEVAL): Minimized scope of variable orig_sym. Eliminated
goto-labels cdrxnoap, cdrxbegin and nontoplevel_cdrxnoap. Changed
argument checking order for set! to locals, variables and symbols.
Improvements to control structure. Removed some uses of arg1 and
arg2 as temporary variables.
2002-03-15 Thien-Thi Nguyen <ttn@giblet.glug.org> 2002-03-15 Thien-Thi Nguyen <ttn@giblet.glug.org>
* guile-snarf.in: Remove "--compat=1.4" support. * guile-snarf.in: Remove "--compat=1.4" support.

93
libguile/eval.c
View file

@ -123,10 +123,6 @@ char *alloca ();
* Originally, it is defined to scm_ceval, but is redefined to * Originally, it is defined to scm_ceval, but is redefined to
* scm_deval during the second pass. * scm_deval during the second pass.
* *
* SIDEVAL corresponds to SCM_CEVAL, but is used in situations where
* only side effects of expressions matter. All immediates are
* ignored.
*
* SCM_EVALIM is used when it is known that the expression is an * SCM_EVALIM is used when it is known that the expression is an
* immediate. (This macro never calls an evaluator.) * immediate. (This macro never calls an evaluator.)
* *
@ -150,8 +146,6 @@ char *alloca ();
*/ */
#define SCM_CEVAL scm_ceval #define SCM_CEVAL scm_ceval
#define SIDEVAL(x, env) if (SCM_NIMP (x)) SCM_CEVAL((x), (env))
#define EVALCELLCAR(x, env) (SCM_SYMBOLP (SCM_CAR (x)) \ #define EVALCELLCAR(x, env) (SCM_SYMBOLP (SCM_CAR (x)) \
? *scm_lookupcar (x, env, 1) \ ? *scm_lookupcar (x, env, 1) \
: SCM_CEVAL (SCM_CAR (x), env)) : SCM_CEVAL (SCM_CAR (x), env))
@ -1890,7 +1884,7 @@ scm_deval (SCM x, SCM env)
SCM SCM
SCM_CEVAL (SCM x, SCM env) SCM_CEVAL (SCM x, SCM env)
{ {
SCM proc, arg1, arg2, orig_sym; SCM proc, arg1, arg2;
#ifdef DEVAL #ifdef DEVAL
scm_t_debug_frame debug; scm_t_debug_frame debug;
scm_t_debug_info *debug_info_end; scm_t_debug_info *debug_info_end;
@ -2009,15 +2003,11 @@ dispatch:
goto carloop; goto carloop;
case SCM_BIT8 (SCM_IM_BEGIN): case SCM_BIT8 (SCM_IM_BEGIN):
if (SCM_NULLP (SCM_CDR (x))) x = SCM_CDR (x);
if (SCM_NULLP (x))
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
/* (currently unused)
cdrxnoap: */
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
/* (currently unused)
cdrxbegin: */
x = SCM_CDR (x);
begin: begin:
/* If we are on toplevel with a lookup closure, we need to sync /* If we are on toplevel with a lookup closure, we need to sync
@ -2036,9 +2026,6 @@ dispatch:
else else
goto nontoplevel_begin; goto nontoplevel_begin;
nontoplevel_cdrxnoap:
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
x = SCM_CDR (x);
nontoplevel_begin: nontoplevel_begin:
while (!SCM_NULLP (SCM_CDR (x))) while (!SCM_NULLP (SCM_CDR (x)))
{ {
@ -2254,8 +2241,9 @@ dispatch:
while (!SCM_NULLP (init_forms)); while (!SCM_NULLP (init_forms));
env = EXTEND_ENV (SCM_CAR (x), init_values, env); env = EXTEND_ENV (SCM_CAR (x), init_values, env);
} }
x = SCM_CDR (x); x = SCM_CDDR (x);
goto nontoplevel_cdrxnoap; PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto nontoplevel_begin;
case SCM_BIT8 (SCM_IM_LETREC): case SCM_BIT8 (SCM_IM_LETREC):
@ -2273,7 +2261,9 @@ dispatch:
while (!SCM_NULLP (init_forms)); while (!SCM_NULLP (init_forms));
SCM_SETCDR (SCM_CAR (env), init_values); SCM_SETCDR (SCM_CAR (env), init_values);
} }
goto nontoplevel_cdrxnoap; x = SCM_CDR (x);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto nontoplevel_begin;
case SCM_BIT8 (SCM_IM_LETSTAR): case SCM_BIT8 (SCM_IM_LETSTAR):
@ -2294,7 +2284,9 @@ dispatch:
while (!SCM_NULLP (bindings)); while (!SCM_NULLP (bindings));
} }
} }
goto nontoplevel_cdrxnoap; x = SCM_CDR (x);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto nontoplevel_begin;
case SCM_BIT8 (SCM_IM_OR): case SCM_BIT8 (SCM_IM_OR):
@ -2324,12 +2316,13 @@ dispatch:
{ {
SCM *location; SCM *location;
SCM variable = SCM_CAR (x); SCM variable = SCM_CAR (x);
#ifdef MEMOIZE_LOCALS
if (SCM_ILOCP (variable))
location = scm_ilookup (variable, env);
else
#endif
if (SCM_VARIABLEP (variable)) if (SCM_VARIABLEP (variable))
location = SCM_VARIABLE_LOC (variable); location = SCM_VARIABLE_LOC (variable);
#ifdef MEMOIZE_LOCALS
else if (SCM_ILOCP (variable))
location = scm_ilookup (variable, env);
#endif
else /* (SCM_SYMBOLP (variable)) is known to be true */ else /* (SCM_SYMBOLP (variable)) is known to be true */
location = scm_lookupcar (x, env, 1); location = scm_lookupcar (x, env, 1);
x = SCM_CDR (x); x = SCM_CDR (x);
@ -2407,23 +2400,27 @@ dispatch:
int first; int first;
SCM val = scm_make_continuation (&first); SCM val = scm_make_continuation (&first);
if (first) if (!first)
arg1 = val;
else
RETURN (val); RETURN (val);
else
{
arg1 = val;
proc = SCM_CDR (x);
proc = scm_eval_car (proc, env);
SCM_ASRTGO (SCM_NIMP (proc), badfun);
PREP_APPLY (proc, scm_list_1 (arg1));
ENTER_APPLY;
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1))
goto umwrongnumargs;
goto evap1;
}
} }
proc = SCM_CDR (x);
proc = scm_eval_car (proc, env);
SCM_ASRTGO (SCM_NIMP (proc), badfun);
PREP_APPLY (proc, scm_list_1 (arg1));
ENTER_APPLY;
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1))
goto umwrongnumargs;
goto evap1;
case (SCM_ISYMNUM (SCM_IM_DELAY)): case (SCM_ISYMNUM (SCM_IM_DELAY)):
RETURN (scm_makprom (scm_closure (SCM_CDR (x), env))); RETURN (scm_makprom (scm_closure (SCM_CDR (x), env)));
case (SCM_ISYMNUM (SCM_IM_DISPATCH)): case (SCM_ISYMNUM (SCM_IM_DISPATCH)):
{ {
/* If not done yet, evaluate the operand forms. The result is a /* If not done yet, evaluate the operand forms. The result is a
@ -2732,9 +2729,9 @@ dispatch:
#endif /* ifdef MEMOIZE_LOCALS */ #endif /* ifdef MEMOIZE_LOCALS */
case scm_tcs_cons_nimcar: case scm_tcs_cons_nimcar:
orig_sym = SCM_CAR (x); if (SCM_SYMBOLP (SCM_CAR (x)))
if (SCM_SYMBOLP (orig_sym))
{ {
SCM orig_sym = SCM_CAR (x);
#ifdef USE_THREADS #ifdef USE_THREADS
{ {
SCM *location = scm_lookupcar1 (x, env, 1); SCM *location = scm_lookupcar1 (x, env, 1);
@ -2759,7 +2756,7 @@ dispatch:
{ {
SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of
lookupcar */ lookupcar */
handle_a_macro: handle_a_macro: /* inputs: x, env, proc */
#ifdef DEVAL #ifdef DEVAL
/* Set a flag during macro expansion so that macro /* Set a flag during macro expansion so that macro
application frames can be deleted from the backtrace. */ application frames can be deleted from the backtrace. */
@ -2812,18 +2809,18 @@ dispatch:
#endif #endif
if (SCM_CLOSUREP (proc)) if (SCM_CLOSUREP (proc))
{ {
arg2 = SCM_CLOSURE_FORMALS (proc); SCM formals = SCM_CLOSURE_FORMALS (proc);
arg1 = SCM_CDR (x); SCM args = SCM_CDR (x);
while (!SCM_NULLP (arg2)) while (!SCM_NULLP (formals))
{ {
if (!SCM_CONSP (arg2)) if (!SCM_CONSP (formals))
goto evapply; goto evapply;
if (SCM_IMP (arg1)) if (SCM_IMP (args))
goto umwrongnumargs; goto umwrongnumargs;
arg2 = SCM_CDR (arg2); formals = SCM_CDR (formals);
arg1 = SCM_CDR (arg1); args = SCM_CDR (args);
} }
if (!SCM_NULLP (arg1)) if (!SCM_NULLP (args))
goto umwrongnumargs; goto umwrongnumargs;
} }
else if (SCM_MACROP (proc)) else if (SCM_MACROP (proc))
@ -2832,7 +2829,7 @@ dispatch:
} }
evapply: evapply: /* inputs: x, proc */
PREP_APPLY (proc, SCM_EOL); PREP_APPLY (proc, SCM_EOL);
if (SCM_NULLP (SCM_CDR (x))) { if (SCM_NULLP (SCM_CDR (x))) {
ENTER_APPLY; ENTER_APPLY;
@ -3358,7 +3355,7 @@ exit:
{ {
int first; int first;
SCM val = scm_make_continuation (&first); SCM val = scm_make_continuation (&first);
if (first) if (first)
arg1 = val; arg1 = val;
else else