{-# 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
newtype Bit = Bit {
Bit -> Bool
unBit :: Bool
} 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
, 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
, Bit -> ()
forall a. (a -> ()) -> NFData a
rnf :: Bit -> ()
$crnf :: Bit -> ()
NFData
)
#else
newtype Bit = Bit {
unBit :: Bool
} deriving
(Bounded, Enum, Eq, Ord
, FiniteBits
, Bits, Typeable
, Generic
, NFData
)
#endif
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
instance Real Bit where
toRational :: Bit -> Rational
toRational = forall a b. (Integral a, Num b) => a -> b
fromIntegral
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
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
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
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 #-}
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'', () #)
#if __GLASGOW_HASKELL__ == 808 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1
{-# NOINLINE modifyByteArray #-}
#else
{-# INLINE modifyByteArray #-}
#endif
#endif
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
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
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 #-}
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
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 #-}
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