add context properties to a module expansion

Add 'module-body-inside-context, 'module-body-outside-context, and
'module-body-context-simple? properties to the expansion of a
`module` form. These properties expose scopes that are used by
`module->namespace` and taht appear in marshaled bytecode.

pkgs/racket-doc/scribblings/raco/zo-struct.scrbl

@@ -274,12 +274,17 @@ binding, constructor, etc.}
   The @racket[lang-info] value specifies an optional module path that
   provides information about the module's implementation language.
 
-  The @racket[internal-context] value describes the lexical
+  The @racket[internal-context] value describes the lexical context of
-  context of the body of the module.  This value is used by
+  the body of the module. This value is used by
-  @racket[module->namespace].  A @racket[#f] value means that the
+  @racket[module->namespace]. A @racket[#f] value means that the
-  context is unavailable or empty.  A @racket[#t] value means that the
+  context is unavailable or empty. A @racket[#t] value means that the
-  context is computed by re-importing all required modules.  A
+  context is computed by re-importing all required modules. A
-  syntax-object value embeds an arbitrary lexical context.
+  syntax-object value embeds lexical information; the syntax object
+  should contain a vector of two elements, where the first element of
+  the vector is a syntax object for the module's body, which includes
+  the outside-edge and inside-edge scopes, and the second element of
+  the vector is a syntax object that has just the module's inside-edge
+  scope.
 
   The @racket[binding-names] value provides additional information to
   @racket[module->namespace] to correlate symbol names for variables

pkgs/racket-doc/scribblings/reference/stx-expand.scrbl

@@ -105,6 +105,14 @@ to the syntax object:
  list of @tech{module path index}es (or symbols) representing the
  modules explicitly for-template imported into the module.}
 
+ @item{@indexed-racket['module-direct-for-meta-requires] --- a list of
+ lists: each list is an integer or @racket[#f] representing a
+ @tech{phase level} followed by a list of @tech{module path index}es
+ (or symbols) representing the modules explicitly imported into the
+ module at the corresponding phase.
+
+ @history[#:added "6.4.0.1"]}
+
  @item{@indexed-racket['module-variable-provides] --- a list of
  provided items, where each item is one of the following:
  
@@ -138,5 +146,35 @@ to the syntax object:
  be exported indirectly through macro expansions.  Definitions of
  macro-generated identifiers create uninterned symbols in this list.}
 
+ @item{@indexed-racket['module-body-inside-context] --- a syntax
+ object whose @tech{lexical information} corresponds to the inside of
+ the module, so it includes the expansion's @tech{outside-edge scope}
+ and its @tech{inside-edge scope}; that is, the syntax object
+ simulates an identifier that is present in the original module body
+ and inaccessible to manipulation by any macro, so that its lexical
+ information includes bindings for the module's imports and
+ definitions.
+
+ @history[#:added "6.4.0.1"]}
+
+ @item{@indexed-racket['module-body-outside-context] --- a syntax
+ object whose @tech{lexical information} corresponds to an identifier
+ that starts with no lexical context and is moved into the macro, so
+ that it includes only the expansions's @tech{inside-edge scope}.
+
+ @history[#:added "6.4.0.1"]}
+
+ @item{@indexed-racket['module-body-context-simple?] --- a boolean,
+ where @racket[#t] indicates that the bindings of the module's body
+ (as recorded in the @tech{lexical information} of the value of the
+ @racket['module-body-inside-context] property) can be directly
+ reconstructed from the values of @racket['module-direct-requires],
+ @racket['module-direct-for-syntax-requires],
+ @racket['module-direct-for-template-requires], and
+ @racket['module-direct-for-meta-requires].
+
+ @history[#:added "6.4.0.1"]}
+
+
 ]
 

pkgs/racket-doc/scribblings/reference/syntax-model.scrbl

@@ -742,9 +742,7 @@ internal-definition context are equivalent to local binding via
 @racket[letrec-syntaxes+values]; macro expansion converts internal
 definitions to a @racket[letrec-syntaxes+values] form.
 
-Expansion of an internal-definition context begins with the
+Expansion relies on @tech{partial expansion} of each @racket[_body] in
-introduction of a fresh @tech{scope} for the context. Thereafter,
-expansion relies on @tech{partial expansion} of each @racket[_body] in
 an internal-definition sequence. Partial expansion of each
 @racket[_body] produces a form matching one of the following cases:
 
@@ -782,8 +780,25 @@ are then converted to bindings in a @racket[letrec-syntaxes+values]
 form, and all expressions after the last definition become the body of
 the @racket[letrec-syntaxes+values] form.
 
+Before partial expansion begins, expansion of an internal-definition
+context begins with the introduction of a fresh @deftech{outside-edge
+scope} on the content of the internal-definition context. This
+outside-edge scope effectively identifies syntax objects that are
+present in the original form. An @deftech{inside-edge scope} is also
+created and added to the original content; furthermore, the
+inside-edge scope is added to the result of any partial expansion.
+This inside-edge scope ensures that all bindings introduced by the
+internal-definition context have a particular scope in common.
+
 @;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-@subsection[#:tag "mod-parse"]{Module Phases and Visits}
+@subsection[#:tag "mod-parse"]{Module Expansion, Phases, and Visits}
+
+Expansion of a @racket[module] form proceeds in a similar way to
+@seclink["intdef-body"]{expansion of an internal-definition context}:
+an @tech{outside-edge scope} is created for the original module
+content, and an @tech{inside-edge scope} is added to both the original
+module and any form that appears during a partial expansion of the
+module's top-level forms to uncover definitions and imports.
 
 A @racket[require] form not only introduces @tech{bindings} at
 expansion time, but also @deftech{visits} the referenced module when

pkgs/racket-test-core/tests/racket/module.rktl

@@ -1719,6 +1719,35 @@ case of module-leve bindings; it doesn't cover local bindings.
 (require 'exports-x**-as-x)
 (test 5 'five (x))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check 'module-body-context-simple? and 'module-body-...context properties
+
+(define (check-module-body-context-properties with-kar?)
+  (define m (expand `(module m racket/base
+                      ,@(if with-kar?
+                            `((require (rename-in racket/base [car kar])))
+                            null)
+                      (define inside 7))))
+  
+  (test (not with-kar?) syntax-property m 'module-body-context-simple?)
+
+  (define i (syntax-property m 'module-body-inside-context))
+  (define o (syntax-property m 'module-body-outside-context))
+  
+  (test #t syntax? i)
+  (test #t syntax? o)
+  
+  (test car eval-syntax (datum->syntax i 'car))
+  (test 'inside cadr (identifier-binding (datum->syntax i 'inside)))
+  (test #f identifier-binding (datum->syntax o 'inside))
+  (test (if with-kar? 'car #f)
+        'kar-binding
+        (let ([v (identifier-binding (datum->syntax i 'kar))])
+          (and v (cadr v)))))
+
+(check-module-body-context-properties #f)
+(check-module-body-context-properties #t)
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/src/racket/src/module.c

@@ -7434,7 +7434,13 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
 
     fm = scheme_datum_to_syntax(fm, form, ctx_form, 0, 2);
 
+    /* for future expansion, shift away from self_modidx: */
+    ps = scheme_make_shift(NULL, self_modidx, this_empty_self_modidx, NULL, NULL, NULL);
+    fm = scheme_stx_add_shift(fm, ps);
+    
     if (hints) {
+      Scheme_Object *stx, *l;
+
       fm = scheme_stx_property(fm, 
 			       scheme_intern_symbol("module-direct-requires"),
 			       m->requires);
@@ -7445,6 +7451,24 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
 			       scheme_intern_symbol("module-direct-for-template-requires"),
 			       m->tt_requires);
 
+      l = scheme_null;
+      if (!SCHEME_NULLP(m->dt_requires))
+        l = scheme_make_pair(scheme_make_pair(scheme_false, m->dt_requires),
+                             l);
+      if (m->other_requires) {
+        int i;
+        for (i = 0; i < m->other_requires->size; i++) {
+          if (m->other_requires->vals[i]) {
+            l = scheme_make_pair(scheme_make_pair(m->other_requires->keys[i],
+                                                  m->other_requires->vals[i]),
+                                 l);
+          }
+        }
+      }      
+      fm = scheme_stx_property(fm, 
+			       scheme_intern_symbol("module-direct-for-meta-requires"),
+			       l);
+      
       fm = scheme_stx_property(fm, 
 			       scheme_intern_symbol("module-variable-provides"),
 			       SCHEME_CAR(hints));
@@ -7463,11 +7487,25 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
       fm = scheme_stx_property(fm, 
 			       scheme_intern_symbol("module-self-path-index"),
 			       this_empty_self_modidx);
-    }
 
-    /* for future expansion, shift away from self_modidx: */
+      fm = scheme_stx_property(fm, 
-    ps = scheme_make_shift(NULL, self_modidx, this_empty_self_modidx, NULL, NULL, NULL);
+                               scheme_intern_symbol("module-body-context-simple?"),
-    fm = scheme_stx_add_shift(fm, ps);
+                               (SAME_OBJ(scheme_true, m->rn_stx)
+                                ? scheme_true
+                                : scheme_false));
+
+      stx = scheme_datum_to_syntax(scheme_intern_symbol("inside"), scheme_false, scheme_false, 0, 0);
+      stx = scheme_stx_add_module_context(stx, rn_set);
+      fm = scheme_stx_property(fm,
+                               scheme_intern_symbol("module-body-inside-context"),
+                               scheme_stx_add_shift(stx, ps));
+
+      stx = scheme_datum_to_syntax(scheme_intern_symbol("outside"), scheme_false, scheme_false, 0, 0);
+      stx = scheme_stx_introduce_to_module_context(stx, rn_set);
+      fm = scheme_stx_property(fm,
+                               scheme_intern_symbol("module-body-outside-context"),
+                               scheme_stx_add_shift(stx, ps));
+    }
 
     /* make self_modidx like the empty modidx */
     if (SAME_OBJ(this_empty_self_modidx, empty_self_modidx))
@@ -8383,7 +8421,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
 
     result = scheme_null;
 
-    /* kernel re-export info (always #f): */
+    /* kernel re-export info (now always #f): */
     result = scheme_make_pair(scheme_false, result);
 
     /* Indirect provides */ 
@@ -8467,6 +8505,12 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
         add_binding_names_from_environment(env->genv->module, bnenv);
       }
     }
+  } else {
+    /* For a property on the expanded module: */
+    if (*all_simple_bindings && env->genv->module->rn_stx) {
+      /* We will be able to reconstruct binding for `module->namespace`: */
+      env->genv->module->rn_stx = scheme_true;
+    }
   }
 
   if (rec[drec].comp || has_submodules) {