make #%plain-module-begin' transformer detect module*' in stop list

collects/scribblings/reference/stx-trans.scrbl

@@ -218,6 +218,14 @@ bindings listed in @secref["fully-expanded"] plus the
 @racket[letrec-syntaxes+values] form and @racket[#%expression]
 in any expression position.
 
+When @racket[#%plain-module-begin] is not itself in @racket[stop-ids]
+and @racket[module*] is in @racket[stop-ids], then the
+@racket[#%plain-module-begin] transformer refrains from expanding
+@racket[module*] sub-forms. Otherwise, the
+@racket[#%plain-module-begin] transformer detects and expands sub-forms
+(such as @racket[define-values]) independent of the correspond
+identifier's presence in @racket[stop-ids].
+
 The optional @racket[intdef-ctx] argument must be either @racket[#f],
 the result of @racket[syntax-local-make-definition-context], or a list
 of such results. In the latter two cases, lexical information for

collects/tests/racket/macro.rktl

@@ -459,7 +459,7 @@
   (define q 8)
   (nab h))
 
-;; #'module* in sto plist shouldn't add all the rest:
+;; #'module* in stop list shouldn't add all the rest:
 (let ()
   (define-syntax (m stx) (syntax-case stx () 
                            [(_ e) 
@@ -470,6 +470,31 @@
                               #'(void))]))
   (m (+ 1 2)))
 
+;; #'module* in stop list should stop:
+(module m1-for-local-expand racket/base
+  (require (for-syntax racket/base))
+  (provide (rename-out [mb #%module-begin])
+           (except-out (all-from-out racket/base) #%module-begin))
+  (define-syntax (mb stx)
+    (syntax-case stx ()
+      [(_ 10) #'(#%plain-module-begin 10)]
+      [(_ 11) #'(#%plain-module-begin 11)]
+      [(_ form ...)
+       (let ([e (local-expand #'(#%plain-module-begin form ...)
+                              'module-begin
+                              (list #'module*))])
+         (syntax-case e (module module* quote #%plain-app)
+           [(mod-beg
+             (#%plain-app + (quote 1) (quote 2))
+             (module* q #f 10)
+             (module* z #f 11))
+            'ok]
+           [else (error 'test "bad local-expand result: ~s" (syntax->datum e))])
+         e)])))
+(module m2-for-local-expand 'm1-for-local-expand
+  (+ 1 2)
+  (module* q #f 10) (module* z #f 11))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (module rename-transformer-tests scheme/base

src/racket/src/module.c

@@ -150,6 +150,7 @@ static Scheme_Object *fixup_expanded(Scheme_Object *expanded_l,
 
 static void check_formerly_unbound(Scheme_Object *unbounds, Scheme_Comp_Env *env);
 static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **_begin_for_syntax_stx);
+static int is_modulestar_stop(Scheme_Comp_Env *env);
 
 static Scheme_Object *scheme_sys_wraps_phase_worker(intptr_t p);
 
@@ -7727,8 +7728,18 @@ 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);
     }
 
-    expanded_modules = expand_submodules(rec, drec, env, bxs->saved_submodules, 1, bxs, !rec[drec].comp);
-    
+    if (!rec[drec].comp && (is_modulestar_stop(env))) {
+      Scheme_Object *l = bxs->saved_submodules;
+      expanded_modules =  NULL;
+      while (!SCHEME_NULLP(l)) {
+        expanded_modules = scheme_make_pair(SCHEME_CAR(SCHEME_CAR(l)),
+                                            expanded_modules);
+        l = SCHEME_CDR(l);
+      }
+      bxs->saved_submodules = scheme_null;
+    } else
+      expanded_modules = expand_submodules(rec, drec, env, bxs->saved_submodules, 1, bxs, !rec[drec].comp);
+
     if (!rec[drec].comp) {
       (void)fixup_expanded(expanded_l, expanded_modules, 0, MODULE_MODFORM_KIND);
     }
@@ -8936,6 +8947,20 @@ static void check_formerly_unbound(Scheme_Object *unbounds,
   }
 }
 
+static int is_modulestar_stop(Scheme_Comp_Env *env)
+{
+  Scheme_Object *p;
+  p = scheme_datum_to_syntax(scheme_intern_symbol("module*"), scheme_false, scheme_sys_wraps(env), 0, 0);
+  p = scheme_lookup_binding(p, env, 
+                            (SCHEME_NULL_FOR_UNBOUND
+                             + SCHEME_DONT_MARK_USE 
+                             + SCHEME_ENV_CONSTANTS_OK
+                             + (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL)),
+                            env->in_modidx, 
+                            NULL, NULL, NULL, NULL);
+  return (scheme_get_stop_expander() == p);
+}
+
 static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **_begin_for_syntax_stx)
 {
   Scheme_Object *stop, *w, *s;