{-# 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
import GHC.Num.Backend

#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
#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 instead of an unlifted newtype to make Integer/Natural
   -- types easier to wire in the compiler

-- | A lifted 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.
data BigNat = BN# { unBigNat :: BigNat# }

-- 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.


-- | Check that the BigNat is valid
bigNatCheck# :: BigNat# -> Bool#
bigNatCheck# bn
   | 0#  <- bigNatSize# bn                         = 1#
   -- check that size is a multiple of Word size
   | r <- remInt# (sizeofByteArray# bn) WORD_SIZE_IN_BYTES#
   , isTrue# (r /=# 0#)                            = 0#
   -- check that most-significant limb isn't zero
   | 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

{-# NOINLINE bigNatZero #-}
bigNatZero :: BigNat
bigNatZero = BN# (withNewWordArray# 0# (\_ s -> s))

{-# NOINLINE bigNatOne #-}
bigNatOne :: BigNat
bigNatOne = BN# (bigNatFromWord# 1##)

-- | BigNat Zero
bigNatZero# :: Void# -> BigNat# -- cf Note [Why Void#?]
bigNatZero# _ = case bigNatZero of
   BN# w -> w

-- | BigNat one
bigNatOne# :: Void# -> BigNat# -- cf Note [Why Void#?]
bigNatOne# _ = case bigNatOne of
   BN# w -> w

raiseDivZero_BigNat :: Void# -> BigNat#
raiseDivZero_BigNat _ = case raiseDivZero of
   !_ -> bigNatZero# void#
   -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives

-- | 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## l   = bigNatFromWord# l
bigNatFromWord2# h   l   = wordArrayFromWord2# h l

-- | 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 0#) 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
  | LT <- bigNatCompare a b = 1#
  | True                    = 0#

-- | Predicate: a < b
bigNatLt :: BigNat# -> BigNat# -> Bool
bigNatLt a b = isTrue# (bigNatLt# a b)

-- | Predicate: a <= b
bigNatLe# :: BigNat# -> BigNat# -> Bool#
bigNatLe# a b
  | GT <- bigNatCompare a b = 0#
  | True                    = 1#

-- | Predicate: a <= b
bigNatLe :: BigNat# -> BigNat# -> Bool
bigNatLe a b = isTrue# (bigNatLe# a b)

-- | Predicate: a > b
bigNatGt# :: BigNat# -> BigNat# -> Bool#
bigNatGt# a b
  | GT <- bigNatCompare a b = 1#
  | True                    = 0#

-- | Predicate: a > b
bigNatGt :: BigNat# -> BigNat# -> Bool
bigNatGt a b = isTrue# (bigNatGt# a b)

-- | Predicate: a >= b
bigNatGe# :: BigNat# -> BigNat# -> Bool#
bigNatGe# a b
  | LT <- bigNatCompare a b = 0#
  | True                    = 1#

-- | Predicate: a >= b
bigNatGe :: BigNat# -> BigNat# -> Bool
bigNatGe a b = isTrue# (bigNatGe# a b)

-------------------------------------------------
-- 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', 1# #) -> s'
               (# s', _  #) -> case raiseUnderflow of
                                 !_ -> s'
                                 -- see Note [ghc-bignum exceptions] in
                                 -- GHC.Num.Primitives

-- | 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 = raiseDivZero_BigNat 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       = raiseDivZero_Word# void#
   | 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 raiseDivZero of
                  !_ -> (# bigNatZero# void#, 0## #)
                  -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
   | 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 raiseDivZero of
                                 !_ -> (# bigNatZero# void#, bigNatZero# void# #)
                                 -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
   | 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          = raiseDivZero_BigNat 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          = raiseDivZero_BigNat 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
   = unexpectedValue_Word# void#

   | 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 = unexpectedValue_Word# void#
   | 1## <- base = unexpectedValue_Word# void#
   | 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##)
   = unexpectedValue_Word# void#

   | 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## = raiseDivZero_Word# void#
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 = raiseDivZero_BigNat 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




-- | Create a BigNat# from a WordArray# containing /n/ limbs in
-- least-significant-first order.
--
-- If possible 'WordArray#', will be used directly (i.e. shared
-- /without/ cloning the 'WordArray#' into a newly allocated one)
bigNatFromWordArray# :: WordArray# -> Word# -> BigNat#
bigNatFromWordArray# wa n0
   | isTrue# (n `eqWord#` 0##)
   = bigNatZero# void#

   | isTrue# (r `eqWord#` 0##) -- i.e. wa is multiple of limb-size
   , 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##
      -- find real size in Words by removing trailing null limbs
      !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


-- | Create a BigNat from a WordArray# containing /n/ limbs in
-- least-significant-first order.
--
-- If possible 'WordArray#', will be used directly (i.e. shared
-- /without/ cloning the 'WordArray#' into a newly allocated one)
bigNatFromWordArray :: WordArray# -> Word# -> BigNat
bigNatFromWordArray wa n = BN# (bigNatFromWordArray# wa n)

-------------------------------------------------
-- Instances
-------------------------------------------------

instance Eq BigNat where
   BN# a == BN# b = bigNatEq a b
   BN# a /= BN# b = bigNatNe a b

instance Ord BigNat where
   (BN# a) `compare` (BN# b) = bigNatCompare a b
   BN# a <  BN# b = bigNatLt a b
   BN# a <= BN# b = bigNatLe a b
   BN# a >  BN# b = bigNatGt a b
   BN# a >= BN# b = bigNatGe a b