Implement foldl with foldr
[packages/base.git] / GHC / Num.lhs
index c24749a..5cdf782 100644 (file)
@@ -1,12 +1,13 @@
 \begin{code}
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
 {-# 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)
 --
 -----------------------------------------------------------------------------
 
-#include "MachDeps.h"
-#if SIZEOF_HSWORD == 4
-#define DIGITS       9
-#define BASE         1000000000
-#elif SIZEOF_HSWORD == 8
-#define DIGITS       18
-#define BASE         1000000000000000000
-#else
-#error Please define DIGITS and BASE
--- DIGITS should be the largest integer such that
---     10^DIGITS < 2^(SIZEOF_HSWORD * 8 - 1)
--- BASE should be 10^DIGITS. Note that ^ is not available yet.
-#endif
-
--- #hide
 module GHC.Num (module GHC.Num, module GHC.Integer) where
 
 import GHC.Base
-import GHC.Enum
-import GHC.Show
 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}
 
@@ -54,14 +38,14 @@ default ()              -- Double isn't available yet,
 -- | Basic numeric class.
 --
 -- Minimal complete definition: all except 'negate' or @(-)@
-class  (Eq a, Show a) => Num a  where
+class  Num a  where
     (+), (-), (*)       :: a -> a -> a
     -- | Unary negation.
     negate              :: a -> a
     -- | 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,8 +58,11 @@ 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
+    {-# MINIMAL (+), (*), abs, signum, fromInteger, (negate | (-)) #-}
 
 -- | the same as @'flip' ('-')@.
 --
@@ -96,143 +83,38 @@ subtract x y = y - x
 
 \begin{code}
 instance  Num Int  where
-    (+)    = plusInt
-    (-)    = minusInt
-    negate = negateInt
-    (*)    = timesInt
-    abs n  = if n `geInt` 0 then n else negateInt n
+    I# x + I# y = I# (x +# y)
+    I# x - I# y = I# (x -# y)
+    negate (I# x) = I# (negateInt# x)
+    I# x * I# y = I# (x *# y)
+    abs n  = if n `geInt` 0 then n else negate n
 
-    signum n | n `ltInt` 0 = negateInt 1
+    signum n | n `ltInt` 0 = negate 1
              | n `eqInt` 0 = 0
              | otherwise   = 1
 
-    fromInteger i = I# (toInt# i)
-
-quotRemInt :: Int -> Int -> (Int, Int)
-quotRemInt a@(I# _) b@(I# _) = (a `quotInt` b, a `remInt` b)
-    -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)
-
-divModInt ::  Int -> Int -> (Int, Int)
-divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y)
-    -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
+    {-# INLINE fromInteger #-}  -- Just to be sure!
+    fromInteger i = I# (integerToInt i)
 \end{code}
 
 %*********************************************************
 %*                                                      *
-\subsection{The @Integer@ instances for @Eq@, @Ord@}
+\subsection{Instances for @Word@}
 %*                                                      *
 %*********************************************************
 
 \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@}
-%*                                                      *
-%*********************************************************
-
-\begin{code}
-instance Show Integer where
-    showsPrec p n r
-        | p > 6 && n < 0 = '(' : integerToString n (')' : r)
-        -- Minor point: testing p first gives better code
-        -- in the not-uncommon case where the p argument
-        -- is a constant
-        | otherwise = integerToString n r
-    showList = showList__ (showsPrec 0)
-
--- Divide an conquer implementation of string conversion
-integerToString :: Integer -> String -> String
-integerToString n cs
-    | n < 0     = '-' : integerToString' (-n) cs
-    | otherwise = integerToString' n cs
-    where
-    integerToString' :: Integer -> String -> String
-    integerToString' n cs
-        | n < BASE  = jhead (fromInteger n) cs
-        | otherwise = jprinth (jsplitf (BASE*BASE) n) cs
-
-    -- Split n into digits in base p. We first split n into digits
-    -- in base p*p and then split each of these digits into two.
-    -- Note that the first 'digit' modulo p*p may have a leading zero
-    -- in base p that we need to drop - this is what jsplith takes care of.
-    -- jsplitb the handles the remaining digits.
-    jsplitf :: Integer -> Integer -> [Integer]
-    jsplitf p n
-        | p > n     = [n]
-        | otherwise = jsplith p (jsplitf (p*p) n)
-
-    jsplith :: Integer -> [Integer] -> [Integer]
-    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
-
-    jsplitb :: Integer -> [Integer] -> [Integer]
-    jsplitb p []     = []
-    jsplitb p (n:ns) = case n `quotRemInteger` p of
-                       (# q, r #) ->
-                           q : r : jsplitb p ns
-
-    -- Convert a number that has been split into digits in base BASE^2
-    -- this includes a last splitting step and then conversion of digits
-    -- that all fit into a machine word.
-    jprinth :: [Integer] -> String -> String
-    jprinth (n:ns) cs =
-        case n `quotRemInteger` BASE of
-        (# q', r' #) ->
-            let q = fromInteger q'
-                r = fromInteger r'
-            in if q > 0 then jhead q $ jblock r $ jprintb ns cs
-                        else jhead r $ jprintb ns cs
-
-    jprintb :: [Integer] -> String -> String
-    jprintb []     cs = cs
-    jprintb (n:ns) cs = case n `quotRemInteger` BASE of
-                        (# q', r' #) ->
-                            let q = fromInteger q'
-                                r = fromInteger r'
-                            in jblock q $ jblock r $ jprintb ns cs
-
-    -- Convert an integer that fits into a machine word. Again, we have two
-    -- functions, one that drops leading zeros (jhead) and one that doesn't
-    -- (jblock)
-    jhead :: Int -> String -> String
-    jhead n cs
-        | n < 10    = case unsafeChr (ord '0' + n) of
-            c@(C# _) -> c : cs
-        | otherwise = case unsafeChr (ord '0' + r) of
-            c@(C# _) -> jhead q (c : cs)
-        where
-        (q, r) = n `quotRemInt` 10
-
-    jblock = jblock' {- ' -} DIGITS
-
-    jblock' :: Int -> Int -> String -> String
-    jblock' d n cs
-        | d == 1    = case unsafeChr (ord '0' + n) of
-             c@(C# _) -> c : cs
-        | otherwise = case unsafeChr (ord '0' + r) of
-             c@(C# _) -> jblock' (d - 1) q (c : cs)
-        where
-        (q, r) = n `quotRemInt` 10
+instance Num Word where
+    (W# x#) + (W# y#)      = W# (x# `plusWord#` y#)
+    (W# x#) - (W# y#)      = W# (x# `minusWord#` y#)
+    (W# x#) * (W# y#)      = W# (x# `timesWord#` y#)
+    negate (W# x#)         = W# (int2Word# (negateInt# (word2Int# x#)))
+    abs x                  = x
+    signum 0               = 0
+    signum _               = 1
+    fromInteger i          = W# (integerToWord i)
 \end{code}
 
-
 %*********************************************************
 %*                                                      *
 \subsection{The @Integer@ instances for @Num@}
@@ -251,70 +133,3 @@ instance  Num Integer  where
     signum = signumInteger
 \end{code}
 
-
-%*********************************************************
-%*                                                      *
-\subsection{The @Integer@ instance for @Enum@}
-%*                                                      *
-%*********************************************************
-
-\begin{code}
-instance  Enum Integer  where
-    succ x               = x + 1
-    pred x               = x - 1
-    toEnum (I# n)        = smallInteger n
-    fromEnum n           = I# (toInt# n)
-
-    {-# INLINE enumFrom #-}
-    {-# INLINE enumFromThen #-}
-    {-# INLINE enumFromTo #-}
-    {-# INLINE enumFromThenTo #-}
-    enumFrom x             = enumDeltaInteger  x 1
-    enumFromThen x y       = enumDeltaInteger  x (y-x)
-    enumFromTo x lim       = enumDeltaToInteger x 1     lim
-    enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim
-
-{-# RULES
-"enumDeltaInteger"      [~1] forall x y.  enumDeltaInteger x y     = build (\c _ -> enumDeltaIntegerFB c x y)
-"efdtInteger"           [~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l)
-"enumDeltaInteger"      [1] enumDeltaIntegerFB   (:)    = enumDeltaInteger
-"enumDeltaToInteger"    [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger
- #-}
-
-enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
-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 <dons@galois.com>                       
-
-enumDeltaToIntegerFB c n x delta lim
-  | delta >= 0 = up_fb c n x delta lim
-  | otherwise  = dn_fb c n x delta lim
-
-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)
-                      where
-                        go x | x > lim   = n
-                             | otherwise = x `c` go (x+delta)
-dn_fb c n x delta lim = go (x::Integer)
-                      where
-                        go x | x < lim   = n
-                             | otherwise = x `c` go (x+delta)
-
-up_list x delta lim = go (x::Integer)
-                    where
-                        go x | x > lim   = []
-                             | otherwise = x : go (x+delta)
-dn_list x delta lim = go (x::Integer)
-                    where
-                        go x | x < lim   = []
-                             | otherwise = x : go (x+delta)
-
-\end{code}
-