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

* eval.c (SCM_CEVAL): Cleaned up the handling of 'if', 'let',

Browse source 
'letrec' and 'set*': Removed some uses of t.arg1, t.lloc 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.  Removed code that
was conditionally compiled if SICP was defined - which it never
is.
This commit is contained in:
Dirk Herrmann 2002-03-02 12:47:45 +00:00
parent e5cb71a0a9
commit 38ace99eb3
2 changed files with 68 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

11
libguile/ChangeLog
View file

@ -1,3 +1,14 @@
2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SCM_CEVAL): Cleaned up the handling of 'if', 'let',
'letrec' and 'set*': Removed some uses of t.arg1, t.lloc 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. Removed code that
was conditionally compiled if SICP was defined - which it never
is.
2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de> 2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SCM_CEVAL): Cleaned up the handling of 'cons' and 'do': * eval.c (SCM_CEVAL): Cleaned up the handling of 'cons' and 'do':

107
libguile/eval.c
View file

@ -2003,8 +2003,8 @@ dispatch:
x = SCM_CDR (x); x = SCM_CDR (x);
while (!SCM_NULLP (SCM_CDR (x))) while (!SCM_NULLP (SCM_CDR (x)))
{ {
SCM condition = EVALCAR (x, env); SCM test_result = EVALCAR (x, env);
if (SCM_FALSEP (condition) || SCM_NILP (condition)) if (SCM_FALSEP (test_result) || SCM_NILP (test_result))
RETURN (SCM_BOOL_F); RETURN (SCM_BOOL_F);
else else
x = SCM_CDR (x); x = SCM_CDR (x);
@ -2085,7 +2085,7 @@ dispatch:
} }
case SCM_BIT8(SCM_IM_CASE): case SCM_BIT8 (SCM_IM_CASE):
x = SCM_CDR (x); x = SCM_CDR (x);
{ {
SCM key = EVALCAR (x, env); SCM key = EVALCAR (x, env);
@ -2229,46 +2229,59 @@ dispatch:
goto nontoplevel_begin; goto nontoplevel_begin;
case SCM_BIT8(SCM_IM_IF): case SCM_BIT8 (SCM_IM_IF):
x = SCM_CDR (x); x = SCM_CDR (x);
if (!SCM_FALSEP (t.arg1 = EVALCAR (x, env)) && !SCM_NILP (t.arg1)) {
x = SCM_CDR (x); SCM test_result = EVALCAR (x, env);
else if (SCM_IMP (x = SCM_CDDR (x))) if (!SCM_FALSEP (test_result) && !SCM_NILP (test_result))
RETURN (SCM_UNSPECIFIED); x = SCM_CDR (x);
else
{
x = SCM_CDDR (x);
if (SCM_NULLP (x))
RETURN (SCM_UNSPECIFIED);
}
}
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto carloop; goto carloop;
case SCM_BIT8(SCM_IM_LET): case SCM_BIT8 (SCM_IM_LET):
x = SCM_CDR (x); x = SCM_CDR (x);
proc = SCM_CADR (x); {
t.arg1 = SCM_EOL; SCM init_forms = SCM_CADR (x);
do SCM init_values = SCM_EOL;
{ do
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); {
} init_values = scm_cons (EVALCAR (init_forms, env), init_values);
while (SCM_NIMP (proc = SCM_CDR (proc))); init_forms = SCM_CDR (init_forms);
env = EXTEND_ENV (SCM_CAR (x), t.arg1, env); }
while (!SCM_NULLP (init_forms));
env = EXTEND_ENV (SCM_CAR (x), init_values, env);
}
x = SCM_CDR (x); x = SCM_CDR (x);
goto nontoplevel_cdrxnoap; goto nontoplevel_cdrxnoap;
case SCM_BIT8(SCM_IM_LETREC): case SCM_BIT8 (SCM_IM_LETREC):
x = SCM_CDR (x); x = SCM_CDR (x);
env = EXTEND_ENV (SCM_CAR (x), scm_undefineds, env); env = EXTEND_ENV (SCM_CAR (x), scm_undefineds, env);
x = SCM_CDR (x); x = SCM_CDR (x);
proc = SCM_CAR (x); {
t.arg1 = SCM_EOL; SCM init_forms = SCM_CAR (x);
do SCM init_values = SCM_EOL;
{ do
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); {
} init_values = scm_cons (EVALCAR (init_forms, env), init_values);
while (SCM_NIMP (proc = SCM_CDR (proc))); init_forms = SCM_CDR (init_forms);
SCM_SETCDR (SCM_CAR (env), t.arg1); }
while (!SCM_NULLP (init_forms));
SCM_SETCDR (SCM_CAR (env), init_values);
}
goto nontoplevel_cdrxnoap; goto nontoplevel_cdrxnoap;
case SCM_BIT8(SCM_IM_LETSTAR): case SCM_BIT8 (SCM_IM_LETSTAR):
x = SCM_CDR (x); x = SCM_CDR (x);
{ {
SCM bindings = SCM_CAR (x); SCM bindings = SCM_CAR (x);
@ -2289,7 +2302,7 @@ dispatch:
goto nontoplevel_cdrxnoap; goto nontoplevel_cdrxnoap;
case SCM_BIT8(SCM_IM_OR): case SCM_BIT8 (SCM_IM_OR):
x = SCM_CDR (x); x = SCM_CDR (x);
while (!SCM_NULLP (SCM_CDR (x))) while (!SCM_NULLP (SCM_CDR (x)))
{ {
@ -2303,43 +2316,37 @@ dispatch:
goto carloop; goto carloop;
case SCM_BIT8(SCM_IM_LAMBDA): case SCM_BIT8 (SCM_IM_LAMBDA):
RETURN (scm_closure (SCM_CDR (x), env)); RETURN (scm_closure (SCM_CDR (x), env));
case SCM_BIT8(SCM_IM_QUOTE): case SCM_BIT8 (SCM_IM_QUOTE):
RETURN (SCM_CADR (x)); RETURN (SCM_CADR (x));
case SCM_BIT8(SCM_IM_SET_X): case SCM_BIT8 (SCM_IM_SET_X):
x = SCM_CDR (x); x = SCM_CDR (x);
proc = SCM_CAR (x); {
switch (SCM_ITAG3 (proc)) SCM *location;
{ SCM variable = SCM_CAR (x);
case scm_tc3_cons: if (SCM_VARIABLEP (variable))
if (SCM_VARIABLEP (proc)) location = SCM_VARIABLE_LOC (variable);
t.lloc = SCM_VARIABLE_LOC (proc);
else
t.lloc = scm_lookupcar (x, env, 1);
break;
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
case scm_tc3_imm24: else if (SCM_ILOCP (variable))
t.lloc = scm_ilookup (proc, env); location = scm_ilookup (variable, env);
break;
#endif #endif
} else /* (SCM_SYMBOLP (variable)) is known to be true */
x = SCM_CDR (x); location = scm_lookupcar (x, env, 1);
*t.lloc = EVALCAR (x, env); x = SCM_CDR (x);
#ifdef SICP *location = EVALCAR (x, env);
RETURN (*t.lloc); }
#else
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
#endif
case SCM_BIT8(SCM_IM_DEFINE): /* only for internal defines */ case SCM_BIT8(SCM_IM_DEFINE): /* only for internal defines */
scm_misc_error (NULL, "Bad define placement", SCM_EOL); scm_misc_error (NULL, "Bad define placement", SCM_EOL);
/* new syntactic forms go here. */ /* new syntactic forms go here. */
case SCM_BIT8(SCM_MAKISYM (0)): case SCM_BIT8(SCM_MAKISYM (0)):
proc = SCM_CAR (x); proc = SCM_CAR (x);