suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

expander: fix require after shadowing define

Browse Source
This commit is contained in:
Matthew Flatt 2018-03-01 14:13:59 -07:00
parent 7069510d67
commit 11fd70c3dd
7 changed files with 15171 additions and 14862 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
pkgs/racket-test-core/tests/racket/module.rktl
View File

@ -683,6 +683,55 @@
(let ([n-ns (eval '(module->namespace ''n) ns)])
(test 5 eval '(lambda (x) x) n-ns)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check shadowing when `define` precedes `require`
(module definition-shadows-later-require racket/base
(provide result)
(define first "last")
(require racket/list)
(define result first))
(test "last" dynamic-require ''definition-shadows-later-require 'result)
(module definition-shadows-later-require/rename racket/base
(provide result)
(define first "last")
(require (rename-in racket/function
[curry first]))
(define result first))
(test "last" dynamic-require ''definition-shadows-later-require/rename 'result)
(module definition-shadows-later-require/2 racket/base
(provide result)
(define first "last")
(require racket/list)
(require racket/list)
(define result first))
(test "last" dynamic-require ''definition-shadows-later-require/2 'result)
(err/rt-test
(eval
'(module m racket/base
(define first "last")
(require racket/list)
;; late `require` collision:
(require (rename-in racket/function
[curry first]))))
exn:fail:syntax?)
(err/rt-test
(eval
'(module m racket/base
(require racket/list)
(define first "last")
;; late `require` collision:
(require (rename-in racket/function
[curry first]))))
exn:fail:syntax?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check printing of resolved module paths

7
racket/src/expander/expand/env.rkt
View File

@ -85,10 +85,13 @@
(add-binding-in-scopes! (syntax-scope-set id phase) (syntax-e id) binding
#:just-for-nominal? just-for-nominal?))
(define (add-bulk-binding! s binding phase #:in [in-s #f])
(define (add-bulk-binding! s binding phase
#:in [in-s #f]
#:shadow-except [shadow-except #f])
(when (syntax-tainted? s)
(raise-syntax-error #f "cannot bind from tainted syntax" in-s s))
(add-bulk-binding-in-scopes! (syntax-scope-set s phase) binding))
(add-bulk-binding-in-scopes! (syntax-scope-set s phase) binding
#:shadow-except shadow-except))
;; Helper for registering a local binding in a set of scopes:
(define (add-local-binding! id phase counter #:frame-id [frame-id #f] #:in [in-s #f])

113
racket/src/expander/expand/require+provide.rkt
View File

@ -49,6 +49,7 @@
requires ; mpi [interned] -> require-phase -> sym -> list-ish of [bulk-]required
provides ; phase -> sym -> binding or protected
phase-to-defined-syms ; phase -> sym -> boolean
also-required ; sym -> binding
[can-cross-phase-persistent? #:mutable]
[all-bindings-simple? #:mutable]) ; tracks whether bindings are easily reconstructed
#:authentic)
@ -82,6 +83,7 @@
(make-hasheq) ; requires
(make-hasheqv) ; provides
(make-hasheqv) ; phase-to-defined-syms
(make-hasheq) ; also-required
#t
#t))
@ -90,7 +92,8 @@
;; all previously required modules
(hash-clear! (requires+provides-requires r+p))
(hash-clear! (requires+provides-provides r+p))
(hash-clear! (requires+provides-phase-to-defined-syms r+p)))
(hash-clear! (requires+provides-phase-to-defined-syms r+p))
(hash-clear! (requires+provides-also-required r+p)))
;; ----------------------------------------
@ -150,7 +153,8 @@
(hash-ref sym-to-reqds sym null))))
;; Like `add-defined-or-required-id!`, but faster for bindings that
;; all have the same scope, etc.
;; all have the same scope, etc.<
;; Return #t if any required id is already defined by a shaodwing definition.
(define (add-bulk-required-ids! r+p s self nominal-module phase-shift provides provide-phase-level
#:prefix bulk-prefix
#:excepts bulk-excepts
@ -169,29 +173,38 @@
(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 br (bulk-required provides prefix-len s provide-phase-level can-be-shadowed?))
(for ([(out-sym binding/p) (in-hash provides)])
(for/or ([(out-sym binding/p) (in-hash provides)])
(when symbols-accum (hash-set! symbols-accum out-sym #t))
(unless (hash-ref bulk-excepts out-sym #f)
(define sym (cond
[(not bulk-prefix) out-sym]
[else (string->symbol (format "~a~a" bulk-prefix out-sym))]))
(when (and check-and-remove?
(cond
[(hash-ref bulk-excepts out-sym #f)
#f]
[else
(define sym (cond
[(not bulk-prefix) out-sym]
[else (string->symbol (format "~a~a" bulk-prefix out-sym))]))
(define already-defined?
(cond
[(and check-and-remove?
(or (not shortcut-table)
(hash-ref shortcut-table sym #f)))
(check-not-defined #:check-not-required? #t
r+p (datum->syntax s sym s) phase #:in orig-s
#:unless-matches
(lambda ()
(provide-binding-to-require-binding binding/p
sym
#:self self
#:mpi mpi
#:provide-phase-level provide-phase-level
#:phase-shift phase-shift))
#:remove-shadowed!? #t
#:accum-update-nominals accum-update-nominals
#:who who))
(hash-set! sym-to-reqds sym (cons-ish br (hash-ref sym-to-reqds sym null))))))
(check-not-defined #:check-not-required? #t
#:allow-defined? #t
r+p (datum->syntax s sym s) phase #:in orig-s
#:unless-matches
(lambda ()
(provide-binding-to-require-binding binding/p
sym
#:self self
#:mpi mpi
#:provide-phase-level provide-phase-level
#:phase-shift phase-shift))
#:remove-shadowed!? #t
#:accum-update-nominals accum-update-nominals
#:who who)]
[else #f]))
(unless already-defined?
(hash-set! sym-to-reqds sym (cons-ish br (hash-ref sym-to-reqds sym null))))
already-defined?])))
;; Convert a combination of a symbol and `bulk-required` to a
;; `required` on demand
@ -266,8 +279,10 @@
;; Check whether an identifier has a binding that is from a non-shadowable
;; require; if something is found but it will be replaced, then record that
;; bindings are not simple.
;; bindings are not simple. Returns a boolean to dincate whether the binding
;; is defined already, since `allow-defined?` allows the result to be #t.
(define (check-not-defined #:check-not-required? [check-not-required? #f]
#:allow-defined? [allow-defined? #f]
r+p id phase #:in orig-s
#:unless-matches [ok-binding/delayed #f] ; binding or (-> binding)
#:remove-shadowed!? [remove-shadowed!? #f]
@ -275,7 +290,7 @@
#:who who)
(define b (resolve+shift id phase #:exactly? #t))
(cond
[(not b) (void)]
[(not b) #f]
[(not (module-binding? b))
(raise-syntax-error #f "identifier out of context" id)]
[else
@ -285,7 +300,11 @@
[(and (not defined?) (not check-not-required?))
;; Not defined, and we're shadowing all requires -- so, it's ok,
;; but binding is non-simple
(set-requires+provides-all-bindings-simple?! r+p #f)]
(set-requires+provides-all-bindings-simple?! r+p #f)
;; Also, record the `require` binding, in case we see another
;; `require` for the same identifier
(hash-set! (requires+provides-also-required r+p) (module-binding-sym b) b)
#f]
[(and defined?
;; In case `#%module-begin` is expanded multiple times, check
;; that the definition has been seen this particular expansion
@ -295,19 +314,30 @@
(module-binding-sym b)
#f)))
;; Doesn't count as previously defined
(void)]
#f]
[else
(define mpi (intern-mpi r+p (module-binding-nominal-module b)))
(define at-mod (hash-ref (requires+provides-requires r+p) mpi #f))
(define ok-binding (if (procedure? ok-binding/delayed)
(ok-binding/delayed)
ok-binding/delayed))
(define (raise-already-bound defined?)
(raise-syntax-error who
(string-append "identifier already "
(if defined? "defined" "required")
(cond
[(zero-phase? phase) ""]
[(label-phase? phase) " for label"]
[(= 1 phase) " for syntax"]
[else (format " for phase ~a" phase)]))
orig-s
id))
(cond
[(not at-mod)
;; Binding is from an enclosing context; if it's from an
;; enclosing module, then we've already marked bindings
;; a non-simple --- otherwise, we don't care
(void)]
#f]
[(and ok-binding (same-binding? b ok-binding))
;; It's the same binding already, so overall binding hasn't
;; become non-simple
@ -327,7 +357,19 @@
;; We can't reset now, because the caller is preparing for
;; a bulk bind. Record that we need to merge nominals.
(set-box! accum-update-nominals (cons update! (unbox accum-update-nominals)))]
[else (update!)]))]
[else (update!)]))
defined?]
[(and defined? allow-defined?)
;; A `require` doesn't conflict with a definition, even if we
;; saw the definition earlier; but make sure there are not multiple
;; `require`s (any one of which would be shadowed by the definition)
(define also-required (requires+provides-also-required r+p))
(define prev-b (hash-ref also-required (module-binding-sym b) #f))
(when (and prev-b (not (same-binding? ok-binding prev-b)))
(raise-already-bound #f))
(hash-set! also-required (module-binding-sym b) ok-binding)
(set-requires+provides-all-bindings-simple?! r+p #f)
#t]
[else
(define nominal-phase (module-binding-nominal-require-phase b))
(define sym-to-reqds (hash-ref at-mod nominal-phase #hasheq()))
@ -339,21 +381,12 @@
(required-can-be-shadowed? r))
;; Shadowing --- ok, but non-simple
(set-requires+provides-all-bindings-simple?! r+p #f)]
[else
(raise-syntax-error who
(string-append "identifier already "
(if defined? "defined" "required")
(cond
[(zero-phase? phase) ""]
[(label-phase? phase) " for label"]
[(= 1 phase) " for syntax"]
[else (format " for phase ~a" phase)]))
orig-s
id)]))
[else (raise-already-bound defined?)]))
(when (and remove-shadowed!? (not (null? reqds)))
;; Same work as in `remove-required-id!`
(hash-set! sym-to-reqds (syntax-e id)
(remove-non-matching-requireds reqds id phase mpi nominal-phase (syntax-e id))))])])]))
(remove-non-matching-requireds reqds id phase mpi nominal-phase (syntax-e id))))
#f])])]))
(define (add-defined-syms! r+p syms phase)
(define phase-to-defined-syms (requires+provides-phase-to-defined-syms r+p))

52
racket/src/expander/expand/require.rkt
View File

@ -258,6 +258,7 @@
m
bind-in-stx phase-shift m-ns interned-mpi module-name
#:in orig-s
#:defines-mpi (and requires+provides (requires+provides-self requires+provides))
#:only (cond
[(adjust-only? adjust) (set->list (adjust-only-syms adjust))]
[(adjust-rename? adjust) (list (adjust-rename-from-sym adjust))]
@ -271,6 +272,7 @@
requires+provides
can-bulk-bind?
(lambda (provides provide-phase-level)
;; Returns #t if any binding is already shadowed by a definition:
(add-bulk-required-ids! requires+provides
bind-in-stx
(module-self m) mpi phase-shift
@ -314,28 +316,37 @@
(and (eq? sym (adjust-rename-from-sym adjust))
(hash-set! done-syms sym #t)
(adjust-rename-to-id adjust))]))
(when (and adjusted-sym requires+provides)
(define s (datum->syntax bind-in-stx adjusted-sym))
(define bind-phase (phase+ phase-shift provide-phase))
(unless initial-require?
(check-not-defined #:check-not-required? #t
requires+provides
s bind-phase
#:unless-matches binding
#:in orig-s
#:remove-shadowed!? #t
#:who who))
(add-defined-or-required-id! requires+provides
s bind-phase binding
#:can-be-shadowed? can-be-shadowed?
#:as-transformer? as-transformer?))
(define skip-bind?
(cond
[(and adjusted-sym requires+provides)
(define s (datum->syntax bind-in-stx adjusted-sym))
(define bind-phase (phase+ phase-shift provide-phase))
(define skip-bind?
(cond
[initial-require? #f]
[else
(check-not-defined #:check-not-required? #t
#:allow-defined? #t ; `define` shadows `require`
requires+provides
s bind-phase
#:unless-matches binding
#:in orig-s
#:remove-shadowed!? #t
#:who who)]))
(unless skip-bind?
(add-defined-or-required-id! requires+provides
s bind-phase binding
#:can-be-shadowed? can-be-shadowed?
#:as-transformer? as-transformer?))
skip-bind?]
[else #f]))
(when (and adjusted-sym
copy-variable-phase-level
(not as-transformer?)
(equal? provide-phase copy-variable-phase-level))
(copy-namespace-value m-ns adjusted-sym binding copy-variable-phase-level phase-shift
copy-variable-as-constant?))
adjusted-sym)))
(and (not skip-bind?) adjusted-sym))))
;; Now that a bulk binding is in place, update to merge nominals:
(when update-nominals-box
(for ([update! (in-list (unbox update-nominals-box))])
@ -359,6 +370,7 @@
(define (bind-all-provides! m in-stx phase-shift ns mpi module-name
#:in orig-s
#:defines-mpi defines-mpi
#:only only-syms
#:just-meta just-meta
#:bind? bind?
@ -372,8 +384,9 @@
#:when (or (eq? just-meta 'all)
(eqv? just-meta provide-phase-level)))
(define phase (phase+ phase-shift provide-phase-level))
(when bulk-callback
(bulk-callback provides provide-phase-level))
(define need-except?
(and bulk-callback
(bulk-callback provides provide-phase-level)))
(when bind?
(when filter
(for ([sym (in-list (or only-syms (hash-keys provides)))])
@ -408,7 +421,8 @@
self mpi provide-phase-level phase-shift
bulk-binding-registry)
phase
#:in orig-s)))))
#:in orig-s
#:shadow-except (and need-except? defines-mpi))))))
;; ----------------------------------------

36
racket/src/expander/syntax/binding-table.rkt
View File

@ -3,7 +3,8 @@
"../common/set.rkt"
"../compile/serialize-property.rkt"
"../compile/serialize-state.rkt"
"syntax.rkt")
"syntax.rkt"
"module-binding.rkt")
;; A binding table within a scope maps symbol plus scope set
;; combinations (where the scope binding the binding table is always
@ -105,7 +106,7 @@
just-for-nominal?))
;; Keep `syms/serialize` in sync with `syms`, except for bindings
;; that are just to extend the set of nominal imports. We keep those
;; separate --- and don't serialize them --- because they interfere
;; separate --- and don't serialize them --- because they interfere
;; with bulk representations of binding and they're used only to
;; commuincate to `provide`.
(define new-syms/serialize
@ -124,18 +125,21 @@
[syms/serialize new-syms/serialize])]))
;; Adding a binding for a computed-on-demand set of symbols
(define (binding-table-add-bulk bt scopes bulk)
(define (binding-table-add-bulk bt scopes bulk
#:shadow-except [shadow-except #f])
(cond
[(table-with-bulk-bindings? bt)
(define new-syms (remove-matching-bindings (table-with-bulk-bindings-syms bt)
scopes
bulk))
bulk
#:except shadow-except))
(define new-syms/serialize (if (eq? (table-with-bulk-bindings-syms bt)
(table-with-bulk-bindings-syms/serialize bt))
new-syms
(remove-matching-bindings (table-with-bulk-bindings-syms/serialize bt)
scopes
bulk)))
bulk
#:except shadow-except)))
(table-with-bulk-bindings new-syms
new-syms/serialize
(cons (bulk-binding-at scopes bulk)
@ -144,28 +148,36 @@
(binding-table-add-bulk (table-with-bulk-bindings bt bt null) scopes bulk)]))
;; The bindings of `bulk` at `scopes` should shadow any existing
;; mappings in `sym-bindings`
(define (remove-matching-bindings syms scopes bulk)
;; mappings in `sym-bindings`, except one for `except`
(define (remove-matching-bindings syms scopes bulk #:except except)
(define bulk-symbols (bulk-binding-symbols bulk #f null))
(cond
[((hash-count syms) . < . (hash-count bulk-symbols))
;; Faster to consider each sym in `sym-binding`
;; Faster to consider each sym in `syms`
(for/fold ([syms syms]) ([(sym sym-bindings) (in-immutable-hash syms)])
(if (hash-ref bulk-symbols sym #f)
(remove-matching-binding syms sym sym-bindings scopes)
(remove-matching-binding syms sym sym-bindings scopes #:except except)
syms))]
[else
;; Faster to consider each sym in `bulk-symbols`
(for/fold ([syms syms]) ([sym (in-immutable-hash-keys bulk-symbols)])
(define sym-bindings (hash-ref syms sym #f))
(if sym-bindings
(remove-matching-binding syms sym sym-bindings scopes)
(remove-matching-binding syms sym sym-bindings scopes #:except except)
syms))]))
;; Update an individual symbol's bindings to remove a mapping
;; for a given set of scopes
(define (remove-matching-binding syms sym sym-bindings scopes)
(hash-set syms sym (hash-remove sym-bindings scopes)))
(define (remove-matching-binding syms sym sym-bindings scopes #:except except)
(cond
[(and except
(let ([b (hash-ref sym-bindings scopes #f)])
(and (module-binding? b)
(eq? except (module-binding-module b)))))
;; Don't replace a shadowing definition
syms]
[else
(hash-set syms sym (hash-remove sym-bindings scopes))]))
;; ----------------------------------------

6
racket/src/expander/syntax/scope.rkt
View File

@ -741,9 +741,11 @@
(set-scope-binding-table! max-sc bt)
(clear-resolve-cache! sym))
(define (add-bulk-binding-in-scopes! scopes bulk-binding)
(define (add-bulk-binding-in-scopes! scopes bulk-binding
#:shadow-except [shadow-except #f])
(define max-sc (find-max-scope scopes))
(define bt (binding-table-add-bulk (scope-binding-table max-sc) scopes bulk-binding))
(define bt (binding-table-add-bulk (scope-binding-table max-sc) scopes bulk-binding
#:shadow-except shadow-except))
(set-scope-binding-table! max-sc bt)
(clear-resolve-cache!))

29770
racket/src/racket/src/startup.inc
View File

File diff suppressed because it is too large Load Diff