Make tc-let add unconditional prop.

original commit: 13bcc61fd4631072294902bba97698bb9c6d5465
This commit is contained in:
Eric Dobson 2014-05-24 09:27:40 -07:00
parent 22f507dc18
commit d69316ff91
2 changed files with 22 additions and 20 deletions

View File

@ -64,18 +64,20 @@
(with-lexical-env/extend
namess
expected-types
(with-lexical-env/extend-props
(apply append props)
;; type-check the rhs exprs
(for-each expr->type
exprs
expected-results)
;; typecheck the body
(replace-names
(get-names+objects namess expected-results)
(if expected
(tc-body/check body (erase-filter expected))
(tc-body body))))))
(replace-names
(get-names+objects namess expected-results)
(with-lexical-env/extend-props
(apply append props)
;; type-check the rhs exprs
(for-each expr->type
exprs
expected-results)
;; typecheck the body
(add-unconditional-prop
(if expected
(tc-body/check body (erase-filter expected))
(tc-body body))
(apply -and (apply append props)))))))
(define (tc-expr/maybe-expected/t e names)
(syntax-parse names

View File

@ -570,7 +570,7 @@
3))
-Number]
[tc-e (let ([x 1]) x) -One]
[tc-e/t (let ([x 1]) x) -One]
[tc-e (let ([x 1]) (boolean? x)) #:ret (ret -Boolean -false-filter)]
[tc-e (boolean? number?) #:ret (ret -Boolean (-FS -bot (-not-filter -Boolean #'number?)))]
@ -658,10 +658,10 @@
[tc-e null #:ret (-path -Null #'null)]
[tc-e (let* ([sym 'squarf]
[x (if (= 1 2) 3 sym)])
x)
(t:Un (-val 'squarf) -PosByte)]
[tc-e/t (let* ([sym 'squarf]
[x (if (= 1 2) 3 sym)])
x)
(t:Un (-val 'squarf) -PosByte)]
[tc-e/t (if #t 1 2) -One]
@ -2418,7 +2418,7 @@
#:ret (ret (-lst* -String -String) -true-filter)]
;; test new :-less forms that allow fewer annotations
[tc-e (let ([x "foo"]) x) -String]
[tc-e/t (let ([x "foo"]) x) -String]
[tc-e (let ([x : String "foo"]) (string-append x "bar"))
-String]
[tc-e (let ([x : String "foo"] [y 'y]) (string-append x "bar"))
@ -2431,7 +2431,7 @@
#:ret (ret -String -true-filter)]
[tc-e (let #:forall (A) ([y 'y] [x : A "foo"]) x)
#:ret (ret -String -true-filter)]
[tc-e (let* ([x "foo"]) x) -String]
[tc-e/t (let* ([x "foo"]) x) -String]
[tc-e (let* ([x : String "foo"]) (string-append x "bar"))
-String]
[tc-e (let* ([x : String "foo"] [y 'y]) (string-append x "bar"))
@ -2449,7 +2449,7 @@
-String]
[tc-e (letrec ([y 'y] [x : String "foo"]) (string-append x "bar"))
-String]
[tc-e (let-values ([(x y) (values "foo" "bar")]) x) -String]
[tc-e/t (let-values ([(x y) (values "foo" "bar")]) x) -String]
[tc-e (let-values ([(x y) (values "foo" "bar")]
[([z : String]) (values "baz")])
(string-append x y z))