X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FNum.lhs;h=5dc5e753d1e99633df774f2ec95789e64d37d2c8;hb=HEAD;hp=c24749ab47220feaf1d74cb8b6ce1ba8a2d35564;hpb=1afd67bb640dda92a639959a270ed1c7a8b976a3;p=ghc-base.git diff --git a/GHC/Num.lhs b/GHC/Num.lhs index c24749a..5dc5e75 100644 --- a/GHC/Num.lhs +++ b/GHC/Num.lhs @@ -1,12 +1,15 @@ \begin{code} -{-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-} +-- 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 #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Num -- Copyright : (c) The University of Glasgow 1994-2002 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) @@ -40,7 +43,7 @@ import GHC.Integer infixl 7 * infixl 6 +, - -default () -- Double isn't available yet, +default () -- Double isn't available yet, -- and we shouldn't be using defaults anyway \end{code} @@ -61,7 +64,7 @@ class (Eq a, Show a) => Num a where -- | Absolute value. abs :: a -> a -- | Sign of a number. - -- The functions 'abs' and 'signum' should satisfy the law: + -- The functions 'abs' and 'signum' should satisfy the law: -- -- > abs x * signum x == x -- @@ -74,6 +77,8 @@ class (Eq a, Show a) => Num a where -- so such literals have type @('Num' a) => a@. fromInteger :: Integer -> a + {-# INLINE (-) #-} + {-# INLINE negate #-} x - y = x + negate y negate x = 0 - x @@ -106,6 +111,7 @@ instance Num Int where | n `eqInt` 0 = 0 | otherwise = 1 + {-# INLINE fromInteger #-} -- Just to be sure! fromInteger i = I# (toInt# i) quotRemInt :: Int -> Int -> (Int, Int) @@ -119,27 +125,6 @@ divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y) %********************************************************* %* * -\subsection{The @Integer@ instances for @Eq@, @Ord@} -%* * -%********************************************************* - -\begin{code} -instance Eq Integer where - (==) = eqInteger - (/=) = neqInteger - ------------------------------------------------------------------------- -instance Ord Integer where - (<=) = leInteger - (>) = gtInteger - (<) = ltInteger - (>=) = geInteger - compare = compareInteger -\end{code} - - -%********************************************************* -%* * \subsection{The @Integer@ instances for @Show@} %* * %********************************************************* @@ -156,9 +141,9 @@ instance Show Integer where -- Divide an conquer implementation of string conversion integerToString :: Integer -> String -> String -integerToString n cs - | n < 0 = '-' : integerToString' (-n) cs - | otherwise = integerToString' n cs +integerToString n0 cs0 + | n0 < 0 = '-' : integerToString' (- n0) cs0 + | otherwise = integerToString' n0 cs0 where integerToString' :: Integer -> String -> String integerToString' n cs @@ -179,11 +164,12 @@ integerToString n cs jsplith p (n:ns) = case n `quotRemInteger` p of (# q, r #) -> - if q > 0 then fromInteger q : fromInteger r : jsplitb p ns - else fromInteger r : jsplitb p ns + if q > 0 then q : r : jsplitb p ns + else r : jsplitb p ns + jsplith _ [] = error "jsplith: []" jsplitb :: Integer -> [Integer] -> [Integer] - jsplitb p [] = [] + jsplitb _ [] = [] jsplitb p (n:ns) = case n `quotRemInteger` p of (# q, r #) -> q : r : jsplitb p ns @@ -199,6 +185,7 @@ integerToString n cs r = fromInteger r' in if q > 0 then jhead q $ jblock r $ jprintb ns cs else jhead r $ jprintb ns cs + jprinth [] _ = error "jprinth []" jprintb :: [Integer] -> String -> String jprintb [] cs = cs @@ -286,35 +273,43 @@ enumDeltaIntegerFB c x d = x `seq` (x `c` enumDeltaIntegerFB c (x+d) d) enumDeltaInteger :: Integer -> Integer -> [Integer] enumDeltaInteger x d = x `seq` (x : enumDeltaInteger (x+d) d) - -- strict accumulator, as for Int - -- so, head (drop 1000000 [1 .. ] works - -- patch by Don Stewart - +-- strict accumulator, so +-- head (drop 1000000 [1 .. ] +-- works + +{-# NOINLINE [0] enumDeltaToIntegerFB #-} +-- Don't inline this until RULE "enumDeltaToInteger" has had a chance to fire +enumDeltaToIntegerFB :: (Integer -> a -> a) -> a + -> Integer -> Integer -> Integer -> a enumDeltaToIntegerFB c n x delta lim | delta >= 0 = up_fb c n x delta lim | otherwise = dn_fb c n x delta lim +enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer] enumDeltaToInteger x delta lim | delta >= 0 = up_list x delta lim | otherwise = dn_list x delta lim -up_fb c n x delta lim = go (x::Integer) +up_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a +up_fb c n x0 delta lim = go (x0 :: Integer) where go x | x > lim = n | otherwise = x `c` go (x+delta) -dn_fb c n x delta lim = go (x::Integer) +dn_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a +dn_fb c n x0 delta lim = go (x0 :: Integer) where go x | x < lim = n | otherwise = x `c` go (x+delta) -up_list x delta lim = go (x::Integer) +up_list :: Integer -> Integer -> Integer -> [Integer] +up_list x0 delta lim = go (x0 :: Integer) where go x | x > lim = [] | otherwise = x : go (x+delta) -dn_list x delta lim = go (x::Integer) +dn_list :: Integer -> Integer -> Integer -> [Integer] +dn_list x0 delta lim = go (x0 :: Integer) where go x | x < lim = [] | otherwise = x : go (x+delta) - \end{code}