expander: don't flip use-site scope in local-expand

Various parts of the expander, including `local-expand`, always
flipped the use-site scope when flipping an introduction scope. Onlt
`syntax-local-introduce` should flip both of them, though.

Closes #2112
This commit is contained in:
Matthew Flatt 2018-05-31 17:09:37 +08:00
parent 32b256886e
commit 937c396e1b
6 changed files with 6169 additions and 6067 deletions

View File

@ -2155,6 +2155,25 @@
[(_ e) (disarm #'e)]))
(mapply m))))
;; ----------------------------------------
;; Make sure `local-expand` doesn't flip the use-site
;; scope in addition to the introduction scope
(module local-expand-result-depends-on-use-site-scope racket/base
(require (for-syntax racket/base))
(define x 1)
(define-syntax (a stx)
(syntax-case stx ()
[(a id)
(local-expand #'(let ([id 3]) x) 'expression '())]))
(define result (a x))
(provide result))
(test 1 dynamic-require ''local-expand-result-depends-on-use-site-scope 'result)
;; ----------------------------------------
(report-errs)

View File

@ -56,6 +56,7 @@
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
* current-use-scopes ; scopes for current macro expansion
declared-submodule-names ; mutable hash table: symbol -> 'module or 'module*
lifts ; #f or lift-context, which contains a list of lifteds
lift-envs ; list of box of env for lifts to locals
@ -103,6 +104,7 @@
#f ; keep-#%expression?
empty-free-id-set ; stops
null ; current-introduction-scopes
null ; current-use-scopes
#hasheq() ; declared-submodule-names
#f ; lifts
'() ; lift-envs

View File

@ -27,6 +27,7 @@
make-local-expand-context
flip-introduction-scopes
flip-introduction-and-use-scopes
intdefs?
intdefs?-string
@ -299,3 +300,7 @@
(define (flip-introduction-scopes s ctx)
(flip-scopes s (expand-context-current-introduction-scopes ctx)))
(define (flip-introduction-and-use-scopes s ctx)
(flip-scopes (flip-introduction-scopes s ctx)
(expand-context-current-use-scopes ctx)))

View File

@ -410,8 +410,8 @@
(accumulate-def-ctx-scopes ctx (expand-context-def-ctx-scopes ctx))
ctx))
(define m-ctx (struct*-copy expand-context accum-ctx
[current-introduction-scopes (cons intro-scope
use-scopes)]
[current-introduction-scopes (list intro-scope)]
[current-use-scopes use-scopes]
[def-ctx-scopes
(if confine-def-ctx-scopes?
;; Can confine tracking to this call

View File

@ -92,7 +92,7 @@
(define/who (syntax-local-introduce s)
(check who syntax? s)
(define ctx (get-current-expand-context 'syntax-local-introduce))
(flip-introduction-scopes s ctx))
(flip-introduction-and-use-scopes s ctx))
(define/who (syntax-local-identifier-as-binding id)
(check who identifier? id)

File diff suppressed because it is too large Load Diff