diff options
Diffstat (limited to 'libraries/ghc-bignum/src/GHC/Num/BigNat.hs')
| -rw-r--r-- | libraries/ghc-bignum/src/GHC/Num/BigNat.hs | 1509 |
1 files changed, 1509 insertions, 0 deletions
diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs new file mode 100644 index 0000000000..5d0a9919f5 --- /dev/null +++ b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs @@ -0,0 +1,1509 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE BinaryLiterals #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} + +-- | Multi-precision natural +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 + +#if WORD_SIZE_IN_BITS < 64 +import GHC.IntWord64 +#endif + +#if defined(BIGNUM_CHECK) +import GHC.Num.BigNat.Check + +#elif defined(BIGNUM_NATIVE) +import GHC.Num.BigNat.Native + +#elif defined(BIGNUM_FFI) +import GHC.Num.BigNat.FFI + +#elif defined(BIGNUM_GMP) +import GHC.Num.BigNat.GMP + +#else +#error Undefined BigNat backend. Use a flag to select it (e.g. gmp, native, ffi)` +#endif + +default () + +-- | A BigNat +-- +-- Represented as an array of limbs (Word#) stored in little-endian order (Word# +-- themselves use machine order). +-- +-- Invariant (canonical representation): higher Word# is non-zero. +-- As a consequence, zero is represented with a WordArray# whose size is 0. +type BigNat = WordArray# -- we use a type-alias to make Integer/Natural easier to wire-in + +-- | Check that the BigNat is valid +bigNatCheck# :: BigNat -> Bool# +bigNatCheck# bn + | 0# <- bigNatSize# bn = 1# + | 0## <- bigNatIndex# bn (bigNatSize# bn -# 1#) = 0# + | True = 1# + +-- | Check that the BigNat is valid +bigNatCheck :: BigNat -> Bool +bigNatCheck bn = isTrue# (bigNatCheck# bn) + +-- | Number of words in the BigNat +bigNatSize :: BigNat -> Word +bigNatSize bn = W# (int2Word# (bigNatSize# bn)) + +-- | Number of words in the BigNat +bigNatSize# :: BigNat -> Int# +bigNatSize# ba = wordArraySize# ba + +-- Note [Why Void#?] +-- ~~~~~~~~~~~~~~~~~ +-- +-- We can't have top-level BigNat for now because they are unlifted ByteArray# +-- (see #17521). So we use functions that take an empty argument Void# that +-- will be discarded at compile time. + +data BigNatW = BigNatW BigNat + +{-# NOINLINE bigNatZeroW #-} +bigNatZeroW :: BigNatW +bigNatZeroW = BigNatW (withNewWordArray# 0# (\_ s -> s)) + +{-# NOINLINE bigNatOneW #-} +bigNatOneW :: BigNatW +bigNatOneW = BigNatW (bigNatFromWord# 1##) + +-- | BigNat Zero +bigNatZero :: Void# -> BigNat -- cf Note [Why Void#?] +bigNatZero _ = case bigNatZeroW of + BigNatW w -> w + +-- | BigNat one +bigNatOne :: Void# -> BigNat -- cf Note [Why Void#?] +bigNatOne _ = case bigNatOneW of + BigNatW w -> w + +-- | Indicate if a bigNat is zero +bigNatIsZero :: BigNat -> Bool +bigNatIsZero bn = isTrue# (bigNatIsZero# bn) + +-- | Indicate if a bigNat is zero +bigNatIsZero# :: BigNat -> Bool# +bigNatIsZero# ba = wordArraySize# ba ==# 0# + +-- | Indicate if a bigNat is one +bigNatIsOne :: BigNat -> Bool +bigNatIsOne bn = isTrue# (bigNatIsOne# bn) + +-- | Indicate if a bigNat is one +bigNatIsOne# :: BigNat -> Bool# +bigNatIsOne# ba = + wordArraySize# ba ==# 1# + &&# indexWordArray# ba 0# `eqWord#` 1## + +-- | Indicate if a bigNat is two +bigNatIsTwo :: BigNat -> Bool +bigNatIsTwo bn = isTrue# (bigNatIsTwo# bn) + +-- | Indicate if a bigNat is two +bigNatIsTwo# :: BigNat -> Bool# +bigNatIsTwo# ba = + wordArraySize# ba ==# 1# + &&# indexWordArray# ba 0# `eqWord#` 2## + +-- | Indicate if the value is a power of two and which one +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# + +-- | Return the Word# at the given index +bigNatIndex# :: BigNat -> Int# -> Word# +bigNatIndex# x i = indexWordArray# x i + +-- | Return the Word# at the given index +bigNatIndex :: BigNat -> Int# -> Word +bigNatIndex bn i = W# (bigNatIndex# bn i) + +------------------------------------------------- +-- Conversion +------------------------------------------------- + +-- | Create a BigNat from a Word +bigNatFromWord :: Word -> BigNat +bigNatFromWord (W# w) = bigNatFromWord# w + +-- | Create a BigNat from a Word +bigNatFromWord# :: Word# -> BigNat +bigNatFromWord# 0## = bigNatZero void# +bigNatFromWord# w = wordArrayFromWord# w + +-- | Convert a list of non-zero Words (most-significant first) into a BigNat +bigNatFromWordList :: [Word] -> BigNat +bigNatFromWordList (W# 0##:xs) = bigNatFromWordList xs +bigNatFromWordList xs = bigNatFromWordListUnsafe xs + +-- | Convert a list of non-zero Words (most-significant first) into a BigNat +bigNatFromWordList# :: [Word] -> WordArray# +{-# NOINLINE bigNatFromWordList# #-} +bigNatFromWordList# xs = bigNatFromWordList xs + +-- | Return the absolute value of the Int# in a BigNat +bigNatFromAbsInt# :: Int# -> BigNat +bigNatFromAbsInt# i = bigNatFromWord# (wordFromAbsInt# i) + +-- | Convert a list of non-zero Words (most-significant first) into a BigNat. +-- Don't remove most-significant zero words +bigNatFromWordListUnsafe :: [Word] -> BigNat +bigNatFromWordListUnsafe [] = bigNatZero void# +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 + +-- | Convert a BigNat into a list of non-zero Words (most-significant first) +bigNatToWordList :: BigNat -> [Word] +bigNatToWordList bn = go (bigNatSize# bn) + where + go 0# = [] + go n = bigNatIndex bn (n -# 1#) : go (n -# 1#) + + +-- | Convert two Word# (most-significant first) into a BigNat +bigNatFromWord2# :: Word# -> Word# -> BigNat +bigNatFromWord2# 0## 0## = bigNatZero void# +bigNatFromWord2# 0## n = bigNatFromWord# n +bigNatFromWord2# w1 w2 = wordArrayFromWord2# w1 w2 + +-- | Convert a BigNat into a Word# +bigNatToWord# :: BigNat -> Word# +bigNatToWord# a + | bigNatIsZero a = 0## + | True = bigNatIndex# a 0# + +-- | Convert a BigNat into a Word# if it fits +bigNatToWordMaybe# :: BigNat -> (# Word# | () #) +bigNatToWordMaybe# a + | bigNatIsZero a = (# 0## | #) + | isTrue# (bigNatSize# a ># 1#) = (# | () #) + | True = (# bigNatIndex# a 0# | #) + +-- | Convert a BigNat into a Word +bigNatToWord :: BigNat -> Word +bigNatToWord bn = W# (bigNatToWord# bn) + +-- | Convert a BigNat into a Int# +bigNatToInt# :: BigNat -> Int# +bigNatToInt# a + | bigNatIsZero a = 0# + | True = indexIntArray# a 0# + +-- | Convert a BigNat into a Int +bigNatToInt :: BigNat -> Int +bigNatToInt bn = I# (bigNatToInt# bn) + +#if WORD_SIZE_IN_BITS == 32 + +-- | Convert a Word64# into a BigNat on 32-bit architectures +bigNatFromWord64# :: Word64# -> BigNat +bigNatFromWord64# w64 = bigNatFromWord2# wh# wl# + where + wh# = word64ToWord# (uncheckedShiftRL64# w64 32#) + wl# = word64ToWord# w64 + +-- | Convert a BigNat into a Word64# on 32-bit architectures +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 + +-- | Encode (# BigNat mantissa, Int# exponent #) into a Double# +bigNatEncodeDouble# :: BigNat -> Int# -> Double# +bigNatEncodeDouble# a e + | bigNatIsZero a + = word2Double# 0## -- FIXME: isn't it NaN on 0# exponent? + + | True + = inline bignat_encode_double a e + +------------------------------------------------- +-- Predicates +------------------------------------------------- + +-- | Test if a BigNat is greater than a Word +bigNatGtWord# :: BigNat -> Word# -> Bool# +bigNatGtWord# bn w = + notB# (bigNatIsZero# bn) + &&# ( bigNatSize# bn ># 1# + ||# bigNatIndex# bn 0# `gtWord#` w + ) + +-- | Test if a BigNat is equal to a Word +bigNatEqWord# :: BigNat -> Word# -> Bool# +bigNatEqWord# bn w + | 0## <- w + = bigNatIsZero# bn + + | isTrue# (bigNatSize# bn ==# 1#) + = bigNatIndex# bn 0# `eqWord#` w + + | True + = 0# + +-- | Test if a BigNat is greater than a Word +bigNatGtWord :: BigNat -> Word -> Bool +bigNatGtWord bn (W# w) = isTrue# (bigNatGtWord# bn w) + +-- | Test if a BigNat is lower than or equal to a Word +bigNatLeWord# :: BigNat -> Word# -> Bool# +bigNatLeWord# bn w = notB# (bigNatGtWord# bn w) + +-- | Test if a BigNat is lower than or equal to a Word +bigNatLeWord :: BigNat -> Word -> Bool +bigNatLeWord bn (W# w) = isTrue# (bigNatLeWord# bn w) + +-- | Equality test for BigNat +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# + +-- | Equality test for BigNat +bigNatEq :: BigNat -> BigNat -> Bool +bigNatEq a b = isTrue# (bigNatEq# a b) + +-- | Inequality test for BigNat +bigNatNe# :: BigNat -> BigNat -> Bool# +bigNatNe# a b = notB# (bigNatEq# a b) + +-- | Equality test for BigNat +bigNatNe :: BigNat -> BigNat -> Bool +bigNatNe a b = isTrue# (bigNatNe# a b) + +-- | Compare a BigNat and a Word# +bigNatCompareWord# :: BigNat -> Word# -> Ordering +bigNatCompareWord# a b + | bigNatIsZero a = cmpW# 0## b + | isTrue# (wordArraySize# a ># 1#) = GT + | True + = cmpW# (indexWordArray# a 1#) b + +-- | Compare a BigNat and a Word +bigNatCompareWord :: BigNat -> Word -> Ordering +bigNatCompareWord a (W# b) = bigNatCompareWord# a b + +-- | Compare two BigNat +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# + + +-- | Predicate: a < b +bigNatLt :: BigNat -> BigNat -> Bool +bigNatLt a b = bigNatCompare a b == LT + +------------------------------------------------- +-- Addition +------------------------------------------------- + +-- | Add a bigNat and a Word# +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 + +-- | Add a bigNat and a Word +bigNatAddWord :: BigNat -> Word -> BigNat +bigNatAddWord a (W# b) = bigNatAddWord# a b + +-- | Add two bigNats +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# -- for the potential carry + in withNewWordArrayTrimed# sz \mwa s -> + inline bignat_add mwa a b s + +------------------------------------------------- +-- Multiplication +------------------------------------------------- + +-- | Multiply a BigNat by a Word# +bigNatMulWord# :: BigNat -> Word# -> BigNat +bigNatMulWord# a w + | 0## <- w = bigNatZero void# + | 1## <- w = a + | bigNatIsZero a = bigNatZero void# + | 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 + +-- | Multiply a BigNAt by a Word +bigNatMulWord :: BigNat -> Word -> BigNat +bigNatMulWord a (W# w) = bigNatMulWord# a w + +-- | Square a BigNat +bigNatSqr :: BigNat -> BigNat +bigNatSqr a = bigNatMul a a + -- This can be replaced by a backend primitive in the future (e.g. to use + -- GMP's mpn_sqr) + +-- | Multiplication (classical algorithm) +bigNatMul :: BigNat -> BigNat -> BigNat +bigNatMul a b + | bigNatSize b > bigNatSize a = bigNatMul b a -- optimize loops + | 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 + + +------------------------------------------------- +-- Subtraction +------------------------------------------------- + +-- | Subtract a Word# from a BigNat +-- +-- The BigNat must be bigger than the Word#. +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 + +-- | Subtract a Word# from a BigNat +-- +-- The BigNat must be bigger than the Word#. +bigNatSubWordUnsafe :: BigNat -> Word -> BigNat +bigNatSubWordUnsafe x (W# y) = bigNatSubWordUnsafe# x y + +-- | Subtract a Word# from a BigNat +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 + + +-- | Subtract two BigNat (don't check if a >= b) +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', 0# #) -> s' + (# s', _ #) -> case underflow of _ -> s' + +-- | Subtract two BigNat +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 + + +------------------------------------------------- +-- Division +------------------------------------------------- + +-- | Divide a BigNat by a Word, return the quotient +-- +-- Require: +-- b /= 0 +bigNatQuotWord# :: BigNat -> Word# -> BigNat +bigNatQuotWord# a b + | 1## <- b = a + | 0## <- b = case divByZero of _ -> bigNatZero void# + | True = + let + sz = wordArraySize# a + in withNewWordArrayTrimed# sz \mwq s -> + inline bignat_quot_word mwq a b s + +-- | Divide a BigNat by a Word, return the quotient +-- +-- Require: +-- b /= 0 +bigNatQuotWord :: BigNat -> Word -> BigNat +bigNatQuotWord a (W# b) = bigNatQuotWord# a b + +-- | Divide a BigNat by a Word, return the remainder +-- +-- Require: +-- b /= 0 +bigNatRemWord# :: BigNat -> Word# -> Word# +bigNatRemWord# a b + | 0## <- b = 1## `remWord#` 0## + | 1## <- b = 0## + | bigNatIsZero a = 0## + | True = inline bignat_rem_word a b + +-- | Divide a BigNat by a Word, return the remainder +-- +-- Require: +-- b /= 0 +bigNatRemWord :: BigNat -> Word -> Word +bigNatRemWord a (W# b) = W# (bigNatRemWord# a b) + +-- | QuotRem a BigNat by a Word +-- +-- Require: +-- b /= 0 +bigNatQuotRemWord# :: BigNat -> Word# -> (# BigNat, Word# #) +bigNatQuotRemWord# a b + | 0## <- b = case divByZero of _ -> (# bigNatZero void#, 0## #) + | 1## <- b = (# a, 0## #) + | isTrue# (bigNatSize# a ==# 1#) + , a0 <- indexWordArray# a 0# + = case compareWord# a0 b of + LT -> (# bigNatZero void#, a0 #) + EQ -> (# bigNatOne void#, 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 #) + + +-- | BigNat division returning (quotient,remainder) +bigNatQuotRem# :: BigNat -> BigNat -> (# BigNat,BigNat #) +bigNatQuotRem# a b + | bigNatIsZero b = case divByZero of _ -> (# bigNatZero void#, bigNatZero void# #) + | bigNatIsZero a = (# bigNatZero void#, bigNatZero void# #) + | bigNatIsOne b = (# a , bigNatZero void# #) + | LT <- cmp = (# bigNatZero void#, a #) + | EQ <- cmp = (# bigNatOne void#, bigNatZero void# #) + | 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 + + +-- | BigNat division returning quotient +bigNatQuot :: BigNat -> BigNat -> BigNat +bigNatQuot a b + | bigNatIsZero b = case divByZero of _ -> bigNatZero void# + | bigNatIsZero a = bigNatZero void# + | bigNatIsOne b = a + | LT <- cmp = bigNatZero void# + | EQ <- cmp = bigNatOne void# + | 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 + +-- | BigNat division returning remainder +bigNatRem :: BigNat -> BigNat -> BigNat +bigNatRem a b + | bigNatIsZero b = case divByZero of _ -> bigNatZero void# + | bigNatIsZero a = bigNatZero void# + | bigNatIsOne b = bigNatZero void# + | LT <- cmp = a + | EQ <- cmp = bigNatZero void# + | 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 + +------------------------------------------------- +-- GCD / LCM +------------------------------------------------- + +-- Word#/Int# GCDs shouldn't be here in BigNat. However GMP provides a very fast +-- implementation so we keep this here at least until we get a native Haskell +-- implementation as fast as GMP's one. Note that these functions are used in +-- `base` (e.g. in GHC.Real) + +-- | Greatest common divisor between two Word# +gcdWord# :: Word# -> Word# -> Word# +gcdWord# = bignat_gcd_word_word + +-- | Greatest common divisor between two Word +gcdWord :: Word -> Word -> Word +gcdWord (W# x) (W# y) = W# (gcdWord# x y) + +-- | Greatest common divisor between two Int# +-- +-- __Warning__: result may become negative if (at least) one argument +-- is 'minBound' +gcdInt# :: Int# -> Int# -> Int# +gcdInt# x y = word2Int# (gcdWord# (wordFromAbsInt# x) (wordFromAbsInt# y)) + +-- | Greatest common divisor between two Int +-- +-- __Warning__: result may become negative if (at least) one argument +-- is 'minBound' +gcdInt :: Int -> Int -> Int +gcdInt (I# x) (I# y) = I# (gcdInt# x y) + +-- | Greatest common divisor +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 = -- 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 + +-- | Greatest common divisor +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 + +-- | Least common multiple +bigNatLcm :: BigNat -> BigNat -> BigNat +bigNatLcm a b + | bigNatIsZero a = bigNatZero void# + | bigNatIsZero b = bigNatZero void# + | 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 + -- TODO: use extended GCD to get a's factor directly + +-- | Least common multiple with a Word# +bigNatLcmWord# :: BigNat -> Word# -> BigNat +bigNatLcmWord# a b + | bigNatIsZero a = bigNatZero void# + | 0## <- b = bigNatZero void# + | bigNatIsOne a = bigNatFromWord# b + | 1## <- b = a + | 1# <- bigNatSize# a = bigNatLcmWordWord# (bigNatIndex# a 0#) b + | True + = (a `bigNatQuotWord#` (a `bigNatGcdWord#` b)) `bigNatMulWord#` b + -- TODO: use extended GCD to get a's factor directly + +-- | Least common multiple between two Word# +bigNatLcmWordWord# :: Word# -> Word# -> BigNat +bigNatLcmWordWord# a b + | 0## <- a = bigNatZero void# + | 0## <- b = bigNatZero void# + | 1## <- a = bigNatFromWord# b + | 1## <- b = bigNatFromWord# a + | True = case (a `quotWord#` (a `gcdWord#` b)) `timesWord2#` b of + -- TODO: use extended GCD to get a's factor directly + (# h, l #) -> bigNatFromWord2# h l + + +------------------------------------------------- +-- Bitwise operations +------------------------------------------------- + +-- | Bitwise OR +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 + +-- | Bitwise OR with Word# +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' + +-- | Bitwise AND +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 + +-- | Bitwise ANDNOT +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 + +-- | Bitwise AND with Word# +bigNatAndWord# :: BigNat -> Word# -> BigNat +bigNatAndWord# a b + | bigNatIsZero a = a + | True = bigNatFromWord# (indexWordArray# a 0# `and#` b) + +-- | Bitwise ANDNOT with Word# +bigNatAndNotWord# :: BigNat -> Word# -> BigNat +bigNatAndNotWord# a b + | bigNatIsZero a = a + | szA <- bigNatSize# a + = withNewWordArray# szA \mwa s -> + -- duplicate higher limbs + case mwaArrayCopy# mwa 1# a 1# (szA -# 1#) s of + s' -> writeWordArray# mwa 0# + (indexWordArray# a 0# `and#` not# b) s' + +-- | Bitwise AND with Int# +bigNatAndInt# :: BigNat -> Int# -> BigNat +bigNatAndInt# a b + | bigNatIsZero a = a + | isTrue# (b >=# 0#) = bigNatAndWord# a (int2Word# b) + | szA <- bigNatSize# a + = withNewWordArray# szA \mwa s -> + -- duplicate higher limbs (because of sign-extension of b) + case mwaArrayCopy# mwa 1# a 1# (szA -# 1#) s of + s' -> writeWordArray# mwa 0# + (indexWordArray# a 0# `and#` int2Word# b) s' + + +-- | Bitwise XOR +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 + +-- | Bitwise XOR with Word# +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' + +-- | PopCount for BigNat +bigNatPopCount :: BigNat -> Word +bigNatPopCount a = W# (bigNatPopCount# a) + +-- | PopCount for BigNat +bigNatPopCount# :: BigNat -> Word# +bigNatPopCount# a + | bigNatIsZero a = 0## + | True = inline bignat_popcount a + +-- | Bit shift right +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 void# + + | 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 + +-- | Bit shift right (two's complement) +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 void# + + | 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 + + +-- | Bit shift right +bigNatShiftR :: BigNat -> Word -> BigNat +bigNatShiftR a (W# n) = bigNatShiftR# a n + +-- | Bit shift left +bigNatShiftL :: BigNat -> Word -> BigNat +bigNatShiftL a (W# n) = bigNatShiftL# a n + +-- | Bit shift left +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 + + +-- | BigNat bit test +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 + +-- | BigNat bit test +bigNatTestBit :: BigNat -> Word -> Bool +bigNatTestBit a (W# n) = isTrue# (bigNatTestBit# a n) + + +-- | Return a BigNat whose bit `i` is the only one set. +-- +-- Specialized version of `bigNatShiftL (bigNatFromWord# 1##)` +-- +bigNatBit# :: Word# -> BigNat +bigNatBit# i + | 0## <- i = bigNatOne void# + | 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 -> + -- clear the array + case mwaFill# mwa 0## 0## (int2Word# sz) s of + -- set the bit in the most-significant word + s2 -> mwaWrite# mwa (sz -# 1#) v s2 + +-- | Return a BigNat whose bit `i` is the only one set. +-- +-- Specialized version of `bigNatShiftL (bigNatFromWord# 1##)` +-- +bigNatBit :: Word -> BigNat +bigNatBit (W# i) = bigNatBit# i + +-- | BigNat clear bit +bigNatClearBit# :: BigNat -> Word# -> BigNat +bigNatClearBit# a n + -- check the range validity and the current bit value + | 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 + + -- special case, operating on most-significant Word + | 0## <- nv + , isTrue# (nw +# 1# ==# sz) + -> case sz -# (waClzAt a (sz -# 2#) +# 1#) of + 0# -> bigNatZero void# + 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' + +-- | BigNat set bit +bigNatSetBit# :: BigNat -> Word# -> BigNat +bigNatSetBit# a n + -- check the current bit value + | 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 + -- result BigNat will have more limbs + | 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' + +-- | Reverse the given bit +bigNatComplementBit# :: BigNat -> Word# -> BigNat +bigNatComplementBit# bn i + | isTrue# (bigNatTestBit# bn i) = bigNatClearBit# bn i + | True = bigNatSetBit# bn i + +------------------------------------------------- +-- Log operations +------------------------------------------------- + +-- | Base 2 logarithm +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#) + +-- | Base 2 logarithm +bigNatLog2 :: BigNat -> Word +bigNatLog2 a = W# (bigNatLog2# a) + +-- | Logarithm for an arbitrary base +bigNatLogBase# :: BigNat -> BigNat -> Word# +bigNatLogBase# base a + | bigNatIsZero base || bigNatIsOne base + = case unexpectedValue of _ -> 0## + + | 1# <- bigNatSize# base + , 2## <- bigNatIndex# base 0# + = bigNatLog2# a + + -- TODO: optimize log base power of 2 (256, etc.) + + | 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## #) + +-- | Logarithm for an arbitrary base +bigNatLogBase :: BigNat -> BigNat -> Word +bigNatLogBase base a = W# (bigNatLogBase# base a) + +-- | Logarithm for an arbitrary base +bigNatLogBaseWord# :: Word# -> BigNat -> Word# +bigNatLogBaseWord# base a + | 0## <- base = case unexpectedValue of _ -> 0## + | 1## <- base = case unexpectedValue of _ -> 0## + | 2## <- base = bigNatLog2# a + -- TODO: optimize log base power of 2 (256, etc.) + | True = bigNatLogBase# (bigNatFromWord# base) a + +-- | Logarithm for an arbitrary base +bigNatLogBaseWord :: Word -> BigNat -> Word +bigNatLogBaseWord (W# base) a = W# (bigNatLogBaseWord# base a) + +------------------------------------------------- +-- Various +------------------------------------------------- + +-- | Compute the number of digits of the BigNat in the given base. +-- +-- `base` must be > 1 +bigNatSizeInBase# :: Word# -> BigNat -> Word# +bigNatSizeInBase# base a + | isTrue# (base `leWord#` 1##) + = case unexpectedValue of _ -> 0## + + | bigNatIsZero a + = 0## + + | True + = bigNatLogBaseWord# base a `plusWord#` 1## + +-- | Compute the number of digits of the BigNat in the given base. +-- +-- `base` must be > 1 +bigNatSizeInBase :: Word -> BigNat -> Word +bigNatSizeInBase (W# w) a = W# (bigNatSizeInBase# w a) + +------------------------------------------------- +-- PowMod +------------------------------------------------- + +-- Word# powMod shouldn't be here in BigNat. However GMP provides a very fast +-- implementation so we keep this here at least until we get a native Haskell +-- implementation as fast as GMP's one. + +powModWord# :: Word# -> Word# -> Word# -> Word# +powModWord# = bignat_powmod_words + + +-- | \"@'bigNatPowModWord#' /b/ /e/ /m/@\" computes base @/b/@ raised to +-- exponent @/e/@ modulo @/m/@. +bigNatPowModWord# :: BigNat -> BigNat -> Word# -> Word# +bigNatPowModWord# !_ !_ 0## = case divByZero of _ -> 0## +bigNatPowModWord# _ _ 1## = 0## +bigNatPowModWord# b e m + | bigNatIsZero e = 1## + | bigNatIsZero b = 0## + | bigNatIsOne b = 1## + | True = bignat_powmod_word b e m + +-- | \"@'bigNatPowMod' /b/ /e/ /m/@\" computes base @/b/@ raised to +-- exponent @/e/@ modulo @/m/@. +bigNatPowMod :: BigNat -> BigNat -> BigNat -> BigNat +bigNatPowMod !b !e !m + | (# m' | #) <- bigNatToWordMaybe# m + = bigNatFromWord# (bigNatPowModWord# b e m') + | bigNatIsZero m = case divByZero of _ -> bigNatZero void# + | 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 + +-- | Return count of trailing zero bits +-- +-- Return 0 for zero BigNat +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 + +-- | Return count of trailing zero bits +-- +-- Return 0 for zero BigNat +bigNatCtz :: BigNat -> Word +bigNatCtz a = W# (bigNatCtz# a) + + +-- | Return count of trailing zero words +-- +-- Return 0 for zero BigNat +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 + +-- | Return count of trailing zero words +-- +-- Return 0 for zero BigNat +bigNatCtzWord :: BigNat -> Word +bigNatCtzWord a = W# (bigNatCtzWord# a) + +------------------------------------------------- +-- Export to memory +------------------------------------------------- + +-- | Write a BigNat in base-256 little-endian representation and return the +-- number of bytes written. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +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 + +-- | Write a BigNat in base-256 big-endian representation and return the +-- number of bytes written. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +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' + + +-- | Write a BigNat in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +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 + +-- | Write a BigNat in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +bigNatToAddr :: BigNat -> Addr# -> Bool# -> IO Word +bigNatToAddr a addr e = IO \s -> case bigNatToAddr# a addr e s of + (# s', w #) -> (# s', W# w #) + + + +------------------------------------------------- +-- Import from memory +------------------------------------------------- + +-- | Read a BigNat in base-256 little-endian representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- Higher limbs equal to 0 are automatically trimed. +bigNatFromAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat #) +bigNatFromAddrLE# 0## _ s = (# s, bigNatZero void# #) +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 + +-- | Read a BigNat in base-256 big-endian representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- Null higher limbs are automatically trimed. +bigNatFromAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat #) +bigNatFromAddrBE# 0## _ s = (# s, bigNatZero void# #) +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 + +-- | Read a BigNat in base-256 representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +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 + +------------------------------------------------- +-- Export to ByteArray +------------------------------------------------- + +-- | Write a BigNat in base-256 little-endian representation and return the +-- number of bytes written. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +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 + +-- | Write a BigNat in base-256 big-endian representation and return the +-- number of bytes written. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +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' + + +-- | Write a BigNat in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +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 + +------------------------------------------------- +-- Import from ByteArray +------------------------------------------------- + +-- | Read a BigNat in base-256 little-endian representation from a ByteArray#. +-- +-- The size is given in bytes. +-- +-- Null higher limbs are automatically trimed. +bigNatFromByteArrayLE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat #) +bigNatFromByteArrayLE# 0## _ _ s = (# s, bigNatZero void# #) +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 + +-- | Read a BigNat in base-256 big-endian representation from a ByteArray#. +-- +-- The size is given in bytes. +-- +-- Null higher limbs are automatically trimed. +bigNatFromByteArrayBE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat #) +bigNatFromByteArrayBE# 0## _ _ s = (# s, bigNatZero void# #) +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 + +-- | Read a BigNat in base-256 representation from a ByteArray#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +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 |