1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

* eval.c (SCM_CEVAL): Cleaned up the handling of 'cons' and 'do':

Removed some uses of t.arg1 and proc as temporary variables.
Removed side-effecting operations from conditions and macro calls.
Introduced temporary variables with hopefully descriptive names
for clarification.  Replaced SCM_N?IMP by a more explicit
predicate in some places.
This commit is contained in:
Dirk Herrmann 2002-03-02 11:50:01 +00:00
parent 6a0f6ff30c
commit e5cb71a0a9
2 changed files with 95 additions and 42 deletions

View file

@ -1,3 +1,12 @@
2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SCM_CEVAL): Cleaned up the handling of 'cons' and 'do':
Removed some uses of t.arg1 and proc as temporary variables.
Removed side-effecting operations from conditions and macro calls.
Introduced temporary variables with hopefully descriptive names
for clarification. Replaced SCM_N?IMP by a more explicit
predicate in some places.
2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (scm_badargsp, SCM_CEVAL): Replaced SCM_N?IMP by a more

View file

@ -2121,64 +2121,108 @@ dispatch:
x = SCM_CDR (x);
while (!SCM_NULLP (x))
{
proc = SCM_CAR (x);
if (SCM_EQ_P (SCM_CAR (proc), scm_sym_else))
SCM clause = SCM_CAR (x);
if (SCM_EQ_P (SCM_CAR (clause), scm_sym_else))
{
x = SCM_CDR (proc);
x = SCM_CDR (clause);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto begin;
}
t.arg1 = EVALCAR (proc, env);
if (!SCM_FALSEP (t.arg1) && !SCM_NILP (t.arg1))
else
{
x = SCM_CDR (proc);
if (SCM_NULLP (x))
RETURN (t.arg1);
else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow))
t.arg1 = EVALCAR (clause, env);
if (!SCM_FALSEP (t.arg1) && !SCM_NILP (t.arg1))
{
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto begin;
x = SCM_CDR (clause);
if (SCM_NULLP (x))
RETURN (t.arg1);
else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow))
{
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto begin;
}
else
{
proc = SCM_CDR (x);
proc = EVALCAR (proc, env);
SCM_ASRTGO (!SCM_IMP (proc), badfun);
PREP_APPLY (proc, scm_list_1 (t.arg1));
ENTER_APPLY;
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1))
goto umwrongnumargs;
else
goto evap1;
}
}
proc = SCM_CDR (x);
proc = EVALCAR (proc, env);
SCM_ASRTGO (!SCM_IMP (proc), badfun);
PREP_APPLY (proc, scm_list_1 (t.arg1));
ENTER_APPLY;
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1))
goto umwrongnumargs;
goto evap1;
x = SCM_CDR (x);
}
x = SCM_CDR (x);
}
RETURN (SCM_UNSPECIFIED);
case SCM_BIT8(SCM_IM_DO):
case SCM_BIT8 (SCM_IM_DO):
x = SCM_CDR (x);
proc = SCM_CADR (x); /* inits */
t.arg1 = SCM_EOL; /* values */
while (!SCM_NULLP (proc))
{
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1);
proc = SCM_CDR (proc);
}
env = EXTEND_ENV (SCM_CAR (x), t.arg1, env);
{
/* Compute the initialization values and the initial environment. */
SCM init_forms = SCM_CADR (x);
SCM init_values = SCM_EOL;
while (!SCM_NULLP (init_forms))
{
init_values = scm_cons (EVALCAR (init_forms, env), init_values);
init_forms = SCM_CDR (init_forms);
}
env = EXTEND_ENV (SCM_CAR (x), init_values, env);
}
x = SCM_CDDR (x);
while (proc = SCM_CAR (x),
SCM_FALSEP (t.arg1 = EVALCAR (proc, env)) || SCM_NILP (t.arg1))
{
for (proc = SCM_CADR (x); SCM_NIMP (proc); proc = SCM_CDR (proc))
{
SCM test_form = SCM_CAR (x);
SCM body_forms = SCM_CADR (x);
SCM step_forms = SCM_CDDR (x);
SCM test_result = EVALCAR (test_form, env);
while (SCM_FALSEP (test_result) || SCM_NILP (test_result))
{
{
t.arg1 = SCM_CAR (proc); /* body */
SIDEVAL (t.arg1, env);
/* Evaluate body forms. */
SCM temp_forms;
for (temp_forms = body_forms;
!SCM_NULLP (temp_forms);
temp_forms = SCM_CDR (temp_forms))
{
SCM form = SCM_CAR (temp_forms);
/* Dirk:FIXME: We only need to eval forms, that may have a
* side effect here. This is only true for forms that start
* with a pair. All others are just constants. However,
* since in the common case there is no constant expression
* in a body of a do form, we just check for immediates here
* and have SCM_CEVAL take care of other cases. In the long
* run it would make sense to get rid of this test and have
* the macro transformer of 'do' eliminate all forms that
* have no sideeffect. */
if (!SCM_IMP (form))
SCM_CEVAL (form, env);
}
}
for (t.arg1 = SCM_EOL, proc = SCM_CDDR (x);
SCM_NIMP (proc);
proc = SCM_CDR (proc))
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); /* steps */
env = EXTEND_ENV (SCM_CAAR (env), t.arg1, SCM_CDR (env));
}
x = SCM_CDR (proc);
{
/* Evaluate the step expressions. */
SCM temp_forms;
SCM step_values = SCM_EOL;
for (temp_forms = step_forms;
!SCM_NULLP (temp_forms);
temp_forms = SCM_CDR (temp_forms))
{
SCM value = EVALCAR (temp_forms, env);
step_values = scm_cons (value, step_values);
}
env = EXTEND_ENV (SCM_CAAR (env), step_values, SCM_CDR (env));
}
test_result = EVALCAR (test_form, env);
}
}
x = SCM_CDAR (x);
if (SCM_NULLP (x))
RETURN (SCM_UNSPECIFIED);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);