expander: repair handling of non-interned provide
s
This commit is contained in:
parent
77028b9c95
commit
983a35a024
|
@ -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]
|
||||||
|
|
|
@ -295,27 +295,30 @@
|
||||||
(define provide-phase (module-binding-nominal-phase binding))
|
(define provide-phase (module-binding-nominal-phase binding))
|
||||||
(define adjusted-sym
|
(define adjusted-sym
|
||||||
(cond
|
(cond
|
||||||
[(and skip-variable-phase-level
|
[(not (symbol-interned? sym))
|
||||||
(not as-transformer?)
|
;; Don't `require` non-interned symbols
|
||||||
(equal? provide-phase skip-variable-phase-level))
|
#f]
|
||||||
#f]
|
[(and skip-variable-phase-level
|
||||||
[(not adjust) sym]
|
(not as-transformer?)
|
||||||
[(adjust-only? adjust)
|
(equal? provide-phase skip-variable-phase-level))
|
||||||
(and (set-member? (adjust-only-syms adjust) sym)
|
#f]
|
||||||
(hash-set! done-syms sym #t)
|
[(not adjust) sym]
|
||||||
sym)]
|
[(adjust-only? adjust)
|
||||||
[(adjust-prefix? adjust)
|
(and (set-member? (adjust-only-syms adjust) sym)
|
||||||
(string->symbol
|
(hash-set! done-syms sym #t)
|
||||||
(format "~a~a" (adjust-prefix-sym adjust) sym))]
|
sym)]
|
||||||
[(adjust-all-except? adjust)
|
[(adjust-prefix? adjust)
|
||||||
(and (not (and (set-member? (adjust-all-except-syms adjust) sym)
|
(string->symbol
|
||||||
(hash-set! done-syms sym #t)))
|
(format "~a~a" (adjust-prefix-sym adjust) sym))]
|
||||||
(string->symbol
|
[(adjust-all-except? adjust)
|
||||||
(format "~a~a" (adjust-all-except-prefix-sym adjust) sym)))]
|
(and (not (and (set-member? (adjust-all-except-syms adjust) sym)
|
||||||
[(adjust-rename? adjust)
|
(hash-set! done-syms sym #t)))
|
||||||
(and (eq? sym (adjust-rename-from-sym adjust))
|
(string->symbol
|
||||||
(hash-set! done-syms sym #t)
|
(format "~a~a" (adjust-all-except-prefix-sym adjust) sym)))]
|
||||||
(adjust-rename-to-id adjust))]))
|
[(adjust-rename? adjust)
|
||||||
|
(and (eq? sym (adjust-rename-from-sym adjust))
|
||||||
|
(hash-set! done-syms sym #t)
|
||||||
|
(adjust-rename-to-id adjust))]))
|
||||||
(define skip-bind?
|
(define skip-bind?
|
||||||
(cond
|
(cond
|
||||||
[(and adjusted-sym requires+provides)
|
[(and adjusted-sym requires+provides)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)])])
|
||||||
|
|
|
@ -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
Loading…
Reference in New Issue
Block a user