[project @ 1999-12-20 10:34:27 by simonpj]

[ghc-hetmet.git] / ghc / lib / std / PrelNumExtra.lhs

diff --git a/ghc/lib/std/PrelNumExtra.lhs b/ghc/lib/std/PrelNumExtra.lhs
index 48cda70..c9fa3c5 100644 (file)
--- a/ghc/lib/std/PrelNumExtra.lhs
+++ b/ghc/lib/std/PrelNumExtra.lhs
@@ -5,6 +5,7 @@
 \section[PrelNumExtra]{Module @PrelNumExtra@}
 
 \begin{code}
+{-# OPTIONS -fno-cpr-analyse #-}
 {-# OPTIONS -fno-implicit-prelude #-}
 {-# OPTIONS -H20m #-}
 
@@ -17,8 +18,10 @@ module PrelNumExtra where
 
 import PrelBase
 import PrelGHC
+import PrelEnum
+import PrelShow
 import PrelNum
-import {-# SOURCE #-} PrelErr ( error )
+import PrelErr ( error )
 import PrelList
 import PrelMaybe
 import Maybe           ( fromMaybe )
@@ -26,7 +29,7 @@ import Maybe          ( fromMaybe )
 import PrelArr         ( Array, array, (!) )
 import PrelIOBase      ( unsafePerformIO )
 import PrelCCall       ()      -- we need the definitions of CCallable and 
-                               -- CReturnable for the _ccall_s herein.
+                               -- CReturnable for the foreign calls herein.
 \end{code}
 
 %*********************************************************
@@ -59,7 +62,14 @@ instance  Num Float  where
     signum x | x == 0.0         = 0
             | x > 0.0   = 1
             | otherwise = negate 1
+
+    {-# INLINE fromInteger #-}
     fromInteger n      =  encodeFloat n 0
+       -- It's important that encodeFloat inlines here, and that 
+       -- fromInteger in turn inlines,
+       -- so that if fromInteger is applied to an (S# i) the right thing happens
+
+    {-# INLINE fromInt #-}
     fromInt i          =  int2Float i
 
 instance  Real Float  where
@@ -142,6 +152,7 @@ foreign import ccall "__encodeFloat" unsafe
 foreign import ccall "__int_encodeFloat" unsafe 
        int_encodeFloat# :: Int# -> Int -> Float
 
+
 foreign import ccall "isFloatNaN" unsafe isFloatNaN :: Float -> Int
 foreign import ccall "isFloatInfinite" unsafe isFloatInfinite :: Float -> Int
 foreign import ccall "isFloatDenormalized" unsafe isFloatDenormalized :: Float -> Int
@@ -208,6 +219,9 @@ instance  Num Double  where
     signum x | x == 0.0         = 0
             | x > 0.0   = 1
             | otherwise = negate 1
+
+    {-# INLINE fromInteger #-}
+       -- See comments with Num Float
     fromInteger n      =  encodeFloat n 0
     fromInt (I# n#)    =  case (int2Double# n#) of { d# -> D# d# }
 
@@ -256,14 +270,6 @@ instance  RealFrac Double  where
     {-# SPECIALIZE ceiling  :: Double -> Integer #-}
     {-# SPECIALIZE floor    :: Double -> Integer #-}
 
-#if defined(__UNBOXED_INSTANCES__)
-    {-# SPECIALIZE properFraction :: Double -> (Int#, Double) #-}
-    {-# SPECIALIZE truncate :: Double -> Int# #-}
-    {-# SPECIALIZE round    :: Double -> Int# #-}
-    {-# SPECIALIZE ceiling  :: Double -> Int# #-}
-    {-# SPECIALIZE floor    :: Double -> Int# #-}
-#endif
-
     properFraction x
       = case (decodeFloat x)      of { (m,n) ->
        let  b = floatRadix x     in
@@ -564,7 +570,11 @@ prR n r e0
        s@(h:t) = show ((round (r * 10^n))::Integer)
        e       = e0+1
        
+#ifdef USE_REPORT_PRELUDE
+        takeN n ls rs = take n ls ++ rs
+#else
        takeN (I# n#) ls rs = takeUInt_append n# ls rs
+#endif
 
 drop0 :: String -> String -> String
 drop0     [] rs = rs
@@ -722,7 +732,7 @@ showFloat x  =  showString (formatRealFloat FFGeneric Nothing x)
 
 -- These are the format types.  This type is not exported.
 
-data FFFormat = FFExponent | FFFixed | FFGeneric --no need: deriving (Eq, Ord, Show)
+data FFFormat = FFExponent | FFFixed | FFGeneric
 
 formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String
 formatRealFloat fmt decs x
@@ -742,10 +752,11 @@ formatRealFloat fmt decs x
      FFExponent ->
       case decs of
        Nothing ->
-        let e' = if e==0 then 0 else e-1 in
-       (case ds of
-          [d]     -> d : ".0e"
-         (d:ds') -> d : '.' : ds' ++ "e") ++ show e'
+        let show_e' = show (e-1) in
+       case ds of
+          "0"     -> "0.0e0"
+          [d]     -> d : ".0e" ++ show_e'
+         (d:ds') -> d : '.' : ds' ++ "e" ++ show_e'
        Just dec ->
         let dec' = max dec 1 in
         case is of