{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BinaryLiterals #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

module GHC.Num.Backend.Native where

#include "MachDeps.h"
#include "WordSize.h"

#if defined(BIGNUM_NATIVE) || defined(BIGNUM_CHECK) || defined(BIGNUM_FFI)
import {-# SOURCE #-} GHC.Num.BigNat
import {-# SOURCE #-} GHC.Num.Natural
import {-# SOURCE #-} GHC.Num.Integer
#else
import GHC.Num.BigNat
import GHC.Num.Natural
import GHC.Num.Integer
#endif
import GHC.Num.WordArray
import GHC.Num.Primitives
import GHC.Prim
import GHC.Types

default ()

-- | ghc-bignum backend name
backendName :: [Char]
backendName :: [Char]
backendName = [Char]
"native"


count_words_bits :: Word# -> (# Word#, Word# #)
count_words_bits :: Word# -> (# Word#, Word# #)
count_words_bits Word#
n = (# Word#
nw, Word#
nb #)
   where
      nw :: Word#
nw = Word#
n Word# -> Int# -> Word#
`uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#
      nb :: Word#
nb = Word#
n Word# -> Word# -> Word#
`and#` WORD_SIZE_BITS_MASK##

count_words_bits_int :: Word# -> (# Int#, Int# #)
count_words_bits_int :: Word# -> (# Int#, Int# #)
count_words_bits_int Word#
n = case Word# -> (# Word#, Word# #)
count_words_bits Word#
n of
   (# Word#
nw, Word#
nb #) -> (# Word# -> Int#
word2Int# Word#
nw, Word# -> Int#
word2Int# Word#
nb #)

bignat_compare :: WordArray# -> WordArray# -> Int#
bignat_compare :: WordArray# -> WordArray# -> Int#
bignat_compare WordArray#
wa WordArray#
wb = Int# -> Int#
go (Int#
sz Int# -> Int# -> Int#
-# Int#
1#)
   where
      sz :: Int#
sz = WordArray# -> Int#
wordArraySize# WordArray#
wa
      go :: Int# -> Int#
go Int#
i
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
0#) = Int#
0#
         | Word#
a <- WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i
         , Word#
b <- WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wb Int#
i
         = if | Int# -> Bool
isTrue# (Word#
a Word# -> Word# -> Int#
`eqWord#` Word#
b) -> Int# -> Int#
go (Int#
i Int# -> Int# -> Int#
-# Int#
1#)
              | Int# -> Bool
isTrue# (Word#
a Word# -> Word# -> Int#
`gtWord#` Word#
b) -> Int#
1#
              | Bool
True                    -> Int#
-1#

bignat_add
   :: MutableWordArray# s -- ^ Result
   -> WordArray#
   -> WordArray#
   -> State# s
   -> State# s
bignat_add :: forall s.
MutableWordArray# s
-> WordArray# -> WordArray# -> State# s -> State# s
bignat_add MutableWordArray# s
mwa WordArray#
wa WordArray#
wb = Int# -> Word# -> State# s -> State# s
addABc Int#
0# Word#
0##
   where
      !szA :: Int#
szA     = WordArray# -> Int#
wordArraySize# WordArray#
wa
      !szB :: Int#
szB     = WordArray# -> Int#
wordArraySize# WordArray#
wb
      !szMin :: Int#
szMin   = Int# -> Int# -> Int#
minI# Int#
szA Int#
szB

      -- we have four cases:
      -- 1) we have a digit in A and in B + a potential carry
      --    => perform triple addition
      --    => result in (carry,word)
      -- 2) we have a digit only in A or B and a carry
      --    => perform double addition from a single array
      --    => result in (carry,word)
      -- 3) we have a digit only in A or B and no carry
      --    => perform array copy and shrink the array
      -- 4) We only have a potential carry
      --    => write the carry or shrink the array

      addABc :: Int# -> Word# -> State# s -> State# s
addABc Int#
i Word#
carry State# s
s
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
szMin) =
            let
               !(# Word#
carry', Word#
r #) = Word# -> Word# -> Word# -> (# Word#, Word# #)
plusWord3#
                                    (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i)
                                    (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wb Int#
i)
                                    Word#
carry
            in case MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwa Int#
i Word#
r State# s
s of
               State# s
s' -> Int# -> Word# -> State# s -> State# s
addABc (Int#
i Int# -> Int# -> Int#
+# Int#
1#) Word#
carry' State# s
s'

         | Int# -> Bool
isTrue# ((Int#
i Int# -> Int# -> Int#
==# Int#
szA) Int# -> Int# -> Int#
&&# (Int#
i Int# -> Int# -> Int#
==# Int#
szB))
         = MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
forall s.
MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
mwaWriteOrShrink MutableWordArray# s
mwa Word#
carry Int#
i State# s
s

         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
szA)
         = WordArray# -> Int# -> Word# -> State# s -> State# s
addAoBc WordArray#
wb Int#
i Word#
carry State# s
s

         | Bool
True
         = WordArray# -> Int# -> Word# -> State# s -> State# s
addAoBc WordArray#
wa Int#
i Word#
carry State# s
s

      addAoBc :: WordArray# -> Int# -> Word# -> State# s -> State# s
addAoBc WordArray#
wab Int#
i Word#
carry State# s
s
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# WordArray# -> Int#
wordArraySize# WordArray#
wab)
         = MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
forall s.
MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
mwaWriteOrShrink MutableWordArray# s
mwa Word#
carry Int#
i State# s
s

         | Word#
0## <- Word#
carry
         = -- copy the remaining words and remove the word allocated for the
           -- potential carry
           case MutableWordArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
mwaArrayCopy# MutableWordArray# s
mwa Int#
i WordArray#
wab Int#
i (WordArray# -> Int#
wordArraySize# WordArray#
wab Int# -> Int# -> Int#
-# Int#
i) State# s
s of
            State# s
s' -> MutableWordArray# s -> Int# -> State# s -> State# s
forall s. MutableByteArray# s -> Int# -> State# s -> State# s
mwaShrink# MutableWordArray# s
mwa Int#
1# State# s
s'

         | Bool
True
         = let !(# Word#
carry', Word#
r #) = Word# -> Word# -> (# Word#, Word# #)
plusWord2# (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wab Int#
i) Word#
carry
           in case MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwa Int#
i Word#
r State# s
s of
               State# s
s' -> WordArray# -> Int# -> Word# -> State# s -> State# s
addAoBc WordArray#
wab (Int#
i Int# -> Int# -> Int#
+# Int#
1#) Word#
carry' State# s
s'

bignat_add_word
   :: MutableWordArray# RealWorld -- ^ Result
   -> WordArray#
   -> Word#
   -> State# RealWorld
   -> State# RealWorld
bignat_add_word :: MutableWordArray# RealWorld
-> WordArray# -> Word# -> State# RealWorld -> State# RealWorld
bignat_add_word MutableWordArray# RealWorld
mwa WordArray#
wa Word#
b State# RealWorld
s = MutableWordArray# RealWorld
-> WordArray# -> Word# -> State# RealWorld -> State# RealWorld
forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
mwaInitArrayPlusWord MutableWordArray# RealWorld
mwa WordArray#
wa Word#
b State# RealWorld
s

bignat_sub_word
   :: MutableWordArray# RealWorld
   -> WordArray#
   -> Word#
   -> State# RealWorld
   -> (# State# RealWorld, Bool# #)
bignat_sub_word :: MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> State# RealWorld
-> (# State# RealWorld, Int# #)
bignat_sub_word MutableWordArray# RealWorld
mwa WordArray#
wa Word#
b = Word# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go Word#
b Int#
0#
   where
      !sz :: Int#
sz = WordArray# -> Int#
wordArraySize# WordArray#
wa
      go :: Word# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go Word#
carry Int#
i State# RealWorld
s
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
>=# Int#
sz)
         = (# State# RealWorld
s, Word#
carry Word# -> Word# -> Int#
`eqWord#` Word#
0## #)

         | Word#
0## <- Word#
carry
         = case MutableWordArray# RealWorld
-> Int#
-> WordArray#
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall s.
MutableByteArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
mwaArrayCopy# MutableWordArray# RealWorld
mwa Int#
i WordArray#
wa Int#
i (Int#
sz Int# -> Int# -> Int#
-# Int#
i) State# RealWorld
s of
            State# RealWorld
s' -> (# State# RealWorld
s', Int#
1# #) -- no underflow

         | Bool
True
         = case Word# -> Word# -> (# Word#, Int# #)
subWordC# (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i) Word#
carry of
            (# Word#
0##, Int#
0# #)
               | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
sz) -> case MutableWordArray# RealWorld
-> Int# -> State# RealWorld -> State# RealWorld
forall s. MutableByteArray# s -> Int# -> State# s -> State# s
mwaShrink# MutableWordArray# RealWorld
mwa Int#
1# State# RealWorld
s of
                                          State# RealWorld
s' -> (# State# RealWorld
s', Int#
1# #) -- no underflow

            (# Word#
l  , Int#
c  #) -> case MutableWordArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# RealWorld
mwa Int#
i Word#
l State# RealWorld
s of
                              State# RealWorld
s1 -> Word# -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go (Int# -> Word#
int2Word# Int#
c) (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s1

bignat_mul_word
   :: MutableWordArray# RealWorld -- ^ Result
   -> WordArray#
   -> Word#
   -> State# RealWorld
   -> State# RealWorld
bignat_mul_word :: MutableWordArray# RealWorld
-> WordArray# -> Word# -> State# RealWorld -> State# RealWorld
bignat_mul_word MutableWordArray# RealWorld
mwa WordArray#
wa Word#
b = Int# -> Word# -> State# RealWorld -> State# RealWorld
go Int#
0# Word#
0##
   where
      !szA :: Int#
szA = WordArray# -> Int#
wordArraySize# WordArray#
wa
      go :: Int# -> Word# -> State# RealWorld -> State# RealWorld
go Int#
i Word#
carry State# RealWorld
s
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
szA) = MutableWordArray# RealWorld
-> Word# -> Int# -> State# RealWorld -> State# RealWorld
forall s.
MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
mwaWriteOrShrink MutableWordArray# RealWorld
mwa Word#
carry Int#
i State# RealWorld
s
         | Bool
True =
            let
               ai :: Word#
ai               = WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i
               !(# Word#
carry', Word#
r #) = Word# -> (# Word#, Word# #) -> (# Word#, Word# #)
plusWord12# Word#
carry (Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
ai Word#
b)
            in case MutableWordArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# RealWorld
mwa Int#
i Word#
r State# RealWorld
s of
                  State# RealWorld
s' -> Int# -> Word# -> State# RealWorld -> State# RealWorld
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) Word#
carry' State# RealWorld
s'


bignat_mul
   :: MutableWordArray# RealWorld -- ^ Result
   -> WordArray#
   -> WordArray#
   -> State# RealWorld
   -> State# RealWorld
bignat_mul :: MutableWordArray# RealWorld
-> WordArray# -> WordArray# -> State# RealWorld -> State# RealWorld
bignat_mul MutableWordArray# RealWorld
mwa WordArray#
wa WordArray#
wb State# RealWorld
s1 =
   -- initialize the resulting WordArray
   case MutableWordArray# RealWorld
-> Word# -> Word# -> Word# -> State# RealWorld -> State# RealWorld
forall s.
MutableWordArray# s
-> Word# -> Word# -> Word# -> State# s -> State# s
mwaFill# MutableWordArray# RealWorld
mwa Word#
0## Word#
0## (Int# -> Word#
int2Word# Int#
sz) State# RealWorld
s1 of
      State# RealWorld
s' -> Int# -> State# RealWorld -> State# RealWorld
mulEachB Int#
ctzB State# RealWorld
s' -- loop on b Words
   where
      !szA :: Int#
szA = WordArray# -> Int#
wordArraySize# WordArray#
wa
      !szB :: Int#
szB = WordArray# -> Int#
wordArraySize# WordArray#
wb
      !sz :: Int#
sz  = Int#
szA Int# -> Int# -> Int#
+# Int#
szB

      !ctzA :: Int#
ctzA = Word# -> Int#
word2Int# (WordArray# -> Word#
bigNatCtzWord# WordArray#
wa)
      !ctzB :: Int#
ctzB = Word# -> Int#
word2Int# (WordArray# -> Word#
bigNatCtzWord# WordArray#
wb)

      -- multiply a single bj Word# to the whole wa WordArray
      mul :: MutableWordArray# d
-> WordArray#
-> Word#
-> Int#
-> Int#
-> Word#
-> State# d
-> State# d
mul MutableWordArray# d
mwa WordArray#
wa Word#
bj Int#
j Int#
i Word#
carry State# d
s
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# WordArray# -> Int#
wordArraySize# WordArray#
wa)
         -- write the carry
         = MutableWordArray# d -> Int# -> Word# -> State# d -> State# d
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaAddInplaceWord# MutableWordArray# d
mwa (Int#
i Int# -> Int# -> Int#
+# Int#
j) Word#
carry State# d
s

         | Bool
True = let
                     ai :: Word#
ai           = WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i
                     !(# Word#
c',Word#
r' #) = Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
ai Word#
bj
                     !(# Word#
c'',Word#
r #) = Word# -> Word# -> (# Word#, Word# #)
plusWord2# Word#
r' Word#
carry
                     carry' :: Word#
carry'       = Word# -> Word# -> Word#
plusWord# Word#
c' Word#
c''
                  in case MutableWordArray# d -> Int# -> Word# -> State# d -> State# d
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaAddInplaceWord# MutableWordArray# d
mwa (Int#
i Int# -> Int# -> Int#
+# Int#
j) Word#
r State# d
s of
                        State# d
s' -> MutableWordArray# d
-> WordArray#
-> Word#
-> Int#
-> Int#
-> Word#
-> State# d
-> State# d
mul MutableWordArray# d
mwa WordArray#
wa Word#
bj Int#
j (Int#
i Int# -> Int# -> Int#
+# Int#
1#) Word#
carry' State# d
s'

      -- for each bj in wb, call `mul bj wa`
      mulEachB :: Int# -> State# RealWorld -> State# RealWorld
mulEachB Int#
i State# RealWorld
s
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
szB) = State# RealWorld
s
         | Bool
True = case WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wb Int#
i of
            -- detect bj == 0## and skip the loop
            Word#
0## -> Int# -> State# RealWorld -> State# RealWorld
mulEachB (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s
            Word#
bi  -> case MutableWordArray# RealWorld
-> WordArray#
-> Word#
-> Int#
-> Int#
-> Word#
-> State# RealWorld
-> State# RealWorld
forall {d}.
MutableWordArray# d
-> WordArray#
-> Word#
-> Int#
-> Int#
-> Word#
-> State# d
-> State# d
mul MutableWordArray# RealWorld
mwa WordArray#
wa Word#
bi Int#
i Int#
ctzA Word#
0## State# RealWorld
s of
                     State# RealWorld
s' -> Int# -> State# RealWorld -> State# RealWorld
mulEachB (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s'

bignat_sub
   :: MutableWordArray# RealWorld
   -> WordArray#
   -> WordArray#
   -> State# RealWorld
   -> (# State# RealWorld, Bool# #)
bignat_sub :: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> (# State# RealWorld, Int# #)
bignat_sub MutableWordArray# RealWorld
mwa WordArray#
wa WordArray#
wb State# RealWorld
s =
   -- initialize the resulting WordArray
   -- Note: we could avoid the copy by subtracting the first non-zero
   -- less-significant word of b...
   case MutableWordArray# RealWorld
-> Int#
-> WordArray#
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall s.
MutableByteArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
mwaArrayCopy# MutableWordArray# RealWorld
mwa Int#
0# WordArray#
wa Int#
0# (WordArray# -> Int#
wordArraySize# WordArray#
wa) State# RealWorld
s of
      State# RealWorld
s' -> MutableWordArray# RealWorld
-> Int#
-> WordArray#
-> State# RealWorld
-> (# State# RealWorld, Int# #)
forall d.
MutableWordArray# d
-> Int# -> WordArray# -> State# d -> (# State# d, Int# #)
mwaSubInplaceArray MutableWordArray# RealWorld
mwa Int#
0# WordArray#
wb State# RealWorld
s'

bignat_popcount :: WordArray# -> Word#
bignat_popcount :: WordArray# -> Word#
bignat_popcount WordArray#
wa = Int# -> Word# -> Word#
go Int#
0# Word#
0##
   where
      !sz :: Int#
sz = WordArray# -> Int#
wordArraySize# WordArray#
wa
      go :: Int# -> Word# -> Word#
go Int#
i Word#
c
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
sz) = Word#
c
         | Bool
True               = Int# -> Word# -> Word#
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) (Word#
c Word# -> Word# -> Word#
`plusWord#` Word# -> Word#
popCnt# (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i))

bignat_shiftl
   :: MutableWordArray# s
   -> WordArray#
   -> Word#
   -> State# s
   -> State# s
bignat_shiftl :: forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
bignat_shiftl MutableWordArray# s
mwa WordArray#
wa Word#
n State# s
s1 =
   -- set the lower words to 0
   case MutableWordArray# s
-> Word# -> Word# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s
-> Word# -> Word# -> Word# -> State# s -> State# s
mwaFill# MutableWordArray# s
mwa Word#
0## Word#
0## (Int# -> Word#
int2Word# Int#
nw) State# s
s1 of
      State# s
s2 -> if
            | Int#
0# <- Int#
nb -> MutableWordArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
mwaArrayCopy# MutableWordArray# s
mwa Int#
nw WordArray#
wa Int#
0# Int#
szA State# s
s2
            | Bool
True     -> Int# -> Word# -> State# s -> State# s
mwaBitShift Int#
0# Word#
0## State# s
s2
   where
      !szA :: Int#
szA          = WordArray# -> Int#
wordArraySize# WordArray#
wa
      !(# Int#
nw, Int#
nb #) = Word# -> (# Int#, Int# #)
count_words_bits_int Word#
n
      !sh :: Int#
sh           = WORD_SIZE_IN_BITS# -# nb

      -- Bit granularity (c is the carry from the previous shift)
      mwaBitShift :: Int# -> Word# -> State# s -> State# s
mwaBitShift Int#
i Word#
c State# s
s
         -- write the carry
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
szA)
         = MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
forall s.
MutableWordArray# s -> Word# -> Int# -> State# s -> State# s
mwaWriteOrShrink MutableWordArray# s
mwa Word#
c (Int#
i Int# -> Int# -> Int#
+# Int#
nw) State# s
s

         | Bool
True =
            let
               !ai :: Word#
ai = WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i
               !v :: Word#
v  = Word#
c Word# -> Word# -> Word#
`or#` (Word#
ai Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
nb)
               !c' :: Word#
c' = Word#
ai Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
sh
            in case MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwa (Int#
i Int# -> Int# -> Int#
+# Int#
nw) Word#
v State# s
s of
                  State# s
s' -> Int# -> Word# -> State# s -> State# s
mwaBitShift (Int#
i Int# -> Int# -> Int#
+# Int#
1#) Word#
c' State# s
s'


bignat_shiftr
   :: MutableWordArray# s
   -> WordArray#
   -> Word#
   -> State# s
   -> State# s
bignat_shiftr :: forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
bignat_shiftr MutableWordArray# s
mwa WordArray#
wa Word#
n State# s
s1
   | Int# -> Bool
isTrue# (Int#
nb Int# -> Int# -> Int#
==# Int#
0#) = MutableWordArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
mwaArrayCopy# MutableWordArray# s
mwa Int#
0# WordArray#
wa Int#
nw Int#
sz State# s
s1
   | Bool
True                = Int# -> Word# -> State# s -> State# s
mwaBitShift (Int#
sz Int# -> Int# -> Int#
-# Int#
1#) Word#
0## State# s
s1
   where
      !szA :: Int#
szA          = WordArray# -> Int#
wordArraySize# WordArray#
wa
      !(# Int#
nw, Int#
nb #) = Word# -> (# Int#, Int# #)
count_words_bits_int Word#
n
      !sz :: Int#
sz           = Int#
szA Int# -> Int# -> Int#
-# Int#
nw
      !sh :: Int#
sh           = WORD_SIZE_IN_BITS# -# nb

      -- Bit granularity (c is the carry from the previous shift)
      mwaBitShift :: Int# -> Word# -> State# s -> State# s
mwaBitShift Int#
i Word#
c State# s
s
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
0#) = State# s
s
         | Bool
True =
            let
               !ai :: Word#
ai = WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa (Int#
i Int# -> Int# -> Int#
+# Int#
nw)
               !v :: Word#
v  = Word#
c Word# -> Word# -> Word#
`or#` (Word#
ai Word# -> Int# -> Word#
`uncheckedShiftRL#` Int#
nb)
               !c' :: Word#
c' = Word#
ai Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
sh
            in case MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwa Int#
i Word#
v State# s
s of
                  State# s
s' -> Int# -> Word# -> State# s -> State# s
mwaBitShift (Int#
i Int# -> Int# -> Int#
-# Int#
1#) Word#
c' State# s
s'

bignat_shiftr_neg
   :: MutableWordArray# s
   -> WordArray#
   -> Word#
   -> State# s
   -> State# s
bignat_shiftr_neg :: forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
bignat_shiftr_neg MutableWordArray# s
mwa WordArray#
wa Word#
n State# s
s1
   -- initialize higher limb of mwa
   = case MutableWordArray# s -> State# s -> (# State# s, Int# #)
forall s. MutableWordArray# s -> State# s -> (# State# s, Int# #)
mwaSize# MutableWordArray# s
mwa State# s
s1 of
      (# State# s
s2, Int#
sz_mwa #) -> case MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwa (Int#
sz_mwa Int# -> Int# -> Int#
-# Int#
1#) Word#
0## State# s
s2 of
        State# s
s3 -> case MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
bignat_shiftr MutableWordArray# s
mwa WordArray#
wa Word#
n State# s
s3 of
           State# s
s4 -> if Bool
nz_shifted_out
                    -- round if non-zero bits were shifted out
                    then MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaAddInplaceWord# MutableWordArray# s
mwa Int#
0# Word#
1## State# s
s4
                    else State# s
s4
   where
      !(# Int#
nw, Int#
nb #) = Word# -> (# Int#, Int# #)
count_words_bits_int Word#
n

      -- non-zero bits are shifted out?
      nz_shifted_out :: Bool
nz_shifted_out
         -- test nb bits
         | Int# -> Bool
isTrue# (
            (Int#
nb Int# -> Int# -> Int#
/=# Int#
0#)
            Int# -> Int# -> Int#
&&# (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
nw Word# -> Int# -> Word#
`uncheckedShiftL#`
                  (WORD_SIZE_IN_BITS# -# nb) `neWord#` 0##))
         = Bool
True
         -- test nw words
         | Bool
True
         = let
            go :: Int# -> Bool
go Int#
j
               | Int# -> Bool
isTrue# (Int#
j Int# -> Int# -> Int#
==# Int#
nw)                           = Bool
False
               | Int# -> Bool
isTrue# (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
j Word# -> Word# -> Int#
`neWord#` Word#
0##) = Bool
True
               | Bool
True                                         = Int# -> Bool
go (Int#
j Int# -> Int# -> Int#
+# Int#
1#)
           in Int# -> Bool
go Int#
0#


bignat_or
   :: MutableWordArray# RealWorld -- ^ Result
   -> WordArray#
   -> WordArray#
   -> State# RealWorld
   -> State# RealWorld
bignat_or :: MutableWordArray# RealWorld
-> WordArray# -> WordArray# -> State# RealWorld -> State# RealWorld
bignat_or MutableWordArray# RealWorld
mwa WordArray#
wa WordArray#
wb State# RealWorld
s1
   | Int# -> Bool
isTrue# (Int#
szA Int# -> Int# -> Int#
>=# Int#
szB) = WordArray#
-> Int#
-> WordArray#
-> Int#
-> State# RealWorld
-> State# RealWorld
go WordArray#
wa Int#
szA WordArray#
wb Int#
szB State# RealWorld
s1
   | Bool
True                  = WordArray#
-> Int#
-> WordArray#
-> Int#
-> State# RealWorld
-> State# RealWorld
go WordArray#
wb Int#
szB WordArray#
wa Int#
szA State# RealWorld
s1
   where
      !szA :: Int#
szA = WordArray# -> Int#
wordArraySize# WordArray#
wa
      !szB :: Int#
szB = WordArray# -> Int#
wordArraySize# WordArray#
wb
      -- nx >= ny
      go :: WordArray#
-> Int#
-> WordArray#
-> Int#
-> State# RealWorld
-> State# RealWorld
go WordArray#
wx Int#
nx WordArray#
wy Int#
ny State# RealWorld
s =
         case MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> (Word# -> Word# -> Word#)
-> State# RealWorld
-> State# RealWorld
forall s.
MutableWordArray# s
-> WordArray#
-> WordArray#
-> (Word# -> Word# -> Word#)
-> State# s
-> State# s
mwaInitArrayBinOp MutableWordArray# RealWorld
mwa WordArray#
wx WordArray#
wy Word# -> Word# -> Word#
or# State# RealWorld
s of
            State# RealWorld
s' -> MutableWordArray# RealWorld
-> Int#
-> WordArray#
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall s.
MutableByteArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
mwaArrayCopy# MutableWordArray# RealWorld
mwa Int#
ny WordArray#
wx Int#
ny (Int#
nx Int# -> Int# -> Int#
-# Int#
ny) State# RealWorld
s'

bignat_xor
   :: MutableWordArray# RealWorld -- ^ Result
   -> WordArray#
   -> WordArray#
   -> State# RealWorld
   -> State# RealWorld
bignat_xor :: MutableWordArray# RealWorld
-> WordArray# -> WordArray# -> State# RealWorld -> State# RealWorld
bignat_xor MutableWordArray# RealWorld
mwa WordArray#
wa WordArray#
wb State# RealWorld
s1
   | Int# -> Bool
isTrue# (Int#
szA Int# -> Int# -> Int#
>=# Int#
szB) = WordArray#
-> Int#
-> WordArray#
-> Int#
-> State# RealWorld
-> State# RealWorld
go WordArray#
wa Int#
szA WordArray#
wb Int#
szB State# RealWorld
s1
   | Bool
True                  = WordArray#
-> Int#
-> WordArray#
-> Int#
-> State# RealWorld
-> State# RealWorld
go WordArray#
wb Int#
szB WordArray#
wa Int#
szA State# RealWorld
s1
   where
      !szA :: Int#
szA = WordArray# -> Int#
wordArraySize# WordArray#
wa
      !szB :: Int#
szB = WordArray# -> Int#
wordArraySize# WordArray#
wb
      -- nx >= ny
      go :: WordArray#
-> Int#
-> WordArray#
-> Int#
-> State# RealWorld
-> State# RealWorld
go WordArray#
wx Int#
nx WordArray#
wy Int#
ny State# RealWorld
s =
         case MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> (Word# -> Word# -> Word#)
-> State# RealWorld
-> State# RealWorld
forall s.
MutableWordArray# s
-> WordArray#
-> WordArray#
-> (Word# -> Word# -> Word#)
-> State# s
-> State# s
mwaInitArrayBinOp MutableWordArray# RealWorld
mwa WordArray#
wx WordArray#
wy Word# -> Word# -> Word#
xor# State# RealWorld
s of
            State# RealWorld
s' -> MutableWordArray# RealWorld
-> Int#
-> WordArray#
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall s.
MutableByteArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
mwaArrayCopy# MutableWordArray# RealWorld
mwa Int#
ny WordArray#
wx Int#
ny (Int#
nx Int# -> Int# -> Int#
-# Int#
ny) State# RealWorld
s'

bignat_and
   :: MutableWordArray# RealWorld -- ^ Result
   -> WordArray#
   -> WordArray#
   -> State# RealWorld
   -> State# RealWorld
bignat_and :: MutableWordArray# RealWorld
-> WordArray# -> WordArray# -> State# RealWorld -> State# RealWorld
bignat_and MutableWordArray# RealWorld
mwa WordArray#
wa WordArray#
wb State# RealWorld
s = MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> (Word# -> Word# -> Word#)
-> State# RealWorld
-> State# RealWorld
forall s.
MutableWordArray# s
-> WordArray#
-> WordArray#
-> (Word# -> Word# -> Word#)
-> State# s
-> State# s
mwaInitArrayBinOp MutableWordArray# RealWorld
mwa WordArray#
wa WordArray#
wb Word# -> Word# -> Word#
and# State# RealWorld
s

bignat_and_not
   :: MutableWordArray# RealWorld -- ^ Result
   -> WordArray#
   -> WordArray#
   -> State# RealWorld
   -> State# RealWorld
bignat_and_not :: MutableWordArray# RealWorld
-> WordArray# -> WordArray# -> State# RealWorld -> State# RealWorld
bignat_and_not MutableWordArray# RealWorld
mwa WordArray#
wa WordArray#
wb State# RealWorld
s =
   case MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> (Word# -> Word# -> Word#)
-> State# RealWorld
-> State# RealWorld
forall s.
MutableWordArray# s
-> WordArray#
-> WordArray#
-> (Word# -> Word# -> Word#)
-> State# s
-> State# s
mwaInitArrayBinOp MutableWordArray# RealWorld
mwa WordArray#
wa WordArray#
wb (\Word#
x Word#
y -> Word#
x Word# -> Word# -> Word#
`and#` Word# -> Word#
not# Word#
y) State# RealWorld
s of
      State# RealWorld
s' -> MutableWordArray# RealWorld
-> Int#
-> WordArray#
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall s.
MutableByteArray# s
-> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s
mwaArrayCopy# MutableWordArray# RealWorld
mwa Int#
szB WordArray#
wa Int#
szB (Int#
szA Int# -> Int# -> Int#
-# Int#
szB) State# RealWorld
s'
   where
      !szA :: Int#
szA = WordArray# -> Int#
wordArraySize# WordArray#
wa
      !szB :: Int#
szB = WordArray# -> Int#
wordArraySize# WordArray#
wb

bignat_quotrem
   :: MutableWordArray# s
   -> MutableWordArray# s
   -> WordArray#
   -> WordArray#
   -> State# s
   -> State# s
bignat_quotrem :: forall s.
MutableWordArray# s
-> MutableWordArray# s
-> WordArray#
-> WordArray#
-> State# s
-> State# s
bignat_quotrem MutableWordArray# s
mwq MutableWordArray# s
mwr WordArray#
uwa WordArray#
uwb State# s
s0 =
   -- Normalization consists in left-shifting bits in B and A so that the
   -- most-significant bit of the most-significant word of B is 1. It makes
   -- quotient prediction much more efficient as we only use the two most
   -- significant words of A and the most significant word of B to make the
   -- prediction.

   -- we will left-shift A and B of "clzb" bits for normalization
   let !clzb :: Word#
clzb  = Word# -> Word#
clz# (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
uwb (WordArray# -> Int#
wordArraySize# WordArray#
uwb Int# -> Int# -> Int#
-# Int#
1#))

   -- we use a single array initially containing A (normalized) and
   -- returning the remainder (normalized): mnwa (for "mutable normalized
   -- wordarray A")
   --
   -- We allocate it here with an additionnal Word compared to A because
   -- normalizing can left shift at most (N-1) bits (on N-bit arch).
   in case Int# -> State# s -> (# State# s, MutableWordArray# s #)
forall s. Int# -> State# s -> (# State# s, MutableWordArray# s #)
newWordArray# (WordArray# -> Int#
wordArraySize# WordArray#
uwa Int# -> Int# -> Int#
+# Int#
1#) State# s
s0 of { (# State# s
s1, MutableWordArray# s
mnwa #) ->

   -- normalized A in mnwa
   let normalizeA :: State# s -> State# s
normalizeA State# s
s = case MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mnwa (WordArray# -> Int#
wordArraySize# WordArray#
uwa) Word#
0## State# s
s of -- init potential carry
                         State# s
s -> case MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
bignat_shiftl MutableWordArray# s
mnwa WordArray#
uwa Word#
clzb State# s
s of     -- left shift
                            State# s
s -> MutableWordArray# s -> State# s -> State# s
forall s. MutableByteArray# s -> State# s -> State# s
mwaTrimZeroes# MutableWordArray# s
mnwa State# s
s                  -- remove null carry if any
   in case State# s -> State# s
normalizeA State# s
s1 of { State# s
s2 ->

   -- normalize B. We don't do it in a MutableWordArray because it will remain
   -- constant during the whole computation.
   let !nwb :: WordArray#
nwb = WordArray# -> Word# -> WordArray#
bigNatShiftL# WordArray#
uwb Word#
clzb in

   -- perform quotrem on normalized inputs
   case MutableWordArray# s
-> MutableWordArray# s -> WordArray# -> State# s -> State# s
forall s.
MutableWordArray# s
-> MutableWordArray# s -> WordArray# -> State# s -> State# s
bignat_quotrem_normalized MutableWordArray# s
mwq MutableWordArray# s
mnwa WordArray#
nwb State# s
s2 of { State# s
s3 ->

   -- denormalize the remainder now stored in mnwa. We just have to right shift
   -- of "clzb" bits. We copy the result into "mwr" array.
   let denormalizeR :: State# s -> State# s
denormalizeR State# s
s = case MutableWordArray# s -> State# s -> State# s
forall s. MutableByteArray# s -> State# s -> State# s
mwaTrimZeroes# MutableWordArray# s
mnwa State# s
s of
                         State# s
s -> case MutableWordArray# s -> State# s -> (# State# s, WordArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, WordArray# #)
unsafeFreezeByteArray# MutableWordArray# s
mnwa State# s
s of
                            (# State# s
s, WordArray#
wr #) -> case MutableWordArray# s -> Int# -> State# s -> State# s
forall s. MutableByteArray# s -> Int# -> State# s -> State# s
mwaSetSize# MutableWordArray# s
mwr (WordArray# -> Int#
wordArraySize# WordArray#
wr) State# s
s of
                               State# s
s -> case MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
bignat_shiftr MutableWordArray# s
mwr WordArray#
wr Word#
clzb State# s
s of
                                 State# s
s -> MutableWordArray# s -> State# s -> State# s
forall s. MutableByteArray# s -> State# s -> State# s
mwaTrimZeroes# MutableWordArray# s
mwr State# s
s
   in State# s -> State# s
denormalizeR State# s
s3
   }}}



bignat_quot
   :: MutableWordArray# RealWorld
   -> WordArray#
   -> WordArray#
   -> State# RealWorld
   -> State# RealWorld
bignat_quot :: MutableWordArray# RealWorld
-> WordArray# -> WordArray# -> State# RealWorld -> State# RealWorld
bignat_quot MutableWordArray# RealWorld
mwq WordArray#
wa WordArray#
wb State# RealWorld
s =
   -- allocate a temporary array for the remainder and call quotrem
   case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableWordArray# RealWorld #)
forall s. Int# -> State# s -> (# State# s, MutableWordArray# s #)
newWordArray# (WordArray# -> Int#
wordArraySize# WordArray#
wb) State# RealWorld
s of
      (# State# RealWorld
s, MutableWordArray# RealWorld
mwr #) -> MutableWordArray# RealWorld
-> MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
forall s.
MutableWordArray# s
-> MutableWordArray# s
-> WordArray#
-> WordArray#
-> State# s
-> State# s
bignat_quotrem MutableWordArray# RealWorld
mwq MutableWordArray# RealWorld
mwr WordArray#
wa WordArray#
wb State# RealWorld
s

bignat_rem
   :: MutableWordArray# RealWorld
   -> WordArray#
   -> WordArray#
   -> State# RealWorld
   -> State# RealWorld
bignat_rem :: MutableWordArray# RealWorld
-> WordArray# -> WordArray# -> State# RealWorld -> State# RealWorld
bignat_rem MutableWordArray# RealWorld
mwr WordArray#
wa WordArray#
wb State# RealWorld
s =
   -- allocate a temporary array for the quotient and call quotrem
   -- (we could avoid allocating it as it is not used to compute the result but
   -- it would require non trivial modification of bignat_quotrem)
   case Int#
-> State# RealWorld
-> (# State# RealWorld, MutableWordArray# RealWorld #)
forall s. Int# -> State# s -> (# State# s, MutableWordArray# s #)
newWordArray# Int#
szQ State# RealWorld
s of
      (# State# RealWorld
s, MutableWordArray# RealWorld
mwq #) -> MutableWordArray# RealWorld
-> MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
forall s.
MutableWordArray# s
-> MutableWordArray# s
-> WordArray#
-> WordArray#
-> State# s
-> State# s
bignat_quotrem MutableWordArray# RealWorld
mwq MutableWordArray# RealWorld
mwr WordArray#
wa WordArray#
wb State# RealWorld
s
   where
   szA :: Int#
szA = WordArray# -> Int#
wordArraySize# WordArray#
wa
   szB :: Int#
szB = WordArray# -> Int#
wordArraySize# WordArray#
wb
   szQ :: Int#
szQ = Int#
1# Int# -> Int# -> Int#
+# Int#
szA Int# -> Int# -> Int#
-# Int#
szB

-- | Perform quotRem on normalized inputs:
--    * highest bit of B is set
--    * A is trimmed
--    * A >= B
--    * B > 1
bignat_quotrem_normalized
   :: MutableWordArray# s
   -> MutableWordArray# s
   -> WordArray#
   -> State# s
   -> State# s
bignat_quotrem_normalized :: forall s.
MutableWordArray# s
-> MutableWordArray# s -> WordArray# -> State# s -> State# s
bignat_quotrem_normalized MutableWordArray# s
mwq MutableWordArray# s
mwa WordArray#
b State# s
s0 =

   -- n is the size of B
   let !n :: Int#
n = WordArray# -> Int#
wordArraySize# WordArray#
b

   -- m+n is the size of A (m >= 0)
   in case MutableWordArray# s -> State# s -> (# State# s, Int# #)
forall s. MutableWordArray# s -> State# s -> (# State# s, Int# #)
mwaSize# MutableWordArray# s
mwa State# s
s0 of { (# State# s
s1, Int#
szA #) ->
   let !m :: Int#
m = Int#
szA Int# -> Int# -> Int#
-# Int#
n in

   -- Definitions:
   --    MSW(x) is the most-significant word of x
   --    MSB(x) the most-significant bit of x

   -- We first compute MSW(Q).  Thanks to the normalization of B, MSW(Q) can
   -- only be 0 or 1 so we only have to perform a prefix comparison to compute
   -- MSW(Q).
   --
   --    Proof MSW(Q) < 2:
   --       * MSB(MSW(B)) = 1 thanks to normalization.
   --       * MSW(B) * MSW(Q) <= MSW(A) by definition
   --       * suppose MSW(Q) >= 2:
   --          MSW(B) * MSW(Q) >= MSW(B) << 1    { MSW(Q) >= 2              }
   --                          >  MAX_WORD_VALUE { MSB(MSW(B)) = 1          }
   --                          >  MSW(A)         { MSW(A) <= MAX_WORD_VALUE }
   --          contradiction.
   --
   -- If A >= (B << m words)
   --    then Qm = 1
   --         A := A - (B << m words)
   --    else Qm = 0
   --         A unchanged
   let computeQm :: State# s -> (# State# s, Word# #)
computeQm State# s
s = case Int#
-> MutableWordArray# s
-> WordArray#
-> State# s
-> (# State# s, Ordering #)
forall s.
Int#
-> MutableWordArray# s
-> WordArray#
-> State# s
-> (# State# s, Ordering #)
mwaTrimCompare Int#
m MutableWordArray# s
mwa WordArray#
b State# s
s of
         (# State# s
s, Ordering
LT #) -> (# State# s
s, Word#
0## #)
         (# State# s
s, Ordering
_  #) -> (# State# s
s, Word#
1## #)

       updateQj :: Int# -> Word# -> WordArray# -> State# s -> State# s
updateQj Int#
j Word#
qj WordArray#
qjb State# s
s = case MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwq Int#
j Word#
qj State# s
s of -- write Qj
               State# s
s | Word#
0## <- Word#
qj -> State# s
s
                 | Bool
True      -> case MutableWordArray# s
-> Int# -> WordArray# -> State# s -> (# State# s, Int# #)
forall d.
MutableWordArray# d
-> Int# -> WordArray# -> State# d -> (# State# d, Int# #)
mwaSubInplaceArray MutableWordArray# s
mwa Int#
j WordArray#
qjb State# s
s of -- subtract (qjB << j words)
                                 (# State# s
s, Int#
_ #) -> State# s
s

       -- update the highest word of Q
       updateQm :: State# s -> State# s
updateQm State# s
s = case State# s -> (# State# s, Word# #)
computeQm State# s
s of
         (# State# s
s, Word#
qm #) -> Int# -> Word# -> WordArray# -> State# s -> State# s
updateQj Int#
m Word#
qm WordArray#
b State# s
s

       -- the size of Q is szA+szB+1 BEFORE normalization. Normalization may add
       -- an additional higher word to A.
       --   * If A has an additional limb:
       --      * MSW(A) < MSW(B). Because MSB(MSW(A)) can't be set (it would
       --        mean that we shifted a whole word, which we didn't)
       --      * hence MSW(Q) = 0 but we don't have to write it (and we mustn't)
       --        because of the size of Q
       --   * If A has no additional limb:
       --      * We have to check if MSW(A) >= MSW(B) and to adjust A and MSW(Q)
       --        accordingly
       --
       -- We detect if A has an additional limb by comparing the size of Q with m
       updateQmMaybe :: State# s -> State# s
updateQmMaybe State# s
s = case MutableWordArray# s -> State# s -> (# State# s, Int# #)
forall s. MutableWordArray# s -> State# s -> (# State# s, Int# #)
mwaSize# MutableWordArray# s
mwq State# s
s of
         (# State# s
s, Int#
szQ #) | Int# -> Bool
isTrue# (Int#
m Int# -> Int# -> Int#
<# Int#
szQ) -> State# s -> State# s
updateQm State# s
s
                      | Bool
True               -> State# s
s

   in case State# s -> State# s
updateQmMaybe State# s
s1 of { State# s
s2 ->


   -- main loop: for j from (m-1) downto 0
   --    We estimate a one Word quotient qj:
   --       e1e0 <- a(n+j)a(n+j-1) `div` b(n-1)
   --       qj | e1 == 0   = e0
   --          | otherwise = maxBound
   --    We loop until we find the real quotient:
   --       while (A < ((qj*B) << j words)) qj--
   --    We update A and Qj:
   --       Qj := qj
   --       A  := A - (qj*B << j words)

   let bmsw :: Word#
bmsw = WordArray# -> Word#
wordArrayLast# WordArray#
b -- most significant word of B

       estimateQj :: Int# -> State# s -> (# State# s, Word# #)
estimateQj Int#
j State# s
s =
         case MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall s.
MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
mwaRead# MutableWordArray# s
mwa (Int#
n Int# -> Int# -> Int#
+# Int#
j) State# s
s of
           (# State# s
s, Word#
a1 #) -> case MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall s.
MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #)
mwaRead# MutableWordArray# s
mwa (Int#
n Int# -> Int# -> Int#
+# Int#
j Int# -> Int# -> Int#
-# Int#
1#) State# s
s of
             (# State# s
s, Word#
a0 #) -> case (# Word#, Word# #) -> Word# -> (# (# Word#, Word# #), Word# #)
quotRemWord3# (# Word#
a1, Word#
a0 #) Word#
bmsw of
               (# (# Word#
0##, Word#
qj #), Word#
_ #) -> (# State# s
s,              Word#
qj #)
               (# (#   Word#
_,  Word#
_ #), Word#
_ #) -> (# State# s
s, WORD_MAXBOUND## #)

       -- we perform the qj*B multiplication once and then we subtract B from
       -- qj*B as much as needed until (qj'*B << j words) <= A
       findRealQj :: Int# -> Word# -> State# s -> (# State# s, Word#, WordArray# #)
findRealQj Int#
j Word#
qj State# s
s = Int#
-> Word#
-> WordArray#
-> State# s
-> (# State# s, Word#, WordArray# #)
findRealQj' Int#
j Word#
qj (WordArray# -> Word# -> WordArray#
bigNatMulWord# WordArray#
b Word#
qj) State# s
s

       findRealQj' :: Int#
-> Word#
-> WordArray#
-> State# s
-> (# State# s, Word#, WordArray# #)
findRealQj' Int#
j Word#
qj WordArray#
qjB State# s
s = case Int#
-> MutableWordArray# s
-> WordArray#
-> State# s
-> (# State# s, Ordering #)
forall s.
Int#
-> MutableWordArray# s
-> WordArray#
-> State# s
-> (# State# s, Ordering #)
mwaTrimCompare Int#
j MutableWordArray# s
mwa WordArray#
qjB State# s
s of
         (# State# s
s, Ordering
LT #) -> Int#
-> Word#
-> WordArray#
-> State# s
-> (# State# s, Word#, WordArray# #)
findRealQj' Int#
j (Word#
qj Word# -> Word# -> Word#
`minusWord#` Word#
1##) (WordArray# -> WordArray# -> WordArray#
bigNatSubUnsafe WordArray#
qjB WordArray#
b) State# s
s
                                                            -- TODO: we could do the sub inplace to
                                                            -- reduce allocations
         (# State# s
s, Ordering
_  #) -> (# State# s
s, Word#
qj, WordArray#
qjB #)

       loop :: Int# -> State# s -> State# s
loop Int#
j State# s
s = case Int# -> State# s -> (# State# s, Word# #)
estimateQj Int#
j State# s
s of
         (# State# s
s, Word#
qj #) -> case Int# -> Word# -> State# s -> (# State# s, Word#, WordArray# #)
findRealQj Int#
j Word#
qj State# s
s of
            (# State# s
s, Word#
qj, WordArray#
qjB #) -> case Int# -> Word# -> WordArray# -> State# s -> State# s
updateQj Int#
j Word#
qj WordArray#
qjB State# s
s of
               State# s
s | Int#
0# <- Int#
j -> State# s
s
                 | Bool
True    -> Int# -> State# s -> State# s
loop (Int#
j Int# -> Int# -> Int#
-# Int#
1#) State# s
s


   in if | Int#
0# <- Int#
m -> State# s
s2
         | Bool
True    -> Int# -> State# s -> State# s
loop (Int#
m Int# -> Int# -> Int#
-# Int#
1#) State# s
s2
   }}

bignat_quotrem_word
   :: MutableWordArray# s -- ^ Quotient
   -> WordArray#
   -> Word#
   -> State# s
   -> (# State# s, Word# #)
bignat_quotrem_word :: forall s.
MutableWordArray# s
-> WordArray# -> Word# -> State# s -> (# State# s, Word# #)
bignat_quotrem_word MutableWordArray# s
mwq WordArray#
wa Word#
b State# s
s = Int# -> Word# -> State# s -> (# State# s, Word# #)
go (Int#
sz Int# -> Int# -> Int#
-# Int#
1#) Word#
0## State# s
s
   where
      sz :: Int#
sz = WordArray# -> Int#
wordArraySize# WordArray#
wa
      go :: Int# -> Word# -> State# s -> (# State# s, Word# #)
go Int#
i Word#
r State# s
s
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
0#) = (# State# s
s, Word#
r #)
         | Bool
True =
            let
               ai :: Word#
ai          = WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i
               !(# Word#
q,Word#
r' #) = Word# -> Word# -> Word# -> (# Word#, Word# #)
quotRemWord2# Word#
r Word#
ai Word#
b
            in case MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwq Int#
i Word#
q State# s
s of
                  State# s
s' -> Int# -> Word# -> State# s -> (# State# s, Word# #)
go (Int#
i Int# -> Int# -> Int#
-# Int#
1#) Word#
r' State# s
s'

bignat_quot_word
   :: MutableWordArray# s -- ^ Quotient
   -> WordArray#
   -> Word#
   -> State# s
   -> State# s
bignat_quot_word :: forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
bignat_quot_word MutableWordArray# s
mwq WordArray#
wa Word#
b State# s
s = Int# -> Word# -> State# s -> State# s
go (Int#
sz Int# -> Int# -> Int#
-# Int#
1#) Word#
0## State# s
s
   where
      sz :: Int#
sz = WordArray# -> Int#
wordArraySize# WordArray#
wa
      go :: Int# -> Word# -> State# s -> State# s
go Int#
i Word#
r State# s
s
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
0#) = State# s
s
         | Bool
True =
            let
               ai :: Word#
ai          = WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i
               !(# Word#
q,Word#
r' #) = Word# -> Word# -> Word# -> (# Word#, Word# #)
quotRemWord2# Word#
r Word#
ai Word#
b
            in case MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwq Int#
i Word#
q State# s
s of
                  State# s
s' -> Int# -> Word# -> State# s -> State# s
go (Int#
i Int# -> Int# -> Int#
-# Int#
1#) Word#
r' State# s
s'

bignat_rem_word
   :: WordArray#
   -> Word#
   -> Word#
bignat_rem_word :: WordArray# -> Word# -> Word#
bignat_rem_word WordArray#
wa Word#
b = Int# -> Word# -> Word#
go (Int#
sz Int# -> Int# -> Int#
-# Int#
1#) Word#
0##
   where
      sz :: Int#
sz = WordArray# -> Int#
wordArraySize# WordArray#
wa
      go :: Int# -> Word# -> Word#
go Int#
i Word#
r
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
0#) = Word#
r
         | Bool
True =
            let
               ai :: Word#
ai          = WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i
               !(# Word#
_,Word#
r' #) = Word# -> Word# -> Word# -> (# Word#, Word# #)
quotRemWord2# Word#
r Word#
ai Word#
b
            in Int# -> Word# -> Word#
go (Int#
i Int# -> Int# -> Int#
-# Int#
1#) Word#
r'


bignat_gcd
   :: MutableWordArray# s
   -> WordArray#
   -> WordArray#
   -> State# s
   -> State# s
bignat_gcd :: forall s.
MutableWordArray# s
-> WordArray# -> WordArray# -> State# s -> State# s
bignat_gcd MutableWordArray# s
mwr = WordArray# -> WordArray# -> State# s -> State# s
go
   where
      go :: WordArray# -> WordArray# -> State# s -> State# s
go WordArray#
wmax WordArray#
wmin State# s
s
         | Int# -> Bool
isTrue# (WordArray# -> Int#
wordArraySize# WordArray#
wmin Int# -> Int# -> Int#
==# Int#
0#)
         = MutableWordArray# s -> WordArray# -> State# s -> State# s
forall s. MutableByteArray# s -> WordArray# -> State# s -> State# s
mwaInitCopyShrink# MutableWordArray# s
mwr WordArray#
wmax State# s
s

         | Bool
True
         = let
             wmax' :: WordArray#
wmax' = WordArray#
wmin
             !wmin' :: WordArray#
wmin' = WordArray# -> WordArray# -> WordArray#
bigNatRem WordArray#
wmax WordArray#
wmin
           in WordArray# -> WordArray# -> State# s -> State# s
go WordArray#
wmax' WordArray#
wmin' State# s
s

bignat_gcd_word
   :: WordArray#
   -> Word#
   -> Word#
bignat_gcd_word :: WordArray# -> Word# -> Word#
bignat_gcd_word WordArray#
a Word#
b = Word# -> Word# -> Word#
bignat_gcd_word_word Word#
b (WordArray# -> Word# -> Word#
bigNatRemWord# WordArray#
a Word#
b)

-- | This operation doesn't really belongs here, but GMP's one is much faster
-- than this simple implementation (basic Euclid algorithm).
--
-- Ideally we should make an implementation as fast as GMP's one and put it into
-- GHC.Num.Primitives.
bignat_gcd_word_word
   :: Word#
   -> Word#
   -> Word#
bignat_gcd_word_word :: Word# -> Word# -> Word#
bignat_gcd_word_word Word#
a Word#
0## = Word#
a
bignat_gcd_word_word Word#
a Word#
b   = Word# -> Word# -> Word#
bignat_gcd_word_word Word#
b (Word#
a Word# -> Word# -> Word#
`remWord#` Word#
b)

bignat_encode_double :: WordArray# -> Int# -> Double#
bignat_encode_double :: WordArray# -> Int# -> Double#
bignat_encode_double WordArray#
wa Int#
e0 = Double# -> Int# -> Int# -> Double#
go Double#
0.0## Int#
e0 Int#
0#
   where
      sz :: Int#
sz = WordArray# -> Int#
wordArraySize# WordArray#
wa
      go :: Double# -> Int# -> Int# -> Double#
go Double#
acc Int#
e Int#
i
         | Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
>=# Int#
sz) = Double#
acc
         | Bool
True
         = Double# -> Int# -> Int# -> Double#
go (Double#
acc Double# -> Double# -> Double#
+## Word# -> Int# -> Double#
wordEncodeDouble# (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
wa Int#
i) Int#
e)
              (Int#
e Int# -> Int# -> Int#
+# WORD_SIZE_IN_BITS#) -- FIXME: we assume that e doesn't overflow...
              (Int#
i Int# -> Int# -> Int#
+# Int#
1#)

bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word#
bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word#
bignat_powmod_word WordArray#
b0 WordArray#
e0 Word#
m = Natural -> Natural -> Natural -> Word#
go (WordArray# -> Natural
naturalFromBigNat# WordArray#
b0) (WordArray# -> Natural
naturalFromBigNat# WordArray#
e0) (Word# -> Natural
naturalFromWord# Word#
1##)
   where
      go :: Natural -> Natural -> Natural -> Word#
go !Natural
b Natural
e !Natural
r
        | Int# -> Bool
isTrue# (Natural
e Natural -> Word# -> Int#
`naturalTestBit#` Word#
0##)
        = Natural -> Natural -> Natural -> Word#
go Natural
b' Natural
e' ((Natural
r Natural -> Natural -> Natural
`naturalMul` Natural
b) Natural -> Natural -> Natural
`naturalRem` Natural
m')

        | Natural -> Bool
naturalIsZero Natural
e
        = Natural -> Word#
naturalToWord# Natural
r

        | Bool
True
        = Natural -> Natural -> Natural -> Word#
go Natural
b' Natural
e' Natural
r
        where
          b' :: Natural
b' = (Natural
b Natural -> Natural -> Natural
`naturalMul` Natural
b) Natural -> Natural -> Natural
`naturalRem` Natural
m'
          m' :: Natural
m' = Word# -> Natural
naturalFromWord# Word#
m
          e' :: Natural
e' = Natural
e Natural -> Word# -> Natural
`naturalShiftR#` Word#
1## -- slightly faster than "e `div` 2"

bignat_powmod
   :: MutableWordArray# RealWorld
   -> WordArray#
   -> WordArray#
   -> WordArray#
   -> State# RealWorld
   -> State# RealWorld
bignat_powmod :: MutableWordArray# RealWorld
-> WordArray#
-> WordArray#
-> WordArray#
-> State# RealWorld
-> State# RealWorld
bignat_powmod MutableWordArray# RealWorld
r WordArray#
b0 WordArray#
e0 WordArray#
m State# RealWorld
s = MutableWordArray# RealWorld
-> WordArray# -> State# RealWorld -> State# RealWorld
forall s. MutableByteArray# s -> WordArray# -> State# s -> State# s
mwaInitCopyShrink# MutableWordArray# RealWorld
r WordArray#
r' State# RealWorld
s
   where
      !r' :: WordArray#
r' = Natural -> Natural -> Natural -> WordArray#
go (WordArray# -> Natural
naturalFromBigNat# WordArray#
b0)
               (WordArray# -> Natural
naturalFromBigNat# WordArray#
e0)
               (Word# -> Natural
naturalFromWord# Word#
1##)

      go :: Natural -> Natural -> Natural -> WordArray#
go !Natural
b Natural
e !Natural
r
        | Int# -> Bool
isTrue# (Natural
e Natural -> Word# -> Int#
`naturalTestBit#` Word#
0##)
        = Natural -> Natural -> Natural -> WordArray#
go Natural
b' Natural
e' ((Natural
r Natural -> Natural -> Natural
`naturalMul` Natural
b) Natural -> Natural -> Natural
`naturalRem` Natural
m')

        | Natural -> Bool
naturalIsZero Natural
e
        = Natural -> WordArray#
naturalToBigNat# Natural
r

        | Bool
True
        = Natural -> Natural -> Natural -> WordArray#
go Natural
b' Natural
e' Natural
r
        where
          b' :: Natural
b' = (Natural
b Natural -> Natural -> Natural
`naturalMul` Natural
b) Natural -> Natural -> Natural
`naturalRem` Natural
m'
          m' :: Natural
m' = WordArray# -> Natural
naturalFromBigNat# WordArray#
m
          e' :: Natural
e' = Natural
e Natural -> Word# -> Natural
`naturalShiftR#` Word#
1## -- slightly faster than "e `div` 2"

bignat_powmod_words
   :: Word#
   -> Word#
   -> Word#
   -> Word#
bignat_powmod_words :: Word# -> Word# -> Word# -> Word#
bignat_powmod_words Word#
b Word#
e Word#
m =
   WordArray# -> WordArray# -> Word# -> Word#
bignat_powmod_word (Word# -> WordArray#
wordArrayFromWord# Word#
b)
                      (Word# -> WordArray#
wordArrayFromWord# Word#
e)
                      Word#
m


integer_gcde
   :: Integer
   -> Integer
   -> (# Integer, Integer, Integer #)
integer_gcde :: Integer -> Integer -> (# Integer, Integer, Integer #)
integer_gcde Integer
a Integer
b = (# Integer, Integer, Integer #)
-> (# Integer, Integer, Integer #)
-> (# Integer, Integer, Integer #)
f (# Integer
a,Integer
integerOne,Integer
integerZero #) (# Integer
b,Integer
integerZero,Integer
integerOne #)
  where
    -- returned "g" must be positive
    fix :: (# Integer, Integer, Integer #) -> (# Integer, Integer, Integer #)
fix (# Integer
g, Integer
x, Integer
y #)
       | Integer -> Bool
integerIsNegative Integer
g = (# Integer -> Integer
integerNegate Integer
g, Integer -> Integer
integerNegate Integer
x, Integer -> Integer
integerNegate Integer
y #)
       | Bool
True                = (# Integer
g,Integer
x,Integer
y #)

    f :: (# Integer, Integer, Integer #)
-> (# Integer, Integer, Integer #)
-> (# Integer, Integer, Integer #)
f old :: (# Integer, Integer, Integer #)
old@(# Integer
old_g, Integer
old_s, Integer
old_t #) new :: (# Integer, Integer, Integer #)
new@(# Integer
g, Integer
s, Integer
t #)
      | Integer -> Bool
integerIsZero Integer
g = (# Integer, Integer, Integer #) -> (# Integer, Integer, Integer #)
fix (# Integer, Integer, Integer #)
old
      | Bool
True            = case Integer -> Integer -> (# Integer, Integer #)
integerQuotRem# Integer
old_g Integer
g of
                              !(# Integer
q, Integer
r #) -> (# Integer, Integer, Integer #)
-> (# Integer, Integer, Integer #)
-> (# Integer, Integer, Integer #)
f (# Integer, Integer, Integer #)
new (# Integer
r , Integer
old_s Integer -> Integer -> Integer
`integerSub` (Integer
q Integer -> Integer -> Integer
`integerMul` Integer
s)
                                                        , Integer
old_t Integer -> Integer -> Integer
`integerSub` (Integer
q Integer -> Integer -> Integer
`integerMul` Integer
t) #)

integer_recip_mod
   :: Integer
   -> Natural
   -> (# Natural | () #)
integer_recip_mod :: Integer -> Natural -> (# Natural | () #)
integer_recip_mod Integer
x Natural
m =
   let m' :: Integer
m' = Natural -> Integer
integerFromNatural Natural
m
   in case Integer -> Integer -> (# Integer, Integer, Integer #)
integer_gcde Integer
x Integer
m' of
      (# Integer
g, Integer
a, Integer
_b #)
         -- gcd(x,m) = ax+mb = 1
         -- ==> ax - 1 = -mb
         -- ==> ax     = 1 [m]
         | Integer
g Integer -> Integer -> Bool
`integerEq` Integer
integerOne -> (# Integer -> Natural
integerToNatural (Integer
a Integer -> Integer -> Integer
`integerMod` Integer
m') | #)
                                       -- a `mod` m > 0 because m > 0
         | Bool
True                     -> (# | () #)

integer_powmod
   :: Integer
   -> Natural
   -> Natural
   -> Natural
integer_powmod :: Integer -> Natural -> Natural -> Natural
integer_powmod Integer
b0 Natural
e0 Natural
m = Integer -> Natural -> Integer -> Natural
go Integer
b0 Natural
e0 Integer
integerOne
   where
      !m' :: Integer
m' = Natural -> Integer
integerFromNatural Natural
m

      go :: Integer -> Natural -> Integer -> Natural
go !Integer
b Natural
e !Integer
r
        | Int# -> Bool
isTrue# (Natural
e Natural -> Word# -> Int#
`naturalTestBit#` Word#
0##)
        = Integer -> Natural -> Integer -> Natural
go Integer
b' Natural
e' ((Integer
r Integer -> Integer -> Integer
`integerMul` Integer
b) Integer -> Integer -> Integer
`integerMod` Integer
m')

        | Natural -> Bool
naturalIsZero Natural
e
        = Integer -> Natural
integerToNatural Integer
r -- r >= 0 by integerMod above

        | Bool
True
        = Integer -> Natural -> Integer -> Natural
go Integer
b' Natural
e' Integer
r
        where
          b' :: Integer
b' = (Integer
b Integer -> Integer -> Integer
`integerMul` Integer
b) Integer -> Integer -> Integer
`integerRem` Integer
m'
          e' :: Natural
e' = Natural
e Natural -> Word# -> Natural
`naturalShiftR#` Word#
1##