Report more information for untyped imported identifiers
svn: r14418 original commit: 2aab5762370806fb648694cbbd6cb1c44ba2fc83
This commit is contained in:
parent
35a67354ca
commit
7b70ced131
7
collects/tests/typed-scheme/fail/untyped-srfi1.ss
Normal file
7
collects/tests/typed-scheme/fail/untyped-srfi1.ss
Normal file
|
@ -0,0 +1,7 @@
|
|||
#;
|
||||
(exn-pred ".*untyped identifier map.*" ".*srfi.*")
|
||||
#lang typed-scheme
|
||||
|
||||
(require srfi/1)
|
||||
|
||||
map
|
2
collects/typed-scheme/env/lexical-env.ss
vendored
2
collects/typed-scheme/env/lexical-env.ss
vendored
|
@ -33,7 +33,7 @@
|
|||
=>
|
||||
(lambda (a)
|
||||
(-lst (substitute Univ (cdr a) (car a))))]
|
||||
[else (lookup-fail (syntax-e i))]))))))
|
||||
[else (lookup-fail i)]))))))
|
||||
|
||||
;; refine the type of i in the lexical env
|
||||
;; (identifier type -> type) identifier -> environment
|
||||
|
|
2
collects/typed-scheme/env/type-env.ss
vendored
2
collects/typed-scheme/env/type-env.ss
vendored
|
@ -39,7 +39,7 @@
|
|||
;; given an identifier, return the type associated with it
|
||||
;; if none found, calls lookup-fail
|
||||
;; identifier -> type
|
||||
(define (lookup-type id [fail-handler (lambda () (lookup-fail (syntax-e id)))])
|
||||
(define (lookup-type id [fail-handler (lambda () (lookup-type-fail id))])
|
||||
(let ([v (module-identifier-mapping-get the-mapping id fail-handler)])
|
||||
(if (box? v) (unbox v) v)))
|
||||
|
||||
|
|
2
collects/typed-scheme/env/type-name-env.ss
vendored
2
collects/typed-scheme/env/type-name-env.ss
vendored
|
@ -35,7 +35,7 @@
|
|||
;; given an identifier, return the type associated with it
|
||||
;; optional argument is failure continuation - default calls lookup-fail
|
||||
;; identifier (-> error) -> type
|
||||
(define (lookup-type-name id [k (lambda () (lookup-fail (syntax-e id)))])
|
||||
(define (lookup-type-name id [k (lambda () (lookup-type-fail id))])
|
||||
(begin0
|
||||
(module-identifier-mapping-get the-mapping id k)
|
||||
(add-type-name-reference id)))
|
||||
|
|
|
@ -29,7 +29,8 @@
|
|||
(struct-out DottedBoth)
|
||||
just-Dotted?
|
||||
tc-error/expr
|
||||
lookup-fail)
|
||||
lookup-fail
|
||||
lookup-type-fail)
|
||||
|
||||
|
||||
;; substitute : Type Name Type -> Type
|
||||
|
@ -218,4 +219,16 @@
|
|||
return)
|
||||
|
||||
;; error for unbound variables
|
||||
(define (lookup-fail e) (tc-error/expr "unbound identifier ~a" e))
|
||||
(define (lookup-fail e)
|
||||
(match (identifier-binding e)
|
||||
['lexical (int-err "untyped lexical variable ~a" (syntax-e e))]
|
||||
[#f (int-err "untyped top-level variable ~a" (syntax-e e))]
|
||||
[(list _ _ nominal-source-mod nominal-source-id _ _ _)
|
||||
(let-values ([(x y) (module-path-index-split nominal-source-mod)])
|
||||
(cond [(and (not x) (not y))
|
||||
(tc-error/expr "untyped identifier ~a" (syntax-e e))]
|
||||
[else
|
||||
(tc-error/expr "untyped identifier ~a imported from module <~a>" (syntax-e e) x)]))]))
|
||||
|
||||
(define (lookup-type-fail i)
|
||||
(tc-error/expr "~a is not bound as a type" (syntax-e i)))
|
||||
|
|
Loading…
Reference in New Issue
Block a user