From d69316ff91b83fe88a6727623b1384d5c48ef736 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 24 May 2014 09:27:40 -0700 Subject: [PATCH] Make tc-let add unconditional prop. original commit: 13bcc61fd4631072294902bba97698bb9c6d5465 --- .../typed-racket/typecheck/tc-let-unit.rkt | 26 ++++++++++--------- .../unit-tests/typecheck-tests.rkt | 16 ++++++------ 2 files changed, 22 insertions(+), 20 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt index eb47c2df..456213b9 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt @@ -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 diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt index d54a4449..8455fc1b 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -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))