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) (expand-context (root-expand-context-self-mpi root-ctx)
(root-expand-context-module-scopes root-ctx) (root-expand-context-module-scopes root-ctx)
(root-expand-context-post-expansion-scope 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-top-level-bind-scope root-ctx)
(root-expand-context-all-scopes-stx root-ctx) (root-expand-context-all-scopes-stx root-ctx)
(root-expand-context-use-site-scopes root-ctx) (root-expand-context-use-site-scopes root-ctx)

View File

@ -260,6 +260,12 @@
(and same-kind? (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)))]
[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 [post-expansion-scope-action
(if (and intdefs (not (null? intdefs))) (if (and intdefs (not (null? intdefs)))
(lambda (s placeholder-sc) (lambda (s placeholder-sc)

View File

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

View File

@ -21,6 +21,7 @@
(self-mpi ; MPI for the enclosing module during compilation (self-mpi ; MPI for the enclosing module during compilation
module-scopes ; list of scopes for enclosing module or top level; includes next two fields 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-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" 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 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 * use-site-scopes ; #f or boxed list: scopes that should be pruned from binders
@ -41,6 +42,7 @@
(root-expand-context self-mpi (root-expand-context self-mpi
module-scopes module-scopes
post-expansion-scope post-expansion-scope
null ; post-expansion-shifts
(new-scope 'module) ; top-level-bind-scope (new-scope 'module) ; top-level-bind-scope
(or all-scopes-stx (or all-scopes-stx
(add-scopes empty-syntax module-scopes)) (add-scopes empty-syntax module-scopes))
@ -57,7 +59,8 @@
(datum->syntax (datum->syntax
#f #f
(vector (add-scopes empty-syntax (root-expand-context-module-scopes ctx)) (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) (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))) (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 (for/hasheqv ([(phase ht) (in-hash (root-expand-context-defined-syms ctx))]) ; make immutable
@ -83,6 +86,7 @@
(root-expand-context self (root-expand-context self
(extract-scope-list (vector-ref vec 0)) ; module-scopes (extract-scope-list (vector-ref vec 0)) ; module-scopes
(extract-scope (vector-ref vec 1)) ; post-expansion-scope (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 (new-scope 'module) ; top-level-bind-scope
(vector-ref vec 2) ; all-scopes-stx (vector-ref vec 2) ; all-scopes-stx
(box (extract-scope-list (vector-ref vec 3))) ; use-site-scopes (box (extract-scope-list (vector-ref vec 3))) ; use-site-scopes
@ -110,6 +114,9 @@
(define s (syntax-scope-set stx 0)) (define s (syntax-scope-set stx 0))
(generalize-scope (set-first s))) (generalize-scope (set-first s)))
(define (extract-shifts stx)
(syntax-mpi-shifts stx))
(define (unpack-defined-syms v) (define (unpack-defined-syms v)
(hash-copy ; make mutable (hash-copy ; make mutable
(for/hasheqv ([(phase ht-s) (in-hash (syntax-e v))]) (for/hasheqv ([(phase ht-s) (in-hash (syntax-e v))])

View File

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

File diff suppressed because it is too large Load Diff