expander: fix problem with module->namespace and shifts

When expanding in a namespace for a module unmarshaled from ".zo"
form, a scope corresponding to the module's "inside edge" is added to
every expansion. Before this repair, the scope was detached from
module path index shifts that might apply to the bindings (including
references to bulk bindings). Repair the problem by adding suitable
shifts when adding the scope.

Thanks to William Hatch for the bug report.
This commit is contained in:
Matthew Flatt 2018-05-31 16:45:54 +08:00
parent 53f7a95dc2
commit 32b256886e
6 changed files with 9033 additions and 8915 deletions

View File

@ -76,6 +76,7 @@
(expand-context (root-expand-context-self-mpi root-ctx)
(root-expand-context-module-scopes root-ctx)
(root-expand-context-post-expansion-scope root-ctx)
(root-expand-context-post-expansion-shifts root-ctx)
(root-expand-context-top-level-bind-scope root-ctx)
(root-expand-context-all-scopes-stx root-ctx)
(root-expand-context-use-site-scopes root-ctx)

View File

@ -260,6 +260,12 @@
(and same-kind?
(memq context '(module module-begin top-level))
(root-expand-context-post-expansion-scope ctx)))]
[post-expansion-shifts
#:parent root-expand-context
(if (and same-kind?
(eq? context 'top-level))
(root-expand-context-post-expansion-shifts ctx)
null)]
[post-expansion-scope-action
(if (and intdefs (not (null? intdefs)))
(lambda (s placeholder-sc)

View File

@ -463,9 +463,11 @@
;; if the macro expands to a definition form, the binding will be
;; in the definition context's scope. The sepcific action depends
;; on the expansion context.
(define new-s
((expand-context-post-expansion-scope-action ctx)
s
(root-expand-context-post-expansion-scope ctx))]
(root-expand-context-post-expansion-scope ctx)))
(syntax-add-shifts new-s (root-expand-context-post-expansion-shifts ctx))]
[else s]))
(define (accumulate-def-ctx-scopes ctx def-ctx-scopes)

View File

@ -21,6 +21,7 @@
(self-mpi ; MPI for the enclosing module during compilation
module-scopes ; list of scopes for enclosing module or top level; includes next two fields
* post-expansion-scope ; #f or scope to add to every expansion; often module's inside edge
* post-expansion-shifts ; a list of MPIshifts to go with `post-expansion-scope`
top-level-bind-scope ; #f or a scope to constrain expansion bindings; see "expand-bind-top.rkt"
all-scopes-stx ; scopes like the initial import, which correspond to original forms
* use-site-scopes ; #f or boxed list: scopes that should be pruned from binders
@ -41,6 +42,7 @@
(root-expand-context self-mpi
module-scopes
post-expansion-scope
null ; post-expansion-shifts
(new-scope 'module) ; top-level-bind-scope
(or all-scopes-stx
(add-scopes empty-syntax module-scopes))
@ -57,7 +59,8 @@
(datum->syntax
#f
(vector (add-scopes empty-syntax (root-expand-context-module-scopes ctx))
(add-scope empty-syntax (root-expand-context-post-expansion-scope ctx))
(syntax-add-shifts (add-scope empty-syntax (root-expand-context-post-expansion-scope ctx))
(root-expand-context-post-expansion-shifts ctx))
(syntax-module-path-index-shift (root-expand-context-all-scopes-stx ctx) orig-self new-self)
(add-scopes empty-syntax (unbox (root-expand-context-use-site-scopes ctx)))
(for/hasheqv ([(phase ht) (in-hash (root-expand-context-defined-syms ctx))]) ; make immutable
@ -83,6 +86,7 @@
(root-expand-context self
(extract-scope-list (vector-ref vec 0)) ; module-scopes
(extract-scope (vector-ref vec 1)) ; post-expansion-scope
(extract-shifts (vector-ref vec 1)) ; post-expansion-scope-shifts
(new-scope 'module) ; top-level-bind-scope
(vector-ref vec 2) ; all-scopes-stx
(box (extract-scope-list (vector-ref vec 3))) ; use-site-scopes
@ -110,6 +114,9 @@
(define s (syntax-scope-set stx 0))
(generalize-scope (set-first s)))
(define (extract-shifts stx)
(syntax-mpi-shifts stx))
(define (unpack-defined-syms v)
(hash-copy ; make mutable
(for/hasheqv ([(phase ht-s) (in-hash (syntax-e v))])

View File

@ -37,6 +37,7 @@
syntax-apply-shifts
binding-module-path-index-shift
syntax-transfer-shifts
syntax-add-shifts
syntax-source-module
identifier-prune-to-source-module)
@ -280,7 +281,9 @@
[else b]))
(define (syntax-transfer-shifts to-s from-s [inspector #f] #:non-source? [non-source? #f])
(define shifts (syntax-mpi-shifts from-s))
(syntax-add-shifts to-s (syntax-mpi-shifts from-s) inspector #:non-source? non-source?))
(define (syntax-add-shifts to-s shifts [inspector #f] #:non-source? [non-source? #f])
(cond
[(and (null? shifts) inspector)
(syntax-set-inspector to-s inspector)]

File diff suppressed because it is too large Load Diff