expander: repair local-expand with definition context

When `local-expand` receives one or more internal definition contexts,
it would forget about any current post-expansion scopes. That's
particularly a problem in a 'module-begin expansion context, where the
post-expansion scope ensures that any bindings are suitably
phase-specific.

Closes #2115
This commit is contained in:
Matthew Flatt 2018-06-03 09:16:52 +08:00
parent 3fa6fef654
commit a1b5bab31b
3 changed files with 821 additions and 767 deletions

View File

@ -2173,6 +2173,38 @@
(test 1 dynamic-require ''local-expand-result-depends-on-use-site-scope 'result) (test 1 dynamic-require ''local-expand-result-depends-on-use-site-scope 'result)
;; ----------------------------------------
;; Make sure `local-expand` doesn't get confused about the
;; post-expansion scope needed to make a binding phase-specific
(module test-for-scope-specific-binding racket/base
(module l racket/base
(require (for-syntax racket/base racket/syntax)
syntax/parse/define)
(provide #%module-begin m
(all-from-out racket/base))
(define-syntax-parser #%module-begin
[(_ form ...)
(let ([intdef-ctx (syntax-local-make-definition-context #f #f)])
(local-expand #'(#%plain-module-begin form ...)
'module-begin
'()
intdef-ctx))])
(define-syntax-parser m
[(_)
#:with x (generate-temporary)
#'(begin
(define x #f)
;; The #' here triggers a `syntax-local-value` call:
(begin-for-syntax #'x))]))
(module c (submod ".." l)
(#%module-begin
(m))))
;; ---------------------------------------- ;; ----------------------------------------

View File

@ -232,6 +232,9 @@
(define def-ctx-scopes (if (expand-context-def-ctx-scopes ctx) (define def-ctx-scopes (if (expand-context-def-ctx-scopes ctx)
(unbox (expand-context-def-ctx-scopes ctx)) (unbox (expand-context-def-ctx-scopes ctx))
null)) null))
(define placeholder-sc (and intdefs
(not (null? intdefs))
(new-scope 'macro)))
(struct*-copy expand-context ctx (struct*-copy expand-context ctx
[context context] [context context]
[env (add-intdef-bindings (expand-context-env ctx) [env (add-intdef-bindings (expand-context-env ctx)
@ -256,11 +259,12 @@
[else (or frame-id i-frame-id)]))] [else (or frame-id i-frame-id)]))]
[post-expansion-scope [post-expansion-scope
#:parent root-expand-context #:parent root-expand-context
(if (and intdefs (not (null? intdefs))) (or (and same-kind?
(new-scope 'macro) ; placeholder; action uses `indefs`
(and same-kind?
(memq context '(module module-begin top-level)) (memq context '(module module-begin top-level))
(root-expand-context-post-expansion-scope ctx)))] (root-expand-context-post-expansion-scope ctx))
;; Placeholder to make sure `post-expansion-scope-action`
;; is used
placeholder-sc)]
[post-expansion-shifts [post-expansion-shifts
#:parent root-expand-context #:parent root-expand-context
(if (and same-kind? (if (and same-kind?
@ -268,10 +272,14 @@
(root-expand-context-post-expansion-shifts ctx) (root-expand-context-post-expansion-shifts ctx)
null)] null)]
[post-expansion-scope-action [post-expansion-scope-action
(if (and intdefs (not (null? intdefs))) (let ([act (expand-context-post-expansion-scope-action ctx)])
(lambda (s placeholder-sc) (if (and intdefs (not (null? intdefs)))
(add-intdef-scopes s intdefs)) (lambda (s sc)
(expand-context-post-expansion-scope-action ctx))] (define s2 (if (eq? sc placeholder-sc)
s
(act s sc)))
(add-intdef-scopes s2 intdefs))
act))]
[scopes [scopes
(append def-ctx-scopes (append def-ctx-scopes
(expand-context-scopes ctx))] (expand-context-scopes ctx))]

File diff suppressed because it is too large Load Diff