expander: repair handling of non-interned provides

This commit is contained in:
Matthew Flatt 2018-03-03 16:46:53 -07:00
parent 77028b9c95
commit 983a35a024
6 changed files with 2823 additions and 2797 deletions

View File

@ -173,7 +173,8 @@
(define sym-to-reqds (hash-ref! at-mod phase-shift make-hasheq)) (define sym-to-reqds (hash-ref! at-mod phase-shift make-hasheq))
(define prefix-len (if bulk-prefix (string-length (symbol->string bulk-prefix)) 0)) (define prefix-len (if bulk-prefix (string-length (symbol->string bulk-prefix)) 0))
(define br (bulk-required provides prefix-len s provide-phase-level can-be-shadowed?)) (define br (bulk-required provides prefix-len s provide-phase-level can-be-shadowed?))
(for/or ([(out-sym binding/p) (in-hash provides)]) (for/or ([(out-sym binding/p) (in-hash provides)]
#:unless (not (symbol-interned? out-sym)))
(when symbols-accum (hash-set! symbols-accum out-sym #t)) (when symbols-accum (hash-set! symbols-accum out-sym #t))
(cond (cond
[(hash-ref bulk-excepts out-sym #f) [(hash-ref bulk-excepts out-sym #f)
@ -504,16 +505,12 @@
(for/list ([mpi (in-list mpis)]) (for/list ([mpi (in-list mpis)])
(module-path-index-shift mpi from-mpi to-mpi))))])) (module-path-index-shift mpi from-mpi to-mpi))))]))
;; Also removes uninterned (uncluding unreadable) symbols from among ;; Note: the provides may include non-interned symbols. Those may be
;; provides, just in case something like a lifted identifier was ;; accessible via` dynamic-require`, but don't import them.
;; provided. Since lifting generates a locally deterministic
;; unreadable symbol that is intended to be specific to a particular
;; module, exporting unreadable symbols can create collisions.
(define (shift-provides-module-path-index provides from-mpi to-mpi) (define (shift-provides-module-path-index provides from-mpi to-mpi)
(for/hasheqv ([(phase at-phase) (in-hash provides)]) (for/hasheqv ([(phase at-phase) (in-hash provides)])
(values phase (values phase
(for/hasheq ([(sym binding) (in-hash at-phase)] (for/hasheq ([(sym binding) (in-hash at-phase)])
#:when (symbol-interned? sym))
(values sym (values sym
(cond (cond
[(eq? from-mpi to-mpi) binding] [(eq? from-mpi to-mpi) binding]

View File

@ -295,6 +295,9 @@
(define provide-phase (module-binding-nominal-phase binding)) (define provide-phase (module-binding-nominal-phase binding))
(define adjusted-sym (define adjusted-sym
(cond (cond
[(not (symbol-interned? sym))
;; Don't `require` non-interned symbols
#f]
[(and skip-variable-phase-level [(and skip-variable-phase-level
(not as-transformer?) (not as-transformer?)
(equal? provide-phase skip-variable-phase-level)) (equal? provide-phase skip-variable-phase-level))

View File

@ -61,7 +61,7 @@
(struct module (source-name ; #f, symbol, or complete path (struct module (source-name ; #f, symbol, or complete path
self ; module path index used for a self reference self ; module path index used for a self reference
requires ; list of (cons phase list-of-module-path-index) requires ; list of (cons phase list-of-module-path-index)
provides ; phase-level -> sym -> binding or (provided binding bool bool) provides ; phase-level -> sym -> binding or (provided binding bool bool); see [*] below
[access #:mutable] ; phase-level -> sym -> 'provided or 'protected; computed on demand from `provides` [access #:mutable] ; phase-level -> sym -> 'provided or 'protected; computed on demand from `provides`
language-info ; #f or vector language-info ; #f or vector
min-phase-level ; phase-level min-phase-level ; phase-level
@ -79,6 +79,14 @@
supermodule-name ; associated supermodule (i.e, when declared together) supermodule-name ; associated supermodule (i.e, when declared together)
get-all-variables)) ; for `module->indirect-exports` get-all-variables)) ; for `module->indirect-exports`
;; [*] Beware that tabels in `provides` may map non-interned symbols
;; to provided bindings, in case something like a lifted
;; identifier was provided. Since lifting generates a locally
;; deterministic unreadable symbol that is intended to be specific
;; to a particular module, `require`ing unreadable symbols can
;; create collisions. Still, the provided binding is supposed to
;; be accessible via `dynamic-require`.
(struct module-linklet-info (linklet-or-instance ; #f, linklet, or instance supplied for cross-linking optimization (struct module-linklet-info (linklet-or-instance ; #f, linklet, or instance supplied for cross-linking optimization
module-uses ; #f or vector for linklet's imports module-uses ; #f or vector for linklet's imports
self ; self modidx self ; self modidx

View File

@ -222,7 +222,8 @@
[(binding-id) (cond [(binding-id) (cond
[(pair? i) [(pair? i)
(define bulk (bulk-binding-at-bulk (car i))) (define bulk (bulk-binding-at-bulk (car i)))
(define b-info (hash-ref (bulk-binding-symbols bulk s extra-shifts) sym #f)) (define b-info (and (symbol-interned? sym) ; don't `require` non-interned
(hash-ref (bulk-binding-symbols bulk s extra-shifts) sym #f)))
(and b-info (and b-info
((bulk-binding-create bulk) bulk b-info sym))] ((bulk-binding-create bulk) bulk b-info sym))]
[else (hash-iterate-value ht i)])]) [else (hash-iterate-value ht i)])])

View File

@ -142,7 +142,9 @@
(define (bulk-provides-add-prefix-remove-exceptions provides prefix excepts) (define (bulk-provides-add-prefix-remove-exceptions provides prefix excepts)
(for/hash ([(sym val) (in-hash provides)] (for/hash ([(sym val) (in-hash provides)]
#:unless (hash-ref excepts sym #f)) #:unless (hash-ref excepts sym #f)
;; Don't `require` non-interned
#:when (symbol-interned? sym))
(values (if prefix (values (if prefix
(string->symbol (format "~a~a" prefix sym)) (string->symbol (format "~a~a" prefix sym))
sym) sym)

File diff suppressed because it is too large Load Diff