Commit c75dc9b3 authored by panne's avatar panne
Browse files

[project @ 2000-05-10 15:16:11 by panne]

More RULES for coercions and truncate.
parent c516bab3
......@@ -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)
......
......@@ -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}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment