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

Fix flonum and single-flonum operation types.

Browse Source 
Most issues were found with random testing.
This commit is contained in:
Vincent St-Amour 2012-06-06 14:59:22 -04:00
parent 0b7eaf56ca
commit 48f47f3384
1 changed files with 28 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -60,7 +60,7 @@
(list (-> a1 a2 r) (-> a2 a1 r))) (list (-> a1 a2 r) (-> a2 a1 r)))
;; when having at least one of a given type matters (e.g. adding one+ Pos and Nats) ;; when having at least one of a given type matters (e.g. adding one+ Pos and Nats)
(define (commutative-case t1 t2 [r t1]) (define (commutative-case t1 t2 [r t1])
(list (->* (list t1) t2 r) (list (->* (list t1 t2) t2 r)
(->* (list t2 t1) t2 r) (->* (list t2 t1) t2 r)
(->* (list t2 t2 t1) t2 r))) (->* (list t2 t2 t1) t2 r)))
@ -531,16 +531,16 @@
(define flmin-type (define flmin-type
(lambda () (lambda ()
(from-cases (commutative-case -NegFlonum (Un -NonNegFlonum -NonPosFlonum)) (from-cases (commutative-case -NegFlonum (Un -NonNegFlonum -NonPosFlonum))
(commutative-case -NegFlonum -Flonum (Un -NegFlonum -FlonumNan)) (commutative-case (Un -NegFlonum -FlonumNan) -Flonum)
(commutative-case -NonPosFlonum (Un -NonNegFlonum -NonPosFlonum)) (commutative-case -NonPosFlonum (Un -NonNegFlonum -NonPosFlonum))
(commutative-case -NonPosFlonum (Un -NonPosFlonum -FlonumNan)) (commutative-case (Un -NonPosFlonum -FlonumNan) -NonPosFlonum)
(map binop (list -PosFlonum -NonNegFlonum -Flonum))))) (map binop (list -PosFlonum -NonNegFlonum -Flonum)))))
(define flmax-type (define flmax-type
(lambda () (lambda ()
(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 (Un -PosFlonum -FlonumNan) -Flonum)
(commutative-case -NonNegFlonum (Un -NonNegFlonum -NonPosFlonum)) (commutative-case -NonNegFlonum (Un -NonNegFlonum -NonPosFlonum))
(commutative-case -NonNegFlonum -Flonum (Un -NonNegFlonum -FlonumNan)) (commutative-case (Un -NonNegFlonum -FlonumNan) -Flonum)
(map binop (list -NegFlonum -NonPosFlonum -Flonum))))) (map binop (list -NegFlonum -NonPosFlonum -Flonum)))))
(define flround-type ; truncate too (define flround-type ; truncate too
(lambda () (lambda ()
@ -998,7 +998,7 @@
(-> -NegFlonum -NegFlonum -NegFlonum -NonPosFlonum) (-> -NegFlonum -NegFlonum -NegFlonum -NonPosFlonum)
;; limited flonum contagion rules ;; limited flonum contagion rules
;; (* <float> 0) is exact 0 (i.e. not a float) ;; (* <float> 0) is exact 0 (i.e. not a float)
(commutative-case -NonNegFlonum -PosReal -NonNegFlonum) ; real args don't include 0 (commutative-case -NonNegFlonum -PosReal (Un -NonNegFlonum -FlonumNan)) ; real args don't include 0
(commutative-case -Flonum (Un -PosReal -NegReal) -Flonum) (commutative-case -Flonum (Un -PosReal -NegReal) -Flonum)
(map varop (list -Flonum -SingleFlonumZero)) (map varop (list -Flonum -SingleFlonumZero))
(varop-1+ -PosSingleFlonum -NonNegSingleFlonum) (varop-1+ -PosSingleFlonum -NonNegSingleFlonum)
@ -1009,7 +1009,7 @@
(-> -NonPosSingleFlonum -NonPosSingleFlonum) (-> -NonPosSingleFlonum -NonPosSingleFlonum)
(-> -NegSingleFlonum -NegSingleFlonum -NonNegSingleFlonum) ; possible underflow, so no neg neg -> pos (-> -NegSingleFlonum -NegSingleFlonum -NonNegSingleFlonum) ; possible underflow, so no neg neg -> pos
(-> -NegSingleFlonum -NegSingleFlonum -NegSingleFlonum -NonPosSingleFlonum) (-> -NegSingleFlonum -NegSingleFlonum -NegSingleFlonum -NonPosSingleFlonum)
(commutative-case -NonNegSingleFlonum (Un -PosRat -NonNegSingleFlonum) -NonNegSingleFlonum) (commutative-case -NonNegSingleFlonum (Un -PosRat -NonNegSingleFlonum) (Un -NonNegSingleFlonum -SingleFlonumNan))
(commutative-case -SingleFlonum (Un -PosRat -NegRat -SingleFlonum) -SingleFlonum) (commutative-case -SingleFlonum (Un -PosRat -NegRat -SingleFlonum) -SingleFlonum)
(map varop (list -SingleFlonum -InexactRealZero)) (map varop (list -SingleFlonum -InexactRealZero))
(varop-1+ -PosInexactReal -NonNegInexactReal) (varop-1+ -PosInexactReal -NonNegInexactReal)
@ -1019,7 +1019,7 @@
(-> -NonPosInexactReal -NonPosInexactReal) (-> -NonPosInexactReal -NonPosInexactReal)
(-> -NegInexactReal -NegInexactReal -NonNegInexactReal) (-> -NegInexactReal -NegInexactReal -NonNegInexactReal)
(-> -NegInexactReal -NegInexactReal -NegInexactReal -NonPosInexactReal) (-> -NegInexactReal -NegInexactReal -NegInexactReal -NonPosInexactReal)
(commutative-case -NonNegInexactReal (Un -PosRat -NonNegInexactReal) -NonNegInexactReal) (commutative-case -NonNegInexactReal (Un -PosRat -NonNegInexactReal) (Un -NonNegInexactReal -SingleFlonumNan))
(commutative-case -InexactReal (Un -PosRat -NegRat -InexactReal) -InexactReal) (commutative-case -InexactReal (Un -PosRat -NegRat -InexactReal) -InexactReal)
(varop -InexactReal) (varop -InexactReal)
;; reals ;; reals
@ -1038,6 +1038,7 @@
(commutative-case -InexactComplex (Un -InexactComplex -InexactReal -PosRat -NegRat) -InexactComplex) (commutative-case -InexactComplex (Un -InexactComplex -InexactReal -PosRat -NegRat) -InexactComplex)
(varop N))] (varop N))]
[+ (from-cases [+ (from-cases
(-> -Zero)
(binop -Zero) (binop -Zero)
(map (lambda (t) (commutative-binop t -Zero t)) (map (lambda (t) (commutative-binop t -Zero t))
(list -One -PosByte -Byte -PosIndex -Index (list -One -PosByte -Byte -PosIndex -Index
@ -1068,6 +1069,7 @@
(commutative-case -NonNegFlonum -NonNegReal -NonNegFlonum) (commutative-case -NonNegFlonum -NonNegReal -NonNegFlonum)
(commutative-case -NonPosFlonum -NonPosReal -NonPosFlonum) (commutative-case -NonPosFlonum -NonPosReal -NonPosFlonum)
(commutative-case -Flonum -Real -Flonum) (commutative-case -Flonum -Real -Flonum)
(varop -Flonum)
;; single-flonum + rat -> single-flonum ;; single-flonum + rat -> single-flonum
(commutative-case -PosSingleFlonum (Un -NonNegRat -NonNegSingleFlonum) -PosSingleFlonum) (commutative-case -PosSingleFlonum (Un -NonNegRat -NonNegSingleFlonum) -PosSingleFlonum)
(commutative-case (Un -PosRat -PosSingleFlonum) -NonNegSingleFlonum -PosSingleFlonum) (commutative-case (Un -PosRat -PosSingleFlonum) -NonNegSingleFlonum -PosSingleFlonum)
@ -1076,6 +1078,7 @@
(commutative-case -NonNegSingleFlonum (Un -NonNegRat -NonNegSingleFlonum) -NonNegSingleFlonum) (commutative-case -NonNegSingleFlonum (Un -NonNegRat -NonNegSingleFlonum) -NonNegSingleFlonum)
(commutative-case -NonPosSingleFlonum (Un -NonPosRat -NonPosSingleFlonum) -NonPosSingleFlonum) (commutative-case -NonPosSingleFlonum (Un -NonPosRat -NonPosSingleFlonum) -NonPosSingleFlonum)
(commutative-case -SingleFlonum (Un -Rat -SingleFlonum) -SingleFlonum) (commutative-case -SingleFlonum (Un -Rat -SingleFlonum) -SingleFlonum)
(varop -SingleFlonum)
;; inexact-real + real -> inexact-real ;; inexact-real + real -> inexact-real
(commutative-case -PosInexactReal -NonNegReal -PosInexactReal) (commutative-case -PosInexactReal -NonNegReal -PosInexactReal)
(commutative-case -PosReal -NonNegInexactReal -PosInexactReal) (commutative-case -PosReal -NonNegInexactReal -PosInexactReal)
@ -1124,8 +1127,11 @@
(varop-1+ -Rat) (varop-1+ -Rat)
;; floats - uncertain about sign properties in the presence of ;; floats - uncertain about sign properties in the presence of
;; under/overflow, so these are left out ;; under/overflow, so these are left out
(varop-1+ -Flonum)
(commutative-case -Flonum -Real -Flonum) (commutative-case -Flonum -Real -Flonum)
(varop-1+ -SingleFlonum)
(commutative-case -SingleFlonum (Un -SingleFlonum -Rat) -SingleFlonum) (commutative-case -SingleFlonum (Un -SingleFlonum -Rat) -SingleFlonum)
(varop-1+ -InexactReal)
(commutative-case -InexactReal (Un -InexactReal -Rat) -InexactReal) (commutative-case -InexactReal (Un -InexactReal -Rat) -InexactReal)
(map varop-1+ (list -Real -ExactNumber)) (map varop-1+ (list -Real -ExactNumber))
(commutative-case -FloatComplex N -FloatComplex) (commutative-case -FloatComplex N -FloatComplex)
@ -1147,10 +1153,8 @@
(-> -NegRat -NegRat -NegRat -NegRat) (-> -NegRat -NegRat -NegRat -NegRat)
(-> -NonPosRat -NonPosRat -NonPosRat -NonPosRat) (-> -NonPosRat -NonPosRat -NonPosRat -NonPosRat)
(varop-1+ -Rat) (varop-1+ -Rat)
(-> -FlonumZero -PosFlonum) ; +inf.0 (-> -FlonumZero (Un -PosFlonum -NegFlonum)) ; one of the infinities
(varop-1+ -PosFlonum -NonNegFlonum) ; possible underflow (varop-1+ -PosFlonum -NonNegFlonum) ; possible underflow
(-> -NonNegFlonum -NonNegFlonum)
(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
;; No (-> -NonPosFlonum -NonPosFlonum), (/ 0.0) => +inf.0 ;; No (-> -NonPosFlonum -NonPosFlonum), (/ 0.0) => +inf.0
(-> -NegFlonum -NegFlonum -NonNegFlonum) (-> -NegFlonum -NegFlonum -NonNegFlonum)
@ -1159,40 +1163,31 @@
;; (/ 0 <float>) is exact 0 (i.e. not a float) ;; (/ 0 <float>) is exact 0 (i.e. not a float)
(-> -PosFlonum -PosReal -NonNegFlonum) (-> -PosFlonum -PosReal -NonNegFlonum)
(-> -PosReal -PosFlonum -NonNegFlonum) (-> -PosReal -PosFlonum -NonNegFlonum)
(commutative-case -NonNegFlonum -PosReal (Un -NonNegFlonum -FlonumNan)) (commutative-case -PosFlonum -PosReal (Un -NonNegFlonum -FlonumNan))
(->* (list (Un -PosReal -NegReal -Flonum)) -Flonum -Flonum) (->* (list (Un -PosReal -NegReal -Flonum) -Flonum) -Flonum -Flonum)
(->* (list -Flonum) -Real -Flonum) ; if any argument after the first is exact 0, not a problem (->* (list -Flonum) -Real -Flonum) ; if any argument after the first is exact 0, not a problem
(varop-1+ -Flonum) (varop-1+ -Flonum)
(-> -SingleFlonumZero -PosSingleFlonum) (-> -SingleFlonumZero (Un -PosSingleFlonum -NegSingleFlonum)) ; one of the infinities
(varop-1+ -PosSingleFlonum) (varop-1+ -PosSingleFlonum -NonNegSingleFlonum) ; possible underflow
(-> -NonNegSingleFlonum -NonNegSingleFlonum)
(varop-1+ (Un -NonNegSingleFlonum -SingleFlonumNan))
;; we could add contagion rules for negatives, but we haven't for now ;; we could add contagion rules for negatives, but we haven't for now
(-> -NegSingleFlonum -NegSingleFlonum)
(-> -NonPosSingleFlonum -NonPosSingleFlonum)
(-> -NegSingleFlonum -NegSingleFlonum -NonNegSingleFlonum) ; possible underflow, so no neg neg -> pos (-> -NegSingleFlonum -NegSingleFlonum -NonNegSingleFlonum) ; possible underflow, so no neg neg -> pos
(-> -NegSingleFlonum -NegSingleFlonum -NegSingleFlonum -NonPosSingleFlonum) (-> -NegSingleFlonum -NegSingleFlonum -NegSingleFlonum -NonPosSingleFlonum)
(-> -PosSingleFlonum (Un -PosRat -PosSingleFlonum) -NonNegSingleFlonum) (-> -PosSingleFlonum (Un -PosRat -PosSingleFlonum) -NonNegSingleFlonum)
(-> (Un -PosRat -PosSingleFlonum) -PosSingleFlonum -NonNegSingleFlonum) (-> (Un -PosRat -PosSingleFlonum) -PosSingleFlonum -NonNegSingleFlonum)
(commutative-case -NonNegSingleFlonum (Un -PosRat -NonNegSingleFlonum) (Un -NonNegSingleFlonum -SingleFlonumNan)) (commutative-case -PosSingleFlonum (Un -PosRat -PosSingleFlonum) (Un -NonNegSingleFlonum -SingleFlonumNan))
(commutative-case -SingleFlonum (Un -PosRat -NegRat -SingleFlonum) -SingleFlonum) (commutative-case -SingleFlonum (Un -PosRat -NegRat -SingleFlonum) -SingleFlonum)
(varop-1+ -SingleFlonum) (varop-1+ -SingleFlonum)
(-> -InexactRealZero -PosInexactReal) (-> -InexactRealZero (Un -PosInexactReal -NegInexactReal))
(varop-1+ -PosInexactReal) (varop-1+ -PosInexactReal -NonNegInexactReal) ; possible underflow
(-> -NonNegInexactReal -NonNegInexactReal)
(varop-1+ (Un -NonNegInexactReal -InexactRealNan))
(-> -NegInexactReal -NegInexactReal)
(-> -NonPosInexactReal -NonPosInexactReal)
(-> -NegInexactReal -NegInexactReal -NonNegInexactReal) (-> -NegInexactReal -NegInexactReal -NonNegInexactReal)
(-> -NegInexactReal -NegInexactReal -NegInexactReal -NonPosInexactReal) (-> -NegInexactReal -NegInexactReal -NegInexactReal -NonPosInexactReal)
(-> -PosInexactReal (Un -PosRat -PosInexactReal) -NonNegInexactReal) (-> -PosInexactReal (Un -PosRat -PosInexactReal) -NonNegInexactReal)
(-> (Un -PosRat -PosInexactReal) -PosInexactReal -NonNegInexactReal) (-> (Un -PosRat -PosInexactReal) -PosInexactReal -NonNegInexactReal)
(commutative-case -NonNegInexactReal (Un -PosRat -NonNegInexactReal) (Un -NonNegInexactReal -InexactRealNan)) (commutative-case -PosInexactReal (Un -PosRat -PosInexactReal) (Un -NonNegInexactReal -InexactRealNan))
(commutative-case -InexactReal (Un -PosRat -NegRat -InexactReal) -InexactReal) (commutative-case -InexactReal (Un -PosRat -NegRat -InexactReal) -InexactReal)
(varop-1+ -InexactReal) (varop-1+ -InexactReal)
;; reals ;; reals
(varop-1+ -PosReal) (varop-1+ -PosReal)
(varop-1+ (Un -NonNegReal -InexactRealNan))
(-> -NegReal -NegReal) (-> -NegReal -NegReal)
(-> -NonPosReal -NonPosReal) (-> -NonPosReal -NonPosReal)
(-> -NegReal -NegReal -NonNegReal) (-> -NegReal -NegReal -NonNegReal)
@ -1327,7 +1322,7 @@
(unop -Rat) (unop -Rat)
(-> -NonPosFlonum -NegFlonum) (-> -NonPosFlonum -NegFlonum)
(unop -Flonum) (unop -Flonum)
(-> -NonPosSingleFlonum -NegFlonum) (-> -NonPosSingleFlonum -NegSingleFlonum)
(unop -SingleFlonum) (unop -SingleFlonum)
(-> -NonPosInexactReal -NegInexactReal) (-> -NonPosInexactReal -NegInexactReal)
(unop -InexactReal) (unop -InexactReal)
@ -1820,13 +1815,13 @@
(-> -Int -Nat) (-> -Int -Nat)
(unop -PosRat) (unop -PosRat)
(-> -Rat -NonNegRat) (-> -Rat -NonNegRat)
(unop -PosFlonum) (-> -NonNegFlonum -NonNegFlonum) ; possible underflow, no pos -> pos
(-> -Flonum (Un -NonNegFlonum -FlonumNan)) (-> -Flonum (Un -NonNegFlonum -FlonumNan))
(unop -PosSingleFlonum) (-> -NonNegSingleFlonum -NonNegSingleFlonum)
(-> -SingleFlonum (Un -NonNegSingleFlonum -SingleFlonumNan)) (-> -SingleFlonum (Un -NonNegSingleFlonum -SingleFlonumNan))
(unop -PosInexactReal) (-> -NonNegInexactReal -NonNegInexactReal)
(-> -InexactReal (Un -NonNegInexactReal -InexactRealNan)) (-> -InexactReal (Un -NonNegInexactReal -InexactRealNan))
(unop -PosReal) (-> -NonNegReal -NonNegReal)
(-> -Real (Un -NonNegReal -InexactRealNan)) (-> -Real (Un -NonNegReal -InexactRealNan))
(map unop (list -FloatComplex -SingleFlonumComplex (map unop (list -FloatComplex -SingleFlonumComplex
-InexactComplex -ExactNumber N)))] -InexactComplex -ExactNumber N)))]