suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix problem with re-declaring modules (especially with syntax objects in compile-time expressions), and remove some debugging code that was accidentally left in the previous change

Browse Source 
svn: r14672
This commit is contained in:
Matthew Flatt 2009-05-01 03:36:27 +00:00
parent 2b8b10dd40
commit f3bc79c2db
3 changed files with 41 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/mzscheme/src/env.c
View File

@ -4508,15 +4508,8 @@ local_module_introduce(int argc, Scheme_Object *argv[])
v = scheme_stx_source_module(s, 0);
if (SCHEME_FALSEP(v)) {
if (env->genv->module) {
if (env->genv->module->rn_stx && !SAME_OBJ(scheme_true, env->genv->module->rn_stx)) {
v = scheme_stx_to_rename(env->genv->module->rn_stx);
s = scheme_add_rename(s, v);
}
} else {
if (env->genv->rename_set)
s = scheme_add_rename(s, env->genv->rename_set);
}
if (env->genv->rename_set)
s = scheme_add_rename(s, env->genv->rename_set);
}
return s;

63
src/mzscheme/src/module.c
View File

@ -3823,31 +3823,45 @@ static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int res
menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(env->modchain), m->modname);
if (!menv || restart) {
if (!menv) {
Scheme_Object *insp;
Scheme_Object *insp;
if (!menv) {
/* printf("new %ld %s\n", env->phase, SCHEME_SYM_VAL(m->modname)); */
menv = scheme_new_module_env(env, m, 0);
scheme_hash_set(MODCHAIN_TABLE(env->modchain), m->modname, (Scheme_Object *)menv);
/* These three should be set by various "finish"es, but
we initialize them in case there's an error runing a "finish". */
menv->require_names = scheme_null;
menv->et_require_names = scheme_null;
menv->tt_require_names = scheme_null;
menv->dt_require_names = scheme_null;
menv->phase = env->phase;
menv->link_midx = syntax_idx;
insp = scheme_make_inspector(m->insp);
menv->insp = insp;
} else {
Scheme_Env *env2;
menv->module = m;
menv->running = 0;
menv->et_running = 0;
menv->ran = 0;
menv->did_starts = NULL;
for (env2 = menv->exp_env; env2; env2 = env2->exp_env) {
env2->module = m;
}
for (env2 = menv->template_env; env2; env2 = env2->template_env) {
env2->module = m;
}
env2 = menv->label_env;
if (env2)
env2->module = m;
}
insp = scheme_make_inspector(m->insp);
menv->insp = insp;
/* These three should be set by various "finish"es, but
we initialize them in case there's an error runing a "finish". */
menv->require_names = scheme_null;
menv->et_require_names = scheme_null;
menv->tt_require_names = scheme_null;
menv->dt_require_names = scheme_null;
if (env->label_env != env) {
setup_accessible_table(m);
@ -3965,9 +3979,6 @@ static void do_start_module(Scheme_Module *m, Scheme_Env *menv, Scheme_Env *env,
return;
}
if (restart)
menv->running = 0;
if (menv->running > 0) {
return;
}
@ -4001,6 +4012,7 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
{
Scheme_Env *menv;
Scheme_Object *l, *new_cycle_list;
int prep_namespace = 0;
if (SAME_OBJ(m, kernel))
return;
@ -4019,15 +4031,6 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
check_phase(menv, env, 0);
if (restart) {
menv->did_starts = NULL;
menv->require_names = NULL;
menv->et_require_names = NULL;
menv->tt_require_names = NULL;
menv->dt_require_names = NULL;
menv->other_require_names = NULL;
}
show("chck", menv, eval_exp, eval_run, base_phase);
if (did_start(menv->did_starts, base_phase, eval_exp, eval_run))
@ -4044,6 +4047,13 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
chain_start_module(menv, env, eval_exp, eval_run, base_phase, cycle_list, syntax_idx);
if (restart) {
if (menv->rename_set_ready) {
menv->rename_set_ready = 0;
prep_namespace = 1;
}
}
if (env->phase == base_phase) {
if (eval_exp) {
if (eval_exp > 0) {
@ -4079,6 +4089,9 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
show_indent(-1);
show_done("done", menv, eval_exp, eval_run, base_phase);
if (prep_namespace)
scheme_prep_namespace_rename(menv);
}
static void do_prepare_compile_env(Scheme_Env *env, int base_phase, int pos)
@ -4677,7 +4690,7 @@ module_execute(Scheme_Object *data)
if (!SCHEME_SYMBOLP(m->self_modidx)) {
Scheme_Modidx *midx = (Scheme_Modidx *)m->self_modidx;
Scheme_Object *nmidx;
nmidx = scheme_make_modidx(midx->path, midx->base, m->modname);
m->self_modidx = nmidx;
@ -4749,7 +4762,7 @@ module_execute(Scheme_Object *data)
/* Replacing an already-running or already-syntaxing module? */
if (old_menv) {
start_module(m, env, 1, NULL, 0, (old_menv->running > 0) ? 1 : 0, env->phase, scheme_null);
start_module(m, env, 1, NULL, old_menv->et_running, old_menv->running, env->phase, scheme_null);
}
return scheme_void;

10
src/mzscheme/src/stxobj.c
View File

@ -3442,7 +3442,7 @@ static Scheme_Object *check_floating_id(Scheme_Object *stx)
return scheme_false;
}
#define EXPLAIN_RESOLVE 1
#define EXPLAIN_RESOLVE 0
#if EXPLAIN_RESOLVE
int scheme_explain_resolves = 0;
# define EXPLAIN(x) if (scheme_explain_resolves) { x; }
@ -8350,14 +8350,6 @@ static Scheme_Object *syntax_property_keys(int argc, Scheme_Object **argv)
if (!SCHEME_STXP(argv[0]))
scheme_wrong_type("syntax-property-symbol-keys", "syntax", 0, argc, argv);
// REMOVEME
{
scheme_explain_resolves++;
resolve_env(NULL, argv[0], scheme_make_integer(0),
1, NULL, NULL, NULL, NULL, 0, NULL);
--scheme_explain_resolves;
}
stx = (Scheme_Stx *)argv[0];
if (stx->props) {