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

for-label and namespace-attach repairs

Browse Source 
svn: r9618
This commit is contained in:
Matthew Flatt 2008-05-03 05:09:31 +00:00
parent 1dd30ca031
commit de59692eb0
2 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -745,7 +745,7 @@ static Scheme_Env *make_env(Scheme_Env *base, int semi, int toplevel_size)
Scheme_Bucket_Table *toplevel, *syntax;
Scheme_Hash_Table *module_registry, *export_registry;
Scheme_Object *modchain;
Scheme_Env *env;
Scheme_Env *env, *label_env;
toplevel = scheme_make_bucket_table(toplevel_size, SCHEME_hash_ptr);
toplevel->with_home = 1;
@ -755,17 +755,20 @@ static Scheme_Env *make_env(Scheme_Env *base, int semi, int toplevel_size)
modchain = NULL;
module_registry = NULL;
export_registry = NULL;
label_env = NULL;
} else {
syntax = scheme_make_bucket_table(7, SCHEME_hash_ptr);
if (base) {
modchain = base->modchain;
module_registry = base->module_registry;
export_registry = base->export_registry;
label_env = base->label_env;
} else {
if (semi < 0) {
module_registry = NULL;
export_registry = NULL;
modchain = NULL;
label_env = NULL;
} else {
Scheme_Hash_Table *modules;
@ -777,6 +780,8 @@ static Scheme_Env *make_env(Scheme_Env *base, int semi, int toplevel_size)
module_registry->iso.so.type = scheme_module_registry_type;
export_registry = scheme_make_hash_table(SCHEME_hash_ptr);
label_env = NULL;
}
}
}
@ -786,6 +791,8 @@ static Scheme_Env *make_env(Scheme_Env *base, int semi, int toplevel_size)
env->toplevel = toplevel;
env->label_env = label_env;
if (semi < 1) {
env->syntax = syntax;
env->modchain = modchain;
@ -987,6 +994,7 @@ Scheme_Env *scheme_clone_module_env(Scheme_Env *menv, Scheme_Env *ns, Scheme_Obj
menv2->exp_env->toplevel = menv->exp_env->toplevel;
}
scheme_prepare_label_env(ns);
menv2->label_env = ns->label_env;
return menv2;

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

@ -1383,7 +1383,6 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
if (!same_namespace) {
l = menv->dt_require_names;
if (l) {
/* Need (phaseless) declaration, only */
while (!SCHEME_NULLP(l)) {
name = scheme_module_resolve(SCHEME_CAR(l), 0);
@ -1504,6 +1503,9 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
LOG_ATTACH(printf("Done phase: %d\n", phase));
if (SCHEME_PAIRP(nophase_todo) && !from_env->label_env)
scheme_signal_error("internal error: missing label environment");
/* Recursively process phase-#f modules: */
while (!SCHEME_NULLP(nophase_todo)) {
name = SCHEME_CAR(nophase_todo);
@ -1608,7 +1610,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(from_env->label_env->modchain), name);
menv2 = scheme_clone_module_env(menv, to_env->label_env, to_env->label_env->modchain);
scheme_hash_set(MODCHAIN_TABLE(from_env->label_env->modchain), name, (Scheme_Object *)menv2);
scheme_hash_set(MODCHAIN_TABLE(to_env->label_env->modchain), name, (Scheme_Object *)menv2);
if (menv->attached)
menv2->attached = 1;
@ -1654,14 +1656,15 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
menv2 = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(to_modchain), name);
if (!menv2) {
/* Clone menv for the new namespace: */
menv2 = scheme_clone_module_env(menv, to_env, to_modchain);
if (menv->attached)
menv2->attached = 1;
if (phase >= 0)
if (phase >= 0) {
menv2 = scheme_clone_module_env(menv, to_env, to_modchain);
if (menv->attached)
menv2->attached = 1;
scheme_hash_set(MODCHAIN_TABLE(to_modchain), name, (Scheme_Object *)menv2);
scheme_hash_set(to_env->module_registry, name, (Scheme_Object *)menv2->module);
scheme_hash_set(to_env->export_registry, name, (Scheme_Object *)menv2->module->me);
}
scheme_hash_set(to_env->module_registry, name, (Scheme_Object *)menv->module);
scheme_hash_set(to_env->export_registry, name, (Scheme_Object *)menv->module->me);
/* Push name onto notify list: */
if (!same_namespace)