[project @ 1997-09-26 13:38:58 by simonm]

this file got lost somehow

diff --git a/ghc/tests/codeGen/should_run/cg034.hs b/ghc/tests/codeGen/should_run/cg034.hs
new file mode 100644 (file)
index 0000000..2f01c9b
--- /dev/null
+++ b/ghc/tests/codeGen/should_run/cg034.hs
@@ -0,0 +1,162 @@
+import Ratio -- 1.3
+
+main = putStr (
+   shows tinyFloat  ( '\n'
+ : shows t_f       ( '\n'
+ : shows hugeFloat  ( '\n'
+ : shows h_f       ( '\n'
+ : shows tinyDouble ( '\n'
+ : shows t_d       ( '\n'
+ : shows hugeDouble ( '\n'
+ : shows h_d       ( '\n'
+ : shows x_f       ( '\n'
+ : shows x_d       ( '\n'
+ : shows y_f       ( '\n'
+ : shows y_d       ( "\n"
+ )))))))))))))
+  where
+    t_f :: Float
+    t_d :: Double
+    h_f :: Float
+    h_d :: Double
+    x_f :: Float
+    x_d :: Double
+    y_f :: Float
+    y_d :: Double
+    t_f = fromRationalX (toRational tinyFloat)
+    t_d = fromRationalX (toRational tinyDouble)
+    h_f = fromRationalX (toRational hugeFloat)
+    h_d = fromRationalX (toRational hugeDouble)
+    x_f = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational)
+    x_d = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational)
+    y_f = 1.82173691287639817263897126389712638972163e-300
+    y_d = 1.82173691287639817263897126389712638972163e-300
+
+--!! fromRational woes
+
+fromRationalX :: (RealFloat a) => Rational -> a
+fromRationalX r =
+       let 
+           h = ceiling (huge `asTypeOf` x)
+           b = toInteger (floatRadix x)
+           x = fromRat 0 r
+           fromRat e0 r' =
+               let d = denominator r'
+                   n = numerator r'
+               in  if d > h then
+                      let e = integerLogBase b (d `div` h) + 1
+                      in  fromRat (e0-e) (n % (d `div` (b^e)))
+                   else if abs n > h then
+                      let e = integerLogBase b (abs n `div` h) + 1
+                      in  fromRat (e0+e) ((n `div` (b^e)) % d)
+                   else
+                      scaleFloat e0 (rationalToRealFloat {-fromRational-} r')
+       in  x
+
+{-
+fromRationalX r =
+  rationalToRealFloat r
+{- Hmmm...
+       let 
+           h = ceiling (huge `asTypeOf` x)
+           b = toInteger (floatRadix x)
+           x = fromRat 0 r
+
+           fromRat e0 r' =
+{--}           trace (shows e0 ('/' : shows r' ('/' : shows h "\n"))) (
+               let d = denominator r'
+                   n = numerator r'
+               in  if d > h then
+                      let e = integerLogBase b (d `div` h) + 1
+                      in  fromRat (e0-e) (n % (d `div` (b^e)))
+                   else if abs n > h then
+                      let e = integerLogBase b (abs n `div` h) + 1
+                      in  fromRat (e0+e) ((n `div` (b^e)) % d)
+                   else
+                      scaleFloat e0 (rationalToRealFloat r')
+                      -- now that we know things are in-bounds,
+                      -- we use the "old" Prelude code.
+{--}           )
+       in  x
+-}
+-}
+
+-- Compute the discrete log of i in base b.
+-- Simplest way would be just divide i by b until it's smaller then b, but that would
+-- be very slow!  We are just slightly more clever.
+integerLogBase :: Integer -> Integer -> Int
+integerLogBase b i =
+     if i < b then
+        0
+     else
+       -- Try squaring the base first to cut down the number of divisions.
+        let l = 2 * integerLogBase (b*b) i
+           doDiv :: Integer -> Int -> Int
+           doDiv i l = if i < b then l else doDiv (i `div` b) (l+1)
+       in  doDiv (i `div` (b^l)) l
+
+
+------------
+
+-- Compute smallest and largest floating point values.
+tiny :: (RealFloat a) => a
+tiny =
+       let (l, _) = floatRange x
+           x = encodeFloat 1 (l-1)
+       in  x
+
+huge :: (RealFloat a) => a
+huge =
+       let (_, u) = floatRange x
+           d = floatDigits x
+           x = encodeFloat (floatRadix x ^ d - 1) (u - d)
+       in  x
+
+tinyDouble = tiny :: Double
+tinyFloat  = tiny :: Float
+hugeDouble = huge :: Double
+hugeFloat  = huge :: Float
+
+{-
+[In response to a request by simonpj, Joe Fasel writes:]
+
+A quite reasonable request!  This code was added to the Prelude just
+before the 1.2 release, when Lennart, working with an early version
+of hbi, noticed that (read . show) was not the identity for
+floating-point numbers.         (There was a one-bit error about half the time.)
+The original version of the conversion function was in fact simply
+a floating-point divide, as you suggest above. The new version is,
+I grant you, somewhat denser.
+
+How's this?
+
+--Joe
+-}
+
+
+rationalToRealFloat :: (RealFloat a) => Rational -> a
+
+rationalToRealFloat x  =  x'
+       where x'    = f e
+
+--             If the exponent of the nearest floating-point number to x 
+--             is e, then the significand is the integer nearest xb^(-e),
+--             where b is the floating-point radix.  We start with a good
+--             guess for e, and if it is correct, the exponent of the
+--             floating-point number we construct will again be e.  If
+--             not, one more iteration is needed.
+
+             f e   = if e' == e then y else f e'
+                     where y      = encodeFloat (round (x * (1%b)^^e)) e
+                           (_,e') = decodeFloat y
+             b     = floatRadix x'
+
+--             We obtain a trial exponent by doing a floating-point
+--             division of x's numerator by its denominator.  The
+--             result of this division may not itself be the ultimate
+--             result, because of an accumulation of three rounding
+--             errors.
+
+             (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
+                                       / fromInteger (denominator x))
+