Remove unnecessary parens

[ghc-base.git] / GHC / Float.lhs

diff --git a/GHC/Float.lhs b/GHC/Float.lhs
index 1190caf..0d535c5 100644 (file)
--- a/GHC/Float.lhs
+++ b/GHC/Float.lhs
@@ -1,5 +1,6 @@
 \begin{code}
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
@@ -18,10 +19,12 @@
 #include "ieee-flpt.h"
 
 -- #hide
-module GHC.Float( module GHC.Float, Float#, Double# )  where
+module GHC.Float( module GHC.Float, Float(..), Double(..), Float#, Double# )
+    where
 
 import Data.Maybe
 
+import Data.Bits
 import GHC.Base
 import GHC.List
 import GHC.Enum
@@ -141,25 +144,6 @@ class  (RealFrac a, Floating a) => RealFloat a  where
 
 %*********************************************************
 %*                                                      *
-\subsection{Type @Integer@, @Float@, @Double@}
-%*                                                      *
-%*********************************************************
-
-\begin{code}
--- | Single-precision floating point numbers.
--- It is desirable that this type be at least equal in range and precision
--- to the IEEE single-precision type.
-data Float      = F# Float#
-
--- | Double-precision floating point numbers.
--- It is desirable that this type be at least equal in range and precision
--- to the IEEE double-precision type.
-data Double     = D# Double#
-\end{code}
-
-
-%*********************************************************
-%*                                                      *
 \subsection{Type @Float@}
 %*                                                      *
 %*********************************************************
@@ -216,16 +200,22 @@ instance  RealFrac Float  where
     {-# INLINE floor #-}
     {-# INLINE truncate #-}
 
-    properFraction x
-      = case (decodeFloat x)      of { (m,n) ->
-        let  b = floatRadix x     in
-        if n >= 0 then
-            (fromInteger m * fromInteger b ^ n, 0.0)
-        else
-            case (quotRem m (b^(negate n))) of { (w,r) ->
-            (fromInteger w, encodeFloat r n)
-            }
-        }
+-- We assume that FLT_RADIX is 2 so that we can use more efficient code
+#if FLT_RADIX != 2
+#error FLT_RADIX must be 2
+#endif
+    properFraction (F# x#)
+      = case decodeFloat_Int# x# of
+        (# m#, n# #) ->
+            let m = I# m#
+                n = I# n#
+            in
+            if n >= 0
+            then (fromIntegral m * (2 ^ n), 0.0)
+            else let i = if m >= 0 then                m `shiftR` negate n
+                                   else negate (negate m `shiftR` negate n)
+                     f = m - (i `shiftL` negate n)
+                 in (fromIntegral i, encodeFloat (fromIntegral f) n)
 
     truncate x  = case properFraction x of
                      (n,_) -> n
@@ -272,8 +262,8 @@ instance  RealFloat Float  where
     floatDigits _       =  FLT_MANT_DIG     -- ditto
     floatRange _        =  (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto
 
-    decodeFloat (F# f#) = case decodeFloatInteger f# of
-                          (# i, e #) -> (i, I# e)
+    decodeFloat (F# f#) = case decodeFloat_Int# f# of
+                          (# i, e #) -> (smallInteger i, I# e)
 
     encodeFloat i (I# e) = F# (encodeFloatInteger i e)
 
@@ -520,6 +510,7 @@ formatRealFloat fmt decs x
           "0"     -> "0.0e0"
           [d]     -> d : ".0e" ++ show_e'
           (d:ds') -> d : '.' : ds' ++ "e" ++ show_e'
+          []      -> error "formatRealFloat/doFmt/FFExponent: []"
        Just dec ->
         let dec' = max dec 1 in
         case is of
@@ -565,6 +556,7 @@ roundTo base d is =
   case f d is of
     x@(0,_) -> x
     (1,xs)  -> (1, 1:xs)
+    _       -> error "roundTo: bad Value"
  where
   b2 = base `div` 2
 
@@ -633,7 +625,9 @@ floatToDigits base x =
         -- Haskell promises that p-1 <= logBase b f < p.
         (p - 1 + e0) * 3 `div` 10
      else
-        ceiling ((log (fromInteger (f+1)) +
+       -- f :: Integer, log :: Float -> Float, 
+        --               ceiling :: Float -> Int
+        ceiling ((log (fromInteger (f+1) :: Float) +
                  fromIntegral e * log (fromInteger b)) /
                    log (fromInteger base))
 --WAS:            fromInt e * log (fromInteger b))
@@ -732,13 +726,13 @@ Now, here's Lennart's code (which works)
 fromRat :: (RealFloat a) => Rational -> a
 
 -- Deal with special cases first, delegating the real work to fromRat'
-fromRat (n :% 0) | n > 0  =  1/0        -- +Infinity
-                 | n == 0 =  0/0        -- NaN
-                 | n < 0  = -1/0        -- -Infinity
+fromRat (n :% 0) | n > 0     =  1/0        -- +Infinity
+                 | n < 0     = -1/0        -- -Infinity
+                 | otherwise =  0/0        -- NaN
 
-fromRat (n :% d) | n > 0  = fromRat' (n :% d)
-                 | n == 0 = encodeFloat 0 0             -- Zero
-                 | n < 0  = - fromRat' ((-n) :% d)
+fromRat (n :% d) | n > 0     = fromRat' (n :% d)
+                 | n < 0     = - fromRat' ((-n) :% d)
+                 | otherwise = encodeFloat 0 0             -- Zero
 
 -- Conversion process:
 -- Scale the rational number by the RealFloat base until