{-# LANGUAGE CPP                        #-}

{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE RankNTypes                 #-}

#ifndef BITVEC_THREADSAFE
module Data.Bit.F2Poly
#else
module Data.Bit.F2PolyTS
#endif
  ( F2Poly
  , unF2Poly
  , toF2Poly
  , gcdExt
  ) where

import Control.DeepSeq
import Control.Exception
import Control.Monad
import Control.Monad.ST
#ifndef BITVEC_THREADSAFE
import Data.Bit.Immutable
import Data.Bit.Internal
import Data.Bit.Mutable
#else
import Data.Bit.ImmutableTS
import Data.Bit.InternalTS
import Data.Bit.MutableTS
#endif
import Data.Bit.Utils
import Data.Bits
import Data.Char
import Data.Coerce
import Data.Primitive.ByteArray
import Data.Typeable
import qualified Data.Vector.Primitive as P
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
import GHC.Exts
import GHC.Generics
import Numeric

#ifdef MIN_VERSION_ghc_bignum
import GHC.Num.BigNat
import GHC.Num.Integer
#else
import GHC.Integer.GMP.Internals
import GHC.Integer.Logarithms
#endif

-- | Binary polynomials of one variable, backed
-- by an unboxed 'Data.Vector.Unboxed.Vector' 'Bit'.
--
-- Polynomials are stored normalized, without leading zero coefficients.
--
-- The 'Ord' instance does not make much sense mathematically,
-- it is defined only for the sake of 'Data.Set.Set', 'Data.Map.Map', etc.
--
-- >>> :set -XBinaryLiterals
-- >>> -- (1 + x) * (1 + x + x^2) = 1 + x^3 (mod 2)
-- >>> 0b11 * 0b111 :: F2Poly
-- 0b1001
--
-- @since 1.0.1.0
newtype F2Poly = F2Poly {
  F2Poly -> Vector Bit
unF2Poly :: U.Vector Bit
  -- ^ Convert an 'F2Poly' to a vector of coefficients
  -- (first element corresponds to a constant term).
  --
  -- >>> :set -XBinaryLiterals
  -- >>> unF2Poly 0b1101
  -- [1,0,1,1]
  --
  -- @since 1.0.1.0
  }
  deriving (F2Poly -> F2Poly -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: F2Poly -> F2Poly -> Bool
$c/= :: F2Poly -> F2Poly -> Bool
== :: F2Poly -> F2Poly -> Bool
$c== :: F2Poly -> F2Poly -> Bool
Eq, Eq F2Poly
F2Poly -> F2Poly -> Bool
F2Poly -> F2Poly -> Ordering
F2Poly -> F2Poly -> F2Poly
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: F2Poly -> F2Poly -> F2Poly
$cmin :: F2Poly -> F2Poly -> F2Poly
max :: F2Poly -> F2Poly -> F2Poly
$cmax :: F2Poly -> F2Poly -> F2Poly
>= :: F2Poly -> F2Poly -> Bool
$c>= :: F2Poly -> F2Poly -> Bool
> :: F2Poly -> F2Poly -> Bool
$c> :: F2Poly -> F2Poly -> Bool
<= :: F2Poly -> F2Poly -> Bool
$c<= :: F2Poly -> F2Poly -> Bool
< :: F2Poly -> F2Poly -> Bool
$c< :: F2Poly -> F2Poly -> Bool
compare :: F2Poly -> F2Poly -> Ordering
$ccompare :: F2Poly -> F2Poly -> Ordering
Ord, Typeable, forall x. Rep F2Poly x -> F2Poly
forall x. F2Poly -> Rep F2Poly x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep F2Poly x -> F2Poly
$cfrom :: forall x. F2Poly -> Rep F2Poly x
Generic, F2Poly -> ()
forall a. (a -> ()) -> NFData a
rnf :: F2Poly -> ()
$crnf :: F2Poly -> ()
NFData)

-- | Make an 'F2Poly' from a list of coefficients
-- (first element corresponds to a constant term).
--
-- >>> :set -XOverloadedLists
-- >>> toF2Poly [1,0,1,1,0,0]
-- 0b1101
--
-- @since 1.0.1.0
toF2Poly :: U.Vector Bit -> F2Poly
toF2Poly :: Vector Bit -> F2Poly
toF2Poly Vector Bit
xs = Vector Bit -> F2Poly
F2Poly forall a b. (a -> b) -> a -> b
$ Vector Bit -> Vector Bit
dropWhileEnd forall a b. (a -> b) -> a -> b
$ Vector Word -> Vector Bit
castFromWords forall a b. (a -> b) -> a -> b
$ Vector Bit -> Vector Word
cloneToWords Vector Bit
xs

zero :: F2Poly
zero :: F2Poly
zero = Vector Bit -> F2Poly
F2Poly forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Bit
BitVec Int
0 Int
0 forall a b. (a -> b) -> a -> b
$
#ifdef MIN_VERSION_ghc_bignum
  ByteArray# -> ByteArray
ByteArray (BigNat -> ByteArray#
unBigNat BigNat
bigNatZero)
#else
  fromBigNat zeroBigNat
#endif

one :: F2Poly
one :: F2Poly
one = Vector Bit -> F2Poly
F2Poly forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Bit
BitVec Int
0 Int
1 forall a b. (a -> b) -> a -> b
$
#ifdef MIN_VERSION_ghc_bignum
  ByteArray# -> ByteArray
ByteArray (BigNat -> ByteArray#
unBigNat BigNat
bigNatOne)
#else
  fromBigNat oneBigNat
#endif

-- -- | A valid 'F2Poly' has offset 0 and no trailing garbage.
-- _isValid :: F2Poly -> Bool
-- _isValid (F2Poly (BitVec o l arr)) = o == 0 && l == l'
--   where
--     l' = U.length $ dropWhileEnd $ BitVec 0 (sizeofByteArray arr `shiftL` 3) arr

-- | Addition and multiplication are evaluated modulo 2.
--
-- 'abs' = 'id' and 'signum' = 'const' 1.
--
-- 'fromInteger' converts a binary polynomial, encoded as 'Integer',
-- to 'F2Poly' encoding.
instance Num F2Poly where
  + :: F2Poly -> F2Poly -> F2Poly
(+) = coerce :: forall a b. Coercible a b => a -> b
coerce Vector Bit -> Vector Bit -> Vector Bit
xorBits
  (-) = coerce :: forall a b. Coercible a b => a -> b
coerce Vector Bit -> Vector Bit -> Vector Bit
xorBits
  negate :: F2Poly -> F2Poly
negate = forall a. a -> a
id
  abs :: F2Poly -> F2Poly
abs    = forall a. a -> a
id
  signum :: F2Poly -> F2Poly
signum = forall a b. a -> b -> a
const F2Poly
one
  * :: F2Poly -> F2Poly -> F2Poly
(*) = coerce :: forall a b. Coercible a b => a -> b
coerce ((Vector Bit -> Vector Bit
dropWhileEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Bit -> Vector Bit -> Vector Bit
karatsuba)
#ifdef MIN_VERSION_ghc_bignum
  fromInteger :: Integer -> F2Poly
fromInteger !Integer
n = case Integer
n of
    IS Int#
i#
      | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0     -> forall a e. Exception e => e -> a
throw ArithException
Underflow
      | Bool
otherwise -> Vector Bit -> F2Poly
F2Poly forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Bit
BitVec Int
0 (Int
wordSize forall a. Num a => a -> a -> a
- Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
clz# (Int# -> Word#
int2Word# Int#
i#))))
                     forall a b. (a -> b) -> a -> b
$ ByteArray# -> ByteArray
ByteArray (Word# -> ByteArray#
bigNatFromWord# (Int# -> Word#
int2Word# Int#
i#))
    IP ByteArray#
bn# -> Vector Bit -> F2Poly
F2Poly forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Bit
BitVec Int
0 (Int# -> Int
I# (Word# -> Int#
word2Int# (Integer -> Word#
integerLog2# Integer
n)) forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ ByteArray# -> ByteArray
ByteArray ByteArray#
bn#
    IN{}   -> forall a e. Exception e => e -> a
throw ArithException
Underflow
  {-# INLINE fromInteger #-}
#else
  fromInteger !n = case n of
    S# i#
      | n < 0     -> throw Underflow
      | otherwise -> F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#))))
                      $ fromBigNat $ wordToBigNat (int2Word# i#)
    Jp# bn# -> F2Poly $ BitVec 0 (I# (integerLog2# n) + 1) $ fromBigNat bn#
    Jn#{}   -> throw Underflow
  {-# INLINE fromInteger #-}
#endif

  {-# INLINE (+)         #-}
  {-# INLINE (-)         #-}
  {-# INLINE negate      #-}
  {-# INLINE abs         #-}
  {-# INLINE signum      #-}
  {-# INLINE (*)         #-}

instance Enum F2Poly where
  fromEnum :: F2Poly -> Int
fromEnum = forall a b. (Integral a, Num b) => a -> b
fromIntegral
#ifdef MIN_VERSION_ghc_bignum
  toEnum :: Int -> F2Poly
toEnum (I# Int#
i#) = Vector Bit -> F2Poly
F2Poly forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Bit
BitVec Int
0 (Int
wordSize forall a. Num a => a -> a -> a
- Int# -> Int
I# (Word# -> Int#
word2Int# (Word# -> Word#
clz# (Int# -> Word#
int2Word# Int#
i#))))
                           forall a b. (a -> b) -> a -> b
$ ByteArray# -> ByteArray
ByteArray (Word# -> ByteArray#
bigNatFromWord# (Int# -> Word#
int2Word# Int#
i#))
#else
  toEnum (I# i#) = F2Poly $ BitVec 0 (wordSize - I# (word2Int# (clz# (int2Word# i#))))
                           $ fromBigNat $ wordToBigNat (int2Word# i#)
#endif

instance Real F2Poly where
  toRational :: F2Poly -> Rational
toRational = forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'toInteger' converts a binary polynomial, encoded as 'F2Poly',
-- to an 'Integer' encoding.
instance Integral F2Poly where
#ifdef MIN_VERSION_ghc_bignum
  toInteger :: F2Poly -> Integer
toInteger F2Poly
xs = ByteArray# -> Integer
integerFromBigNat# (Vector Bit -> ByteArray#
bitsToByteArray (F2Poly -> Vector Bit
unF2Poly F2Poly
xs))
#else
  toInteger xs = bigNatToInteger (BN# (bitsToByteArray (unF2Poly xs)))
#endif
  quotRem :: F2Poly -> F2Poly -> (F2Poly, F2Poly)
quotRem (F2Poly Vector Bit
xs) (F2Poly Vector Bit
ys) = (Vector Bit -> F2Poly
F2Poly (Vector Bit -> Vector Bit
dropWhileEnd Vector Bit
qs), Vector Bit -> F2Poly
F2Poly (Vector Bit -> Vector Bit
dropWhileEnd Vector Bit
rs))
    where
      (Vector Bit
qs, Vector Bit
rs) = Vector Bit -> Vector Bit -> (Vector Bit, Vector Bit)
quotRemBits Vector Bit
xs Vector Bit
ys
  divMod :: F2Poly -> F2Poly -> (F2Poly, F2Poly)
divMod = forall a. Integral a => a -> a -> (a, a)
quotRem
  mod :: F2Poly -> F2Poly -> F2Poly
mod = forall a. Integral a => a -> a -> a
rem

instance Show F2Poly where
  show :: F2Poly -> String
show = (:) Char
'0' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
'b' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase Integer
2 Int -> Char
intToDigit) String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger

-- | Inputs must be valid for wrapping into F2Poly: no trailing garbage is allowed.
xorBits
  :: U.Vector Bit
  -> U.Vector Bit
  -> U.Vector Bit
xorBits :: Vector Bit -> Vector Bit -> Vector Bit
xorBits (BitVec Int
_ Int
0 ByteArray
_) Vector Bit
ys = Vector Bit
ys
xorBits Vector Bit
xs (BitVec Int
_ Int
0 ByteArray
_) = Vector Bit
xs
-- GMP has platform-dependent ASM implementations for mpn_xor_n,
-- which are impossible to beat by native Haskell.
#ifdef MIN_VERSION_ghc_bignum
xorBits (BitVec Int
0 Int
lx (ByteArray ByteArray#
xarr)) (BitVec Int
0 Int
ly (ByteArray ByteArray#
yarr)) = case Int
lx forall a. Ord a => a -> a -> Ordering
`compare` Int
ly of
  Ordering
LT -> Int -> Int -> ByteArray -> Vector Bit
BitVec Int
0 Int
ly ByteArray
zs
  Ordering
EQ -> Vector Bit -> Vector Bit
dropWhileEnd forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Bit
BitVec Int
0 (Int
lx forall a. Ord a => a -> a -> a
`min` (ByteArray -> Int
sizeofByteArray ByteArray
zs forall a. Bits a => a -> Int -> a
`shiftL` Int
3)) ByteArray
zs
  Ordering
GT -> Int -> Int -> ByteArray -> Vector Bit
BitVec Int
0 Int
lx ByteArray
zs
  where
    zs :: ByteArray
zs = ByteArray# -> ByteArray
ByteArray (ByteArray#
xarr ByteArray# -> ByteArray# -> ByteArray#
`bigNatXor` ByteArray#
yarr)
#else
xorBits (BitVec 0 lx xarr) (BitVec 0 ly yarr) = case lx `compare` ly of
  LT -> BitVec 0 ly zs
  EQ -> dropWhileEnd $ BitVec 0 (lx `min` (sizeofByteArray zs `shiftL` 3)) zs
  GT -> BitVec 0 lx zs
  where
    zs = fromBigNat (toBigNat xarr `xorBigNat` toBigNat yarr)
#endif
xorBits Vector Bit
xs Vector Bit
ys = Vector Bit -> Vector Bit
dropWhileEnd forall a b. (a -> b) -> a -> b
$ forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let lx :: Int
lx = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
xs
      ly :: Int
ly = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
ys
      (Int
shorterLen, Int
longerLen, Vector Bit
longer) = if Int
lx forall a. Ord a => a -> a -> Bool
>= Int
ly then (Int
ly, Int
lx, Vector Bit
xs) else (Int
lx, Int
ly, Vector Bit
ys)
  MVector s Bit
zs <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
MU.replicate Int
longerLen (Bool -> Bit
Bit Bool
False)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0, Int
wordSize .. Int
shorterLen forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
    forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector s Bit
zs Int
i (Vector Bit -> Int -> Word
indexWord Vector Bit
xs Int
i forall a. Bits a => a -> a -> a
`xor` Vector Bit -> Int -> Word
indexWord Vector Bit
ys Int
i)
  forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> Vector a -> m ()
U.unsafeCopy (forall a s. Unbox a => Int -> MVector s a -> MVector s a
MU.drop Int
shorterLen MVector s Bit
zs) (forall a. Unbox a => Int -> Vector a -> Vector a
U.drop Int
shorterLen Vector Bit
longer)
  forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.unsafeFreeze MVector s Bit
zs

-- | Must be >= 2 * wordSize.
karatsubaThreshold :: Int
karatsubaThreshold :: Int
karatsubaThreshold = Int
2048

karatsuba :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
karatsuba :: Vector Bit -> Vector Bit -> Vector Bit
karatsuba Vector Bit
xs Vector Bit
ys
  | Vector Bit
xs forall a. Eq a => a -> a -> Bool
== Vector Bit
ys = Vector Bit -> Vector Bit
sqrBits Vector Bit
xs
  | Int
lenXs forall a. Ord a => a -> a -> Bool
<= Int
karatsubaThreshold Bool -> Bool -> Bool
|| Int
lenYs forall a. Ord a => a -> a -> Bool
<= Int
karatsubaThreshold
  = Vector Bit -> Vector Bit -> Vector Bit
mulBits Vector Bit
xs Vector Bit
ys
  | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MVector s Bit
zs <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.unsafeNew Int
lenZs
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. forall a. Bits a => a -> a
divWordSize (Int
lenZs forall a. Num a => a -> a -> a
- Int
1)] forall a b. (a -> b) -> a -> b
$ \Int
k -> do
      let z0 :: Word
z0  = Vector Bit -> Int -> Word
indexWord0 Vector Bit
zs0   Int
k
          z11 :: Word
z11 = Vector Bit -> Int -> Word
indexWord0 Vector Bit
zs11 (Int
k forall a. Num a => a -> a -> a
- Int
m)
          z10 :: Word
z10 = Vector Bit -> Int -> Word
indexWord0 Vector Bit
zs0  (Int
k forall a. Num a => a -> a -> a
- Int
m)
          z12 :: Word
z12 = Vector Bit -> Int -> Word
indexWord0 Vector Bit
zs2  (Int
k forall a. Num a => a -> a -> a
- Int
m)
          z2 :: Word
z2  = Vector Bit -> Int -> Word
indexWord0 Vector Bit
zs2  (Int
k forall a. Num a => a -> a -> a
- Int
2 forall a. Num a => a -> a -> a
* Int
m)
      forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector s Bit
zs (forall a. Bits a => a -> a
mulWordSize Int
k) (Word
z0 forall a. Bits a => a -> a -> a
`xor` Word
z11 forall a. Bits a => a -> a -> a
`xor` Word
z10 forall a. Bits a => a -> a -> a
`xor` Word
z12 forall a. Bits a => a -> a -> a
`xor` Word
z2)
    forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.unsafeFreeze MVector s Bit
zs
  where
    lenXs :: Int
lenXs = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
xs
    lenYs :: Int
lenYs = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
ys
    lenZs :: Int
lenZs = Int
lenXs forall a. Num a => a -> a -> a
+ Int
lenYs forall a. Num a => a -> a -> a
- Int
1

    m :: Int
m    = (forall a. Ord a => a -> a -> a
min Int
lenXs Int
lenYs forall a. Num a => a -> a -> a
+ Int
1) forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
lgWordSize forall a. Num a => a -> a -> a
+ Int
1)
    m' :: Int
m'   = forall a. Bits a => a -> a
mulWordSize Int
m

    xs0 :: Vector Bit
xs0  = forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.unsafeSlice Int
0 Int
m' Vector Bit
xs
    xs1 :: Vector Bit
xs1  = forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.unsafeSlice Int
m' (Int
lenXs forall a. Num a => a -> a -> a
- Int
m') Vector Bit
xs
    ys0 :: Vector Bit
ys0  = forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.unsafeSlice Int
0 Int
m' Vector Bit
ys
    ys1 :: Vector Bit
ys1  = forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.unsafeSlice Int
m' (Int
lenYs forall a. Num a => a -> a -> a
- Int
m') Vector Bit
ys

    xs01 :: Vector Bit
xs01 = Vector Bit -> Vector Bit -> Vector Bit
xorBits Vector Bit
xs0 Vector Bit
xs1
    ys01 :: Vector Bit
ys01 = Vector Bit -> Vector Bit -> Vector Bit
xorBits Vector Bit
ys0 Vector Bit
ys1
    zs0 :: Vector Bit
zs0  = Vector Bit -> Vector Bit -> Vector Bit
karatsuba Vector Bit
xs0 Vector Bit
ys0
    zs2 :: Vector Bit
zs2  = Vector Bit -> Vector Bit -> Vector Bit
karatsuba Vector Bit
xs1 Vector Bit
ys1
    zs11 :: Vector Bit
zs11 = Vector Bit -> Vector Bit -> Vector Bit
karatsuba Vector Bit
xs01 Vector Bit
ys01

indexWord0 :: U.Vector Bit -> Int -> Word
indexWord0 :: Vector Bit -> Int -> Word
indexWord0 Vector Bit
bv Int
i'
  | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
lenI forall a. Ord a => a -> a -> Bool
<= Int
0 = Word
0
  | Int
lenI forall a. Ord a => a -> a -> Bool
>= Int
wordSize   = Word
word
  | Bool
otherwise          = Word
word forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
lenI
  where
    i :: Int
i     = forall a. Bits a => a -> a
mulWordSize Int
i'
    lenI :: Int
lenI  = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
bv forall a. Num a => a -> a -> a
- Int
i
    word :: Word
word  = Vector Bit -> Int -> Word
indexWord Vector Bit
bv Int
i

mulBits :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
mulBits :: Vector Bit -> Vector Bit -> Vector Bit
mulBits Vector Bit
xs Vector Bit
ys
  | Int
lenXs forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
lenYs forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. Unbox a => Vector a
U.empty
  | Int
lenXs forall a. Ord a => a -> a -> Bool
>= Int
lenYs           = Vector Bit -> Vector Bit -> Vector Bit
mulBits' Vector Bit
xs Vector Bit
ys
  | Bool
otherwise                = Vector Bit -> Vector Bit -> Vector Bit
mulBits' Vector Bit
ys Vector Bit
xs
  where
    lenXs :: Int
lenXs = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
xs
    lenYs :: Int
lenYs = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
ys

mulBits' :: U.Vector Bit -> U.Vector Bit -> U.Vector Bit
mulBits' :: Vector Bit -> Vector Bit -> Vector Bit
mulBits' Vector Bit
xs Vector Bit
ys = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  MVector s Bit
zs <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
MU.replicate Int
lenZs (Bool -> Bit
Bit Bool
False)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
lenYs forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
k ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bit -> Bool
unBit (forall a. Unbox a => Vector a -> Int -> a
U.unsafeIndex Vector Bit
ys Int
k)) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *).
PrimMonad m =>
(forall a. Bits a => a -> a -> a)
-> Vector Bit -> MVector (PrimState m) Bit -> m ()
zipInPlace forall a. Bits a => a -> a -> a
xor Vector Bit
xs (forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.unsafeSlice Int
k (Int
lenZs forall a. Num a => a -> a -> a
- Int
k) MVector s Bit
zs)
  forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.unsafeFreeze MVector s Bit
zs
  where
    lenXs :: Int
lenXs = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
xs
    lenYs :: Int
lenYs = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
ys
    lenZs :: Int
lenZs = Int
lenXs forall a. Num a => a -> a -> a
+ Int
lenYs forall a. Num a => a -> a -> a
- Int
1

sqrBits :: U.Vector Bit -> U.Vector Bit
sqrBits :: Vector Bit -> Vector Bit
sqrBits Vector Bit
xs = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  let lenXs :: Int
lenXs = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
xs
  MVector s Bit
zs <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
MU.replicate (forall a. Bits a => a -> a
mulWordSize (Int -> Int
nWords Int
lenXs forall a. Bits a => a -> Int -> a
`shiftL` Int
1)) (Bool -> Bit
Bit Bool
False)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0, Int
wordSize .. Int
lenXs forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    let (Word
z0, Word
z1) = Word -> (Word, Word)
sparseBits (Vector Bit -> Int -> Word
indexWord Vector Bit
xs Int
i)
    forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector s Bit
zs (Int
i forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Word
z0
    forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector s Bit
zs ((Int
i forall a. Bits a => a -> Int -> a
`shiftL` Int
1) forall a. Num a => a -> a -> a
+ Int
wordSize) Word
z1
  forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.unsafeFreeze MVector s Bit
zs

quotRemBits :: U.Vector Bit -> U.Vector Bit -> (U.Vector Bit, U.Vector Bit)
quotRemBits :: Vector Bit -> Vector Bit -> (Vector Bit, Vector Bit)
quotRemBits Vector Bit
xs Vector Bit
ys
  | forall a. Unbox a => Vector a -> Bool
U.null Vector Bit
ys = forall a e. Exception e => e -> a
throw ArithException
DivideByZero
  | forall a. Unbox a => Vector a -> Int
U.length Vector Bit
xs forall a. Ord a => a -> a -> Bool
< forall a. Unbox a => Vector a -> Int
U.length Vector Bit
ys = (forall a. Unbox a => Vector a
U.empty, Vector Bit
xs)
  | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    let lenXs :: Int
lenXs = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
xs
        lenYs :: Int
lenYs = forall a. Unbox a => Vector a -> Int
U.length Vector Bit
ys
        lenQs :: Int
lenQs = Int
lenXs forall a. Num a => a -> a -> a
- Int
lenYs forall a. Num a => a -> a -> a
+ Int
1
    MVector s Bit
qs <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
MU.replicate Int
lenQs (Bool -> Bit
Bit Bool
False)
    MVector s Bit
rs <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
MU.replicate Int
lenXs (Bool -> Bit
Bit Bool
False)
    forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> Vector a -> m ()
U.unsafeCopy MVector s Bit
rs Vector Bit
xs
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
lenQs forall a. Num a => a -> a -> a
- Int
1, Int
lenQs forall a. Num a => a -> a -> a
- Int
2 .. Int
0] forall a b. (a -> b) -> a -> b
$ \Int
i -> do
      Bit Bool
r <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MU.unsafeRead MVector s Bit
rs (Int
lenYs forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
+ Int
i)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
r forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.unsafeWrite MVector s Bit
qs Int
i (Bool -> Bit
Bit Bool
True)
        forall (m :: * -> *).
PrimMonad m =>
(forall a. Bits a => a -> a -> a)
-> Vector Bit -> MVector (PrimState m) Bit -> m ()
zipInPlace forall a. Bits a => a -> a -> a
xor Vector Bit
ys (forall a s. Unbox a => Int -> MVector s a -> MVector s a
MU.drop Int
i MVector s Bit
rs)
    let rs' :: MVector s Bit
rs' = forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.unsafeSlice Int
0 Int
lenYs MVector s Bit
rs
    (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.unsafeFreeze MVector s Bit
qs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.unsafeFreeze MVector s Bit
rs'

dropWhileEnd
  :: U.Vector Bit
  -> U.Vector Bit
dropWhileEnd :: Vector Bit -> Vector Bit
dropWhileEnd Vector Bit
xs = forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.unsafeSlice Int
0 (Int -> Int
go (forall a. Unbox a => Vector a -> Int
U.length Vector Bit
xs)) Vector Bit
xs
  where
    go :: Int -> Int
go Int
n
      | Int
n forall a. Ord a => a -> a -> Bool
< Int
wordSize = Int
wordSize forall a. Num a => a -> a -> a
- forall b. FiniteBits b => b -> Int
countLeadingZeros (Vector Bit -> Int -> Word
indexWord Vector Bit
xs Int
0 forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
n)
      | Bool
otherwise    = case Vector Bit -> Int -> Word
indexWord Vector Bit
xs (Int
n forall a. Num a => a -> a -> a
- Int
wordSize) of
        Word
0 -> Int -> Int
go (Int
n forall a. Num a => a -> a -> a
- Int
wordSize)
        Word
w -> Int
n forall a. Num a => a -> a -> a
- forall b. FiniteBits b => b -> Int
countLeadingZeros Word
w

bitsToByteArray :: U.Vector Bit -> ByteArray#
bitsToByteArray :: Vector Bit -> ByteArray#
bitsToByteArray Vector Bit
xs = ByteArray#
arr
  where
    ys :: Vector Word
ys = if forall a. Unbox a => Vector a -> Bool
U.null Vector Bit
xs then forall a. Unbox a => a -> Vector a
U.singleton (Word
0 :: Word) else Vector Bit -> Vector Word
cloneToWords Vector Bit
xs
    !(P.Vector Int
_ Int
_ (ByteArray ByteArray#
arr)) = Vector Word -> Vector Word
toPrimVector Vector Word
ys

#ifdef MIN_VERSION_ghc_bignum
#else
fromBigNat :: BigNat -> ByteArray
fromBigNat (BN# arr) = ByteArray arr

toBigNat :: ByteArray -> BigNat
toBigNat (ByteArray arr) = BN# arr
#endif

-- | Execute the extended Euclidean algorithm.
-- For polynomials @a@ and @b@, compute their unique greatest common divisor @g@
-- and the unique coefficient polynomial @s@ satisfying \( a \cdot s + b \cdot t = g \).
--
-- >>> :set -XBinaryLiterals
-- >>> gcdExt 0b101 0b0101
-- (0b101,0b0)
-- >>> gcdExt 0b11 0b111
-- (0b1,0b10)
--
-- @since 1.0.2.0
gcdExt :: F2Poly -> F2Poly -> (F2Poly, F2Poly)
gcdExt :: F2Poly -> F2Poly -> (F2Poly, F2Poly)
gcdExt = forall {t}. Integral t => t -> t -> t -> t -> (t, t)
go F2Poly
one F2Poly
zero
  where
    go :: t -> t -> t -> t -> (t, t)
go t
s t
s' t
r t
r'
      | t
r' forall a. Eq a => a -> a -> Bool
== t
0   = (t
r, t
s)
      | Bool
otherwise = case forall a. Integral a => a -> a -> (a, a)
quotRem t
r t
r' of
        (t
q, t
r'') -> t -> t -> t -> t -> (t, t)
go t
s' (t
s forall a. Num a => a -> a -> a
- t
q forall a. Num a => a -> a -> a
* t
s') t
r' t
r''