From de59692eb02f13f9ad2410254b3ab4023da60e0e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 3 May 2008 05:09:31 +0000
Subject: [PATCH] for-label and namespace-attach repairs

svn: r9618
---
 src/mzscheme/src/env.c    | 10 +++++++++-
 src/mzscheme/src/module.c | 21 ++++++++++++---------
 2 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c
index 0b7e554f1c..243f8bce7c 100644
--- a/src/mzscheme/src/env.c
+++ b/src/mzscheme/src/env.c
@@ -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;
diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c
index e86cb07d8a..5a7d158645 100644
--- a/src/mzscheme/src/module.c
+++ b/src/mzscheme/src/module.c
@@ -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)