ref: a86b2bcdfabfe459b0865a9d5ea0b4499a08f9b0
parent: bd52a2999d3e0534d1714244aef5e4b242ad022c
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Tue Nov 28 12:26:48 EST 2023
Test updates for 32 bit
--- a/lib/Data/Double.hs
+++ b/lib/Data/Double.hs
@@ -18,6 +18,10 @@
import Data.Word
import Text.Show
+--
+-- NOTE: On 32 bit platforms the MicroHs Double type is actually 32 bit floats.
+--
+
instance Num Double where
(+) = primDoubleAdd
(-) = primDoubleSub
@@ -54,7 +58,7 @@
instance Real Double where
toRational x =
- let (m, e) = decodeDouble x
+ let (m, e) = decodeFloat x
in toRational m * 2^^e
instance Floating Double where
@@ -83,19 +87,23 @@
-- Assumes 64 bit floats
instance RealFloat Double where
floatRadix _ = 2
- floatDigits _ = 53
- floatRange _ = (-1021,1024)
- decodeFloat = decodeDouble
- encodeFloat = encodeDouble
- isNaN = isNaNDouble
- isInfinite = isInfDouble
- isDenormalized = isDenDouble
- isNegativeZero = isNegZeroDouble
+ floatDigits _ = flt 24 53
+ floatRange _ = flt (-125,128) (-1021,1024)
+ decodeFloat = flt decodeFloat32 decodeFloat64
+ encodeFloat = flt encodeFloat32 encodeFloat64
+ isNaN = flt isNaNFloat32 isNaNFloat64
+ isInfinite = flt isInfFloat32 isInfFloat64
+ isDenormalized = flt isDenFloat32 isDenFloat64
+ isNegativeZero = flt isNegZeroFloat32 isNegZeroFloat64
isIEEE _ = True
atan2 x y = primPerformIO (catan2 x y)
-decodeDouble :: Double -> (Integer, Int)
-decodeDouble x =
+flt :: forall a . a -> a -> a
+flt f d | _wordSize == 32 = f
+ | otherwise = d
+
+decodeFloat64 :: Double -> (Integer, Int)
+decodeFloat64 x =
let xw = primWordFromDoubleRaw x
sign = xw .&. 0x8000000000000000
expn = (xw .&. 0x7fffffffffffffff) `shiftR` 52
@@ -113,29 +121,29 @@
(neg (_wordToInteger (mant .|. 0x0010000000000000)),
primWordToInt expn - 1023 - 52)
-isNaNDouble :: Double -> Bool
-isNaNDouble x =
+isNaNFloat64 :: Double -> Bool
+isNaNFloat64 x =
let xw = primWordFromDoubleRaw x
expn = (xw .&. 0x7fffffffffffffff) `shiftR` 52
mant = xw .&. 0x000fffffffffffff
in expn == 0x7ff && mant /= 0
-isInfDouble :: Double -> Bool
-isInfDouble x =
+isInfFloat64 :: Double -> Bool
+isInfFloat64 x =
let xw = primWordFromDoubleRaw x
expn = (xw .&. 0x7fffffffffffffff) `shiftR` 52
mant = xw .&. 0x000fffffffffffff
in expn == 0x7ff && mant == 0
-isDenDouble :: Double -> Bool
-isDenDouble x =
+isDenFloat64 :: Double -> Bool
+isDenFloat64 x =
let xw = primWordFromDoubleRaw x
expn = (xw .&. 0x7fffffffffffffff) `shiftR` 52
mant = xw .&. 0x000fffffffffffff
in expn == 0 && mant /= 0
-isNegZeroDouble :: Double -> Bool
-isNegZeroDouble x =
+isNegZeroFloat64 :: Double -> Bool
+isNegZeroFloat64 x =
let xw = primWordFromDoubleRaw x
sign = xw .&. 0x8000000000000000
rest = xw .&. 0x7fffffffffffffff
@@ -142,5 +150,56 @@
in sign /= 0 && rest == 0
-- Simple (and sometimes wrong) encoder
-encodeDouble :: Integer -> Int -> Double
-encodeDouble mant expn = fromInteger mant * 2^^expn
+encodeFloat64 :: Integer -> Int -> Double
+encodeFloat64 mant expn = fromInteger mant * 2^^expn
+
+decodeFloat32 :: Double -> (Integer, Int)
+decodeFloat32 x =
+ let xw = primWordFromDoubleRaw x
+ sign = xw .&. 0x80000000
+ expn = (xw .&. 0x7fffffff) `shiftR` 23
+ mant = xw .&. 0x007fffff
+ neg = if sign /= 0 then negate else id
+ in if expn == 0 then
+ -- subnormal or 0
+ (neg (_wordToInteger mant), 0)
+ else if expn == 0xff then
+ -- infinity or NaN
+ (0, 0)
+ else
+ -- ordinary number, add hidden bit
+ -- mant is offset-1023, and assumes scaled mantissa (thus -52)
+ (neg (_wordToInteger (mant .|. 0x00400000)),
+ primWordToInt expn - 127 - 22)
+
+isNaNFloat32 :: Double -> Bool
+isNaNFloat32 x =
+ let xw = primWordFromDoubleRaw x
+ expn = (xw .&. 0x7fffffff) `shiftR` 23
+ mant = xw .&. 0x007fffff
+ in expn == 0xff && mant /= 0
+
+isInfFloat32 :: Double -> Bool
+isInfFloat32 x =
+ let xw = primWordFromDoubleRaw x
+ expn = (xw .&. 0x7fffffff) `shiftR` 23
+ mant = xw .&. 0x007fffff
+ in expn == 0x7ff && mant == 0
+
+isDenFloat32 :: Double -> Bool
+isDenFloat32 x =
+ let xw = primWordFromDoubleRaw x
+ expn = (xw .&. 0x7fffffff) `shiftR` 23
+ mant = xw .&. 0x007fffff
+ in expn == 0 && mant /= 0
+
+isNegZeroFloat32 :: Double -> Bool
+isNegZeroFloat32 x =
+ let xw = primWordFromDoubleRaw x
+ sign = xw .&. 0x80000000
+ rest = xw .&. 0x7fffffff
+ in sign /= 0 && rest == 0
+
+-- Simple (and sometimes wrong) encoder
+encodeFloat32 :: Integer -> Int -> Double
+encodeFloat32 mant expn = fromInteger mant * 2^^expn
--- a/tests/Default.hs
+++ b/tests/Default.hs
@@ -5,5 +5,5 @@
main :: IO ()
main = do
print 1
- print 1.2
+ print 1.5
print [] -- defaults to Int, a little weird
--- a/tests/Default.ref
+++ b/tests/Default.ref
@@ -1,3 +1,3 @@
1
-1.2
+1.5
[]
--- a/tests/FArith.hs
+++ b/tests/FArith.hs
@@ -7,7 +7,7 @@
list1 = [-100.343241, -53.3248973, 0.0, 1.0, 1.23453523, 3243534.34534, 999.999]
list2 :: [Double]
-list2 = [-100.343241, -53.3248973, 0.0, 1.0, 1.23453523, 3243534.34534, 999.999, 1.2e33]
+list2 = [-100.343241, -53.3248973, 0.0, 1.0, 1.23453523, 3243534.34534, 999.999, 1.2e13]
divide :: Double -> Double -> Double
divide x y = if y == 0.0 then 0.0 else x / y
@@ -21,4 +21,4 @@
let str = readDouble "1.576"
putStrLn $ show str
putStrLn $ show $ 1.0 + readDouble "2.5"
- putStrLn $ show $ map readDouble ["1.5e42", "1.2e-90"]
+ putStrLn $ show $ map readDouble ["1.5e32", "1.25e-33"]
--- a/tests/FArith.ref
+++ b/tests/FArith.ref
@@ -1,7 +1,7 @@
-[-200.686482,0.0,10068.76601438408,1.0,-153.6681383,-47.0183437,5350.79302107415,1.881733413108702,-100.343241,-100.343241,-0.0,0.0,-99.34324100000001,-101.343241,-100.343241,-100.343241,-99.10870577,-101.57777623,-123.8772661068804,-81.28017618419848,3243434.002099,-3243634.688581,-325466748.5062289,-3.093638923360364e-05,899.655759,-1100.342241,-100343.140656759,-0.1003433413433413,1.2e+33,-1.2e+33,-1.204118892e+35,-8.36193675e-32,-153.6681383,47.0183437,5350.79302107415,0.53142490484237,-106.6497946,0.0,2843.544672055548,1.0,-53.3248973,-53.3248973,-0.0,0.0,-52.3248973,-54.3248973,-53.3248973,-53.3248973,-52.09036207,-54.55943253,-65.83146435298188,-43.19430989425875,3243481.0204427,-3243587.6702373,-172961135.8542782,-1.644036770463433e-05,946.6741027,-1053.3238973,-53324.8439751027,-0.05332495062495063,1.2e+33,-1.2e+33,-6.398987676000001e+34,-4.443741441666667e-32,-100.343241,100.343241,-0.0,-0.0,-53.3248973,53.3248973,-0.0,-0.0,0.0,0.0,0.0,0.0,1.0,-1.0,0.0,0.0,1.23453523,-1.23453523,0.0,0.0,3243534.34534,-3243534.34534,0.0,0.0,999.999,-999.999,0.0,0.0,1.2e+33,-1.2e+33,0.0,0.0,-99.34324100000001,101.343241,-100.343241,-0.009965793311380085,-52.3248973,54.3248973,-53.3248973,-0.01875296626215912,1.0,1.0,0.0,0.0,2.0,0.0,1.0,1.0,2.23453523,-0.2345352300000001,1.23453523,0.8100214361642801,3243535.34534,-3243533.34534,3243534.34534,3.083056609024981e-07,1000.999,-998.999,999.999,0.001000001000001,1.2e+33,-1.2e+33,1.2e+33,8.333333333333333e-34,-99.10870577,101.57777623,-123.8772661068804,-0.01230312293779708,-52.09036207,54.55943253,-65.83146435298188,-0.02315119751763685,1.23453523,1.23453523,0.0,0.0,2.23453523,0.2345352300000001,1.23453523,1.23453523,2.46907046,0.0,1.524077234111153,1.0,3243535.57987523,-3243533.11080477,4004257.419037217,3.806141999925675e-07,1001.23353523,-998.76446477,1234.53399546477,0.001234536464536465,1.2e+33,-1.2e+33,1.481442276e+33,1.028779358333333e-33,3243434.002099,3243634.688581,-325466748.5062289,-32324.39288402096,3243481.0204427,3243587.6702373,-172961135.8542782,-60825.89014831539,3243534.34534,3243534.34534,0.0,0.0,3243535.34534,3243533.34534,3243534.34534,3243534.34534,3243535.57987523,3243533.11080477,4004257.419037217,2627332.348660475,6487068.69068,0.0,10520515049400.18,1.0,3244534.34434,3242534.34634,3243531101.805655,3243.537588877589,1.2e+33,-1.2e+33,3.892241214408e+39,2.702945287783333e-27,899.655759,1100.342241,-100343.140656759,-9.965783345586773,946.6741027,1053.3238973,-53324.8439751027,-18.75294750919286,999.999,999.999,0.0,0.0,1000.999,998.999,999.999,999.999,1001.23353523,998.76446477,1234.53399546477,810.020626142844,3244534.34434,-3242534.34634,3243531101.805655,0.0003083053525968371,1999.998,0.0,999998.000001,1.0,1.2e+33,-1.2e+33,1.1999988e+36,8.333325e-31]
+[-200.686482,0.0,10068.76601438408,1.0,-153.6681383,-47.0183437,5350.79302107415,1.881733413108702,-100.343241,-100.343241,-0.0,0.0,-99.34324100000001,-101.343241,-100.343241,-100.343241,-99.10870577,-101.57777623,-123.8772661068804,-81.28017618419848,3243434.002099,-3243634.688581,-325466748.5062289,-3.093638923360364e-05,899.655759,-1100.342241,-100343.140656759,-0.1003433413433413,11999999999899.66,-12000000000100.34,-1204118892000000.0,-8.361936750000001e-12,-153.6681383,47.0183437,5350.79302107415,0.53142490484237,-106.6497946,0.0,2843.544672055548,1.0,-53.3248973,-53.3248973,-0.0,0.0,-52.3248973,-54.3248973,-53.3248973,-53.3248973,-52.09036207,-54.55943253,-65.83146435298188,-43.19430989425875,3243481.0204427,-3243587.6702373,-172961135.8542782,-1.644036770463433e-05,946.6741027,-1053.3238973,-53324.8439751027,-0.05332495062495063,11999999999946.68,-12000000000053.32,-639898767600000.0,-4.443741441666667e-12,-100.343241,100.343241,-0.0,-0.0,-53.3248973,53.3248973,-0.0,-0.0,0.0,0.0,0.0,0.0,1.0,-1.0,0.0,0.0,1.23453523,-1.23453523,0.0,0.0,3243534.34534,-3243534.34534,0.0,0.0,999.999,-999.999,0.0,0.0,12000000000000.0,-12000000000000.0,0.0,0.0,-99.34324100000001,101.343241,-100.343241,-0.009965793311380085,-52.3248973,54.3248973,-53.3248973,-0.01875296626215912,1.0,1.0,0.0,0.0,2.0,0.0,1.0,1.0,2.23453523,-0.2345352300000001,1.23453523,0.8100214361642801,3243535.34534,-3243533.34534,3243534.34534,3.083056609024981e-07,1000.999,-998.999,999.999,0.001000001000001,12000000000001.0,-11999999999999.0,12000000000000.0,8.333333333333334e-14,-99.10870577,101.57777623,-123.8772661068804,-0.01230312293779708,-52.09036207,54.55943253,-65.83146435298188,-0.02315119751763685,1.23453523,1.23453523,0.0,0.0,2.23453523,0.2345352300000001,1.23453523,1.23453523,2.46907046,0.0,1.524077234111153,1.0,3243535.57987523,-3243533.11080477,4004257.419037217,3.806141999925675e-07,1001.23353523,-998.76446477,1234.53399546477,0.001234536464536465,12000000000001.23,-11999999999998.77,14814422760000.0,1.028779358333333e-13,3243434.002099,3243634.688581,-325466748.5062289,-32324.39288402096,3243481.0204427,3243587.6702373,-172961135.8542782,-60825.89014831539,3243534.34534,3243534.34534,0.0,0.0,3243535.34534,3243533.34534,3243534.34534,3243534.34534,3243535.57987523,3243533.11080477,4004257.419037217,2627332.348660475,6487068.69068,0.0,10520515049400.18,1.0,3244534.34434,3242534.34634,3243531101.805655,3243.537588877589,12000003243534.35,-11999996756465.65,3.892241214408e+19,2.702945287783333e-07,899.655759,1100.342241,-100343.140656759,-9.965783345586773,946.6741027,1053.3238973,-53324.8439751027,-18.75294750919286,999.999,999.999,0.0,0.0,1000.999,998.999,999.999,999.999,1001.23353523,998.76446477,1234.53399546477,810.020626142844,3244534.34434,-3242534.34634,3243531101.805655,0.0003083053525968371,1999.998,0.0,999998.000001,1.0,12000000001000.0,-11999999999000.0,1.1999988e+16,8.333325e-11]
[True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,True,True,False,False,False,True,True,True,False,False,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,True,False,False,True,False,True,False,True,False,False,True,True,False,True,True,True,False,False,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,False,False,True,True,False,True,True,True,False,False,True,False,False,True,False,True,False,True,True,True,False,False]
[2.234983,0.4469966,0.2234983,0.02234983,1.232,0.2464,0.1232,0.01232,23.0,4.6,2.3,0.23]
[-2.234983,0.4469966,-0.2234983,0.02234983,-1.232,0.2464,-0.1232,0.01232,-23.0,4.6,-2.3,0.23]
1.576
3.5
-[1.5e+42,1.2e-90]
+[1.5e+32,1.25e-33]
--- a/tests/Floating.hs
+++ b/tests/Floating.hs
@@ -3,6 +3,6 @@
main :: IO ()
main = do
- print $ log (1000::Double)
+ print $ logBase 10 (1000::Double)
print $ cos (pi::Double)
print $ sqrt (4::Double)
--- a/tests/Floating.ref
+++ b/tests/Floating.ref
@@ -1,3 +1,3 @@
-6.907755278982137
+3.0
-1.0
2.0
--- a/tests/Word.hs
+++ b/tests/Word.hs
@@ -4,10 +4,8 @@
main :: IO ()
main = do
- putStrLn $ show (4294967295::Int)
putStrLn $ show (1000::Word)
- putStrLn $ show twoTo32M1
- putStrLn $ show $ (*) twoTo32M1 twoTo32M1
+ putStrLn $ show $ maxw*maxw > 0
-twoTo32M1 :: Word
-twoTo32M1 = 4294967295::Word
+maxw :: Word
+maxw = if _wordSize == 32 then 0x7fff::Word else 0x7fffffff::Word
--- a/tests/Word.ref
+++ b/tests/Word.ref
@@ -1,4 +1,2 @@
-4294967295
1000
-4294967295
-18446744065119617025
+True
--
⑨