{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE ExplicitForAll #-}

-- |
-- Module      :  GHC.Integer.Type
-- Copyright   :  (c) Herbert Valerio Riedel 2014
-- License     :  BSD3
--
-- Maintainer  :  ghc-devs@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (GHC Extensions)
--
-- GHC needs this module to be named "GHC.Integer.Type" and provide
-- all the low-level 'Integer' operations.

module GHC.Integer.Type where

#include "MachDeps.h"
#include "HsIntegerGmp.h"

-- Sanity check as CPP defines are implicitly 0-valued when undefined
#if !(defined(SIZEOF_LONG) && defined(SIZEOF_HSWORD) \
           && defined(WORD_SIZE_IN_BITS))
# error missing defines
#endif

import GHC.Classes
import GHC.Magic
import GHC.Prim
import GHC.Types
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64
#endif

default ()

-- Most high-level operations need to be marked `NOINLINE` as
-- otherwise GHC doesn't recognize them and fails to apply constant
-- folding to `Integer`-typed expression.
--
-- To this end, the CPP hack below allows to write the pseudo-pragma
--
--   {-# CONSTANT_FOLDED plusInteger #-}
--
-- which is simply expaned into a
--
--   {-# NOINLINE plusInteger #-}
--
#define CONSTANT_FOLDED NOINLINE

----------------------------------------------------------------------------
-- type definitions

-- NB: all code assumes GMP_LIMB_BITS == WORD_SIZE_IN_BITS
-- The C99 code in cbits/wrappers.c will fail to compile if this doesn't hold

-- | Type representing a GMP Limb
type GmpLimb = Word -- actually, 'CULong'
type GmpLimb# = Word#

-- | Count of 'GmpLimb's, must be positive (unless specified otherwise).
type GmpSize = Int  -- actually, a 'CLong'
type GmpSize# = Int#

narrowGmpSize# :: Int# -> Int#
#if SIZEOF_LONG == SIZEOF_HSWORD
narrowGmpSize# :: Int# -> Int#
narrowGmpSize# Int#
x = Int#
x
#elif (SIZEOF_LONG == 4) && (SIZEOF_HSWORD == 8)
-- On IL32P64 (i.e. Win64), we have to be careful with CLong not being
-- 64bit.  This is mostly an issue on values returned from C functions
-- due to sign-extension.
narrowGmpSize# = narrow32Int#
#endif


type GmpBitCnt = Word -- actually, 'CULong'
type GmpBitCnt# = Word# -- actually, 'CULong'

-- Pseudo FFI CType
type CInt = Int
type CInt# = Int#

narrowCInt# :: Int# -> Int#
narrowCInt# :: Int# -> Int#
narrowCInt# = Int# -> Int#
narrow32Int#

-- | Bits in a 'GmpLimb'. Same as @WORD_SIZE_IN_BITS@.
gmpLimbBits :: Word -- 8 `shiftL` gmpLimbShift
gmpLimbBits :: Word
gmpLimbBits = Word# -> Word
W# WORD_SIZE_IN_BITS##

#if WORD_SIZE_IN_BITS == 64
# define GMP_LIMB_SHIFT   3
# define GMP_LIMB_BYTES   8
# define GMP_LIMB_BITS    64
# define INT_MINBOUND     -0x8000000000000000
# define INT_MAXBOUND      0x7fffffffffffffff
# define ABS_INT_MINBOUND  0x8000000000000000
# define SQRT_INT_MAXBOUND 0xb504f333
#elif WORD_SIZE_IN_BITS == 32
# define GMP_LIMB_SHIFT   2
# define GMP_LIMB_BYTES   4
# define GMP_LIMB_BITS    32
# define INT_MINBOUND     -0x80000000
# define INT_MAXBOUND      0x7fffffff
# define ABS_INT_MINBOUND  0x80000000
# define SQRT_INT_MAXBOUND 0xb504
#else
# error unsupported WORD_SIZE_IN_BITS config
#endif

-- | Type representing /raw/ arbitrary-precision Naturals
--
-- This is common type used by 'Natural' and 'Integer'.  As this type
-- consists of a single constructor wrapping a 'ByteArray#' it can be
-- unpacked.
--
-- Essential invariants:
--
--  - 'ByteArray#' size is an exact multiple of 'Word#' size
--  - limbs are stored in least-significant-limb-first order,
--  - the most-significant limb must be non-zero, except for
--  - @0@ which is represented as a 1-limb.
data BigNat = BN# ByteArray#

instance Eq BigNat where
    == :: BigNat -> BigNat -> Bool
(==) = BigNat -> BigNat -> Bool
eqBigNat

instance Ord BigNat where
    compare :: BigNat -> BigNat -> Ordering
compare = BigNat -> BigNat -> Ordering
compareBigNat

-- [Implementation notes]
--
-- Invariant: 'Jn#' and 'Jp#' are used iff value doesn't fit in 'S#'
--
-- Useful properties resulting from the invariants:
--
--  - @abs ('S#' _) <= abs ('Jp#' _)@
--  - @abs ('S#' _) <  abs ('Jn#' _)@

-- | Arbitrary precision integers. In contrast with fixed-size integral types
-- such as 'Int', the 'Integer' type represents the entire infinite range of
-- integers.
--
-- For more information about this type's representation, see the comments in
-- its implementation.
data Integer  = S#                !Int#
                -- ^ iff value in @[minBound::'Int', maxBound::'Int']@ range
              | Jp# {-# UNPACK #-} !BigNat
                -- ^ iff value in @]maxBound::'Int', +inf[@ range
              | Jn# {-# UNPACK #-} !BigNat
                -- ^ iff value in @]-inf, minBound::'Int'[@ range

-- NOTE: the above representation is baked into the GHCi debugger in
-- compiler/ghci/RtClosureInspect.hs. If you change it here, fixes
-- will be required over there too. Tests for this are in
-- testsuite/tests/ghci.debugger.

-- TODO: experiment with different constructor-ordering

instance Eq Integer where
    == :: Integer -> Integer -> Bool
(==)    = Integer -> Integer -> Bool
eqInteger
    /= :: Integer -> Integer -> Bool
(/=)    = Integer -> Integer -> Bool
neqInteger

instance Ord Integer where
    compare :: Integer -> Integer -> Ordering
compare = Integer -> Integer -> Ordering
compareInteger
    > :: Integer -> Integer -> Bool
(>)     = Integer -> Integer -> Bool
gtInteger
    >= :: Integer -> Integer -> Bool
(>=)    = Integer -> Integer -> Bool
geInteger
    < :: Integer -> Integer -> Bool
(<)     = Integer -> Integer -> Bool
ltInteger
    <= :: Integer -> Integer -> Bool
(<=)    = Integer -> Integer -> Bool
leInteger

----------------------------------------------------------------------------

-- | Construct 'Integer' value from list of 'Int's.
--
-- This function is used by GHC for constructing 'Integer' literals.
mkInteger :: Bool   -- ^ sign of integer ('True' if non-negative)
          -> [Int]  -- ^ absolute value expressed in 31 bit chunks, least
                    --   significant first (ideally these would be machine-word
                    --   'Word's rather than 31-bit truncated 'Int's)
          -> Integer
mkInteger :: Bool -> [Int] -> Integer
mkInteger Bool
nonNegative [Int]
is
  | Bool
nonNegative = [Int] -> Integer
f [Int]
is
  | Bool
True        = Integer -> Integer
negateInteger ([Int] -> Integer
f [Int]
is)
  where
    f :: [Int] -> Integer
f [] = Int# -> Integer
S# Int#
0#
    f (I# Int#
i : [Int]
is') = Int# -> Integer
smallInteger (Int#
i Int# -> Int# -> Int#
`andI#` Int#
0x7fffffff#) Integer -> Integer -> Integer
`orInteger`
                         Integer -> Int# -> Integer
shiftLInteger ([Int] -> Integer
f [Int]
is') Int#
31#
{-# CONSTANT_FOLDED mkInteger #-}

-- | Test whether all internal invariants are satisfied by 'Integer' value
--
-- Returns @1#@ if valid, @0#@ otherwise.
--
-- This operation is mostly useful for test-suites and/or code which
-- constructs 'Integer' values directly.
isValidInteger# :: Integer -> Int#
isValidInteger# :: Integer -> Int#
isValidInteger# (S#  Int#
_) = Int#
1#
isValidInteger# (Jp# BigNat
bn)
    = BigNat -> Int#
isValidBigNat# BigNat
bn Int# -> Int# -> Int#
`andI#` (BigNat
bn BigNat -> Word# -> Int#
`gtBigNatWord#` INT_MAXBOUND##)
isValidInteger# (Jn# BigNat
bn)
    = BigNat -> Int#
isValidBigNat# BigNat
bn Int# -> Int# -> Int#
`andI#` (BigNat
bn BigNat -> Word# -> Int#
`gtBigNatWord#` ABS_INT_MINBOUND##)

-- | Should rather be called @intToInteger@
smallInteger :: Int# -> Integer
smallInteger :: Int# -> Integer
smallInteger Int#
i# = Int# -> Integer
S# Int#
i#
{-# CONSTANT_FOLDED smallInteger #-}

----------------------------------------------------------------------------
-- Int64/Word64 specific primitives

#if WORD_SIZE_IN_BITS < 64
int64ToInteger :: Int64# -> Integer
int64ToInteger i
  | isTrue# (i `leInt64#` intToInt64#  0x7FFFFFFF#)
  , isTrue# (i `geInt64#` intToInt64# -0x80000000#)
    = S# (int64ToInt# i)
  | isTrue# (i `geInt64#` intToInt64# 0#)
    = Jp# (word64ToBigNat (int64ToWord64# i))
  | True
    = Jn# (word64ToBigNat (int64ToWord64# (negateInt64# i)))
{-# CONSTANT_FOLDED int64ToInteger #-}

word64ToInteger :: Word64# -> Integer
word64ToInteger w
  | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##)
    = S# (int64ToInt# (word64ToInt64# w))
  | True
    = Jp# (word64ToBigNat w)
{-# CONSTANT_FOLDED word64ToInteger #-}

integerToInt64 :: Integer -> Int64#
integerToInt64 (S# i#)  = intToInt64# i#
integerToInt64 (Jp# bn) = word64ToInt64# (bigNatToWord64 bn)
integerToInt64 (Jn# bn) = negateInt64# (word64ToInt64# (bigNatToWord64 bn))
{-# CONSTANT_FOLDED integerToInt64 #-}

integerToWord64 :: Integer -> Word64#
integerToWord64 (S# i#)  = int64ToWord64# (intToInt64# i#)
integerToWord64 (Jp# bn) = bigNatToWord64 bn
integerToWord64 (Jn# bn)
    = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64 bn)))
{-# CONSTANT_FOLDED integerToWord64 #-}

#if GMP_LIMB_BITS == 32
word64ToBigNat :: Word64# -> BigNat
word64ToBigNat w64 = wordToBigNat2 wh# wl#
  where
    wh# = word64ToWord# (uncheckedShiftRL64# w64 32#)
    wl# = word64ToWord# w64

bigNatToWord64 :: BigNat -> Word64#
bigNatToWord64 bn
  | isTrue# (sizeofBigNat# bn ># 1#)
    = let wh# = wordToWord64# (indexBigNat# bn 1#)
      in uncheckedShiftL64# wh# 32# `or64#` wl#
  | True = wl#
  where
    wl# = wordToWord64# (bigNatToWord bn)
#endif
#endif

-- End of Int64/Word64 specific primitives
----------------------------------------------------------------------------

-- | Truncates 'Integer' to least-significant 'Int#'
integerToInt :: Integer -> Int#
integerToInt :: Integer -> Int#
integerToInt (S# Int#
i#)  = Int#
i#
integerToInt (Jp# BigNat
bn) = BigNat -> Int#
bigNatToInt BigNat
bn
integerToInt (Jn# BigNat
bn) = Int# -> Int#
negateInt# (BigNat -> Int#
bigNatToInt BigNat
bn)
{-# CONSTANT_FOLDED integerToInt #-}

hashInteger :: Integer -> Int#
hashInteger :: Integer -> Int#
hashInteger = Integer -> Int#
integerToInt -- emulating what integer-{simple,gmp} already do

integerToWord :: Integer -> Word#
integerToWord :: Integer -> Word#
integerToWord (S# Int#
i#)  = Int# -> Word#
int2Word# Int#
i#
integerToWord (Jp# BigNat
bn) = BigNat -> Word#
bigNatToWord BigNat
bn
integerToWord (Jn# BigNat
bn) = Int# -> Word#
int2Word# (Int# -> Int#
negateInt# (BigNat -> Int#
bigNatToInt BigNat
bn))
{-# CONSTANT_FOLDED integerToWord #-}

wordToInteger :: Word# -> Integer
wordToInteger :: Word# -> Integer
wordToInteger Word#
w#
  | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int# -> Integer
S# Int#
i#
  | Bool
True                = BigNat -> Integer
Jp# (Word# -> BigNat
wordToBigNat Word#
w#)
  where
    i# :: Int#
i# = Word# -> Int#
word2Int# Word#
w#
{-# CONSTANT_FOLDED wordToInteger #-}

wordToNegInteger :: Word# -> Integer
wordToNegInteger :: Word# -> Integer
wordToNegInteger Word#
w#
  | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<=# Int#
0#) = Int# -> Integer
S# Int#
i#
  | Bool
True                = BigNat -> Integer
Jn# (Word# -> BigNat
wordToBigNat Word#
w#)
  where
    i# :: Int#
i# = Int# -> Int#
negateInt# (Word# -> Int#
word2Int# Word#
w#)

-- we could almost auto-derive Ord if it wasn't for the Jn#-Jn# case
compareInteger :: Integer -> Integer -> Ordering
compareInteger :: Integer -> Integer -> Ordering
compareInteger (Jn# BigNat
x)  (Jn# BigNat
y) = BigNat -> BigNat -> Ordering
compareBigNat BigNat
y BigNat
x
compareInteger (S#  Int#
x)  (S#  Int#
y) = Int# -> Int# -> Ordering
compareInt#   Int#
x Int#
y
compareInteger (Jp# BigNat
x)  (Jp# BigNat
y) = BigNat -> BigNat -> Ordering
compareBigNat BigNat
x BigNat
y
compareInteger (Jn# BigNat
_)  Integer
_       = Ordering
LT
compareInteger (S#  Int#
_)  (Jp# BigNat
_) = Ordering
LT
compareInteger (S#  Int#
_)  (Jn# BigNat
_) = Ordering
GT
compareInteger (Jp# BigNat
_)  Integer
_       = Ordering
GT
{-# CONSTANT_FOLDED compareInteger #-}

isNegInteger# :: Integer -> Int#
isNegInteger# :: Integer -> Int#
isNegInteger# (S# Int#
i#) = Int#
i# Int# -> Int# -> Int#
<# Int#
0#
isNegInteger# (Jp# BigNat
_)  = Int#
0#
isNegInteger# (Jn# BigNat
_)  = Int#
1#

-- | Not-equal predicate.
neqInteger :: Integer -> Integer -> Bool
neqInteger :: Integer -> Integer -> Bool
neqInteger Integer
x Integer
y = Int# -> Bool
isTrue# (Integer -> Integer -> Int#
neqInteger# Integer
x Integer
y)

eqInteger, leInteger, ltInteger, gtInteger, geInteger
  :: Integer -> Integer -> Bool
eqInteger :: Integer -> Integer -> Bool
eqInteger  Integer
x Integer
y = Int# -> Bool
isTrue# (Integer -> Integer -> Int#
eqInteger#  Integer
x Integer
y)
leInteger :: Integer -> Integer -> Bool
leInteger  Integer
x Integer
y = Int# -> Bool
isTrue# (Integer -> Integer -> Int#
leInteger#  Integer
x Integer
y)
ltInteger :: Integer -> Integer -> Bool
ltInteger  Integer
x Integer
y = Int# -> Bool
isTrue# (Integer -> Integer -> Int#
ltInteger#  Integer
x Integer
y)
gtInteger :: Integer -> Integer -> Bool
gtInteger  Integer
x Integer
y = Int# -> Bool
isTrue# (Integer -> Integer -> Int#
gtInteger#  Integer
x Integer
y)
geInteger :: Integer -> Integer -> Bool
geInteger  Integer
x Integer
y = Int# -> Bool
isTrue# (Integer -> Integer -> Int#
geInteger#  Integer
x Integer
y)

eqInteger#, neqInteger#, leInteger#, ltInteger#, gtInteger#, geInteger#
  :: Integer -> Integer -> Int#
eqInteger# :: Integer -> Integer -> Int#
eqInteger# (S# Int#
x#) (S# Int#
y#)   = Int#
x# Int# -> Int# -> Int#
==# Int#
y#
eqInteger# (Jn# BigNat
x) (Jn# BigNat
y)   = BigNat -> BigNat -> Int#
eqBigNat# BigNat
x BigNat
y
eqInteger# (Jp# BigNat
x) (Jp# BigNat
y)   = BigNat -> BigNat -> Int#
eqBigNat# BigNat
x BigNat
y
eqInteger# Integer
_       Integer
_         = Int#
0#
{-# CONSTANT_FOLDED eqInteger# #-}

neqInteger# :: Integer -> Integer -> Int#
neqInteger# (S# Int#
x#) (S# Int#
y#)  = Int#
x# Int# -> Int# -> Int#
/=# Int#
y#
neqInteger# (Jn# BigNat
x) (Jn# BigNat
y)  = BigNat -> BigNat -> Int#
neqBigNat# BigNat
x BigNat
y
neqInteger# (Jp# BigNat
x) (Jp# BigNat
y)  = BigNat -> BigNat -> Int#
neqBigNat# BigNat
x BigNat
y
neqInteger# Integer
_       Integer
_        = Int#
1#
{-# CONSTANT_FOLDED neqInteger# #-}


gtInteger# :: Integer -> Integer -> Int#
gtInteger# (S# Int#
x#) (S# Int#
y#)   = Int#
x# Int# -> Int# -> Int#
># Int#
y#
gtInteger# Integer
x Integer
y | (Integer -> Integer -> Ordering) -> Integer -> Integer -> Ordering
forall a. a -> a
inline Integer -> Integer -> Ordering
compareInteger Integer
x Integer
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT  = Int#
1#
gtInteger# Integer
_ Integer
_                                    = Int#
0#
{-# CONSTANT_FOLDED gtInteger# #-}

leInteger# :: Integer -> Integer -> Int#
leInteger# (S# Int#
x#) (S# Int#
y#)   = Int#
x# Int# -> Int# -> Int#
<=# Int#
y#
leInteger# Integer
x Integer
y | (Integer -> Integer -> Ordering) -> Integer -> Integer -> Ordering
forall a. a -> a
inline Integer -> Integer -> Ordering
compareInteger Integer
x Integer
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT  = Int#
1#
leInteger# Integer
_ Integer
_                             = Int#
0#
{-# CONSTANT_FOLDED leInteger# #-}

ltInteger# :: Integer -> Integer -> Int#
ltInteger# (S# Int#
x#) (S# Int#
y#)   = Int#
x# Int# -> Int# -> Int#
<# Int#
y#
ltInteger# Integer
x Integer
y | (Integer -> Integer -> Ordering) -> Integer -> Integer -> Ordering
forall a. a -> a
inline Integer -> Integer -> Ordering
compareInteger Integer
x Integer
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT  = Int#
1#
ltInteger# Integer
_ Integer
_                             = Int#
0#
{-# CONSTANT_FOLDED ltInteger# #-}

geInteger# :: Integer -> Integer -> Int#
geInteger# (S# Int#
x#) (S# Int#
y#)   = Int#
x# Int# -> Int# -> Int#
>=# Int#
y#
geInteger# Integer
x Integer
y | (Integer -> Integer -> Ordering) -> Integer -> Integer -> Ordering
forall a. a -> a
inline Integer -> Integer -> Ordering
compareInteger Integer
x Integer
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT  = Int#
1#
geInteger# Integer
_ Integer
_                             = Int#
0#
{-# CONSTANT_FOLDED geInteger# #-}

-- | Compute absolute value of an 'Integer'
absInteger :: Integer -> Integer
absInteger :: Integer -> Integer
absInteger (Jn# BigNat
n)                       = BigNat -> Integer
Jp# BigNat
n
absInteger (S# INT_MINBOUND#)            = Jp# (wordToBigNat ABS_INT_MINBOUND##)
absInteger (S# Int#
i#) | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# Int#
0#)  = Int# -> Integer
S# (Int# -> Int#
negateInt# Int#
i#)
absInteger i :: Integer
i@(S# Int#
_)                      = Integer
i
absInteger i :: Integer
i@(Jp# BigNat
_)                     = Integer
i
{-# CONSTANT_FOLDED absInteger #-}

-- | Return @-1@, @0@, and @1@ depending on whether argument is
-- negative, zero, or positive, respectively
signumInteger :: Integer -> Integer
signumInteger :: Integer -> Integer
signumInteger Integer
j = Int# -> Integer
S# (Integer -> Int#
signumInteger# Integer
j)
{-# CONSTANT_FOLDED signumInteger #-}

-- | Return @-1#@, @0#@, and @1#@ depending on whether argument is
-- negative, zero, or positive, respectively
signumInteger# :: Integer -> Int#
signumInteger# :: Integer -> Int#
signumInteger# (Jn# BigNat
_)  = Int#
-1#
signumInteger# (S# Int#
i#) = Int# -> Int#
sgnI# Int#
i#
signumInteger# (Jp# BigNat
_ ) =  Int#
1#

-- | Negate 'Integer'
negateInteger :: Integer -> Integer
negateInteger :: Integer -> Integer
negateInteger (Jn# BigNat
n)      = BigNat -> Integer
Jp# BigNat
n
negateInteger (S# INT_MINBOUND#) = Jp# (wordToBigNat ABS_INT_MINBOUND##)
negateInteger (S# Int#
i#)             = Int# -> Integer
S# (Int# -> Int#
negateInt# Int#
i#)
negateInteger (Jp# BigNat
bn)
  | Int# -> Bool
isTrue# (BigNat -> Word# -> Int#
eqBigNatWord# BigNat
bn ABS_INT_MINBOUND##) = S# INT_MINBOUND#
  | Bool
True                                        = BigNat -> Integer
Jn# BigNat
bn
{-# CONSTANT_FOLDED negateInteger #-}

-- one edge-case issue to take into account is that Int's range is not
-- symmetric around 0.  I.e. @minBound+maxBound = -1@
--
-- Jp# is used iff n > maxBound::Int
-- Jn# is used iff n < minBound::Int

-- | Add two 'Integer's
plusInteger :: Integer -> Integer -> Integer
plusInteger :: Integer -> Integer -> Integer
plusInteger Integer
x    (S# Int#
0#)  = Integer
x
plusInteger (S# Int#
0#) Integer
y     = Integer
y
plusInteger (S# Int#
x#) (S# Int#
y#)
  = case Int# -> Int# -> (# Int#, Int# #)
addIntC# Int#
x# Int#
y# of
    (# Int#
z#, Int#
0# #) -> Int# -> Integer
S# Int#
z#
    (# Int#
0#, Int#
_  #) -> BigNat -> Integer
Jn# (Word# -> Word# -> BigNat
wordToBigNat2 Word#
1## Word#
0##) -- 2*minBound::Int
    (# Int#
z#, Int#
_  #)
      | Int# -> Bool
isTrue# (Int#
z# Int# -> Int# -> Int#
># Int#
0#) -> BigNat -> Integer
Jn# (Word# -> BigNat
wordToBigNat ( (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
z#))))
      | Bool
True               -> BigNat -> Integer
Jp# (Word# -> BigNat
wordToBigNat ( (Int# -> Word#
int2Word# Int#
z#)))
plusInteger y :: Integer
y@(S# Int#
_) Integer
x = Integer -> Integer -> Integer
plusInteger Integer
x Integer
y
-- no S# as first arg from here on
plusInteger (Jp# BigNat
x) (Jp# BigNat
y) = BigNat -> Integer
Jp# (BigNat -> BigNat -> BigNat
plusBigNat BigNat
x BigNat
y)
plusInteger (Jn# BigNat
x) (Jn# BigNat
y) = BigNat -> Integer
Jn# (BigNat -> BigNat -> BigNat
plusBigNat BigNat
x BigNat
y)
plusInteger (Jp# BigNat
x) (S# Int#
y#) -- edge-case: @(maxBound+1) + minBound == 0@
  | Int# -> Bool
isTrue# (Int#
y# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
Jp# (BigNat -> Word# -> BigNat
plusBigNatWord BigNat
x (Int# -> Word#
int2Word# Int#
y#))
  | Bool
True                = BigNat -> Integer
bigNatToInteger (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
x (Int# -> Word#
int2Word#
                                                              (Int# -> Int#
negateInt# Int#
y#)))
plusInteger (Jn# BigNat
x) (S# Int#
y#) -- edge-case: @(minBound-1) + maxBound == -2@
  | Int# -> Bool
isTrue# (Int#
y# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
bigNatToNegInteger (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
x (Int# -> Word#
int2Word# Int#
y#))
  | Bool
True                = BigNat -> Integer
Jn# (BigNat -> Word# -> BigNat
plusBigNatWord BigNat
x (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
y#)))
plusInteger y :: Integer
y@(Jn# BigNat
_) x :: Integer
x@(Jp# BigNat
_) = Integer -> Integer -> Integer
plusInteger Integer
x Integer
y
plusInteger (Jp# BigNat
x) (Jn# BigNat
y)
    = case BigNat -> BigNat -> Ordering
compareBigNat BigNat
x BigNat
y of
      Ordering
LT -> BigNat -> Integer
bigNatToNegInteger (BigNat -> BigNat -> BigNat
minusBigNat BigNat
y BigNat
x)
      Ordering
EQ -> Int# -> Integer
S# Int#
0#
      Ordering
GT -> BigNat -> Integer
bigNatToInteger (BigNat -> BigNat -> BigNat
minusBigNat BigNat
x BigNat
y)
{-# CONSTANT_FOLDED plusInteger #-}

-- | Subtract one 'Integer' from another.
minusInteger :: Integer -> Integer -> Integer
minusInteger :: Integer -> Integer -> Integer
minusInteger Integer
x       (S# Int#
0#)            = Integer
x
minusInteger (S# Int#
x#) (S# Int#
y#)
  = case Int# -> Int# -> (# Int#, Int# #)
subIntC# Int#
x# Int#
y# of
    (# Int#
z#, Int#
0# #) -> Int# -> Integer
S# Int#
z#
    (# Int#
0#, Int#
_  #) -> BigNat -> Integer
Jn# (Word# -> Word# -> BigNat
wordToBigNat2 Word#
1## Word#
0##)
    (# Int#
z#, Int#
_  #)
      | Int# -> Bool
isTrue# (Int#
z# Int# -> Int# -> Int#
># Int#
0#) -> BigNat -> Integer
Jn# (Word# -> BigNat
wordToBigNat ( (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
z#))))
      | Bool
True               -> BigNat -> Integer
Jp# (Word# -> BigNat
wordToBigNat ( (Int# -> Word#
int2Word# Int#
z#)))
minusInteger (S# Int#
x#) (Jp# BigNat
y)
  | Int# -> Bool
isTrue# (Int#
x# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
bigNatToNegInteger (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
y (Int# -> Word#
int2Word# Int#
x#))
  | Bool
True                = BigNat -> Integer
Jn# (BigNat -> Word# -> BigNat
plusBigNatWord BigNat
y (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
x#)))
minusInteger (S# Int#
x#) (Jn# BigNat
y)
  | Int# -> Bool
isTrue# (Int#
x# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
Jp# (BigNat -> Word# -> BigNat
plusBigNatWord BigNat
y (Int# -> Word#
int2Word# Int#
x#))
  | Bool
True                = BigNat -> Integer
bigNatToInteger (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
y (Int# -> Word#
int2Word#
                                                              (Int# -> Int#
negateInt# Int#
x#)))
minusInteger (Jp# BigNat
x) (Jp# BigNat
y)
    = case BigNat -> BigNat -> Ordering
compareBigNat BigNat
x BigNat
y of
      Ordering
LT -> BigNat -> Integer
bigNatToNegInteger (BigNat -> BigNat -> BigNat
minusBigNat BigNat
y BigNat
x)
      Ordering
EQ -> Int# -> Integer
S# Int#
0#
      Ordering
GT -> BigNat -> Integer
bigNatToInteger (BigNat -> BigNat -> BigNat
minusBigNat BigNat
x BigNat
y)
minusInteger (Jp# BigNat
x) (Jn# BigNat
y) = BigNat -> Integer
Jp# (BigNat -> BigNat -> BigNat
plusBigNat BigNat
x BigNat
y)
minusInteger (Jn# BigNat
x) (Jp# BigNat
y) = BigNat -> Integer
Jn# (BigNat -> BigNat -> BigNat
plusBigNat BigNat
x BigNat
y)
minusInteger (Jn# BigNat
x) (Jn# BigNat
y)
    = case BigNat -> BigNat -> Ordering
compareBigNat BigNat
x BigNat
y of
      Ordering
LT -> BigNat -> Integer
bigNatToInteger (BigNat -> BigNat -> BigNat
minusBigNat BigNat
y BigNat
x)
      Ordering
EQ -> Int# -> Integer
S# Int#
0#
      Ordering
GT -> BigNat -> Integer
bigNatToNegInteger (BigNat -> BigNat -> BigNat
minusBigNat BigNat
x BigNat
y)
minusInteger (Jp# BigNat
x) (S# Int#
y#)
  | Int# -> Bool
isTrue# (Int#
y# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
bigNatToInteger (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
x (Int# -> Word#
int2Word# Int#
y#))
  | Bool
True                = BigNat -> Integer
Jp# (BigNat -> Word# -> BigNat
plusBigNatWord BigNat
x (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
y#)))
minusInteger (Jn# BigNat
x) (S# Int#
y#)
  | Int# -> Bool
isTrue# (Int#
y# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
Jn# (BigNat -> Word# -> BigNat
plusBigNatWord BigNat
x (Int# -> Word#
int2Word# Int#
y#))
  | Bool
True                = BigNat -> Integer
bigNatToNegInteger (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
x
                                              (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
y#)))
{-# CONSTANT_FOLDED minusInteger #-}

-- | Multiply two 'Integer's
timesInteger :: Integer -> Integer -> Integer
timesInteger :: Integer -> Integer -> Integer
timesInteger !Integer
_      (S# Int#
0#) = Int# -> Integer
S# Int#
0#
timesInteger (S# Int#
0#) Integer
_       = Int# -> Integer
S# Int#
0#
timesInteger Integer
x       (S# Int#
1#) = Integer
x
timesInteger (S# Int#
1#) Integer
y       = Integer
y
timesInteger Integer
x      (S# Int#
-1#) = Integer -> Integer
negateInteger Integer
x
timesInteger (S# Int#
-1#) Integer
y      = Integer -> Integer
negateInteger Integer
y
timesInteger (S# Int#
x#) (S# Int#
y#)
  = case Int# -> Int# -> Int#
mulIntMayOflo# Int#
x# Int#
y# of
    Int#
0# -> Int# -> Integer
S# (Int#
x# Int# -> Int# -> Int#
*# Int#
y#)
    Int#
_  -> Int# -> Int# -> Integer
timesInt2Integer Int#
x# Int#
y#
timesInteger x :: Integer
x@(S# Int#
_) Integer
y      = Integer -> Integer -> Integer
timesInteger Integer
y Integer
x
-- no S# as first arg from here on
timesInteger (Jp# BigNat
x) (Jp# BigNat
y) = BigNat -> Integer
Jp# (BigNat -> BigNat -> BigNat
timesBigNat BigNat
x BigNat
y)
timesInteger (Jp# BigNat
x) (Jn# BigNat
y) = BigNat -> Integer
Jn# (BigNat -> BigNat -> BigNat
timesBigNat BigNat
x BigNat
y)
timesInteger (Jp# BigNat
x) (S# Int#
y#)
  | Int# -> Bool
isTrue# (Int#
y# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
Jp# (BigNat -> Word# -> BigNat
timesBigNatWord BigNat
x (Int# -> Word#
int2Word# Int#
y#))
  | Bool
True       = BigNat -> Integer
Jn# (BigNat -> Word# -> BigNat
timesBigNatWord BigNat
x (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
y#)))
timesInteger (Jn# BigNat
x) (Jn# BigNat
y) = BigNat -> Integer
Jp# (BigNat -> BigNat -> BigNat
timesBigNat BigNat
x BigNat
y)
timesInteger (Jn# BigNat
x) (Jp# BigNat
y) = BigNat -> Integer
Jn# (BigNat -> BigNat -> BigNat
timesBigNat BigNat
x BigNat
y)
timesInteger (Jn# BigNat
x) (S# Int#
y#)
  | Int# -> Bool
isTrue# (Int#
y# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
Jn# (BigNat -> Word# -> BigNat
timesBigNatWord BigNat
x (Int# -> Word#
int2Word# Int#
y#))
  | Bool
True       = BigNat -> Integer
Jp# (BigNat -> Word# -> BigNat
timesBigNatWord BigNat
x (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
y#)))
{-# CONSTANT_FOLDED timesInteger #-}

-- | Square 'Integer'
sqrInteger :: Integer -> Integer
sqrInteger :: Integer -> Integer
sqrInteger (S# INT_MINBOUND#) = timesInt2Integer INT_MINBOUND# INT_MINBOUND#
sqrInteger (S# Int#
j#) | Int# -> Bool
isTrue# (Int# -> Int#
absI# Int#
j# Int# -> Int# -> Int#
<=# SQRT_INT_MAXBOUND#) = S# (j# *# j#)
sqrInteger (S# Int#
j#) = Int# -> Int# -> Integer
timesInt2Integer Int#
j# Int#
j#
sqrInteger (Jp# BigNat
bn) = BigNat -> Integer
Jp# (BigNat -> BigNat
sqrBigNat BigNat
bn)
sqrInteger (Jn# BigNat
bn) = BigNat -> Integer
Jp# (BigNat -> BigNat
sqrBigNat BigNat
bn)

-- | Construct 'Integer' from the product of two 'Int#'s
timesInt2Integer :: Int# -> Int# -> Integer
timesInt2Integer :: Int# -> Int# -> Integer
timesInt2Integer Int#
x# Int#
y# = case (# Int# -> Bool
isTrue# (Int#
x# Int# -> Int# -> Int#
>=# Int#
0#), Int# -> Bool
isTrue# (Int#
y# Int# -> Int# -> Int#
>=# Int#
0#) #) of
    (# Bool
False, Bool
False #) -> case Word# -> Word# -> (# Word#, Word# #)
timesWord2# (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
x#))
                                     (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
y#)) of
        (# Word#
0##,Word#
l #) -> (Word# -> Integer) -> Word# -> Integer
forall a. a -> a
inline Word# -> Integer
wordToInteger Word#
l
        (# Word#
h  ,Word#
l #) -> BigNat -> Integer
Jp# (Word# -> Word# -> BigNat
wordToBigNat2 Word#
h Word#
l)

    (#  Bool
True, Bool
False #) -> case Word# -> Word# -> (# Word#, Word# #)
timesWord2# (Int# -> Word#
int2Word# Int#
x#)
                                     (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
y#)) of
        (# Word#
0##,Word#
l #) -> Word# -> Integer
wordToNegInteger Word#
l
        (# Word#
h  ,Word#
l #) -> BigNat -> Integer
Jn# (Word# -> Word# -> BigNat
wordToBigNat2 Word#
h Word#
l)

    (# Bool
False,  Bool
True #) -> case Word# -> Word# -> (# Word#, Word# #)
timesWord2# (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
x#))
                                     (Int# -> Word#
int2Word# Int#
y#) of
        (# Word#
0##,Word#
l #) -> Word# -> Integer
wordToNegInteger Word#
l
        (# Word#
h  ,Word#
l #) -> BigNat -> Integer
Jn# (Word# -> Word# -> BigNat
wordToBigNat2 Word#
h Word#
l)

    (#  Bool
True,  Bool
True #) -> case Word# -> Word# -> (# Word#, Word# #)
timesWord2# (Int# -> Word#
int2Word# Int#
x#)
                                     (Int# -> Word#
int2Word# Int#
y#) of
        (# Word#
0##,Word#
l #) -> (Word# -> Integer) -> Word# -> Integer
forall a. a -> a
inline Word# -> Integer
wordToInteger Word#
l
        (# Word#
h  ,Word#
l #) -> BigNat -> Integer
Jp# (Word# -> Word# -> BigNat
wordToBigNat2 Word#
h Word#
l)

bigNatToInteger :: BigNat -> Integer
bigNatToInteger :: BigNat -> Integer
bigNatToInteger BigNat
bn
  | Int# -> Bool
isTrue# ((BigNat -> Int#
sizeofBigNat# BigNat
bn Int# -> Int# -> Int#
==# Int#
1#) Int# -> Int# -> Int#
`andI#` (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#)) = Int# -> Integer
S# Int#
i#
  | Bool
True                                                    = BigNat -> Integer
Jp# BigNat
bn
  where
    i# :: Int#
i# = Word# -> Int#
word2Int# (BigNat -> Word#
bigNatToWord BigNat
bn)

bigNatToNegInteger :: BigNat -> Integer
bigNatToNegInteger :: BigNat -> Integer
bigNatToNegInteger BigNat
bn
  | Int# -> Bool
isTrue# ((BigNat -> Int#
sizeofBigNat# BigNat
bn Int# -> Int# -> Int#
==# Int#
1#) Int# -> Int# -> Int#
`andI#` (Int#
i# Int# -> Int# -> Int#
<=# Int#
0#)) = Int# -> Integer
S# Int#
i#
  | Bool
True                                                    = BigNat -> Integer
Jn# BigNat
bn
  where
    i# :: Int#
i# = Int# -> Int#
negateInt# (Word# -> Int#
word2Int# (BigNat -> Word#
bigNatToWord BigNat
bn))

-- | Count number of set bits. For negative arguments returns negative
-- population count of negated argument.
popCountInteger :: Integer -> Int#
popCountInteger :: Integer -> Int#
popCountInteger (S# Int#
i#)
  | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#) = Int# -> Int#
popCntI# Int#
i#
  | Bool
True                = Int# -> Int#
negateInt# (Int# -> Int#
popCntI# (Int# -> Int#
negateInt# Int#
i#))
popCountInteger (Jp# BigNat
bn)  = BigNat -> Int#
popCountBigNat BigNat
bn
popCountInteger (Jn# BigNat
bn)  = Int# -> Int#
negateInt# (BigNat -> Int#
popCountBigNat BigNat
bn)
{-# CONSTANT_FOLDED popCountInteger #-}

-- | 'Integer' for which only /n/-th bit is set. Undefined behaviour
-- for negative /n/ values.
bitInteger :: Int# -> Integer
bitInteger :: Int# -> Integer
bitInteger Int#
i#
  | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# (GMP_LIMB_BITS# -# 1#)) = S# (uncheckedIShiftL# 1# i#)
  | Bool
True = BigNat -> Integer
Jp# (Int# -> BigNat
bitBigNat Int#
i#)
{-# CONSTANT_FOLDED bitInteger #-}

-- | Test if /n/-th bit is set.
testBitInteger :: Integer -> Int# -> Bool
testBitInteger :: Integer -> Int# -> Bool
testBitInteger !Integer
_  Int#
n# | Int# -> Bool
isTrue# (Int#
n# Int# -> Int# -> Int#
<# Int#
0#) = Bool
False
testBitInteger (S# Int#
i#) Int#
n#
  | Int# -> Bool
isTrue# (Int#
n# Int# -> Int# -> Int#
<# GMP_LIMB_BITS#) = isTrue# (((uncheckedIShiftL# 1# n#)
                                               `andI#` i#) /=# 0#)
  | Bool
True                          = Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# Int#
0#)
testBitInteger (Jp# BigNat
bn) Int#
n = BigNat -> Int# -> Bool
testBitBigNat BigNat
bn Int#
n
testBitInteger (Jn# BigNat
bn) Int#
n = BigNat -> Int# -> Bool
testBitNegBigNat BigNat
bn Int#
n
{-# CONSTANT_FOLDED testBitInteger #-}

-- | Bitwise @NOT@ operation
complementInteger :: Integer -> Integer
complementInteger :: Integer -> Integer
complementInteger (S# Int#
i#) = Int# -> Integer
S# (Int# -> Int#
notI# Int#
i#)
complementInteger (Jp# BigNat
bn) = BigNat -> Integer
Jn# (BigNat -> Word# -> BigNat
plusBigNatWord  BigNat
bn Word#
1##)
complementInteger (Jn# BigNat
bn) = BigNat -> Integer
Jp# (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
bn Word#
1##)
{-# CONSTANT_FOLDED complementInteger #-}

-- | Arithmetic shift-right operation
--
-- Even though the shift-amount is expressed as `Int#`, the result is
-- undefined for negative shift-amounts.
shiftRInteger :: Integer -> Int# -> Integer
shiftRInteger :: Integer -> Int# -> Integer
shiftRInteger Integer
x        Int#
0# = Integer
x
shiftRInteger (S# Int#
i#)  Int#
n# = Int# -> Integer
S# (Int# -> Int# -> Int#
iShiftRA# Int#
i# Int#
n#)
  where
    iShiftRA# :: Int# -> Int# -> Int#
iShiftRA# Int#
a Int#
b
      | Int# -> Bool
isTrue# (Int#
b Int# -> Int# -> Int#
>=# WORD_SIZE_IN_BITS#) = (a <# 0#) *# (-1#)
      | Bool
True                               = Int#
a Int# -> Int# -> Int#
`uncheckedIShiftRA#` Int#
b
shiftRInteger (Jp# BigNat
bn) Int#
n# = BigNat -> Integer
bigNatToInteger (BigNat -> Int# -> BigNat
shiftRBigNat BigNat
bn Int#
n#)
shiftRInteger (Jn# BigNat
bn) Int#
n#
    = case BigNat -> Integer
bigNatToNegInteger (BigNat -> Int# -> BigNat
shiftRNegBigNat BigNat
bn Int#
n#) of
        S# Int#
0# -> Int# -> Integer
S# Int#
-1#
        Integer
r           -> Integer
r
{-# CONSTANT_FOLDED shiftRInteger #-}

-- | Shift-left operation
--
-- Even though the shift-amount is expressed as `Int#`, the result is
-- undefined for negative shift-amounts.
shiftLInteger :: Integer -> Int# -> Integer
shiftLInteger :: Integer -> Int# -> Integer
shiftLInteger Integer
x       Int#
0# = Integer
x
shiftLInteger (S# Int#
0#) Int#
_  = Int# -> Integer
S# Int#
0#
shiftLInteger (S# Int#
1#) Int#
n# = Int# -> Integer
bitInteger Int#
n#
shiftLInteger (S# Int#
i#) Int#
n#
  | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
>=# Int#
0#)  = BigNat -> Integer
bigNatToInteger (BigNat -> Int# -> BigNat
shiftLBigNat
                                            (Word# -> BigNat
wordToBigNat (Int# -> Word#
int2Word# Int#
i#)) Int#
n#)
  | Bool
True                 = BigNat -> Integer
bigNatToNegInteger (BigNat -> Int# -> BigNat
shiftLBigNat
                                               (Word# -> BigNat
wordToBigNat (Int# -> Word#
int2Word#
                                                              (Int# -> Int#
negateInt# Int#
i#))) Int#
n#)
shiftLInteger (Jp# BigNat
bn) Int#
n# = BigNat -> Integer
Jp# (BigNat -> Int# -> BigNat
shiftLBigNat BigNat
bn Int#
n#)
shiftLInteger (Jn# BigNat
bn) Int#
n# = BigNat -> Integer
Jn# (BigNat -> Int# -> BigNat
shiftLBigNat BigNat
bn Int#
n#)
{-# CONSTANT_FOLDED shiftLInteger #-}

-- | Bitwise OR operation
orInteger :: Integer -> Integer -> Integer
-- short-cuts
orInteger :: Integer -> Integer -> Integer
orInteger  (S# Int#
0#)     Integer
y         = Integer
y
orInteger  Integer
x           (S# Int#
0#)   = Integer
x
orInteger  (S# Int#
-1#)    Integer
_         = Int# -> Integer
S# Int#
-1#
orInteger  Integer
_           (S# Int#
-1#)  = Int# -> Integer
S# Int#
-1#
-- base-cases
orInteger  (S# Int#
x#)     (S# Int#
y#)   = Int# -> Integer
S# (Int# -> Int# -> Int#
orI# Int#
x# Int#
y#)
orInteger  (Jp# BigNat
x)     (Jp# BigNat
y)   = BigNat -> Integer
Jp# (BigNat -> BigNat -> BigNat
orBigNat BigNat
x BigNat
y)
orInteger  (Jn# BigNat
x)     (Jn# BigNat
y)
    = BigNat -> Integer
bigNatToNegInteger (BigNat -> Word# -> BigNat
plusBigNatWord (BigNat -> BigNat -> BigNat
andBigNat
                                          (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
x Word#
1##)
                                          (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
y Word#
1##)) Word#
1##)
orInteger  x :: Integer
x@(Jn# BigNat
_)   y :: Integer
y@(Jp# BigNat
_)  = Integer -> Integer -> Integer
orInteger Integer
y Integer
x -- retry with swapped args
orInteger  (Jp# BigNat
x)     (Jn# BigNat
y)
    = BigNat -> Integer
bigNatToNegInteger (BigNat -> Word# -> BigNat
plusBigNatWord (BigNat -> BigNat -> BigNat
andnBigNat (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
y Word#
1##) BigNat
x)
                                         Word#
1##)
-- TODO/FIXpromotion-hack
orInteger  x :: Integer
x@(S# Int#
_)   Integer
y          = Integer -> Integer -> Integer
orInteger (Integer -> Integer
unsafePromote Integer
x) Integer
y
orInteger  Integer
x           Integer
y {- S# -}= Integer -> Integer -> Integer
orInteger Integer
x (Integer -> Integer
unsafePromote Integer
y)
{-# CONSTANT_FOLDED orInteger #-}

-- | Bitwise XOR operation
xorInteger :: Integer -> Integer -> Integer
-- short-cuts
xorInteger :: Integer -> Integer -> Integer
xorInteger (S# Int#
0#)     Integer
y          = Integer
y
xorInteger Integer
x           (S# Int#
0#)    = Integer
x
-- TODO: (S# -1) cases
-- base-cases
xorInteger (S# Int#
x#)     (S# Int#
y#)    = Int# -> Integer
S# (Int# -> Int# -> Int#
xorI# Int#
x# Int#
y#)
xorInteger (Jp# BigNat
x)     (Jp# BigNat
y)    = BigNat -> Integer
bigNatToInteger (BigNat -> BigNat -> BigNat
xorBigNat BigNat
x BigNat
y)
xorInteger (Jn# BigNat
x)     (Jn# BigNat
y)
    = BigNat -> Integer
bigNatToInteger (BigNat -> BigNat -> BigNat
xorBigNat (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
x Word#
1##)
                                 (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
y Word#
1##))
xorInteger x :: Integer
x@(Jn# BigNat
_)   y :: Integer
y@(Jp# BigNat
_)  = Integer -> Integer -> Integer
xorInteger Integer
y Integer
x -- retry with swapped args
xorInteger (Jp# BigNat
x)     (Jn# BigNat
y)
    = BigNat -> Integer
bigNatToNegInteger (BigNat -> Word# -> BigNat
plusBigNatWord (BigNat -> BigNat -> BigNat
xorBigNat BigNat
x (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
y Word#
1##))
                                         Word#
1##)
-- TODO/FIXME promotion-hack
xorInteger x :: Integer
x@(S# Int#
_)    Integer
y          = Integer -> Integer -> Integer
xorInteger (Integer -> Integer
unsafePromote Integer
x) Integer
y
xorInteger Integer
x           Integer
y {- S# -} = Integer -> Integer -> Integer
xorInteger Integer
x (Integer -> Integer
unsafePromote Integer
y)
{-# CONSTANT_FOLDED xorInteger #-}

-- | Bitwise AND operation
andInteger :: Integer -> Integer -> Integer
-- short-cuts
andInteger :: Integer -> Integer -> Integer
andInteger (S# Int#
0#)     !Integer
_        = Int# -> Integer
S# Int#
0#
andInteger Integer
_           (S# Int#
0#)   = Int# -> Integer
S# Int#
0#
andInteger (S# Int#
-1#)   Integer
y          = Integer
y
andInteger Integer
x           (S# Int#
-1#)  = Integer
x
-- base-cases
andInteger (S# Int#
x#)     (S# Int#
y#)   = Int# -> Integer
S# (Int# -> Int# -> Int#
andI# Int#
x# Int#
y#)
andInteger (Jp# BigNat
x)     (Jp# BigNat
y)   = BigNat -> Integer
bigNatToInteger (BigNat -> BigNat -> BigNat
andBigNat BigNat
x BigNat
y)
andInteger (Jn# BigNat
x)     (Jn# BigNat
y)
    = BigNat -> Integer
bigNatToNegInteger (BigNat -> Word# -> BigNat
plusBigNatWord (BigNat -> BigNat -> BigNat
orBigNat (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
x Word#
1##)
                                                   (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
y Word#
1##)) Word#
1##)
andInteger x :: Integer
x@(Jn# BigNat
_)   y :: Integer
y@(Jp# BigNat
_)  = Integer -> Integer -> Integer
andInteger Integer
y Integer
x
andInteger (Jp# BigNat
x)     (Jn# BigNat
y)
    = BigNat -> Integer
bigNatToInteger (BigNat -> BigNat -> BigNat
andnBigNat BigNat
x (BigNat -> Word# -> BigNat
minusBigNatWord BigNat
y Word#
1##))
-- TODO/FIXME promotion-hack
andInteger x :: Integer
x@(S# Int#
_)   Integer
y          = Integer -> Integer -> Integer
andInteger (Integer -> Integer
unsafePromote Integer
x) Integer
y
andInteger Integer
x           Integer
y {- S# -}= Integer -> Integer -> Integer
andInteger Integer
x (Integer -> Integer
unsafePromote Integer
y)
{-# CONSTANT_FOLDED andInteger #-}

-- HACK warning! breaks invariant on purpose
unsafePromote :: Integer -> Integer
unsafePromote :: Integer -> Integer
unsafePromote (S# Int#
x#)
    | Int# -> Bool
isTrue# (Int#
x# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
Jp# (Word# -> BigNat
wordToBigNat (Int# -> Word#
int2Word# Int#
x#))
    | Bool
True                = BigNat -> Integer
Jn# (Word# -> BigNat
wordToBigNat (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
x#)))
unsafePromote Integer
x = Integer
x

-- | Simultaneous 'quotInteger' and 'remInteger'.
--
-- Divisor must be non-zero otherwise the GHC runtime will terminate
-- with a division-by-zero fault.
quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
quotRemInteger Integer
n       (S# Int#
1#) = (# Integer
n, Int# -> Integer
S# Int#
0# #)
quotRemInteger Integer
n      (S# Int#
-1#) = let !q :: Integer
q = Integer -> Integer
negateInteger Integer
n in (# Integer
q, (Int# -> Integer
S# Int#
0#) #)
quotRemInteger !Integer
_      (S# Int#
0#) = (# Int# -> Integer
S# (Int# -> Int# -> Int#
quotInt# Int#
0# Int#
0#),Int# -> Integer
S# (Int# -> Int# -> Int#
remInt# Int#
0# Int#
0#) #)
quotRemInteger (S# Int#
0#) Integer
_       = (# Int# -> Integer
S# Int#
0#, Int# -> Integer
S# Int#
0# #)
quotRemInteger (S# Int#
n#) (S# Int#
d#) = case Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
n# Int#
d# of
    (# Int#
q#, Int#
r# #) -> (# Int# -> Integer
S# Int#
q#, Int# -> Integer
S# Int#
r# #)
quotRemInteger (Jp# BigNat
n)  (Jp# BigNat
d)  = case BigNat -> BigNat -> (# BigNat, BigNat #)
quotRemBigNat BigNat
n BigNat
d of
    (# BigNat
q, BigNat
r #) -> (# BigNat -> Integer
bigNatToInteger BigNat
q, BigNat -> Integer
bigNatToInteger BigNat
r #)
quotRemInteger (Jp# BigNat
n)  (Jn# BigNat
d)  = case BigNat -> BigNat -> (# BigNat, BigNat #)
quotRemBigNat BigNat
n BigNat
d of
    (# BigNat
q, BigNat
r #) -> (# BigNat -> Integer
bigNatToNegInteger BigNat
q, BigNat -> Integer
bigNatToInteger BigNat
r #)
quotRemInteger (Jn# BigNat
n)  (Jn# BigNat
d)  = case BigNat -> BigNat -> (# BigNat, BigNat #)
quotRemBigNat BigNat
n BigNat
d of
    (# BigNat
q, BigNat
r #) -> (# BigNat -> Integer
bigNatToInteger BigNat
q, BigNat -> Integer
bigNatToNegInteger BigNat
r #)
quotRemInteger (Jn# BigNat
n)  (Jp# BigNat
d)  = case BigNat -> BigNat -> (# BigNat, BigNat #)
quotRemBigNat BigNat
n BigNat
d of
    (# BigNat
q, BigNat
r #) -> (# BigNat -> Integer
bigNatToNegInteger BigNat
q, BigNat -> Integer
bigNatToNegInteger BigNat
r #)
quotRemInteger (Jp# BigNat
n)  (S# Int#
d#)
  | Int# -> Bool
isTrue# (Int#
d# Int# -> Int# -> Int#
>=# Int#
0#) = case BigNat -> Word# -> (# BigNat, Word# #)
quotRemBigNatWord BigNat
n (Int# -> Word#
int2Word# Int#
d#) of
      (# BigNat
q, Word#
r# #) -> (# BigNat -> Integer
bigNatToInteger BigNat
q, (Word# -> Integer) -> Word# -> Integer
forall a. a -> a
inline Word# -> Integer
wordToInteger Word#
r# #)
  | Bool
True               = case BigNat -> Word# -> (# BigNat, Word# #)
quotRemBigNatWord BigNat
n (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
d#)) of
      (# BigNat
q, Word#
r# #) -> (# BigNat -> Integer
bigNatToNegInteger BigNat
q, (Word# -> Integer) -> Word# -> Integer
forall a. a -> a
inline Word# -> Integer
wordToInteger Word#
r# #)
quotRemInteger (Jn# BigNat
n)  (S# Int#
d#)
  | Int# -> Bool
isTrue# (Int#
d# Int# -> Int# -> Int#
>=# Int#
0#) = case BigNat -> Word# -> (# BigNat, Word# #)
quotRemBigNatWord BigNat
n (Int# -> Word#
int2Word# Int#
d#) of
      (# BigNat
q, Word#
r# #) -> (# BigNat -> Integer
bigNatToNegInteger BigNat
q, Word# -> Integer
wordToNegInteger Word#
r# #)
  | Bool
True               = case BigNat -> Word# -> (# BigNat, Word# #)
quotRemBigNatWord BigNat
n (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
d#)) of
      (# BigNat
q, Word#
r# #) -> (# BigNat -> Integer
bigNatToInteger BigNat
q, Word# -> Integer
wordToNegInteger Word#
r# #)
quotRemInteger n :: Integer
n@(S# Int#
_) (Jn# BigNat
_) = (# Int# -> Integer
S# Int#
0#, Integer
n #) -- since @n < d@
quotRemInteger n :: Integer
n@(S# Int#
n#) (Jp# BigNat
d) -- need to account for (S# minBound)
    | Int# -> Bool
isTrue# (Int#
n# Int# -> Int# -> Int#
># Int#
0#)                                    = (# Int# -> Integer
S# Int#
0#, Integer
n #)
    | Int# -> Bool
isTrue# (BigNat -> Word# -> Int#
gtBigNatWord# BigNat
d (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
n#))) = (# Int# -> Integer
S# Int#
0#, Integer
n #)
    | Bool
True {- abs(n) == d -}                          = (# Int# -> Integer
S# Int#
-1#, Int# -> Integer
S# Int#
0# #)
{-# CONSTANT_FOLDED quotRemInteger #-}


quotInteger :: Integer -> Integer -> Integer
quotInteger :: Integer -> Integer -> Integer
quotInteger Integer
n       (S# Int#
1#) = Integer
n
quotInteger Integer
n      (S# Int#
-1#) = Integer -> Integer
negateInteger Integer
n
quotInteger !Integer
_      (S# Int#
0#) = Int# -> Integer
S# (Int# -> Int# -> Int#
quotInt# Int#
0# Int#
0#)
quotInteger (S# Int#
0#) Integer
_       = Int# -> Integer
S# Int#
0#
quotInteger (S# Int#
n#)  (S# Int#
d#) = Int# -> Integer
S# (Int# -> Int# -> Int#
quotInt# Int#
n# Int#
d#)
quotInteger (Jp# BigNat
n)   (S# Int#
d#)
  | Int# -> Bool
isTrue# (Int#
d# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
bigNatToInteger    (BigNat -> Word# -> BigNat
quotBigNatWord BigNat
n (Int# -> Word#
int2Word# Int#
d#))
  | Bool
True                = BigNat -> Integer
bigNatToNegInteger (BigNat -> Word# -> BigNat
quotBigNatWord BigNat
n
                                              (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
d#)))
quotInteger (Jn# BigNat
n)   (S# Int#
d#)
  | Int# -> Bool
isTrue# (Int#
d# Int# -> Int# -> Int#
>=# Int#
0#) = BigNat -> Integer
bigNatToNegInteger (BigNat -> Word# -> BigNat
quotBigNatWord BigNat
n (Int# -> Word#
int2Word# Int#
d#))
  | Bool
True                = BigNat -> Integer
bigNatToInteger    (BigNat -> Word# -> BigNat
quotBigNatWord BigNat
n
                                              (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
d#)))
quotInteger (Jp# BigNat
n) (Jp# BigNat
d) = BigNat -> Integer
bigNatToInteger    (BigNat -> BigNat -> BigNat
quotBigNat BigNat
n BigNat
d)
quotInteger (Jp# BigNat
n) (Jn# BigNat
d) = BigNat -> Integer
bigNatToNegInteger (BigNat -> BigNat -> BigNat
quotBigNat BigNat
n BigNat
d)
quotInteger (Jn# BigNat
n) (Jp# BigNat
d) = BigNat -> Integer
bigNatToNegInteger (BigNat -> BigNat -> BigNat
quotBigNat BigNat
n BigNat
d)
quotInteger (Jn# BigNat
n) (Jn# BigNat
d) = BigNat -> Integer
bigNatToInteger    (BigNat -> BigNat -> BigNat
quotBigNat BigNat
n BigNat
d)
-- handle remaining non-allocating cases
quotInteger Integer
n Integer
d = case (Integer -> Integer -> (# Integer, Integer #))
-> Integer -> Integer -> (# Integer, Integer #)
forall a. a -> a
inline Integer -> Integer -> (# Integer, Integer #)
quotRemInteger Integer
n Integer
d of (# Integer
q, Integer
_ #) -> Integer
q
{-# CONSTANT_FOLDED quotInteger #-}

remInteger :: Integer -> Integer -> Integer
remInteger :: Integer -> Integer -> Integer
remInteger !Integer
_       (S# Int#
1#) = Int# -> Integer
S# Int#
0#
remInteger Integer
_       (S# Int#
-1#) = Int# -> Integer
S# Int#
0#
remInteger Integer
_        (S# Int#
0#) = Int# -> Integer
S# (Int# -> Int# -> Int#
remInt# Int#
0# Int#
0#)
remInteger (S# Int#
0#) Integer
_        = Int# -> Integer
S# Int#
0#
remInteger (S# Int#
n#) (S# Int#
d#) = Int# -> Integer
S# (Int# -> Int# -> Int#
remInt# Int#
n# Int#
d#)
remInteger (Jp# BigNat
n)  (S# Int#
d#)
    = Word# -> Integer
wordToInteger    (BigNat -> Word# -> Word#
remBigNatWord BigNat
n (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
d#)))
remInteger (Jn# BigNat
n)  (S# Int#
d#)
    = Word# -> Integer
wordToNegInteger (BigNat -> Word# -> Word#
remBigNatWord BigNat
n (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
d#)))
remInteger (Jp# BigNat
n)  (Jp# BigNat
d)  = BigNat -> Integer
bigNatToInteger    (BigNat -> BigNat -> BigNat
remBigNat BigNat
n BigNat
d)
remInteger (Jp# BigNat
n)  (Jn# BigNat
d)  = BigNat -> Integer
bigNatToInteger    (BigNat -> BigNat -> BigNat
remBigNat BigNat
n BigNat
d)
remInteger (Jn# BigNat
n)  (Jp# BigNat
d)  = BigNat -> Integer
bigNatToNegInteger (BigNat -> BigNat -> BigNat
remBigNat BigNat
n BigNat
d)
remInteger (Jn# BigNat
n)  (Jn# BigNat
d)  = BigNat -> Integer
bigNatToNegInteger (BigNat -> BigNat -> BigNat
remBigNat BigNat
n BigNat
d)
-- handle remaining non-allocating cases
remInteger Integer
n Integer
d = case (Integer -> Integer -> (# Integer, Integer #))
-> Integer -> Integer -> (# Integer, Integer #)
forall a. a -> a
inline Integer -> Integer -> (# Integer, Integer #)
quotRemInteger Integer
n Integer
d of (# Integer
_, Integer
r #) -> Integer
r
{-# CONSTANT_FOLDED remInteger #-}

-- | Simultaneous 'divInteger' and 'modInteger'.
--
-- Divisor must be non-zero otherwise the GHC runtime will terminate
-- with a division-by-zero fault.
divModInteger :: Integer -> Integer -> (# Integer, Integer #)
divModInteger :: Integer -> Integer -> (# Integer, Integer #)
divModInteger Integer
n Integer
d
  | Int# -> Bool
isTrue# (Integer -> Int#
signumInteger# Integer
r Int# -> Int# -> Int#
==# Int# -> Int#
negateInt# (Integer -> Int#
signumInteger# Integer
d))
     = let !q' :: Integer
q' = Integer -> Integer -> Integer
plusInteger Integer
q (Int# -> Integer
S# Int#
-1#) -- TODO: optimize
           !r' :: Integer
r' = Integer -> Integer -> Integer
plusInteger Integer
r Integer
d
       in (# Integer
q', Integer
r' #)
  | Bool
True = (# Integer, Integer #)
qr
  where
    !qr :: (# Integer, Integer #)
qr@(# Integer
q, Integer
r #) = Integer -> Integer -> (# Integer, Integer #)
quotRemInteger Integer
n Integer
d
{-# CONSTANT_FOLDED divModInteger #-}

divInteger :: Integer -> Integer -> Integer
-- same-sign ops can be handled by more efficient 'quotInteger'
divInteger :: Integer -> Integer -> Integer
divInteger Integer
n Integer
d | Int# -> Bool
isTrue# (Integer -> Int#
isNegInteger# Integer
n Int# -> Int# -> Int#
==# Integer -> Int#
isNegInteger# Integer
d) = Integer -> Integer -> Integer
quotInteger Integer
n Integer
d
divInteger Integer
n Integer
d = case (Integer -> Integer -> (# Integer, Integer #))
-> Integer -> Integer -> (# Integer, Integer #)
forall a. a -> a
inline Integer -> Integer -> (# Integer, Integer #)
divModInteger Integer
n Integer
d of (# Integer
q, Integer
_ #) -> Integer
q
{-# CONSTANT_FOLDED divInteger #-}

modInteger :: Integer -> Integer -> Integer
-- same-sign ops can be handled by more efficient 'remInteger'
modInteger :: Integer -> Integer -> Integer
modInteger Integer
n Integer
d | Int# -> Bool
isTrue# (Integer -> Int#
isNegInteger# Integer
n Int# -> Int# -> Int#
==# Integer -> Int#
isNegInteger# Integer
d) = Integer -> Integer -> Integer
remInteger Integer
n Integer
d
modInteger Integer
n Integer
d = case (Integer -> Integer -> (# Integer, Integer #))
-> Integer -> Integer -> (# Integer, Integer #)
forall a. a -> a
inline Integer -> Integer -> (# Integer, Integer #)
divModInteger Integer
n Integer
d of (# Integer
_, Integer
r #) -> Integer
r
{-# CONSTANT_FOLDED modInteger #-}

-- | Compute greatest common divisor.
gcdInteger :: Integer -> Integer -> Integer
gcdInteger :: Integer -> Integer -> Integer
gcdInteger (S# Int#
0#)        Integer
b = Integer -> Integer
absInteger Integer
b
gcdInteger Integer
a        (S# Int#
0#) = Integer -> Integer
absInteger Integer
a
gcdInteger (S# Int#
1#)        Integer
_ = Int# -> Integer
S# Int#
1#
gcdInteger (S# Int#
-1#)       Integer
_ = Int# -> Integer
S# Int#
1#
gcdInteger Integer
_        (S# Int#
1#) = Int# -> Integer
S# Int#
1#
gcdInteger Integer
_       (S# Int#
-1#) = Int# -> Integer
S# Int#
1#
gcdInteger (S# Int#
a#) (S# Int#
b#)
    = Word# -> Integer
wordToInteger (Word# -> Word# -> Word#
gcdWord# (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
a#)) (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
b#)))
gcdInteger a :: Integer
a@(S# Int#
_) Integer
b = Integer -> Integer -> Integer
gcdInteger Integer
b Integer
a
gcdInteger (Jn# BigNat
a) Integer
b = Integer -> Integer -> Integer
gcdInteger (BigNat -> Integer
Jp# BigNat
a) Integer
b
gcdInteger (Jp# BigNat
a) (Jp# BigNat
b) = BigNat -> Integer
bigNatToInteger (BigNat -> BigNat -> BigNat
gcdBigNat BigNat
a BigNat
b)
gcdInteger (Jp# BigNat
a) (Jn# BigNat
b) = BigNat -> Integer
bigNatToInteger (BigNat -> BigNat -> BigNat
gcdBigNat BigNat
a BigNat
b)
gcdInteger (Jp# BigNat
a) (S# Int#
b#)
    = Word# -> Integer
wordToInteger (BigNat -> Word# -> Word#
gcdBigNatWord BigNat
a (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
b#)))
{-# CONSTANT_FOLDED gcdInteger #-}

-- | Compute least common multiple.
lcmInteger :: Integer -> Integer -> Integer
lcmInteger :: Integer -> Integer -> Integer
lcmInteger (S# Int#
0#) !Integer
_  = Int# -> Integer
S# Int#
0#
lcmInteger (S# Int#
1#)  Integer
b  = Integer -> Integer
absInteger Integer
b
lcmInteger (S# Int#
-1#) Integer
b  = Integer -> Integer
absInteger Integer
b
lcmInteger Integer
_ (S# Int#
0#)   = Int# -> Integer
S# Int#
0#
lcmInteger Integer
a (S# Int#
1#)   = Integer -> Integer
absInteger Integer
a
lcmInteger Integer
a (S# Int#
-1#)  = Integer -> Integer
absInteger Integer
a
lcmInteger Integer
a Integer
b = (Integer
aa Integer -> Integer -> Integer
`quotInteger` (Integer
aa Integer -> Integer -> Integer
`gcdInteger` Integer
ab)) Integer -> Integer -> Integer
`timesInteger` Integer
ab
  where
    aa :: Integer
aa = Integer -> Integer
absInteger Integer
a
    ab :: Integer
ab = Integer -> Integer
absInteger Integer
b
{-# CONSTANT_FOLDED lcmInteger #-}

-- | Compute greatest common divisor.
--
-- __Warning__: result may become negative if (at least) one argument
-- is 'minBound'
gcdInt :: Int# -> Int# -> Int#
gcdInt :: Int# -> Int# -> Int#
gcdInt Int#
x# Int#
y#
    = Word# -> Int#
word2Int# (Word# -> Word# -> Word#
gcdWord# (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
x#)) (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
y#)))

-- | Compute greatest common divisor.
--
-- @since 1.0.0.0
gcdWord :: Word# -> Word# -> Word#
gcdWord :: Word# -> Word# -> Word#
gcdWord = Word# -> Word# -> Word#
gcdWord#

----------------------------------------------------------------------------
-- BigNat operations

compareBigNat :: BigNat -> BigNat -> Ordering
compareBigNat :: BigNat -> BigNat -> Ordering
compareBigNat x :: BigNat
x@(BN# ByteArray#
x#) y :: BigNat
y@(BN# ByteArray#
y#)
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
==# Int#
ny#)
      = Int# -> Int# -> Ordering
compareInt# (Int# -> Int#
narrowCInt# (ByteArray# -> ByteArray# -> Int# -> Int#
c_mpn_cmp ByteArray#
x# ByteArray#
y# Int#
nx#)) Int#
0#
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
<#  Int#
ny#) = Ordering
LT
  | Bool
True                  = Ordering
GT
  where
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y

compareBigNatWord :: BigNat -> GmpLimb# -> Ordering
compareBigNatWord :: BigNat -> Word# -> Ordering
compareBigNatWord BigNat
bn Word#
w#
  | Int# -> Bool
isTrue# (BigNat -> Int#
sizeofBigNat# BigNat
bn Int# -> Int# -> Int#
==# Int#
1#) = Word# -> Word# -> Ordering
cmpW# (BigNat -> Word#
bigNatToWord BigNat
bn) Word#
w#
  | Bool
True                              = Ordering
GT

gtBigNatWord# :: BigNat -> GmpLimb# -> Int#
gtBigNatWord# :: BigNat -> Word# -> Int#
gtBigNatWord# BigNat
bn Word#
w#
    = (BigNat -> Int#
sizeofBigNat# BigNat
bn Int# -> Int# -> Int#
># Int#
1#) Int# -> Int# -> Int#
`orI#` (BigNat -> Word#
bigNatToWord BigNat
bn Word# -> Word# -> Int#
`gtWord#` Word#
w#)

eqBigNat :: BigNat -> BigNat -> Bool
eqBigNat :: BigNat -> BigNat -> Bool
eqBigNat BigNat
x BigNat
y = Int# -> Bool
isTrue# (BigNat -> BigNat -> Int#
eqBigNat# BigNat
x BigNat
y)

eqBigNat# :: BigNat -> BigNat -> Int#
eqBigNat# :: BigNat -> BigNat -> Int#
eqBigNat# x :: BigNat
x@(BN# ByteArray#
x#) y :: BigNat
y@(BN# ByteArray#
y#)
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
==# Int#
ny#) = ByteArray# -> ByteArray# -> Int# -> Int#
c_mpn_cmp ByteArray#
x# ByteArray#
y# Int#
nx# Int# -> Int# -> Int#
==# Int#
0#
  | Bool
True                  = Int#
0#
  where
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y

neqBigNat# :: BigNat -> BigNat -> Int#
neqBigNat# :: BigNat -> BigNat -> Int#
neqBigNat# x :: BigNat
x@(BN# ByteArray#
x#) y :: BigNat
y@(BN# ByteArray#
y#)
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
==# Int#
ny#) = ByteArray# -> ByteArray# -> Int# -> Int#
c_mpn_cmp ByteArray#
x# ByteArray#
y# Int#
nx# Int# -> Int# -> Int#
/=# Int#
0#
  | Bool
True                  = Int#
1#
  where
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y

eqBigNatWord :: BigNat -> GmpLimb# -> Bool
eqBigNatWord :: BigNat -> Word# -> Bool
eqBigNatWord BigNat
bn Word#
w# = Int# -> Bool
isTrue# (BigNat -> Word# -> Int#
eqBigNatWord# BigNat
bn Word#
w#)

eqBigNatWord# :: BigNat -> GmpLimb# -> Int#
eqBigNatWord# :: BigNat -> Word# -> Int#
eqBigNatWord# BigNat
bn Word#
w#
    = (BigNat -> Int#
sizeofBigNat# BigNat
bn Int# -> Int# -> Int#
==# Int#
1#) Int# -> Int# -> Int#
`andI#` (BigNat -> Word#
bigNatToWord BigNat
bn Word# -> Word# -> Int#
`eqWord#` Word#
w#)


-- | Same as @'indexBigNat#' bn 0\#@
bigNatToWord :: BigNat -> Word#
bigNatToWord :: BigNat -> Word#
bigNatToWord BigNat
bn = BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
0#

-- | Equivalent to @'word2Int#' . 'bigNatToWord'@
bigNatToInt :: BigNat -> Int#
bigNatToInt :: BigNat -> Int#
bigNatToInt (BN# ByteArray#
ba#) = ByteArray# -> Int# -> Int#
indexIntArray# ByteArray#
ba# Int#
0#

-- | CAF representing the value @0 :: BigNat@
zeroBigNat :: BigNat
zeroBigNat :: BigNat
zeroBigNat = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    MutBigNat RealWorld
mbn <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
1#
    ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
0# Word#
0##)
    MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
{-# NOINLINE zeroBigNat #-}

-- | Test if 'BigNat' value is equal to zero.
isZeroBigNat :: BigNat -> Bool
isZeroBigNat :: BigNat -> Bool
isZeroBigNat BigNat
bn = BigNat -> Word# -> Bool
eqBigNatWord BigNat
bn Word#
0##

-- | CAF representing the value @1 :: BigNat@
oneBigNat :: BigNat
oneBigNat :: BigNat
oneBigNat = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    MutBigNat RealWorld
mbn <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
1#
    ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
0# Word#
1##)
    MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
{-# NOINLINE oneBigNat #-}

czeroBigNat :: BigNat
czeroBigNat :: BigNat
czeroBigNat = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    MutBigNat RealWorld
mbn <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
1#
    ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
0# (Word# -> Word#
not# Word#
0##))
    MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
{-# NOINLINE czeroBigNat #-}

-- | Special 0-sized bigNat returned in case of arithmetic underflow
--
-- This is currently only returned by the following operations:
--
--  - 'minusBigNat'
--  - 'minusBigNatWord'
--
-- Other operations such as 'quotBigNat' may return 'nullBigNat' as
-- well as a dummy/place-holder value instead of 'undefined' since we
-- can't throw exceptions. But that behaviour should not be relied
-- upon.
--
-- NB: @isValidBigNat# nullBigNat@ is false
nullBigNat :: BigNat
nullBigNat :: BigNat
nullBigNat = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
0# S RealWorld (MutBigNat RealWorld)
-> (MutBigNat RealWorld -> S RealWorld BigNat)
-> S RealWorld BigNat
forall s a b. S s a -> (a -> S s b) -> S s b
>>= MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat#)
{-# NOINLINE nullBigNat #-}

-- | Test for special 0-sized 'BigNat' representing underflows.
isNullBigNat# :: BigNat -> Int#
isNullBigNat# :: BigNat -> Int#
isNullBigNat# (BN# ByteArray#
ba#) = ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba# Int# -> Int# -> Int#
==# Int#
0#

-- | Construct 1-limb 'BigNat' from 'Word#'
wordToBigNat :: Word# -> BigNat
wordToBigNat :: Word# -> BigNat
wordToBigNat Word#
0## = BigNat
zeroBigNat
wordToBigNat Word#
1## = BigNat
oneBigNat
wordToBigNat Word#
w#
  | Int# -> Bool
isTrue# (Word# -> Word#
not# Word#
w# Word# -> Word# -> Int#
`eqWord#` Word#
0##) = BigNat
czeroBigNat
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    MutBigNat RealWorld
mbn <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
1#
    ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
0# Word#
w#)
    MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn

-- | Construct BigNat from 2 limbs.
-- The first argument is the most-significant limb.
wordToBigNat2 :: Word# -> Word# -> BigNat
wordToBigNat2 :: Word# -> Word# -> BigNat
wordToBigNat2 Word#
0## Word#
lw# = Word# -> BigNat
wordToBigNat Word#
lw#
wordToBigNat2 Word#
hw# Word#
lw# = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    MutBigNat RealWorld
mbn <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
2#
    ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
0# Word#
lw#)
    ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
1# Word#
hw#)
    MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn

plusBigNat :: BigNat -> BigNat -> BigNat
plusBigNat :: BigNat -> BigNat -> BigNat
plusBigNat BigNat
x BigNat
y
  | Int# -> Bool
isTrue# (BigNat -> Word# -> Int#
eqBigNatWord# BigNat
x Word#
0##) = BigNat
y
  | Int# -> Bool
isTrue# (BigNat -> Word# -> Int#
eqBigNatWord# BigNat
y Word#
0##) = BigNat
x
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
>=# Int#
ny#) = BigNat -> Int# -> BigNat -> Int# -> BigNat
go BigNat
x Int#
nx# BigNat
y Int#
ny#
  | Bool
True                  = BigNat -> Int# -> BigNat -> Int# -> BigNat
go BigNat
y Int#
ny# BigNat
x Int#
nx#
  where
    go :: BigNat -> Int# -> BigNat -> Int# -> BigNat
go (BN# ByteArray#
a#) Int#
na# (BN# ByteArray#
b#) Int#
nb# = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
        mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
na#
        (W# Word#
c#) <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO Word
forall s.
MutableByteArray# s
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO Word
c_mpn_add MutableByteArray# RealWorld
mba# ByteArray#
a# Int#
na# ByteArray#
b# Int#
nb#)
        case Word#
c# of
              Word#
0## -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
              Word#
_   -> MutBigNat RealWorld -> Word# -> S RealWorld BigNat
forall s. MutBigNat s -> Word# -> S s BigNat
unsafeSnocFreezeBigNat# MutBigNat RealWorld
mbn Word#
c#

    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y

plusBigNatWord :: BigNat -> GmpLimb# -> BigNat
plusBigNatWord :: BigNat -> Word# -> BigNat
plusBigNatWord BigNat
x          Word#
0## = BigNat
x
plusBigNatWord x :: BigNat
x@(BN# ByteArray#
x#) Word#
y# = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nx#
    (W# Word#
c#) <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> Word# -> IO Word
forall s.
MutableByteArray# s -> ByteArray# -> Int# -> Word# -> IO Word
c_mpn_add_1 MutableByteArray# RealWorld
mba# ByteArray#
x# Int#
nx# Word#
y#)
    case Word#
c# of
        Word#
0## -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
        Word#
_   -> MutBigNat RealWorld -> Word# -> S RealWorld BigNat
forall s. MutBigNat s -> Word# -> S s BigNat
unsafeSnocFreezeBigNat# MutBigNat RealWorld
mbn Word#
c#
  where
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x

-- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflow
minusBigNat :: BigNat -> BigNat -> BigNat
minusBigNat :: BigNat -> BigNat -> BigNat
minusBigNat x :: BigNat
x@(BN# ByteArray#
x#) y :: BigNat
y@(BN# ByteArray#
y#)
  | BigNat -> Bool
isZeroBigNat BigNat
y = BigNat
x
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
>=# Int#
ny#) = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nx#
    (W# Word#
b#) <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO Word
forall s.
MutableByteArray# s
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO Word
c_mpn_sub MutableByteArray# RealWorld
mba# ByteArray#
x# Int#
nx# ByteArray#
y# Int#
ny#)
    case Word#
b# of
        Word#
0## -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
mbn
        Word#
_   -> BigNat -> S RealWorld BigNat
forall a s. a -> S s a
return BigNat
nullBigNat

  | Bool
True = BigNat
nullBigNat
  where
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y

-- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflow
minusBigNatWord :: BigNat -> GmpLimb# -> BigNat
minusBigNatWord :: BigNat -> Word# -> BigNat
minusBigNatWord BigNat
x Word#
0## = BigNat
x
minusBigNatWord x :: BigNat
x@(BN# ByteArray#
x#) Word#
y# = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nx#
    (W# Word#
b#) <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (IO Word -> S RealWorld Word) -> IO Word -> S RealWorld Word
forall a b. (a -> b) -> a -> b
$ MutableByteArray# RealWorld
-> ByteArray# -> Int# -> Word# -> IO Word
forall s.
MutableByteArray# s -> ByteArray# -> Int# -> Word# -> IO Word
c_mpn_sub_1 MutableByteArray# RealWorld
mba# ByteArray#
x# Int#
nx# Word#
y#
    case Word#
b# of
        Word#
0## -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
mbn
        Word#
_   -> BigNat -> S RealWorld BigNat
forall a s. a -> S s a
return BigNat
nullBigNat
  where
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x


timesBigNat :: BigNat -> BigNat -> BigNat
timesBigNat :: BigNat -> BigNat -> BigNat
timesBigNat BigNat
x BigNat
y
  | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
zeroBigNat
  | BigNat -> Bool
isZeroBigNat BigNat
y = BigNat
zeroBigNat
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
>=# Int#
ny#) = BigNat -> Int# -> BigNat -> Int# -> BigNat
go BigNat
x Int#
nx# BigNat
y Int#
ny#
  | Bool
True                  = BigNat -> Int# -> BigNat -> Int# -> BigNat
go BigNat
y Int#
ny# BigNat
x Int#
nx#
  where
    go :: BigNat -> Int# -> BigNat -> Int# -> BigNat
go (BN# ByteArray#
a#) Int#
na# (BN# ByteArray#
b#) Int#
nb# = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
        let n# :: Int#
n# = Int#
nx# Int# -> Int# -> Int#
+# Int#
ny#
        mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
n#
        (W# Word#
msl#) <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO Word
forall s.
MutableByteArray# s
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO Word
c_mpn_mul MutableByteArray# RealWorld
mba# ByteArray#
a# Int#
na# ByteArray#
b# Int#
nb#)
        case Word#
msl# of
              Word#
0## -> MutBigNat RealWorld -> Int# -> S RealWorld BigNat
forall s. MutBigNat s -> Int# -> S s BigNat
unsafeShrinkFreezeBigNat# MutBigNat RealWorld
mbn (Int#
n# Int# -> Int# -> Int#
-# Int#
1#)
              Word#
_   -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn

    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y

-- | Square 'BigNat'
sqrBigNat :: BigNat -> BigNat
sqrBigNat :: BigNat -> BigNat
sqrBigNat BigNat
x
  | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
zeroBigNat
  -- TODO: 1-limb BigNats below sqrt(maxBound::GmpLimb)
sqrBigNat BigNat
x = BigNat -> BigNat -> BigNat
timesBigNat BigNat
x BigNat
x -- TODO: mpn_sqr

timesBigNatWord :: BigNat -> GmpLimb# -> BigNat
timesBigNatWord :: BigNat -> Word# -> BigNat
timesBigNatWord !BigNat
_ Word#
0## = BigNat
zeroBigNat
timesBigNatWord BigNat
x Word#
1## = BigNat
x
timesBigNatWord x :: BigNat
x@(BN# ByteArray#
x#) Word#
y#
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
==# Int#
1#) =
      let !(# !Word#
h#, !Word#
l# #) = Word# -> Word# -> (# Word#, Word# #)
timesWord2# (BigNat -> Word#
bigNatToWord BigNat
x) Word#
y#
      in Word# -> Word# -> BigNat
wordToBigNat2 Word#
h# Word#
l#
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
        mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nx#
        (W# Word#
msl#) <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> Word# -> IO Word
forall s.
MutableByteArray# s -> ByteArray# -> Int# -> Word# -> IO Word
c_mpn_mul_1 MutableByteArray# RealWorld
mba# ByteArray#
x# Int#
nx# Word#
y#)
        case Word#
msl# of
              Word#
0## -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
              Word#
_   -> MutBigNat RealWorld -> Word# -> S RealWorld BigNat
forall s. MutBigNat s -> Word# -> S s BigNat
unsafeSnocFreezeBigNat# MutBigNat RealWorld
mbn Word#
msl#

  where
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x

-- | Specialised version of
--
-- > bitBigNat = shiftLBigNat (wordToBigNat 1##)
--
-- avoiding a few redundant allocations
bitBigNat :: Int# -> BigNat
bitBigNat :: Int# -> BigNat
bitBigNat Int#
i#
  | Int# -> Bool
isTrue# (Int#
i#  Int# -> Int# -> Int#
<#  Int#
0#) = BigNat
zeroBigNat -- or maybe 'nullBigNat'?
  | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
==#  Int#
0#) = BigNat
oneBigNat
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
      mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# (Int#
li# Int# -> Int# -> Int#
+# Int#
1#)
      -- FIXME: do we really need to zero-init MBAs returned by 'newByteArray#'?
      -- clear all limbs (except for the most-significant limb)
      ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall s.
MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
clearWordArray# MutableByteArray# RealWorld
mba# Int#
0# Int#
li#)
      -- set single bit in most-significant limb
      ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
li# (Word# -> Int# -> Word#
uncheckedShiftL# Word#
1## Int#
bi#))
      MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
  where
    !(# Int#
li#, Int#
bi# #) = Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
i# GMP_LIMB_BITS#

testBitBigNat :: BigNat -> Int# -> Bool
testBitBigNat :: BigNat -> Int# -> Bool
testBitBigNat BigNat
bn Int#
i#
  | Int# -> Bool
isTrue# (Int#
i#  Int# -> Int# -> Int#
<#  Int#
0#) = Bool
False
  | Int# -> Bool
isTrue# (Int#
li# Int# -> Int# -> Int#
<# Int#
nx#) = Int# -> Bool
isTrue# (Word# -> Int# -> Int#
testBitWord# (BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
li#) Int#
bi#)
  | Bool
True                 = Bool
False
  where
    !(# Int#
li#, Int#
bi# #) = Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
i# GMP_LIMB_BITS#
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
bn

testBitNegBigNat :: BigNat -> Int# -> Bool
testBitNegBigNat :: BigNat -> Int# -> Bool
testBitNegBigNat BigNat
bn Int#
i#
  | Int# -> Bool
isTrue# (Int#
i#  Int# -> Int# -> Int#
<#  Int#
0#)  = Bool
False
  | Int# -> Bool
isTrue# (Int#
li# Int# -> Int# -> Int#
>=# Int#
nx#) = Bool
True
  | Int# -> Bool
allZ Int#
li# = Int# -> Bool
isTrue# ((Word# -> Int# -> Int#
testBitWord#
                         (BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
li# Word# -> Word# -> Word#
`minusWord#` Word#
1##) Int#
bi#) Int# -> Int# -> Int#
==# Int#
0#)
  | Bool
True     = Int# -> Bool
isTrue# ((Word# -> Int# -> Int#
testBitWord# (BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
li#) Int#
bi#) Int# -> Int# -> Int#
==# Int#
0#)
  where
    !(# Int#
li#, Int#
bi# #) = Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
i# GMP_LIMB_BITS#
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
bn

    allZ :: Int# -> Bool
allZ Int#
0# = Bool
True
    allZ Int#
j | Int# -> Bool
isTrue# (BigNat -> Int# -> Word#
indexBigNat# BigNat
bn (Int#
j Int# -> Int# -> Int#
-# Int#
1#) Word# -> Word# -> Int#
`eqWord#` Word#
0##) = Int# -> Bool
allZ (Int#
j Int# -> Int# -> Int#
-# Int#
1#)
           | Bool
True                 = Bool
False


clearBitBigNat :: BigNat -> Int# -> BigNat
clearBitBigNat :: BigNat -> Int# -> BigNat
clearBitBigNat BigNat
bn Int#
i#
  | Bool -> Bool
not ((BigNat -> Int# -> Bool) -> BigNat -> Int# -> Bool
forall a. a -> a
inline BigNat -> Int# -> Bool
testBitBigNat BigNat
bn Int#
i#) = BigNat
bn
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
==# Int#
1#)        = Word# -> BigNat
wordToBigNat (BigNat -> Word#
bigNatToWord BigNat
bn Word# -> Word# -> Word#
`xor#` Int# -> Word#
bitWord# Int#
bi#)
  | Int# -> Bool
isTrue# (Int#
li# Int# -> Int# -> Int#
+# Int#
1# Int# -> Int# -> Int#
==# Int#
nx#) = -- special case, operating on most-sig limb
      case BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
li# Word# -> Word# -> Word#
`xor#` Int# -> Word#
bitWord# Int#
bi# of
        Word#
0## -> do -- most-sig limb became zero -> result has less limbs
            case BigNat -> Int# -> Int#
fmssl BigNat
bn (Int#
li# Int# -> Int# -> Int#
-# Int#
1#) of
              Int#
0# -> BigNat
zeroBigNat
              Int#
n# -> S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
                  MutBigNat RealWorld
mbn <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
n#
                  ()
_ <- BigNat
-> Int# -> MutBigNat RealWorld -> Int# -> Int# -> S RealWorld ()
forall s. BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()
copyWordArray BigNat
bn Int#
0# MutBigNat RealWorld
mbn Int#
0# Int#
n#
                  MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
        Word#
newlimb# -> S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do -- no shrinking
            MutBigNat RealWorld
mbn <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nx#
            ()
_ <- BigNat
-> Int# -> MutBigNat RealWorld -> Int# -> Int# -> S RealWorld ()
forall s. BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()
copyWordArray BigNat
bn Int#
0# MutBigNat RealWorld
mbn Int#
0# Int#
li#
            ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
li# Word#
newlimb#)
            MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn

  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
        MutBigNat RealWorld
mbn <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nx#
        ()
_ <- BigNat
-> Int# -> MutBigNat RealWorld -> Int# -> Int# -> S RealWorld ()
forall s. BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()
copyWordArray BigNat
bn Int#
0# MutBigNat RealWorld
mbn Int#
0# Int#
nx#
        let newlimb# :: Word#
newlimb# = BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
li# Word# -> Word# -> Word#
`xor#` Int# -> Word#
bitWord# Int#
bi#
        ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
li# Word#
newlimb#)
        MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn

  where
    !(# Int#
li#, Int#
bi# #) = Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
i# GMP_LIMB_BITS#
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
bn



setBitBigNat :: BigNat -> Int# -> BigNat
setBitBigNat :: BigNat -> Int# -> BigNat
setBitBigNat BigNat
bn Int#
i#
  | (BigNat -> Int# -> Bool) -> BigNat -> Int# -> Bool
forall a. a -> a
inline BigNat -> Int# -> Bool
testBitBigNat BigNat
bn Int#
i# = BigNat
bn
  | Int# -> Bool
isTrue# (Int#
d# Int# -> Int# -> Int#
># Int#
0#) = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do -- result BigNat will have more limbs
        mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# (Int#
li# Int# -> Int# -> Int#
+# Int#
1#)
        ()
_ <- BigNat
-> Int# -> MutBigNat RealWorld -> Int# -> Int# -> S RealWorld ()
forall s. BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()
copyWordArray BigNat
bn Int#
0# MutBigNat RealWorld
mbn Int#
0# Int#
nx#
        ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutableByteArray# RealWorld
-> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall s.
MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
clearWordArray# MutableByteArray# RealWorld
mba# Int#
nx# (Int#
d# Int# -> Int# -> Int#
-# Int#
1#))
        ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
li# (Int# -> Word#
bitWord# Int#
bi#))
        MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn

  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
        MutBigNat RealWorld
mbn <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nx#
        ()
_ <- BigNat
-> Int# -> MutBigNat RealWorld -> Int# -> Int# -> S RealWorld ()
forall s. BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()
copyWordArray BigNat
bn Int#
0# MutBigNat RealWorld
mbn Int#
0# Int#
nx#
        ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall s. MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# MutBigNat RealWorld
mbn Int#
li# (BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
li#
                                          Word# -> Word# -> Word#
`or#` Int# -> Word#
bitWord# Int#
bi#))
        MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn

  where
    !(# Int#
li#, Int#
bi# #) = Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
i# GMP_LIMB_BITS#
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
bn
    d# :: Int#
d# = Int#
li# Int# -> Int# -> Int#
+# Int#
1# Int# -> Int# -> Int#
-# Int#
nx#


complementBitBigNat :: BigNat -> Int# -> BigNat
complementBitBigNat :: BigNat -> Int# -> BigNat
complementBitBigNat BigNat
bn Int#
i#
  | BigNat -> Int# -> Bool
testBitBigNat BigNat
bn Int#
i# = BigNat -> Int# -> BigNat
clearBitBigNat BigNat
bn Int#
i#
  | Bool
True                = BigNat -> Int# -> BigNat
setBitBigNat BigNat
bn Int#
i#

popCountBigNat :: BigNat -> Int#
popCountBigNat :: BigNat -> Int#
popCountBigNat bn :: BigNat
bn@(BN# ByteArray#
ba#) = Word# -> Int#
word2Int# (ByteArray# -> Int# -> Word#
c_mpn_popcount ByteArray#
ba# (BigNat -> Int#
sizeofBigNat# BigNat
bn))


shiftLBigNat :: BigNat -> Int# -> BigNat
shiftLBigNat :: BigNat -> Int# -> BigNat
shiftLBigNat BigNat
x Int#
0# = BigNat
x
shiftLBigNat BigNat
x Int#
_ | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
zeroBigNat
shiftLBigNat x :: BigNat
x@(BN# ByteArray#
xba#) Int#
n# = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    ymbn :: MutBigNat RealWorld
ymbn@(MBN# MutableByteArray# RealWorld
ymba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
yn#
    W# Word#
ymsl <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> Word# -> IO Word
forall s.
MutableByteArray# s -> ByteArray# -> Int# -> Word# -> IO Word
c_mpn_lshift MutableByteArray# RealWorld
ymba# ByteArray#
xba# Int#
xn# (Int# -> Word#
int2Word# Int#
n#))
    case Word#
ymsl of
        Word#
0## -> MutBigNat RealWorld -> Int# -> S RealWorld BigNat
forall s. MutBigNat s -> Int# -> S s BigNat
unsafeShrinkFreezeBigNat# MutBigNat RealWorld
ymbn (Int#
yn# Int# -> Int# -> Int#
-# Int#
1#)
        Word#
_   -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
ymbn
  where
    xn# :: Int#
xn# = BigNat -> Int#
sizeofBigNat# BigNat
x
    yn# :: Int#
yn# = Int#
xn# Int# -> Int# -> Int#
+# Int#
nlimbs# Int# -> Int# -> Int#
+# (Int#
nbits# Int# -> Int# -> Int#
/=# Int#
0#)
    !(# Int#
nlimbs#, Int#
nbits# #) = Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
n# GMP_LIMB_BITS#



shiftRBigNat :: BigNat -> Int# -> BigNat
shiftRBigNat :: BigNat -> Int# -> BigNat
shiftRBigNat BigNat
x Int#
0# = BigNat
x
shiftRBigNat BigNat
x Int#
_ | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
zeroBigNat
shiftRBigNat x :: BigNat
x@(BN# ByteArray#
xba#) Int#
n#
  | Int# -> Bool
isTrue# (Int#
nlimbs# Int# -> Int# -> Int#
>=# Int#
xn#) = BigNat
zeroBigNat
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
      ymbn :: MutBigNat RealWorld
ymbn@(MBN# MutableByteArray# RealWorld
ymba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
yn#
      W# Word#
ymsl <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> Word# -> IO Word
forall s.
MutableByteArray# s -> ByteArray# -> Int# -> Word# -> IO Word
c_mpn_rshift MutableByteArray# RealWorld
ymba# ByteArray#
xba# Int#
xn# (Int# -> Word#
int2Word# Int#
n#))
      case Word#
ymsl of
          Word#
0## -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
ymbn -- may shrink more than one
          Word#
_   -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
ymbn
  where
    xn# :: Int#
xn# = BigNat -> Int#
sizeofBigNat# BigNat
x
    yn# :: Int#
yn# = Int#
xn# Int# -> Int# -> Int#
-# Int#
nlimbs#
    nlimbs# :: Int#
nlimbs# = Int# -> Int# -> Int#
quotInt# Int#
n# GMP_LIMB_BITS#

shiftRNegBigNat :: BigNat -> Int# -> BigNat
shiftRNegBigNat :: BigNat -> Int# -> BigNat
shiftRNegBigNat BigNat
x Int#
0# = BigNat
x
shiftRNegBigNat BigNat
x Int#
_ | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
zeroBigNat
shiftRNegBigNat x :: BigNat
x@(BN# ByteArray#
xba#) Int#
n#
  | Int# -> Bool
isTrue# (Int#
nlimbs# Int# -> Int# -> Int#
>=# Int#
xn#) = BigNat
zeroBigNat
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
      ymbn :: MutBigNat RealWorld
ymbn@(MBN# MutableByteArray# RealWorld
ymba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
yn#
      W# Word#
ymsl <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> Word# -> IO Word
forall s.
MutableByteArray# s -> ByteArray# -> Int# -> Word# -> IO Word
c_mpn_rshift_2c MutableByteArray# RealWorld
ymba# ByteArray#
xba# Int#
xn# (Int# -> Word#
int2Word# Int#
n#))
      case Word#
ymsl of
          Word#
0## -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
ymbn -- may shrink more than one
          Word#
_   -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
ymbn
  where
    xn# :: Int#
xn# = BigNat -> Int#
sizeofBigNat# BigNat
x
    yn# :: Int#
yn# = Int#
xn# Int# -> Int# -> Int#
-# Int#
nlimbs#
    nlimbs# :: Int#
nlimbs# = Int# -> Int# -> Int#
quotInt# (Int#
n# Int# -> Int# -> Int#
-# Int#
1#) GMP_LIMB_BITS#


orBigNat :: BigNat -> BigNat -> BigNat
orBigNat :: BigNat -> BigNat -> BigNat
orBigNat x :: BigNat
x@(BN# ByteArray#
x#) y :: BigNat
y@(BN# ByteArray#
y#)
  | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
y
  | BigNat -> Bool
isZeroBigNat BigNat
y = BigNat
x
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
>=# Int#
ny#) = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (ByteArray# -> Int# -> ByteArray# -> Int# -> S RealWorld BigNat
ior' ByteArray#
x# Int#
nx# ByteArray#
y# Int#
ny#)
  | Bool
True                  = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (ByteArray# -> Int# -> ByteArray# -> Int# -> S RealWorld BigNat
ior' ByteArray#
y# Int#
ny# ByteArray#
x# Int#
nx#)
  where
    ior' :: ByteArray# -> Int# -> ByteArray# -> Int# -> S RealWorld BigNat
ior' ByteArray#
a# Int#
na# ByteArray#
b# Int#
nb# = do -- na >= nb
        mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
na#
        ()
_ <- IO () -> S RealWorld ()
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> ByteArray# -> Int# -> IO ()
forall s.
MutableByteArray# s -> ByteArray# -> ByteArray# -> Int# -> IO ()
c_mpn_ior_n MutableByteArray# RealWorld
mba# ByteArray#
a# ByteArray#
b# Int#
nb#)
        ()
_ <- case Int# -> Bool
isTrue# (Int#
na# Int# -> Int# -> Int#
==# Int#
nb#) of
            Bool
False -> (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (ByteArray#
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall s.
ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyWordArray# ByteArray#
a# Int#
nb# MutableByteArray# RealWorld
mba# Int#
nb# (Int#
na# Int# -> Int# -> Int#
-# Int#
nb#))
            Bool
True  -> () -> S RealWorld ()
forall a s. a -> S s a
return ()
        MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn

    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y


xorBigNat :: BigNat -> BigNat -> BigNat
xorBigNat :: BigNat -> BigNat -> BigNat
xorBigNat x :: BigNat
x@(BN# ByteArray#
x#) y :: BigNat
y@(BN# ByteArray#
y#)
  | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
y
  | BigNat -> Bool
isZeroBigNat BigNat
y = BigNat
x
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
>=# Int#
ny#) = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (ByteArray# -> Int# -> ByteArray# -> Int# -> S RealWorld BigNat
xor' ByteArray#
x# Int#
nx# ByteArray#
y# Int#
ny#)
  | Bool
True                  = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (ByteArray# -> Int# -> ByteArray# -> Int# -> S RealWorld BigNat
xor' ByteArray#
y# Int#
ny# ByteArray#
x# Int#
nx#)
  where
    xor' :: ByteArray# -> Int# -> ByteArray# -> Int# -> S RealWorld BigNat
xor' ByteArray#
a# Int#
na# ByteArray#
b# Int#
nb# = do -- na >= nb
        mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
na#
        ()
_ <- IO () -> S RealWorld ()
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> ByteArray# -> Int# -> IO ()
forall s.
MutableByteArray# s -> ByteArray# -> ByteArray# -> Int# -> IO ()
c_mpn_xor_n MutableByteArray# RealWorld
mba# ByteArray#
a# ByteArray#
b# Int#
nb#)
        case Int# -> Bool
isTrue# (Int#
na# Int# -> Int# -> Int#
==# Int#
nb#) of
            Bool
False -> do ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (ByteArray#
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall s.
ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyWordArray# ByteArray#
a# Int#
nb# MutableByteArray# RealWorld
mba# Int#
nb# (Int#
na# Int# -> Int# -> Int#
-# Int#
nb#))
                        MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
            Bool
True  -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
mbn

    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y

-- | aka @\x y -> x .&. (complement y)@
andnBigNat :: BigNat -> BigNat -> BigNat
andnBigNat :: BigNat -> BigNat -> BigNat
andnBigNat x :: BigNat
x@(BN# ByteArray#
x#) y :: BigNat
y@(BN# ByteArray#
y#)
  | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
zeroBigNat
  | BigNat -> Bool
isZeroBigNat BigNat
y = BigNat
x
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
      mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nx#
      ()
_ <- IO () -> S RealWorld ()
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> ByteArray# -> Int# -> IO ()
forall s.
MutableByteArray# s -> ByteArray# -> ByteArray# -> Int# -> IO ()
c_mpn_andn_n MutableByteArray# RealWorld
mba# ByteArray#
x# ByteArray#
y# Int#
n#)
      ()
_ <- case Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
==# Int#
n#) of
            Bool
False -> (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (ByteArray#
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall s.
ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyWordArray# ByteArray#
x# Int#
n# MutableByteArray# RealWorld
mba# Int#
n# (Int#
nx# Int# -> Int# -> Int#
-# Int#
n#))
            Bool
True  -> () -> S RealWorld ()
forall a s. a -> S s a
return ()
      MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
mbn
  where
    n# :: Int#
n# | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
<# Int#
ny#) = Int#
nx#
       | Bool
True                 = Int#
ny#
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y


andBigNat :: BigNat -> BigNat -> BigNat
andBigNat :: BigNat -> BigNat -> BigNat
andBigNat x :: BigNat
x@(BN# ByteArray#
x#) y :: BigNat
y@(BN# ByteArray#
y#)
  | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
zeroBigNat
  | BigNat -> Bool
isZeroBigNat BigNat
y = BigNat
zeroBigNat
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
      mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
n#
      ()
_ <- IO () -> S RealWorld ()
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> ByteArray# -> Int# -> IO ()
forall s.
MutableByteArray# s -> ByteArray# -> ByteArray# -> Int# -> IO ()
c_mpn_and_n MutableByteArray# RealWorld
mba# ByteArray#
x# ByteArray#
y# Int#
n#)
      MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
mbn
  where
    n# :: Int#
n# | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
<# Int#
ny#) = Int#
nx#
       | Bool
True                 = Int#
ny#
    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y

-- | If divisor is zero, @(\# 'nullBigNat', 'nullBigNat' \#)@ is returned
quotRemBigNat :: BigNat -> BigNat -> (# BigNat,BigNat #)
quotRemBigNat :: BigNat -> BigNat -> (# BigNat, BigNat #)
quotRemBigNat n :: BigNat
n@(BN# ByteArray#
nba#) d :: BigNat
d@(BN# ByteArray#
dba#)
  | BigNat -> Bool
isZeroBigNat BigNat
d     = (# BigNat
nullBigNat, BigNat
nullBigNat #)
  | BigNat -> Word# -> Bool
eqBigNatWord BigNat
d Word#
1## = (# BigNat
n, BigNat
zeroBigNat #)
  | BigNat
n BigNat -> BigNat -> Bool
forall a. Ord a => a -> a -> Bool
< BigNat
d              = (# BigNat
zeroBigNat, BigNat
n #)
  | Bool
True = case S RealWorld (BigNat, BigNat) -> (BigNat, BigNat)
forall a. S RealWorld a -> a
runS S RealWorld (BigNat, BigNat)
go of (!BigNat
q,!BigNat
r) -> (# BigNat
q, BigNat
r #)
  where
    nn# :: Int#
nn# = BigNat -> Int#
sizeofBigNat# BigNat
n
    dn# :: Int#
dn# = BigNat -> Int#
sizeofBigNat# BigNat
d
    qn# :: Int#
qn# = Int#
1# Int# -> Int# -> Int#
+# Int#
nn# Int# -> Int# -> Int#
-# Int#
dn#
    rn# :: Int#
rn# = Int#
dn#

    go :: S RealWorld (BigNat, BigNat)
go = do
      qmbn :: MutBigNat RealWorld
qmbn@(MBN# MutableByteArray# RealWorld
qmba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
qn#
      rmbn :: MutBigNat RealWorld
rmbn@(MBN# MutableByteArray# RealWorld
rmba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
rn#

      ()
_ <- IO () -> S RealWorld ()
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> Int#
-> ByteArray#
-> Int#
-> ByteArray#
-> Int#
-> IO ()
forall s.
MutableByteArray# s
-> MutableByteArray# s
-> Int#
-> ByteArray#
-> Int#
-> ByteArray#
-> Int#
-> IO ()
c_mpn_tdiv_qr MutableByteArray# RealWorld
qmba# MutableByteArray# RealWorld
rmba# Int#
0# ByteArray#
nba# Int#
nn# ByteArray#
dba# Int#
dn#)

      BigNat
q <- MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
qmbn
      BigNat
r <- MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
rmbn
      (BigNat, BigNat) -> S RealWorld (BigNat, BigNat)
forall a s. a -> S s a
return (BigNat
q, BigNat
r)

quotBigNat :: BigNat -> BigNat -> BigNat
quotBigNat :: BigNat -> BigNat -> BigNat
quotBigNat n :: BigNat
n@(BN# ByteArray#
nba#) d :: BigNat
d@(BN# ByteArray#
dba#)
  | BigNat -> Bool
isZeroBigNat BigNat
d     = BigNat
nullBigNat
  | BigNat -> Word# -> Bool
eqBigNatWord BigNat
d Word#
1## = BigNat
n
  | BigNat
n BigNat -> BigNat -> Bool
forall a. Ord a => a -> a -> Bool
< BigNat
d              = BigNat
zeroBigNat
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
      let nn# :: Int#
nn# = BigNat -> Int#
sizeofBigNat# BigNat
n
      let dn# :: Int#
dn# = BigNat -> Int#
sizeofBigNat# BigNat
d
      let qn# :: Int#
qn# = Int#
1# Int# -> Int# -> Int#
+# Int#
nn# Int# -> Int# -> Int#
-# Int#
dn#
      qmbn :: MutBigNat RealWorld
qmbn@(MBN# MutableByteArray# RealWorld
qmba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
qn#
      ()
_ <- IO () -> S RealWorld ()
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO ()
forall s.
MutableByteArray# s
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO ()
c_mpn_tdiv_q MutableByteArray# RealWorld
qmba# ByteArray#
nba# Int#
nn# ByteArray#
dba# Int#
dn#)
      MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
qmbn

remBigNat :: BigNat -> BigNat -> BigNat
remBigNat :: BigNat -> BigNat -> BigNat
remBigNat n :: BigNat
n@(BN# ByteArray#
nba#) d :: BigNat
d@(BN# ByteArray#
dba#)
  | BigNat -> Bool
isZeroBigNat BigNat
d     = BigNat
nullBigNat
  | BigNat -> Word# -> Bool
eqBigNatWord BigNat
d Word#
1## = BigNat
zeroBigNat
  | BigNat
n BigNat -> BigNat -> Bool
forall a. Ord a => a -> a -> Bool
< BigNat
d              = BigNat
n
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
      let nn# :: Int#
nn# = BigNat -> Int#
sizeofBigNat# BigNat
n
      let dn# :: Int#
dn# = BigNat -> Int#
sizeofBigNat# BigNat
d
      rmbn :: MutBigNat RealWorld
rmbn@(MBN# MutableByteArray# RealWorld
rmba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
dn#
      ()
_ <- IO () -> S RealWorld ()
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO ()
forall s.
MutableByteArray# s
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO ()
c_mpn_tdiv_r MutableByteArray# RealWorld
rmba# ByteArray#
nba# Int#
nn# ByteArray#
dba# Int#
dn#)
      MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
rmbn

-- | Note: Result of div/0 undefined
quotRemBigNatWord :: BigNat -> GmpLimb# -> (# BigNat, GmpLimb# #)
quotRemBigNatWord :: BigNat -> Word# -> (# BigNat, Word# #)
quotRemBigNatWord !BigNat
_           Word#
0## = (# BigNat
nullBigNat, Word#
0## #)
quotRemBigNatWord BigNat
n            Word#
1## = (# BigNat
n,          Word#
0## #)
quotRemBigNatWord n :: BigNat
n@(BN# ByteArray#
nba#) Word#
d# = case BigNat -> Word# -> Ordering
compareBigNatWord BigNat
n Word#
d# of
    Ordering
LT -> (# BigNat
zeroBigNat, BigNat -> Word#
bigNatToWord BigNat
n #)
    Ordering
EQ -> (# BigNat
oneBigNat, Word#
0## #)
    Ordering
GT -> case S RealWorld (BigNat, Word) -> (BigNat, Word)
forall a. S RealWorld a -> a
runS S RealWorld (BigNat, Word)
go of (!BigNat
q,!(W# Word#
r#)) -> (# BigNat
q, Word#
r# #) -- TODO: handle word/word
  where
    go :: S RealWorld (BigNat, Word)
go = do
      let nn# :: Int#
nn# = BigNat -> Int#
sizeofBigNat# BigNat
n
      qmbn :: MutBigNat RealWorld
qmbn@(MBN# MutableByteArray# RealWorld
qmba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nn#
      Word
r <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> Int# -> ByteArray# -> Int# -> Word# -> IO Word
forall s.
MutableByteArray# s
-> Int# -> ByteArray# -> Int# -> Word# -> IO Word
c_mpn_divrem_1 MutableByteArray# RealWorld
qmba# Int#
0# ByteArray#
nba# Int#
nn# Word#
d#)
      BigNat
q <- MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
qmbn
      (BigNat, Word) -> S RealWorld (BigNat, Word)
forall a s. a -> S s a
return (BigNat
q,Word
r)

quotBigNatWord :: BigNat -> GmpLimb# -> BigNat
quotBigNatWord :: BigNat -> Word# -> BigNat
quotBigNatWord BigNat
n Word#
d# = case (BigNat -> Word# -> (# BigNat, Word# #))
-> BigNat -> Word# -> (# BigNat, Word# #)
forall a. a -> a
inline BigNat -> Word# -> (# BigNat, Word# #)
quotRemBigNatWord BigNat
n Word#
d# of (# BigNat
q, Word#
_ #) -> BigNat
q

-- | div/0 not checked
remBigNatWord :: BigNat -> GmpLimb# -> Word#
remBigNatWord :: BigNat -> Word# -> Word#
remBigNatWord n :: BigNat
n@(BN# ByteArray#
nba#) Word#
d# = ByteArray# -> Int# -> Word# -> Word#
c_mpn_mod_1 ByteArray#
nba# (BigNat -> Int#
sizeofBigNat# BigNat
n) Word#
d#

gcdBigNatWord :: BigNat -> Word# -> Word#
gcdBigNatWord :: BigNat -> Word# -> Word#
gcdBigNatWord bn :: BigNat
bn@(BN# ByteArray#
ba#) = ByteArray# -> Int# -> Word# -> Word#
c_mpn_gcd_1# ByteArray#
ba# (BigNat -> Int#
sizeofBigNat# BigNat
bn)

gcdBigNat :: BigNat -> BigNat -> BigNat
gcdBigNat :: BigNat -> BigNat -> BigNat
gcdBigNat x :: BigNat
x@(BN# ByteArray#
x#) y :: BigNat
y@(BN# ByteArray#
y#)
  | BigNat -> Bool
isZeroBigNat BigNat
x = BigNat
y
  | BigNat -> Bool
isZeroBigNat BigNat
y = BigNat
x
  | Int# -> Bool
isTrue# (Int#
nx# Int# -> Int# -> Int#
>=# Int#
ny#) = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (ByteArray# -> Int# -> ByteArray# -> Int# -> S RealWorld BigNat
gcd' ByteArray#
x# Int#
nx# ByteArray#
y# Int#
ny#)
  | Bool
True                  = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (ByteArray# -> Int# -> ByteArray# -> Int# -> S RealWorld BigNat
gcd' ByteArray#
y# Int#
ny# ByteArray#
x# Int#
nx#)
  where
    gcd' :: ByteArray# -> Int# -> ByteArray# -> Int# -> S RealWorld BigNat
gcd' ByteArray#
a# Int#
na# ByteArray#
b# Int#
nb# = do -- na >= nb
        mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
nb#
        I# Int#
rn'# <- IO Int -> S RealWorld Int
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO Int
forall s.
MutableByteArray# s
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO Int
c_mpn_gcd# MutableByteArray# RealWorld
mba# ByteArray#
a# Int#
na# ByteArray#
b# Int#
nb#)
        let rn# :: Int#
rn# = Int# -> Int#
narrowGmpSize# Int#
rn'#
        case Int# -> Bool
isTrue# (Int#
rn# Int# -> Int# -> Int#
==# Int#
nb#) of
            Bool
False -> MutBigNat RealWorld -> Int# -> S RealWorld BigNat
forall s. MutBigNat s -> Int# -> S s BigNat
unsafeShrinkFreezeBigNat# MutBigNat RealWorld
mbn Int#
rn#
            Bool
True  -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn

    nx# :: Int#
nx# = BigNat -> Int#
sizeofBigNat# BigNat
x
    ny# :: Int#
ny# = BigNat -> Int#
sizeofBigNat# BigNat
y

-- | Extended euclidean algorithm.
--
-- For @/a/@ and @/b/@, compute their greatest common divisor @/g/@
-- and the coefficient @/s/@ satisfying @/a//s/ + /b//t/ = /g/@.
--
-- @since 0.5.1.0
{-# NOINLINE gcdExtInteger #-}
gcdExtInteger :: Integer -> Integer -> (# Integer, Integer #)
gcdExtInteger :: Integer -> Integer -> (# Integer, Integer #)
gcdExtInteger Integer
a Integer
b = case SBigNat -> SBigNat -> (# BigNat, SBigNat #)
gcdExtSBigNat SBigNat
a' SBigNat
b' of
    (# BigNat
g, SBigNat
s #) -> let !g' :: Integer
g' = BigNat -> Integer
bigNatToInteger  BigNat
g
                      !s' :: Integer
s' = SBigNat -> Integer
sBigNatToInteger SBigNat
s
                  in (# Integer
g', Integer
s' #)
  where
    a' :: SBigNat
a' = Integer -> SBigNat
integerToSBigNat Integer
a
    b' :: SBigNat
b' = Integer -> SBigNat
integerToSBigNat Integer
b

-- internal helper
gcdExtSBigNat :: SBigNat -> SBigNat -> (# BigNat, SBigNat #)
gcdExtSBigNat :: SBigNat -> SBigNat -> (# BigNat, SBigNat #)
gcdExtSBigNat SBigNat
x SBigNat
y = case S RealWorld (BigNat, SBigNat) -> (BigNat, SBigNat)
forall a. S RealWorld a -> a
runS S RealWorld (BigNat, SBigNat)
go of (BigNat
g,SBigNat
s) -> (# BigNat
g, SBigNat
s #)
  where
    go :: S RealWorld (BigNat, SBigNat)
go = do
        g :: MutBigNat RealWorld
g@(MBN# MutableByteArray# RealWorld
g#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
gn0#
        -- According to https://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fgcdext
        -- abs(s) < abs(y) / (2 g)
        s :: MutBigNat RealWorld
s@(MBN# MutableByteArray# RealWorld
s#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# (Int# -> Int#
absI# Int#
yn#)
        I# Int#
ssn_# <- IO Int -> S RealWorld Int
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> MutableByteArray# RealWorld
-> ByteArray#
-> Int#
-> ByteArray#
-> Int#
-> IO Int
forall s.
MutableByteArray# s
-> MutableByteArray# s
-> ByteArray#
-> Int#
-> ByteArray#
-> Int#
-> IO Int
integer_gmp_gcdext# MutableByteArray# RealWorld
s# MutableByteArray# RealWorld
g# ByteArray#
x# Int#
xn# ByteArray#
y# Int#
yn#)
        let ssn# :: Int#
ssn# = Int# -> Int#
narrowGmpSize# Int#
ssn_#
            sn# :: Int#
sn#  = Int# -> Int#
absI# Int#
ssn#
        BigNat
s' <- MutBigNat RealWorld -> Int# -> S RealWorld BigNat
forall s. MutBigNat s -> Int# -> S s BigNat
unsafeShrinkFreezeBigNat# MutBigNat RealWorld
s Int#
sn#
        BigNat
g' <- MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat RealWorld
g
        case Int# -> Bool
isTrue# (Int#
ssn# Int# -> Int# -> Int#
>=# Int#
0#) of
            Bool
False -> (BigNat, SBigNat) -> S RealWorld (BigNat, SBigNat)
forall a s. a -> S s a
return ( BigNat
g', BigNat -> SBigNat
NegBN BigNat
s' )
            Bool
True  -> (BigNat, SBigNat) -> S RealWorld (BigNat, SBigNat)
forall a s. a -> S s a
return ( BigNat
g', BigNat -> SBigNat
PosBN BigNat
s' )

    !(BN# ByteArray#
x#) = SBigNat -> BigNat
absSBigNat SBigNat
x
    !(BN# ByteArray#
y#) = SBigNat -> BigNat
absSBigNat SBigNat
y
    xn# :: Int#
xn# = SBigNat -> Int#
ssizeofSBigNat# SBigNat
x
    yn# :: Int#
yn# = SBigNat -> Int#
ssizeofSBigNat# SBigNat
y

    gn0# :: Int#
gn0# = Int# -> Int# -> Int#
minI# (Int# -> Int#
absI# Int#
xn#) (Int# -> Int#
absI# Int#
yn#)

----------------------------------------------------------------------------
-- modular exponentiation

-- | \"@'powModInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to
-- exponent @/e/@ modulo @abs(/m/)@.
--
-- Negative exponents are supported if an inverse modulo @/m/@
-- exists.
--
-- __Warning__: It's advised to avoid calling this primitive with
-- negative exponents unless it is guaranteed the inverse exists, as
-- failure to do so will likely cause program abortion due to a
-- divide-by-zero fault. See also 'recipModInteger'.
--
-- Future versions of @integer_gmp@ may not support negative @/e/@
-- values anymore.
--
-- @since 0.5.1.0
{-# NOINLINE powModInteger #-}
powModInteger :: Integer -> Integer -> Integer -> Integer
powModInteger :: Integer -> Integer -> Integer -> Integer
powModInteger (S# Int#
b#) (S# Int#
e#) (S# Int#
m#)
  | Int# -> Bool
isTrue# (Int#
b# Int# -> Int# -> Int#
>=# Int#
0#), Int# -> Bool
isTrue# (Int#
e# Int# -> Int# -> Int#
>=# Int#
0#)
  = Word# -> Integer
wordToInteger (Word# -> Word# -> Word# -> Word#
powModWord (Int# -> Word#
int2Word# Int#
b#) (Int# -> Word#
int2Word# Int#
e#)
                              (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
m#)))
powModInteger Integer
b Integer
e Integer
m = case Integer
m of
    (S# Int#
m#) -> Word# -> Integer
wordToInteger (SBigNat -> SBigNat -> Word# -> Word#
powModSBigNatWord SBigNat
b' SBigNat
e' (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
m#)))
    (Jp# BigNat
m') -> BigNat -> Integer
bigNatToInteger (SBigNat -> SBigNat -> BigNat -> BigNat
powModSBigNat SBigNat
b' SBigNat
e' BigNat
m')
    (Jn# BigNat
m') -> BigNat -> Integer
bigNatToInteger (SBigNat -> SBigNat -> BigNat -> BigNat
powModSBigNat SBigNat
b' SBigNat
e' BigNat
m')
  where
    b' :: SBigNat
b' = Integer -> SBigNat
integerToSBigNat Integer
b
    e' :: SBigNat
e' = Integer -> SBigNat
integerToSBigNat Integer
e

-- | \"@'powModSecInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to
-- exponent @/e/@ modulo @/m/@. It is required that @/e/ >= 0@ and
-- @/m/@ is odd.
--
-- This is a \"secure\" variant of 'powModInteger' using the
-- @mpz_powm_sec()@ function which is designed to be resilient to side
-- channel attacks and is therefore intended for cryptographic
-- applications.
--
-- This primitive is only available when the underlying GMP library
-- supports it (GMP >= 5). Otherwise, it internally falls back to
-- @'powModInteger'@, and a warning will be emitted when used.
--
-- @since 1.0.2.0
{-# NOINLINE powModSecInteger #-}
powModSecInteger :: Integer -> Integer -> Integer -> Integer
powModSecInteger :: Integer -> Integer -> Integer -> Integer
powModSecInteger Integer
b Integer
e Integer
m = BigNat -> Integer
bigNatToInteger (SBigNat -> SBigNat -> BigNat -> BigNat
powModSecSBigNat SBigNat
b' SBigNat
e' BigNat
m')
  where
    b' :: SBigNat
b' = Integer -> SBigNat
integerToSBigNat Integer
b
    e' :: SBigNat
e' = Integer -> SBigNat
integerToSBigNat Integer
e
    m' :: BigNat
m' = SBigNat -> BigNat
absSBigNat (Integer -> SBigNat
integerToSBigNat Integer
m)

#if HAVE_SECURE_POWM == 0
{-# WARNING powModSecInteger "The underlying GMP library does not support a secure version of powModInteger which is side-channel resistant - you need at least GMP version 5 to support this" #-}
#endif

-- | Version of 'powModInteger' operating on 'BigNat's
--
-- @since 1.0.0.0
powModBigNat :: BigNat -> BigNat -> BigNat -> BigNat
powModBigNat :: BigNat -> BigNat -> BigNat -> BigNat
powModBigNat BigNat
b BigNat
e BigNat
m = (SBigNat -> SBigNat -> BigNat -> BigNat)
-> SBigNat -> SBigNat -> BigNat -> BigNat
forall a. a -> a
inline SBigNat -> SBigNat -> BigNat -> BigNat
powModSBigNat (BigNat -> SBigNat
PosBN BigNat
b) (BigNat -> SBigNat
PosBN BigNat
e) BigNat
m

-- | Version of 'powModInteger' for 'Word#'-sized moduli
--
-- @since 1.0.0.0
powModBigNatWord :: BigNat -> BigNat -> GmpLimb# -> GmpLimb#
powModBigNatWord :: BigNat -> BigNat -> Word# -> Word#
powModBigNatWord BigNat
b BigNat
e Word#
m# = (SBigNat -> SBigNat -> Word# -> Word#)
-> SBigNat -> SBigNat -> Word# -> Word#
forall a. a -> a
inline SBigNat -> SBigNat -> Word# -> Word#
powModSBigNatWord (BigNat -> SBigNat
PosBN BigNat
b) (BigNat -> SBigNat
PosBN BigNat
e) Word#
m#

-- | Version of 'powModInteger' operating on 'Word#'s
--
-- @since 1.0.0.0
foreign import ccall unsafe "integer_gmp_powm_word"
  powModWord :: GmpLimb# -> GmpLimb# -> GmpLimb# -> GmpLimb#

-- internal non-exported helper
powModSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat
powModSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat
powModSBigNat SBigNat
b SBigNat
e m :: BigNat
m@(BN# ByteArray#
m#) = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    r :: MutBigNat RealWorld
r@(MBN# MutableByteArray# RealWorld
r#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
mn#
    I# Int#
rn_# <- IO Int -> S RealWorld Int
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray#
-> Int#
-> ByteArray#
-> Int#
-> ByteArray#
-> Int#
-> IO Int
integer_gmp_powm# MutableByteArray# RealWorld
r# ByteArray#
b# Int#
bn# ByteArray#
e# Int#
en# ByteArray#
m# Int#
mn#)
    let rn# :: Int#
rn# = Int# -> Int#
narrowGmpSize# Int#
rn_#
    case Int# -> Bool
isTrue# (Int#
rn# Int# -> Int# -> Int#
==# Int#
mn#) of
        Bool
False -> MutBigNat RealWorld -> Int# -> S RealWorld BigNat
forall s. MutBigNat s -> Int# -> S s BigNat
unsafeShrinkFreezeBigNat# MutBigNat RealWorld
r Int#
rn#
        Bool
True  -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
r
  where
    !(BN# ByteArray#
b#) = SBigNat -> BigNat
absSBigNat SBigNat
b
    !(BN# ByteArray#
e#) = SBigNat -> BigNat
absSBigNat SBigNat
e
    bn# :: Int#
bn# = SBigNat -> Int#
ssizeofSBigNat# SBigNat
b
    en# :: Int#
en# = SBigNat -> Int#
ssizeofSBigNat# SBigNat
e
    mn# :: Int#
mn# = BigNat -> Int#
sizeofBigNat# BigNat
m

foreign import ccall unsafe "integer_gmp_powm"
  integer_gmp_powm# :: MutableByteArray# RealWorld
                       -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
                       -> ByteArray# -> GmpSize# -> IO GmpSize

-- internal non-exported helper
powModSBigNatWord :: SBigNat -> SBigNat -> GmpLimb# -> GmpLimb#
powModSBigNatWord :: SBigNat -> SBigNat -> Word# -> Word#
powModSBigNatWord SBigNat
b SBigNat
e Word#
m# = ByteArray# -> Int# -> ByteArray# -> Int# -> Word# -> Word#
integer_gmp_powm1# ByteArray#
b# Int#
bn# ByteArray#
e# Int#
en# Word#
m#
  where
    !(BN# ByteArray#
b#) = SBigNat -> BigNat
absSBigNat SBigNat
b
    !(BN# ByteArray#
e#) = SBigNat -> BigNat
absSBigNat SBigNat
e
    bn# :: Int#
bn# = SBigNat -> Int#
ssizeofSBigNat# SBigNat
b
    en# :: Int#
en# = SBigNat -> Int#
ssizeofSBigNat# SBigNat
e

foreign import ccall unsafe "integer_gmp_powm1"
  integer_gmp_powm1# :: ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
                        -> GmpLimb# -> GmpLimb#

-- internal non-exported helper
powModSecSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat
powModSecSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat
powModSecSBigNat SBigNat
b SBigNat
e m :: BigNat
m@(BN# ByteArray#
m#) = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    r :: MutBigNat RealWorld
r@(MBN# MutableByteArray# RealWorld
r#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
mn#
    I# Int#
rn_# <- IO Int -> S RealWorld Int
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray#
-> Int#
-> ByteArray#
-> Int#
-> ByteArray#
-> Int#
-> IO Int
integer_gmp_powm_sec# MutableByteArray# RealWorld
r# ByteArray#
b# Int#
bn# ByteArray#
e# Int#
en# ByteArray#
m# Int#
mn#)
    let rn# :: Int#
rn# = Int# -> Int#
narrowGmpSize# Int#
rn_#
    case Int# -> Bool
isTrue# (Int#
rn# Int# -> Int# -> Int#
==# Int#
mn#) of
        Bool
False -> MutBigNat RealWorld -> Int# -> S RealWorld BigNat
forall s. MutBigNat s -> Int# -> S s BigNat
unsafeShrinkFreezeBigNat# MutBigNat RealWorld
r Int#
rn#
        Bool
True  -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
r
  where
    !(BN# ByteArray#
b#) = SBigNat -> BigNat
absSBigNat SBigNat
b
    !(BN# ByteArray#
e#) = SBigNat -> BigNat
absSBigNat SBigNat
e
    bn# :: Int#
bn# = SBigNat -> Int#
ssizeofSBigNat# SBigNat
b
    en# :: Int#
en# = SBigNat -> Int#
ssizeofSBigNat# SBigNat
e
    mn# :: Int#
mn# = BigNat -> Int#
sizeofBigNat# BigNat
m

foreign import ccall unsafe "integer_gmp_powm_sec"
  integer_gmp_powm_sec# :: MutableByteArray# RealWorld
                           -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize#
                           -> ByteArray# -> GmpSize# -> IO GmpSize


-- | \"@'recipModInteger' /x/ /m/@\" computes the inverse of @/x/@ modulo @/m/@. If
-- the inverse exists, the return value @/y/@ will satisfy @0 < /y/ <
-- abs(/m/)@, otherwise the result is @0@.
--
-- @since 0.5.1.0
{-# NOINLINE recipModInteger #-}
recipModInteger :: Integer -> Integer -> Integer
recipModInteger :: Integer -> Integer -> Integer
recipModInteger (S# Int#
x#) (S# Int#
m#)
  | Int# -> Bool
isTrue# (Int#
x# Int# -> Int# -> Int#
>=# Int#
0#)
  = Word# -> Integer
wordToInteger (Word# -> Word# -> Word#
recipModWord (Int# -> Word#
int2Word# Int#
x#) (Int# -> Word#
int2Word# (Int# -> Int#
absI# Int#
m#)))
recipModInteger Integer
x Integer
m = BigNat -> Integer
bigNatToInteger (SBigNat -> BigNat -> BigNat
recipModSBigNat SBigNat
x' BigNat
m')
  where
    x' :: SBigNat
x' = Integer -> SBigNat
integerToSBigNat Integer
x
    m' :: BigNat
m' = SBigNat -> BigNat
absSBigNat (Integer -> SBigNat
integerToSBigNat Integer
m)

-- | Version of 'recipModInteger' operating on 'BigNat's
--
-- @since 1.0.0.0
recipModBigNat :: BigNat -> BigNat -> BigNat
recipModBigNat :: BigNat -> BigNat -> BigNat
recipModBigNat BigNat
x BigNat
m = (SBigNat -> BigNat -> BigNat) -> SBigNat -> BigNat -> BigNat
forall a. a -> a
inline SBigNat -> BigNat -> BigNat
recipModSBigNat (BigNat -> SBigNat
PosBN BigNat
x) BigNat
m

-- | Version of 'recipModInteger' operating on 'Word#'s
--
-- @since 1.0.0.0
foreign import ccall unsafe "integer_gmp_invert_word"
  recipModWord :: GmpLimb# -> GmpLimb# -> GmpLimb#

-- internal non-exported helper
recipModSBigNat :: SBigNat -> BigNat -> BigNat
recipModSBigNat :: SBigNat -> BigNat -> BigNat
recipModSBigNat SBigNat
x m :: BigNat
m@(BN# ByteArray#
m#) = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    r :: MutBigNat RealWorld
r@(MBN# MutableByteArray# RealWorld
r#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
mn#
    I# Int#
rn_# <- IO Int -> S RealWorld Int
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Int# -> ByteArray# -> Int# -> IO Int
integer_gmp_invert# MutableByteArray# RealWorld
r# ByteArray#
x# Int#
xn# ByteArray#
m# Int#
mn#)
    let rn# :: Int#
rn# = Int# -> Int#
narrowGmpSize# Int#
rn_#
    case Int# -> Bool
isTrue# (Int#
rn# Int# -> Int# -> Int#
==# Int#
mn#) of
        Bool
False -> MutBigNat RealWorld -> Int# -> S RealWorld BigNat
forall s. MutBigNat s -> Int# -> S s BigNat
unsafeShrinkFreezeBigNat# MutBigNat RealWorld
r Int#
rn#
        Bool
True  -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
r
  where
    !(BN# ByteArray#
x#) = SBigNat -> BigNat
absSBigNat SBigNat
x
    xn# :: Int#
xn# = SBigNat -> Int#
ssizeofSBigNat# SBigNat
x
    mn# :: Int#
mn# = BigNat -> Int#
sizeofBigNat# BigNat
m

foreign import ccall unsafe "integer_gmp_invert"
  integer_gmp_invert# :: MutableByteArray# RealWorld
                         -> ByteArray# -> GmpSize#
                         -> ByteArray# -> GmpSize# -> IO GmpSize

----------------------------------------------------------------------------
-- Conversions to/from floating point

decodeDoubleInteger :: Double# -> (# Integer, Int# #)
-- decodeDoubleInteger 0.0## = (# S# 0#, 0# #)
#if WORD_SIZE_IN_BITS == 64
decodeDoubleInteger :: Double# -> (# Integer, Int# #)
decodeDoubleInteger Double#
x = case Double# -> (# Int#, Int# #)
decodeDouble_Int64# Double#
x of
                          (# Int#
m#, Int#
e# #) -> (# Int# -> Integer
S# Int#
m#, Int#
e# #)
#elif WORD_SIZE_IN_BITS == 32
decodeDoubleInteger x = case decodeDouble_Int64# x of
                          (# m#, e# #) -> (# int64ToInteger m#, e# #)
#endif
{-# CONSTANT_FOLDED decodeDoubleInteger #-}

-- provided by GHC's RTS
foreign import ccall unsafe "__int_encodeDouble"
  int_encodeDouble# :: Int# -> Int# -> Double#

encodeDoubleInteger :: Integer -> Int# -> Double#
encodeDoubleInteger :: Integer -> Int# -> Double#
encodeDoubleInteger (S# Int#
m#) Int#
0# = Int# -> Double#
int2Double# Int#
m#
encodeDoubleInteger (S# Int#
m#) Int#
e# = Int# -> Int# -> Double#
int_encodeDouble# Int#
m# Int#
e#
encodeDoubleInteger (Jp# bn :: BigNat
bn@(BN# ByteArray#
bn#)) Int#
e#
    = ByteArray# -> Int# -> Int# -> Double#
c_mpn_get_d ByteArray#
bn# (BigNat -> Int#
sizeofBigNat# BigNat
bn) Int#
e#
encodeDoubleInteger (Jn# bn :: BigNat
bn@(BN# ByteArray#
bn#)) Int#
e#
    = ByteArray# -> Int# -> Int# -> Double#
c_mpn_get_d ByteArray#
bn# (Int# -> Int#
negateInt# (BigNat -> Int#
sizeofBigNat# BigNat
bn)) Int#
e#
{-# CONSTANT_FOLDED encodeDoubleInteger #-}

-- double integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn)
foreign import ccall unsafe "integer_gmp_mpn_get_d"
  c_mpn_get_d :: ByteArray# -> GmpSize# -> Int# -> Double#

doubleFromInteger :: Integer -> Double#
doubleFromInteger :: Integer -> Double#
doubleFromInteger (S# Int#
m#) = Int# -> Double#
int2Double# Int#
m#
doubleFromInteger (Jp# bn :: BigNat
bn@(BN# ByteArray#
bn#))
    = ByteArray# -> Int# -> Int# -> Double#
c_mpn_get_d ByteArray#
bn# (BigNat -> Int#
sizeofBigNat# BigNat
bn) Int#
0#
doubleFromInteger (Jn# bn :: BigNat
bn@(BN# ByteArray#
bn#))
    = ByteArray# -> Int# -> Int# -> Double#
c_mpn_get_d ByteArray#
bn# (Int# -> Int#
negateInt# (BigNat -> Int#
sizeofBigNat# BigNat
bn)) Int#
0#
{-# CONSTANT_FOLDED doubleFromInteger #-}

-- TODO: Not sure if it's worth to write 'Float' optimized versions here
floatFromInteger :: Integer -> Float#
floatFromInteger :: Integer -> Float#
floatFromInteger Integer
i = Double# -> Float#
double2Float# (Integer -> Double#
doubleFromInteger Integer
i)

encodeFloatInteger :: Integer -> Int# -> Float#
encodeFloatInteger :: Integer -> Int# -> Float#
encodeFloatInteger Integer
m Int#
e = Double# -> Float#
double2Float# (Integer -> Int# -> Double#
encodeDoubleInteger Integer
m Int#
e)

----------------------------------------------------------------------------
-- FFI ccall imports

foreign import ccall unsafe "integer_gmp_gcd_word"
  gcdWord# :: GmpLimb# -> GmpLimb# -> GmpLimb#

foreign import ccall unsafe "integer_gmp_mpn_gcd_1"
  c_mpn_gcd_1# :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#

foreign import ccall unsafe "integer_gmp_mpn_gcd"
  c_mpn_gcd# :: MutableByteArray# s -> ByteArray# -> GmpSize#
                -> ByteArray# -> GmpSize# -> IO GmpSize

foreign import ccall unsafe "integer_gmp_gcdext"
  integer_gmp_gcdext# :: MutableByteArray# s -> MutableByteArray# s
                         -> ByteArray# -> GmpSize#
                         -> ByteArray# -> GmpSize# -> IO GmpSize

-- mp_limb_t mpn_add_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,
--                      mp_limb_t s2limb)
foreign import ccall unsafe "gmp.h __gmpn_add_1"
  c_mpn_add_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
                 -> IO GmpLimb

-- mp_limb_t mpn_sub_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,
--                      mp_limb_t s2limb)
foreign import ccall unsafe "gmp.h __gmpn_sub_1"
  c_mpn_sub_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
                 -> IO GmpLimb

-- mp_limb_t mpn_mul_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,
--                      mp_limb_t s2limb)
foreign import ccall unsafe "gmp.h __gmpn_mul_1"
  c_mpn_mul_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb#
                 -> IO GmpLimb

-- mp_limb_t mpn_add (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,
--                    const mp_limb_t *s2p, mp_size_t s2n)
foreign import ccall unsafe "gmp.h __gmpn_add"
  c_mpn_add :: MutableByteArray# s -> ByteArray# -> GmpSize#
               -> ByteArray# -> GmpSize# -> IO GmpLimb

-- mp_limb_t mpn_sub (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,
--                    const mp_limb_t *s2p, mp_size_t s2n)
foreign import ccall unsafe "gmp.h __gmpn_sub"
  c_mpn_sub :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
               -> GmpSize# -> IO GmpLimb

-- mp_limb_t mpn_mul (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,
--                    const mp_limb_t *s2p, mp_size_t s2n)
foreign import ccall unsafe "gmp.h __gmpn_mul"
  c_mpn_mul :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
               -> GmpSize# -> IO GmpLimb

-- int mpn_cmp (const mp_limb_t *s1p, const mp_limb_t *s2p, mp_size_t n)
foreign import ccall unsafe "gmp.h __gmpn_cmp"
  c_mpn_cmp :: ByteArray# -> ByteArray# -> GmpSize# -> CInt#

-- void mpn_tdiv_qr (mp_limb_t *qp, mp_limb_t *rp, mp_size_t qxn,
--                   const mp_limb_t *np, mp_size_t nn,
--                   const mp_limb_t *dp, mp_size_t dn)
foreign import ccall unsafe "gmp.h __gmpn_tdiv_qr"
  c_mpn_tdiv_qr :: MutableByteArray# s -> MutableByteArray# s -> GmpSize#
                   -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> IO ()

foreign import ccall unsafe "integer_gmp_mpn_tdiv_q"
  c_mpn_tdiv_q :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
                  -> GmpSize# -> IO ()

foreign import ccall unsafe "integer_gmp_mpn_tdiv_r"
  c_mpn_tdiv_r :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray#
                  -> GmpSize# -> IO ()

-- mp_limb_t mpn_divrem_1 (mp_limb_t *r1p, mp_size_t qxn, mp_limb_t *s2p,
--                         mp_size_t s2n, mp_limb_t s3limb)
foreign import ccall unsafe "gmp.h __gmpn_divrem_1"
  c_mpn_divrem_1 :: MutableByteArray# s -> GmpSize# -> ByteArray# -> GmpSize#
                    -> GmpLimb# -> IO GmpLimb

-- mp_limb_t mpn_mod_1 (const mp_limb_t *s1p, mp_size_t s1n, mp_limb_t s2limb)
foreign import ccall unsafe "gmp.h __gmpn_mod_1"
  c_mpn_mod_1 :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb#

-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],
--                                   mp_size_t sn, mp_bitcnt_t count)
foreign import ccall unsafe "integer_gmp_mpn_rshift"
  c_mpn_rshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpBitCnt#
                  -> IO GmpLimb

-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],
--                                   mp_size_t sn, mp_bitcnt_t count)
foreign import ccall unsafe "integer_gmp_mpn_rshift_2c"
  c_mpn_rshift_2c :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpBitCnt#
                     -> IO GmpLimb

-- mp_limb_t integer_gmp_mpn_lshift (mp_limb_t rp[], const mp_limb_t sp[],
--                                   mp_size_t sn, mp_bitcnt_t count)
foreign import ccall unsafe "integer_gmp_mpn_lshift"
  c_mpn_lshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpBitCnt#
                  -> IO GmpLimb

-- void mpn_and_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
--                 mp_size_t n)
foreign import ccall unsafe "integer_gmp_mpn_and_n"
  c_mpn_and_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
                 -> IO ()

-- void mpn_andn_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
--                  mp_size_t n)
foreign import ccall unsafe "integer_gmp_mpn_andn_n"
  c_mpn_andn_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
                  -> IO ()

-- void mpn_ior_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
--                 mp_size_t n)
foreign import ccall unsafe "integer_gmp_mpn_ior_n"
  c_mpn_ior_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
                 -> IO ()

-- void mpn_xor_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
--                 mp_size_t n)
foreign import ccall unsafe "integer_gmp_mpn_xor_n"
  c_mpn_xor_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
                 -> IO ()

-- mp_bitcnt_t mpn_popcount (const mp_limb_t *s1p, mp_size_t n)
foreign import ccall unsafe "gmp.h __gmpn_popcount"
  c_mpn_popcount :: ByteArray# -> GmpSize# -> GmpBitCnt#

----------------------------------------------------------------------------
-- BigNat-wrapped ByteArray#-primops

-- | Return number of limbs contained in 'BigNat'.
--
-- The result is always @>= 1@ since even zero is encoded with 1 limb.
sizeofBigNat# :: BigNat -> GmpSize#
sizeofBigNat# :: BigNat -> Int#
sizeofBigNat# (BN# ByteArray#
x#)
    = ByteArray# -> Int#
sizeofByteArray# ByteArray#
x# Int# -> Int# -> Int#
`uncheckedIShiftRL#` GMP_LIMB_SHIFT#

data MutBigNat s = MBN# !(MutableByteArray# s)

getSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, GmpSize# #)
--getSizeofMutBigNat# :: MutBigNat s -> S s GmpSize#
getSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, Int# #)
getSizeofMutBigNat# (MBN# MutableByteArray# s
x#) State# s
s =
    case MutableByteArray# s -> State# s -> (# State# s, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# s
x# State# s
s of
        (# State# s
s', Int#
n# #) -> (# State# s
s', Int#
n# Int# -> Int# -> Int#
`uncheckedIShiftRL#` GMP_LIMB_SHIFT# #)

newBigNat# :: GmpSize# -> S s (MutBigNat s)
newBigNat# :: Int# -> S s (MutBigNat s)
newBigNat# Int#
limbs# State# s
s =
    case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Int#
limbs# Int# -> Int# -> Int#
`uncheckedIShiftL#` GMP_LIMB_SHIFT#) s of
        (# State# s
s', MutableByteArray# s
mba# #) -> (# State# s
s', MutableByteArray# s -> MutBigNat s
forall s. MutableByteArray# s -> MutBigNat s
MBN# MutableByteArray# s
mba# #)

writeBigNat# :: MutBigNat s -> GmpSize# -> GmpLimb# -> State# s -> State# s
writeBigNat# :: MutBigNat s -> Int# -> Word# -> State# s -> State# s
writeBigNat# (MBN# MutableByteArray# s
mba#) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWordArray# MutableByteArray# s
mba#

-- | Extract /n/-th (0-based) limb in 'BigNat'.
-- /n/ must be less than size as reported by 'sizeofBigNat#'.
indexBigNat# :: BigNat -> GmpSize# -> GmpLimb#
indexBigNat# :: BigNat -> Int# -> Word#
indexBigNat# (BN# ByteArray#
ba#) = ByteArray# -> Int# -> Word#
indexWordArray# ByteArray#
ba#

unsafeFreezeBigNat# :: MutBigNat s -> S s BigNat
unsafeFreezeBigNat# :: MutBigNat s -> S s BigNat
unsafeFreezeBigNat# (MBN# MutableByteArray# s
mba#) State# s
s = case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba# State# s
s of
                                      (# State# s
s', ByteArray#
ba# #) -> (# State# s
s', ByteArray# -> BigNat
BN# ByteArray#
ba# #)

resizeMutBigNat# :: MutBigNat s -> GmpSize# -> S s (MutBigNat s)
resizeMutBigNat# :: MutBigNat s -> Int# -> S s (MutBigNat s)
resizeMutBigNat# (MBN# MutableByteArray# s
mba0#) Int#
nsz# State# s
s
  | Int# -> Bool
isTrue# (Int#
bsz# Int# -> Int# -> Int#
==# Int#
n#) = (# State# s
s', MutableByteArray# s -> MutBigNat s
forall s. MutableByteArray# s -> MutBigNat s
MBN# MutableByteArray# s
mba0# #)
  | Bool
True =
    case MutableByteArray# s
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d.
MutableByteArray# d
-> Int# -> State# d -> (# State# d, MutableByteArray# d #)
resizeMutableByteArray# MutableByteArray# s
mba0# Int#
bsz# State# s
s' of
        (# State# s
s'', MutableByteArray# s
mba# #) -> (# State# s
s'', MutableByteArray# s -> MutBigNat s
forall s. MutableByteArray# s -> MutBigNat s
MBN# MutableByteArray# s
mba# #)
  where
    bsz# :: Int#
bsz# = Int#
nsz# Int# -> Int# -> Int#
`uncheckedIShiftL#` GMP_LIMB_SHIFT#
    !(# State# s
s', Int#
n# #) = MutableByteArray# s -> State# s -> (# State# s, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# s
mba0# State# s
s

shrinkMutBigNat# :: MutBigNat s -> GmpSize# -> State# s -> State# s
shrinkMutBigNat# :: MutBigNat s -> Int# -> State# s -> State# s
shrinkMutBigNat# (MBN# MutableByteArray# s
mba0#) Int#
nsz# State# s
s
  | Int# -> Bool
isTrue# (Int#
bsz# Int# -> Int# -> Int#
==# Int#
n#) = State# s
s' -- no-op
  | Bool
True                  = MutableByteArray# s -> Int# -> State# s -> State# s
forall d. MutableByteArray# d -> Int# -> State# d -> State# d
shrinkMutableByteArray# MutableByteArray# s
mba0# Int#
bsz# State# s
s'
  where
    bsz# :: Int#
bsz# = Int#
nsz# Int# -> Int# -> Int#
`uncheckedIShiftL#` GMP_LIMB_SHIFT#
    !(# State# s
s', Int#
n# #) = MutableByteArray# s -> State# s -> (# State# s, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# s
mba0# State# s
s

unsafeSnocFreezeBigNat# :: MutBigNat s -> GmpLimb# -> S s BigNat
unsafeSnocFreezeBigNat# :: MutBigNat s -> Word# -> S s BigNat
unsafeSnocFreezeBigNat# mbn0 :: MutBigNat s
mbn0@(MBN# MutableByteArray# s
mba0#) Word#
limb# State# s
s = S s BigNat
go State# s
s'
  where
    n# :: Int#
n#   = Int#
nb0# Int# -> Int# -> Int#
`uncheckedIShiftRL#` GMP_LIMB_SHIFT#
    !(# State# s
s', Int#
nb0# #) = MutableByteArray# s -> State# s -> (# State# s, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# s
mba0# State# s
s
    go :: S s BigNat
go = do
        (MBN# MutableByteArray# s
mba#) <- MutBigNat s -> Int# -> S s (MutBigNat s)
forall s. MutBigNat s -> Int# -> S s (MutBigNat s)
resizeMutBigNat# MutBigNat s
mbn0 (Int#
n# Int# -> Int# -> Int#
+# Int#
1#)
        ()
_ <- (State# s -> State# s) -> S s ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWordArray# MutableByteArray# s
mba# Int#
n# Word#
limb#)
        MutBigNat s -> S s BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# (MutableByteArray# s -> MutBigNat s
forall s. MutableByteArray# s -> MutBigNat s
MBN# MutableByteArray# s
mba#)

-- | May shrink underlyng 'ByteArray#' if needed to satisfy BigNat invariant
unsafeRenormFreezeBigNat# :: MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# :: MutBigNat s -> S s BigNat
unsafeRenormFreezeBigNat# MutBigNat s
mbn State# s
s
  | Int# -> Bool
isTrue# (Int#
n0# Int# -> Int# -> Int#
==# Int#
0#)  = (# State# s
s'', BigNat
nullBigNat #)
  | Int# -> Bool
isTrue# (Int#
n#  Int# -> Int# -> Int#
==# Int#
0#)  = (# State# s
s'', BigNat
zeroBigNat #)
  | Int# -> Bool
isTrue# (Int#
n#  Int# -> Int# -> Int#
==# Int#
n0#) = (MutBigNat s -> S s BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat s
mbn) State# s
s''
  | Bool
True                  = (MutBigNat s -> Int# -> S s BigNat
forall s. MutBigNat s -> Int# -> S s BigNat
unsafeShrinkFreezeBigNat# MutBigNat s
mbn Int#
n#) State# s
s''
  where
    !(# State# s
s', Int#
n0# #) = MutBigNat s -> State# s -> (# State# s, Int# #)
forall s. MutBigNat s -> State# s -> (# State# s, Int# #)
getSizeofMutBigNat# MutBigNat s
mbn State# s
s
    !(# State# s
s'', Int#
n# #) = MutBigNat s -> Int# -> State# s -> (# State# s, Int# #)
forall s. MutBigNat s -> Int# -> State# s -> (# State# s, Int# #)
normSizeofMutBigNat'# MutBigNat s
mbn Int#
n0# State# s
s'

-- | Shrink MBN
unsafeShrinkFreezeBigNat# :: MutBigNat s -> GmpSize# -> S s BigNat
unsafeShrinkFreezeBigNat# :: MutBigNat s -> Int# -> S s BigNat
unsafeShrinkFreezeBigNat# x :: MutBigNat s
x@(MBN# MutableByteArray# s
xmba) Int#
1#
    = \State# s
s -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWordArray# MutableByteArray# s
xmba Int#
0# State# s
s of
        (# State# s
s', Word#
w#   #) -> Word# -> S s BigNat
freezeOneLimb Word#
w# State# s
s'
  where
    freezeOneLimb :: Word# -> S s BigNat
freezeOneLimb Word#
0## = BigNat -> S s BigNat
forall a s. a -> S s a
return BigNat
zeroBigNat
    freezeOneLimb Word#
1## = BigNat -> S s BigNat
forall a s. a -> S s a
return BigNat
oneBigNat
    freezeOneLimb Word#
w# | Int# -> Bool
isTrue# (Word# -> Word#
not# Word#
w# Word# -> Word# -> Int#
`eqWord#` Word#
0##) = BigNat -> S s BigNat
forall a s. a -> S s a
return BigNat
czeroBigNat
    freezeOneLimb Word#
_   = do
        ()
_ <- (State# s -> State# s) -> S s ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat s -> Int# -> State# s -> State# s
forall s. MutBigNat s -> Int# -> State# s -> State# s
shrinkMutBigNat# MutBigNat s
x Int#
1#)
        MutBigNat s -> S s BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat s
x
unsafeShrinkFreezeBigNat# MutBigNat s
x Int#
y# = do
    ()
_ <- (State# s -> State# s) -> S s ()
forall s. (State# s -> State# s) -> S s ()
svoid (MutBigNat s -> Int# -> State# s -> State# s
forall s. MutBigNat s -> Int# -> State# s -> State# s
shrinkMutBigNat# MutBigNat s
x Int#
y#)
    MutBigNat s -> S s BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat s
x


copyWordArray# :: ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int#
                  -> State# s -> State# s
copyWordArray# :: ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyWordArray# ByteArray#
src Int#
src_ofs MutableByteArray# s
dst Int#
dst_ofs Int#
len
  = ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall s.
ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyByteArray# ByteArray#
src (Int#
src_ofs Int# -> Int# -> Int#
`uncheckedIShiftL#` GMP_LIMB_SHIFT#)
                   MutableByteArray# s
dst (Int#
dst_ofs Int# -> Int# -> Int#
`uncheckedIShiftL#` GMP_LIMB_SHIFT#)
                   (Int#
len Int# -> Int# -> Int#
`uncheckedIShiftL#` GMP_LIMB_SHIFT#)

copyWordArray :: BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()
copyWordArray :: BigNat -> Int# -> MutBigNat s -> Int# -> Int# -> S s ()
copyWordArray (BN# ByteArray#
ba#) Int#
ofs_ba# (MBN# MutableByteArray# s
mba#) Int#
ofs_mba# Int#
len#
  = (State# s -> State# s) -> S s ()
forall s. (State# s -> State# s) -> S s ()
svoid (ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall s.
ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyWordArray# ByteArray#
ba# Int#
ofs_ba# MutableByteArray# s
mba# Int#
ofs_mba# Int#
len#)

clearWordArray# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
clearWordArray# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
clearWordArray# MutableByteArray# s
mba Int#
ofs Int#
len
  = MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> State# d
setByteArray# MutableByteArray# s
mba (Int#
ofs Int# -> Int# -> Int#
`uncheckedIShiftL#` GMP_LIMB_SHIFT#)
                      (Int#
len Int# -> Int# -> Int#
`uncheckedIShiftL#` GMP_LIMB_SHIFT#) 0#

-- | Version of 'normSizeofMutBigNat'#' which scans all allocated 'MutBigNat#'
normSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, Int# #)
normSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, Int# #)
normSizeofMutBigNat# mbn :: MutBigNat s
mbn@(MBN# MutableByteArray# s
mba) State# s
s = MutBigNat s -> Int# -> State# s -> (# State# s, Int# #)
forall s. MutBigNat s -> Int# -> State# s -> (# State# s, Int# #)
normSizeofMutBigNat'# MutBigNat s
mbn Int#
sz# State# s
s'
  where
    !(# State# s
s', Int#
n# #) = MutableByteArray# s -> State# s -> (# State# s, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# s
mba State# s
s
    sz# :: Int#
sz# = Int#
n# Int# -> Int# -> Int#
`uncheckedIShiftRA#` GMP_LIMB_SHIFT#

-- | Find most-significant non-zero limb and return its index-position
-- plus one. Start scanning downward from the initial limb-size
-- (i.e. start-index plus one) given as second argument.
--
-- NB: The 'normSizeofMutBigNat' of 'zeroBigNat' would be @0#@
normSizeofMutBigNat'# :: MutBigNat s -> GmpSize#
                         -> State# s -> (# State# s, GmpSize# #)
normSizeofMutBigNat'# :: MutBigNat s -> Int# -> State# s -> (# State# s, Int# #)
normSizeofMutBigNat'# (MBN# MutableByteArray# s
mba) = Int# -> State# s -> (# State# s, Int# #)
go
  where
    go :: Int# -> State# s -> (# State# s, Int# #)
go  Int#
0# State# s
s = (# State# s
s, Int#
0# #)
    go Int#
i0# State# s
s = case MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWordArray# MutableByteArray# s
mba (Int#
i0# Int# -> Int# -> Int#
-# Int#
1#) State# s
s of
        (# State# s
s', Word#
0## #) -> Int# -> State# s -> (# State# s, Int# #)
go (Int#
i0# Int# -> Int# -> Int#
-# Int#
1#) State# s
s'
        (# State# s
s', Word#
_  #) -> (# State# s
s', Int#
i0# #)

-- | Construct 'BigNat' from existing 'ByteArray#' containing /n/
-- 'GmpLimb's in least-significant-first order.
--
-- If possible 'ByteArray#', will be used directly (i.e. shared
-- /without/ cloning the 'ByteArray#' into a newly allocated one)
--
-- Note: size parameter (times @sizeof(GmpLimb)@) must be less or
-- equal to its 'sizeofByteArray#'.
byteArrayToBigNat# :: ByteArray# -> GmpSize# -> BigNat
byteArrayToBigNat# :: ByteArray# -> Int# -> BigNat
byteArrayToBigNat# ByteArray#
ba# Int#
n0#
  | Int# -> Bool
isTrue# (Int#
n#  Int# -> Int# -> Int#
==# Int#
0#)    = BigNat
zeroBigNat
  | Int# -> Bool
isTrue# (Int#
baszr# Int# -> Int# -> Int#
==# Int#
0#) -- i.e. ba# is multiple of limb-size
  , Int# -> Bool
isTrue# (Int#
baszq# Int# -> Int# -> Int#
==# Int#
n#) = (ByteArray# -> BigNat
BN# ByteArray#
ba#)
  | Bool
True = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
      let !(# State# RealWorld
s', mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) #) = Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
n# State# RealWorld
s
          !(# State# RealWorld
s'', Int#
ba_sz# #) = MutableByteArray# RealWorld
-> State# RealWorld -> (# State# RealWorld, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# RealWorld
mba# State# RealWorld
s'
          go :: S RealWorld BigNat
go = do ()
_ <- (State# RealWorld -> State# RealWorld) -> S RealWorld ()
forall s. (State# s -> State# s) -> S s ()
svoid (ByteArray#
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall s.
ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
copyByteArray# ByteArray#
ba# Int#
0# MutableByteArray# RealWorld
mba# Int#
0# Int#
ba_sz# )
                  MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
      in S RealWorld BigNat
go State# RealWorld
s''
  where
    !(# Int#
baszq#, Int#
baszr# #) = Int# -> Int# -> (# Int#, Int# #)
quotRemInt# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#) GMP_LIMB_BYTES#

    n# :: Int#
n#  = BigNat -> Int# -> Int#
fmssl (ByteArray# -> BigNat
BN# ByteArray#
ba#) (Int#
n0# Int# -> Int# -> Int#
-# Int#
1#)

-- | Read 'Integer' (without sign) from memory location at @/addr/@ in
-- base-256 representation.
--
-- @'importIntegerFromAddr' /addr/ /size/ /msbf/@
--
-- See description of 'importIntegerFromByteArray' for more details.
--
-- @since 1.0.0.0
importIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer
importIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer
importIntegerFromAddr Addr#
addr Word#
len Int#
msbf = (State# RealWorld -> (# State# RealWorld, Integer #)) -> IO Integer
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Integer #))
 -> IO Integer)
-> (State# RealWorld -> (# State# RealWorld, Integer #))
-> IO Integer
forall a b. (a -> b) -> a -> b
$ do
    BigNat
bn <- IO BigNat -> S RealWorld BigNat
forall a. IO a -> S RealWorld a
liftIO (Addr# -> Word# -> Int# -> IO BigNat
importBigNatFromAddr Addr#
addr Word#
len Int#
msbf)
    Integer -> State# RealWorld -> (# State# RealWorld, Integer #)
forall a s. a -> S s a
return (BigNat -> Integer
bigNatToInteger BigNat
bn)

-- | Version of 'importIntegerFromAddr' constructing a 'BigNat'
importBigNatFromAddr :: Addr# -> Word# -> Int# -> IO BigNat
importBigNatFromAddr :: Addr# -> Word# -> Int# -> IO BigNat
importBigNatFromAddr Addr#
_ Word#
0## Int#
_ = S RealWorld BigNat -> IO BigNat
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# State# RealWorld
s, BigNat
zeroBigNat #))
importBigNatFromAddr Addr#
addr Word#
len0 Int#
1# = S RealWorld BigNat -> IO BigNat
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (S RealWorld BigNat -> IO BigNat)
-> S RealWorld BigNat -> IO BigNat
forall a b. (a -> b) -> a -> b
$ do -- MSBF
    W# Word#
ofs <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (Addr# -> Word# -> Word# -> IO Word
c_scan_nzbyte_addr Addr#
addr Word#
0## Word#
len0)
    let len :: Word#
len = Word#
len0 Word# -> Word# -> Word#
`minusWord#` Word#
ofs
        addr' :: Addr#
addr' = Addr#
addr Addr# -> Int# -> Addr#
`plusAddr#` (Word# -> Int#
word2Int# Word#
ofs)
    Addr# -> Word# -> Int# -> S RealWorld BigNat
importBigNatFromAddr# Addr#
addr' Word#
len Int#
1#
importBigNatFromAddr Addr#
addr Word#
len0 Int#
_ = S RealWorld BigNat -> IO BigNat
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (S RealWorld BigNat -> IO BigNat)
-> S RealWorld BigNat -> IO BigNat
forall a b. (a -> b) -> a -> b
$ do -- LSBF
    W# Word#
len <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (Addr# -> Word# -> Word# -> IO Word
c_rscan_nzbyte_addr Addr#
addr Word#
0## Word#
len0)
    Addr# -> Word# -> Int# -> S RealWorld BigNat
importBigNatFromAddr# Addr#
addr Word#
len Int#
0#

foreign import ccall unsafe "integer_gmp_scan_nzbyte"
    c_scan_nzbyte_addr :: Addr# -> Word# -> Word# -> IO Word

foreign import ccall unsafe "integer_gmp_rscan_nzbyte"
    c_rscan_nzbyte_addr :: Addr# -> Word# -> Word# -> IO Word

-- | Helper for 'importBigNatFromAddr'
importBigNatFromAddr# :: Addr# -> Word# -> Int# -> S RealWorld BigNat
importBigNatFromAddr# :: Addr# -> Word# -> Int# -> S RealWorld BigNat
importBigNatFromAddr# Addr#
_ Word#
0## Int#
_ = BigNat -> S RealWorld BigNat
forall a s. a -> S s a
return BigNat
zeroBigNat
importBigNatFromAddr# Addr#
addr Word#
len Int#
msbf = do
    mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
n#
    () <- IO () -> S RealWorld ()
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> Addr# -> Word# -> Word# -> Int# -> IO ()
c_mpn_import_addr MutableByteArray# RealWorld
mba# Addr#
addr Word#
0## Word#
len Int#
msbf)
    MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
  where
    -- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs required
    n# :: Int#
n# = (Word# -> Int#
word2Int# Word#
len Int# -> Int# -> Int#
+# (SIZEOF_HSWORD# -# 1#)) `quotInt#` SIZEOF_HSWORD#

foreign import ccall unsafe "integer_gmp_mpn_import"
    c_mpn_import_addr :: MutableByteArray# RealWorld -> Addr# -> Word# -> Word#
                      -> Int# -> IO ()

-- | Read 'Integer' (without sign) from byte-array in base-256 representation.
--
-- The call
--
-- @'importIntegerFromByteArray' /ba/ /offset/ /size/ /msbf/@
--
-- reads
--
-- * @/size/@ bytes from the 'ByteArray#' @/ba/@ starting at @/offset/@
--
-- * with most significant byte first if @/msbf/@ is @1#@ or least
--   significant byte first if @/msbf/@ is @0#@, and
--
-- * returns a new 'Integer'
--
-- @since 1.0.0.0
importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer
importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer
importIntegerFromByteArray ByteArray#
ba Word#
ofs Word#
len Int#
msbf
    = BigNat -> Integer
bigNatToInteger (ByteArray# -> Word# -> Word# -> Int# -> BigNat
importBigNatFromByteArray ByteArray#
ba Word#
ofs Word#
len Int#
msbf)

-- | Version of 'importIntegerFromByteArray' constructing a 'BigNat'
importBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> BigNat
importBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> BigNat
importBigNatFromByteArray ByteArray#
_  Word#
_    Word#
0##  Int#
_  = BigNat
zeroBigNat
importBigNatFromByteArray ByteArray#
ba Word#
ofs0 Word#
len0 Int#
1# = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do -- MSBF
    W# Word#
ofs <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (ByteArray# -> Word# -> Word# -> IO Word
c_scan_nzbyte_bytearray ByteArray#
ba Word#
ofs0 Word#
len0)
    let len :: Word#
len = (Word#
len0 Word# -> Word# -> Word#
`plusWord#` Word#
ofs0) Word# -> Word# -> Word#
`minusWord#` Word#
ofs
    ByteArray# -> Word# -> Word# -> Int# -> S RealWorld BigNat
importBigNatFromByteArray# ByteArray#
ba Word#
ofs Word#
len Int#
1#
importBigNatFromByteArray ByteArray#
ba Word#
ofs  Word#
len0 Int#
_  = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do -- LSBF
    W# Word#
len <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (ByteArray# -> Word# -> Word# -> IO Word
c_rscan_nzbyte_bytearray ByteArray#
ba Word#
ofs Word#
len0)
    ByteArray# -> Word# -> Word# -> Int# -> S RealWorld BigNat
importBigNatFromByteArray# ByteArray#
ba Word#
ofs Word#
len Int#
0#

foreign import ccall unsafe "integer_gmp_scan_nzbyte"
    c_scan_nzbyte_bytearray :: ByteArray# -> Word# -> Word# -> IO Word

foreign import ccall unsafe "integer_gmp_rscan_nzbyte"
    c_rscan_nzbyte_bytearray :: ByteArray# -> Word# -> Word# -> IO Word

-- | Helper for 'importBigNatFromByteArray'
importBigNatFromByteArray# :: ByteArray# -> Word# -> Word# -> Int#
                           -> S RealWorld BigNat
importBigNatFromByteArray# :: ByteArray# -> Word# -> Word# -> Int# -> S RealWorld BigNat
importBigNatFromByteArray# ByteArray#
_ Word#
_ Word#
0## Int#
_ = BigNat -> S RealWorld BigNat
forall a s. a -> S s a
return BigNat
zeroBigNat
importBigNatFromByteArray# ByteArray#
ba Word#
ofs Word#
len Int#
msbf = do
    mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
n#
    () <- IO () -> S RealWorld ()
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld
-> ByteArray# -> Word# -> Word# -> Int# -> IO ()
c_mpn_import_bytearray MutableByteArray# RealWorld
mba# ByteArray#
ba Word#
ofs Word#
len Int#
msbf)
    MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
  where
    -- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs required
    n# :: Int#
n# = (Word# -> Int#
word2Int# Word#
len Int# -> Int# -> Int#
+# (SIZEOF_HSWORD# -# 1#)) `quotInt#` SIZEOF_HSWORD#

foreign import ccall unsafe "integer_gmp_mpn_import"
    c_mpn_import_bytearray :: MutableByteArray# RealWorld -> ByteArray# -> Word#
                           -> Word# -> Int# -> IO ()

-- | Test whether all internal invariants are satisfied by 'BigNat' value
--
-- Returns @1#@ if valid, @0#@ otherwise.
--
-- This operation is mostly useful for test-suites and/or code which
-- constructs 'Integer' values directly.
isValidBigNat# :: BigNat -> Int#
isValidBigNat# :: BigNat -> Int#
isValidBigNat# (BN# ByteArray#
ba#)
  = (Int#
szq# Int# -> Int# -> Int#
># Int#
0#) Int# -> Int# -> Int#
`andI#` (Int#
szr# Int# -> Int# -> Int#
==# Int#
0#) Int# -> Int# -> Int#
`andI#` Int#
isNorm#
  where
    isNorm# :: Int#
isNorm#
      | Int# -> Bool
isTrue# (Int#
szq# Int# -> Int# -> Int#
># Int#
1#) = (ByteArray# -> Int# -> Word#
indexWordArray# ByteArray#
ba# (Int#
szq# Int# -> Int# -> Int#
-# Int#
1#)) Word# -> Word# -> Int#
`neWord#` Word#
0##
      | Bool
True                 = Int#
1#

    sz# :: Int#
sz# = ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#

    !(# Int#
szq#, Int#
szr# #) = Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
sz# GMP_LIMB_BYTES#

-- | Version of 'nextPrimeInteger' operating on 'BigNat's
--
-- @since 1.0.0.0
nextPrimeBigNat :: BigNat -> BigNat
nextPrimeBigNat :: BigNat -> BigNat
nextPrimeBigNat bn :: BigNat
bn@(BN# ByteArray#
ba#) = S RealWorld BigNat -> BigNat
forall a. S RealWorld a -> a
runS (S RealWorld BigNat -> BigNat) -> S RealWorld BigNat -> BigNat
forall a b. (a -> b) -> a -> b
$ do
    mbn :: MutBigNat RealWorld
mbn@(MBN# MutableByteArray# RealWorld
mba#) <- Int# -> S RealWorld (MutBigNat RealWorld)
forall s. Int# -> S s (MutBigNat s)
newBigNat# Int#
n#
    (W# Word#
c#) <- IO Word -> S RealWorld Word
forall a. IO a -> S RealWorld a
liftIO (MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO Word
nextPrime# MutableByteArray# RealWorld
mba# ByteArray#
ba# Int#
n#)
    case Word#
c# of
        Word#
0## -> MutBigNat RealWorld -> S RealWorld BigNat
forall s. MutBigNat s -> S s BigNat
unsafeFreezeBigNat# MutBigNat RealWorld
mbn
        Word#
_   -> MutBigNat RealWorld -> Word# -> S RealWorld BigNat
forall s. MutBigNat s -> Word# -> S s BigNat
unsafeSnocFreezeBigNat# MutBigNat RealWorld
mbn Word#
c#
  where
    n# :: Int#
n# = BigNat -> Int#
sizeofBigNat# BigNat
bn

foreign import ccall unsafe "integer_gmp_next_prime"
  nextPrime# :: MutableByteArray# RealWorld -> ByteArray# -> GmpSize#
                -> IO GmpLimb

----------------------------------------------------------------------------
-- monadic combinators for low-level state threading

type S s a = State# s -> (# State# s, a #)

infixl 1 >>=
infixl 1 >>
infixr 0 $

{-# INLINE ($) #-}
($)                     :: (a -> b) -> a -> b
a -> b
f $ :: (a -> b) -> a -> b
$ a
x                   =  a -> b
f a
x

{-# INLINE (>>=) #-}
(>>=) :: S s a -> (a -> S s b) -> S s b
>>= :: S s a -> (a -> S s b) -> S s b
(>>=) S s a
m a -> S s b
k = \State# s
s -> case S s a
m State# s
s of (# State# s
s', a
a #) -> a -> S s b
k a
a State# s
s'

{-# INLINE (>>) #-}
(>>) :: S s a -> S s b -> S s b
>> :: S s a -> S s b -> S s b
(>>) S s a
m S s b
k = \State# s
s -> case S s a
m State# s
s of (# State# s
s', a
_ #) -> S s b
k State# s
s'

{-# INLINE svoid #-}
svoid :: (State# s -> State# s) -> S s ()
svoid :: (State# s -> State# s) -> S s ()
svoid State# s -> State# s
m0 = \State# s
s -> case State# s -> State# s
m0 State# s
s of State# s
s' -> (# State# s
s', () #)

{-# INLINE return #-}
return :: a -> S s a
return :: a -> S s a
return a
a = \State# s
s -> (# State# s
s, a
a #)

{-# INLINE liftIO #-}
liftIO :: IO a -> S RealWorld a
liftIO :: IO a -> S RealWorld a
liftIO (IO S RealWorld a
m) = S RealWorld a
m

-- NB: equivalent of GHC.IO.unsafeDupablePerformIO, see notes there
runS :: S RealWorld a -> a
runS :: S RealWorld a -> a
runS S RealWorld a
m = case S RealWorld a -> (# State# RealWorld, a #)
forall o. (State# RealWorld -> o) -> o
runRW# S RealWorld a
m of (# State# RealWorld
_, a
a #) -> a
a

-- stupid hack
fail :: [Char] -> S s a
fail :: [Char] -> S s a
fail [Char]
s = a -> S s a
forall a s. a -> S s a
return ([Char] -> a
forall b a. b -> a
raise# [Char]
s)

----------------------------------------------------------------------------

-- | Internal helper type for "signed" 'BigNat's
--
-- This is a useful abstraction for operations which support negative
-- mp_size_t arguments.
data SBigNat = NegBN !BigNat | PosBN !BigNat

-- | Absolute value of 'SBigNat'
absSBigNat :: SBigNat -> BigNat
absSBigNat :: SBigNat -> BigNat
absSBigNat (NegBN BigNat
bn) = BigNat
bn
absSBigNat (PosBN BigNat
bn) = BigNat
bn

-- | /Signed/ limb count. Negative sizes denote negative integers
ssizeofSBigNat# :: SBigNat -> GmpSize#
ssizeofSBigNat# :: SBigNat -> Int#
ssizeofSBigNat# (NegBN BigNat
bn) = Int# -> Int#
negateInt# (BigNat -> Int#
sizeofBigNat# BigNat
bn)
ssizeofSBigNat# (PosBN BigNat
bn) = BigNat -> Int#
sizeofBigNat# BigNat
bn

-- | Construct 'SBigNat' from 'Int#' value
intToSBigNat# :: Int# -> SBigNat
intToSBigNat# :: Int# -> SBigNat
intToSBigNat# Int#
0#     = BigNat -> SBigNat
PosBN BigNat
zeroBigNat
intToSBigNat# Int#
1#     = BigNat -> SBigNat
PosBN BigNat
oneBigNat
intToSBigNat# (Int#
-1#)  = BigNat -> SBigNat
NegBN BigNat
oneBigNat
intToSBigNat# Int#
i# | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
># Int#
0#) = BigNat -> SBigNat
PosBN (Word# -> BigNat
wordToBigNat (Int# -> Word#
int2Word# Int#
i#))
                 | Bool
True   = BigNat -> SBigNat
NegBN (Word# -> BigNat
wordToBigNat (Int# -> Word#
int2Word# (Int# -> Int#
negateInt# Int#
i#)))

-- | Convert 'Integer' into 'SBigNat'
integerToSBigNat :: Integer -> SBigNat
integerToSBigNat :: Integer -> SBigNat
integerToSBigNat (S#  Int#
i#) = Int# -> SBigNat
intToSBigNat# Int#
i#
integerToSBigNat (Jp# BigNat
bn) = BigNat -> SBigNat
PosBN BigNat
bn
integerToSBigNat (Jn# BigNat
bn) = BigNat -> SBigNat
NegBN BigNat
bn

-- | Convert 'SBigNat' into 'Integer'
sBigNatToInteger :: SBigNat -> Integer
sBigNatToInteger :: SBigNat -> Integer
sBigNatToInteger (NegBN BigNat
bn) = BigNat -> Integer
bigNatToNegInteger BigNat
bn
sBigNatToInteger (PosBN BigNat
bn) = BigNat -> Integer
bigNatToInteger BigNat
bn

----------------------------------------------------------------------------
-- misc helpers, some of these should rather be primitives exported by ghc-prim

cmpW# :: Word# -> Word# -> Ordering
cmpW# :: Word# -> Word# -> Ordering
cmpW# Word#
x# Word#
y#
  | Int# -> Bool
isTrue# (Word#
x# Word# -> Word# -> Int#
`ltWord#` Word#
y#) = Ordering
LT
  | Int# -> Bool
isTrue# (Word#
x# Word# -> Word# -> Int#
`eqWord#` Word#
y#) = Ordering
EQ
  | Bool
True                      = Ordering
GT
{-# INLINE cmpW# #-}

bitWord# :: Int# -> Word#
bitWord# :: Int# -> Word#
bitWord# = Word# -> Int# -> Word#
uncheckedShiftL# Word#
1##
{-# INLINE bitWord# #-}

testBitWord# :: Word# -> Int# -> Int#
testBitWord# :: Word# -> Int# -> Int#
testBitWord# Word#
w# Int#
i# = (Int# -> Word#
bitWord# Int#
i# Word# -> Word# -> Word#
`and#` Word#
w#) Word# -> Word# -> Int#
`neWord#` Word#
0##
{-# INLINE testBitWord# #-}

popCntI# :: Int# -> Int#
popCntI# :: Int# -> Int#
popCntI# Int#
i# = Word# -> Int#
word2Int# (Word# -> Word#
popCnt# (Int# -> Word#
int2Word# Int#
i#))
{-# INLINE popCntI# #-}

-- branchless version
absI# :: Int# -> Int#
absI# :: Int# -> Int#
absI# Int#
i# = (Int#
i# Int# -> Int# -> Int#
`xorI#` Int#
nsign) Int# -> Int# -> Int#
-# Int#
nsign
  where
    -- nsign = negateInt# (i# <# 0#)
    nsign :: Int#
nsign = Int# -> Int# -> Int#
uncheckedIShiftRA# Int#
i# (WORD_SIZE_IN_BITS# -# 1#)

-- branchless version
sgnI# :: Int# -> Int#
sgnI# :: Int# -> Int#
sgnI# Int#
x# = (Int#
x# Int# -> Int# -> Int#
># Int#
0#) Int# -> Int# -> Int#
-# (Int#
x# Int# -> Int# -> Int#
<# Int#
0#)

cmpI# :: Int# -> Int# -> Int#
cmpI# :: Int# -> Int# -> Int#
cmpI# Int#
x# Int#
y# = (Int#
x# Int# -> Int# -> Int#
># Int#
y#) Int# -> Int# -> Int#
-# (Int#
x# Int# -> Int# -> Int#
<# Int#
y#)

minI# :: Int# -> Int# -> Int#
minI# :: Int# -> Int# -> Int#
minI# Int#
x# Int#
y# | Int# -> Bool
isTrue# (Int#
x# Int# -> Int# -> Int#
<=# Int#
y#) = Int#
x#
            | Bool
True                = Int#
y#

-- find most-sig set limb, starting at given index
fmssl :: BigNat -> Int# -> Int#
fmssl :: BigNat -> Int# -> Int#
fmssl !BigNat
bn Int#
i0# = Int# -> Int#
go Int#
i0#
  where
    go :: Int# -> Int#
go Int#
i# | Int# -> Bool
isTrue# (Int#
i# Int# -> Int# -> Int#
<# Int#
0#)                         = Int#
0#
          | Int# -> Bool
isTrue# (Word# -> Word# -> Int#
neWord# (BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
i#) Word#
0##) = Int#
i# Int# -> Int# -> Int#
+# Int#
1#
          | Bool
True                                       = Int# -> Int#
go (Int#
i# Int# -> Int# -> Int#
-# Int#
1#)