expander: fix problems with syntax-local-make-definition-context

Allow `syntax-local-make-definition-context` in places where the
created scope is not accumulated for stripping from `quote-syntax`.
Refine the docs to clarify those situtations.

A test for the repair exposed a problem with use-site scopes
and `quote-syntax`, so fix that, too.

Closes #2062

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

@@ -498,6 +498,12 @@ argument to ensure the necessary @tech{use-site scopes} are added to macros expa
 Otherwise, expansion of nested definitions can be inconsistent with the expansion of definitions in
 the surrounding context.
 
+The scope associated with a new definition context is pruned from
+@racket[quote-syntax] forms only when it is created during the dynamic
+extent of a @tech{syntax transformer} application or in a
+@racket[begin-for-syntax] form (potentially nested) within a module
+being expanded.
+
 @transform-time[]
 
 @history[#:changed "6.3" @elem{Added the @racket[add-scope?] argument,

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

@@ -519,6 +519,69 @@
   (provide v))
 (test 1 dynamic-require ''uses-internal-definition-context-around-id 'v)
 
+;; Make sure `syntax-local-make-definition-context` can be called
+;; at unusual times, where the scope that is otherwise captured
+;; for `quote-syntax` isn't or can't be recorded
+(let-syntax ([x (syntax-local-make-definition-context)])
+  (void))
+(module makes-definition-context-at-compile-time-begin racket
+  (begin-for-syntax
+    (syntax-local-make-definition-context)))
+(require 'makes-definition-context-at-compile-time-begin)
+
+
+(module create-definition-context-during-visit racket/base
+  (require (for-syntax racket/base))
+  (provide (for-syntax ds))
+  ;; won't be stipped for `quote-syntax`
+  (define-for-syntax ds (syntax-local-make-definition-context)))
+
+(module create-definition-context-during-expand racket/base
+  (require (for-syntax racket/base)
+           'create-definition-context-during-visit)
+  (provide results
+           get-results)
+
+  ;; will be stipped for `quote-syntax`
+  (define-for-syntax ds2 (syntax-local-make-definition-context))
+
+  (define-syntax (m stx)
+    (syntax-case stx ()
+      [(_ body)
+       (internal-definition-context-introduce ds #'body)]))
+
+  (define-syntax (m2 stx)
+    (syntax-case stx ()
+      [(_ body)
+       (internal-definition-context-introduce ds2 #'body)]))
+
+  (define-syntax (m3 stx)
+    (syntax-case stx ()
+      [(_ body)
+       (let ([ds3 (syntax-local-make-definition-context)])
+         (internal-definition-context-introduce ds3 #'body))]))
+
+  (define results
+    (list
+     (bound-identifier=? (m #'x)
+                         #'x)
+     (bound-identifier=? (m2 #'x)
+                         #'x)
+     (bound-identifier=? (m3 #'x)
+                         #'x)))
+
+  (define (get-results)
+    (list
+     (bound-identifier=? (m #'x)
+                         #'x)
+     (bound-identifier=? (m2 #'x)
+                         #'x)
+     (bound-identifier=? (m3 #'x)
+                         #'x))))
+
+(test '(#f #t #t) dynamic-require ''create-definition-context-during-expand 'results)
+(test '(#f #t #t) (dynamic-require ''create-definition-context-during-expand 'get-results))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (module local-expand-begin-for-syntax-test racket/base
@@ -1509,6 +1572,22 @@
              (eval-syntax #'a)
              (eval-syntax (expand-syntax #'b)))])))
 
+;; ----------------------------------------
+;; Basic use-site scope example
+
+(module define-n-as-ten-not-five racket/base
+  (define x 10)
+  
+  (define-syntax-rule (use-x misc-id)
+    (let ([misc-id 5])
+      x))
+  
+  (define n (use-x x))
+  
+  (provide n))
+
+(test 10 dynamic-require ''define-n-as-ten-not-five 'n)
+
 ;; ----------------------------------------
 ;; Check that use-site scopes are not pruned too eagerly
 ;;  (based on examples from Brian Mastenbrook)

racket/src/expander/eval/main.rkt

@@ -234,7 +234,6 @@
     (define-values (require-lifts lifts exp-s)
       (expand-capturing-lifts s (struct*-copy expand-context tl-ctx
                                               [only-immediate? #t]
-                                              [def-ctx-scopes (box null)] ; discarding is ok
                                               [phase phase]
                                               [namespace ns])))
     (define disarmed-exp-s (raw:syntax-disarm exp-s))

racket/src/expander/expand/context.rkt

@@ -90,7 +90,7 @@
                   empty-env
                   push-scope ; post-expansion-scope-action
                   null ; scopes
-                  #f   ; def-ctx-scopes
+                  #f   ; def-ctx-scopes [=> don't record scopes to be stipped for `quote-syntax`]
                   (root-expand-context-frame-id root-ctx) ; binding-layer
                   null ; reference-records
                   #f   ; only-immediate?

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

@@ -55,8 +55,8 @@
                        (gensym)))
   (define sc (new-scope 'intdef))
   (define def-ctx-scopes (expand-context-def-ctx-scopes ctx))
-  (unless def-ctx-scopes (error "internal error: no box to accumulate definition-context scopes"))
+  (when def-ctx-scopes
-  (set-box! def-ctx-scopes (cons sc (unbox def-ctx-scopes)))
+    (set-box! def-ctx-scopes (cons sc (unbox def-ctx-scopes))))
   (internal-definition-context frame-id sc add-scope? (box null) parent-ctx))
 
 ;; syntax-local-bind-syntaxes

racket/src/expander/expand/expr.rkt

@@ -454,7 +454,9 @@
           `(,(m-local 'quote-syntax) ,(m-local 'datum) ,(m-kw 'kw))))]
     [else
      ;; otherwise, prune scopes up to transformer boundary:
-     (define datum-s (remove-scopes (m 'datum) (expand-context-scopes ctx)))
+     (define use-site-scopes (root-expand-context-use-site-scopes ctx))
+     (define datum-s (remove-scopes (remove-scopes (m 'datum) (expand-context-scopes ctx))
+                                    (if use-site-scopes (unbox use-site-scopes) '())))
      (if (and (expand-context-to-parsed? ctx)
               (free-id-set-empty? (expand-context-stops ctx)))
          (parsed-quote-syntax (keep-properties-only~ s) datum-s)

racket/src/expander/expand/module.rkt

@@ -360,7 +360,7 @@
                                         [to-module-lifts (make-to-module-lift-context phase
                                                                                       #:shared-module-ends module-ends
                                                                                       #:end-as-expressions? #t)]))
-         
+
          (finish-expanding-body-expressons partially-expanded-bodys
                                            #:phase phase
                                            #:ctx body-ctx
@@ -502,7 +502,8 @@
    ;; Expand the body
    (define expanded-mb (performance-region
                         ['expand 'module-begin]
-                        (expand mb (accumulate-def-ctx-scopes mb-ctx mb-def-ctx-scopes))))
+                        (expand mb (struct*-copy expand-context (accumulate-def-ctx-scopes mb-ctx mb-def-ctx-scopes)
+                                                 [def-ctx-scopes #f]))))
 
    ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ;; Assemble the `module` result

racket/src/expander/expand/provide.rkt

@@ -156,7 +156,7 @@
                                                             ;; Discarding definition-context scopes is ok,
                                                             ;; because the scopes won't be captured by
                                                             ;; any `quote-syntax`:
-                                                            [def-ctx-scopes (box null)])))
+                                                            [def-ctx-scopes #f])))
            (unless (and (pair? (syntax-e exp-spec))
                         (identifier? (car (syntax-e exp-spec)))
                         (eq? 'begin (core-form-sym exp-spec at-phase)))