ghc/tests/codeGen/should_run/cg034.hs

   1 import Ratio -- 1.3
   2
   3 main = putStr (
   4    shows tinyFloat  ( '\n'
   5  : shows t_f        ( '\n'
   6  : shows hugeFloat  ( '\n'
   7  : shows h_f        ( '\n'
   8  : shows tinyDouble ( '\n'
   9  : shows t_d        ( '\n'
  10  : shows hugeDouble ( '\n'
  11  : shows h_d        ( '\n'
  12  : shows x_f        ( '\n'
  13  : shows x_d        ( '\n'
  14  : shows y_f        ( '\n'
  15  : shows y_d        ( "\n"
  16  )))))))))))))
  17   where
  18     t_f :: Float
  19     t_d :: Double
  20     h_f :: Float
  21     h_d :: Double
  22     x_f :: Float
  23     x_d :: Double
  24     y_f :: Float
  25     y_d :: Double
  26     t_f = fromRationalX (toRational tinyFloat)
  27     t_d = fromRationalX (toRational tinyDouble)
  28     h_f = fromRationalX (toRational hugeFloat)
  29     h_d = fromRationalX (toRational hugeDouble)
  30     x_f = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational)
  31     x_d = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational)
  32     y_f = 1.82173691287639817263897126389712638972163e-300
  33     y_d = 1.82173691287639817263897126389712638972163e-300
  34
  35 --!! fromRational woes
  36
  37 fromRationalX :: (RealFloat a) => Rational -> a
  38 fromRationalX r =
  39         let
  40             h = ceiling (huge `asTypeOf` x)
  41             b = toInteger (floatRadix x)
  42             x = fromRat 0 r
  43             fromRat e0 r' =
  44                 let d = denominator r'
  45                     n = numerator r'
  46                 in  if d > h then
  47                        let e = integerLogBase b (d `div` h) + 1
  48                        in  fromRat (e0-e) (n % (d `div` (b^e)))
  49                     else if abs n > h then
  50                        let e = integerLogBase b (abs n `div` h) + 1
  51                        in  fromRat (e0+e) ((n `div` (b^e)) % d)
  52                     else
  53                        scaleFloat e0 (rationalToRealFloat {-fromRational-} r')
  54         in  x
  55
  56 {-
  57 fromRationalX r =
  58   rationalToRealFloat r
  59 {- Hmmm...
  60         let
  61             h = ceiling (huge `asTypeOf` x)
  62             b = toInteger (floatRadix x)
  63             x = fromRat 0 r
  64
  65             fromRat e0 r' =
  66 {--}            trace (shows e0 ('/' : shows r' ('/' : shows h "\n"))) (
  67                 let d = denominator r'
  68                     n = numerator r'
  69                 in  if d > h then
  70                        let e = integerLogBase b (d `div` h) + 1
  71                        in  fromRat (e0-e) (n % (d `div` (b^e)))
  72                     else if abs n > h then
  73                        let e = integerLogBase b (abs n `div` h) + 1
  74                        in  fromRat (e0+e) ((n `div` (b^e)) % d)
  75                     else
  76                        scaleFloat e0 (rationalToRealFloat r')
  77                        -- now that we know things are in-bounds,
  78                        -- we use the "old" Prelude code.
  79 {--}            )
  80         in  x
  81 -}
  82 -}
  83
  84 -- Compute the discrete log of i in base b.
  85 -- Simplest way would be just divide i by b until it's smaller then b, but that would
  86 -- be very slow!  We are just slightly more clever.
  87 integerLogBase :: Integer -> Integer -> Int
  88 integerLogBase b i =
  89      if i < b then
  90         0
  91      else
  92         -- Try squaring the base first to cut down the number of divisions.
  93         let l = 2 * integerLogBase (b*b) i
  94             doDiv :: Integer -> Int -> Int
  95             doDiv i l = if i < b then l else doDiv (i `div` b) (l+1)
  96         in  doDiv (i `div` (b^l)) l
  97
  98
  99 ------------
 100
 101 -- Compute smallest and largest floating point values.
 102 tiny :: (RealFloat a) => a
 103 tiny =
 104         let (l, _) = floatRange x
 105             x = encodeFloat 1 (l-1)
 106         in  x
 107
 108 huge :: (RealFloat a) => a
 109 huge =
 110         let (_, u) = floatRange x
 111             d = floatDigits x
 112             x = encodeFloat (floatRadix x ^ d - 1) (u - d)
 113         in  x
 114
 115 tinyDouble = tiny :: Double
 116 tinyFloat  = tiny :: Float
 117 hugeDouble = huge :: Double
 118 hugeFloat  = huge :: Float
 119
 120 {-
 121 [In response to a request by simonpj, Joe Fasel writes:]
 122
 123 A quite reasonable request!  This code was added to the Prelude just
 124 before the 1.2 release, when Lennart, working with an early version
 125 of hbi, noticed that (read . show) was not the identity for
 126 floating-point numbers.  (There was a one-bit error about half the time.)
 127 The original version of the conversion function was in fact simply
 128 a floating-point divide, as you suggest above.  The new version is,
 129 I grant you, somewhat denser.
 130
 131 How's this?
 132
 133 --Joe
 134 -}
 135
 136
 137 rationalToRealFloat :: (RealFloat a) => Rational -> a
 138
 139 rationalToRealFloat x   =  x'
 140         where x'    = f e
 141
 142 --              If the exponent of the nearest floating-point number to x
 143 --              is e, then the significand is the integer nearest xb^(-e),
 144 --              where b is the floating-point radix.  We start with a good
 145 --              guess for e, and if it is correct, the exponent of the
 146 --              floating-point number we construct will again be e.  If
 147 --              not, one more iteration is needed.
 148
 149               f e   = if e' == e then y else f e'
 150                       where y      = encodeFloat (round (x * (1%b)^^e)) e
 151                             (_,e') = decodeFloat y
 152               b     = floatRadix x'
 153
 154 --              We obtain a trial exponent by doing a floating-point
 155 --              division of x's numerator by its denominator.  The
 156 --              result of this division may not itself be the ultimate
 157 --              result, because of an accumulation of three rounding
 158 --              errors.
 159
 160               (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
 161                                         / fromInteger (denominator x))
 162