fixes for submodules and `variable-reference->namespace'

Closes PR 12925

Merge to 5.3
(cherry picked from commit d95ec4d454)

collects/compiler/zo-structs.rkt

@@ -124,7 +124,7 @@
                                 [max-let-depth exact-nonnegative-integer?]
                                 [dummy toplevel?]
                                 [lang-info (or/c #f (vector/c module-path? symbol? any/c))]
-                                [internal-context (or/c #f #t stx?)]
+                                [internal-context (or/c #f #t stx? (listof stx?))]
                                 [pre-submodules (listof mod?)]
                                 [post-submodules (listof mod?)]))
 

collects/scribblings/raco/zo-struct.scrbl

@@ -173,7 +173,7 @@ structures that are produced by @racket[zo-parse] and consumed by
              [max-let-depth exact-nonnegative-integer?]
              [dummy toplevel?]
              [lang-info (or/c #f (vector/c module-path? symbol? any/c))]
-             [internal-context (or/c #f #t stx?)]
+             [internal-context (or/c #f #t stx? (listof stx?))]
              [pre-submodules (listof mod?)]
              [post-submodules (listof mod?)])]{
   Represents a @racket[module] declaration.

collects/tests/racket/submodule.rktl

@@ -711,6 +711,57 @@
   (attach-tests #f)
   (attach-tests #t))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; module->namespace
+
+(module check-to-namespace-1 racket/base
+  (module* main #f
+    (define x 10)
+    (define v
+      (eval 'x (variable-reference->namespace (#%variable-reference))))
+    (provide v)))
+
+(test 10 dynamic-require `(submod 'check-to-namespace-1 main) 'v)
+
+(module check-to-namespace-2 racket/base
+  (require racket/math)
+  (module* main #f
+    (define v
+      (eval 'pi (variable-reference->namespace (#%variable-reference))))
+    (provide v)))
+
+(require racket/math)
+(test pi dynamic-require `(submod 'check-to-namespace-2 main) 'v)
+
+(module check-to-namespace-3.0 racket/base
+  (define x 13)
+  (define v
+    (eval 'x (variable-reference->namespace (#%variable-reference))))
+  (provide v))
+
+(test 13 dynamic-require ''check-to-namespace-3.0 'v)
+
+(module check-to-namespace-3 racket/base
+  (define x 13)
+  (module* main #f
+    (define v
+      (eval 'x (variable-reference->namespace (#%variable-reference))))
+    (provide v)))
+
+(test 13 dynamic-require `(submod 'check-to-namespace-3 main) 'v)
+
+(let ([path (build-path (current-directory) "ctn-no-such-file.rkt")])
+  (parameterize ([current-module-declare-name (make-resolved-module-path path)])
+    (eval
+     '(module check-to-namespace-3 racket/base
+        (define x 130)
+        (module* main #f
+          (define v
+            (eval 'x (variable-reference->namespace (#%variable-reference))))
+          (provide v)))))
+  (test 130 dynamic-require `(submod ,path main) 'v))
+
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

src/racket/src/compenv.c

@@ -1951,7 +1951,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
       pos = 0;
     else
       pos = scheme_check_accessible_in_module(genv, env->insp, in_modidx, 
-					      find_id, src_find_id, NULL, NULL, rename_insp, -1, 1,
+					      find_id, src_find_id, NULL, env->insp, rename_insp, -1, 1,
 					      _protected, NULL, env->genv, NULL, &mod_constant);
     modpos = (int)SCHEME_INT_VAL(pos);
   } else

src/racket/src/module.c

@@ -122,6 +122,7 @@ typedef struct Module_Begin_Expand_State {
   Scheme_Hash_Table *modidx_cache;
   Scheme_Object *redef_modname;
   Scheme_Object *end_statementss; /* list of lists */
+  Scheme_Object *rn_stx;
 } Module_Begin_Expand_State;
 
 static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_Env *env, 
@@ -2912,17 +2913,45 @@ void scheme_prep_namespace_rename(Scheme_Env *menv)
 	m->rn_stx = rns;
       } else if (SCHEME_PAIRP(m->rn_stx)) {
 	/* Delayed shift: */
-	Scheme_Object *rn_stx, *midx;
+	Scheme_Object *vec, *vec2, *rn_stx, *midx;
-	rn_stx = SCHEME_CAR(m->rn_stx);
+        int i;
+
+	vec = SCHEME_CAR(m->rn_stx);
 	midx = SCHEME_CDR(m->rn_stx);
-	rns = scheme_stx_to_rename(rn_stx);
+        
-	rns = scheme_stx_shift_rename_set(rns, midx, m->self_modidx, m->insp);
+        if (!SCHEME_VECTORP(vec))
-	rn_stx = scheme_rename_to_stx(rns);
+          vec = scheme_make_vector(1, vec);
-	m->rn_stx = rn_stx;
+        vec2 = scheme_make_vector(SCHEME_VEC_SIZE(vec), NULL);
+
+        for (i = SCHEME_VEC_SIZE(vec); i--; ) {
+          rn_stx = SCHEME_VEC_ELS(vec)[i];
+          rns = scheme_stx_to_rename(rn_stx);
+          rns = scheme_stx_shift_rename_set(rns, midx, m->self_modidx, m->insp);
+          rn_stx = scheme_rename_to_stx(rns);
+          SCHEME_VEC_ELS(vec2)[i] = rn_stx;
+        }
+
+	m->rn_stx = vec2;
+      }
+
+      /* add rename(s) to the environment's rename: */
+      {
+        int i;
+        Scheme_Object *vec = m->rn_stx, *prior = NULL;
+
+        if (!SCHEME_VECTORP(vec)) {
+          vec = scheme_make_vector(1, vec);
+          m->rn_stx = vec;
+        }
+
+        for (i = SCHEME_VEC_SIZE(vec); i--; ) {
+          rns = scheme_stx_to_rename(SCHEME_VEC_ELS(vec)[i]);
+          scheme_append_rename_set_to_env(rns, menv);
+          prior = scheme_accum_prior_contexts(rns, prior);
+        }
+        scheme_install_prior_contexts_to_env(prior, menv);
       }
 
-      rns = scheme_stx_to_rename(m->rn_stx);
-      scheme_append_rename_set_to_env(rns, menv);
       menv->rename_set_ready = 1;
     }
   }
@@ -6898,7 +6927,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
                               scheme_false);
   } else {
     void **super_bxs_info;
-    Scheme_Object *rn;
+    Scheme_Object *rn, *rnss, *rnss2, *rn2;
 
     iidx = scheme_make_modidx(scheme_make_pair(submod_symbol,
                                                scheme_make_pair(scheme_make_utf8_string(".."),
@@ -6913,13 +6942,24 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
                                           menv->module_registry->exports,
                                           env->insp, NULL);
 
-    super_bxs_info = MALLOC_N(void*, 6);
+    rnss2 = scheme_null;
+    for (rnss = super_bxs->rn_stx; SCHEME_PAIRP(rnss); rnss = SCHEME_CDR(rnss)) {
+      rn2 = scheme_stx_to_rename(SCHEME_CAR(rnss));
+      rn2 = scheme_stx_shift_rename_set(rn2,
+                                        top_env->module->self_modidx, iidx, 
+                                        env->insp);
+      rnss2 = scheme_make_pair(scheme_rename_to_stx(rn2), rnss2);
+    }
+    rnss2 = scheme_reverse(rnss2);
+    
+    super_bxs_info = MALLOC_N(void*, 7);
     super_bxs_info[0] = super_bxs;
     super_bxs_info[1] = rn;
     super_bxs_info[2] = top_env->module->self_modidx;
     super_bxs_info[3] = iidx;
     super_bxs_info[4] = top_env;
     super_bxs_info[5] = super_phase_shift;
+    super_bxs_info[6] = rnss2;
     m->super_bxs_info = super_bxs_info;
   }
 
@@ -7639,7 +7679,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
   Scheme_Module_Export_Info **exp_infos, *exp_info;
   Scheme_Module_Phase_Exports *pt;
   Scheme_Object *post_ex_rn_set; /* phase -> post_ex_rn-like rename */
-  Scheme_Object *form, *redef_modname, *rn_set, *observer, **exis, *body_lists, *expanded_l;
+  Scheme_Object *form, *redef_modname, *rn_set, *observer, **exis, *body_lists, *expanded_l, *rn_stx;
   Scheme_Env *genv;
   Module_Begin_Expand_State *bxs;
   Scheme_Expand_Info crec;
@@ -7664,18 +7704,12 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
 
   modidx_cache = scheme_make_hash_table_equal();
 
-  rn_set = env->genv->rename_set;
-  {
-    Scheme_Object *v;
-    v = scheme_rename_to_stx(rn_set);
-    env->genv->module->rn_stx = v;
-  }
-
   all_provided = scheme_make_hash_table_equal();
   all_reprovided = scheme_make_hash_table_equal();
   all_defs = scheme_make_hash_tree(1);
   all_defs_out = scheme_make_hash_table_equal();
 
+  rn_set = env->genv->rename_set;
   post_ex_rn_set = scheme_make_module_rename_set(mzMOD_RENAME_MARKED, rn_set, env->genv->module->insp);
 
   /* It's possible that #%module-begin expansion introduces
@@ -7691,6 +7725,22 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
   all_simple_renames = (int *)scheme_malloc_atomic(sizeof(int));
   *all_simple_renames = 1;
 
+  if (env->genv->module->super_bxs_info) {
+    rn_stx = scheme_rename_to_stx(post_ex_rn_set);
+    *all_simple_renames = 0;
+  } else
+    rn_stx = scheme_rename_to_stx(rn_set);
+  if (env->genv->module->super_bxs_info && env->genv->module->super_bxs_info[6])
+    rn_stx = scheme_make_pair(rn_stx, env->genv->module->super_bxs_info[6]);
+  {
+    Scheme_Object *v;
+    if (SCHEME_PAIRP(rn_stx))
+      v = scheme_list_to_vector(rn_stx); 
+   else
+      v = rn_stx;
+    env->genv->module->rn_stx = v;
+  }
+
   bxs = scheme_malloc(sizeof(Module_Begin_Expand_State));
   bxs->post_ex_rn_set = post_ex_rn_set;
   bxs->tables = tables;
@@ -7974,6 +8024,10 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
       (void)do_module_execute(o, env->genv, 0, 1, root_module_name, NULL);
     }
 
+    if (!SCHEME_PAIRP(rn_stx))
+      rn_stx = scheme_make_pair(rn_stx, scheme_null);
+    bxs->rn_stx = rn_stx;
+
     if (!rec[drec].comp && (is_modulestar_stop(env))) {
       Scheme_Object *l = bxs->saved_submodules;
       expanded_modules =  NULL;

src/racket/src/schpriv.h

@@ -1007,6 +1007,8 @@ Scheme_Object *scheme_get_module_rename_from_set(Scheme_Object *set, Scheme_Obje
 Scheme_Hash_Table *scheme_get_module_rename_marked_names(Scheme_Object *set, Scheme_Object *phase, int create);
 
 void scheme_append_rename_set_to_env(Scheme_Object *rns, Scheme_Env *env);
+void scheme_install_prior_contexts_to_env(Scheme_Object *prior, Scheme_Env *env);
+Scheme_Object *scheme_accum_prior_contexts(Scheme_Object *rns, Scheme_Object *prior);
 
 void scheme_seal_module_rename(Scheme_Object *rn, int level);
 void scheme_seal_module_rename_set(Scheme_Object *rns, int level);
@@ -3122,7 +3124,7 @@ typedef struct Scheme_Module
 
   Scheme_Env *primitive;
 
-  Scheme_Object *rn_stx;
+  Scheme_Object *rn_stx; /* NULL, #t, a stx for a rename, a vector of stxes, or a pair to delay shifts */
 
   Scheme_Object *submodule_path; /* path to this module relative to enclosing top-level module */
   Scheme_Object *pre_submodules, *post_submodules; /* list of modules (when compiled or loaded as a group) */

src/racket/src/syntax.c

@@ -170,6 +170,7 @@ typedef struct Module_Renames_Set {
   Scheme_Object so; /* scheme_rename_table_set_type */
   char kind, sealed;
   Scheme_Object *set_identity;
+  Scheme_Object *prior_contexts; /* for module->namespace */
   Module_Renames *rt, *et;
   Scheme_Hash_Table *other_phases;
   Scheme_Object *share_marked_names; /* a Module_Renames_Set */
@@ -1634,6 +1635,23 @@ void scheme_append_rename_set_to_env(Scheme_Object *_mrns, Scheme_Env *env)
   }
 }
 
+void scheme_install_prior_contexts_to_env(Scheme_Object *prior, Scheme_Env *env)
+{
+  if (prior) {
+    prior = SCHEME_CDR(prior);
+    if (!SCHEME_NULLP(prior)) {
+      ((Module_Renames_Set *)env->rename_set)->prior_contexts = prior;
+    }
+  }
+}
+
+Scheme_Object *scheme_accum_prior_contexts(Scheme_Object *rns, Scheme_Object *prior)
+{
+  if (!prior)
+    prior = scheme_null;
+  return scheme_make_pair(((Module_Renames_Set *)rns)->set_identity, prior);
+}
+
 void scheme_remove_module_rename(Scheme_Object *mrn,
 				 Scheme_Object *localname)
 {
@@ -1715,6 +1733,9 @@ Scheme_Object *scheme_stx_to_rename(Scheme_Object *stx)
       if (!rns) {
         rns = scheme_make_module_rename_set(((Module_Renames *)v)->kind, NULL, NULL);
         ((Module_Renames_Set *)rns)->set_identity = ((Module_Renames *)v)->set_identity;
+      } else if (!SAME_OBJ(((Module_Renames_Set *)rns)->set_identity,
+                           ((Module_Renames *)v)->set_identity)) {
+        scheme_signal_error("can't convert syntax to rename (identity mismatch)");
       }
       scheme_add_module_rename_to_set(rns, v);
     } else {
@@ -1798,6 +1819,8 @@ Scheme_Object *scheme_stx_shift_rename_set(Scheme_Object *_mrns,
 
   mrns2 = scheme_make_module_rename_set(mrns->kind, NULL, new_insp);
   ((Module_Renames_Set *)mrns2)->sealed = mrns->sealed;
+  ((Module_Renames_Set *)mrns2)->set_identity = mrns->set_identity;
+  
   if (mrns->rt) {
     mrn = scheme_stx_shift_rename((Scheme_Object *)mrns->rt, old_midx, new_midx, new_insp);
     scheme_add_module_rename_to_set(mrns2, mrn);
@@ -3084,6 +3107,21 @@ static Scheme_Object *get_old_module_env(Scheme_Object *stx)
 
         kind = mrns->kind;
         set_identity = mrns->set_identity;
+
+        if (mrns->prior_contexts) {
+          /* A rename-set with a prior context should be last */
+          if (SCHEME_FALSEP(result_id)) {
+            result_id = mrns->prior_contexts;
+            if (SCHEME_NULLP(SCHEME_CDR(result_id)))
+              result_id = SCHEME_CAR(result_id);
+          } else {
+            if (!SCHEME_PAIRP(result_id)) {
+              result_id = scheme_make_pair(result_id, scheme_null);
+              last_pr = result_id;
+            }
+            SCHEME_CDR(last_pr) = mrns->prior_contexts;
+          }
+        }
       }
 
       if ((kind != mzMOD_RENAME_TOPLEVEL)