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

More fixnum improvements.

Browse Source 
original commit: 3251712ef79832415b371a7ff2c6593da0372411
This commit is contained in:
Sam Tobin-Hochstadt 2010-06-24 18:17:01 -04:00
parent a7b787db6c
commit 680e7fee29
2 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -53,7 +53,7 @@
[rational? (make-pred-ty -Real)]
[exact? (asym-pred N B (-FS -top (-not-filter -ExactRational 0)))]
[inexact? (asym-pred N B (-FS -top (-not-filter -Flonum 0)))]
[fixnum? (asym-pred Univ B (-FS (-filter -Integer 0) -top))]
[fixnum? (make-pred-ty -Fixnum)]
[positive? (-> -Real B)]
[negative? (-> -Real B)]
[exact-positive-integer? (make-pred-ty -Pos)]

9
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -599,11 +599,12 @@
[_ (int-err "bad expected: ~a" expected)])]
;; special case for `-' used like `sub1'
[(#%plain-app (~and op (~literal -)) v (~and arg2 ((~literal quote) 1)))
(add-typeof-expr #'arg2 (ret -Nat))
(add-typeof-expr #'arg2 (ret -PositiveFixnum))
(match-let ([(tc-result1: t) (single-value #'v)])
(if (subtype t -ExactPositiveInteger)
(ret -Nat)
(tc/funapp #'op #'(v arg2) (single-value #'op) (list (ret t) (single-value #'arg2)) expected)))]
(cond
[(subtype t (Un -Zero -PositiveFixnum)) (ret -Fixnum)]
[(subtype t -ExactPositiveInteger) (ret -Nat)]
[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)