From e02e4bbe117548d0c8521b2db2e3a21c81caea85 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Fri, 15 Jun 2012 21:17:07 -0700 Subject: [PATCH] Remove special cases for - and fx- in tc-app.rkt. original commit: 779291c795e6370706efa34cca6af2a110727ebb --- .../unit-tests/typecheck-tests.rkt | 16 ++++++++++++++++ .../base-env/base-env-numeric.rkt | 2 ++ collects/typed-racket/typecheck/tc-app.rkt | 19 ------------------- 3 files changed, 18 insertions(+), 19 deletions(-) diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index 0ef78d37..b95f787d 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -180,6 +180,22 @@ (tc-e (- -23524623547234734568) -PosInt) (tc-e (- 241.3) -NegFlonum) (tc-e (- -24.3) -PosFlonum) + + (tc-e (- (ann 1000 Index) 1) -Fixnum) + (tc-e (- (ann 1000 Positive-Index) 1) -Index) + (tc-e (- (ann 1000 Fixnum) 1) -Int) + (tc-e (- (ann 1000 Nonnegative-Fixnum) 1) -Fixnum) + (tc-e (- (ann 1000 Positive-Fixnum) 1) -NonNegFixnum) + (tc-e (- (ann 1000 Exact-Positive-Integer) 1) -Nat) + + (tc-e (fx- (ann 1000 Index) 1) -Fixnum) + (tc-e (fx- (ann 1000 Positive-Index) 1) -Index) + (tc-e (fx- (ann 1000 Fixnum) 1) -Fixnum) + (tc-e (fx- (ann 1000 Nonnegative-Fixnum) 1) -Fixnum) + (tc-e (fx- (ann 1000 Positive-Fixnum) 1) -NonNegFixnum) + (tc-e (fx- (ann 1000 Exact-Positive-Integer) 1) -NonNegFixnum) + + (tc-e (*) -One) (tc-e (gcd 1/2) -PosRat) diff --git a/collects/typed-racket/base-env/base-env-numeric.rkt b/collects/typed-racket/base-env/base-env-numeric.rkt index 95c15cd1..5370ed12 100644 --- a/collects/typed-racket/base-env/base-env-numeric.rkt +++ b/collects/typed-racket/base-env/base-env-numeric.rkt @@ -135,6 +135,7 @@ (-PosByte -One . -> . -Byte) (-PosIndex -One . -> . -Index) (-PosFixnum -One . -> . -NonNegFixnum) + (-PosInt -One . -> . -NonNegFixnum) (-NegInt -Nat . -> . -NegFixnum) (-NonPosInt -PosInt . -> . -NegFixnum) (-NonPosInt -Nat . -> . -NonPosFixnum) @@ -1135,6 +1136,7 @@ (-> -PosByte -One -Byte) (-> -PosIndex -One -Index) (-> -PosFixnum -One -NonNegFixnum) + (-> -PosInt -One -Nat) (-> -NonNegFixnum -NonNegFixnum -Fixnum) (->* (list -PosInt -NonPosInt) -NonPosInt -PosInt) (->* (list -Nat -NonPosInt) -NonPosInt -Nat) diff --git a/collects/typed-racket/typecheck/tc-app.rkt b/collects/typed-racket/typecheck/tc-app.rkt index 25d3fd23..567bd0a1 100644 --- a/collects/typed-racket/typecheck/tc-app.rkt +++ b/collects/typed-racket/typecheck/tc-app.rkt @@ -525,25 +525,6 @@ [(tc-result1: t) (ret (-> -NonNegFixnum (generalize t)))])) expected)] [_ (int-err "bad expected: ~a" expected)])] - ;; special case for `-' used like `sub1' - [(#%plain-app (~and op:normal-op (~literal -)) v (~and arg2 ((~literal quote) 1))) - (add-typeof-expr #'arg2 (ret -PosFixnum)) - (match-let ([(tc-result1: t) (single-value #'v)]) - (cond - [(subtype t -PosFixnum) (ret -NonNegFixnum)] - [(subtype t -NonNegFixnum) (ret -Fixnum)] - [(subtype t -PosInt) (ret -Nat)] - [else (tc/funapp #'op #'(v arg2) (single-value #'op) - (list (ret t) (single-value #'arg2)) expected)]))] - ;; idem for fx- - [(#%plain-app (~and op:normal-op (~or (~literal fx-) (~literal unsafe-fx-))) - v (~and arg2 ((~literal quote) 1))) - (add-typeof-expr #'arg2 (ret -PosFixnum)) - (match-let ([(tc-result1: t) (single-value #'v)]) - (cond - [(subtype t -PosInt) (ret -NonNegFixnum)] - [else (tc/funapp #'op #'(v arg2) (single-value #'op) - (list (ret t) (single-value #'arg2)) expected)]))] ;; call-with-values [(#%plain-app call-with-values prod con) (match (tc/funapp #'prod #'() (single-value #'prod) null #f)