b2509dda635a2999e09016329585362358dc022f
[ghc.git] / testsuite / tests / codeGen / should_run / cgrun044.hs
1 {-# OPTIONS -cpp #-}
2 -- !!! Testing IEEE Float and Double extremity predicates.
3 module Main(main) where
4
5 import Data.Char
6 import Control.Monad.ST
7 import Data.Word
8 import Data.Array.ST
9
10 #include "ghcconfig.h"
11
12 reverse_if_bigendian :: [a] -> [a]
13 #ifdef WORDS_BIGENDIAN
14 reverse_if_bigendian = reverse
15 #else
16 reverse_if_bigendian = id
17 #endif
18
19
20 main :: IO ()
21 main = do
22 sequence_ (map putStrLn double_tests)
23 sequence_ (map putStrLn float_tests)
24 where
25 double_tests = run_tests double_numbers
26 float_tests = run_tests float_numbers
27
28 run_tests nums =
29 map ($ nums)
30 [ denorm
31 , pos_inf
32 , neg_inf
33 , nan
34 , neg_zero
35 , pos_zero
36 ]
37
38 -------------
39 double_numbers :: [Double]
40 double_numbers =
41 [ 0
42 , encodeFloat 0 0 -- 0 using encodeFloat method
43 , mkDouble (reverse_if_bigendian [0,0,0,0,0,0, 0xf0, 0x7f]) -- +inf
44 , encodeFloat 1 2047 -- +Inf
45 , encodeFloat 1 2048
46 , encodeFloat 1 2047 -- signalling NaN
47 , encodeFloat 0xf000000000000 2047 -- quiet NaN
48 , 0/(0::Double)
49 -- misc
50 , 1.82173691287639817263897126389712638972163e-300
51 , 1.82173691287639817263897126389712638972163e+300
52 , 4.9406564558412465e-324 -- smallest possible denorm number
53 -- (as reported by enquire running
54 -- on a i686-pc-linux.)
55 , 2.2250738585072014e-308
56 , 0.11
57 , 0.100
58 , -3.4
59 -- smallest
60 , let (l, _) = floatRange x
61 x = encodeFloat 1 (l-1)
62 in x
63 -- largest
64 , let (_, u) = floatRange x
65 d = floatDigits x
66 x = encodeFloat (floatRadix x ^ d - 1) (u - d)
67 in x
68 ]
69
70 float_numbers :: [Float]
71 float_numbers =
72 [ 0
73 , encodeFloat 0 0 -- 0 using encodeFloat method
74 , encodeFloat 1 255 -- +Inf
75 , encodeFloat 1 256
76 , encodeFloat 11 255 -- signalling NaN
77 , encodeFloat 0xf00000 255 -- quiet NaN
78 , 0/(0::Float)
79 -- misc
80 , 1.82173691287639817263897126389712638972163e-300
81 , 1.82173691287639817263897126389712638972163e+300
82 , 1.40129846e-45
83 , 1.17549435e-38
84 , 2.98023259e-08
85 , 0.11
86 , 0.100
87 , -3.4
88 -- smallest
89 , let (l, _) = floatRange x
90 x = encodeFloat 1 (l-1)
91 in x
92 -- largest
93 , let (_, u) = floatRange x
94 d = floatDigits x
95 x = encodeFloat (floatRadix x ^ d - 1) (u - d)
96 in x
97 ]
98
99 -------------
100
101 denorm :: RealFloat a => [a] -> String
102 denorm numbers =
103 unlines
104 ( ""
105 : "*********************************"
106 : ("Denormalised numbers: " ++ doubleOrFloat numbers)
107 : ""
108 : map showPerform numbers)
109 where
110 showPerform = showAndPerform (isDenormalized) "isDenormalised"
111
112 pos_inf :: RealFloat a => [a] -> String
113 pos_inf numbers =
114 unlines
115 ( ""
116 : "*********************************"
117 : ("Positive Infinity: " ++ doubleOrFloat numbers)
118 : ""
119 : map showPerform numbers)
120 where
121 showPerform = showAndPerform (isInfinite) "isInfinite"
122
123 neg_inf :: RealFloat a => [a] -> String
124 neg_inf numbers =
125 unlines
126 ( ""
127 : "*********************************"
128 : ("Negative Infinity: " ++ doubleOrFloat numbers)
129 : ""
130 : map showPerform numbers)
131 where
132 showPerform = showAndPerform (\ x -> isInfinite x && x < 0) "isNegInfinite"
133
134 nan :: RealFloat a => [a] -> String
135 nan numbers =
136 unlines
137 ( ""
138 : "*********************************"
139 : ("NaN: " ++ doubleOrFloat numbers)
140 : ""
141 : map showPerform numbers)
142 where
143 showPerform = showAndPerform (isNaN) "isNaN"
144
145 pos_zero :: RealFloat a => [a] -> String
146 pos_zero numbers =
147 unlines
148 ( ""
149 : "*********************************"
150 : ("Positive zero: " ++ doubleOrFloat numbers)
151 : ""
152 : map showPerform numbers)
153 where
154 showPerform = showAndPerform (==0) "isPosZero"
155
156 neg_zero :: RealFloat a => [a] -> String
157 neg_zero numbers =
158 unlines
159 ( ""
160 : "*********************************"
161 : ("Negative zero: " ++ doubleOrFloat numbers)
162 : ""
163 : map showPerform numbers)
164 where
165 showPerform = showAndPerform (isNegativeZero) "isNegativeZero"
166
167 -- what a hack.
168 doubleOrFloat :: RealFloat a => [a] -> String
169 doubleOrFloat ls
170 | (floatDigits atType) == (floatDigits (0::Double)) = "Double"
171 | (floatDigits atType) == (floatDigits (0::Float)) = "Float"
172 | otherwise = "unknown RealFloat type"
173 where
174 atType = undefined `asTypeOf` (head ls)
175
176 -- make a double from a list of 8 bytes
177 -- (caller deals with byte ordering.)
178 mkDouble :: [Word8] -> Double
179 mkDouble ls =
180 runST (( do
181 arr <- newArray_ (0,7)
182 sequence (zipWith (writeArray arr) [(0::Int)..] (take 8 ls))
183 arr' <- castSTUArray arr
184 readArray arr' 0
185 ) :: ST s Double )
186
187 showAndPerform :: (Show a, Show b)
188 => (a -> b)
189 -> String
190 -> a
191 -> String
192 showAndPerform fun name_fun val =
193 name_fun ++ ' ':show val ++ " = " ++ show (fun val)
194
195