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

Make tc-error/expr return (ret -Bottom).

Browse Source
This commit is contained in:
Eric Dobson 2014-03-20 09:32:25 -07:00
parent ef98a582cb
commit ca3411155f
14 changed files with 55 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt
View File

@ -108,10 +108,9 @@
(let ([ty (tc-expr expr)]) (let ([ty (tc-expr expr)])
(match ty (match ty
[(tc-any-results:) [(tc-any-results:)
(ret
(tc-error/expr (tc-error/expr
"Expression should produce ~a values, but produces an unknown number of values" "Expression should produce ~a values, but produces an unknown number of values"
(length stxs)))] (length stxs))]
[(tc-results: tys fs os) [(tc-results: tys fs os)
(if (not (= (length stxs) (length tys))) (if (not (= (length stxs) (length tys)))
(tc-error/expr #:return (ret (map (lambda _ (Un)) stxs)) (tc-error/expr #:return (ret (map (lambda _ (Un)) stxs))

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
View File

@ -1352,7 +1352,7 @@
(make-PolyDots ns (method->function type))] (make-PolyDots ns (method->function type))]
[(PolyRow-names: ns constraints body) [(PolyRow-names: ns constraints body)
(make-PolyRow ns constraints (method->function type))] (make-PolyRow ns constraints (method->function type))]
[_ (tc-error/expr "expected a function type for method")])) [_ (tc-error/expr #:return -Bottom "expected a function type for method")]))
;; annotate-method : Syntax Type -> Syntax ;; annotate-method : Syntax Type -> Syntax
;; Adds a self type annotation for the first argument and annotated ;; Adds a self type annotation for the first argument and annotated

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
View File

@ -348,8 +348,7 @@
"function")]) "function")])
(if (and (andmap null? msg-doms) (if (and (andmap null? msg-doms)
(null? argtypes)) (null? argtypes))
(tc-error/expr #:return (ret (Un)) (tc-error/expr (string-append
(string-append
"Could not infer types for applying polymorphic " "Could not infer types for applying polymorphic "
fcn-string fcn-string
"\n")) "\n"))
@ -372,8 +371,7 @@
"function with keywords")]) "function with keywords")])
(if (and (andmap null? msg-doms) (if (and (andmap null? msg-doms)
(null? argtypes)) (null? argtypes))
(tc-error/expr #:return (ret (Un)) (tc-error/expr (string-append
(string-append
"Could not infer types for applying polymorphic " "Could not infer types for applying polymorphic "
fcn-string fcn-string
"\n")) "\n"))

9
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt
View File

@ -36,14 +36,13 @@
#f])])) #f])]))
(define (index-error i-val i-bound expr type name) (define (index-error i-val i-bound expr type name)
(define return (ret -Bottom))
(cond (cond
[(not (and (integer? i-val) (exact? i-val))) [(not (and (integer? i-val) (exact? i-val)))
(tc-error/expr #:stx expr #:return return "expected exact integer for ~a index, but got ~a" name i-val)] (tc-error/expr #:stx expr "expected exact integer for ~a index, but got ~a" name i-val)]
[(< i-val 0) [(< i-val 0)
(tc-error/expr #:stx expr #:return return "index ~a too small for ~a ~a" i-val name type)] (tc-error/expr #:stx expr "index ~a too small for ~a ~a" i-val name type)]
[(not (< i-val i-bound)) [(not (< i-val i-bound))
(tc-error/expr #:stx expr #:return return "index ~a too large for ~a ~a" i-val name type)])) (tc-error/expr #:stx expr "index ~a too large for ~a ~a" i-val name type)]))
(define (valid-index? i bound) (define (valid-index? i bound)
(and (integer? i) (exact? i) (<= 0 i (sub1 bound)))) (and (integer? i) (exact? i) (<= 0 i (sub1 bound))))
@ -119,7 +118,7 @@
(tc-expr/check/t e (ret t)))) (tc-expr/check/t e (ret t))))
-true-filter)] -true-filter)]
[else [else
(tc-error/expr #:return (ret -Bottom) (tc-error/expr
"expected vector with ~a elements, but got ~a" "expected vector with ~a elements, but got ~a"
(length ts) (make-HeterogeneousVector (stx-map tc-expr/t #'(args ...))))])] (length ts) (make-HeterogeneousVector (stx-map tc-expr/t #'(args ...))))])]
;; If the expected type is a union, then we examine just the parts ;; If the expected type is a union, then we examine just the parts

12
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt
View File

@ -46,11 +46,9 @@
(tc-keywords #'(#%plain-app . form) arities (type->list (tc-expr/t #'kws)) (tc-keywords #'(#%plain-app . form) arities (type->list (tc-expr/t #'kws))
#'kw-arg-list #'pos-args expected)] #'kw-arg-list #'pos-args expected)]
[(tc-result1: (Poly: _ (Function: _))) [(tc-result1: (Poly: _ (Function: _)))
(tc-error/expr #:return (ret (Un)) (tc-error/expr "Inference for polymorphic keyword functions not supported")]
"Inference for polymorphic keyword functions not supported")]
[(tc-result1: t) [(tc-result1: t)
(tc-error/expr #:return (ret (Un)) (tc-error/expr "Cannot apply expression of type ~a, since it is not a function type" t)])))
"Cannot apply expression of type ~a, since it is not a function type" t)])))
(define (tc-keywords/internal arity kws kw-args error?) (define (tc-keywords/internal arity kws kw-args error?)
(match arity (match arity
@ -64,15 +62,13 @@
(void)] (void)]
[(_ '()) [(_ '())
(if error? (if error?
(tc-error/expr #:return (ret (Un)) (tc-error/delayed "Unexpected keyword argument ~a" (car actual-kws))
"Unexpected keyword argument ~a" (car actual-kws))
#f)] #f)]
[('() (cons fst rst)) [('() (cons fst rst))
(match fst (match fst
[(Keyword: k _ #t) [(Keyword: k _ #t)
(if error? (if error?
(tc-error/expr #:return (ret (Un)) (tc-error/delayed "Missing keyword argument ~a" k)
"Missing keyword argument ~a" k)
#f)] #f)]
[_ (loop actual-kws actuals rst)])] [_ (loop actual-kws actuals rst)])]
[((cons k kws-rest) (cons (Keyword: k* t req?) form-rest)) [((cons k kws-rest) (cons (Keyword: k* t req?) form-rest))

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-list.rkt
View File

@ -53,8 +53,7 @@
expected-elem-type)) expected-elem-type))
[(tc-result1: t) (ret (make-ListDots t bound0))] [(tc-result1: t) (ret (make-ListDots t bound0))]
[(tc-results: ts) [(tc-results: ts)
(tc-error/expr #:return (ret (Un)) (tc-error/expr "Expected one value, but got ~a" (-values ts))])]
"Expected one value, but got ~a" (-values ts))])]
;; otherwise, if it's not a ListDots, defer to the regular function typechecking ;; otherwise, if it's not a ListDots, defer to the regular function typechecking
;; TODO fix double typechecking ;; TODO fix double typechecking
[(res0 res) (tc/app-regular #'form expected)])) [(res0 res) (tc/app-regular #'form expected)]))

13
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-objects.rkt
View File

@ -81,8 +81,7 @@
(check-named-inits other-inits given-names name-assoc)]) (check-named-inits other-inits given-names name-assoc)])
(ret (make-Instance c))] (ret (make-Instance c))]
[t [t
(tc-error/expr #:return (ret (Un)) (tc-error/expr "expected a class value for object creation, got: ~a" t)]))
"expected a class value for object creation, got: ~a" t)]))
(define (check-named-inits inits names name-assoc) (define (check-named-inits inits names name-assoc)
(define init-names (map car inits)) (define init-names (map car inits))
@ -112,8 +111,7 @@
(syntax-parse meth [(quote m:id) (syntax-e #'m)] [_ #f])) (syntax-parse meth [(quote m:id) (syntax-e #'m)] [_ #f]))
(define obj-type (tc-expr/t obj)) (define obj-type (tc-expr/t obj))
(unless maybe-meth-sym (unless maybe-meth-sym
(tc-error/expr #:return (ret (Un)) (tc-error/expr "expected a symbolic method name, but got ~a" meth))
"expected a symbolic method name, but got ~a" meth))
(define (check obj-type) (define (check obj-type)
(match (resolve obj-type) (match (resolve obj-type)
;; FIXME: handle unions and mu? ;; FIXME: handle unions and mu?
@ -122,7 +120,6 @@
(λ (field-entry) (ret (cadr field-entry)))] (λ (field-entry) (ret (cadr field-entry)))]
[else [else
(tc-error/expr/fields "type mismatch" (tc-error/expr/fields "type mismatch"
#:return (ret (Un))
#:more "the object is missing an expected field" #:more "the object is missing an expected field"
"field" maybe-meth-sym "field" maybe-meth-sym
"object type" ty)])] "object type" ty)])]
@ -131,7 +128,6 @@
[type [type
(tc-error/expr/fields "type mismatch" (tc-error/expr/fields "type mismatch"
#:more "expected an object value for get-field" #:more "expected an object value for get-field"
#:return (ret (Un))
"given" type)])) "given" type)]))
(check obj-type)) (check obj-type))
@ -141,8 +137,7 @@
(define maybe-field-sym (define maybe-field-sym
(syntax-parse field [(quote f:id) (syntax-e #'f)] [_ #f])) (syntax-parse field [(quote f:id) (syntax-e #'f)] [_ #f]))
(unless maybe-field-sym (unless maybe-field-sym
(tc-error/expr #:return (ret (Un)) (tc-error/expr "expected a symbolic field name, but got ~a" field))
"expected a symbolic field name, but got ~a" field))
(define obj-type (tc-expr/t obj)) (define obj-type (tc-expr/t obj))
(define val-type (tc-expr/t val)) (define val-type (tc-expr/t val))
(define (check obj-type) (define (check obj-type)
@ -163,14 +158,12 @@
(tc-error/expr/fields "type mismatch" (tc-error/expr/fields "type mismatch"
#:more (~a "expected an object with field " #:more (~a "expected an object with field "
maybe-field-sym) maybe-field-sym)
#:return (ret (Un))
"given" ty)])] "given" ty)])]
[(Instance: (? needs-resolving? type)) [(Instance: (? needs-resolving? type))
(check (make-Instance (resolve type)))] (check (make-Instance (resolve type)))]
[type [type
(tc-error/expr/fields "type mismatch" (tc-error/expr/fields "type mismatch"
#:more "expected an object value for set-field!" #:more "expected an object value for set-field!"
#:return (ret (Un))
"given" type)])) "given" type)]))
(check obj-type)) (check obj-type))

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt
View File

@ -33,13 +33,13 @@
(single-value #'arg expected)] (single-value #'arg expected)]
[(tc-results: ts) [(tc-results: ts)
(single-value #'arg) ;Type check the argument, to find other errors (single-value #'arg) ;Type check the argument, to find other errors
(tc-error/expr #:return (ret -Bottom) (tc-error/expr
"wrong number of values: expected ~a but got one" "wrong number of values: expected ~a but got one"
(length ts))] (length ts))]
;; match polydots case and error ;; match polydots case and error
[(tc-results: ts _ _ dty dbound) [(tc-results: ts _ _ dty dbound)
(single-value #'arg) (single-value #'arg)
(tc-error/expr #:return (ret -Bottom) (tc-error/expr
"Expected ~a ..., but got only one value" dty)])) "Expected ~a ..., but got only one value" dty)]))
;; handle `values' specially ;; handle `values' specially
(pattern (values . args) (pattern (values . args)
@ -53,7 +53,7 @@
(single-value arg (ret et ef eo)))]) (single-value arg (ret et ef eo)))])
(if (= (length ts) (length ets) (syntax-length #'args)) (if (= (length ts) (length ets) (syntax-length #'args))
(ret ts fs os) (ret ts fs os)
(tc-error/expr #:return (ret -Bottom) "wrong number of values: expected ~a but got ~a" (tc-error/expr "wrong number of values: expected ~a but got ~a"
(length ets) (syntax-length #'args))))] (length ets) (syntax-length #'args))))]
[_ (match-let ([(list (tc-result1: ts fs os) ...) [_ (match-let ([(list (tc-result1: ts fs os) ...)
(for/list ([arg (in-syntax #'args)]) (for/list ([arg (in-syntax #'args)])

13
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
View File

@ -38,8 +38,7 @@
[(tc-result1: (and t (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ...)))) [(tc-result1: (and t (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ...))))
;; special case for (case-lambda) ;; special case for (case-lambda)
(when (null? doms) (when (null? doms)
(tc-error/expr #:return (ret (Un)) (tc-error/expr "empty case-lambda given as argument to apply"))
"empty case-lambda given as argument to apply"))
(match-let* ([arg-tres (map tc-expr fixed-args)] (match-let* ([arg-tres (map tc-expr fixed-args)]
[arg-tys (map (match-lambda [(tc-result1: t _ _) t]) arg-tres)] [arg-tys (map (match-lambda [(tc-result1: t _ _) t]) arg-tres)]
[(tc-result1: tail-ty) (single-value tail)]) [(tc-result1: tail-ty) (single-value tail)])
@ -138,8 +137,7 @@
;; if nothing matches, around the loop again ;; if nothing matches, around the loop again
[else (loop (cdr doms*) (cdr rngs*) (cdr rests*) (cdr drests*))])))] [else (loop (cdr doms*) (cdr rngs*) (cdr rests*) (cdr drests*))])))]
[(tc-result1: (Poly: vars (Function: '()))) [(tc-result1: (Poly: vars (Function: '())))
(tc-error/expr #:return (ret (Un)) (tc-error/expr "Function has no cases")]
"Function has no cases")]
[(tc-result1: (PolyDots: (and vars (list fixed-vars ... dotted-var)) [(tc-result1: (PolyDots: (and vars (list fixed-vars ... dotted-var))
(Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1)))) (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1))))
(let*-values ([(arg-tres) (map tc-expr fixed-args)] (let*-values ([(arg-tres) (map tc-expr fixed-args)]
@ -221,7 +219,6 @@
;; if nothing matches, around the loop again ;; if nothing matches, around the loop again
[else (loop (cdr doms*) (cdr rngs*) (cdr rests*) (cdr drests*))])))] [else (loop (cdr doms*) (cdr rngs*) (cdr rests*) (cdr drests*))])))]
[(tc-result1: (PolyDots: vars (Function: '()))) [(tc-result1: (PolyDots: vars (Function: '())))
(tc-error/expr #:return (ret (Un)) (tc-error/expr "Function has no cases")]
"Function has no cases")] [(tc-result1: f-ty)
[(tc-result1: f-ty) (tc-error/expr #:return (ret (Un)) (tc-error/expr "Type of argument to apply is not a function type: \n~a" f-ty)]))
"Type of argument to apply is not a function type: \n~a" f-ty)]))

15
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
View File

@ -126,7 +126,7 @@
(check-row-constraints (check-row-constraints
row constraints row constraints
(λ (name) (λ (name)
(tc-error/expr (tc-error/delayed
(~a "Cannot instantiate row with member " name (~a "Cannot instantiate row with member " name
" that the given row variable requires to be absent")))) " that the given row variable requires to be absent"))))
(instantiate-poly ty (list row))]))] (instantiate-poly ty (list row))]))]
@ -210,10 +210,10 @@
(cond [(and (identifier? var) (lookup-type/lexical var #:fail (λ _ #f))) (cond [(and (identifier? var) (lookup-type/lexical var #:fail (λ _ #f)))
=> =>
(λ (t) (λ (t)
(tc-error/expr #:return (ret (Un)) #:stx stx (tc-error/expr #:stx stx
(string-append (syntax-e msg) "; missing coverage of ~a") (string-append (syntax-e msg) "; missing coverage of ~a")
t))] t))]
[else (tc-error/expr #:return (ret (Un)) #:stx stx (syntax-e msg))])) [else (tc-error/expr #:stx stx (syntax-e msg))]))
;; check that `expr` doesn't evaluate any references ;; check that `expr` doesn't evaluate any references
;; to `name` that aren't under `lambda` ;; to `name` that aren't under `lambda`
@ -291,8 +291,7 @@
;(tc-expr/check/type #'e2 Univ) ;(tc-expr/check/type #'e2 Univ)
;(tc-expr/check #'e3 expected) ;(tc-expr/check #'e3 expected)
(tc-error/expr "with-continuation-mark requires a continuation-mark-key, but got ~a" key-t (tc-error/expr "with-continuation-mark requires a continuation-mark-key, but got ~a" key-t)])]
#:return (ret -Bottom))])]
;; application ;; application
[(#%plain-app . _) (tc/app/check form expected)] [(#%plain-app . _) (tc/app/check form expected)]
;; #%expression ;; #%expression
@ -355,7 +354,7 @@
[(tc-result1: t) [(tc-result1: t)
(with-lexical-env/extend (list #'name) (list t) (tc-expr/check #'expr expected))] (with-lexical-env/extend (list #'name) (list t) (tc-expr/check #'expr expected))]
[(tc-results: ts) [(tc-results: ts)
(tc-error/expr #:return (ret (Un)) "Expected ~a values, but got only 1" (length ts))])] (tc-error/expr "Expected ~a values, but got only 1" (length ts))])]
[(letrec-values ([(name ...) expr] ...) . body) [(letrec-values ([(name ...) expr] ...) . body)
(tc/letrec-values #'((name ...) ...) #'(expr ...) #'body expected)] (tc/letrec-values #'((name ...) ...) #'(expr ...) #'body expected)]
;; other ;; other
@ -406,8 +405,7 @@
(tc-expr #'e3)] (tc-expr #'e3)]
[(tc-result1: key-t) [(tc-result1: key-t)
;; see comments in the /check variant ;; see comments in the /check variant
(tc-error/expr "with-continuation-mark requires a continuation-mark-key, but got ~a" key-t (tc-error/expr "with-continuation-mark requires a continuation-mark-key, but got ~a" key-t)])]
#:return (ret (Un)))])]
;; lambda ;; lambda
[(#%plain-lambda formals . body) [(#%plain-lambda formals . body)
(tc/lambda form #'(formals) #'(body))] (tc/lambda form #'(formals) #'(body))]
@ -519,7 +517,6 @@
[(tc-result1: _ _ _) t] [(tc-result1: _ _ _) t]
[_ (tc-error/expr [_ (tc-error/expr
#:stx form #:stx form
#:return (ret (Un))
"expected single value, got multiple (or zero) values")])) "expected single value, got multiple (or zero) values")]))
;; type-check a body of exprs, producing the type of the last one. ;; type-check a body of exprs, producing the type of the last one.

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
View File

@ -166,7 +166,6 @@
in t))] in t))]
[((tc-result1: (Param: _ _)) _) [((tc-result1: (Param: _ _)) _)
(tc-error/expr (tc-error/expr
#:return (ret (Un))
"Wrong number of arguments to parameter - expected 0 or 1, got ~a" "Wrong number of arguments to parameter - expected 0 or 1, got ~a"
(length argtys))] (length argtys))]
;; resolve names, polymorphic apps, mu, etc ;; resolve names, polymorphic apps, mu, etc
@ -182,12 +181,10 @@
;; otherwise fail ;; otherwise fail
[((tc-result1: (and f-ty (Poly: ns (Function: arrs)))) _) [((tc-result1: (and f-ty (Poly: ns (Function: arrs)))) _)
(tc-error/expr (tc-error/expr
#:return (ret (Un))
(string-append "Cannot infer type instantiation for type ~a. Please add " (string-append "Cannot infer type instantiation for type ~a. Please add "
"more type annotations") "more type annotations")
f-ty)] f-ty)]
[((tc-result1: f-ty) _) [((tc-result1: f-ty) _)
(tc-error/expr (tc-error/expr
#:return (ret (Un))
"Cannot apply expression of type ~a, since it is not a function type" "Cannot apply expression of type ~a, since it is not a function type"
f-ty)])) f-ty)]))

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-if.rkt
View File

@ -99,6 +99,5 @@
(ret us fs3 os3)] (ret us fs3 os3)]
;; otherwise, error ;; otherwise, error
[else [else
(tc-error/expr #:return (ret -Bottom) (tc-error/expr "Expected the same number of values from both branches of `if' expression, but got ~a and ~a"
"Expected the same number of values from both branches of `if' expression, but got ~a and ~a"
(length ts) (length us))])])))])) (length ts) (length us))])])))]))

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-send.rkt
View File

@ -22,13 +22,13 @@
(let* ([ftype (cond [(assq s methods) => cadr] (let* ([ftype (cond [(assq s methods) => cadr]
[else (tc-error/expr/fields "send: method not understood by object" [else (tc-error/expr/fields "send: method not understood by object"
"method name" s "method name" s
"object type" obj)])] "object type" obj
#:return -Bottom)])]
[retval (tc/funapp rcvr args (ret ftype) (stx-map tc-expr args) expected)]) [retval (tc/funapp rcvr args (ret ftype) (stx-map tc-expr args) expected)])
(add-typeof-expr form retval) (add-typeof-expr form retval)
retval)] retval)]
[(tc-result1: t) (int-err "non-symbol methods not supported by Typed Racket: ~a" t)])] [(tc-result1: t) (int-err "non-symbol methods not supported by Typed Racket: ~a" t)])]
[(tc-result1: t) (tc-error/expr/fields [(tc-result1: t) (tc-error/expr/fields
#:return (ret -Bottom)
"send: type mismatch" "send: type mismatch"
"expected" "an object" "expected" "an object"
"given" t)])) "given" t)]))

24
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/tc-error.rkt
View File

@ -3,6 +3,7 @@
(require "../utils/utils.rkt" (require "../utils/utils.rkt"
(rep type-rep) (rep type-rep)
(utils tc-utils) (utils tc-utils)
(types tc-result)
"base-abbrev.rkt" "base-abbrev.rkt"
(prefix-in c: (contract-req)) (prefix-in c: (contract-req))
racket/match) racket/match)
@ -17,9 +18,9 @@
[lookup-type-fail (identifier? . c:-> . Type/c)] [lookup-type-fail (identifier? . c:-> . Type/c)]
[lookup-variance-fail (identifier? . c:-> . void?)]) [lookup-variance-fail (identifier? . c:-> . void?)])
;; produce a type-checking error, and also return a result (e.g., a type) ;; produce a type-checking error, and also return a result (e.g., a tc-result)
(define (tc-error/expr msg (define (tc-error/expr msg
#:return [return -Bottom] #:return [return (ret -Bottom)]
#:stx [stx (current-orig-stx)] #:stx [stx (current-orig-stx)]
. rest) . rest)
(apply tc-error/delayed #:stx stx msg rest) (apply tc-error/delayed #:stx stx msg rest)
@ -29,7 +30,7 @@
(define (tc-error/expr/fields msg (define (tc-error/expr/fields msg
#:more [more #f] #:more [more #f]
#:stx [stx (current-orig-stx)] #:stx [stx (current-orig-stx)]
#:return [return -Bottom] #:return [return (ret -Bottom)]
. rst) . rst)
(apply tc-error/fields #:more more #:stx stx #:delayed? #t msg rst) (apply tc-error/fields #:more more #:stx stx #:delayed? #t msg rst)
return) return)
@ -39,17 +40,20 @@
(match (identifier-binding e) (match (identifier-binding e)
['lexical (tc-error/expr/fields "missing type for identifier" ['lexical (tc-error/expr/fields "missing type for identifier"
#:more "consider adding a type annotation with `:'" #:more "consider adding a type annotation with `:'"
"identifier" (syntax-e e))] "identifier" (syntax-e e)
#:return -Bottom)]
[#f (tc-error/expr/fields "missing type for top-level identifier" [#f (tc-error/expr/fields "missing type for top-level identifier"
#:more "either undefined or missing a type annotation" #:more "either undefined or missing a type annotation"
"identifier" (syntax-e e))] "identifier" (syntax-e e)
#:return -Bottom)]
[(list _ _ nominal-source-mod nominal-source-id _ _ _) [(list _ _ nominal-source-mod nominal-source-id _ _ _)
(define-values (mod-path base-path) (define-values (mod-path base-path)
(module-path-index-split nominal-source-mod)) (module-path-index-split nominal-source-mod))
(cond [(and (not mod-path) (not base-path)) (cond [(and (not mod-path) (not base-path))
(tc-error/expr/fields "missing type for identifier" (tc-error/expr/fields "missing type for identifier"
#:more "consider adding a type annotation with `:'" #:more "consider adding a type annotation with `:'"
"identifier" (syntax-e e))] "identifier" (syntax-e e)
#:return -Bottom)]
[(equal? mod-path '(lib "typed/racket")) [(equal? mod-path '(lib "typed/racket"))
(tc-error/expr/fields (tc-error/expr/fields
"missing type for identifier" "missing type for identifier"
@ -58,15 +62,17 @@
" to have a type for this identifier;" " to have a type for this identifier;"
" please file a bug report") " please file a bug report")
"identifier" (syntax-e e) "identifier" (syntax-e e)
"from module" mod-path)] "from module" mod-path
#:return -Bottom)]
[else [else
(tc-error/expr/fields "missing type for identifier" (tc-error/expr/fields "missing type for identifier"
#:more "consider using `require/typed' to import it" #:more "consider using `require/typed' to import it"
"identifier" (syntax-e e) "identifier" (syntax-e e)
"from module" mod-path)])])) "from module" mod-path
#:return -Bottom)])]))
(define (lookup-type-fail i) (define (lookup-type-fail i)
(tc-error/expr "~a is not bound as a type" (syntax-e i))) (tc-error/expr #:return -Bottom "~a is not bound as a type" (syntax-e i)))
(define (lookup-variance-fail i) (define (lookup-variance-fail i)
(int-err "~a is bound but missing a variance" (syntax-e i))) (int-err "~a is bound but missing a variance" (syntax-e i)))