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

Don't double-include eval.i.c -- let's only build deval.

Browse source 
* libguile/eval.c (SCM_I_XEVAL, SCM_I_XEVALCAR): No more debug_p args,
  we are always debugging. Adapt all callers.
  (ceval_letrec_inits): For some reason this function is used by deval.
  No idea why. Pull it out here.

* libguile/eval.i.c (SCM_APPLY): scm_dapply is scm_apply.
This commit is contained in:
Andy Wingo 2009-08-21 00:54:34 +02:00
parent 95e5998204
commit a4ac184963
2 changed files with 37 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

49
libguile/eval.c
View file

@ -74,8 +74,6 @@ static SCM unmemoize_exprs (SCM expr, SCM env);
static SCM canonicalize_define (SCM expr);
static SCM *scm_lookupcar1 (SCM vloc, SCM genv, int check);
static SCM unmemoize_builtin_macro (SCM expr, SCM env);
static void ceval_letrec_inits (SCM env, SCM init_forms, SCM **init_values_eol);
static SCM ceval (SCM x, SCM env);
static SCM deval (SCM x, SCM env);
@ -2589,15 +2587,11 @@ scm_badargsp (SCM formals, SCM args)
* memoized. Expressions that are not of the form '(<form> <form> ...)' are
* evaluated inline without calling an evaluator.
*
* This macro uses ceval or deval depending on its 3rd argument.
*
* SCM_I_XEVALCAR evaluates the car of an expression 'X:(Y:<form> <form> ...)',
* potentially replacing a symbol at the position Y:<form> by its memoized
* variable. If Y:<form> is not of the form '(<form> <form> ...)', the
* evaluation is performed inline without calling an evaluator.
*
* This macro uses ceval or deval depending on its 3rd argument.
*
*/
#define SCM_I_EVALIM2(x) \
@ -2610,26 +2604,22 @@ scm_badargsp (SCM formals, SCM args)
? *scm_ilookup ((x), (env)) \
: SCM_I_EVALIM2(x))
#define SCM_I_XEVAL(x, env, debug_p) \
#define SCM_I_XEVAL(x, env) \
(SCM_IMP (x) \
? SCM_I_EVALIM2 (x) \
: (SCM_VARIABLEP (x) \
? SCM_VARIABLE_REF (x) \
: (scm_is_pair (x) \
? (debug_p \
? deval ((x), (env)) \
: ceval ((x), (env))) \
: (x))))
#define SCM_I_XEVALCAR(x, env, debug_p) \
#define SCM_I_XEVALCAR(x, env) \
(SCM_IMP (SCM_CAR (x)) \
? SCM_I_EVALIM (SCM_CAR (x), (env)) \
: (SCM_VARIABLEP (SCM_CAR (x)) \
? SCM_VARIABLE_REF (SCM_CAR (x)) \
: (scm_is_pair (SCM_CAR (x)) \
? (debug_p \
? deval (SCM_CAR (x), (env)) \
: ceval (SCM_CAR (x), (env))) \
: (!scm_is_symbol (SCM_CAR (x)) \
? SCM_CAR (x) \
: *scm_lookupcar ((x), (env), 1)))))
@ -2891,7 +2881,7 @@ lazy_memoize_variable (const SCM symbol, const SCM environment)
SCM
scm_eval_car (SCM pair, SCM env)
{
return SCM_I_XEVALCAR (pair, env, scm_debug_mode_p);
return SCM_I_XEVALCAR (pair, env);
}
@ -2918,11 +2908,11 @@ scm_eval_body (SCM code, SCM env)
}
}
else
SCM_I_XEVAL (SCM_CAR (code), env, scm_debug_mode_p);
SCM_I_XEVAL (SCM_CAR (code), env);
code = next;
next = SCM_CDR (code);
}
return SCM_I_XEVALCAR (code, env, scm_debug_mode_p);
return SCM_I_XEVALCAR (code, env);
}
@ -3698,7 +3688,7 @@ scm_i_eval_x (SCM exp, SCM env)
if (scm_is_symbol (exp))
return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (exp, env, scm_debug_mode_p);
return SCM_I_XEVAL (exp, env);
}
SCM
@ -3708,7 +3698,7 @@ scm_i_eval (SCM exp, SCM env)
if (scm_is_symbol (exp))
return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (exp, env, scm_debug_mode_p);
return SCM_I_XEVAL (exp, env);
}
SCM
@ -3795,10 +3785,33 @@ SCM_DEFINE (scm_eval, "eval", 2, 0, 0,
/* At this point, deval and scm_dapply are generated.
*/
static void
ceval_letrec_inits (SCM env, SCM init_forms, SCM **init_values_eol)
{
SCM argv[10];
int i = 0, imax = sizeof (argv) / sizeof (SCM);
while (!scm_is_null (init_forms))
{
if (imax == i)
{
ceval_letrec_inits (env, init_forms, init_values_eol);
break;
}
argv[i++] = SCM_I_XEVALCAR (init_forms, env);
init_forms = SCM_CDR (init_forms);
}
for (i--; i >= 0; i--)
{
**init_values_eol = scm_list_1 (argv[i]);
*init_values_eol = SCM_CDRLOC (**init_values_eol);
}
}
#define DEVAL
#include "eval.i.c"
#undef DEVAL
#include "eval.i.c"
void

32
libguile/eval.i.c
View file

@ -35,7 +35,7 @@
#define EVAL_DEBUGGING_P 1
#define CEVAL deval /* Substitute all uses of ceval */
#define SCM_APPLY scm_dapply
#define SCM_APPLY scm_apply
#define PREP_APPLY(p, l) \
{ ++debug.info; debug.info->a.proc = p; debug.info->a.args = l; }
@ -71,7 +71,7 @@ deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
SCM *results = lloc;
while (scm_is_pair (l))
{
const SCM res = SCM_I_XEVALCAR (l, env, 1);
const SCM res = SCM_I_XEVALCAR (l, env);
*lloc = scm_list_1 (res);
lloc = SCM_CDRLOC (*lloc);
@ -106,30 +106,6 @@ deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
static void
ceval_letrec_inits (SCM env, SCM init_forms, SCM **init_values_eol)
{
SCM argv[10];
int i = 0, imax = sizeof (argv) / sizeof (SCM);
while (!scm_is_null (init_forms))
{
if (imax == i)
{
ceval_letrec_inits (env, init_forms, init_values_eol);
break;
}
argv[i++] = SCM_I_XEVALCAR (init_forms, env, 0);
init_forms = SCM_CDR (init_forms);
}
for (i--; i >= 0; i--)
{
**init_values_eol = scm_list_1 (argv[i]);
*init_values_eol = SCM_CDRLOC (**init_values_eol);
}
}
static SCM
scm_ceval_args (SCM l, SCM env, SCM proc)
{
@ -161,8 +137,8 @@ scm_eval_args (SCM l, SCM env, SCM proc)
#define EVAL(x, env) SCM_I_XEVAL(x, env, EVAL_DEBUGGING_P)
#define EVALCAR(x, env) SCM_I_XEVALCAR(x, env, EVAL_DEBUGGING_P)
#define EVAL(x, env) SCM_I_XEVAL(x, env)
#define EVALCAR(x, env) SCM_I_XEVALCAR(x, env)