Wrap expected type. Closes PR 11980.

original commit: b76819a66e9f8c6b1b5f364c4b07301ecada7979
This commit is contained in:
Sam Tobin-Hochstadt 2011-06-14 18:34:21 -04:00
parent d78bd10198
commit 0cf1898580
2 changed files with 25 additions and 3 deletions

View File

@ -0,0 +1,21 @@
#lang typed/racket
(define-type SN (U String Number))
(define-predicate sn? SN)
(struct: (α) node ({left : α} {right : α}))
(: create-node (Any Any -> String))
(define (create-node x y)
(begin0
"foo"
(unless #t
(error 'bad ""))))
(: create-node2 (All (B) (B B -> (node SN))))
(define (create-node2 x y)
(if (and (sn? x) (sn? y))
(node x y)
(error 'bad "")))

View File

@ -13,7 +13,7 @@
(env lexical-env type-env-structs tvar-env index-env)
racket/private/class-internal
(except-in syntax/parse id)
unstable/function
unstable/function #;unstable/debug
(only-in srfi/1 split-at))
(require (for-template scheme/base racket/private/class-internal))
@ -236,7 +236,8 @@
;; the argument must be syntax
(unless (syntax? form)
(int-err "bad form input to tc-expr: ~a" form))
(let (;; a local version of ret that does the checking
(let ([old-ret ret]
;; a local version of ret that does the checking
[ret
(lambda args
(define te (apply ret args))
@ -292,7 +293,7 @@
;; begin
[(begin e . es) (tc-exprs/check (syntax->list #'(e . es)) expected)]
[(begin0 e . es)
(begin (tc-exprs/check (syntax->list #'es) Univ)
(begin (tc-exprs/check (syntax->list #'es) (old-ret Univ))
(tc-expr/check #'e expected))]
;; if
[(if tst thn els) (tc/if-twoarm #'tst #'thn #'els expected)]