module GHC.Num.BigNat 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.WordArray
import GHC.Num.Backend
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
#endif
default ()
type BigNat# = WordArray#
data BigNat = BN# { unBigNat :: BigNat# }
bigNatCheck# :: BigNat# -> Bool#
bigNatCheck# bn
| 0# <- bigNatSize# bn = 1#
| r <- remInt# (sizeofByteArray# bn) WORD_SIZE_IN_BYTES#
, isTrue# (r /=# 0#) = 0#
| 0## <- bigNatIndex# bn (bigNatSize# bn -# 1#) = 0#
| True = 1#
bigNatCheck :: BigNat# -> Bool
bigNatCheck bn = isTrue# (bigNatCheck# bn)
bigNatSize :: BigNat# -> Word
bigNatSize bn = W# (int2Word# (bigNatSize# bn))
bigNatSize# :: BigNat# -> Int#
bigNatSize# ba = wordArraySize# ba
bigNatZero :: BigNat
bigNatZero = BN# (withNewWordArray# 0# (\_ s -> s))
bigNatOne :: BigNat
bigNatOne = BN# (bigNatFromWord# 1##)
bigNatZero# :: (# #) -> BigNat#
bigNatZero# _ = case bigNatZero of
BN# w -> w
bigNatOne# :: (# #) -> BigNat#
bigNatOne# _ = case bigNatOne of
BN# w -> w
raiseDivZero_BigNat :: (# #) -> BigNat#
raiseDivZero_BigNat _ = case raiseDivZero of
!_ -> bigNatZero# (# #)
bigNatIsZero :: BigNat# -> Bool
bigNatIsZero bn = isTrue# (bigNatIsZero# bn)
bigNatIsZero# :: BigNat# -> Bool#
bigNatIsZero# ba = wordArraySize# ba ==# 0#
bigNatIsOne :: BigNat# -> Bool
bigNatIsOne bn = isTrue# (bigNatIsOne# bn)
bigNatIsOne# :: BigNat# -> Bool#
bigNatIsOne# ba =
wordArraySize# ba ==# 1#
&&# indexWordArray# ba 0# `eqWord#` 1##
bigNatIsTwo :: BigNat# -> Bool
bigNatIsTwo bn = isTrue# (bigNatIsTwo# bn)
bigNatIsTwo# :: BigNat# -> Bool#
bigNatIsTwo# ba =
wordArraySize# ba ==# 1#
&&# indexWordArray# ba 0# `eqWord#` 2##
bigNatIsPowerOf2# :: BigNat# -> (# (# #) | Word# #)
bigNatIsPowerOf2# a
| bigNatIsZero a = (# (# #) | #)
| True = case wordIsPowerOf2# msw of
(# (# #) | #) -> (# (# #) | #)
(# | c #) -> case checkAllZeroes (imax -# 1#) of
0# -> (# (# #) | #)
_ -> (# | c `plusWord#`
(int2Word# imax `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#) #)
where
msw = bigNatIndex# a imax
sz = bigNatSize# a
imax = sz -# 1#
checkAllZeroes i
| isTrue# (i <# 0#) = 1#
| True = case bigNatIndex# a i of
0## -> checkAllZeroes (i -# 1#)
_ -> 0#
bigNatIndex# :: BigNat# -> Int# -> Word#
bigNatIndex# x i = indexWordArray# x i
bigNatIndex :: BigNat# -> Int# -> Word
bigNatIndex bn i = W# (bigNatIndex# bn i)
bigNatFromWord :: Word -> BigNat#
bigNatFromWord (W# w) = bigNatFromWord# w
bigNatFromWord# :: Word# -> BigNat#
bigNatFromWord# 0## = bigNatZero# (# #)
bigNatFromWord# w = wordArrayFromWord# w
bigNatFromWordList :: [Word] -> BigNat#
bigNatFromWordList (W# 0##:xs) = bigNatFromWordList xs
bigNatFromWordList xs = bigNatFromWordListUnsafe xs
bigNatFromWordList# :: [Word] -> WordArray#
bigNatFromWordList# xs = bigNatFromWordList xs
bigNatFromAbsInt# :: Int# -> BigNat#
bigNatFromAbsInt# i = bigNatFromWord# (wordFromAbsInt# i)
bigNatFromWordListUnsafe :: [Word] -> BigNat#
bigNatFromWordListUnsafe [] = bigNatZero# (# #)
bigNatFromWordListUnsafe xs =
let
length i [] = i
length i (_:ys) = length (i +# 1#) ys
!lxs = length 0# xs
writeWordList _mwa _i [] s = s
writeWordList mwa i (W# w:ws) s =
case mwaWrite# mwa i w s of
s1 -> writeWordList mwa (i -# 1#) ws s1
in withNewWordArray# lxs \mwa ->
writeWordList mwa (lxs -# 1#) xs
bigNatToWordList :: BigNat# -> [Word]
bigNatToWordList bn = go (bigNatSize# bn)
where
go 0# = []
go n = bigNatIndex bn (n -# 1#) : go (n -# 1#)
bigNatFromWord2# :: Word# -> Word# -> BigNat#
bigNatFromWord2# 0## 0## = bigNatZero# (# #)
bigNatFromWord2# 0## l = bigNatFromWord# l
bigNatFromWord2# h l = wordArrayFromWord2# h l
bigNatToWord# :: BigNat# -> Word#
bigNatToWord# a
| bigNatIsZero a = 0##
| True = bigNatIndex# a 0#
bigNatToWordMaybe# :: BigNat# -> (# (# #) | Word# #)
bigNatToWordMaybe# a
| bigNatIsZero a = (# | 0## #)
| isTrue# (bigNatSize# a ># 1#) = (# (# #) | #)
| True = (# | bigNatIndex# a 0# #)
bigNatToWord :: BigNat# -> Word
bigNatToWord bn = W# (bigNatToWord# bn)
bigNatToInt# :: BigNat# -> Int#
bigNatToInt# a
| bigNatIsZero a = 0#
| True = indexIntArray# a 0#
bigNatToInt :: BigNat# -> Int
bigNatToInt bn = I# (bigNatToInt# bn)
#if WORD_SIZE_IN_BITS == 32
bigNatFromWord64# :: Word64# -> BigNat#
bigNatFromWord64# w64 = bigNatFromWord2# wh# wl#
where
wh# = word64ToWord# (uncheckedShiftRL64# w64 32#)
wl# = word64ToWord# w64
bigNatToWord64# :: BigNat# -> Word64#
bigNatToWord64# b
| bigNatIsZero b = wordToWord64# 0##
| wl <- wordToWord64# (bigNatToWord# b)
= if isTrue# (bigNatSize# b ># 1#)
then
let wh = wordToWord64# (bigNatIndex# b 1#)
in uncheckedShiftL64# wh 32# `or64#` wl
else wl
#endif
bigNatEncodeDouble# :: BigNat# -> Int# -> Double#
bigNatEncodeDouble# a e
| bigNatIsZero a
= word2Double# 0##
| True
= inline bignat_encode_double a e
bigNatGtWord# :: BigNat# -> Word# -> Bool#
bigNatGtWord# bn w =
notB# (bigNatIsZero# bn)
&&# ( bigNatSize# bn ># 1#
||# bigNatIndex# bn 0# `gtWord#` w
)
bigNatEqWord# :: BigNat# -> Word# -> Bool#
bigNatEqWord# bn w
| 0## <- w
= bigNatIsZero# bn
| isTrue# (bigNatSize# bn ==# 1#)
= bigNatIndex# bn 0# `eqWord#` w
| True
= 0#
bigNatGtWord :: BigNat# -> Word -> Bool
bigNatGtWord bn (W# w) = isTrue# (bigNatGtWord# bn w)
bigNatLeWord# :: BigNat# -> Word# -> Bool#
bigNatLeWord# bn w = notB# (bigNatGtWord# bn w)
bigNatLeWord :: BigNat# -> Word -> Bool
bigNatLeWord bn (W# w) = isTrue# (bigNatLeWord# bn w)
bigNatEq# :: BigNat# -> BigNat# -> Bool#
bigNatEq# wa wb
| isTrue# (wordArraySize# wa /=# wordArraySize# wb) = 0#
| isTrue# (wordArraySize# wa ==# 0#) = 1#
| True = inline bignat_compare wa wb ==# 0#
bigNatEq :: BigNat# -> BigNat# -> Bool
bigNatEq a b = isTrue# (bigNatEq# a b)
bigNatNe# :: BigNat# -> BigNat# -> Bool#
bigNatNe# a b = notB# (bigNatEq# a b)
bigNatNe :: BigNat# -> BigNat# -> Bool
bigNatNe a b = isTrue# (bigNatNe# a b)
bigNatCompareWord# :: BigNat# -> Word# -> Ordering
bigNatCompareWord# a b
| bigNatIsZero a = cmpW# 0## b
| isTrue# (wordArraySize# a ># 1#) = GT
| True
= cmpW# (indexWordArray# a 0#) b
bigNatCompareWord :: BigNat# -> Word -> Ordering
bigNatCompareWord a (W# b) = bigNatCompareWord# a b
bigNatCompare :: BigNat# -> BigNat# -> Ordering
bigNatCompare a b =
let
szA = wordArraySize# a
szB = wordArraySize# b
in if
| isTrue# (szA ># szB) -> GT
| isTrue# (szA <# szB) -> LT
| isTrue# (szA ==# 0#) -> EQ
| True -> compareInt# (inline bignat_compare a b) 0#
bigNatLt# :: BigNat# -> BigNat# -> Bool#
bigNatLt# a b
| LT <- bigNatCompare a b = 1#
| True = 0#
bigNatLt :: BigNat# -> BigNat# -> Bool
bigNatLt a b = isTrue# (bigNatLt# a b)
bigNatLe# :: BigNat# -> BigNat# -> Bool#
bigNatLe# a b
| GT <- bigNatCompare a b = 0#
| True = 1#
bigNatLe :: BigNat# -> BigNat# -> Bool
bigNatLe a b = isTrue# (bigNatLe# a b)
bigNatGt# :: BigNat# -> BigNat# -> Bool#
bigNatGt# a b
| GT <- bigNatCompare a b = 1#
| True = 0#
bigNatGt :: BigNat# -> BigNat# -> Bool
bigNatGt a b = isTrue# (bigNatGt# a b)
bigNatGe# :: BigNat# -> BigNat# -> Bool#
bigNatGe# a b
| LT <- bigNatCompare a b = 0#
| True = 1#
bigNatGe :: BigNat# -> BigNat# -> Bool
bigNatGe a b = isTrue# (bigNatGe# a b)
bigNatAddWord# :: BigNat# -> Word# -> BigNat#
bigNatAddWord# a b
| 0## <- b
= a
| bigNatIsZero a
= bigNatFromWord# b
| True
= withNewWordArrayTrimed# (wordArraySize# a +# 1#) \mwa s ->
inline bignat_add_word mwa a b s
bigNatAddWord :: BigNat# -> Word -> BigNat#
bigNatAddWord a (W# b) = bigNatAddWord# a b
bigNatAdd :: BigNat# -> BigNat# -> BigNat#
bigNatAdd a b
| bigNatIsZero a = b
| bigNatIsZero b = a
| True =
let
!szA = wordArraySize# a
!szB = wordArraySize# b
!szMax = maxI# szA szB
!sz = szMax +# 1#
in withNewWordArrayTrimed# sz \mwa s ->
inline bignat_add mwa a b s
bigNatMulWord# :: BigNat# -> Word# -> BigNat#
bigNatMulWord# a w
| 0## <- w = bigNatZero# (# #)
| 1## <- w = a
| bigNatIsZero a = bigNatZero# (# #)
| bigNatIsOne a = bigNatFromWord# w
| isTrue# (bigNatSize# a ==# 1#)
= case timesWord2# (bigNatIndex# a 0#) w of
(# h, l #) -> bigNatFromWord2# h l
| True = withNewWordArrayTrimed# (bigNatSize# a +# 1#) \mwa s ->
inline bignat_mul_word mwa a w s
bigNatMulWord :: BigNat# -> Word -> BigNat#
bigNatMulWord a (W# w) = bigNatMulWord# a w
bigNatSqr :: BigNat# -> BigNat#
bigNatSqr a = bigNatMul a a
bigNatMul :: BigNat# -> BigNat# -> BigNat#
bigNatMul a b
| bigNatSize b > bigNatSize a = bigNatMul b a
| bigNatIsZero a = a
| bigNatIsZero b = b
| bigNatIsOne a = b
| bigNatIsOne b = a
| True =
let
!szA = wordArraySize# a
!szB = wordArraySize# b
!sz = szA +# szB
in withNewWordArrayTrimed# sz \mwa s->
inline bignat_mul mwa a b s
bigNatSubWordUnsafe# :: BigNat# -> Word# -> BigNat#
bigNatSubWordUnsafe# x y
| 0## <- y = x
| True = withNewWordArrayTrimed# sz \mwa -> go mwa y 0#
where
!sz = wordArraySize# x
go mwa carry i s
| isTrue# (i >=# sz)
= s
| 0## <- carry
= mwaArrayCopy# mwa i x i (sz -# i) s
| True
= case subWordC# (indexWordArray# x i) carry of
(# l, c #) -> case mwaWrite# mwa i l s of
s1 -> go mwa (int2Word# c) (i +# 1#) s1
bigNatSubWordUnsafe :: BigNat# -> Word -> BigNat#
bigNatSubWordUnsafe x (W# y) = bigNatSubWordUnsafe# x y
bigNatSubWord# :: BigNat# -> Word# -> (# (# #) | BigNat# #)
bigNatSubWord# a b
| 0## <- b = (# | a #)
| bigNatIsZero a = (# (# #) | #)
| True
= withNewWordArrayTrimedMaybe# (bigNatSize# a) \mwa s ->
inline bignat_sub_word mwa a b s
bigNatSubUnsafe :: BigNat# -> BigNat# -> BigNat#
bigNatSubUnsafe a b
| bigNatIsZero b = a
| True =
let szA = wordArraySize# a
in withNewWordArrayTrimed# szA \mwa s->
case inline bignat_sub mwa a b s of
(# s', 1# #) -> s'
(# s', _ #) -> case raiseUnderflow of
!_ -> s'
bigNatSub :: BigNat# -> BigNat# -> (# (# #) | BigNat# #)
bigNatSub a b
| bigNatIsZero b = (# | a #)
| isTrue# (bigNatSize# a <# bigNatSize# b)
= (# (# #) | #)
| True
= withNewWordArrayTrimedMaybe# (bigNatSize# a) \mwa s ->
inline bignat_sub mwa a b s
bigNatQuotWord# :: BigNat# -> Word# -> BigNat#
bigNatQuotWord# a b
| 1## <- b = a
| 0## <- b = raiseDivZero_BigNat (# #)
| True =
let
sz = wordArraySize# a
in withNewWordArrayTrimed# sz \mwq s ->
inline bignat_quot_word mwq a b s
bigNatQuotWord :: BigNat# -> Word -> BigNat#
bigNatQuotWord a (W# b) = bigNatQuotWord# a b
bigNatRemWord# :: BigNat# -> Word# -> Word#
bigNatRemWord# a b
| 0## <- b = raiseDivZero_Word# (# #)
| 1## <- b = 0##
| bigNatIsZero a = 0##
| True = inline bignat_rem_word a b
bigNatRemWord :: BigNat# -> Word -> Word
bigNatRemWord a (W# b) = W# (bigNatRemWord# a b)
bigNatQuotRemWord# :: BigNat# -> Word# -> (# BigNat#, Word# #)
bigNatQuotRemWord# a b
| 0## <- b = case raiseDivZero of
!_ -> (# bigNatZero# (# #), 0## #)
| 1## <- b = (# a, 0## #)
| isTrue# (bigNatSize# a ==# 1#)
, a0 <- indexWordArray# a 0#
= case compareWord# a0 b of
LT -> (# bigNatZero# (# #), a0 #)
EQ -> (# bigNatOne# (# #), 0## #)
GT -> case quotRemWord# a0 b of
(# q, r #) -> (# bigNatFromWord# q, r #)
| True =
let
sz = wordArraySize# a
io s =
case newWordArray# sz s of { (# s1, mwq #) ->
case inline bignat_quotrem_word mwq a b s1 of { (# s2, r #) ->
case mwaTrimZeroes# mwq s2 of { s3 ->
case unsafeFreezeByteArray# mwq s3 of { (# s4, wq #) ->
(# s4, (# wq, r #) #)
}}}}
in case runRW# io of
(# _, (# wq,r #) #) -> (# wq, r #)
bigNatQuotRem# :: BigNat# -> BigNat# -> (# BigNat#, BigNat# #)
bigNatQuotRem# a b
| bigNatIsZero b = case raiseDivZero of
!_ -> (# bigNatZero# (# #), bigNatZero# (# #) #)
| bigNatIsZero a = (# bigNatZero# (# #), bigNatZero# (# #) #)
| bigNatIsOne b = (# a , bigNatZero# (# #) #)
| LT <- cmp = (# bigNatZero# (# #), a #)
| EQ <- cmp = (# bigNatOne# (# #), bigNatZero# (# #) #)
| isTrue# (szB ==# 1#) = case bigNatQuotRemWord# a (bigNatIndex# b 0#) of
(# q, r #) -> (# q, bigNatFromWord# r #)
| True = withNewWordArray2Trimed# szQ szR \mwq mwr s ->
inline bignat_quotrem mwq mwr a b s
where
cmp = bigNatCompare a b
szA = wordArraySize# a
szB = wordArraySize# b
szQ = 1# +# szA -# szB
szR = szB
bigNatQuot :: BigNat# -> BigNat# -> BigNat#
bigNatQuot a b
| bigNatIsZero b = raiseDivZero_BigNat (# #)
| bigNatIsZero a = bigNatZero# (# #)
| bigNatIsOne b = a
| LT <- cmp = bigNatZero# (# #)
| EQ <- cmp = bigNatOne# (# #)
| isTrue# (szB ==# 1#) = bigNatQuotWord# a (bigNatIndex# b 0#)
| True = withNewWordArrayTrimed# szQ \mwq s ->
inline bignat_quot mwq a b s
where
cmp = bigNatCompare a b
szA = wordArraySize# a
szB = wordArraySize# b
szQ = 1# +# szA -# szB
bigNatRem :: BigNat# -> BigNat# -> BigNat#
bigNatRem a b
| bigNatIsZero b = raiseDivZero_BigNat (# #)
| bigNatIsZero a = bigNatZero# (# #)
| bigNatIsOne b = bigNatZero# (# #)
| LT <- cmp = a
| EQ <- cmp = bigNatZero# (# #)
| isTrue# (szB ==# 1#) = case bigNatRemWord# a (bigNatIndex# b 0#) of
r -> bigNatFromWord# r
| True = withNewWordArrayTrimed# szR \mwr s ->
inline bignat_rem mwr a b s
where
cmp = bigNatCompare a b
szB = wordArraySize# b
szR = szB
gcdWord# :: Word# -> Word# -> Word#
gcdWord# = bignat_gcd_word_word
gcdWord :: Word -> Word -> Word
gcdWord (W# x) (W# y) = W# (gcdWord# x y)
gcdInt# :: Int# -> Int# -> Int#
gcdInt# x y = word2Int# (gcdWord# (wordFromAbsInt# x) (wordFromAbsInt# y))
gcdInt :: Int -> Int -> Int
gcdInt (I# x) (I# y) = I# (gcdInt# x y)
bigNatGcd :: BigNat# -> BigNat# -> BigNat#
bigNatGcd a b
| bigNatIsZero a = b
| bigNatIsZero b = a
| bigNatIsOne a = a
| bigNatIsOne b = b
| True
= case (# bigNatSize# a, bigNatSize# b #) of
(# 1#, 1# #) -> bigNatFromWord# (gcdWord# (bigNatIndex# a 0#)
(bigNatIndex# b 0#))
(# 1#, _ #) -> bigNatFromWord# (bigNatGcdWord# b (bigNatIndex# a 0#))
(# _ , 1# #) -> bigNatFromWord# (bigNatGcdWord# a (bigNatIndex# b 0#))
_ ->
let
go wx wy =
withNewWordArrayTrimed# (wordArraySize# wy) \mwr s ->
bignat_gcd mwr wx wy s
in case bigNatCompare a b of
EQ -> a
LT -> go b a
GT -> go a b
bigNatGcdWord# :: BigNat# -> Word# -> Word#
bigNatGcdWord# a b
| bigNatIsZero a = 0##
| 0## <- b = 0##
| bigNatIsOne a = 1##
| 1## <- b = 1##
| True = case bigNatCompareWord# a b of
EQ -> b
_ -> bignat_gcd_word a b
bigNatLcm :: BigNat# -> BigNat# -> BigNat#
bigNatLcm a b
| bigNatIsZero a = bigNatZero# (# #)
| bigNatIsZero b = bigNatZero# (# #)
| bigNatIsOne a = b
| bigNatIsOne b = a
| True
= case (# bigNatSize# a, bigNatSize# b #) of
(# 1#, 1# #) -> bigNatLcmWordWord# (bigNatIndex# a 0#) (bigNatIndex# b 0#)
(# 1#, _ #) -> bigNatLcmWord# b (bigNatIndex# a 0#)
(# _ , 1# #) -> bigNatLcmWord# a (bigNatIndex# b 0#)
_ -> (a `bigNatQuot` (a `bigNatGcd` b)) `bigNatMul` b
bigNatLcmWord# :: BigNat# -> Word# -> BigNat#
bigNatLcmWord# a b
| bigNatIsZero a = bigNatZero# (# #)
| 0## <- b = bigNatZero# (# #)
| bigNatIsOne a = bigNatFromWord# b
| 1## <- b = a
| 1# <- bigNatSize# a = bigNatLcmWordWord# (bigNatIndex# a 0#) b
| True
= (a `bigNatQuotWord#` (a `bigNatGcdWord#` b)) `bigNatMulWord#` b
bigNatLcmWordWord# :: Word# -> Word# -> BigNat#
bigNatLcmWordWord# a b
| 0## <- a = bigNatZero# (# #)
| 0## <- b = bigNatZero# (# #)
| 1## <- a = bigNatFromWord# b
| 1## <- b = bigNatFromWord# a
| True = case (a `quotWord#` (a `gcdWord#` b)) `timesWord2#` b of
(# h, l #) -> bigNatFromWord2# h l
bigNatOr :: BigNat# -> BigNat# -> BigNat#
bigNatOr a b
| bigNatIsZero a = b
| bigNatIsZero b = a
| True = withNewWordArray# sz \mwa s ->
inline bignat_or mwa a b s
where
!szA = wordArraySize# a
!szB = wordArraySize# b
!sz = maxI# szA szB
bigNatOrWord# :: BigNat# -> Word# -> BigNat#
bigNatOrWord# a b
| bigNatIsZero a = bigNatFromWord# b
| 0## <- b = a
| True =
let sz = wordArraySize# a
in withNewWordArray# sz \mwa s ->
case mwaArrayCopy# mwa 1# a 1# (sz -# 1#) s of
s' -> mwaWrite# mwa 0# (indexWordArray# a 0# `or#` b) s'
bigNatAnd :: BigNat# -> BigNat# -> BigNat#
bigNatAnd a b
| bigNatIsZero a = a
| bigNatIsZero b = b
| True = withNewWordArrayTrimed# sz \mwa s ->
inline bignat_and mwa a b s
where
!szA = wordArraySize# a
!szB = wordArraySize# b
!sz = minI# szA szB
bigNatAndNot :: BigNat# -> BigNat# -> BigNat#
bigNatAndNot a b
| bigNatIsZero a = a
| bigNatIsZero b = a
| True = withNewWordArrayTrimed# szA \mwa s ->
inline bignat_and_not mwa a b s
where
!szA = wordArraySize# a
bigNatAndWord# :: BigNat# -> Word# -> BigNat#
bigNatAndWord# a b
| bigNatIsZero a = a
| True = bigNatFromWord# (indexWordArray# a 0# `and#` b)
bigNatAndNotWord# :: BigNat# -> Word# -> BigNat#
bigNatAndNotWord# a b
| bigNatIsZero a = a
| szA <- bigNatSize# a
= withNewWordArray# szA \mwa s ->
case mwaArrayCopy# mwa 1# a 1# (szA -# 1#) s of
s' -> writeWordArray# mwa 0#
(indexWordArray# a 0# `and#` not# b) s'
bigNatAndInt# :: BigNat# -> Int# -> BigNat#
bigNatAndInt# a b
| bigNatIsZero a = a
| isTrue# (b >=# 0#) = bigNatAndWord# a (int2Word# b)
| szA <- bigNatSize# a
= withNewWordArray# szA \mwa s ->
case mwaArrayCopy# mwa 1# a 1# (szA -# 1#) s of
s' -> writeWordArray# mwa 0#
(indexWordArray# a 0# `and#` int2Word# b) s'
bigNatXor :: BigNat# -> BigNat# -> BigNat#
bigNatXor a b
| bigNatIsZero a = b
| bigNatIsZero b = a
| True = withNewWordArrayTrimed# sz \mwa s ->
inline bignat_xor mwa a b s
where
!szA = wordArraySize# a
!szB = wordArraySize# b
!sz = maxI# szA szB
bigNatXorWord# :: BigNat# -> Word# -> BigNat#
bigNatXorWord# a b
| bigNatIsZero a = bigNatFromWord# b
| 0## <- b = a
| True =
let
sz = wordArraySize# a
in withNewWordArray# sz \mwa s ->
case mwaArrayCopy# mwa 1# a 1# (sz -# 1#) s of
s' -> mwaWrite# mwa 0# (indexWordArray# a 0# `xor#` b) s'
bigNatPopCount :: BigNat# -> Word
bigNatPopCount a = W# (bigNatPopCount# a)
bigNatPopCount# :: BigNat# -> Word#
bigNatPopCount# a
| bigNatIsZero a = 0##
| True = inline bignat_popcount a
bigNatShiftR# :: BigNat# -> Word# -> BigNat#
bigNatShiftR# a n
| 0## <- n
= a
| isTrue# (wordArraySize# a ==# 0#)
= a
| nw <- word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
, isTrue# (nw >=# wordArraySize# a)
= bigNatZero# (# #)
| True
= let
!szA = wordArraySize# a
!nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
!sz = szA -# nw
in withNewWordArrayTrimed# sz \mwa s ->
inline bignat_shiftr mwa a n s
bigNatShiftRNeg# :: BigNat# -> Word# -> BigNat#
bigNatShiftRNeg# a n
| 0## <- n
= a
| isTrue# (wordArraySize# a ==# 0#)
= a
| nw <- word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
, isTrue# (nw >=# wordArraySize# a)
= bigNatZero# (# #)
| True
= let
!szA = wordArraySize# a
!nw = (word2Int# n -# 1#) `uncheckedIShiftRL#` WORD_SIZE_BITS_SHIFT#
!sz = szA -# nw
in withNewWordArrayTrimed# sz \mwa s ->
inline bignat_shiftr_neg mwa a n s
bigNatShiftR :: BigNat# -> Word -> BigNat#
bigNatShiftR a (W# n) = bigNatShiftR# a n
bigNatShiftL :: BigNat# -> Word -> BigNat#
bigNatShiftL a (W# n) = bigNatShiftL# a n
bigNatShiftL# :: BigNat# -> Word# -> BigNat#
bigNatShiftL# a n
| 0## <- n
= a
| isTrue# (wordArraySize# a ==# 0#)
= a
| True
= let
!szA = wordArraySize# a
!nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
!nb = word2Int# (n `and#` WORD_SIZE_BITS_MASK##)
!sz = szA +# nw +# (nb /=# 0#)
in withNewWordArrayTrimed# sz \mwa s ->
inline bignat_shiftl mwa a n s
bigNatTestBit# :: BigNat# -> Word# -> Bool#
bigNatTestBit# a n =
let
!sz = wordArraySize# a
!nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
!nb = n `and#` WORD_SIZE_BITS_MASK##
in if
| isTrue# (nw >=# sz) -> 0#
| True -> testBitW# (indexWordArray# a nw) nb
bigNatTestBit :: BigNat# -> Word -> Bool
bigNatTestBit a (W# n) = isTrue# (bigNatTestBit# a n)
bigNatBit# :: Word# -> BigNat#
bigNatBit# i
| 0## <- i = bigNatOne# (# #)
| True =
let
!nw = word2Int# (i `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
!nb = word2Int# (i `and#` WORD_SIZE_BITS_MASK##)
!sz = nw +# 1#
!v = 1## `uncheckedShiftL#` nb
in withNewWordArray# sz \mwa s ->
case mwaFill# mwa 0## 0## (int2Word# sz) s of
s2 -> mwaWrite# mwa (sz -# 1#) v s2
bigNatBit :: Word -> BigNat#
bigNatBit (W# i) = bigNatBit# i
bigNatClearBit# :: BigNat# -> Word# -> BigNat#
bigNatClearBit# a n
| isTrue# (bigNatTestBit# a n ==# 0#) = a
| True
= let
!sz = wordArraySize# a
!nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
!nb = word2Int# (n `and#` WORD_SIZE_BITS_MASK##)
!nv = bigNatIndex# a nw `xor#` bitW# nb
in if
| isTrue# (sz ==# 1#)
-> bigNatFromWord# nv
| 0## <- nv
, isTrue# (nw +# 1# ==# sz)
-> case sz -# (waClzAt a (sz -# 2#) +# 1#) of
0# -> bigNatZero# (# #)
nsz -> withNewWordArray# nsz \mwa s ->
mwaArrayCopy# mwa 0# a 0# nsz s
| True ->
withNewWordArray# sz \mwa s ->
case mwaArrayCopy# mwa 0# a 0# sz s of
s' -> writeWordArray# mwa nw nv s'
bigNatSetBit# :: BigNat# -> Word# -> BigNat#
bigNatSetBit# a n
| isTrue# (bigNatTestBit# a n) = a
| True
= let
!sz = wordArraySize# a
!nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#)
!nb = word2Int# (n `and#` WORD_SIZE_BITS_MASK##)
d = nw +# 1# -# sz
in if
| isTrue# (d ># 0#)
-> withNewWordArray# (nw +# 1#) \mwa s ->
case mwaArrayCopy# mwa 0# a 0# sz s of
s' -> case mwaFill# mwa 0## (int2Word# sz) (int2Word# (d -# 1#)) s' of
s'' -> writeWordArray# mwa nw (bitW# nb) s''
| nv <- bigNatIndex# a nw `or#` bitW# nb
-> withNewWordArray# sz \mwa s ->
case mwaArrayCopy# mwa 0# a 0# sz s of
s' -> writeWordArray# mwa nw nv s'
bigNatComplementBit# :: BigNat# -> Word# -> BigNat#
bigNatComplementBit# bn i
| isTrue# (bigNatTestBit# bn i) = bigNatClearBit# bn i
| True = bigNatSetBit# bn i
bigNatLog2# :: BigNat# -> Word#
bigNatLog2# a
| bigNatIsZero a = 0##
| True =
let i = int2Word# (bigNatSize# a) `minusWord#` 1##
in wordLog2# (bigNatIndex# a (word2Int# i))
`plusWord#` (i `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#)
bigNatLog2 :: BigNat# -> Word
bigNatLog2 a = W# (bigNatLog2# a)
bigNatLogBase# :: BigNat# -> BigNat# -> Word#
bigNatLogBase# base a
| bigNatIsZero base || bigNatIsOne base
= unexpectedValue_Word# (# #)
| 1# <- bigNatSize# base
, 2## <- bigNatIndex# base 0#
= bigNatLog2# a
| True
= case go base of (# _, e' #) -> e'
where
go pw = if a `bigNatLt` pw
then (# a, 0## #)
else case go (bigNatSqr pw) of
(# q, e #) -> if q `bigNatLt` pw
then (# q, 2## `timesWord#` e #)
else (# q `bigNatQuot` pw
, (2## `timesWord#` e) `plusWord#` 1## #)
bigNatLogBase :: BigNat# -> BigNat# -> Word
bigNatLogBase base a = W# (bigNatLogBase# base a)
bigNatLogBaseWord# :: Word# -> BigNat# -> Word#
bigNatLogBaseWord# base a
| 0## <- base = unexpectedValue_Word# (# #)
| 1## <- base = unexpectedValue_Word# (# #)
| 2## <- base = bigNatLog2# a
| True = bigNatLogBase# (bigNatFromWord# base) a
bigNatLogBaseWord :: Word -> BigNat# -> Word
bigNatLogBaseWord (W# base) a = W# (bigNatLogBaseWord# base a)
bigNatSizeInBase# :: Word# -> BigNat# -> Word#
bigNatSizeInBase# base a
| isTrue# (base `leWord#` 1##)
= unexpectedValue_Word# (# #)
| bigNatIsZero a
= 0##
| True
= bigNatLogBaseWord# base a `plusWord#` 1##
bigNatSizeInBase :: Word -> BigNat# -> Word
bigNatSizeInBase (W# w) a = W# (bigNatSizeInBase# w a)
powModWord# :: Word# -> Word# -> Word# -> Word#
powModWord# = bignat_powmod_words
bigNatPowModWord# :: BigNat# -> BigNat# -> Word# -> Word#
bigNatPowModWord# !_ !_ 0## = raiseDivZero_Word# (# #)
bigNatPowModWord# _ _ 1## = 0##
bigNatPowModWord# b e m
| bigNatIsZero e = 1##
| bigNatIsZero b = 0##
| bigNatIsOne b = 1##
| True = bignat_powmod_word b e m
bigNatPowMod :: BigNat# -> BigNat# -> BigNat# -> BigNat#
bigNatPowMod !b !e !m
| (# | m' #) <- bigNatToWordMaybe# m
= bigNatFromWord# (bigNatPowModWord# b e m')
| bigNatIsZero m = raiseDivZero_BigNat (# #)
| bigNatIsOne m = bigNatFromWord# 0##
| bigNatIsZero e = bigNatFromWord# 1##
| bigNatIsZero b = bigNatFromWord# 0##
| bigNatIsOne b = bigNatFromWord# 1##
| True = withNewWordArrayTrimed# (bigNatSize# m) \mwa s ->
inline bignat_powmod mwa b e m s
bigNatCtz# :: BigNat# -> Word#
bigNatCtz# a
| bigNatIsZero a = 0##
| True = go 0# 0##
where
go i c = case indexWordArray# a i of
0## -> go (i +# 1#) (c `plusWord#` WORD_SIZE_IN_BITS##)
w -> ctz# w `plusWord#` c
bigNatCtz :: BigNat# -> Word
bigNatCtz a = W# (bigNatCtz# a)
bigNatCtzWord# :: BigNat# -> Word#
bigNatCtzWord# a
| bigNatIsZero a = 0##
| True = go 0# 0##
where
go i c = case indexWordArray# a i of
0## -> go (i +# 1#) (c `plusWord#` 1##)
_ -> c
bigNatCtzWord :: BigNat# -> Word
bigNatCtzWord a = W# (bigNatCtzWord# a)
bigNatToAddrLE# :: BigNat# -> Addr# -> State# s -> (# State# s, Word# #)
bigNatToAddrLE# a addr s0
| isTrue# (sz ==# 0#) = (# s0, 0## #)
| True = case writeMSB s0 of
(# s1, k #) -> case go 0# s1 of
s2 -> (# s2, k `plusWord#` (int2Word# li `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #)
where
!sz = wordArraySize# a
!li = sz -# 1#
writeMSB = wordToAddrLE# (indexWordArray# a li)
(addr `plusAddr#` (li `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#))
go i s
| isTrue# (i <# li)
, off <- i `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#
, w <- indexWordArray# a i
= case wordWriteAddrLE# w (addr `plusAddr#` off) s of
s -> go (i +# 1#) s
| True
= s
bigNatToAddrBE# :: BigNat# -> Addr# -> State# s -> (# State# s, Word# #)
bigNatToAddrBE# a addr s0
| isTrue# (sz ==# 0#) = (# s0, 0## #)
| msw <- indexWordArray# a (sz -# 1#)
= case wordToAddrBE# msw addr s0 of
(# s1, k #) -> case go (sz -# 1#) (addr `plusAddr#` word2Int# k) s1 of
s2 -> (# s2, k `plusWord#` (int2Word# (sz -# 1#) `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #)
where
sz = wordArraySize# a
go i adr s
| 0# <- i
= s
| w <- indexWordArray# a (i -# 1#)
= case wordWriteAddrBE# w adr s of
s' -> go (i -# 1#)
(adr `plusAddr#` WORD_SIZE_IN_BYTES# ) s'
bigNatToAddr# :: BigNat# -> Addr# -> Bool# -> State# s -> (# State# s, Word# #)
bigNatToAddr# a addr 0# s = bigNatToAddrLE# a addr s
bigNatToAddr# a addr _ s = bigNatToAddrBE# a addr s
bigNatToAddr :: BigNat# -> Addr# -> Bool# -> IO Word
bigNatToAddr a addr e = IO \s -> case bigNatToAddr# a addr e s of
(# s', w #) -> (# s', W# w #)
bigNatFromAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat# #)
bigNatFromAddrLE# 0## _ s = (# s, bigNatZero# (# #) #)
bigNatFromAddrLE# sz addr s =
let
!nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#
!nb = sz `and#` WORD_SIZE_BYTES_MASK##
readMSB mwa s
| 0## <- nb
= s
| off <- word2Int# (nw `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#)
= case wordFromAddrLE# nb (addr `plusAddr#` off) s of
(# s, w #) -> mwaWrite# mwa (word2Int# nw) w s
go mwa i s
| isTrue# (i ==# word2Int# nw)
= s
| off <- i `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#
= case wordFromAddrLE# WORD_SIZE_IN_BYTES## (addr `plusAddr#` off) s of
(# s, w #) -> case mwaWrite# mwa i w s of
s -> go mwa (i +# 1#) s
in case newWordArray# (word2Int# nw +# (word2Int# nb /=# 0#)) s of
(# s, mwa #) -> case readMSB mwa s of
s -> case go mwa 0# s of
s -> case mwaTrimZeroes# mwa s of
s -> unsafeFreezeByteArray# mwa s
bigNatFromAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat# #)
bigNatFromAddrBE# 0## _ s = (# s, bigNatZero# (# #) #)
bigNatFromAddrBE# sz addr s =
let
!nw = word2Int# (sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#)
!nb = sz `and#` WORD_SIZE_BYTES_MASK##
goMSB mwa s
| 0## <- nb
= s
| True
= case wordFromAddrBE# nb addr s of
(# s, w #) -> mwaWrite# mwa nw w s
go mwa i s
| isTrue# (i ==# nw)
= s
| k <- nw -# 1# -# i
, off <- (k `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#) +# word2Int# nb
= case wordFromAddrBE# WORD_SIZE_IN_BYTES## (addr `plusAddr#` off) s of
(# s, w #) -> case mwaWrite# mwa i w s of
s -> go mwa (i +# 1#) s
in case newWordArray# (nw +# (word2Int# nb /=# 0#)) s of
(# s, mwa #) -> case goMSB mwa s of
s -> case go mwa 0# s of
s -> case mwaTrimZeroes# mwa s of
s -> unsafeFreezeByteArray# mwa s
bigNatFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, BigNat# #)
bigNatFromAddr# sz addr 0# s = bigNatFromAddrLE# sz addr s
bigNatFromAddr# sz addr _ s = bigNatFromAddrBE# sz addr s
bigNatToMutableByteArrayLE# :: BigNat# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #)
bigNatToMutableByteArrayLE# a mba moff s0
| isTrue# (sz ==# 0#) = (# s0, 0## #)
| True = case writeMSB s0 of
(# s1, k #) -> case go 0# s1 of
s2 -> (# s2, k `plusWord#` (int2Word# li `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #)
where
!sz = wordArraySize# a
!li = sz -# 1#
writeMSB = wordToMutableByteArrayLE# (indexWordArray# a li)
mba (moff `plusWord#` int2Word# (li `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#))
go i s
| isTrue# (i <# li)
, off <- int2Word# i `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#
, w <- indexWordArray# a i
= case wordWriteMutableByteArrayLE# w mba (moff `plusWord#` off) s of
s -> go (i +# 1#) s
| True
= s
bigNatToMutableByteArrayBE# :: BigNat# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #)
bigNatToMutableByteArrayBE# a mba moff s0
| isTrue# (sz ==# 0#) = (# s0, 0## #)
| msw <- indexWordArray# a (sz -# 1#)
= case wordToMutableByteArrayBE# msw mba moff s0 of
(# s1, k #) -> case go (sz -# 1#) k s1 of
s2 -> (# s2, k `plusWord#` (int2Word# (sz -# 1#) `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #)
where
sz = wordArraySize# a
go i c s
| 0# <- i
= s
| w <- indexWordArray# a (i -# 1#)
= case wordWriteMutableByteArrayBE# w mba (moff `plusWord#` c) s of
s' -> go (i -# 1#)
(c `plusWord#` WORD_SIZE_IN_BYTES## ) s'
bigNatToMutableByteArray# :: BigNat# -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #)
bigNatToMutableByteArray# a mba off 0# s = bigNatToMutableByteArrayLE# a mba off s
bigNatToMutableByteArray# a mba off _ s = bigNatToMutableByteArrayBE# a mba off s
bigNatFromByteArrayLE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat# #)
bigNatFromByteArrayLE# 0## _ _ s = (# s, bigNatZero# (# #) #)
bigNatFromByteArrayLE# sz ba moff s =
let
!nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#
!nb = sz `and#` WORD_SIZE_BYTES_MASK##
readMSB mwa s
| 0## <- nb
= s
| off <- nw `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#
= case wordFromByteArrayLE# nb ba (moff `plusWord#` off) of
w -> mwaWrite# mwa (word2Int# nw) w s
go mwa i s
| isTrue# (i `eqWord#` nw)
= s
| off <- i `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#
= case wordFromByteArrayLE# WORD_SIZE_IN_BYTES## ba (moff `plusWord#` off) of
w -> case mwaWrite# mwa (word2Int# i) w s of
s -> go mwa (i `plusWord#` 1##) s
in case newWordArray# (word2Int# nw +# (word2Int# nb /=# 0#)) s of
(# s, mwa #) -> case readMSB mwa s of
s -> case go mwa 0## s of
s -> case mwaTrimZeroes# mwa s of
s -> unsafeFreezeByteArray# mwa s
bigNatFromByteArrayBE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat# #)
bigNatFromByteArrayBE# 0## _ _ s = (# s, bigNatZero# (# #) #)
bigNatFromByteArrayBE# sz ba moff s =
let
!nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#
!nb = sz `and#` WORD_SIZE_BYTES_MASK##
goMSB mwa s
| 0## <- nb
= s
| True
= case wordFromByteArrayBE# nb ba moff of
w -> mwaWrite# mwa (word2Int# nw) w s
go mwa i s
| isTrue# (i `eqWord#` nw)
= s
| k <- nw `minusWord#` 1## `minusWord#` i
, off <- (k `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) `plusWord#` nb
= case wordFromByteArrayBE# WORD_SIZE_IN_BYTES## ba (moff `plusWord#` off) of
w -> case mwaWrite# mwa (word2Int# i) w s of
s -> go mwa (i `plusWord#` 1##) s
in case newWordArray# (word2Int# nw +# (word2Int# nb /=# 0#)) s of
(# s, mwa #) -> case goMSB mwa s of
s -> case go mwa 0## s of
s -> case mwaTrimZeroes# mwa s of
s -> unsafeFreezeByteArray# mwa s
bigNatFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, BigNat# #)
bigNatFromByteArray# sz ba off 0# s = bigNatFromByteArrayLE# sz ba off s
bigNatFromByteArray# sz ba off _ s = bigNatFromByteArrayBE# sz ba off s
bigNatFromWordArray# :: WordArray# -> Word# -> BigNat#
bigNatFromWordArray# wa n0
| isTrue# (n `eqWord#` 0##)
= bigNatZero# (# #)
| isTrue# (r `eqWord#` 0##)
, isTrue# (q `eqWord#` n)
= wa
| True = withNewWordArray# (word2Int# n) \mwa s ->
mwaArrayCopy# mwa 0# wa 0# (word2Int# n) s
where
!(# q, r #) = quotRemWord# (int2Word# (sizeofByteArray# wa))
WORD_SIZE_IN_BYTES##
!n = real_size n0
real_size 0## = 0##
real_size i
| 0## <- bigNatIndex# wa (word2Int# (i `minusWord#` 1##))
= real_size (i `minusWord#` 1##)
real_size i = i
bigNatFromWordArray :: WordArray# -> Word# -> BigNat
bigNatFromWordArray wa n = BN# (bigNatFromWordArray# wa n)