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
This commit is contained in:
parent
f9821f9f15
commit
c927a004d2
|
@ -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,
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -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"))
|
||||
(set-box! def-ctx-scopes (cons sc (unbox def-ctx-scopes)))
|
||||
(when 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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user