diff --git a/ghc/lib/std/PrelFloat.lhs b/ghc/lib/std/PrelFloat.lhs index 250da00527eab360b36d671f10c7b8b53fcb1404..34d7e3f89386d824f51fe2ba078470fe1af8ed92 100644 --- a/ghc/lib/std/PrelFloat.lhs +++ b/ghc/lib/std/PrelFloat.lhs @@ -163,10 +163,10 @@ instance Fractional Float where fromRational x = fromRat x recip x = 1.0 / x +{-# RULES "truncate/Float->Int" truncate = float2Int #-} instance RealFrac Float where {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-} - {-# SPECIALIZE truncate :: Float -> Int #-} {-# SPECIALIZE round :: Float -> Int #-} {-# SPECIALIZE ceiling :: Float -> Int #-} {-# SPECIALIZE floor :: Float -> Int #-} @@ -326,10 +326,10 @@ instance Floating Double where acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0))) atanh x = log ((x+1.0) / sqrt (1.0-x*x)) +{-# RULES "truncate/Double->Int" truncate = double2Int #-} instance RealFrac Double where {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-} - {-# SPECIALIZE truncate :: Double -> Int #-} {-# SPECIALIZE round :: Double -> Int #-} {-# SPECIALIZE ceiling :: Double -> Int #-} {-# SPECIALIZE floor :: Double -> Int #-} @@ -827,6 +827,7 @@ int2Double (I# x) = D# (int2Double# x) double2Float :: Double -> Float double2Float (D# x) = F# (double2Float# x) + float2Double :: Float -> Double float2Double (F# x) = D# (float2Double# x) diff --git a/ghc/lib/std/Prelude.lhs b/ghc/lib/std/Prelude.lhs index 58de2745efe00cd2904c7fca17abefc908f4c447..237db71e427d61b55b6a49f6dac1c8ada82d1b2d 100644 --- a/ghc/lib/std/Prelude.lhs +++ b/ghc/lib/std/Prelude.lhs @@ -182,36 +182,34 @@ mapM_ f as = sequence_ (map f as) %********************************************************* \begin{code} -{-# SPECIALIZE fromIntegral :: - Int -> Rational, - Integer -> Rational, - Int -> Int, - Int -> Integer, - Int -> Float, - Int -> Double, - Integer -> Int, - Integer -> Integer, - Integer -> Float, - Integer -> Double #-} +{-# RULES +"fromIntegral/Int->Int" fromIntegral = id :: Int -> Int +"fromIntegral/Integer->Integer" fromIntegral = id :: Integer -> Integer +"fromIntegral/Int->Integer" fromIntegral = int2Integer +"fromIntegral/Integer->Int" fromIntegral = integer2Int +"fromIntegral/Int->Rational" forall n . fromIntegral n = int2Integer n :% 1 +"fromIntegral/Integer->Rational" forall n . fromIntegral n = n :% (1 :: Integer) +"fromIntegral/Int->Float" fromIntegral = int2Float +"fromIntegral/Int->Double" fromIntegral = int2Double +"fromIntegral/Integer->Float" forall n . fromIntegral n = encodeFloat n 0 :: Float +"fromIntegral/Integer->Double" forall n . fromIntegral n = encodeFloat n 0 :: Double + #-} fromIntegral :: (Integral a, Num b) => a -> b fromIntegral = fromInteger . toInteger -{-# SPECIALIZE realToFrac :: - Double -> Rational, - Rational -> Double, - Float -> Rational, - Rational -> Float - #-} -realToFrac :: (Real a, Fractional b) => a -> b -realToFrac = fromRational . toRational - {-# RULES -"realToFrac/Double->Float" realToFrac = doubleToFloat "realToFrac/Float->Double" realToFrac = floatToDouble -"realToFrac/Double->Double" realToFrac = id :: Double -> Double -"realToFrac/Float->Float" realToFrac = id :: Float -> Float -"realToFrac/Rational->Rational" realToFrac = id :: Rational -> Rational +"realToFrac/Double->Float" realToFrac = doubleToFloat +"realToFrac/Float->Float" realToFrac = id :: Float -> Float +"realToFrac/Double->Double" realToFrac = id :: Double -> Double +"realToFrac/Rational->Rational" realToFrac = id :: Rational -> Rational +"realToFrac/Float->Rational" realToFrac = rf2rat :: Float -> Rational +"realToFrac/Double->Rational" realToFrac = rf2rat :: Double -> Rational +"realToFrac/Rational->Float" realToFrac = fromRat :: Rational -> Float +"realToFrac/Rational->Double" realToFrac = fromRat :: Rational -> Double #-} +realToFrac :: (Real a, Fractional b) => a -> b +realToFrac = fromRational . toRational doubleToFloat :: Double -> Float doubleToFloat (D# d) = F# (double2Float# d) @@ -219,5 +217,12 @@ doubleToFloat (D# d) = F# (double2Float# d) floatToDouble :: Float -> Double floatToDouble (F# f) = D# (float2Double# f) +{-# SPECIALIZE rf2rat :: + Float -> Rational, + Double -> Rational + #-} +rf2rat :: RealFloat a => a -> Rational +rf2rat x = if n >= 0 then (m * (b ^ n)) :% 1 else m :% (b ^ (-n)) + where (m,n) = decodeFloat x + b = floatRadix x \end{code} -