{-# 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 up to 10% slower.
--
-- @since 0.1
newtype Bit = Bit {
  Bit -> Bool
unBit :: Bool -- ^ @since 0.2.0.0
  } deriving
  (Bit
Bit -> Bit -> Bounded 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]
(Bit -> Bit)
-> (Bit -> Bit)
-> (Int -> Bit)
-> (Bit -> Int)
-> (Bit -> [Bit])
-> (Bit -> Bit -> [Bit])
-> (Bit -> Bit -> [Bit])
-> (Bit -> Bit -> Bit -> [Bit])
-> Enum 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
(Bit -> Bit -> Bool) -> (Bit -> Bit -> Bool) -> Eq Bit
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
Eq Bit
-> (Bit -> Bit -> Ordering)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bit)
-> (Bit -> Bit -> Bit)
-> Ord 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
$cp1Ord :: Eq Bit
Ord
  , FiniteBits -- ^ @since 0.2.0.0
  , Eq Bit
Bit
Eq Bit
-> (Bit -> Bit -> Bit)
-> (Bit -> Bit -> Bit)
-> (Bit -> Bit -> Bit)
-> (Bit -> Bit)
-> (Bit -> Int -> Bit)
-> (Bit -> Int -> Bit)
-> Bit
-> (Int -> Bit)
-> (Bit -> Int -> Bit)
-> (Bit -> Int -> Bit)
-> (Bit -> Int -> Bit)
-> (Bit -> Int -> Bool)
-> (Bit -> Maybe Int)
-> (Bit -> Int)
-> (Bit -> Bool)
-> (Bit -> Int -> Bit)
-> (Bit -> Int -> Bit)
-> (Bit -> Int -> Bit)
-> (Bit -> Int -> Bit)
-> (Bit -> Int -> Bit)
-> (Bit -> Int -> Bit)
-> (Bit -> Int)
-> Bits 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
$cp1Bits :: Eq Bit
Bits, Typeable
  , Generic    -- ^ @since 1.0.1.0
  , 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 up to 20% slower.
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 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
b)
  Bit Bool
a - :: Bit -> Bit -> Bit
- Bit Bool
b = Bool -> Bit
Bit (Bool
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
b)
  negate :: Bit -> Bit
negate = Bit -> Bit
forall a. a -> a
id
  abs :: Bit -> Bit
abs    = Bit -> Bit
forall a. a -> a
id
  signum :: Bit -> Bit
signum = Bit -> Bit
forall a. a -> a
id
  fromInteger :: Integer -> Bit
fromInteger = Bool -> Bit
Bit (Bool -> Bit) -> (Integer -> Bool) -> Integer -> Bit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bool
forall a. Integral a => a -> Bool
odd

-- | @since 1.0.1.0
instance Real Bit where
  toRational :: Bit -> Rational
toRational = Bit -> Rational
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) = ArithException -> (Bit, Bit)
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 = Integer -> Bit
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
x) Bit -> Bit -> Bit
forall a. Fractional a => a -> a -> a
/ Integer -> Bit
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
x)
  / :: Bit -> Bit -> Bit
(/) = 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) = Int -> ReadS Bit
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 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
i) Word -> Word -> Bool
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 ) = Word -> Word
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 _ 0 _) Int
_ = Word
0
indexWord (BitVec off len' arr) !Int
i' = Word
word
 where
  len :: Int
len    = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len'
  i :: Int
i      = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i'
  nMod :: Int
nMod   = Int -> Int
modWordSize Int
i
  loIx :: Int
loIx   = Int -> Int
forall a. Bits a => a -> a
divWordSize Int
i
  loWord :: Word
loWord = ByteArray -> Int -> Word
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr Int
loIx
  hiWord :: Word
hiWord = ByteArray -> Int -> Word
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
arr (Int
loIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

  word :: Word
word
    | Int
nMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    = Word
loWord
    | Int
loIx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
forall a. Bits a => a -> a
divWordSize (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    = Word
loWord Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
nMod
    | Bool
otherwise
    = (Word
loWord Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
nMod) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
hiWord Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
wordSize Int -> Int -> Int
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 :: MVector (PrimState m) Bit -> Int -> m Word
readWord (BitMVec _ 0 _) Int
_ = Word -> m Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word
0
readWord (BitMVec off len' arr) !Int
i' = do
  let len :: Int
len  = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len'
      i :: Int
i    = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i'
      nMod :: Int
nMod = Int -> Int
modWordSize Int
i
      loIx :: Int
loIx = Int -> Int
forall a. Bits a => a -> a
divWordSize Int
i
  Word
loWord <- MutableByteArray (PrimState m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
arr Int
loIx

  if Int
nMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Word -> m Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word
loWord
    else if Int
loIx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
forall a. Bits a => a -> a
divWordSize (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      then Word -> m Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word
loWord Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
nMod)
      else do
        Word
hiWord <- MutableByteArray (PrimState m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
arr (Int
loIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        Word -> m Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Word -> m Word) -> Word -> m Word
forall a b. (a -> b) -> a -> b
$   (Word
loWord Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
nMod)
          Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
hiWord Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (Int
wordSize Int -> Int -> Int
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 :: MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr Int
ix Word
msk Word
new = do
  Word
old <- MutableByteArray (PrimState m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
arr Int
ix
  MutableByteArray (PrimState m) -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr Int
ix (Word
old Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
msk Word -> Word -> Word
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 :: MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord (BitMVec _ 0 _) Int
_ Word
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
writeWord (BitMVec off len' arr) !Int
i' !Word
x
  | Int
iMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  = if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wordSize
    then MutableByteArray (PrimState m) -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr Int
iDiv Word
x
    else MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
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 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
lenMod)
  | Int
iDiv Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
forall a. Bits a => a -> a
divWordSize (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  = if Int
lenMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
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 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
iMod)
    else MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr Int
iDiv (Int -> Word
loMask Int
iMod Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Int -> Word
hiMask Int
lenMod) ((Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
iMod) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
lenMod)
  | Int
iDiv Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
forall a. Bits a => a -> a
divWordSize (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  = do
    MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
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 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
iMod)
    if Int
lenMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr (Int
iDiv Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word
hiMask Int
iMod) (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
iMod))
    else MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr (Int
iDiv Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word
hiMask Int
iMod Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Int -> Word
hiMask Int
lenMod) (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
iMod) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
lenMod)
  | Bool
otherwise
  = do
    MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
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 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
iMod)
    MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
arr (Int
iDiv Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Word
hiMask Int
iMod) (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
iMod))
  where
    len :: Int
len    = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len'
    lenMod :: Int
lenMod = Int -> Int
modWordSize Int
len
    i :: Int
i      = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i'
    iMod :: Int
iMod   = Int -> Int
modWordSize Int
i
    iDiv :: Int
iDiv   = Int -> Int
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 :: MVector s Bit -> ST s ()
basicInitialize MVector s Bit
vec = MVector s Bit -> Bit -> ST s ()
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 :: Int -> ST s (MVector s Bit)
basicUnsafeNew Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> ST s (MVector s Bit)
forall a. HasCallStack => String -> a
error (String -> ST s (MVector s Bit)) -> String -> ST s (MVector s Bit)
forall a b. (a -> b) -> a -> b
$ String
"Data.Bit.basicUnsafeNew: negative length: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
    | Bool
otherwise = do
      MutableByteArray s
arr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int
wordsToBytes (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
nWords Int
n)
      MVector s Bit -> ST s (MVector s Bit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVector s Bit -> ST s (MVector s Bit))
-> MVector s Bit -> ST s (MVector s Bit)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MutableByteArray s -> MVector s Bit
forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
0 Int
n MutableByteArray s
arr

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

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

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

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

  {-# INLINE basicUnsafeWrite #-}
#ifndef BITVEC_THREADSAFE
  basicUnsafeWrite :: MVector s Bit -> Int -> Bit -> ST s ()
basicUnsafeWrite (BitMVec off _ arr) !Int
i' !Bit
x = do
    let i :: Int
i  = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i'
        j :: Int
j  = Int -> Int
forall a. Bits a => a -> a
divWordSize Int
i
        k :: Int
k  = Int -> Int
modWordSize Int
i
        kk :: Word
kk = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
k :: Word
    Word
word <- MutableByteArray (PrimState (ST s)) -> Int -> ST s Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
j
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
j (if Bit -> Bool
unBit Bit
x then Word
word Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
kk else Word
word Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
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 :: MVector s Bit -> Bit -> ST s ()
basicSet (BitMVec off len arr) (Bit -> Word
extendToWord -> Word
x) | Int
offBits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
    case Int -> Int
modWordSize Int
len of
      Int
0    -> MutableByteArray (PrimState (ST s))
-> Int -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
offWords Int
lWords (Word
x :: Word)
      Int
nMod -> do
        MutableByteArray (PrimState (ST s))
-> Int -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
offWords (Int
lWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word
x :: Word)
        MutableByteArray (PrimState (ST s))
-> Int -> Word -> Word -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr (Int
offWords Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Word
hiMask Int
nMod) (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
nMod)
   where
    offBits :: Int
offBits  = Int -> Int
modWordSize Int
off
    offWords :: Int
offWords = Int -> Int
forall a. Bits a => a -> a
divWordSize Int
off
    lWords :: Int
lWords   = Int -> Int
nWords (Int
offBits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
  basicSet (BitMVec off len arr) (Bit -> Word
extendToWord -> Word
x) =
    case Int -> Int
modWordSize (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) of
      Int
0 -> do
        MutableByteArray (PrimState (ST s))
-> Int -> Word -> Word -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
offWords (Int -> Word
loMask Int
offBits) (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Int -> Word
hiMask Int
offBits)
        MutableByteArray (PrimState (ST s))
-> Int -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr (Int
offWords Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
lWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word
x :: Word)
      Int
nMod -> if Int
lWords Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
        then do
          let lohiMask :: Word
lohiMask = Int -> Word
loMask Int
offBits Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Int -> Word
hiMask Int
nMod
          MutableByteArray (PrimState (ST s))
-> Int -> Word -> Word -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
offWords Word
lohiMask (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Bits a => a -> a
complement Word
lohiMask)
        else do
          MutableByteArray (PrimState (ST s))
-> Int -> Word -> Word -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr Int
offWords (Int -> Word
loMask Int
offBits) (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Int -> Word
hiMask Int
offBits)
          MutableByteArray (PrimState (ST s))
-> Int -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr (Int
offWords Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
lWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Word
x :: Word)
          MutableByteArray (PrimState (ST s))
-> Int -> Word -> Word -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
arr (Int
offWords Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Word
hiMask Int
nMod) (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Int -> Word
loMask Int
nMod)
   where
    offBits :: Int
offBits  = Int -> Int
modWordSize Int
off
    offWords :: Int
offWords = Int -> Int
forall a. Bits a => a -> a
divWordSize Int
off
    lWords :: Int
lWords   = Int -> Int
nWords (Int
offBits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)

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

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

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

  {-# INLINE basicUnsafeMove #-}
  basicUnsafeMove :: MVector s Bit -> MVector s Bit -> ST s ()
basicUnsafeMove !MVector s Bit
dst src :: MVector s Bit
src@(BitMVec srcShift srcLen _)
    | MVector s Bit -> MVector s Bit -> Bool
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 <- Int -> MVector s Bit -> MVector s Bit
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
MV.drop (Int -> Int
modWordSize Int
srcShift)
        (MVector s Bit -> MVector s Bit)
-> ST s (MVector s Bit) -> ST s (MVector s Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector s Bit)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
MV.basicUnsafeNew (Int -> Int
modWordSize Int
srcShift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen)
      MVector s Bit -> MVector s Bit -> ST s ()
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
      MVector s Bit -> MVector s Bit -> ST s ()
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 = MVector s Bit -> MVector s Bit -> ST s ()
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 :: Int -> Int -> MVector s Bit -> MVector s Bit
basicUnsafeSlice Int
offset Int
n (BitMVec off _ arr) = Int -> Int -> MutableByteArray s -> MVector s Bit
forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Int
n MutableByteArray s
arr

  {-# INLINE basicUnsafeGrow #-}
  basicUnsafeGrow :: MVector s Bit -> Int -> ST s (MVector s Bit)
basicUnsafeGrow (BitMVec off len src) Int
byBits
    | Int
byWords Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = MVector s Bit -> ST s (MVector s Bit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVector s Bit -> ST s (MVector s Bit))
-> MVector s Bit -> ST s (MVector s Bit)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MutableByteArray s -> MVector s Bit
forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
off (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
byBits) MutableByteArray s
src
    | Bool
otherwise = do
      MutableByteArray s
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int
wordsToBytes Int
newWords)
      MutableByteArray (PrimState (ST s))
-> Int
-> MutableByteArray (PrimState (ST s))
-> Int
-> Int
-> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
0 MutableByteArray s
MutableByteArray (PrimState (ST s))
src Int
0 (Int -> Int
wordsToBytes Int
oldWords)
      MVector s Bit -> ST s (MVector s Bit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVector s Bit -> ST s (MVector s Bit))
-> MVector s Bit -> ST s (MVector s Bit)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MutableByteArray s -> MVector s Bit
forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
off (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
byBits) MutableByteArray s
dst
   where
    oldWords :: Int
oldWords = Int -> Int
nWords (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
    newWords :: Int
newWords = Int -> Int
nWords (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
byBits)
    byWords :: Int
byWords  = Int
newWords Int -> Int -> Int
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 :: MVector (PrimState m) Bit -> Int -> m ()
unsafeFlipBit MVector (PrimState m) Bit
v Int
i =
#if MIN_VERSION_vector(0,13,0)
  Checks -> Int -> Int -> m () -> m ()
forall a. HasCallStack => Checks -> Int -> Int -> a -> a
checkIndex Checks
Unsafe
#else
  UNSAFE_CHECK(checkIndex) "flipBit"
#endif
    Int
i (MVector (PrimState m) Bit -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MV.length MVector (PrimState m) Bit
v) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) Bit -> Int -> m ()
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 :: MVector (PrimState m) Bit -> Int -> m ()
basicFlipBit (BitMVec off _ arr) !Int
i' = do
  let i :: Int
i  = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i'
      j :: Int
j  = Int -> Int
forall a. Bits a => a -> a
divWordSize Int
i
      k :: Int
k  = Int -> Int
modWordSize Int
i
      kk :: Word
kk = Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
k :: Word
  Word
word <- MutableByteArray (PrimState m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
arr Int
j
  MutableByteArray (PrimState m) -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
arr Int
j (Word
word Word -> 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 :: MVector (PrimState m) Bit -> Int -> m ()
flipBit MVector (PrimState m) Bit
v Int
i =
#if MIN_VERSION_vector(0,13,0)
  Checks -> Int -> Int -> m () -> m ()
forall a. HasCallStack => Checks -> Int -> Int -> a -> a
checkIndex Checks
Bounds
#else
  BOUNDS_CHECK(checkIndex) "flipBit"
#endif
    Int
i (MVector (PrimState m) Bit -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
MV.length MVector (PrimState m) Bit
v) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      MVector (PrimState m) Bit -> Int -> m ()
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 :: Mutable Vector s Bit -> ST s (Vector Bit)
basicUnsafeFreeze (BitMVec s n v) = Int -> Int -> ByteArray -> Vector Bit
BitVec Int
s Int
n (ByteArray -> Vector Bit) -> ST s ByteArray -> ST s (Vector Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
v
  basicUnsafeThaw :: Vector Bit -> ST s (Mutable Vector s Bit)
basicUnsafeThaw (BitVec s n v) = Int -> Int -> MutableByteArray s -> MVector s Bit
forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
s Int
n (MutableByteArray s -> MVector s Bit)
-> ST s (MutableByteArray s) -> ST s (MVector s Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteArray -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
unsafeThawByteArray ByteArray
v
  basicLength :: Vector Bit -> Int
basicLength (BitVec _ n _) = Int
n

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

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

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