expander: no #%expression in fully expanded

Ensure that `#%expression` appears only around a top-level form in
a fully expanded form.

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

@@ -377,6 +377,14 @@ If @racket[opaque-only?] is true, then the first result is @racket[#f]
 instead of the expanded expression. Obtaining only the second, opaque
 result can be more efficient in some expansion contexts.
 
+Unlike @racket[local-expand], @racket[syntax-local-expand-expression]
+normally produces an expanded expression that contains no
+@racket[#%expression] forms. However, if
+@racket[syntax-local-expand-expression] is used within an expansion
+that is triggered by an enclosing @racket[local-expand] call, then the
+result of @racket[syntax-local-expand-expression] can include
+@racket[#%expression] forms.
+
 @transform-time[]
 
 @history[#:changed "6.90.0.13" @elem{Added the @racket[opaque-only?] argument.}]}

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

@@ -1951,6 +1951,23 @@
 
 (test '(#f value) dynamic-require ''internal-definition-context-introduce-always-adds-scope 'result)
 
+
+;; ----------------------------------------
+;; Make sure `#%expression` doesn't appear in fully
+;; expanded forms
+
+(let ([stx (expand '(module m racket/base
+                      (require racket/class)
+                      (define c
+                        (class object%
+                          (super-new)))))])
+  (test #f 'any-#%expression? (let loop ([e stx])
+                                (cond
+                                  [(eq? e '#%expression) #t]
+                                  [(syntax? e) (loop (syntax-e e))]
+                                  [(pair? e) (or (loop (car e)) (loop (cdr e)))]
+                                  [else #f]))))
+
 ;; ----------------------------------------
 
 (report-errs)

racket/src/expander/expand/context.rkt

@@ -53,6 +53,7 @@
           * need-eventually-defined ; phase(>=1) -> variables expanded before binding
           allow-unbound? ; allow reference to unbound identifiers as variables
           in-local-expand? ; #t via `local-expand`
+          keep-#%expression? ; if `in-local-expand?`, keep `#%expression` forms
           stops      ; free-id-set; non-empty => `def-ctx-scopes` is a box
           * current-introduction-scopes ; scopes for current macro expansion
           declared-submodule-names ; mutable hash table: symbol -> 'module or 'module*
@@ -98,6 +99,7 @@
                   #f   ; need-eventually-defined
                   #t   ; allow-unbound?
                   #f   ; in-local-expand?
+                  #f   ; keep-#%expression?
                   empty-free-id-set ; stops
                   null ; current-introduction-scopes
                   #hasheq() ; declared-submodule-names

racket/src/expander/expand/definition-context.rkt

@@ -218,7 +218,8 @@
                                    #:intdefs intdefs
                                    #:stop-ids [stop-ids #f]
                                    #:to-parsed-ok? [to-parsed-ok? #f]
-                                   #:track-to-be-defined? [track-to-be-defined? #f])
+                                   #:track-to-be-defined? [track-to-be-defined? #f]
+                                   #:keep-#%expression? [keep-#%expression? #t])
   (define same-kind? (or (eq? context
                               (expand-context-context ctx))
                          (and (list? context)
@@ -270,6 +271,7 @@
                                 #f)]
                 [just-once? #f]
                 [in-local-expand? #t]
+                [keep-#%expression? keep-#%expression?]
                 [stops (free-id-set phase (or all-stop-ids null))]
                 [current-introduction-scopes null]
                 [need-eventually-defined (let ([ht (expand-context-need-eventually-defined ctx)])

racket/src/expander/expand/expr.rkt

@@ -755,15 +755,17 @@
                                                  #:wrt ctx)))
    (if (expand-context-to-parsed? ctx)
        exp-e
-       (case (and (not (expand-context-in-local-expand? ctx))
+       (cond
-                  (expand-context-context ctx))
+         [(or (and (expand-context-in-local-expand? ctx)
-         [(expression)
+                   (expand-context-keep-#%expression? ctx))
+              (eq? 'top-level (expand-context-context ctx)))
+          (rebuild
+           rebuild-s
+           `(,(m '#%expression) ,exp-e))]
+         [else
           (define result-s (syntax-track-origin exp-e rebuild-s))
           (log-expand ctx 'tag result-s)
-          result-s]
+          result-s]))))
-         [else (rebuild
-                rebuild-s
-                `(,(m '#%expression) ,exp-e))]))))
 
 ;; ----------------------------------------
 

racket/src/expander/expand/local-expand.rkt

@@ -44,7 +44,8 @@
   (define exp-s (do-local-expand 'syntax-local-expand-expression s 'expression null #f
                                  #:to-parsed-ok? opaque-only?
                                  #:skip-log-exit? #t
-                                 #:track-to-be-defined? #t))
+                                 #:track-to-be-defined? #t
+                                 #:keep-#%expression? #f))
   (define ctx (get-current-expand-context))
   ;; Move introduction scope from the already-expanded syntax object to
   ;; its wrapper. The expander will later check that the wrapper ends up
@@ -67,6 +68,7 @@
                          #:capture-lifts? [capture-lifts? #f]
                          #:as-transformer? [as-transformer? #f]
                          #:to-parsed-ok? [to-parsed-ok? #f]
+                         #:keep-#%expression? [keep-#%expression? #t]
                          #:lift-key [lift-key (and (or capture-lifts?
                                                        as-transformer?)
                                                    (generate-lift-key))]
@@ -102,6 +104,9 @@
                                                 #:intdefs intdefs
                                                 #:stop-ids stop-ids
                                                 #:to-parsed-ok? to-parsed-ok?
+                                                #:keep-#%expression? (or keep-#%expression?
+                                                                         (and (expand-context-in-local-expand? ctx)
+                                                                              (expand-context-keep-#%expression? ctx)))
                                                 #:track-to-be-defined? track-to-be-defined?))
 
    (namespace-visit-available-modules! (expand-context-namespace ctx) phase)