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

* eval.c (scm_badargsp, SCM_CEVAL): Replaced SCM_N?IMP by a more

Browse source 
explicit predicate in some places.

(CHECK_EQVISH): Removed.

(SCM_CEVAL): Removed some uses of t.arg1 and proc as temporary
variables.  Removed side-effecting operations from conditions and
macro calls.  Introduced temporary variables for clarification.
Sorted if-else-if check for the type of the last form in a list by
frequency.  Avoided some unnecessary tail-recursion calls.
This commit is contained in:
Dirk Herrmann 2002-03-02 09:53:51 +00:00
parent 547ba6882a
commit 6a0f6ff30c
2 changed files with 76 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/ChangeLog
View file

@ -1,3 +1,16 @@
2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (scm_badargsp, SCM_CEVAL): Replaced SCM_N?IMP by a more
explicit predicate in some places.
(CHECK_EQVISH): Removed.
(SCM_CEVAL): Removed some uses of t.arg1 and proc as temporary
variables. Removed side-effecting operations from conditions and
macro calls. Introduced temporary variables for clarification.
Sorted if-else-if check for the type of the last form in a list by
frequency. Avoided some unnecessary tail-recursion calls.
2002-03-01 Dirk Herrmann <D.Herrmann@tu-bs.de> 2002-03-01 Dirk Herrmann <D.Herrmann@tu-bs.de>
* gc.c (SCM_HEAP_SEG_SIZE, CELL_UP, CELL_DN, NEXT_DATA_CELL, * gc.c (SCM_HEAP_SEG_SIZE, CELL_UP, CELL_DN, NEXT_DATA_CELL,

111
libguile/eval.c
View file

@ -1571,11 +1571,11 @@ scm_unmemocopy (SCM x, SCM env)
int int
scm_badargsp (SCM formals, SCM args) scm_badargsp (SCM formals, SCM args)
{ {
while (SCM_NIMP (formals)) while (!SCM_NULLP (formals))
{ {
if (!SCM_CONSP (formals)) if (!SCM_CONSP (formals))
return 0; return 0;
if (SCM_IMP(args)) if (SCM_NULLP (args))
return 1; return 1;
formals = SCM_CDR (formals); formals = SCM_CDR (formals);
args = SCM_CDR (args); args = SCM_CDR (args);
@ -1845,9 +1845,6 @@ deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
env = scm_top_level_env (p); \ env = scm_top_level_env (p); \
} while (0) } while (0)
#ifndef DEVAL
#define CHECK_EQVISH(A,B) (SCM_EQ_P ((A), (B)) || (!SCM_FALSEP (scm_eqv_p ((A), (B)))))
#endif /* DEVAL */
/* This is the evaluator. Like any real monster, it has three heads: /* This is the evaluator. Like any real monster, it has three heads:
* *
@ -1926,9 +1923,11 @@ SCM_CEVAL (SCM x, SCM env)
scm_report_stack_overflow (); scm_report_stack_overflow ();
} }
#endif #endif
#ifdef DEVAL #ifdef DEVAL
goto start; goto start;
#endif #endif
loopnoap: loopnoap:
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
loop: loop:
@ -1951,6 +1950,7 @@ loop:
SCM_SET_OVERFLOW (debug); SCM_SET_OVERFLOW (debug);
debug.info -= 2; debug.info -= 2;
} }
start: start:
debug.info->e.exp = x; debug.info->e.exp = x;
debug.info->e.env = env; debug.info->e.env = env;
@ -1999,11 +1999,12 @@ dispatch:
x = scm_cons (x, SCM_UNDEFINED); x = scm_cons (x, SCM_UNDEFINED);
RETURN (*scm_lookupcar (x, env, 1)); RETURN (*scm_lookupcar (x, env, 1));
case SCM_BIT8(SCM_IM_AND): case SCM_BIT8 (SCM_IM_AND):
x = SCM_CDR (x); x = SCM_CDR (x);
while (!SCM_NULLP (SCM_CDR (x))) while (!SCM_NULLP (SCM_CDR (x)))
{ {
if (SCM_FALSEP (t.arg1 = EVALCAR (x, env)) || SCM_NILP (t.arg1)) SCM condition = EVALCAR (x, env);
if (SCM_FALSEP (condition) || SCM_NILP (condition))
RETURN (SCM_BOOL_F); RETURN (SCM_BOOL_F);
else else
x = SCM_CDR (x); x = SCM_CDR (x);
@ -2011,7 +2012,7 @@ dispatch:
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto carloop; goto carloop;
case SCM_BIT8(SCM_IM_BEGIN): case SCM_BIT8 (SCM_IM_BEGIN):
if (SCM_NULLP (SCM_CDR (x))) if (SCM_NULLP (SCM_CDR (x)))
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
@ -2046,59 +2047,73 @@ dispatch:
nontoplevel_begin: nontoplevel_begin:
while (!SCM_NULLP (SCM_CDR (x))) while (!SCM_NULLP (SCM_CDR (x)))
{ {
if (SCM_IMP (SCM_CAR (x))) SCM form = SCM_CAR (x);
if (SCM_IMP (form))
{ {
if (SCM_ISYMP (SCM_CAR (x))) if (SCM_ISYMP (form))
{ {
x = scm_m_expand_body (x, env); x = scm_m_expand_body (x, env);
goto nontoplevel_begin; goto nontoplevel_begin;
} }
else else
SCM_VALIDATE_NON_EMPTY_COMBINATION (SCM_CAR (x)); SCM_VALIDATE_NON_EMPTY_COMBINATION (form);
} }
else else
SCM_CEVAL (SCM_CAR (x), env); SCM_CEVAL (form, env);
x = SCM_CDR (x); x = SCM_CDR (x);
} }
carloop: /* scm_eval car of last form in list */ carloop:
if (SCM_IMP (SCM_CAR (x))) {
{ /* scm_eval last form in list */
x = SCM_CAR (x); SCM last_form = SCM_CAR (x);
RETURN (SCM_EVALIM (x, env));
}
if (SCM_SYMBOLP (SCM_CAR (x))) if (SCM_CONSP (last_form))
RETURN (*scm_lookupcar (x, env, 1)); {
/* This is by far the most frequent case. */
x = SCM_CAR (x); x = last_form;
goto loop; /* tail recurse */ goto loop; /* tail recurse */
}
else if (SCM_IMP (last_form))
RETURN (SCM_EVALIM (last_form, env));
else if (SCM_VARIABLEP (last_form))
RETURN (SCM_VARIABLE_REF (last_form));
else if (SCM_SYMBOLP (last_form))
RETURN (*scm_lookupcar (x, env, 1));
else
RETURN (last_form);
}
case SCM_BIT8(SCM_IM_CASE): case SCM_BIT8(SCM_IM_CASE):
x = SCM_CDR (x); x = SCM_CDR (x);
t.arg1 = EVALCAR (x, env); {
while (SCM_NIMP (x = SCM_CDR (x))) SCM key = EVALCAR (x, env);
{ x = SCM_CDR (x);
proc = SCM_CAR (x); while (!SCM_NULLP (x))
if (SCM_EQ_P (scm_sym_else, SCM_CAR (proc))) {
{ SCM clause = SCM_CAR (x);
x = SCM_CDR (proc); SCM labels = SCM_CAR (clause);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); if (SCM_EQ_P (labels, scm_sym_else))
goto begin; {
} x = SCM_CDR (clause);
proc = SCM_CAR (proc); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
while (SCM_NIMP (proc)) goto begin;
{ }
if (CHECK_EQVISH (SCM_CAR (proc), t.arg1)) while (!SCM_NULLP (labels))
{ {
x = SCM_CDAR (x); SCM label = SCM_CAR (labels);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); if (SCM_EQ_P (label, key) || !SCM_FALSEP (scm_eqv_p (label, key)))
goto begin; {
} x = SCM_CDR (clause);
proc = SCM_CDR (proc); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
} goto begin;
} }
labels = SCM_CDR (labels);
}
x = SCM_CDR (x);
}
}
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
@ -2119,14 +2134,14 @@ dispatch:
x = SCM_CDR (proc); x = SCM_CDR (proc);
if (SCM_NULLP (x)) if (SCM_NULLP (x))
RETURN (t.arg1); RETURN (t.arg1);
if (!SCM_EQ_P (scm_sym_arrow, SCM_CAR (x))) else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow))
{ {
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto begin; goto begin;
} }
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);
PREP_APPLY (proc, scm_list_1 (t.arg1)); PREP_APPLY (proc, scm_list_1 (t.arg1));
ENTER_APPLY; ENTER_APPLY;
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1)) if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1))
@ -2142,7 +2157,7 @@ dispatch:
x = SCM_CDR (x); x = SCM_CDR (x);
proc = SCM_CADR (x); /* inits */ proc = SCM_CADR (x); /* inits */
t.arg1 = SCM_EOL; /* values */ t.arg1 = SCM_EOL; /* values */
while (SCM_NIMP (proc)) while (!SCM_NULLP (proc))
{ {
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1);
proc = SCM_CDR (proc); proc = SCM_CDR (proc);