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

Fix NaN and inf handling in flonum specific op types.

Browse Source
This commit is contained in:
Vincent St-Amour 2012-05-25 14:33:47 -04:00
parent ebcc6d211a
commit 186b463217
2 changed files with 12 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -24,7 +24,7 @@
(typecheck typechecker) (typecheck typechecker)
(env global-env) (env global-env)
(base-env base-env-indexing)) (base-env base-env-indexing))
racket/file racket/port racket/file racket/port racket/flonum
(for-template (for-template
racket/file racket/port racket/file racket/port
(base-env base-types base-types-extra base-env-indexing)) (base-env base-types base-types-extra base-env-indexing))

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

@ -2,7 +2,7 @@
(begin (begin
(require (require
racket/list racket/unsafe/ops racket/list racket/math racket/flonum racket/unsafe/ops
(for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base (for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base
(only-in "../types/numeric-predicates.rkt" index?)) (only-in "../types/numeric-predicates.rkt" index?))
(only-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-PosInt -Pos])) (only-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-PosInt -Pos]))
@ -461,7 +461,7 @@
(-FlonumNegZero -NegFlonum . -> . -FlonumPosZero) (-FlonumNegZero -NegFlonum . -> . -FlonumPosZero)
(-PosFlonum -PosFlonum . -> . -NonNegFlonum) ; possible underflow (-PosFlonum -PosFlonum . -> . -NonNegFlonum) ; possible underflow
(commutative-binop -PosFlonum -NegFlonum -NonPosFlonum) (commutative-binop -PosFlonum -NegFlonum -NonPosFlonum)
(-NegFlonum -NegFlonum . -> . -NonNegFlonum) (-NegFlonum -NegFlonum . -> . (Un -NonNegFlonum -FlonumNan))
(binop -Flonum)))) (binop -Flonum))))
(define fl=-type (define fl=-type
(lambda () (lambda ()
@ -540,7 +540,7 @@
(from-cases (commutative-case -PosFlonum (Un -NonNegFlonum -NonPosFlonum)) (from-cases (commutative-case -PosFlonum (Un -NonNegFlonum -NonPosFlonum))
(commutative-case -PosFlonum -Flonum (Un -PosFlonum -FlonumNan)) (commutative-case -PosFlonum -Flonum (Un -PosFlonum -FlonumNan))
(commutative-case -NonNegFlonum (Un -NonNegFlonum -NonPosFlonum)) (commutative-case -NonNegFlonum (Un -NonNegFlonum -NonPosFlonum))
(commutative-case -NonNegFlonum (Un -NonNegFlonum -FlonumNan)) (commutative-case -NonNegFlonum -Flonum (Un -NonNegFlonum -FlonumNan))
(map binop (list -NegFlonum -NonPosFlonum -Flonum))))) (map binop (list -NegFlonum -NonPosFlonum -Flonum)))))
(define flround-type ; truncate too (define flround-type ; truncate too
(lambda () (lambda ()
@ -557,7 +557,6 @@
(define fllog-type (define fllog-type
(lambda () (lambda ()
(from-cases (-> -FlonumZero -NegFlonum) ; -inf (from-cases (-> -FlonumZero -NegFlonum) ; -inf
(-> -PosFlonum -NonNegFlonum) ; possible underflow
(unop -Flonum)))) (unop -Flonum))))
(define flexp-type (define flexp-type
(lambda () (lambda ()
@ -571,10 +570,9 @@
-Flonum))))) ; anything negative returns nan -Flonum))))) ; anything negative returns nan
(define flexpt-type (define flexpt-type
(lambda () (lambda ()
(from-cases (-FlonumZero -Flonum . -> . -FlonumZero) ; (flexpt -0.0 0.1) -> 0.0 ; not sign preserving (from-cases (-FlonumZero -PosFlonum . -> . -FlonumZero) ; (flexpt -0.0 0.1) -> 0.0 ; not sign preserving
(-Flonum -FlonumZero . -> . -PosFlonum) ; always returns 1.0 ((Un -PosFlonum -NegFlonum) -FlonumZero . -> . -PosFlonum) ; always returns 1.0
(-NonNegFlonum -Flonum . -> . -NonNegFlonum) ; can underflow, so not closed on positives (-PosFlonum (Un -NonNegFlonum -NonPosFlonum) . -> . -NonNegFlonum) ; can underflow, and can't have NaN as exponent
(-NonPosFlonum -NonNegFlonum . -> . -NonPosFlonum) ; if we allow negative exponents, can return NaN, which is not NonPos
(-Flonum -Flonum . -> . -Flonum)))) (-Flonum -Flonum . -> . -Flonum))))
(define fx->fl-type (define fx->fl-type
@ -1154,7 +1152,7 @@
(-> -NonNegFlonum -NonNegFlonum) (-> -NonNegFlonum -NonNegFlonum)
(varop-1+ (Un -NonNegFlonum -FlonumNan)) (varop-1+ (Un -NonNegFlonum -FlonumNan))
;; if we mix Pos and NonNeg (or just NonNeg), we go to Flonum: (/ +inf.0 0.0) -> NaN ;; if we mix Pos and NonNeg (or just NonNeg), we go to Flonum: (/ +inf.0 0.0) -> NaN
(-> -NonPosFlonum -NonPosFlonum) ; possible underflow, so no neg -> neg ;; No (-> -NonPosFlonum -NonPosFlonum), (/ 0.0) => +inf.0
(-> -NegFlonum -NegFlonum -NonNegFlonum) (-> -NegFlonum -NegFlonum -NonNegFlonum)
(-> -NegFlonum -NegFlonum -NegFlonum -NonPosFlonum) (-> -NegFlonum -NegFlonum -NegFlonum -NonPosFlonum)
;; limited flonum contagion rules ;; limited flonum contagion rules
@ -1822,13 +1820,13 @@
(unop -PosRat) (unop -PosRat)
(-> -Rat -NonNegRat) (-> -Rat -NonNegRat)
(unop -PosFlonum) (unop -PosFlonum)
(-> -Flonum -NonNegFlonum) (-> -Flonum (Un -NonNegFlonum -FlonumNan))
(unop -PosSingleFlonum) (unop -PosSingleFlonum)
(-> -SingleFlonum -NonNegSingleFlonum) (-> -SingleFlonum (Un -NonNegSingleFlonum -SingleFlonumNan))
(unop -PosInexactReal) (unop -PosInexactReal)
(-> -InexactReal -NonNegInexactReal) (-> -InexactReal (Un -NonNegInexactReal -InexactRealNan))
(unop -PosReal) (unop -PosReal)
(-> -Real -NonNegReal) (-> -Real (Un -NonNegReal -InexactRealNan))
(map unop (list -FloatComplex -SingleFlonumComplex (map unop (list -FloatComplex -SingleFlonumComplex
-InexactComplex -ExactNumber N)))] -InexactComplex -ExactNumber N)))]
[conjugate (from-cases [conjugate (from-cases