Improve how splicing-syntax-parameterize interacts with module* forms

Commit 00d438cfbe made an attempt at this,
but this commit does it in a much more careful way, based on manually
emulating how the macroexpander expands module* forms in order to allow
splicing-syntax-parameterize to apply even within #%module-begin forms
introduced by the expander.

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

@@ -34,6 +34,7 @@
     (syntax-case stx ()
       [(_ id) #`(define id (quote #,v))]))
   (m x)
+
   (splicing-syntax-parameterize ([sp 'sub])
     (begin
      (define other 'other)
@@ -80,6 +81,12 @@
     (module* sp-submod #f
       (provide b)
       (m b)))
+
+  ; make sure it applies to #%module-begin for submodules
+  (splicing-letrec-syntax ([#%module-begin (syntax-rules ()
+                                             [(_) (#%plain-module-begin (begin (provide b) (m b)))])])
+    (splicing-syntax-parameterize ([sp 'begin-defined])
+      (module* sp-submod2 #f)))
    
   (provide x y z w f g))
 
@@ -90,6 +97,7 @@
 (test 'nested values ((dynamic-require ''check-splicing-stxparam-1 'f)))
 (test 'also-nested values ((dynamic-require ''check-splicing-stxparam-1 'g)))
 (test 'sub-submod dynamic-require '(submod 'check-splicing-stxparam-1 sp-submod) 'b)
+(test 'begin-defined dynamic-require '(submod 'check-splicing-stxparam-1 sp-submod2) 'b)
 
 (module check-splicing-stxparam-et racket/base
   (require (for-syntax racket/base)

racket/collects/racket/splicing.rkt

@@ -343,9 +343,13 @@
                (syntax/loc/props body
                  (begin-for-syntax (wrap-param-et e (orig-id ...) (temp-id ...)) ...))]
               [(module . _) body]
-              [(module* n #f form ...)
+              [(module* name #f form ...)
-               (syntax/loc/props body
+               (datum->syntax body
-                 (module* n #f (expand-ssp-body (sp-id ...) (temp-id ...) (orig-id ...) form) ...))]
+                              (list #'module* #'name #f
+                                    #`(expand-ssp-module-begin
+                                       (sp-id ...) (temp-id ...) (orig-id ...)
+                                       #,body name form ...))
+                              body)]
               [(module* . _) body]
               [(#%require . _) body]
               [(#%provide . _) body]
@@ -354,6 +358,35 @@
                       (letrec-syntaxes ([(sp-id) (syntax-local-value (quote-syntax temp-id))] ...)
                         expr))]))))]))
 
+(define-syntax (expand-ssp-module-begin stx)
+  (syntax-case stx ()
+    [(_ (sp-id ...) (temp-id ...) (orig-id ...) mod-form mod-name-id body-form ...)
+     (unless (eq? (syntax-local-context) 'module-begin)
+       (raise-syntax-error #f "only allowed in module-begin context" stx))
+     (let ([ctx (syntax-local-make-definition-context #f #f)])
+       (for ([sp-id (in-list (syntax->list #'(sp-id ...)))]
+             [temp-id (in-list (syntax->list #'(temp-id ...)))])
+         (syntax-local-bind-syntaxes (list sp-id)
+                                     #`(syntax-local-value (quote-syntax #,temp-id))
+                                     ctx))
+       (let* ([forms (syntax->list #'(body-form ...))]
+              ; emulate how the macroexpander expands module bodies and introduces #%module-begin
+              [body (if (= (length forms) 1)
+                        (let ([body (local-expand (car forms) 'module-begin #f ctx)])
+                          (syntax-case body (#%plain-module-begin)
+                            [(#%plain-module-begin . _) body]
+                            [_ (datum->syntax #'mod-form (list '#%module-begin body) #'mod-form)]))
+                        (datum->syntax #'mod-form (list* '#%module-begin forms) #'mod-form))]
+              [body (syntax-property body 'enclosing-module-name (syntax-e #'mod-name-id))]
+              [body (local-expand body 'module-begin #f ctx)])
+         (syntax-case body (#%plain-module-begin)
+           [(#%plain-module-begin form ...)
+            (syntax/loc/props body
+              (#%plain-module-begin
+               (expand-ssp-body (sp-id ...) (temp-id ...) (orig-id ...) form) ...))]
+           [_ (raise-syntax-error
+               #f "expansion of #%module-begin is not a #%plain-module-begin form" body)])))]))
+
 (define-syntax (letrec-syntaxes/trans stx)
   (syntax-case stx ()
     [(_ bindings body)
@@ -412,8 +445,11 @@
                    (define-values ids (wrap-param-et rhs (orig-id ...) (temp-id ...))))]
                 [(module . _) e]
                 [(module* n #f form ...)
-                 (syntax/loc/props e
+                 (datum->syntax
-                   (module* n #f (wrap-param-et form (orig-id ...) (temp-id ...)) ...))]
+                  e
+                  (syntax-e #'(module* n #f (wrap-param-et form (orig-id ...) (temp-id ...)) ...))
+                  e
+                  e)]
                 [(module* . _) e]
                 [(#%require . _) e]
                 [(#%provide . _) e]