{-# 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 ()
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
-> 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
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 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))
= 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)
= 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
=
case 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' -> 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 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
-> 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 = 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 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# #)
| 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 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# #)
(# Word#
l , Int#
c #) -> case 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
-> 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) = 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 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
-> 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 =
case 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'
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)
mul :: Word#
-> Int# -> Int# -> Word# -> State# RealWorld -> State# RealWorld
mul Word#
bj Int#
j Int#
i Word#
carry State# RealWorld
s
| Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
szA)
= forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaAddInplaceWord# MutableWordArray# RealWorld
mwa (Int#
i Int# -> Int# -> Int#
+# Int#
j) Word#
carry State# RealWorld
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 forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaAddInplaceWord# MutableWordArray# RealWorld
mwa (Int#
i Int# -> Int# -> Int#
+# Int#
j) Word#
r State# RealWorld
s of
State# RealWorld
s' -> Word#
-> Int# -> Int# -> Word# -> State# RealWorld -> State# RealWorld
mul Word#
bj Int#
j (Int#
i Int# -> Int# -> Int#
+# Int#
1#) Word#
carry' State# RealWorld
s'
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
Word#
0## -> Int# -> State# RealWorld -> State# RealWorld
mulEachB (Int#
i Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s
Word#
bi -> case Word#
-> Int# -> Int# -> Word# -> State# RealWorld -> State# RealWorld
mul 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 =
case 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' -> 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 =
case 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 -> 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
mwaBitShift :: Int# -> Word# -> State# s -> State# s
mwaBitShift Int#
i Word#
c State# s
s
| Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
==# Int#
szA)
= 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 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#) = 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
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 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
= case forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwa (Int#
szA Int# -> Int# -> Int#
-# Int#
1#) Word#
0## State# s
s1 of
State# s
s2 -> case forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
bignat_shiftr MutableWordArray# s
mwa WordArray#
wa Word#
n State# s
s2 of
State# s
s3 -> if Bool
nz_shifted_out
then forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaAddInplaceWord# MutableWordArray# s
mwa Int#
0# Word#
1## State# s
s3
else State# s
s3
where
!szA :: Int#
szA = WordArray# -> Int#
wordArraySize# WordArray#
wa
!(# Int#
nw, Int#
nb #) = Word# -> (# Int#, Int# #)
count_words_bits_int Word#
n
nz_shifted_out :: Bool
nz_shifted_out
| 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
| 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
-> 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
go :: WordArray#
-> Int#
-> WordArray#
-> Int#
-> State# RealWorld
-> State# RealWorld
go WordArray#
wx Int#
nx WordArray#
wy Int#
ny State# RealWorld
s =
case 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' -> 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
-> 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
go :: WordArray#
-> Int#
-> WordArray#
-> Int#
-> State# RealWorld
-> State# RealWorld
go WordArray#
wx Int#
nx WordArray#
wy Int#
ny State# RealWorld
s =
case 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' -> 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
-> 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 = 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
-> 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 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' -> 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 =
let !clzb :: Word#
clzb = Word# -> Word#
clz# (WordArray# -> Int# -> Word#
indexWordArray# WordArray#
uwb (WordArray# -> Int#
wordArraySize# WordArray#
uwb Int# -> Int# -> Int#
-# Int#
1#))
in case 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 #) ->
let normalizeA :: State# s -> State# s
normalizeA State# s
s = case 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
State# s
s -> case forall s.
MutableWordArray# s -> WordArray# -> Word# -> State# s -> State# s
bignat_shiftl MutableWordArray# s
mnwa WordArray#
uwa Word#
clzb State# s
s of
State# s
s -> forall s. MutableByteArray# s -> State# s -> State# s
mwaTrimZeroes# MutableWordArray# s
mnwa State# s
s
in case State# s -> State# s
normalizeA State# s
s1 of { State# s
s2 ->
let !nwb :: WordArray#
nwb = WordArray# -> Word# -> WordArray#
bigNatShiftL# WordArray#
uwb Word#
clzb in
case 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 ->
let denormalizeR :: State# s -> State# s
denormalizeR State# s
s = case forall s. MutableByteArray# s -> State# s -> State# s
mwaTrimZeroes# MutableWordArray# s
mnwa State# s
s of
State# s
s -> case forall d.
MutableByteArray# d -> State# d -> (# State# d, WordArray# #)
unsafeFreezeByteArray# MutableWordArray# s
mnwa State# s
s of
(# State# s
s, WordArray#
wr #) -> case 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 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 -> 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 =
case 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 #) -> 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 =
case forall s. Int# -> State# s -> (# State# s, MutableWordArray# s #)
newWordArray# Int#
szQ State# RealWorld
s of
(# State# RealWorld
s, MutableWordArray# RealWorld
mwq #) -> 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
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 =
let !n :: Int#
n = WordArray# -> Int#
wordArraySize# WordArray#
b
in case 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
let computeQm :: State# s -> (# State# s, Word# #)
computeQm State# s
s = case 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 forall s.
MutableWordArray# s -> Int# -> Word# -> State# s -> State# s
mwaWrite# MutableWordArray# s
mwq Int#
j Word#
qj State# s
s of
State# s
s | Word#
0## <- Word#
qj -> State# s
s
| Bool
True -> case forall d.
MutableWordArray# d
-> Int# -> WordArray# -> State# d -> (# State# d, Int# #)
mwaSubInplaceArray MutableWordArray# s
mwa Int#
j WordArray#
qjb State# s
s of
(# State# s
s, Int#
_ #) -> State# s
s
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
updateQmMaybe :: State# s -> State# s
updateQmMaybe State# s
s = case 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 ->
let bmsw :: Word#
bmsw = WordArray# -> Word#
wordArrayLast# WordArray#
b
estimateQj :: Int# -> State# s -> (# State# s, Word# #)
estimateQj Int#
j State# s
s =
case 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 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## #)
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 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
(# 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
-> 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 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
-> 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 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#)
= 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)
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#)
(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##
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 = 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##
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
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 #)
| Integer
g Integer -> Integer -> Bool
`integerEq` Integer
integerOne -> (# Integer -> Natural
integerToNatural (Integer
a Integer -> Integer -> Integer
`integerMod` Integer
m') | #)
| 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
| 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##