diff options
author | Marius Vollmer <mvo@zagadka.de> | 2001-02-11 18:13:07 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2001-02-11 18:13:07 +0000 |
commit | 4163eb7236d7a2bf0429844f20eeeb482e938ecb (patch) | |
tree | 1c37f1e8bdaf3ba23707a03cced96b35206c1cfc | |
parent | 083629bea45242d2d38d8cb6b89e84d8df7f06ff (diff) | |
download | guile-4163eb7236d7a2bf0429844f20eeeb482e938ecb.tar.gz |
* eval.c (scm_ceval, scm_deval): Recognize when `begin' is being
evaluated at top-level and synronize lookup closure before
executing every subform.
(scm_primitve_eval_x, scm_primitive_eval): New functions.
(scm_eval_x, scm_eval): Reimplement in terms of
scm_primitive_eval_x and scm_primitive_eval, respectively.
-rw-r--r-- | libguile/eval.c | 164 |
1 files changed, 120 insertions, 44 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index b8479e4bf..06d2af0c6 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1904,20 +1904,37 @@ dispatch: x = SCM_CDR (x); begin: - t.arg1 = x; - while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1))) + /* If we are on toplevel with a lookup closure, we need to sync + with the current module. */ + if (SCM_CONSP(env) && !SCM_CONSP(SCM_CAR(env))) + { + t.arg1 = x; + while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1))) + { + SCM_SETCAR (env, scm_current_module_lookup_closure ()); + SCM_CEVAL (SCM_CAR (x), env); + x = t.arg1; + } + /* once more, for the last form */ + SCM_SETCAR (env, scm_current_module_lookup_closure ()); + } + else { - if (SCM_IMP (SCM_CAR (x))) + t.arg1 = x; + while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1))) { - if (SCM_ISYMP (SCM_CAR (x))) + if (SCM_IMP (SCM_CAR (x))) { - x = scm_m_expand_body (x, env); - goto begin; + if (SCM_ISYMP (SCM_CAR (x))) + { + x = scm_m_expand_body (x, env); + goto begin; + } } + else + SCM_CEVAL (SCM_CAR (x), env); + x = t.arg1; } - else - SCM_CEVAL (SCM_CAR (x), env); - x = t.arg1; } carloop: /* scm_eval car of last form in list */ @@ -3782,8 +3799,47 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0, #undef FUNC_NAME +/* We have three levels of EVAL here: + + - scm_i_eval (exp, env) + + evaluates EXP in environment ENV. ENV is a lexical environment + structure as used by the actual tree code evaluator. When ENV is + a top-level environment, then changes to the current module are + tracked by modifying ENV so that it continues to be in sync with + the current module. + + - scm_primitive_eval (exp) + + evaluates EXP in the top-level environment as determined by the + current module. This is done by constructing a suitable + environment and calling scm_i_eval. Thus, changes to the + top-level module are tracked normally. + + - scm_eval (exp, mod) + + evaluates EXP while MOD is the current module. Thius is done by + setting the current module to MOD, invoking scm_primitive_eval on + EXP, and then restoring the current module to the value it had + previously. That is, while EXP is evaluated, changes to the + current module are tracked, but these changes do not persist when + scm_eval returns. + + For each level of evals, there are two variants, distinguished by a + _x suffix: the ordinary variant does not modify EXP while the _x + variant can destructively modify EXP into something completely + unintelligible. A Scheme data structure passed as EXP to one of the + _x variants should not ever be used again for anything. So when in + doubt, use the ordinary variant. + +*/ + SCM scm_system_transformer; +// XXX - scm_i_eval is meant to be useable for evaluation in +// non-toplevel environments, for example when used by the debugger. +// Can the system transform deal with this? + SCM scm_i_eval_x (SCM exp, SCM env) { @@ -3803,17 +3859,27 @@ scm_i_eval (SCM exp, SCM env) } SCM -scm_eval_x (SCM exp, SCM module) +scm_primitive_eval_x (SCM exp) { - return scm_i_eval_x (exp, - scm_top_level_env (SCM_MODULE_EVAL_CLOSURE (module))); + SCM env = scm_top_level_env (scm_current_module_lookup_closure ()); + return scm_i_eval_x (exp, env); } +SCM_DEFINE (scm_primitive_eval, "primitive-eval", 1, 0, 0, + (SCM exp), + "Evaluate @var{epx} in the top-level environment specified by\n" + "the current module.") +#define FUNC_NAME s_scm_primitive_eval +{ + SCM env = scm_top_level_env (scm_current_module_lookup_closure ()); + return scm_i_eval (exp, env); +} +#undef FUNC_NAME + /* Eval does not take the second arg optionally. This is intentional * in order to be R5RS compatible, and to prepare for the new module * system, where we would like to make the choice of evaluation - * environment explicit. - */ + * environment explicit. */ static void change_environment (void *data) @@ -3826,22 +3892,6 @@ change_environment (void *data) } -static SCM -inner_eval (void *data) -{ - SCM pair = SCM_PACK (data); - SCM exp = SCM_CAR (pair); - SCM env = SCM_CDR (pair); - SCM transformer = scm_fluid_ref (SCM_CDR (scm_system_transformer)); - - exp = scm_copy_tree (exp); - if (SCM_NIMP (transformer)) - exp = scm_apply (transformer, exp, scm_listofnull); - - return SCM_XEVAL (exp, env); -} - - static void restore_environment (void *data) { @@ -3852,23 +3902,46 @@ restore_environment (void *data) scm_set_current_module (old_module); } +static SCM +inner_eval_x (void *data) +{ + return scm_primitive_eval_x (SCM_PACK(data)); +} + +SCM +scm_eval_x (SCM exp, SCM module) +#define FUNC_NAME "eval!" +{ + SCM_VALIDATE_MODULE (2, module); + + return scm_internal_dynamic_wind + (change_environment, inner_eval_x, restore_environment, + (void *) SCM_UNPACK (exp), + (void *) SCM_UNPACK (scm_cons (module, SCM_BOOL_F))); +} +#undef FUNC_NAME + +static SCM +inner_eval (void *data) +{ + return scm_primitive_eval (SCM_PACK(data)); +} SCM_DEFINE (scm_eval, "eval", 2, 0, 0, - (SCM exp, SCM environment), - "Evaluate @var{exp}, a list representing a Scheme expression, in the\n" - "environment given by @var{environment specifier}.") + (SCM exp, SCM module), + "Evaluate @var{exp}, a list representing a Scheme expression,\n" + "in the top-level environment specified by @var{module}.\n" + "While @var{exp} is evaluated (using @var{primitive-eval}),\n" + "@var{module} is made the current module. The current module\n" + "is reset to its previous value when @var{eval} returns.") #define FUNC_NAME s_scm_eval { - SCM env_closure; - - SCM_VALIDATE_MODULE (2, environment); - - env_closure = scm_top_level_env (SCM_MODULE_EVAL_CLOSURE (environment)); + SCM_VALIDATE_MODULE (2, module); return scm_internal_dynamic_wind (change_environment, inner_eval, restore_environment, - (void *) SCM_UNPACK (scm_cons (exp, env_closure)), - (void *) SCM_UNPACK (scm_cons (environment, SCM_BOOL_F))); + (void *) SCM_UNPACK (exp), + (void *) SCM_UNPACK (scm_cons (module, SCM_BOOL_F))); } #undef FUNC_NAME @@ -3885,7 +3958,8 @@ SCM scm_top_level_lookup_closure_var; /* Avoid using this functionality altogether (except for implementing * libguile, where you can use scm_i_eval or scm_i_eval_x). * - * Applications should use either C level scm_eval_x or Scheme scm_eval. */ + * Applications should use either C level scm_eval_x or Scheme + * scm_eval; or scm_primitive_eval_x or scm_primitive_eval. */ SCM scm_eval_3 (SCM obj, int copyp, SCM env) @@ -3898,9 +3972,11 @@ scm_eval_3 (SCM obj, int copyp, SCM env) SCM_DEFINE (scm_eval2, "eval2", 2, 0, 0, (SCM obj, SCM env_thunk), - "Evaluate @var{exp}, a Scheme expression, in the environment designated\n" - "by @var{lookup}, a symbol-lookup function. @code{(eval exp)} is\n" - "equivalent to @code{(eval2 exp *top-level-lookup-closure*)}.") + "Evaluate @var{exp}, a Scheme expression, in the environment\n" + "designated by @var{lookup}, a symbol-lookup function." + "Do not use this version of eval, it does not play well\n" + "with the module system. Use @code{eval} or\n" + "@code{primitive-eval} instead.") #define FUNC_NAME s_scm_eval2 { return scm_i_eval (obj, scm_top_level_env (env_thunk)); |