ghc/tests/codeGen/should_run/cg044.hs

   1 -- !!! Testing IEEE Float and Double extremity predicates.
   2 module Main(main) where
   3
   4 main :: IO ()
   5 main = do
   6  sequence (map putStrLn double_tests)
   7  sequence (map putStrLn float_tests)
   8   where
   9    double_tests = run_tests double_numbers
  10    float_tests  = run_tests float_numbers
  11
  12    run_tests nums =
  13     map ($nums)
  14         [ denorm
  15         , pos_inf
  16         , neg_inf
  17         , nan
  18         , neg_zero
  19         , pos_zero
  20         ]
  21
  22 -------------
  23 double_numbers :: [Double]
  24 double_numbers =
  25       [ 0
  26       , encodeFloat 0 0     -- 0 using encodeFloat method
  27       , encodeFloat 1 2047  -- +Inf
  28       , encodeFloat 1 2048
  29       , encodeFloat 1  2047               -- signalling NaN
  30       , encodeFloat 0xf000000000000 2047  -- quiet NaN
  31       , 0/(0::Double)
  32         -- misc
  33       , 1.82173691287639817263897126389712638972163e-300
  34       , 1.82173691287639817263897126389712638972163e+300
  35       , 4.9406564558412465e-324  -- smallest possible denorm number
  36                                  -- (as reported by enquire running
  37                                  --  on a i686-pc-linux.)
  38       , 2.2250738585072014e-308
  39       , 0.11
  40       , 0.100
  41       , -3.4
  42         -- smallest
  43       , let (l, _) = floatRange x
  44             x = encodeFloat 1 (l-1)
  45         in x
  46         -- largest
  47       , let (_, u) = floatRange x
  48             d = floatDigits x
  49             x = encodeFloat (floatRadix x ^ d - 1) (u - d)
  50         in x
  51       ]
  52
  53 float_numbers :: [Float]
  54 float_numbers =
  55       [ 0
  56       , encodeFloat 0 0     -- 0 using encodeFloat method
  57       , encodeFloat 1 255  -- +Inf
  58       , encodeFloat 1 256
  59       , encodeFloat 11 255        -- signalling NaN
  60       , encodeFloat 0xf00000 255  -- quiet NaN
  61       , 0/(0::Float)
  62         -- misc
  63       , 1.82173691287639817263897126389712638972163e-300
  64       , 1.82173691287639817263897126389712638972163e+300
  65       , 1.40129846e-45
  66       , 1.17549435e-38
  67       , 2.98023259e-08
  68       , 0.11
  69       , 0.100
  70       , -3.4
  71         -- smallest
  72       , let (l, _) = floatRange x
  73             x = encodeFloat 1 (l-1)
  74         in x
  75         -- largest
  76       , let (_, u) = floatRange x
  77             d = floatDigits x
  78             x = encodeFloat (floatRadix x ^ d - 1) (u - d)
  79         in x
  80       ]
  81
  82 -------------
  83
  84 denorm :: RealFloat a => [a] -> String
  85 denorm numbers =
  86   unlines
  87      ( ""
  88      : "*********************************"
  89      : ("Denormalised numbers: " ++ doubleOrFloat numbers)
  90      : ""
  91      : map showPerform numbers)
  92  where
  93    showPerform = showAndPerform (isDenormalized) "isDenormalised"
  94
  95 pos_inf :: RealFloat a => [a] -> String
  96 pos_inf numbers =
  97   unlines
  98      ( ""
  99      : "*********************************"
 100      : ("Positive Infinity: " ++ doubleOrFloat numbers)
 101      : ""
 102      : map showPerform numbers)
 103  where
 104    showPerform = showAndPerform (isInfinite) "isInfinite"
 105
 106 neg_inf :: RealFloat a => [a] -> String
 107 neg_inf numbers =
 108   unlines
 109      ( ""
 110      : "*********************************"
 111      : ("Negative Infinity: " ++ doubleOrFloat numbers)
 112      : ""
 113      : map showPerform numbers)
 114  where
 115    showPerform = showAndPerform (\ x -> isInfinite x && x < 0) "isNegInfinite"
 116
 117 nan :: RealFloat a => [a] -> String
 118 nan numbers =
 119   unlines
 120      ( ""
 121      : "*********************************"
 122      : ("NaN: " ++ doubleOrFloat numbers)
 123      : ""
 124      : map showPerform numbers)
 125  where
 126    showPerform = showAndPerform (isNaN) "isNaN"
 127
 128 pos_zero :: RealFloat a => [a] -> String
 129 pos_zero numbers =
 130   unlines
 131      ( ""
 132      : "*********************************"
 133      : ("Positive zero: " ++ doubleOrFloat numbers)
 134      : ""
 135      : map showPerform numbers)
 136  where
 137    showPerform = showAndPerform (==0) "isPosZero"
 138
 139 neg_zero :: RealFloat a => [a] -> String
 140 neg_zero numbers =
 141   unlines
 142      ( ""
 143      : "*********************************"
 144      : ("Negative zero: " ++ doubleOrFloat numbers)
 145      : ""
 146      : map showPerform numbers)
 147  where
 148    showPerform = showAndPerform (isNegativeZero) "isNegativeZero"
 149
 150 -- what a hack.
 151 doubleOrFloat :: RealFloat a => [a] -> String
 152 doubleOrFloat ls
 153  | (floatDigits atType) == (floatDigits (0::Double)) = "Double"
 154  | (floatDigits atType) == (floatDigits (0::Float))  = "Float"
 155  | otherwise = "unknown RealFloat type"
 156  where
 157    atType = undefined `asTypeOf` (head ls)
 158
 159
 160
 161 showAndPerform :: (Show a, Show b)
 162                => (a -> b)
 163                -> String
 164                -> a
 165                -> String
 166 showAndPerform fun name_fun val =
 167   name_fun ++ ' ':show val ++ " = " ++ show (fun val)
 168