X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FFloat.lhs;h=dbb556fe50083e46c987a7a874647cc83fd7911e;hb=685432ac839f249ccd98bdf79fcf0c985872380b;hp=1ca9638a336a74b2ac5ad9580ce0cd80ee2d6b30;hpb=80b3ca0899c2ae75f78c0060ece461538fd70017;p=ghc-base.git

diff --git a/GHC/Float.lhs b/GHC/Float.lhs
index 1ca9638..dbb556f 100644
--- a/GHC/Float.lhs
+++ b/GHC/Float.lhs
@@ -1,5 +1,8 @@
 \begin{code}
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
+-- We believe we could deorphan this module, by moving lots of things
+-- around, but we haven't got there yet:
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
@@ -23,6 +26,7 @@ module GHC.Float( module GHC.Float, Float(..), Double(..), Float#, Double# )
 
 import Data.Maybe
 
+import Data.Bits
 import GHC.Base
 import GHC.List
 import GHC.Enum
@@ -55,6 +59,11 @@ class  (Fractional a) => Floating a  where
     sinh, cosh, tanh    :: a -> a
     asinh, acosh, atanh :: a -> a
 
+    {-# INLINE (**) #-}
+    {-# INLINE logBase #-}
+    {-# INLINE sqrt #-}
+    {-# INLINE tan #-}
+    {-# INLINE tanh #-}
     x ** y              =  exp (log x * y)
     logBase x y         =  log y / log x
     sqrt x              =  x ** 0.5
@@ -147,19 +156,6 @@ class  (RealFrac a, Floating a) => RealFloat a  where
 %*********************************************************
 
 \begin{code}
-instance Eq Float where
-    (F# x) == (F# y) = x `eqFloat#` y
-
-instance Ord Float where
-    (F# x) `compare` (F# y) | x `ltFloat#` y = LT
-                            | x `eqFloat#` y = EQ
-                            | otherwise      = GT
-
-    (F# x) <  (F# y) = x `ltFloat#`  y
-    (F# x) <= (F# y) = x `leFloat#`  y
-    (F# x) >= (F# y) = x `geFloat#`  y
-    (F# x) >  (F# y) = x `gtFloat#`  y
-
 instance  Num Float  where
     (+)         x y     =  plusFloat x y
     (-)         x y     =  minusFloat x y
@@ -198,16 +194,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
@@ -254,8 +256,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)
 
@@ -285,19 +287,6 @@ instance  Show Float  where
 %*********************************************************
 
 \begin{code}
-instance Eq Double where
-    (D# x) == (D# y) = x ==## y
-
-instance Ord Double where
-    (D# x) `compare` (D# y) | x <## y   = LT
-                            | x ==## y  = EQ
-                            | otherwise = GT
-
-    (D# x) <  (D# y) = x <##  y
-    (D# x) <= (D# y) = x <=## y
-    (D# x) >= (D# y) = x >=## y
-    (D# x) >  (D# y) = x >##  y
-
 instance  Num Double  where
     (+)         x y     =  plusDouble x y
     (-)         x y     =  minusDouble x y
@@ -617,7 +606,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))
@@ -895,21 +886,12 @@ powerDouble  (D# x) (D# y) = D# (x **## y)
 \end{code}
 
 \begin{code}
-foreign import ccall unsafe "__encodeFloat"
-        encodeFloat# :: Int# -> ByteArray# -> Int -> Float
-foreign import ccall unsafe "__int_encodeFloat"
-        int_encodeFloat# :: Int# -> Int -> Float
-
-
 foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int
 foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int
 foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int
 foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int
 
 
-foreign import ccall unsafe "__encodeDouble"
-        encodeDouble# :: Int# -> ByteArray# -> Int -> Double
-
 foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int
 foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int
 foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int