From 3face0ff46037233901c9c002cc390349bfe98ae Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 16 Jun 2011 17:37:13 -0400 Subject: [PATCH] Unify types and filter behavior of not and false?. original commit: 26541ffbbdccf7d27db1f1ae439430090fcb4b0b --- .../optimizer/tests/false-huh-dead-code.rkt | 11 +++++++++++ collects/typed-scheme/base-env/base-env.rkt | 2 +- collects/typed-scheme/typecheck/tc-app.rkt | 4 ++-- 3 files changed, 14 insertions(+), 3 deletions(-) create mode 100644 collects/tests/typed-scheme/optimizer/tests/false-huh-dead-code.rkt diff --git a/collects/tests/typed-scheme/optimizer/tests/false-huh-dead-code.rkt b/collects/tests/typed-scheme/optimizer/tests/false-huh-dead-code.rkt new file mode 100644 index 00000000..f8d7ae7c --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/tests/false-huh-dead-code.rkt @@ -0,0 +1,11 @@ +#; +( +false-huh-dead-code.rkt line 10 col 16 - (quote 1) - dead then branch +false-huh-dead-code.rkt line 11 col 13 - (quote 1) - dead then branch +2 +2 + ) + +#lang typed/racket +(if (false? #t) 1 2) +(if (not #t) 1 2) diff --git a/collects/typed-scheme/base-env/base-env.rkt b/collects/typed-scheme/base-env/base-env.rkt index 038fbb6b..87b86723 100644 --- a/collects/typed-scheme/base-env/base-env.rkt +++ b/collects/typed-scheme/base-env/base-env.rkt @@ -208,7 +208,7 @@ ;; 1 means predicate on second argument (make-pred-ty (list (make-pred-ty (list a) c d) (-lst a)) c (-lst d) 1) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c)))] -[not (-> Univ B)] +[not (make-pred-ty (-val #f))] [box (-poly (a) (a . -> . (-box a)))] [unbox (-poly (a) (cl->* ((-box a) . -> . a) diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt index 49f18344..68af7448 100644 --- a/collects/typed-scheme/typecheck/tc-app.rkt +++ b/collects/typed-scheme/typecheck/tc-app.rkt @@ -261,7 +261,7 @@ (define (tc/app/internal form expected) (syntax-parse form #:literals (#%plain-app #%plain-lambda letrec-values quote - values apply k:apply not list list* call-with-values do-make-object make-object cons + values apply k:apply not false? list list* call-with-values do-make-object make-object cons map andmap ormap reverse extend-parameterization vector-ref unsafe-vector-ref unsafe-vector*-ref vector-set! unsafe-vector-set! unsafe-vector*-set! @@ -513,7 +513,7 @@ [((tc-result1: t) (tc-result1: t* f o)) (ret t f o)])] ;; special-case for not - flip the filters - [(#%plain-app not arg) + [(#%plain-app (~or not false?) arg) (match (single-value #'arg) [(tc-result1: t (FilterSet: f+ f-) _) (ret -Boolean (make-FilterSet f- f+))])]