suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remove special cases for - and fx- in tc-app.rkt.

Browse Source 
original commit: 779291c795e6370706efa34cca6af2a110727ebb
This commit is contained in:
Eric Dobson 2012-06-15 21:17:07 -07:00 committed by Sam Tobin-Hochstadt
parent fd7bea8edb
commit e02e4bbe11
3 changed files with 18 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -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)

2
collects/typed-racket/base-env/base-env-numeric.rkt
View File

@ -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)

19
collects/typed-racket/typecheck/tc-app.rkt
View File

@ -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)