expander: repair phase >= 1 undefined-variable checking

Closes #1996
This commit is contained in:
Matthew Flatt 2018-03-20 07:02:35 -06:00
parent 5ed0cdf563
commit 93e3b44fd2
5 changed files with 4623 additions and 4518 deletions

View File

@ -2443,4 +2443,19 @@ case of module-leve bindings; it doesn't cover local bindings.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ([check
(lambda (later rx)
(err/rt-test (expand `(module m racket/base
(require (for-syntax racket/base))
(begin-for-syntax
(define (foo) (bar)))
,later))
(lambda (exn)
(regexp-match? rx (exn-message exn)))))])
(check '(void) "unbound identifier")
(check '(begin-for-syntax (struct bar ())) #rx"later defined as syntax")
(check '(require (for-syntax (only-in racket/base [car bar]))) #rx"later bound differently"))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)

View File

@ -369,7 +369,7 @@
#:mpis-to-reset mpis-to-reset))) #:mpis-to-reset mpis-to-reset)))
;; Check that any tentatively allowed reference at phase >= 1 is ok ;; Check that any tentatively allowed reference at phase >= 1 is ok
(check-defined-by-now need-eventually-defined self ctx) (check-defined-by-now need-eventually-defined self ctx requires+provides)
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;; Pass 3: resolve provides at all phases ;; Pass 3: resolve provides at all phases
@ -790,7 +790,7 @@
#:requires+provides requires+provides #:requires+provides requires+provides
#:in exp-body #:in exp-body
#:as-transformer? #t)) #:as-transformer? #t))
(add-defined-syms! requires+provides syms phase) (add-defined-syms! requires+provides syms phase #:as-transformer? #t)
;; Expand and evaluate RHS: ;; Expand and evaluate RHS:
(define-values (exp-rhs parsed-rhs vals) (define-values (exp-rhs parsed-rhs vals)
(expand+eval-for-syntaxes-binding (m 'rhs) ids (expand+eval-for-syntaxes-binding (m 'rhs) ids
@ -1019,17 +1019,27 @@
(cons exp-body (cons exp-body
(loop tail? rest-bodys)))]))) (loop tail? rest-bodys)))])))
(define (check-defined-by-now need-eventually-defined self ctx) (define (check-defined-by-now need-eventually-defined self ctx requires+provides)
;; If `need-eventually-defined` is not empty, report an error ;; If `need-eventually-defined` is not empty, report an error
(for ([(phase l) (in-hash need-eventually-defined)]) (for ([(phase l) (in-hash need-eventually-defined)])
(for ([id (in-list l)]) (for ([id (in-list l)])
(define b (resolve+shift id phase)) (define b (resolve+shift id phase))
;; FIXME: check that the binding is for a variable (define bound-here? (and b
(unless (and b
(module-binding? b) (module-binding? b)
(eq? (module-binding-sym b) (syntax-e id)) (eq? (module-binding-sym b) (syntax-e id))
(eq? (module-binding-module b) self)) (eq? (module-binding-module b) self)))
(raise-syntax-error #f "reference to an unbound identifier" (define bound-kind (and bound-here?
(defined-sym-kind requires+provides (module-binding-sym b) phase)))
(unless (eq? bound-kind 'variable)
(raise-syntax-error #f
(string-append
(cond
[(not b) "reference to an unbound identifier"]
[(eq? bound-kind 'transformer) "identifier treated as a variable, but later defined as syntax"]
[else "identifier treated as a variable, but later bound differently"])
(format "\n at phase: ~a" (case phase
[(1) "1; the transformer environment"]
[else phase])))
id #f null id #f null
(syntax-debug-info-string id ctx)))))) (syntax-debug-info-string id ctx))))))

View File

@ -30,6 +30,7 @@
remove-required-id! remove-required-id!
check-not-defined check-not-defined
add-defined-syms! add-defined-syms!
defined-sym-kind
extract-module-requires extract-module-requires
extract-module-definitions extract-module-definitions
extract-all-module-requires extract-all-module-requires
@ -48,7 +49,7 @@
require-mpis-in-order ; require-phase -> list of module-path-index require-mpis-in-order ; require-phase -> list of module-path-index
requires ; mpi [interned] -> require-phase -> sym -> list-ish of [bulk-]required requires ; mpi [interned] -> require-phase -> sym -> list-ish of [bulk-]required
provides ; phase -> sym -> binding or protected provides ; phase -> sym -> binding or protected
phase-to-defined-syms ; phase -> sym -> boolean phase-to-defined-syms ; phase -> sym -> (or/c 'variable 'transformer)
also-required ; sym -> binding also-required ; sym -> binding
[can-cross-phase-persistent? #:mutable] [can-cross-phase-persistent? #:mutable]
[all-bindings-simple? #:mutable]) ; tracks whether bindings are easily reconstructed [all-bindings-simple? #:mutable]) ; tracks whether bindings are easily reconstructed
@ -397,14 +398,20 @@
(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])])])) #f])])]))
(define (add-defined-syms! r+p syms phase) (define (add-defined-syms! r+p syms phase #:as-transformer? [as-transformer? #f])
(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))
(define defined-syms (hash-ref phase-to-defined-syms phase #hasheq())) (define defined-syms (hash-ref phase-to-defined-syms phase #hasheq()))
(define new-defined-syms (define new-defined-syms
(for/fold ([defined-syms defined-syms]) ([sym (in-list syms)]) (for/fold ([defined-syms defined-syms]) ([sym (in-list syms)])
(hash-set defined-syms sym #t))) (hash-set defined-syms sym (if as-transformer? 'transformer 'variable))))
(hash-set! phase-to-defined-syms phase new-defined-syms)) (hash-set! phase-to-defined-syms phase new-defined-syms))
;; Returns 'variable, 'transformer, or #f
(define (defined-sym-kind r+p sym phase)
(define phase-to-defined-syms (requires+provides-phase-to-defined-syms r+p))
(define defined-syms (hash-ref phase-to-defined-syms phase #hasheq()))
(hash-ref defined-syms sym #f))
;; Get all the bindings imported from a given module ;; Get all the bindings imported from a given module
(define (extract-module-requires r+p mod-name phase) (define (extract-module-requires r+p mod-name phase)
(define mpi (intern-mpi r+p mod-name)) (define mpi (intern-mpi r+p mod-name))

File diff suppressed because it is too large Load Diff