#include "MachDeps.h"
#if SIZEOF_HSWORD == 4
-#define LEFTMOST_BIT 2147483648
#define DIGITS 9
#define BASE 1000000000
#elif SIZEOF_HSWORD == 8
-#define LEFTMOST_BIT 9223372036854775808
#define DIGITS 18
#define BASE 1000000000000000000
#else
-#error Please define LEFTMOST_BIT to be 2^(SIZEOF_HSWORD*8-1)
--- DIGITS should be the largest integer such that 10^DIGITS < LEFTMOST_BIT
+#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 where
+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 +, -
| n `eqInt` 0 = 0
| otherwise = 1
- fromInteger = integer2Int
+ fromInteger i = I# (toInt# i)
quotRemInt :: Int -> Int -> (Int, Int)
quotRemInt a@(I# _) b@(I# _) = (a `quotInt` b, a `remInt` b)
%*********************************************************
%* *
-\subsection{The @Integer@ type}
+\subsection{The @Integer@ instances for @Eq@, @Ord@}
%* *
%*********************************************************
\begin{code}
--- | Arbitrary-precision integers.
-data Integer
- = S# Int# -- small integers
-#ifndef ILX
- | J# Int# ByteArray# -- large integers
-#else
- | J# Void BigInteger -- .NET big ints
-
-foreign type dotnet "BigInteger" BigInteger
-#endif
-\end{code}
-
-Convenient boxed Integer PrimOps.
-
-\begin{code}
-zeroInteger :: Integer
-zeroInteger = S# 0#
-
-int2Integer :: Int -> Integer
-{-# INLINE int2Integer #-}
-int2Integer (I# i) = S# i
-
-integer2Int :: Integer -> Int
-integer2Int (S# i) = I# i
-integer2Int (J# s d) = case (integer2Int# s d) of { n# -> I# n# }
+instance Eq Integer where
+ (==) = eqInteger
+ (/=) = neqInteger
-toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d }
-toBig i@(J# _ _) = i
+------------------------------------------------------------------------
+instance Ord Integer where
+ (<=) = leInteger
+ (>) = gtInteger
+ (<) = ltInteger
+ (>=) = geInteger
+
+ i `compare` j = case i `compareInteger` j of
+ -1# -> LT
+ 0# -> EQ
+ 1# -> GT
+ _ -> error "compareInteger: Bad result"
\end{code}
%*********************************************************
%* *
-\subsection{Dividing @Integers@}
+\subsection{The @Integer@ instances for @Show@}
%* *
%*********************************************************
\begin{code}
-quotRemInteger :: Integer -> Integer -> (Integer, Integer)
-quotRemInteger a@(S# (-LEFTMOST_BIT#)) b = quotRemInteger (toBig a) b
-quotRemInteger (S# i) (S# j)
- = case quotRemInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j )
-quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2)
-quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2
-quotRemInteger (J# s1 d1) (J# s2 d2)
- = case (quotRemInteger# s1 d1 s2 d2) of
- (# s3, d3, s4, d4 #)
- -> (J# s3 d3, J# s4 d4)
-
-divModInteger a@(S# (-LEFTMOST_BIT#)) b = divModInteger (toBig a) b
-divModInteger (S# i) (S# j)
- = case divModInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
-divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2)
-divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2
-divModInteger (J# s1 d1) (J# s2 d2)
- = case (divModInteger# s1 d1 s2 d2) of
- (# s3, d3, s4, d4 #)
- -> (J# s3 d3, J# s4 d4)
-
-remInteger :: Integer -> Integer -> Integer
-remInteger ia ib
- | ib == 0 = error "Prelude.Integral.rem{Integer}: divide by 0"
-remInteger a@(S# (-LEFTMOST_BIT#)) b = remInteger (toBig a) b
-remInteger (S# a) (S# b) = S# (remInt# a b)
-{- Special case doesn't work, because a 1-element J# has the range
- -(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1)
-remInteger ia@(S# a) (J# sb b)
- | sb ==# 1# = S# (remInt# a (word2Int# (integer2Word# sb b)))
- | sb ==# -1# = S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
- | 0# <# sb = ia
- | otherwise = S# (0# -# a)
--}
-remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib
-remInteger (J# sa a) (S# b)
- = case int2Integer# b of { (# sb, b #) ->
- case remInteger# sa a sb b of { (# sr, r #) ->
- S# (integer2Int# sr r) }}
-remInteger (J# sa a) (J# sb b)
- = case remInteger# sa a sb b of (# sr, r #) -> J# sr r
-
-quotInteger :: Integer -> Integer -> Integer
-quotInteger ia ib
- | ib == 0 = error "Prelude.Integral.quot{Integer}: divide by 0"
-quotInteger a@(S# (-LEFTMOST_BIT#)) b = quotInteger (toBig a) b
-quotInteger (S# a) (S# b) = S# (quotInt# a b)
-{- Special case disabled, see remInteger above
-quotInteger (S# a) (J# sb b)
- | sb ==# 1# = S# (quotInt# a (word2Int# (integer2Word# sb b)))
- | sb ==# -1# = S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
- | otherwise = zeroInteger
--}
-quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib
-quotInteger (J# sa a) (S# b)
- = case int2Integer# b of { (# sb, b #) ->
- case quotInteger# sa a sb b of (# sq, q #) -> J# sq q }
-quotInteger (J# sa a) (J# sb b)
- = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g
-\end{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)
-\begin{code}
-gcdInteger :: Integer -> Integer -> Integer
--- SUP: Do we really need the first two cases?
-gcdInteger a@(S# (-LEFTMOST_BIT#)) b = gcdInteger (toBig a) b
-gcdInteger a b@(S# (-LEFTMOST_BIT#)) = gcdInteger a (toBig b)
-gcdInteger (S# a) (S# b) = case gcdInt (I# a) (I# b) of { I# c -> S# c }
-gcdInteger ia@(S# 0#) ib@(J# 0# _) = error "GHC.Num.gcdInteger: gcd 0 0 is undefined"
-gcdInteger ia@(S# a) ib@(J# sb b)
- | a ==# 0# = abs ib
- | sb ==# 0# = abs ia
- | otherwise = S# (gcdIntegerInt# absSb b absA)
- where absA = if a <# 0# then negateInt# a else a
- absSb = if sb <# 0# then negateInt# sb else sb
-gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia
-gcdInteger (J# 0# _) (J# 0# _) = error "GHC.Num.gcdInteger: gcd 0 0 is undefined"
-gcdInteger (J# sa a) (J# sb b)
- = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g
-
-lcmInteger :: Integer -> Integer -> Integer
-lcmInteger a 0
- = zeroInteger
-lcmInteger 0 b
- = zeroInteger
-lcmInteger a b
- = (divExact aa (gcdInteger aa ab)) * ab
- where aa = abs a
- ab = abs b
-
-divExact :: Integer -> Integer -> Integer
-divExact a@(S# (-LEFTMOST_BIT#)) b = divExact (toBig a) b
-divExact (S# a) (S# b) = S# (quotInt# a b)
-divExact (S# a) (J# sb b)
- = S# (quotInt# a (integer2Int# sb b))
-divExact (J# sa a) (S# b)
- = case int2Integer# b of
- (# sb, b #) -> case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
-divExact (J# sa a) (J# sb b)
- = case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
-\end{code}
+ 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
-%*********************************************************
-%* *
-\subsection{The @Integer@ instances for @Eq@, @Ord@}
-%* *
-%*********************************************************
+ -- 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
-\begin{code}
-instance Eq Integer where
- (S# i) == (S# j) = i ==# j
- (S# i) == (J# s d) = cmpIntegerInt# s d i ==# 0#
- (J# s d) == (S# i) = cmpIntegerInt# s d i ==# 0#
- (J# s1 d1) == (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#
+ 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
- (S# i) /= (S# j) = i /=# j
- (S# i) /= (J# s d) = cmpIntegerInt# s d i /=# 0#
- (J# s d) /= (S# i) = cmpIntegerInt# s d i /=# 0#
- (J# s1 d1) /= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
+ -- 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
-------------------------------------------------------------------------
-instance Ord Integer where
- (S# i) <= (S# j) = i <=# j
- (J# s d) <= (S# i) = cmpIntegerInt# s d i <=# 0#
- (S# i) <= (J# s d) = cmpIntegerInt# s d i >=# 0#
- (J# s1 d1) <= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
-
- (S# i) > (S# j) = i ># j
- (J# s d) > (S# i) = cmpIntegerInt# s d i ># 0#
- (S# i) > (J# s d) = cmpIntegerInt# s d i <# 0#
- (J# s1 d1) > (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
-
- (S# i) < (S# j) = i <# j
- (J# s d) < (S# i) = cmpIntegerInt# s d i <# 0#
- (S# i) < (J# s d) = cmpIntegerInt# s d i ># 0#
- (J# s1 d1) < (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
-
- (S# i) >= (S# j) = i >=# j
- (J# s d) >= (S# i) = cmpIntegerInt# s d i >=# 0#
- (S# i) >= (J# s d) = cmpIntegerInt# s d i <=# 0#
- (J# s1 d1) >= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
-
- compare (S# i) (S# j)
- | i ==# j = EQ
- | i <=# j = LT
- | otherwise = GT
- compare (J# s d) (S# i)
- = case cmpIntegerInt# s d i of { res# ->
- if res# <# 0# then LT else
- if res# ># 0# then GT else EQ
- }
- compare (S# i) (J# s d)
- = case cmpIntegerInt# s d i of { res# ->
- if res# ># 0# then LT else
- if res# <# 0# then GT else EQ
- }
- compare (J# s1 d1) (J# s2 d2)
- = case cmpInteger# s1 d1 s2 d2 of { res# ->
- if res# <# 0# then LT else
- if res# ># 0# then GT else EQ
- }
+ 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
\end{code}
negate = negateInteger
fromInteger x = x
- -- ORIG: abs n = if n >= 0 then n else -n
- abs (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT
- abs (S# i) = case abs (I# i) of I# j -> S# j
- abs n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d
-
- signum (S# i) = case signum (I# i) of I# j -> S# j
- signum (J# s d)
- = let
- cmp = cmpIntegerInt# s d 0#
- in
- if cmp ># 0# then S# 1#
- else if cmp ==# 0# then S# 0#
- else S# (negateInt# 1#)
-
-plusInteger i1@(S# i) i2@(S# j) = case addIntC# i j of { (# r, c #) ->
- if c ==# 0# then S# r
- else toBig i1 + toBig i2 }
-plusInteger i1@(J# _ _) i2@(S# _) = i1 + toBig i2
-plusInteger i1@(S# _) i2@(J# _ _) = toBig i1 + i2
-plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
-
-minusInteger i1@(S# i) i2@(S# j) = case subIntC# i j of { (# r, c #) ->
- if c ==# 0# then S# r
- else toBig i1 - toBig i2 }
-minusInteger i1@(J# _ _) i2@(S# _) = i1 - toBig i2
-minusInteger i1@(S# _) i2@(J# _ _) = toBig i1 - i2
-minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
-
-timesInteger i1@(S# i) i2@(S# j) = if mulIntMayOflo# i j ==# 0#
- then S# (i *# j)
- else toBig i1 * toBig i2
-timesInteger i1@(J# _ _) i2@(S# _) = i1 * toBig i2
-timesInteger i1@(S# _) i2@(J# _ _) = toBig i1 * i2
-timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
-
-negateInteger (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT
-negateInteger (S# i) = S# (negateInt# i)
-negateInteger (J# s d) = J# (negateInt# s) d
+ abs = absInteger
+ signum = signumInteger
\end{code}
instance Enum Integer where
succ x = x + 1
pred x = x - 1
- toEnum n = int2Integer n
- fromEnum n = integer2Int n
+ toEnum (I# n) = smallInteger n
+ fromEnum n = I# (toInt# n)
{-# INLINE enumFrom #-}
{-# INLINE enumFromThen #-}
\end{code}
-
-%*********************************************************
-%* *
-\subsection{The @Integer@ instances for @Show@}
-%* *
-%*********************************************************
-
-\begin{code}
-instance Show Integer where
- showsPrec p n r
- | p > 6 && n < 0 = '(' : jtos n (')' : r)
- -- Minor point: testing p first gives better code
- -- in the not-uncommon case where the p argument
- -- is a constant
- | otherwise = jtos n r
- showList = showList__ (showsPrec 0)
-
--- Divide an conquer implementation of string conversion
-jtos :: Integer -> String -> String
-jtos n cs
- | n < 0 = '-' : jtos' (-n) cs
- | otherwise = jtos' n cs
- where
- jtos' :: Integer -> String -> String
- jtos' 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) =
- if q > 0 then fromInteger q : fromInteger r : jsplitb p ns
- else fromInteger r : jsplitb p ns
- where
- (q, r) = n `quotRemInteger` p
-
- jsplitb :: Integer -> [Integer] -> [Integer]
- jsplitb p [] = []
- jsplitb p (n:ns) = q : r : jsplitb p ns
- where
- (q, r) = n `quotRemInteger` p
-
- -- 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 =
- if q > 0 then jhead q $ jblock r $ jprintb ns cs
- else jhead r $ jprintb ns cs
- where
- (q', r') = n `quotRemInteger` BASE
- q = fromInteger q'
- r = fromInteger r'
-
- jprintb :: [Integer] -> String -> String
- jprintb [] cs = cs
- jprintb (n:ns) cs = jblock q $ jblock r $ jprintb ns cs
- where
- (q', r') = n `quotRemInteger` BASE
- q = fromInteger q'
- r = fromInteger r'
-
- -- 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
-
-\end{code}
projects / ghc-base.git / commitdiff