{-# LANGUAGE CPP                        #-}

{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE ViewPatterns               #-}

#ifndef BITVEC_THREADSAFE
module Data.Bit.Internal
#else
module Data.Bit.InternalTS
#endif
  ( Bit(..)
  , U.Vector(BitVec)
  , U.MVector(BitMVec)
  , indexWord
  , readWord
  , writeWord
  , unsafeFlipBit
  , flipBit
  , modifyByteArray
  ) where

#if MIN_VERSION_vector(0,13,0)
import Data.Vector.Internal.Check (checkIndex, Checks(..))
#else
#include "vector.h"
#endif

import Control.DeepSeq
import Control.Exception
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Bits
import Data.Bit.Utils
import Data.Primitive.ByteArray
import Data.Ratio
import Data.Typeable
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Generic.Mutable as MV
import qualified Data.Vector.Unboxed as U
import GHC.Generics

#ifdef BITVEC_THREADSAFE
import GHC.Exts
#endif

#ifndef BITVEC_THREADSAFE
-- | A newtype wrapper with a custom instance
-- for "Data.Vector.Unboxed", which packs booleans
-- as efficient as possible (8 values per byte).
-- Unboxed vectors of `Bit` use 8x less memory
-- than unboxed vectors of 'Bool' (which store one value per byte),
-- but random writes are slightly slower.
--
-- @since 0.1
newtype Bit = Bit {
  Bit -> Bool
unBit :: Bool -- ^ @since 0.2.0.0
  } deriving
  (Bit
forall a. a -> a -> Bounded a
maxBound :: Bit
$cmaxBound :: Bit
minBound :: Bit
$cminBound :: Bit
Bounded, Int -> Bit
Bit -> Int
Bit -> [Bit]
Bit -> Bit
Bit -> Bit -> [Bit]
Bit -> Bit -> Bit -> [Bit]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Bit -> Bit -> Bit -> [Bit]
$cenumFromThenTo :: Bit -> Bit -> Bit -> [Bit]
enumFromTo :: Bit -> Bit -> [Bit]
$cenumFromTo :: Bit -> Bit -> [Bit]
enumFromThen :: Bit -> Bit -> [Bit]
$cenumFromThen :: Bit -> Bit -> [Bit]
enumFrom :: Bit -> [Bit]
$cenumFrom :: Bit -> [Bit]
fromEnum :: Bit -> Int
$cfromEnum :: Bit -> Int
toEnum :: Int -> Bit
$ctoEnum :: Int -> Bit
pred :: Bit -> Bit
$cpred :: Bit -> Bit
succ :: Bit -> Bit
$csucc :: Bit -> Bit
Enum, Bit -> Bit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bit -> Bit -> Bool
$c/= :: Bit -> Bit -> Bool
== :: Bit -> Bit -> Bool
$c== :: Bit -> Bit -> Bool
Eq, Eq Bit
Bit -> Bit -> Bool
Bit -> Bit -> Ordering
Bit -> Bit -> Bit
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 :: Bit -> Bit -> Bit
$cmin :: Bit -> Bit -> Bit
max :: Bit -> Bit -> Bit
$cmax :: Bit -> Bit -> Bit
>= :: Bit -> Bit -> Bool
$c>= :: Bit -> Bit -> Bool
> :: Bit -> Bit -> Bool
$c> :: Bit -> Bit -> Bool
<= :: Bit -> Bit -> Bool
$c<= :: Bit -> Bit -> Bool
< :: Bit -> Bit -> Bool
$c< :: Bit -> Bit -> Bool
compare :: Bit -> Bit -> Ordering
$ccompare :: Bit -> Bit -> Ordering
Ord
  , Bits Bit
Bit -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: Bit -> Int
$ccountTrailingZeros :: Bit -> Int
countLeadingZeros :: Bit -> Int
$ccountLeadingZeros :: Bit -> Int
finiteBitSize :: Bit -> Int
$cfiniteBitSize :: Bit -> Int
FiniteBits -- ^ @since 0.2.0.0
  , Eq Bit
Bit
Int -> Bit
Bit -> Bool
Bit -> Int
Bit -> Maybe Int
Bit -> Bit
Bit -> Int -> Bool
Bit -> Int -> Bit
Bit -> Bit -> Bit
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Bit -> Int
$cpopCount :: Bit -> Int
rotateR :: Bit -> Int -> Bit
$crotateR :: Bit -> Int -> Bit
rotateL :: Bit -> Int -> Bit
$crotateL :: Bit -> Int -> Bit
unsafeShiftR :: Bit -> Int -> Bit
$cunsafeShiftR :: Bit -> Int -> Bit
shiftR :: Bit -> Int -> Bit
$cshiftR :: Bit -> Int -> Bit
unsafeShiftL :: Bit -> Int -> Bit
$cunsafeShiftL :: Bit -> Int -> Bit
shiftL :: Bit -> Int -> Bit
$cshiftL :: Bit -> Int -> Bit
isSigned :: Bit -> Bool
$cisSigned :: Bit -> Bool
bitSize :: Bit -> Int
$cbitSize :: Bit -> Int
bitSizeMaybe :: Bit -> Maybe Int
$cbitSizeMaybe :: Bit -> Maybe Int
testBit :: Bit -> Int -> Bool
$ctestBit :: Bit -> Int -> Bool
complementBit :: Bit -> Int -> Bit
$ccomplementBit :: Bit -> Int -> Bit
clearBit :: Bit -> Int -> Bit
$cclearBit :: Bit -> Int -> Bit
setBit :: Bit -> Int -> Bit
$csetBit :: Bit -> Int -> Bit
bit :: Int -> Bit
$cbit :: Int -> Bit
zeroBits :: Bit
$czeroBits :: Bit
rotate :: Bit -> Int -> Bit
$crotate :: Bit -> Int -> Bit
shift :: Bit -> Int -> Bit
$cshift :: Bit -> Int -> Bit
complement :: Bit -> Bit
$ccomplement :: Bit -> Bit
xor :: Bit -> Bit -> Bit
$cxor :: Bit -> Bit -> Bit
.|. :: Bit -> Bit -> Bit
$c.|. :: Bit -> Bit -> Bit
.&. :: Bit -> Bit -> Bit
$c.&. :: Bit -> Bit -> Bit
Bits, Typeable
  , forall x. Rep Bit x -> Bit
forall x. Bit -> Rep Bit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bit x -> Bit
$cfrom :: forall x. Bit -> Rep Bit x
Generic    -- ^ @since 1.0.1.0
  , Bit -> ()
forall a. (a -> ()) -> NFData a
rnf :: Bit -> ()
$crnf :: Bit -> ()
NFData     -- ^ @since 1.0.1.0
  )
#else
-- | A newtype wrapper with a custom instance
-- for "Data.Vector.Unboxed", which packs booleans
-- as efficient as possible (8 values per byte).
-- Unboxed vectors of `Bit` use 8x less memory
-- than unboxed vectors of 'Bool' (which store one value per byte),
-- but random writes are slightly slower.
--
-- @since 1.0.0.0
newtype Bit = Bit {
  unBit :: Bool -- ^ @since 0.2.0.0
  } deriving
  (Bounded, Enum, Eq, Ord
  , FiniteBits -- ^ @since 0.2.0.0
  , Bits, Typeable
  , Generic    -- ^ @since 1.0.1.0
  , NFData     -- ^ @since 1.0.1.0
  )
#endif

-- | There is only one lawful 'Num' instance possible
-- with '+' = 'xor' and
-- 'fromInteger' = 'Bit' . 'odd'.
--
-- @since 1.0.1.0
instance Num Bit where
  Bit Bool
a * :: Bit -> Bit -> Bit
* Bit Bool
b = Bool -> Bit
Bit (Bool
a Bool -> Bool -> Bool
&& Bool
b)
  Bit Bool
a + :: Bit -> Bit -> Bit
+ Bit Bool
b = Bool -> Bit
Bit (Bool
a forall a. Eq a => a -> a -> Bool
/= Bool
b)
  Bit Bool
a - :: Bit -> Bit -> Bit
- Bit Bool
b = Bool -> Bit
Bit (Bool
a forall a. Eq a => a -> a -> Bool
/= Bool
b)
  negate :: Bit -> Bit
negate = forall a. a -> a
id
  abs :: Bit -> Bit
abs    = forall a. a -> a
id
  signum :: Bit -> Bit
signum = forall a. a -> a
id
  fromInteger :: Integer -> Bit
fromInteger = Bool -> Bit
Bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Bool
odd

-- | @since 1.0.1.0
instance Real Bit where
  toRational :: Bit -> Rational
toRational = forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @since 1.0.1.0
instance Integral Bit where
  quotRem :: Bit -> Bit -> (Bit, Bit)
quotRem Bit
_ (Bit Bool
False) = forall a e. Exception e => e -> a
throw ArithException
DivideByZero
  quotRem Bit
x (Bit Bool
True)  = (Bit
x, Bool -> Bit
Bit Bool
False)
  toInteger :: Bit -> Integer
toInteger (Bit Bool
False) = Integer
0
  toInteger (Bit Bool
True)  = Integer
1

-- | @since 1.0.1.0
instance Fractional Bit where
  fromRational :: Rational -> Bit
fromRational Rational
x = forall a. Num a => Integer -> a
fromInteger (forall a. Ratio a -> a
numerator Rational
x) forall a. Fractional a => a -> a -> a
/ forall a. Num a => Integer -> a
fromInteger (forall a. Ratio a -> a
denominator Rational
x)
  / :: Bit -> Bit -> Bit
(/) = forall a. Integral a => a -> a -> a
quot

instance Show Bit where
  showsPrec :: Int -> Bit -> ShowS
showsPrec Int
_ (Bit Bool
False) = String -> ShowS
showString String
"0"
  showsPrec Int
_ (Bit Bool
True ) = String -> ShowS
showString String
"1"

instance Read Bit where
  readsPrec :: Int -> ReadS Bit
readsPrec Int
p (Char
' ' : String
rest) = forall a. Read a => Int -> ReadS a
readsPrec Int
p String
rest
  readsPrec Int
_ (Char
'0' : String
rest) = [(Bool -> Bit
Bit Bool
False, String
rest)]
  readsPrec Int
_ (Char
'1' : String
rest) = [(Bool -> Bit
Bit Bool
True, String
rest)]
  readsPrec Int
_ String
_            = []

instance U.Unbox Bit

-- Ints are offset and length in bits
data instance U.MVector s Bit = BitMVec !Int !Int !(MutableByteArray s)
data instance U.Vector    Bit = BitVec  !Int !Int !ByteArray

readBit :: Int -> Word -> Bit
readBit :: Int -> Word -> Bit
readBit Int
i Word
w = Bool -> Bit
Bit (Word
w forall a. Bits a => a -> a -> a
.&. (Word
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i) forall a. Eq a => a -> a -> Bool
/= Word
0)
{-# INLINE readBit #-}

extendToWord :: Bit -> Word
extendToWord :: Bit -> Word
extendToWord (Bit Bool
False) = Word
0
extendToWord (Bit Bool
True ) = forall a. Bits a => a -> a
complement Word
0

-- | Read a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.).  If the offset is such that the word extends past the end of the vector, the result is padded with memory garbage.
indexWord :: U.Vector Bit -> Int -> Word
indexWord :: Vector Bit -> Int -> Word
indexWord (BitVec Int
_ Int
0 ByteArray
_) Int
_ = Word
0
indexWord (BitVec Int
off Int
len' ByteArray
arr) !Int
i' = Word
word
 where
  len :: Int
len    = Int
off forall a. Num a => a -> a -> a
+ Int
len'
  i :: Int
i      = Int
off forall a. Num a => a -> a -> a
+ Int
i'
  nMod :: Int
nMod   = Int -> Int
modWordSize Int
i
  loIx :: Int
loIx   = forall a. Bits a => a -> a
divWordSize Int
i
  loWord :: Word
loWord = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr Int
loIx
  hiWord :: Word
hiWord = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (Int
loIx forall a. Num a => a -> a -> a
+ Int
1)

  word :: Word
word
    | Int
nMod forall a. Eq a => a -> a -> Bool
== Int
0
    = Word
loWord
    | Int
loIx forall a. Eq a => a -> a -> Bool
== forall a. Bits a => a -> a
divWordSize (Int
len forall a. Num a => a -> a -> a
- Int
1)
    = Word
loWord forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
nMod
    | Bool
otherwise
    = (Word
loWord forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
nMod) forall a. Bits a => a -> a -> a
.|. (Word
hiWord forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
wordSize forall a. Num a => a -> a -> a
- Int
nMod))
{-# INLINE indexWord #-}

-- | Read a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.).  If the offset is such that the word extends past the end of the vector, the result is padded with memory garbage.
readWord :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m Word
readWord :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord (BitMVec Int
_ Int
0 MutableByteArray (PrimState m)
_) Int
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Word
0
readWord (BitMVec Int
off Int
len' MutableByteArray (PrimState m)
arr) !Int
i' = do
  let len :: Int
len  = Int
off forall a. Num a => a -> a -> a
+ Int
len'
      i :: Int
i    = Int
off forall a. Num a => a -> a -> a
+ Int
i'
      nMod :: Int
nMod = Int -> Int
modWordSize Int
i
      loIx :: Int
loIx = forall a. Bits a => a -> a
divWordSize Int
i
  Word
loWord <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
arr Int
loIx

  if Int
nMod forall a. Eq a => a -> a -> Bool
== Int
0
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Word
loWord
    else if Int
loIx forall a. Eq a => a -> a -> Bool
== forall a. Bits a => a -> a
divWordSize (Int
len forall a. Num a => a -> a -> a
- Int
1)
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word
loWord forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
nMod)
      else do
        Word
hiWord <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
arr (Int
loIx forall a. Num a => a -> a -> a
+ Int
1)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
          forall a b. (a -> b) -> a -> b
$   (Word
loWord forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
nMod)
          forall a. Bits a => a -> a -> a
.|. (Word
hiWord forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
wordSize forall a. Num a => a -> a -> a
- Int
nMod))
{-# SPECIALIZE readWord :: U.MVector s Bit -> Int -> ST s Word #-}
{-# INLINE readWord #-}

modifyByteArray
  :: PrimMonad m
  => MutableByteArray (PrimState m)
  -> Int
  -> Word
  -> Word
  -> m ()
#ifndef BITVEC_THREADSAFE
modifyByteArray :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr Int
ix Word
msk Word
new = do
  Word
old <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
arr Int
ix
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr Int
ix (Word
old forall a. Bits a => a -> a -> a
.&. Word
msk forall a. Bits a => a -> a -> a
.|. Word
new)
{-# INLINE modifyByteArray #-}
#else
modifyByteArray (MutableByteArray mba) (I# ix) (W# msk) (W# new) = do
  primitive $ \state ->
    let !(# state',  _ #) = fetchAndIntArray# mba ix (word2Int# msk) state  in
    let !(# state'', _ #) = fetchOrIntArray#  mba ix (word2Int# new) state' in
    (# state'', () #)

-- https://gitlab.haskell.org/ghc/ghc/issues/17334
#if __GLASGOW_HASKELL__ == 808 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1
{-# NOINLINE modifyByteArray #-}
#else
{-# INLINE modifyByteArray #-}
#endif

#endif

-- | Write a word at the given bit offset in little-endian order (i.e., the LSB will correspond to the bit at the given address, the 2's bit will correspond to the address + 1, etc.).  If the offset is such that the word extends past the end of the vector, the word is truncated and as many low-order bits as possible are written.
writeWord :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord (BitMVec Int
_ Int
0 MutableByteArray (PrimState m)
_) Int
_ Word
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
writeWord (BitMVec Int
off Int
len' MutableByteArray (PrimState m)
arr) !Int
i' !Word
x
  | Int
iMod forall a. Eq a => a -> a -> Bool
== Int
0
  = if Int
len forall a. Ord a => a -> a -> Bool
>= Int
i forall a. Num a => a -> a -> a
+ Int
wordSize
    then forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr Int
iDiv Word
x
    else forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr Int
iDiv (Int -> Word
hiMask Int
lenMod) (Word
x forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
lenMod)
  | Int
iDiv forall a. Eq a => a -> a -> Bool
== forall a. Bits a => a -> a
divWordSize (Int
len forall a. Num a => a -> a -> a
- Int
1)
  = if Int
lenMod forall a. Eq a => a -> a -> Bool
== Int
0
    then forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr Int
iDiv (Int -> Word
loMask Int
iMod) (Word
x forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
iMod)
    else forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr Int
iDiv (Int -> Word
loMask Int
iMod forall a. Bits a => a -> a -> a
.|. Int -> Word
hiMask Int
lenMod) ((Word
x forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
iMod) forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
lenMod)
  | Int
iDiv forall a. Num a => a -> a -> a
+ Int
1 forall a. Eq a => a -> a -> Bool
== forall a. Bits a => a -> a
divWordSize (Int
len forall a. Num a => a -> a -> a
- Int
1)
  = do
    forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr Int
iDiv (Int -> Word
loMask Int
iMod) (Word
x forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
iMod)
    if Int
lenMod forall a. Eq a => a -> a -> Bool
== Int
0
    then forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr (Int
iDiv forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word
hiMask Int
iMod) (Word
x forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wordSize forall a. Num a => a -> a -> a
- Int
iMod))
    else forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr (Int
iDiv forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word
hiMask Int
iMod forall a. Bits a => a -> a -> a
.|. Int -> Word
hiMask Int
lenMod) (Word
x forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wordSize forall a. Num a => a -> a -> a
- Int
iMod) forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
lenMod)
  | Bool
otherwise
  = do
    forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr Int
iDiv (Int -> Word
loMask Int
iMod) (Word
x forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
iMod)
    forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr (Int
iDiv forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word
hiMask Int
iMod) (Word
x forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wordSize forall a. Num a => a -> a -> a
- Int
iMod))
  where
    len :: Int
len    = Int
off forall a. Num a => a -> a -> a
+ Int
len'
    lenMod :: Int
lenMod = Int -> Int
modWordSize Int
len
    i :: Int
i      = Int
off forall a. Num a => a -> a -> a
+ Int
i'
    iMod :: Int
iMod   = Int -> Int
modWordSize Int
i
    iDiv :: Int
iDiv   = forall a. Bits a => a -> a
divWordSize Int
i

{-# SPECIALIZE writeWord :: U.MVector s Bit -> Int -> Word -> ST s () #-}
{-# INLINE writeWord #-}

instance MV.MVector U.MVector Bit where
  {-# INLINE basicInitialize #-}
  basicInitialize :: forall s. MVector s Bit -> ST s ()
basicInitialize MVector s Bit
vec = forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
MV.basicSet MVector s Bit
vec (Bool -> Bit
Bit Bool
False)

  {-# INLINE basicUnsafeNew #-}
  basicUnsafeNew :: forall s. Int -> ST s (MVector s Bit)
basicUnsafeNew Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Data.Bit.basicUnsafeNew: negative length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
    | Bool
otherwise = do
      MutableByteArray s
arr <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int
wordsToBytes forall a b. (a -> b) -> a -> b
$ Int -> Int
nWords Int
n)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
0 Int
n MutableByteArray s
arr

  {-# INLINE basicUnsafeReplicate #-}
  basicUnsafeReplicate :: forall s. Int -> Bit -> ST s (MVector s Bit)
basicUnsafeReplicate Int
n Bit
x
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 =  forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$  String
"Data.Bit.basicUnsafeReplicate: negative length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n
    | Bool
otherwise = do
      MutableByteArray s
arr <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int
wordsToBytes forall a b. (a -> b) -> a -> b
$ Int -> Int
nWords Int
n)
      forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
arr Int
0 (Int -> Int
nWords Int
n) (Bit -> Word
extendToWord Bit
x :: Word)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
0 Int
n MutableByteArray s
arr

  {-# INLINE basicOverlaps #-}
  basicOverlaps :: forall s. MVector s Bit -> MVector s Bit -> Bool
basicOverlaps (BitMVec Int
i' Int
m' MutableByteArray s
arr1) (BitMVec Int
j' Int
n' MutableByteArray s
arr2) =
    forall s. MutableByteArray s -> MutableByteArray s -> Bool
sameMutableByteArray MutableByteArray s
arr1 MutableByteArray s
arr2
      Bool -> Bool -> Bool
&& (forall {a}. Ord a => a -> a -> a -> Bool
between Int
i Int
j (Int
j forall a. Num a => a -> a -> a
+ Int
n) Bool -> Bool -> Bool
|| forall {a}. Ord a => a -> a -> a -> Bool
between Int
j Int
i (Int
i forall a. Num a => a -> a -> a
+ Int
m))
   where
    i :: Int
i = forall a. Bits a => a -> a
divWordSize Int
i'
    m :: Int
m = Int -> Int
nWords (Int
i' forall a. Num a => a -> a -> a
+ Int
m') forall a. Num a => a -> a -> a
- Int
i
    j :: Int
j = forall a. Bits a => a -> a
divWordSize Int
j'
    n :: Int
n = Int -> Int
nWords (Int
j' forall a. Num a => a -> a -> a
+ Int
n') forall a. Num a => a -> a -> a
- Int
j
    between :: a -> a -> a -> Bool
between a
x a
y a
z = a
x forall a. Ord a => a -> a -> Bool
>= a
y Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
< a
z

  {-# INLINE basicLength #-}
  basicLength :: forall s. MVector s Bit -> Int
basicLength (BitMVec Int
_ Int
n MutableByteArray s
_) = Int
n

  {-# INLINE basicUnsafeRead #-}
  basicUnsafeRead :: forall s. MVector s Bit -> Int -> ST s Bit
basicUnsafeRead (BitMVec Int
off Int
_ MutableByteArray s
arr) !Int
i' = do
    let i :: Int
i = Int
off forall a. Num a => a -> a -> a
+ Int
i'
    Word
word <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
arr (forall a. Bits a => a -> a
divWordSize Int
i)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Word -> Bit
readBit (Int -> Int
modWordSize Int
i) Word
word

  {-# INLINE basicUnsafeWrite #-}
#ifndef BITVEC_THREADSAFE
  basicUnsafeWrite :: forall s. MVector s Bit -> Int -> Bit -> ST s ()
basicUnsafeWrite (BitMVec Int
off Int
_ MutableByteArray s
arr) !Int
i' !Bit
x = do
    let i :: Int
i  = Int
off forall a. Num a => a -> a -> a
+ Int
i'
        j :: Int
j  = forall a. Bits a => a -> a
divWordSize Int
i
        k :: Int
k  = Int -> Int
modWordSize Int
i
        kk :: Word
kk = Word
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
k :: Word
    Word
word <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
arr Int
j
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
arr Int
j (if Bit -> Bool
unBit Bit
x then Word
word forall a. Bits a => a -> a -> a
.|. Word
kk else Word
word forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Word
kk)
#else
  basicUnsafeWrite (BitMVec off _ (MutableByteArray mba)) !i' (Bit b) = do
    let i       = off + i'
        !(I# j) = divWordSize i
        !(I# k) = 1 `unsafeShiftL` modWordSize i
    primitive $ \state ->
      let !(# state', _ #) =
              (if b
                then fetchOrIntArray# mba j k state
                else fetchAndIntArray# mba j (notI# k) state
              )
      in  (# state', () #)
#endif

  {-# INLINE basicSet #-}
  basicSet :: forall s. MVector s Bit -> Bit -> ST s ()
basicSet (BitMVec Int
off Int
len MutableByteArray s
arr) (Bit -> Word
extendToWord -> Word
x) | Int
offBits forall a. Eq a => a -> a -> Bool
== Int
0 =
    case Int -> Int
modWordSize Int
len of
      Int
0    -> forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
arr Int
offWords Int
lWords (Word
x :: Word)
      Int
nMod -> do
        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
arr Int
offWords (Int
lWords forall a. Num a => a -> a -> a
- Int
1) (Word
x :: Word)
        forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
arr (Int
offWords forall a. Num a => a -> a -> a
+ Int
lWords forall a. Num a => a -> a -> a
- Int
1) (Int -> Word
hiMask Int
nMod) (Word
x forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
nMod)
   where
    offBits :: Int
offBits  = Int -> Int
modWordSize Int
off
    offWords :: Int
offWords = forall a. Bits a => a -> a
divWordSize Int
off
    lWords :: Int
lWords   = Int -> Int
nWords (Int
offBits forall a. Num a => a -> a -> a
+ Int
len)
  basicSet (BitMVec Int
off Int
len MutableByteArray s
arr) (Bit -> Word
extendToWord -> Word
x) =
    case Int -> Int
modWordSize (Int
off forall a. Num a => a -> a -> a
+ Int
len) of
      Int
0 -> do
        forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
arr Int
offWords (Int -> Word
loMask Int
offBits) (Word
x forall a. Bits a => a -> a -> a
.&. Int -> Word
hiMask Int
offBits)
        forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
arr (Int
offWords forall a. Num a => a -> a -> a
+ Int
1) (Int
lWords forall a. Num a => a -> a -> a
- Int
1) (Word
x :: Word)
      Int
nMod -> if Int
lWords forall a. Eq a => a -> a -> Bool
== Int
1
        then do
          let lohiMask :: Word
lohiMask = Int -> Word
loMask Int
offBits forall a. Bits a => a -> a -> a
.|. Int -> Word
hiMask Int
nMod
          forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
arr Int
offWords Word
lohiMask (Word
x forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Word
lohiMask)
        else do
          forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
arr Int
offWords (Int -> Word
loMask Int
offBits) (Word
x forall a. Bits a => a -> a -> a
.&. Int -> Word
hiMask Int
offBits)
          forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
arr (Int
offWords forall a. Num a => a -> a -> a
+ Int
1) (Int
lWords forall a. Num a => a -> a -> a
- Int
2) (Word
x :: Word)
          forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
arr (Int
offWords forall a. Num a => a -> a -> a
+ Int
lWords forall a. Num a => a -> a -> a
- Int
1) (Int -> Word
hiMask Int
nMod) (Word
x forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
nMod)
   where
    offBits :: Int
offBits  = Int -> Int
modWordSize Int
off
    offWords :: Int
offWords = forall a. Bits a => a -> a
divWordSize Int
off
    lWords :: Int
lWords   = Int -> Int
nWords (Int
offBits forall a. Num a => a -> a -> a
+ Int
len)

  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeCopy :: forall s. MVector s Bit -> MVector s Bit -> ST s ()
basicUnsafeCopy (BitMVec Int
offDst Int
lenDst MutableByteArray s
dst) (BitMVec Int
offSrc Int
_ MutableByteArray s
src)
    | Int
offDstBits forall a. Eq a => a -> a -> Bool
== Int
0, Int
offSrcBits forall a. Eq a => a -> a -> Bool
== Int
0 = case Int -> Int
modWordSize Int
lenDst of
      Int
0 -> forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray s
dst
                                (Int -> Int
wordsToBytes Int
offDstWords)
                                MutableByteArray s
src
                                (Int -> Int
wordsToBytes Int
offSrcWords)
                                (Int -> Int
wordsToBytes Int
lDstWords)
      Int
nMod -> do
        forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray s
dst
                             (Int -> Int
wordsToBytes Int
offDstWords)
                             MutableByteArray s
src
                             (Int -> Int
wordsToBytes Int
offSrcWords)
                             (Int -> Int
wordsToBytes forall a b. (a -> b) -> a -> b
$ Int
lDstWords forall a. Num a => a -> a -> a
- Int
1)

        Word
lastWordSrc <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
src (Int
offSrcWords forall a. Num a => a -> a -> a
+ Int
lDstWords forall a. Num a => a -> a -> a
- Int
1)
        forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
dst (Int
offDstWords forall a. Num a => a -> a -> a
+ Int
lDstWords forall a. Num a => a -> a -> a
- Int
1) (Int -> Word
hiMask Int
nMod) (Word
lastWordSrc forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
nMod)
   where
    offDstBits :: Int
offDstBits  = Int -> Int
modWordSize Int
offDst
    offDstWords :: Int
offDstWords = forall a. Bits a => a -> a
divWordSize Int
offDst
    lDstWords :: Int
lDstWords   = Int -> Int
nWords (Int
offDstBits forall a. Num a => a -> a -> a
+ Int
lenDst)
    offSrcBits :: Int
offSrcBits  = Int -> Int
modWordSize Int
offSrc
    offSrcWords :: Int
offSrcWords = forall a. Bits a => a -> a
divWordSize Int
offSrc
  basicUnsafeCopy (BitMVec Int
offDst Int
lenDst MutableByteArray s
dst) (BitMVec Int
offSrc Int
_ MutableByteArray s
src)
    | Int
offDstBits forall a. Eq a => a -> a -> Bool
== Int
offSrcBits = case Int -> Int
modWordSize (Int
offSrc forall a. Num a => a -> a -> a
+ Int
lenDst) of
      Int
0 -> do
        Word
firstWordSrc <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
src Int
offSrcWords
        forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
dst Int
offDstWords (Int -> Word
loMask Int
offSrcBits) (Word
firstWordSrc forall a. Bits a => a -> a -> a
.&. Int -> Word
hiMask Int
offSrcBits)
        forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray s
dst
                             (Int -> Int
wordsToBytes forall a b. (a -> b) -> a -> b
$ Int
offDstWords forall a. Num a => a -> a -> a
+ Int
1)
                             MutableByteArray s
src
                             (Int -> Int
wordsToBytes forall a b. (a -> b) -> a -> b
$ Int
offSrcWords forall a. Num a => a -> a -> a
+ Int
1)
                             (Int -> Int
wordsToBytes forall a b. (a -> b) -> a -> b
$ Int
lDstWords forall a. Num a => a -> a -> a
- Int
1)
      Int
nMod -> if Int
lDstWords forall a. Eq a => a -> a -> Bool
== Int
1
        then do
          let lohiMask :: Word
lohiMask = Int -> Word
loMask Int
offSrcBits forall a. Bits a => a -> a -> a
.|. Int -> Word
hiMask Int
nMod
          Word
theOnlyWordSrc <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
src Int
offSrcWords
          forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
dst Int
offDstWords Word
lohiMask (Word
theOnlyWordSrc forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Word
lohiMask)
        else do
          Word
firstWordSrc <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
src Int
offSrcWords
          forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
dst Int
offDstWords (Int -> Word
loMask Int
offSrcBits) (Word
firstWordSrc forall a. Bits a => a -> a -> a
.&. Int -> Word
hiMask Int
offSrcBits)
          forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray s
dst
                               (Int -> Int
wordsToBytes forall a b. (a -> b) -> a -> b
$ Int
offDstWords forall a. Num a => a -> a -> a
+ Int
1)
                               MutableByteArray s
src
                               (Int -> Int
wordsToBytes forall a b. (a -> b) -> a -> b
$ Int
offSrcWords forall a. Num a => a -> a -> a
+ Int
1)
                               (Int -> Int
wordsToBytes forall a b. (a -> b) -> a -> b
$ Int
lDstWords forall a. Num a => a -> a -> a
- Int
2)
          Word
lastWordSrc <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
src (Int
offSrcWords forall a. Num a => a -> a -> a
+ Int
lDstWords forall a. Num a => a -> a -> a
- Int
1)
          forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
dst (Int
offDstWords forall a. Num a => a -> a -> a
+ Int
lDstWords forall a. Num a => a -> a -> a
- Int
1) (Int -> Word
hiMask Int
nMod) (Word
lastWordSrc forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
nMod)
   where
    offDstBits :: Int
offDstBits  = Int -> Int
modWordSize Int
offDst
    offDstWords :: Int
offDstWords = forall a. Bits a => a -> a
divWordSize Int
offDst
    lDstWords :: Int
lDstWords   = Int -> Int
nWords (Int
offDstBits forall a. Num a => a -> a -> a
+ Int
lenDst)
    offSrcBits :: Int
offSrcBits  = Int -> Int
modWordSize Int
offSrc
    offSrcWords :: Int
offSrcWords = forall a. Bits a => a -> a
divWordSize Int
offSrc

  basicUnsafeCopy dst :: MVector s Bit
dst@(BitMVec Int
_ Int
len MutableByteArray s
_) MVector s Bit
src = Int -> ST s ()
do_copy Int
0
   where
    n :: Int
n = Int -> Int
alignUp Int
len

    do_copy :: Int -> ST s ()
do_copy Int
i
      | Int
i forall a. Ord a => a -> a -> Bool
< Int
n = do
        Word
x <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector s Bit
src Int
i
        forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector s Bit
dst Int
i Word
x
        Int -> ST s ()
do_copy (Int
i forall a. Num a => a -> a -> a
+ Int
wordSize)
      | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  {-# INLINE basicUnsafeMove #-}
  basicUnsafeMove :: forall s. MVector s Bit -> MVector s Bit -> ST s ()
basicUnsafeMove !MVector s Bit
dst src :: MVector s Bit
src@(BitMVec Int
srcShift Int
srcLen MutableByteArray s
_)
    | forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
MV.basicOverlaps MVector s Bit
dst MVector s Bit
src = do
          -- Align shifts of src and srcCopy to speed up basicUnsafeCopy srcCopy src
      MVector s Bit
srcCopy <- forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
MV.drop (Int -> Int
modWordSize Int
srcShift)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
MV.basicUnsafeNew (Int -> Int
modWordSize Int
srcShift forall a. Num a => a -> a -> a
+ Int
srcLen)
      forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
MV.basicUnsafeCopy MVector s Bit
srcCopy MVector s Bit
src
      forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
MV.basicUnsafeCopy MVector s Bit
dst MVector s Bit
srcCopy
    | Bool
otherwise = forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
MV.basicUnsafeCopy MVector s Bit
dst MVector s Bit
src

  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice :: forall s. Int -> Int -> MVector s Bit -> MVector s Bit
basicUnsafeSlice Int
offset Int
n (BitMVec Int
off Int
_ MutableByteArray s
arr) = forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec (Int
off forall a. Num a => a -> a -> a
+ Int
offset) Int
n MutableByteArray s
arr

  {-# INLINE basicUnsafeGrow #-}
  basicUnsafeGrow :: forall s. MVector s Bit -> Int -> ST s (MVector s Bit)
basicUnsafeGrow (BitMVec Int
off Int
len MutableByteArray s
src) Int
byBits
    | Int
byWords forall a. Eq a => a -> a -> Bool
== Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
off (Int
len forall a. Num a => a -> a -> a
+ Int
byBits) MutableByteArray s
src
    | Bool
otherwise = do
      MutableByteArray s
dst <- forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int
wordsToBytes Int
newWords)
      forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray s
dst Int
0 MutableByteArray s
src Int
0 (Int -> Int
wordsToBytes Int
oldWords)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
off (Int
len forall a. Num a => a -> a -> a
+ Int
byBits) MutableByteArray s
dst
   where
    oldWords :: Int
oldWords = Int -> Int
nWords (Int
off forall a. Num a => a -> a -> a
+ Int
len)
    newWords :: Int
newWords = Int -> Int
nWords (Int
off forall a. Num a => a -> a -> a
+ Int
len forall a. Num a => a -> a -> a
+ Int
byBits)
    byWords :: Int
byWords  = Int
newWords forall a. Num a => a -> a -> a
- Int
oldWords

#ifndef BITVEC_THREADSAFE

-- | Flip the bit at the given position.
-- No bound checks are performed.
-- Equivalent to 'flip' 'Data.Vector.Unboxed.Mutable.unsafeModify' 'Data.Bits.complement',
-- but up to 2x faster.
--
-- In general there is no reason to 'Data.Vector.Unboxed.Mutable.unsafeModify' bit vectors:
-- either you modify it with 'id' (which is 'id' altogether)
-- or with 'Data.Bits.complement' (which is 'unsafeFlipBit').
--
-- >>> :set -XOverloadedLists
-- >>> Data.Vector.Unboxed.modify (`unsafeFlipBit` 2) [1,1,1,1]
-- [1,1,0,1]
--
-- @since 1.0.0.0
unsafeFlipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m ()
unsafeFlipBit :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m ()
unsafeFlipBit MVector (PrimState m) Bit
v Int
i =
#if MIN_VERSION_vector(0,13,0)
  forall a. HasCallStack => Checks -> Int -> Int -> a -> a
checkIndex Checks
Unsafe
#else
  UNSAFE_CHECK(checkIndex) "flipBit"
#endif
    Int
i (forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MV.length MVector (PrimState m) Bit
v) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m ()
basicFlipBit MVector (PrimState m) Bit
v Int
i
{-# INLINE unsafeFlipBit #-}

basicFlipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m ()
basicFlipBit :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m ()
basicFlipBit (BitMVec Int
off Int
_ MutableByteArray (PrimState m)
arr) !Int
i' = do
  let i :: Int
i  = Int
off forall a. Num a => a -> a -> a
+ Int
i'
      j :: Int
j  = forall a. Bits a => a -> a
divWordSize Int
i
      k :: Int
k  = Int -> Int
modWordSize Int
i
      kk :: Word
kk = Word
1 forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
k :: Word
  Word
word <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
arr Int
j
  forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr Int
j (Word
word forall a. Bits a => a -> a -> a
`xor` Word
kk)
{-# INLINE basicFlipBit #-}

-- | Flip the bit at the given position.
-- Equivalent to 'flip' 'Data.Vector.Unboxed.Mutable.modify' 'Data.Bits.complement',
-- but up to 2x faster.
--
-- In general there is no reason to 'Data.Vector.Unboxed.Mutable.modify' bit vectors:
-- either you modify it with 'id' (which is 'id' altogether)
-- or with 'Data.Bits.complement' (which is 'flipBit').
--
-- >>> :set -XOverloadedLists
-- >>> Data.Vector.Unboxed.modify (`flipBit` 2) [1,1,1,1]
-- [1,1,0,1]
--
-- @since 1.0.0.0
flipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m ()
flipBit :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m ()
flipBit MVector (PrimState m) Bit
v Int
i =
#if MIN_VERSION_vector(0,13,0)
  forall a. HasCallStack => Checks -> Int -> Int -> a -> a
checkIndex Checks
Bounds
#else
  BOUNDS_CHECK(checkIndex) "flipBit"
#endif
    Int
i (forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MV.length MVector (PrimState m) Bit
v) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m ()
unsafeFlipBit MVector (PrimState m) Bit
v Int
i
{-# INLINE flipBit #-}

#else

-- | Flip the bit at the given position.
-- No bound checks are performed.
-- Equivalent to 'flip' 'Data.Vector.Unboxed.Mutable.unsafeModify' 'Data.Bits.complement',
-- but up to 33% faster and atomic.
--
-- In general there is no reason to 'Data.Vector.Unboxed.Mutable.unsafeModify' bit vectors:
-- either you modify it with 'id' (which is 'id' altogether)
-- or with 'Data.Bits.complement' (which is 'unsafeFlipBit').
--
-- >>> Data.Vector.Unboxed.modify (\v -> unsafeFlipBit v 1) (read "[1,1,1]")
-- [1,0,1]
unsafeFlipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m ()
unsafeFlipBit v i =
#if MIN_VERSION_vector(0,13,0)
  checkIndex Unsafe
#else
  UNSAFE_CHECK(checkIndex) "flipBit"
#endif
    i (MV.length v) $ basicFlipBit v i
{-# INLINE unsafeFlipBit #-}

basicFlipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m ()
basicFlipBit (BitMVec off _ (MutableByteArray mba)) !i' = do
  let i       = off + i'
      !(I# j) = divWordSize i
      !(I# k) = 1 `unsafeShiftL` modWordSize i
  primitive $ \state ->
    let !(# state', _ #) = fetchXorIntArray# mba j k state in (# state', () #)
{-# INLINE basicFlipBit #-}

-- | Flip the bit at the given position.
-- Equivalent to 'flip' 'Data.Vector.Unboxed.Mutable.modify' 'Data.Bits.complement',
-- but up to 33% faster and atomic.
--
-- In general there is no reason to 'Data.Vector.Unboxed.Mutable.modify' bit vectors:
-- either you modify it with 'id' (which is 'id' altogether)
-- or with 'Data.Bits.complement' (which is 'flipBit').
--
-- >>> Data.Vector.Unboxed.modify (\v -> flipBit v 1) (read "[1,1,1]")
-- [1,0,1]
flipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m ()
flipBit v i =
#if MIN_VERSION_vector(0,13,0)
  checkIndex Bounds
#else
  BOUNDS_CHECK(checkIndex) "flipBit"
#endif
    i (MV.length v) $ basicFlipBit v i
{-# INLINE flipBit #-}

#endif

instance V.Vector U.Vector Bit where
  basicUnsafeFreeze :: forall s. Mutable Vector s Bit -> ST s (Vector Bit)
basicUnsafeFreeze (BitMVec Int
s Int
n MutableByteArray s
v) = Int -> Int -> ByteArray -> Vector Bit
BitVec Int
s Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
v
  basicUnsafeThaw :: forall s. Vector Bit -> ST s (Mutable Vector s Bit)
basicUnsafeThaw (BitVec Int
s Int
n ByteArray
v) = forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
s Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
unsafeThawByteArray ByteArray
v
  basicLength :: Vector Bit -> Int
basicLength (BitVec Int
_ Int
n ByteArray
_) = Int
n

  basicUnsafeIndexM :: Vector Bit -> Int -> Box Bit
basicUnsafeIndexM (BitVec Int
off Int
_ ByteArray
arr) !Int
i' = do
    let i :: Int
i = Int
off forall a. Num a => a -> a -> a
+ Int
i'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Int -> Word -> Bit
readBit (Int -> Int
modWordSize Int
i) (forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (forall a. Bits a => a -> a
divWordSize Int
i))

  basicUnsafeCopy :: forall s. Mutable Vector s Bit -> Vector Bit -> ST s ()
basicUnsafeCopy Mutable Vector s Bit
dst Vector Bit
src = do
    MVector s Bit
src1 <- forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
V.basicUnsafeThaw Vector Bit
src
    forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
MV.basicUnsafeCopy Mutable Vector s Bit
dst MVector s Bit
src1

  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice :: Int -> Int -> Vector Bit -> Vector Bit
basicUnsafeSlice Int
offset Int
n (BitVec Int
off Int
_ ByteArray
arr) = Int -> Int -> ByteArray -> Vector Bit
BitVec (Int
off forall a. Num a => a -> a -> a
+ Int
offset) Int
n ByteArray
arr