diff --git a/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt index 801e96ee..719d1a72 100644 --- a/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt +++ b/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt @@ -31,7 +31,9 @@ (for/list ([names namess] [results results]) (match results [(list (tc-result: _ _ os) ...) - (map list names os)])))) + (map list names os)] + [(tc-results: (list (== -Bottom))) + (map list names (make-list (length names) -empty-obj))])))) ;; Checks that the body has the expected type when names are bound to the types spcified by results. ;; The exprs are also typechecked by using expr->type. @@ -74,7 +76,9 @@ (-and (-filter (-val #f) n) f-)))]))))] ;; amk: does this case ever occur? [(list (tc-result: e-ts (NoFilter:) _) ...) - (values e-ts (make-list (length e-ts) -empty-obj) null)])))) + (values e-ts (make-list (length e-ts) -empty-obj) null)] + [(tc-results: (list (== -Bottom))) + (values (list -Bottom) (list -empty-obj) null)])))) ;; extend the lexical environment for checking the body ;; with types and potential aliases (with-lexical-env/extend-types+aliases @@ -89,7 +93,9 @@ (for ([expr (in-list exprs)] [results (in-list expected-results)]) (match results [(list (tc-result: ts fs os) ...) - (expr->type expr (ret ts fs os))])) + (expr->type expr (ret ts fs os))] + [(tc-results: (list (== -Bottom))) + (list expr -Bottom -empty-obj)])) ;; typecheck the body (tc-body/check body (and expected (erase-filter expected))))))) @@ -234,15 +240,21 @@ (cond [(null? clauses) (k)] [else (match-define (lr-clause names expr) (car clauses)) - (match-define (list (tc-result: ts fs os) ...) - (get-type/infer names expr - (lambda (e) (tc-expr/maybe-expected/t e names)) - tc-expr/check)) - (with-lexical-env/extend-types - names - ts - (replace-names (map list names os) - (loop (cdr clauses))))]))) + (match (get-type/infer names expr + (lambda (e) (tc-expr/maybe-expected/t e names)) + tc-expr/check) + [(list (tc-result: ts fs os) ...) + (with-lexical-env/extend-types + names + ts + (replace-names (map list names os) + (loop (cdr clauses))))] + [(tc-results: (list (== -Bottom))) + (with-lexical-env/extend-types + names + (make-list (length names) -Bottom) + (replace-names (map list names (make-list (length names) -empty-obj)) + (loop (cdr clauses))))])]))) ;; this is so match can provide us with a syntax property to ;; say that this binding is only called in tail position diff --git a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt index 5e662d9b..a49abc51 100644 --- a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt +++ b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt @@ -179,6 +179,11 @@ (match (get-type/infer vars #'expr tc-expr tc-expr/check) [(list (tc-result: ts) ...) (for/list ([i (in-list vars)] [t (in-list ts)]) + (register-type i t) + (free-id-table-set! unann-defs i #t) + (make-def-binding i t))] + [(tc-results: (list (== -Bottom))) + (for/list ([i (in-list vars)] [t (in-cycle (list -Bottom))]) (register-type i t) (free-id-table-set! unann-defs i #t) (make-def-binding i t))])])] diff --git a/typed-racket-test/fail/bind-anyvalues.rkt b/typed-racket-test/fail/bind-anyvalues.rkt new file mode 100644 index 00000000..0cad5092 --- /dev/null +++ b/typed-racket-test/fail/bind-anyvalues.rkt @@ -0,0 +1,2 @@ +#lang typed/racket +(define a (eval 0)) diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt index a7d146eb..25d2cfe3 100644 --- a/typed-racket-test/unit-tests/typecheck-tests.rkt +++ b/typed-racket-test/unit-tests/typecheck-tests.rkt @@ -3777,6 +3777,11 @@ [tc-e/t (ann '(lib "foo") Module-Path) -Module-Path] [tc-err (begin (ann '(submod ".." bar ".") Module-Path) (error "foo"))] + + [tc-err (let ([x (eval 0)]) x)] + [tc-err (let () + (define x (eval 0)) + x)] ) (test-suite