import PrelMaybe
import PrelArr ( Array, array, (!) )
-import PrelUnsafe ( unsafePerformIO )
+import PrelIOBase ( unsafePerformIO )
import Ix ( Ix(..) )
import PrelCCall () -- we need the definitions of CCallable and
-- CReturnable for the _ccall_s herein.
even n = n `rem` 2 == 0
odd = not . even
-{-# GENERATE_SPECS gcd a{Int#,Int,Integer} #-}
+{-# SPECIALISE gcd ::
+ Int -> Int -> Int,
+ Integer -> Integer -> Integer #-}
gcd :: (Integral a) => a -> a -> a
gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined"
gcd x y = gcd' (abs x) (abs y)
where gcd' x 0 = x
gcd' x y = gcd' y (x `rem` y)
-{-# GENERATE_SPECS lcm a{Int#,Int,Integer} #-}
+{-# SPECIALISE lcm ::
+ Int -> Int -> Int,
+ Integer -> Integer -> Integer #-}
lcm :: (Integral a) => a -> a -> a
lcm _ 0 = 0
lcm 0 _ = 0
lcm x y = abs ((x `quot` (gcd x y)) * y)
+{-# SPECIALISE (^) ::
+ Integer -> Integer -> Integer,
+ Integer -> Int -> Integer,
+ Int -> Int -> Int #-}
(^) :: (Num a, Integral b) => a -> b -> a
x ^ 0 = 1
x ^ n | n > 0 = f x (n-1) x
| otherwise = f x (n-1) (x*y)
_ ^ _ = error "Prelude.^: negative exponent"
+{-# SPECIALISE (^^) ::
+ Double -> Int -> Double,
+ Rational -> Int -> Rational #-}
(^^) :: (Fractional a, Integral b) => a -> b -> a
x ^^ n = if n >= 0 then x^n else recip (x^(negate n))
+{-# SPECIALIZE fromIntegral ::
+ Int -> Rational,
+ Integer -> Rational,
+ Int -> Int,
+ Int -> Integer,
+ Int -> Float,
+ Int -> Double,
+ Integer -> Int,
+ Integer -> Integer,
+ Integer -> Float,
+ Integer -> Double #-}
fromIntegral :: (Integral a, Num b) => a -> b
fromIntegral = fromInteger . toInteger
+{-# SPECIALIZE fromRealFrac ::
+ Double -> Rational,
+ Rational -> Double,
+ Float -> Rational,
+ Rational -> Float,
+ Rational -> Rational,
+ Double -> Double,
+ Double -> Float,
+ Float -> Float,
+ Float -> Double #-}
fromRealFrac :: (RealFrac a, Fractional b) => a -> b
fromRealFrac = fromRational . toRational
then a `remInt` b
else error "Integral.Int.rem{PreludeCore}: divide by 0\n"
- x `div` y = if x > 0 && y < 0 then quotInt (x-y-1) y
- else if x < 0 && y > 0 then quotInt (x-y+1) y
- else quotInt x y
+ n `div` d
+ | n > 0 && d < 0 = mk_neg (quotInt (n-d-1) d)
+ | n < 0 && d > 0 = mk_neg (quotInt (n-d+1) d)
+ | otherwise = quotInt n d
+ where
+ {-
+ - the result of (integral) division is
+ defined as being truncated towards
+ negative infinity. (see Sec 6.3.2 of
+ the Haskell 1.4 report.)
+
+ - in the case of Int, if either nominator or
+ denominator is negative, we adjust the nominator
+ to account for the above property before
+ computing the quotient.
+
+ - in the case of Int, the adjustment of the
+ nominator runs the risk of overflowing. If
+ we make the assumption that arithmetic is
+ modulo word size, and adjust the final result
+ to account for this.
+ -}
+
+ mk_neg r
+ | r <= 0 = r
+ | otherwise = -(r+1)
+
x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
if r/=0 then r+y else 0
else
\end{code}
\begin{code}
+{-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
+
(%) :: (Integral a) => a -> a -> Ratio a
numerator, denominator :: (Integral a) => Ratio a -> a
approxRational :: (RealFrac a) => a -> a -> Rational
toEnum n = fromIntegral n :% 1
fromEnum = fromInteger . truncate
-ratio_prec :: Int
-ratio_prec = 7
-
instance (Integral a) => Show (Ratio a) where
showsPrec p (x:%y) = showParen (p > ratio_prec)
(shows x . showString " % " . shows y)
+
+-- defn. also used by the Read (Ratio a) instance PrelRead.
+ratio_prec :: Int
+ratio_prec = 7
+
\end{code}
\begin{code}
--Exported from std library Numeric, defined here to
--avoid mut. rec. between PrelNum and Numeric.
showSigned :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS
-showSigned showPos p x = if x < 0 then showParen (p > 6)
- (showChar '-' . showPos (-x))
- else showPos x
+showSigned showPos p x
+ | x < 0 = showParen (p > 6) (showChar '-' . showPos (-x))
+ | otherwise = showPos x
showSignedInteger :: Int -> Integer -> ShowS
showSignedInteger p n r
if n < 0 && p > 6 then '(':jtos n++(')':r) else jtos n ++ r
jtos :: Integer -> String
-jtos n
- = if n < 0 then
- '-' : jtos' (-n) []
- else
- jtos' n []
+jtos n
+ | n < 0 = '-' : jtos' (-n) []
+ | otherwise = jtos' n []
jtos' :: Integer -> String -> String
jtos' n cs
- = if n < 10 then
- chr (fromInteger (n + ord_0)) : cs
- else
- jtos' q (chr (toInt r + (ord_0::Int)) : cs)
+ | n < 10 = chr (fromInteger (n + ord_0)) : cs
+ | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
where
(q,r) = n `quotRem` 10
formatRealFloat fmt decs x = s
where
base = 10
- s = if isNaN x
- then "NaN"
- else
- if isInfinite x then
- if x < 0 then "-Infinity" else "Infinity"
- else
- if x < 0 || isNegativeZero x then
- '-':doFmt fmt (floatToDigits (toInteger base) (-x))
- else
- doFmt fmt (floatToDigits (toInteger base) x)
+ base_i = toInteger base
+
+ s
+ | isNaN x = "NaN"
+ | isInfinite x = (\ str -> if x < 0 then '-':str else str) "Infinity"
+ | x < 0 || isNegativeZero x = '-' : doFmt fmt (floatToDigits base_i (-x))
+ | otherwise = doFmt fmt (floatToDigits base_i x)
doFmt fmt (is, e) =
let ds = map intToDigit is in
-- Haskell promises that p-1 <= logBase b f < p.
(p - 1 + e0) * 3 `div` 10
else
- ceiling ((log (fromInteger (f+1)) +
- fromInt e * log (fromInteger b)) /
- fromInt e * log (fromInteger b))
+ ceiling ((log (fromInteger (f+1)) + fromInt e * log (fromInteger b)) /
+ log (fromInteger base))
fixup n =
if n >= 0 then
Now, here's Lennart's code.
\begin{code}
+{-# SPECIALISE fromRat ::
+ Rational -> Double,
+ Rational -> Float #-}
+
--fromRat :: (RealFloat a) => Rational -> a
-fromRat x =
- if x == 0 then encodeFloat 0 0 -- Handle exceptional cases
- else if x < 0 then - fromRat' (-x) -- first.
- else fromRat' x
+fromRat x
+ | x == 0 = encodeFloat 0 0 -- Handle exceptional cases
+ | x < 0 = - fromRat' (-x) -- first.
+ | otherwise = fromRat' x
-- Conversion process:
-- Scale the rational number by the RealFloat base until
fromRat' x = r
where b = floatRadix r
p = floatDigits r
+
(minExp0, _) = floatRange r
+
minExp = minExp0 - p -- the real minimum exponent
+
xMin = toRational (expt b (p-1))
xMax = toRational (expt b p)
+
p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp
f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1
(x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f)
+
r = encodeFloat (round x') p'
-- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp.
scaleRat :: Rational -> Int -> Rational -> Rational -> Int -> Rational -> (Rational, Int)
-scaleRat b minExp xMin xMax p x =
- if p <= minExp then
- (x, p)
- else if x >= xMax then
- scaleRat b minExp xMin xMax (p+1) (x/b)
- else if x < xMin then
- scaleRat b minExp xMin xMax (p-1) (x*b)
- else
- (x, p)
+scaleRat b minExp xMin xMax p x
+ | p <= minExp = (x, p)
+ | x >= xMax = scaleRat b minExp xMin xMax (p+1) (x/b)
+ | x < xMin = scaleRat b minExp xMin xMax (p-1) (x*b)
+ | otherwise = (x, p)
-- Exponentiation with a cache for the most common numbers.
minExpt = 0::Int
maxExpt = 1100::Int
+
expt :: Integer -> Int -> Integer
-expt base n =
- if base == 2 && n >= minExpt && n <= maxExpt then
- expts!n
- else
- base^n
+expt base n
+ | base == 2 && n >= minExpt && n <= maxExpt = expts!n
+ | otherwise = base^n
+
expts :: Array Int Integer
expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
-- Simplest way would be just divide i by b until it's smaller then b, but that would
-- be very slow! We are just slightly more clever.
integerLogBase :: Integer -> Integer -> Int
-integerLogBase b i =
- if i < b then
- 0
- else
+integerLogBase b i
+ | i < b = 0
+ | otherwise = doDiv (i `div` (b^l)) l
+ where
-- Try squaring the base first to cut down the number of divisions.
- let l = 2 * integerLogBase (b*b) i
- doDiv :: Integer -> Int -> Int
- doDiv i l = if i < b then l else doDiv (i `div` b) (l+1)
- in doDiv (i `div` (b^l)) l
+ l = 2 * integerLogBase (b*b) i
+
+ doDiv :: Integer -> Int -> Int
+ doDiv i l = if i < b then l else doDiv (i `div` b) (l+1)
+
\end{code}
%*********************************************************
projects / ghc-hetmet.git / blobdiff