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

expander: fix shadowing require after shadowing define

Browse Source 
Refines the repair in 11fd70c3dd to properly handle a `require` that
should be allowed to shadow the initial require.
This commit is contained in:
Matthew Flatt 2018-03-02 12:58:20 -07:00
parent 2104d02a23
commit e78eb0563a
3 changed files with 14277 additions and 13969 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -712,6 +712,17 @@
(test "last" dynamic-require ''definition-shadows-later-require/2 'result) (test "last" dynamic-require ''definition-shadows-later-require/2 'result)
(module definition-shadows-require-shadowing-initial-require racket/base
(provide result)
(define version 42)
(module M racket/base
(provide (all-defined-out))
(define version 42))
(require 'M)
(define result version))
(test 42 dynamic-require ''definition-shadows-require-shadowing-initial-require 'result)
(err/rt-test (err/rt-test
(eval (eval
'(module m racket/base '(module m racket/base

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

@ -297,96 +297,104 @@
(define defined? (and b (eq? (requires+provides-self r+p) (define defined? (and b (eq? (requires+provides-self r+p)
(module-binding-module b)))) (module-binding-module b))))
(cond (cond
[(and (not defined?) (not check-not-required?)) [(and defined?
;; Not defined, and we're shadowing all requires -- so, it's ok, ;; In case `#%module-begin` is expanded multiple times, check
;; but binding is non-simple ;; that the definition has been seen this particular expansion
(set-requires+provides-all-bindings-simple?! r+p #f) (not (hash-ref (hash-ref (requires+provides-phase-to-defined-syms r+p)
;; Also, record the `require` binding, in case we see another phase
;; `require` for the same identifier #hasheq())
(hash-set! (requires+provides-also-required r+p) (module-binding-sym b) b) (module-binding-sym b)
#f] #f)))
[(and defined? ;; Doesn't count as previously defined
;; In case `#%module-begin` is expanded multiple times, check #f]
;; that the definition has been seen this particular expansion [else
(not (hash-ref (hash-ref (requires+provides-phase-to-defined-syms r+p) (define define-shadowing-require? (and (not defined?) (not check-not-required?)))
phase (define mpi (intern-mpi r+p (module-binding-nominal-module b)))
#hasheq()) (define at-mod (hash-ref (requires+provides-requires r+p) mpi #f))
(module-binding-sym b) (define ok-binding (and (not define-shadowing-require?)
#f))) (if (procedure? ok-binding/delayed)
;; Doesn't count as previously defined (ok-binding/delayed)
#f] ok-binding/delayed)))
[else (define (raise-already-bound defined?)
(define mpi (intern-mpi r+p (module-binding-nominal-module b))) (raise-syntax-error who
(define at-mod (hash-ref (requires+provides-requires r+p) mpi #f)) (string-append "identifier already "
(define ok-binding (if (procedure? ok-binding/delayed) (if defined? "defined" "required")
(ok-binding/delayed) (cond
ok-binding/delayed)) [(zero-phase? phase) ""]
(define (raise-already-bound defined?) [(label-phase? phase) " for label"]
(raise-syntax-error who [(= 1 phase) " for syntax"]
(string-append "identifier already " [else (format " for phase ~a" phase)]))
(if defined? "defined" "required") orig-s
(cond id))
[(zero-phase? phase) ""] (cond
[(label-phase? phase) " for label"] [(and (not at-mod)
[(= 1 phase) " for syntax"] (not define-shadowing-require?))
[else (format " for phase ~a" phase)])) ;; Binding is from an enclosing context; if it's from an
orig-s ;; enclosing module, then we've already marked bindings
id)) ;; a non-simple --- otherwise, we don't care
(cond #f]
[(not at-mod) [(and ok-binding (same-binding? b ok-binding))
;; Binding is from an enclosing context; if it's from an ;; It's the same binding already, so overall binding hasn't
;; enclosing module, then we've already marked bindings ;; become non-simple
;; a non-simple --- otherwise, we don't care (unless (same-binding-nominals? b ok-binding)
#f] ;; Need to accumulate nominals
[(and ok-binding (same-binding? b ok-binding)) (define (update!)
;; It's the same binding already, so overall binding hasn't (add-binding!
;; become non-simple #:just-for-nominal? #t
(unless (same-binding-nominals? b ok-binding) id
;; Need to accumulate nominals (module-binding-update b
(define (update!) #:extra-nominal-bindings
(add-binding! (cons ok-binding
#:just-for-nominal? #t (module-binding-extra-nominal-bindings b)))
id phase))
(module-binding-update b (cond
#:extra-nominal-bindings [accum-update-nominals
(cons ok-binding ;; We can't reset now, because the caller is preparing for
(module-binding-extra-nominal-bindings b))) ;; a bulk bind. Record that we need to merge nominals.
phase)) (set-box! accum-update-nominals (cons update! (unbox accum-update-nominals)))]
[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()))
(define reqds (hash-ref sym-to-reqds (syntax-e id) null))
(define only-can-can-shadow-require?
(for/fold ([only-can-can-shadow-require? #t]) ([r (in-list-ish reqds)])
(cond
[(if (bulk-required? r)
(bulk-required-can-be-shadowed? r)
(required-can-be-shadowed? r))
;; Shadowing --- ok, but non-simple
(set-requires+provides-all-bindings-simple?! r+p #f)
only-can-can-shadow-require?]
[define-shadowing-require? #f]
[else (raise-already-bound defined?)])))
(cond (cond
[accum-update-nominals [define-shadowing-require?
;; We can't reset now, because the caller is preparing for ;; Not defined, but defining now (shadowing all requires);
;; a bulk bind. Record that we need to merge nominals. ;; make sure we indicated that the binding is non-simple
(set-box! accum-update-nominals (cons update! (unbox accum-update-nominals)))] (set-requires+provides-all-bindings-simple?! r+p #f)
[else (update!)])) (unless only-can-can-shadow-require?
defined?] ;; Record the `require` binding, if it's non-shadowable,
[(and defined? allow-defined?) ;; in case we see another `require` for the same identifier
;; A `require` doesn't conflict with a definition, even if we (hash-set! (requires+provides-also-required r+p) (module-binding-sym b) b))]
;; saw the definition earlier; but make sure there are not multiple [else
;; `require`s (any one of which would be shadowed by the definition) (when (and remove-shadowed!? (not (null? reqds)))
(define also-required (requires+provides-also-required r+p)) ;; Same work as in `remove-required-id!`
(define prev-b (hash-ref also-required (module-binding-sym b) #f)) (hash-set! sym-to-reqds (syntax-e id)
(when (and prev-b (not (same-binding? ok-binding prev-b))) (remove-non-matching-requireds reqds id phase mpi nominal-phase (syntax-e id))))])
(raise-already-bound #f)) #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()))
(define reqds (hash-ref sym-to-reqds (syntax-e id) null))
(for ([r (in-list-ish reqds)])
(cond
[(if (bulk-required? r)
(bulk-required-can-be-shadowed? r)
(required-can-be-shadowed? r))
;; Shadowing --- ok, but non-simple
(set-requires+provides-all-bindings-simple?! r+p #f)]
[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))))
#f])])]))
(define (add-defined-syms! r+p syms phase) (define (add-defined-syms! r+p syms phase)
(define phase-to-defined-syms (requires+provides-phase-to-defined-syms r+p)) (define phase-to-defined-syms (requires+provides-phase-to-defined-syms r+p))

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

File diff suppressed because it is too large Load Diff