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

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

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

9
libguile/ChangeLog
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> 2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (scm_badargsp, SCM_CEVAL): Replaced SCM_N?IMP by a more * eval.c (scm_badargsp, SCM_CEVAL): Replaced SCM_N?IMP by a more

128
libguile/eval.c
View file

@ -2121,64 +2121,108 @@ dispatch:
x = SCM_CDR (x); x = SCM_CDR (x);
while (!SCM_NULLP (x)) while (!SCM_NULLP (x))
{ {
proc = SCM_CAR (x); SCM clause = SCM_CAR (x);
if (SCM_EQ_P (SCM_CAR (proc), scm_sym_else)) if (SCM_EQ_P (SCM_CAR (clause), scm_sym_else))
{ {
x = SCM_CDR (proc); x = SCM_CDR (clause);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto begin; goto begin;
} }
t.arg1 = EVALCAR (proc, env); else
if (!SCM_FALSEP (t.arg1) && !SCM_NILP (t.arg1))
{ {
x = SCM_CDR (proc); t.arg1 = EVALCAR (clause, env);
if (SCM_NULLP (x)) if (!SCM_FALSEP (t.arg1) && !SCM_NILP (t.arg1))
RETURN (t.arg1);
else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow))
{ {
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); x = SCM_CDR (clause);
goto begin; 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); x = 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);
} }
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
case SCM_BIT8(SCM_IM_DO): case SCM_BIT8 (SCM_IM_DO):
x = SCM_CDR (x); x = SCM_CDR (x);
proc = SCM_CADR (x); /* inits */ {
t.arg1 = SCM_EOL; /* values */ /* Compute the initialization values and the initial environment. */
while (!SCM_NULLP (proc)) SCM init_forms = SCM_CADR (x);
{ SCM init_values = SCM_EOL;
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); while (!SCM_NULLP (init_forms))
proc = SCM_CDR (proc); {
} init_values = scm_cons (EVALCAR (init_forms, env), init_values);
env = EXTEND_ENV (SCM_CAR (x), t.arg1, env); init_forms = SCM_CDR (init_forms);
}
env = EXTEND_ENV (SCM_CAR (x), init_values, env);
}
x = SCM_CDDR (x); x = SCM_CDDR (x);
while (proc = SCM_CAR (x), {
SCM_FALSEP (t.arg1 = EVALCAR (proc, env)) || SCM_NILP (t.arg1)) SCM test_form = SCM_CAR (x);
{ SCM body_forms = SCM_CADR (x);
for (proc = SCM_CADR (x); SCM_NIMP (proc); proc = SCM_CDR (proc)) 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 */ /* Evaluate body forms. */
SIDEVAL (t.arg1, env); 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)) /* Evaluate the step expressions. */
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); /* steps */ SCM temp_forms;
env = EXTEND_ENV (SCM_CAAR (env), t.arg1, SCM_CDR (env)); SCM step_values = SCM_EOL;
} for (temp_forms = step_forms;
x = SCM_CDR (proc); !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)) if (SCM_NULLP (x))
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);