#include "MachDeps.h"
#include "WordSize.h"
module GHC.Num.Natural where
import GHC.Prim
import GHC.Types
import GHC.Classes
import GHC.Num.BigNat
import GHC.Num.Primitives
default ()
data Natural
= NS !Word#
| NB !BigNat#
instance Eq Natural where
(==) = naturalEq
(/=) = naturalNe
instance Ord Natural where
compare = naturalCompare
(>) = naturalGt
(>=) = naturalGe
(<) = naturalLt
(<=) = naturalLe
naturalCheck# :: Natural -> Bool#
naturalCheck# (NS _) = 1#
naturalCheck# (NB bn) = bigNatCheck# bn &&# bigNatSize# bn ># 1#
naturalCheck :: Natural -> Bool
naturalCheck !n = isTrue# (naturalCheck# n)
naturalZero :: Natural
naturalZero = NS 0##
naturalOne :: Natural
naturalOne = NS 1##
naturalIsZero :: Natural -> Bool
naturalIsZero (NS 0##) = True
naturalIsZero _ = False
naturalIsOne :: Natural -> Bool
naturalIsOne (NS 1##) = True
naturalIsOne _ = False
naturalIsPowerOf2# :: Natural -> (# (# #) | Word# #)
naturalIsPowerOf2# (NS w) = wordIsPowerOf2# w
naturalIsPowerOf2# (NB w) = bigNatIsPowerOf2# w
naturalFromBigNat# :: BigNat# -> Natural
naturalFromBigNat# x = case bigNatSize# x of
0# -> naturalZero
1# -> NS (bigNatIndex# x 0#)
_ -> NB x
naturalToBigNat# :: Natural -> BigNat#
naturalToBigNat# (NS w) = bigNatFromWord# w
naturalToBigNat# (NB bn) = bn
naturalFromWord# :: Word# -> Natural
naturalFromWord# x = NS x
naturalFromWord2# :: Word# -> Word# -> Natural
naturalFromWord2# 0## 0## = naturalZero
naturalFromWord2# 0## l = NS l
naturalFromWord2# h l = NB (bigNatFromWord2# h l)
naturalFromWord :: Word -> Natural
naturalFromWord (W# x) = NS x
naturalFromWordList :: [Word] -> Natural
naturalFromWordList xs = naturalFromBigNat# (bigNatFromWordList xs)
naturalToWord# :: Natural -> Word#
naturalToWord# (NS x) = x
naturalToWord# (NB b) = bigNatIndex# b 0#
naturalToWord :: Natural -> Word
naturalToWord !n = W# (naturalToWord# n)
naturalToWordClamp# :: Natural -> Word#
naturalToWordClamp# (NS x) = x
naturalToWordClamp# (NB _) = WORD_MAXBOUND##
naturalToWordClamp :: Natural -> Word
naturalToWordClamp !n = W# (naturalToWordClamp# n)
naturalToWordMaybe# :: Natural -> (# (# #) | Word# #)
naturalToWordMaybe# (NS w) = (# | w #)
naturalToWordMaybe# _ = (# (# #) | #)
naturalEncodeDouble# :: Natural -> Int# -> Double#
naturalEncodeDouble# (NS w) 0# = word2Double# w
naturalEncodeDouble# (NS w) e = wordEncodeDouble# w e
naturalEncodeDouble# (NB b) e = bigNatEncodeDouble# b e
naturalToDouble# :: Natural -> Double#
naturalToDouble# !n = naturalEncodeDouble# n 0#
naturalToFloat# :: Natural -> Float#
naturalToFloat# !i = naturalEncodeFloat# i 0#
naturalEncodeFloat# :: Natural -> Int# -> Float#
naturalEncodeFloat# !m 0# = double2Float# (naturalToDouble# m)
naturalEncodeFloat# !m e = double2Float# (naturalEncodeDouble# m e)
naturalEq# :: Natural -> Natural -> Bool#
naturalEq# (NS x) (NS y) = x `eqWord#` y
naturalEq# (NB x) (NB y) = bigNatEq# x y
naturalEq# _ _ = 0#
naturalEq :: Natural -> Natural -> Bool
naturalEq !x !y = isTrue# (naturalEq# x y)
naturalNe# :: Natural -> Natural -> Bool#
naturalNe# (NS x) (NS y) = x `neWord#` y
naturalNe# (NB x) (NB y) = bigNatNe# x y
naturalNe# _ _ = 1#
naturalNe :: Natural -> Natural -> Bool
naturalNe !x !y = isTrue# (naturalNe# x y)
naturalGe# :: Natural -> Natural -> Bool#
naturalGe# (NS x) (NS y) = x `geWord#` y
naturalGe# (NS _) (NB _) = 0#
naturalGe# (NB _) (NS _) = 1#
naturalGe# (NB x) (NB y) = bigNatGe# x y
naturalGe :: Natural -> Natural -> Bool
naturalGe !x !y = isTrue# (naturalGe# x y)
naturalLe# :: Natural -> Natural -> Bool#
naturalLe# (NS x) (NS y) = x `leWord#` y
naturalLe# (NS _) (NB _) = 1#
naturalLe# (NB _) (NS _) = 0#
naturalLe# (NB x) (NB y) = bigNatLe# x y
naturalLe :: Natural -> Natural -> Bool
naturalLe !x !y = isTrue# (naturalLe# x y)
naturalGt# :: Natural -> Natural -> Bool#
naturalGt# (NS x) (NS y) = x `gtWord#` y
naturalGt# (NS _) (NB _) = 0#
naturalGt# (NB _) (NS _) = 1#
naturalGt# (NB x) (NB y) = bigNatGt# x y
naturalGt :: Natural -> Natural -> Bool
naturalGt !x !y = isTrue# (naturalGt# x y)
naturalLt# :: Natural -> Natural -> Bool#
naturalLt# (NS x) (NS y) = x `ltWord#` y
naturalLt# (NS _) (NB _) = 1#
naturalLt# (NB _) (NS _) = 0#
naturalLt# (NB x) (NB y) = bigNatLt# x y
naturalLt :: Natural -> Natural -> Bool
naturalLt !x !y = isTrue# (naturalLt# x y)
naturalCompare :: Natural -> Natural -> Ordering
naturalCompare (NS x) (NS y) = cmpW# x y
naturalCompare (NB x) (NB y) = bigNatCompare x y
naturalCompare (NS _) (NB _) = LT
naturalCompare (NB _) (NS _) = GT
naturalPopCount# :: Natural -> Word#
naturalPopCount# (NS x) = popCnt# x
naturalPopCount# (NB x) = bigNatPopCount# x
naturalPopCount :: Natural -> Word
naturalPopCount (NS x) = W# (popCnt# x)
naturalPopCount (NB x) = bigNatPopCount x
naturalShiftR# :: Natural -> Word# -> Natural
naturalShiftR# (NS x) n = NS (x `shiftRW#` n)
naturalShiftR# (NB x) n = naturalFromBigNat# (x `bigNatShiftR#` n)
naturalShiftR :: Natural -> Word -> Natural
naturalShiftR x (W# n) = naturalShiftR# x n
naturalShiftL# :: Natural -> Word# -> Natural
naturalShiftL# v@(NS x) n
| 0## <- x = v
| isTrue# (clz# x `geWord#` n) = NS (x `uncheckedShiftL#` word2Int# n)
| True = NB (bigNatFromWord# x `bigNatShiftL#` n)
naturalShiftL# (NB x) n = NB (x `bigNatShiftL#` n)
naturalShiftL :: Natural -> Word -> Natural
naturalShiftL !x (W# n) = naturalShiftL# x n
naturalAdd :: Natural -> Natural -> Natural
naturalAdd (NS x) (NB y) = NB (bigNatAddWord# y x)
naturalAdd (NB x) (NS y) = NB (bigNatAddWord# x y)
naturalAdd (NB x) (NB y) = NB (bigNatAdd x y)
naturalAdd (NS x) (NS y) =
case addWordC# x y of
(# l,0# #) -> NS l
(# l,c #) -> NB (bigNatFromWord2# (int2Word# c) l)
naturalSub :: Natural -> Natural -> (# Void# | Natural #)
naturalSub (NS _) (NB _) = (# void# | #)
naturalSub (NB x) (NS y) = (# | naturalFromBigNat# (bigNatSubWordUnsafe# x y) #)
naturalSub (NS x) (NS y) =
case subWordC# x y of
(# l,0# #) -> (# | NS l #)
(# _,_ #) -> (# void# | #)
naturalSub (NB x) (NB y) =
case bigNatSub x y of
(# (# #) | #) -> (# void# | #)
(# | z #) -> (# | naturalFromBigNat# z #)
naturalSubThrow :: Natural -> Natural -> Natural
naturalSubThrow (NS _) (NB _) = raiseUnderflow
naturalSubThrow (NB x) (NS y) = naturalFromBigNat# (bigNatSubWordUnsafe# x y)
naturalSubThrow (NS x) (NS y) =
case subWordC# x y of
(# l,0# #) -> NS l
(# _,_ #) -> raiseUnderflow
naturalSubThrow (NB x) (NB y) =
case bigNatSub x y of
(# (# #) | #) -> raiseUnderflow
(# | z #) -> naturalFromBigNat# z
naturalSubUnsafe :: Natural -> Natural -> Natural
naturalSubUnsafe (NS x) (NS y) = NS (minusWord# x y)
naturalSubUnsafe (NS _) (NB _) = naturalZero
naturalSubUnsafe (NB x) (NS y) = naturalFromBigNat# (bigNatSubWordUnsafe# x y)
naturalSubUnsafe (NB x) (NB y) =
case bigNatSub x y of
(# (# #) | #) -> naturalZero
(# | z #) -> naturalFromBigNat# z
naturalMul :: Natural -> Natural -> Natural
naturalMul a b = case a of
NS 0## -> NS 0##
NS 1## -> b
NS x -> case b of
NS 0## -> NS 0##
NS 1## -> a
NS y -> case timesWord2# x y of
(# h,l #) -> naturalFromWord2# h l
NB y -> NB (bigNatMulWord# y x)
NB x -> case b of
NS 0## -> NS 0##
NS 1## -> a
NS y -> NB (bigNatMulWord# x y)
NB y -> NB (bigNatMul x y)
naturalSqr :: Natural -> Natural
naturalSqr !a = naturalMul a a
naturalSignum :: Natural -> Natural
naturalSignum (NS 0##) = NS 0##
naturalSignum _ = NS 1##
naturalNegate :: Natural -> Natural
naturalNegate (NS 0##) = NS 0##
naturalNegate _ = raiseUnderflow
naturalQuotRem# :: Natural -> Natural -> (# Natural, Natural #)
naturalQuotRem# (NS n) (NS d) = case quotRemWord# n d of
(# q, r #) -> (# NS q, NS r #)
naturalQuotRem# (NB n) (NS d) = case bigNatQuotRemWord# n d of
(# q, r #) -> (# naturalFromBigNat# q, NS r #)
naturalQuotRem# (NS n) (NB d) = case bigNatQuotRem# (bigNatFromWord# n) d of
(# q, r #) -> (# naturalFromBigNat# q, naturalFromBigNat# r #)
naturalQuotRem# (NB n) (NB d) = case bigNatQuotRem# n d of
(# q, r #) -> (# naturalFromBigNat# q, naturalFromBigNat# r #)
naturalQuotRem :: Natural -> Natural -> (Natural, Natural)
naturalQuotRem !n !d = case naturalQuotRem# n d of
(# q, r #) -> (q,r)
naturalQuot :: Natural -> Natural -> Natural
naturalQuot (NS n) (NS d) = case quotWord# n d of
q -> NS q
naturalQuot (NB n) (NS d) = case bigNatQuotWord# n d of
q -> naturalFromBigNat# q
naturalQuot (NS n) (NB d) = case bigNatQuot (bigNatFromWord# n) d of
q -> naturalFromBigNat# q
naturalQuot (NB n) (NB d) = case bigNatQuot n d of
q -> naturalFromBigNat# q
naturalRem :: Natural -> Natural -> Natural
naturalRem (NS n) (NS d) = case remWord# n d of
r -> NS r
naturalRem (NB n) (NS d) = case bigNatRemWord# n d of
r -> NS r
naturalRem (NS n) (NB d) = case bigNatRem (bigNatFromWord# n) d of
r -> naturalFromBigNat# r
naturalRem (NB n) (NB d) = case bigNatRem n d of
r -> naturalFromBigNat# r
naturalAnd :: Natural -> Natural -> Natural
naturalAnd (NS n) (NS m) = NS (n `and#` m)
naturalAnd (NS n) (NB m) = NS (n `and#` bigNatToWord# m)
naturalAnd (NB n) (NS m) = NS (bigNatToWord# n `and#` m)
naturalAnd (NB n) (NB m) = naturalFromBigNat# (bigNatAnd n m)
naturalAndNot :: Natural -> Natural -> Natural
naturalAndNot (NS n) (NS m) = NS (n `and#` not# m)
naturalAndNot (NS n) (NB m) = NS (n `and#` not# (bigNatToWord# m))
naturalAndNot (NB n) (NS m) = NS (bigNatToWord# n `and#` not# m)
naturalAndNot (NB n) (NB m) = naturalFromBigNat# (bigNatAndNot n m)
naturalOr :: Natural -> Natural -> Natural
naturalOr (NS n) (NS m) = NS (n `or#` m)
naturalOr (NS n) (NB m) = NB (bigNatOrWord# m n)
naturalOr (NB n) (NS m) = NB (bigNatOrWord# n m)
naturalOr (NB n) (NB m) = NB (bigNatOr n m)
naturalXor :: Natural -> Natural -> Natural
naturalXor (NS n) (NS m) = NS (n `xor#` m)
naturalXor (NS n) (NB m) = NB (bigNatXorWord# m n)
naturalXor (NB n) (NS m) = NB (bigNatXorWord# n m)
naturalXor (NB n) (NB m) = naturalFromBigNat# (bigNatXor n m)
naturalTestBit# :: Natural -> Word# -> Bool#
naturalTestBit# (NS w) i = (i `ltWord#` WORD_SIZE_IN_BITS##) &&#
((w `and#` (1## `uncheckedShiftL#` word2Int# i)) `neWord#` 0##)
naturalTestBit# (NB bn) i = bigNatTestBit# bn i
naturalTestBit :: Natural -> Word -> Bool
naturalTestBit !n (W# i) = isTrue# (naturalTestBit# n i)
naturalBit# :: Word# -> Natural
naturalBit# i
| isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) = NS (1## `uncheckedShiftL#` word2Int# i)
| True = NB (bigNatBit# i)
naturalBit :: Word -> Natural
naturalBit (W# i) = naturalBit# i
naturalGcd :: Natural -> Natural -> Natural
naturalGcd (NS 0##) !y = y
naturalGcd x (NS 0##) = x
naturalGcd (NS 1##) _ = NS 1##
naturalGcd _ (NS 1##) = NS 1##
naturalGcd (NB x) (NB y) = naturalFromBigNat# (bigNatGcd x y)
naturalGcd (NB x) (NS y) = NS (bigNatGcdWord# x y)
naturalGcd (NS x) (NB y) = NS (bigNatGcdWord# y x)
naturalGcd (NS x) (NS y) = NS (gcdWord# x y)
naturalLcm :: Natural -> Natural -> Natural
naturalLcm (NS 0##) !_ = NS 0##
naturalLcm _ (NS 0##) = NS 0##
naturalLcm (NS 1##) y = y
naturalLcm x (NS 1##) = x
naturalLcm (NS a ) (NS b ) = naturalFromBigNat# (bigNatLcmWordWord# a b)
naturalLcm (NB a ) (NS b ) = naturalFromBigNat# (bigNatLcmWord# a b)
naturalLcm (NS a ) (NB b ) = naturalFromBigNat# (bigNatLcmWord# b a)
naturalLcm (NB a ) (NB b ) = naturalFromBigNat# (bigNatLcm a b)
naturalLog2# :: Natural -> Word#
naturalLog2# (NS w) = wordLog2# w
naturalLog2# (NB b) = bigNatLog2# b
naturalLog2 :: Natural -> Word
naturalLog2 !n = W# (naturalLog2# n)
naturalLogBaseWord# :: Word# -> Natural -> Word#
naturalLogBaseWord# base (NS a) = wordLogBase# base a
naturalLogBaseWord# base (NB a) = bigNatLogBaseWord# base a
naturalLogBaseWord :: Word -> Natural -> Word
naturalLogBaseWord (W# base) !a = W# (naturalLogBaseWord# base a)
naturalLogBase# :: Natural -> Natural -> Word#
naturalLogBase# (NS base) !a = naturalLogBaseWord# base a
naturalLogBase# (NB _ ) (NS _) = 0##
naturalLogBase# (NB base) (NB a) = bigNatLogBase# base a
naturalLogBase :: Natural -> Natural -> Word
naturalLogBase !base !a = W# (naturalLogBase# base a)
naturalPowMod :: Natural -> Natural -> Natural -> Natural
naturalPowMod !_ !_ (NS 0##) = raiseDivZero
naturalPowMod _ _ (NS 1##) = NS 0##
naturalPowMod _ (NS 0##) _ = NS 1##
naturalPowMod (NS 0##) _ _ = NS 0##
naturalPowMod (NS 1##) _ _ = NS 1##
naturalPowMod (NS b) (NS e) (NS m) = NS (powModWord# b e m)
naturalPowMod b e (NS m) = NS (bigNatPowModWord#
(naturalToBigNat# b)
(naturalToBigNat# e)
m)
naturalPowMod b e (NB m) = naturalFromBigNat#
(bigNatPowMod (naturalToBigNat# b)
(naturalToBigNat# e)
m)
naturalSizeInBase# :: Word# -> Natural -> Word#
naturalSizeInBase# base (NS w) = wordSizeInBase# base w
naturalSizeInBase# base (NB n) = bigNatSizeInBase# base n
naturalToAddr# :: Natural -> Addr# -> Bool# -> State# s -> (# State# s, Word# #)
naturalToAddr# (NS i) = wordToAddr# i
naturalToAddr# (NB n) = bigNatToAddr# n
naturalToAddr :: Natural -> Addr# -> Bool# -> IO Word
naturalToAddr a addr e = IO \s -> case naturalToAddr# a addr e s of
(# s', w #) -> (# s', W# w #)
naturalFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Natural #)
naturalFromAddr# sz addr e s =
case bigNatFromAddr# sz addr e s of
(# s', n #) -> (# s', naturalFromBigNat# n #)
naturalFromAddr :: Word# -> Addr# -> Bool# -> IO Natural
naturalFromAddr sz addr e = IO (naturalFromAddr# sz addr e)
naturalToMutableByteArray# :: Natural -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #)
naturalToMutableByteArray# (NS w) = wordToMutableByteArray# w
naturalToMutableByteArray# (NB a) = bigNatToMutableByteArray# a
naturalFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, Natural #)
naturalFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of
(# s', a #) -> (# s', naturalFromBigNat# a #)