module GHC.Num.Integer where
#include "MachDeps.h"
#include "WordSize.h"
import GHC.Prim
import GHC.Types
import GHC.Classes
import GHC.Magic
import GHC.Num.Primitives
import GHC.Num.BigNat
import GHC.Num.Natural
import qualified GHC.Num.Backend as Backend
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
#endif
default ()
data Integer
= IS !Int#
| IP !BigNat#
| IN !BigNat#
integerCheck# :: Integer -> Bool#
integerCheck# (IS _) = 1#
integerCheck# (IP bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` INT_MAXBOUND##)
integerCheck# (IN bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` ABS_INT_MINBOUND##)
integerCheck :: Integer -> Bool
integerCheck i = isTrue# (integerCheck# i)
integerZero :: Integer
integerZero = IS 0#
integerOne :: Integer
integerOne = IS 1#
integerFromBigNat# :: BigNat# -> Integer
integerFromBigNat# !bn
| bigNatIsZero bn
= integerZero
| isTrue# (bn `bigNatLeWord#` INT_MAXBOUND##)
= IS (word2Int# (bigNatIndex# bn 0#))
| True
= IP bn
integerFromBigNatNeg# :: BigNat# -> Integer
integerFromBigNatNeg# !bn
| bigNatIsZero bn
= integerZero
| 1# <- bigNatSize# bn
, i <- negateInt# (word2Int# (bigNatIndex# bn 0#))
, isTrue# (i <=# 0#)
= IS i
| True
= IN bn
integerFromBigNatSign# :: Int# -> BigNat# -> Integer
integerFromBigNatSign# !sign !bn
| 0# <- sign
= integerFromBigNat# bn
| True
= integerFromBigNatNeg# bn
integerToBigNatSign# :: Integer -> (# Int#, BigNat# #)
integerToBigNatSign# = \case
IS x
| isTrue# (x >=# 0#)
-> (# 0#, bigNatFromWord# (int2Word# x) #)
| True
-> (# 1#, bigNatFromWord# (int2Word# (negateInt# x)) #)
IP x -> (# 0#, x #)
IN x -> (# 1#, x #)
integerToBigNatClamp# :: Integer -> BigNat#
integerToBigNatClamp# (IP x) = x
integerToBigNatClamp# (IS x)
| isTrue# (x >=# 0#) = bigNatFromWord# (int2Word# x)
integerToBigNatClamp# _ = bigNatZero# (# #)
integerFromInt# :: Int# -> Integer
integerFromInt# i = IS i
integerFromInt :: Int -> Integer
integerFromInt (I# i) = IS i
integerToInt# :: Integer -> Int#
integerToInt# (IS i) = i
integerToInt# (IP b) = word2Int# (bigNatToWord# b)
integerToInt# (IN b) = negateInt# (word2Int# (bigNatToWord# b))
integerToInt :: Integer -> Int
integerToInt i = I# (integerToInt# i)
integerFromWord# :: Word# -> Integer
integerFromWord# w
| i <- word2Int# w
, isTrue# (i >=# 0#)
= IS i
| True
= IP (bigNatFromWord# w)
integerFromWord :: Word -> Integer
integerFromWord (W# w) = integerFromWord# w
integerFromWordNeg# :: Word# -> Integer
integerFromWordNeg# w
| isTrue# (w `leWord#` ABS_INT_MINBOUND##)
= IS (negateInt# (word2Int# w))
| True
= IN (bigNatFromWord# w)
integerFromWordSign# :: Int# -> Word# -> Integer
integerFromWordSign# 0# w = integerFromWord# w
integerFromWordSign# _ w = integerFromWordNeg# w
integerToWord# :: Integer -> Word#
integerToWord# (IS i) = int2Word# i
integerToWord# (IP bn) = bigNatToWord# bn
integerToWord# (IN bn) = int2Word# (negateInt# (word2Int# (bigNatToWord# bn)))
integerToWord :: Integer -> Word
integerToWord !i = W# (integerToWord# i)
integerFromNatural :: Natural -> Integer
integerFromNatural (NS x) = integerFromWord# x
integerFromNatural (NB x) = integerFromBigNat# x
integerFromWordList :: Bool -> [Word] -> Integer
integerFromWordList True ws = integerFromBigNatNeg# (bigNatFromWordList ws)
integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws)
integerToNaturalClamp :: Integer -> Natural
integerToNaturalClamp (IS x)
| isTrue# (x <# 0#) = naturalZero
| True = naturalFromWord# (int2Word# x)
integerToNaturalClamp (IP x) = naturalFromBigNat# x
integerToNaturalClamp (IN _) = naturalZero
integerToNatural :: Integer -> Natural
integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x)
integerToNatural (IP x) = naturalFromBigNat# x
integerToNatural (IN x) = naturalFromBigNat# x
integerToNaturalThrow :: Integer -> Natural
integerToNaturalThrow (IS x)
| isTrue# (x <# 0#) = raiseUnderflow
| True = naturalFromWord# (int2Word# x)
integerToNaturalThrow (IP x) = naturalFromBigNat# x
integerToNaturalThrow (IN _) = raiseUnderflow
integerIsNegative# :: Integer -> Bool#
integerIsNegative# (IS i#) = i# <# 0#
integerIsNegative# (IP _) = 0#
integerIsNegative# (IN _) = 1#
integerIsNegative :: Integer -> Bool
integerIsNegative !i = isTrue# (integerIsNegative# i)
integerIsZero :: Integer -> Bool
integerIsZero (IS 0#) = True
integerIsZero _ = False
integerIsOne :: Integer -> Bool
integerIsOne (IS 1#) = True
integerIsOne _ = False
integerNe :: Integer -> Integer -> Bool
integerNe !x !y = isTrue# (integerNe# x y)
integerEq :: Integer -> Integer -> Bool
integerEq !x !y = isTrue# (integerEq# x y)
integerLe :: Integer -> Integer -> Bool
integerLe !x !y = isTrue# (integerLe# x y)
integerLt :: Integer -> Integer -> Bool
integerLt !x !y = isTrue# (integerLt# x y)
integerGt :: Integer -> Integer -> Bool
integerGt !x !y = isTrue# (integerGt# x y)
integerGe :: Integer -> Integer -> Bool
integerGe !x !y = isTrue# (integerGe# x y)
integerEq# :: Integer -> Integer -> Bool#
integerEq# (IS x) (IS y) = x ==# y
integerEq# (IN x) (IN y) = bigNatEq# x y
integerEq# (IP x) (IP y) = bigNatEq# x y
integerEq# _ _ = 0#
integerNe# :: Integer -> Integer -> Bool#
integerNe# (IS x) (IS y) = x /=# y
integerNe# (IN x) (IN y) = bigNatNe# x y
integerNe# (IP x) (IP y) = bigNatNe# x y
integerNe# _ _ = 1#
integerGt# :: Integer -> Integer -> Bool#
integerGt# (IS x) (IS y) = x ># y
integerGt# x y | GT <- integerCompare' x y = 1#
integerGt# _ _ = 0#
integerLe# :: Integer -> Integer -> Bool#
integerLe# (IS x) (IS y) = x <=# y
integerLe# x y | GT <- integerCompare' x y = 0#
integerLe# _ _ = 1#
integerLt# :: Integer -> Integer -> Bool#
integerLt# (IS x) (IS y) = x <# y
integerLt# x y | LT <- integerCompare' x y = 1#
integerLt# _ _ = 0#
integerGe# :: Integer -> Integer -> Bool#
integerGe# (IS x) (IS y) = x >=# y
integerGe# x y | LT <- integerCompare' x y = 0#
integerGe# _ _ = 1#
instance Eq Integer where
(==) = integerEq
(/=) = integerNe
integerCompare :: Integer -> Integer -> Ordering
integerCompare = integerCompare'
integerCompare' :: Integer -> Integer -> Ordering
integerCompare' (IS x) (IS y) = compareInt# x y
integerCompare' (IP x) (IP y) = bigNatCompare x y
integerCompare' (IN x) (IN y) = bigNatCompare y x
integerCompare' (IS _) (IP _) = LT
integerCompare' (IS _) (IN _) = GT
integerCompare' (IP _) (IS _) = GT
integerCompare' (IN _) (IS _) = LT
integerCompare' (IP _) (IN _) = GT
integerCompare' (IN _) (IP _) = LT
instance Ord Integer where
compare = integerCompare
(<) = integerLt
(<=) = integerLe
(>) = integerGt
(>=) = integerGe
integerSub :: Integer -> Integer -> Integer
integerSub !x (IS 0#) = x
integerSub (IS x#) (IS y#)
= case subIntC# x# y# of
(# z#, 0# #) -> IS z#
(# 0#, _ #) -> IN (bigNatFromWord2# 1## 0##)
(# z#, _ #)
| isTrue# (z# ># 0#)
-> IN (bigNatFromWord# ( (int2Word# (negateInt# z#))))
| True
-> IP (bigNatFromWord# ( (int2Word# z#)))
integerSub (IS x#) (IP y)
| isTrue# (x# >=# 0#)
= integerFromBigNatNeg# (bigNatSubWordUnsafe# y (int2Word# x#))
| True
= IN (bigNatAddWord# y (int2Word# (negateInt# x#)))
integerSub (IS x#) (IN y)
| isTrue# (x# >=# 0#)
= IP (bigNatAddWord# y (int2Word# x#))
| True
= integerFromBigNat# (bigNatSubWordUnsafe# y (int2Word# (negateInt# x#)))
integerSub (IP x) (IP y)
= case bigNatCompare x y of
LT -> integerFromBigNatNeg# (bigNatSubUnsafe y x)
EQ -> IS 0#
GT -> integerFromBigNat# (bigNatSubUnsafe x y)
integerSub (IP x) (IN y) = IP (bigNatAdd x y)
integerSub (IN x) (IP y) = IN (bigNatAdd x y)
integerSub (IN x) (IN y)
= case bigNatCompare x y of
LT -> integerFromBigNat# (bigNatSubUnsafe y x)
EQ -> IS 0#
GT -> integerFromBigNatNeg# (bigNatSubUnsafe x y)
integerSub (IP x) (IS y#)
| isTrue# (y# >=# 0#)
= integerFromBigNat# (bigNatSubWordUnsafe# x (int2Word# y#))
| True
= IP (bigNatAddWord# x (int2Word# (negateInt# y#)))
integerSub (IN x) (IS y#)
| isTrue# (y# >=# 0#)
= IN (bigNatAddWord# x (int2Word# y#))
| True
= integerFromBigNatNeg# (bigNatSubWordUnsafe# x (int2Word# (negateInt# y#)))
integerAdd :: Integer -> Integer -> Integer
integerAdd !x (IS 0#) = x
integerAdd (IS 0#) y = y
integerAdd (IS x#) (IS y#)
= case addIntC# x# y# of
(# z#, 0# #) -> IS z#
(# 0#, _ #) -> IN (bigNatFromWord2# 1## 0##)
(# z#, _ #)
| isTrue# (z# ># 0#) -> IN (bigNatFromWord# ( (int2Word# (negateInt# z#))))
| True -> IP (bigNatFromWord# ( (int2Word# z#)))
integerAdd y@(IS _) x = integerAdd x y
integerAdd (IP x) (IP y) = IP (bigNatAdd x y)
integerAdd (IN x) (IN y) = IN (bigNatAdd x y)
integerAdd (IP x) (IS y#)
| isTrue# (y# >=# 0#) = IP (bigNatAddWord# x (int2Word# y#))
| True = integerFromBigNat# (bigNatSubWordUnsafe# x (int2Word#
(negateInt# y#)))
integerAdd (IN x) (IS y#)
| isTrue# (y# >=# 0#) = integerFromBigNatNeg# (bigNatSubWordUnsafe# x (int2Word# y#))
| True = IN (bigNatAddWord# x (int2Word# (negateInt# y#)))
integerAdd y@(IN _) x@(IP _) = integerAdd x y
integerAdd (IP x) (IN y)
= case bigNatCompare x y of
LT -> integerFromBigNatNeg# (bigNatSubUnsafe y x)
EQ -> IS 0#
GT -> integerFromBigNat# (bigNatSubUnsafe x y)
integerMul :: Integer -> Integer -> Integer
integerMul !_ (IS 0#) = IS 0#
integerMul (IS 0#) _ = IS 0#
integerMul x (IS 1#) = x
integerMul (IS 1#) y = y
integerMul x (IS 1#) = integerNegate x
integerMul (IS 1#) y = integerNegate y
#if __GLASGOW_HASKELL__ < 811
integerMul (IS x) (IS y) = case mulIntMayOflo# x y of
0# -> IS (x *# y)
_ -> case (# isTrue# (x >=# 0#), isTrue# (y >=# 0#) #) of
(# False, False #) -> case timesWord2# (int2Word# (negateInt# x))
(int2Word# (negateInt# y)) of
(# 0##,l #) -> integerFromWord# l
(# h ,l #) -> IP (bigNatFromWord2# h l)
(# True, False #) -> case timesWord2# (int2Word# x)
(int2Word# (negateInt# y)) of
(# 0##,l #) -> integerFromWordNeg# l
(# h ,l #) -> IN (bigNatFromWord2# h l)
(# False, True #) -> case timesWord2# (int2Word# (negateInt# x))
(int2Word# y) of
(# 0##,l #) -> integerFromWordNeg# l
(# h ,l #) -> IN (bigNatFromWord2# h l)
(# True, True #) -> case timesWord2# (int2Word# x)
(int2Word# y) of
(# 0##,l #) -> integerFromWord# l
(# h ,l #) -> IP (bigNatFromWord2# h l)
#else
integerMul (IS x) (IS y) = case timesInt2# x y of
(# 0#, _h, l #) -> IS l
(# _ , h, l #)
| isTrue# (h >=# 0#)
-> IP (bigNatFromWord2# (int2Word# h) (int2Word# l))
| True
-> let
!(# l',c #) = addWordC# (not# (int2Word# l)) 1##
!h' = int2Word# c `plusWord#` not# (int2Word# h)
in IN (bigNatFromWord2# h' l')
#endif
integerMul x@(IS _) y = integerMul y x
integerMul (IP x) (IP y) = IP (bigNatMul x y)
integerMul (IP x) (IN y) = IN (bigNatMul x y)
integerMul (IP x) (IS y)
| isTrue# (y >=# 0#) = IP (bigNatMulWord# x (int2Word# y))
| True = IN (bigNatMulWord# x (int2Word# (negateInt# y)))
integerMul (IN x) (IN y) = IP (bigNatMul x y)
integerMul (IN x) (IP y) = IN (bigNatMul x y)
integerMul (IN x) (IS y)
| isTrue# (y >=# 0#) = IN (bigNatMulWord# x (int2Word# y))
| True = IP (bigNatMulWord# x (int2Word# (negateInt# y)))
integerNegate :: Integer -> Integer
integerNegate (IN b) = IP b
integerNegate (IS INT_MINBOUND#) = IP (bigNatFromWord# ABS_INT_MINBOUND##)
integerNegate (IS i) = IS (negateInt# i)
integerNegate (IP b)
| isTrue# (bigNatEqWord# b ABS_INT_MINBOUND##) = IS INT_MINBOUND#
| True = IN b
integerAbs :: Integer -> Integer
integerAbs (IN i) = IP i
integerAbs n@(IP _) = n
integerAbs n@(IS i)
| isTrue# (i >=# 0#) = n
| INT_MINBOUND# <- i = IP (bigNatFromWord# ABS_INT_MINBOUND##)
| True = IS (negateInt# i)
integerSignum :: Integer -> Integer
integerSignum !j = IS (integerSignum# j)
integerSignum# :: Integer -> Int#
integerSignum# (IN _) = 1#
integerSignum# (IS i#) = sgnI# i#
integerSignum# (IP _ ) = 1#
integerPopCount# :: Integer -> Int#
integerPopCount# (IS i)
| isTrue# (i >=# 0#) = word2Int# (popCntI# i)
| True = negateInt# (word2Int# (popCntI# (negateInt# i)))
integerPopCount# (IP bn) = word2Int# (bigNatPopCount# bn)
integerPopCount# (IN bn) = negateInt# (word2Int# (bigNatPopCount# bn))
integerBit# :: Word# -> Integer
integerBit# i
| isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##))
= IS (uncheckedIShiftL# 1# (word2Int# i))
| True = IP (bigNatBit# i)
integerBit :: Word -> Integer
integerBit (W# i) = integerBit# i
integerTestBit# :: Integer -> Word# -> Bool#
integerTestBit# (IS x) i
| isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##)
= testBitI# x i
| True
= x <# 0#
integerTestBit# (IP x) i = bigNatTestBit# x i
integerTestBit# (IN x) i
| isTrue# (iw >=# n)
= 1#
| allZ iw = testBitW# (xi `minusWord#` 1##) ib ==# 0#
| True = testBitW# xi ib ==# 0#
where
!xi = bigNatIndex# x iw
!n = bigNatSize# x
!iw = word2Int# (i `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
!ib = i `and#` WORD_SIZE_BITS_MASK##
allZ 0# = True
allZ j | isTrue# (bigNatIndex# x (j -# 1#) `eqWord#` 0##) = allZ (j -# 1#)
| True = False
integerTestBit :: Integer -> Word -> Bool
integerTestBit !i (W# n) = isTrue# (integerTestBit# i n)
integerShiftR# :: Integer -> Word# -> Integer
integerShiftR# !x 0## = x
integerShiftR# (IS i) n = IS (iShiftRA# i (word2Int# n))
where
iShiftRA# a b
| isTrue# (b >=# WORD_SIZE_IN_BITS#) = (a <# 0#) *# (1#)
| True = a `uncheckedIShiftRA#` b
integerShiftR# (IP bn) n = integerFromBigNat# (bigNatShiftR# bn n)
integerShiftR# (IN bn) n =
case integerFromBigNatNeg# (bigNatShiftRNeg# bn n) of
IS 0# -> IS 1#
r -> r
integerShiftR :: Integer -> Word -> Integer
integerShiftR !x (W# w) = integerShiftR# x w
integerShiftL# :: Integer -> Word# -> Integer
integerShiftL# !x 0## = x
integerShiftL# (IS 0#) _ = IS 0#
integerShiftL# (IS 1#) n = integerBit# n
integerShiftL# (IS i) n
| isTrue# (i >=# 0#) = integerFromBigNat# (bigNatShiftL# (bigNatFromWord# (int2Word# i)) n)
| True = integerFromBigNatNeg# (bigNatShiftL# (bigNatFromWord# (int2Word# (negateInt# i))) n)
integerShiftL# (IP bn) n = IP (bigNatShiftL# bn n)
integerShiftL# (IN bn) n = IN (bigNatShiftL# bn n)
integerShiftL :: Integer -> Word -> Integer
integerShiftL !x (W# w) = integerShiftL# x w
integerOr :: Integer -> Integer -> Integer
integerOr a b = case a of
IS 0# -> b
IS 1# -> IS 1#
IS x -> case b of
IS 0# -> a
IS 1# -> IS 1#
IS y -> IS (orI# x y)
IP y
| isTrue# (x >=# 0#) -> integerFromBigNat# (bigNatOrWord# y (int2Word# x))
| True -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatAndNot
(bigNatFromWord#
(int2Word# (negateInt# x) `minusWord#` 1##))
y)
1##)
IN y
| isTrue# (x >=# 0#) -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatAndNotWord#
(bigNatSubWordUnsafe# y 1##)
(int2Word# x))
1##)
| True -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatAndWord#
(bigNatSubWordUnsafe# y 1##)
(int2Word# (negateInt# x) `minusWord#` 1##))
1##)
IP x -> case b of
IS _ -> integerOr b a
IP y -> integerFromBigNat# (bigNatOr x y)
IN y -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatAndNot
(bigNatSubWordUnsafe# y 1##)
x)
1##)
IN x -> case b of
IS _ -> integerOr b a
IN y -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatAnd
(bigNatSubWordUnsafe# x 1##)
(bigNatSubWordUnsafe# y 1##))
1##)
IP y -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatAndNot
(bigNatSubWordUnsafe# x 1##)
y)
1##)
integerXor :: Integer -> Integer -> Integer
integerXor a b = case a of
IS 0# -> b
IS 1# -> integerComplement b
IS x -> case b of
IS 0# -> a
IS 1# -> integerComplement a
IS y -> IS (xorI# x y)
IP y
| isTrue# (x >=# 0#) -> integerFromBigNat# (bigNatXorWord# y (int2Word# x))
| True -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatXorWord#
y
(int2Word# (negateInt# x) `minusWord#` 1##))
1##)
IN y
| isTrue# (x >=# 0#) -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatXorWord#
(bigNatSubWordUnsafe# y 1##)
(int2Word# x))
1##)
| True -> integerFromBigNat#
(bigNatXorWord#
(bigNatSubWordUnsafe# y 1##)
(int2Word# (negateInt# x) `minusWord#` 1##))
IP x -> case b of
IS _ -> integerXor b a
IP y -> integerFromBigNat# (bigNatXor x y)
IN y -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatXor
x
(bigNatSubWordUnsafe# y 1##))
1##)
IN x -> case b of
IS _ -> integerXor b a
IN y -> integerFromBigNat#
(bigNatXor
(bigNatSubWordUnsafe# x 1##)
(bigNatSubWordUnsafe# y 1##))
IP y -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatXor
y
(bigNatSubWordUnsafe# x 1##))
1##)
integerAnd :: Integer -> Integer -> Integer
integerAnd a b = case a of
IS 0# -> IS 0#
IS 1# -> b
IS x -> case b of
IS 0# -> IS 0#
IS 1# -> a
IS y -> IS (andI# x y)
IP y -> integerFromBigNat# (bigNatAndInt# y x)
IN y
| isTrue# (x >=# 0#) -> integerFromWord# (int2Word# x `andNot#` (indexWordArray# y 0# `minusWord#` 1##))
| True -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatOrWord#
(bigNatSubWordUnsafe# y 1##)
(wordFromAbsInt# x `minusWord#` 1##))
1##)
IP x -> case b of
IS _ -> integerAnd b a
IP y -> integerFromBigNat# (bigNatAnd x y)
IN y -> integerFromBigNat# (bigNatAndNot x (bigNatSubWordUnsafe# y 1##))
IN x -> case b of
IS _ -> integerAnd b a
IN y -> integerFromBigNatNeg#
(bigNatAddWord#
(bigNatOr
(bigNatSubWordUnsafe# x 1##)
(bigNatSubWordUnsafe# y 1##))
1##)
IP y -> integerFromBigNat# (bigNatAndNot y (bigNatSubWordUnsafe# x 1##))
integerComplement :: Integer -> Integer
integerComplement (IS x) = IS (notI# x)
integerComplement (IP x) = IN (bigNatAddWord# x 1##)
integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##)
integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #)
integerQuotRem# !n (IS 1#) = (# n, IS 0# #)
integerQuotRem# !n (IS 1#) = let !q = integerNegate n in (# q, (IS 0#) #)
integerQuotRem# !_ (IS 0#) = case raiseDivZero of
!_ -> (# IS 0#, IS 0# #)
integerQuotRem# (IS 0#) _ = (# IS 0#, IS 0# #)
integerQuotRem# (IS n#) (IS d#) = case quotRemInt# n# d# of
(# q#, r# #) -> (# IS q#, IS r# #)
integerQuotRem# (IP n) (IP d) = case bigNatQuotRem# n d of
(# q, r #) -> (# integerFromBigNat# q, integerFromBigNat# r #)
integerQuotRem# (IP n) (IN d) = case bigNatQuotRem# n d of
(# q, r #) -> (# integerFromBigNatNeg# q, integerFromBigNat# r #)
integerQuotRem# (IN n) (IN d) = case bigNatQuotRem# n d of
(# q, r #) -> (# integerFromBigNat# q, integerFromBigNatNeg# r #)
integerQuotRem# (IN n) (IP d) = case bigNatQuotRem# n d of
(# q, r #) -> (# integerFromBigNatNeg# q, integerFromBigNatNeg# r #)
integerQuotRem# (IP n) (IS d#)
| isTrue# (d# >=# 0#) = case bigNatQuotRemWord# n (int2Word# d#) of
(# q, r# #) -> (# integerFromBigNat# q, integerFromWord# r# #)
| True = case bigNatQuotRemWord# n (int2Word# (negateInt# d#)) of
(# q, r# #) -> (# integerFromBigNatNeg# q, integerFromWord# r# #)
integerQuotRem# (IN n) (IS d#)
| isTrue# (d# >=# 0#) = case bigNatQuotRemWord# n (int2Word# d#) of
(# q, r# #) -> (# integerFromBigNatNeg# q, integerFromWordNeg# r# #)
| True = case bigNatQuotRemWord# n (int2Word# (negateInt# d#)) of
(# q, r# #) -> (# integerFromBigNat# q, integerFromWordNeg# r# #)
integerQuotRem# n@(IS _) (IN _) = (# IS 0#, n #)
integerQuotRem# n@(IS n#) (IP d)
| isTrue# (n# ># 0#) = (# IS 0#, n #)
| isTrue# (bigNatGtWord# d (int2Word# (negateInt# n#))) = (# IS 0#, n #)
| True = (# IS 1#, IS 0# #)
integerQuotRem :: Integer -> Integer -> (Integer, Integer)
integerQuotRem !x !y = case integerQuotRem# x y of
(# q, r #) -> (q, r)
integerQuot :: Integer -> Integer -> Integer
integerQuot !n (IS 1#) = n
integerQuot !n (IS 1#) = integerNegate n
integerQuot !_ (IS 0#) = raiseDivZero
integerQuot (IS 0#) _ = IS 0#
integerQuot (IS n#) (IS d#) = IS (quotInt# n# d#)
integerQuot (IP n) (IS d#)
| isTrue# (d# >=# 0#) = integerFromBigNat# (bigNatQuotWord# n (int2Word# d#))
| True = integerFromBigNatNeg# (bigNatQuotWord# n
(int2Word# (negateInt# d#)))
integerQuot (IN n) (IS d#)
| isTrue# (d# >=# 0#) = integerFromBigNatNeg# (bigNatQuotWord# n (int2Word# d#))
| True = integerFromBigNat# (bigNatQuotWord# n
(int2Word# (negateInt# d#)))
integerQuot (IP n) (IP d) = integerFromBigNat# (bigNatQuot n d)
integerQuot (IP n) (IN d) = integerFromBigNatNeg# (bigNatQuot n d)
integerQuot (IN n) (IP d) = integerFromBigNatNeg# (bigNatQuot n d)
integerQuot (IN n) (IN d) = integerFromBigNat# (bigNatQuot n d)
integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q
integerRem :: Integer -> Integer -> Integer
integerRem !_ (IS 1#) = IS 0#
integerRem _ (IS 1#) = IS 0#
integerRem _ (IS 0#) = IS (remInt# 0# 0#)
integerRem (IS 0#) _ = IS 0#
integerRem (IS n#) (IS d#) = IS (remInt# n# d#)
integerRem (IP n) (IS d#)
= integerFromWord# (bigNatRemWord# n (int2Word# (absI# d#)))
integerRem (IN n) (IS d#)
= integerFromWordNeg# (bigNatRemWord# n (int2Word# (absI# d#)))
integerRem (IP n) (IP d) = integerFromBigNat# (bigNatRem n d)
integerRem (IP n) (IN d) = integerFromBigNat# (bigNatRem n d)
integerRem (IN n) (IP d) = integerFromBigNatNeg# (bigNatRem n d)
integerRem (IN n) (IN d) = integerFromBigNatNeg# (bigNatRem n d)
integerRem n d = case integerQuotRem# n d of (# _, r #) -> r
integerDivMod# :: Integer -> Integer -> (# Integer, Integer #)
integerDivMod# !n !d
| isTrue# (integerSignum# r ==# negateInt# (integerSignum# d))
= let !q' = integerSub q (IS 1#)
!r' = integerAdd r d
in (# q', r' #)
| True = qr
where
!qr@(# q, r #) = integerQuotRem# n d
integerDivMod :: Integer -> Integer -> (Integer, Integer)
integerDivMod !n !d = case integerDivMod# n d of
(# q,r #) -> (q,r)
integerDiv :: Integer -> Integer -> Integer
integerDiv !n !d
| isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerQuot n d
| True = case integerDivMod# n d of (# q, _ #) -> q
integerMod :: Integer -> Integer -> Integer
integerMod !n !d
| isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerRem n d
| True = case integerDivMod# n d of (# _, r #) -> r
integerGcd :: Integer -> Integer -> Integer
integerGcd (IS 0#) !b = integerAbs b
integerGcd a (IS 0#) = integerAbs a
integerGcd (IS 1#) _ = IS 1#
integerGcd (IS 1#) _ = IS 1#
integerGcd _ (IS 1#) = IS 1#
integerGcd _ (IS 1#) = IS 1#
integerGcd (IS a) (IS b) = integerFromWord# (gcdWord#
(int2Word# (absI# a))
(int2Word# (absI# b)))
integerGcd a@(IS _) b = integerGcd b a
integerGcd (IN a) b = integerGcd (IP a) b
integerGcd (IP a) (IP b) = integerFromBigNat# (bigNatGcd a b)
integerGcd (IP a) (IN b) = integerFromBigNat# (bigNatGcd a b)
integerGcd (IP a) (IS b) = integerFromWord# (bigNatGcdWord# a (int2Word# (absI# b)))
integerLcm :: Integer -> Integer -> Integer
integerLcm (IS 0#) !_ = IS 0#
integerLcm (IS 1#) b = integerAbs b
integerLcm (IS 1#) b = integerAbs b
integerLcm _ (IS 0#) = IS 0#
integerLcm a (IS 1#) = integerAbs a
integerLcm a (IS 1#) = integerAbs a
integerLcm a b = (aa `integerQuot` (aa `integerGcd` ab)) `integerMul` ab
where
aa = integerAbs a
ab = integerAbs b
integerSqr :: Integer -> Integer
integerSqr !a = integerMul a a
integerLog2# :: Integer -> Word#
integerLog2# (IS i)
| isTrue# (i <=# 0#) = 0##
| True = wordLog2# (int2Word# i)
integerLog2# (IN _) = 0##
integerLog2# (IP b) = bigNatLog2# b
integerLog2 :: Integer -> Word
integerLog2 !i = W# (integerLog2# i)
integerLogBaseWord# :: Word# -> Integer -> Word#
integerLogBaseWord# base !i
| integerIsNegative i = 0##
| True = naturalLogBaseWord# base (integerToNatural i)
integerLogBaseWord :: Word -> Integer -> Word
integerLogBaseWord (W# base) !i = W# (integerLogBaseWord# base i)
integerLogBase# :: Integer -> Integer -> Word#
integerLogBase# !base !i
| integerIsNegative i = 0##
| True = naturalLogBase# (integerToNatural base)
(integerToNatural i)
integerLogBase :: Integer -> Integer -> Word
integerLogBase !base !i = W# (integerLogBase# base i)
integerIsPowerOf2# :: Integer -> (# (# #) | Word# #)
integerIsPowerOf2# (IS i)
| isTrue# (i <=# 0#) = (# (# #) | #)
| True = wordIsPowerOf2# (int2Word# i)
integerIsPowerOf2# (IN _) = (# (# #) | #)
integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w
#if WORD_SIZE_IN_BITS == 32
integerFromInt64# :: Int64# -> Integer
integerFromInt64# !i
| isTrue# ((i `leInt64#` intToInt64# 0x7FFFFFFF#)
&&# (i `geInt64#` intToInt64# 0x80000000#))
= IS (int64ToInt# i)
| isTrue# (i `geInt64#` intToInt64# 0#)
= IP (bigNatFromWord64# (int64ToWord64# i))
| True
= IN (bigNatFromWord64# (int64ToWord64# (negateInt64# i)))
integerFromWord64# :: Word64# -> Integer
integerFromWord64# !w
| isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##)
= IS (int64ToInt# (word64ToInt64# w))
| True
= IP (bigNatFromWord64# w)
integerToInt64# :: Integer -> Int64#
integerToInt64# (IS i) = intToInt64# i
integerToInt64# (IP b) = word64ToInt64# (bigNatToWord64# b)
integerToInt64# (IN b) = negateInt64# (word64ToInt64# (bigNatToWord64# b))
integerToWord64# :: Integer -> Word64#
integerToWord64# (IS i) = int64ToWord64# (intToInt64# i)
integerToWord64# (IP b) = bigNatToWord64# b
integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64# b)))
#else
integerFromInt64# :: Int# -> Integer
integerFromInt64# !x = IS x
#endif
integerDecodeDouble# :: Double# -> (# Integer, Int# #)
integerDecodeDouble# !x = case decodeDouble_Int64# x of
(# m, e #) -> (# integerFromInt64# m, e #)
integerEncodeDouble# :: Integer -> Int# -> Double#
integerEncodeDouble# (IS i) 0# = int2Double# i
integerEncodeDouble# (IS i) e = intEncodeDouble# i e
integerEncodeDouble# (IP b) e = bigNatEncodeDouble# b e
integerEncodeDouble# (IN b) e = negateDouble# (bigNatEncodeDouble# b e)
integerEncodeDouble :: Integer -> Int -> Double
integerEncodeDouble !m (I# e) = D# (integerEncodeDouble# m e)
integerEncodeFloat# :: Integer -> Int# -> Float#
integerEncodeFloat# !m e = double2Float# (integerEncodeDouble# m e)
integerSizeInBase# :: Word# -> Integer -> Word#
integerSizeInBase# base (IS i) = wordSizeInBase# base (int2Word# (absI# i))
integerSizeInBase# base (IP n) = bigNatSizeInBase# base n
integerSizeInBase# base (IN n) = bigNatSizeInBase# base n
integerToAddr# :: Integer -> Addr# -> Bool# -> State# s -> (# State# s, Word# #)
integerToAddr# (IS i) = wordToAddr# (int2Word# (absI# i))
integerToAddr# (IP n) = bigNatToAddr# n
integerToAddr# (IN n) = bigNatToAddr# n
integerToAddr :: Integer -> Addr# -> Bool# -> IO Word
integerToAddr a addr e = IO \s -> case integerToAddr# a addr e s of
(# s', w #) -> (# s', W# w #)
integerFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Integer #)
integerFromAddr# sz addr e s =
case bigNatFromAddr# sz addr e s of
(# s', n #) -> (# s', integerFromBigNat# n #)
integerFromAddr :: Word# -> Addr# -> Bool# -> IO Integer
integerFromAddr sz addr e = IO (integerFromAddr# sz addr e)
integerToMutableByteArray# :: Integer -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #)
integerToMutableByteArray# (IS i) = wordToMutableByteArray# (int2Word# (absI# i))
integerToMutableByteArray# (IP a) = bigNatToMutableByteArray# a
integerToMutableByteArray# (IN a) = bigNatToMutableByteArray# a
integerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Bool# -> IO Word
integerToMutableByteArray i mba w e = IO \s -> case integerToMutableByteArray# i mba w e s of
(# s', r #) -> (# s', W# r #)
integerFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, Integer #)
integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of
(# s', a #) -> (# s', integerFromBigNat# a #)
integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer
integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of
(# _, i #) -> i
integerGcde#
:: Integer
-> Integer
-> (# Integer, Integer, Integer #)
integerGcde# a b
| integerIsZero a && integerIsZero b = (# integerZero, integerZero, integerZero #)
| integerIsZero a = fix (# b , integerZero, integerOne #)
| integerIsZero b = fix (# a , integerOne, integerZero #)
| integerAbs a `integerEq` integerAbs b = fix (# b , integerZero, integerOne #)
| True = Backend.integer_gcde a b
where
fix (# g, x, y #)
| integerIsNegative g = (# integerNegate g, integerNegate x, integerNegate y #)
| True = (# g,x,y #)
integerGcde
:: Integer
-> Integer
-> ( Integer, Integer, Integer)
integerGcde a b = case integerGcde# a b of
(# g,x,y #) -> (g,x,y)
integerRecipMod#
:: Integer
-> Natural
-> (# Natural | () #)
integerRecipMod# x m
| integerIsZero x = (# | () #)
| naturalIsZero m = (# | () #)
| naturalIsOne m = (# | () #)
| True = Backend.integer_recip_mod x m
integerPowMod# :: Integer -> Integer -> Natural -> (# Natural | () #)
integerPowMod# !b !e !m
| naturalIsZero m = (# | () #)
| naturalIsOne m = (# naturalZero | #)
| integerIsZero e = (# naturalOne | #)
| integerIsZero b = (# naturalZero | #)
| integerIsOne b = (# naturalOne | #)
| integerIsNegative e = case integerRecipMod# b m of
(# | () #) -> (# | () #)
(# b' | #) -> integerPowMod#
(integerFromNatural b')
(integerNegate e)
m
| True = (# Backend.integer_powmod b (integerToNatural e) m | #)