{-# 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
Bit -> Bit -> Bounded Bit
forall a. a -> a -> Bounded a
$cminBound :: Bit
minBound :: Bit
$cmaxBound :: Bit
maxBound :: 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
$csucc :: Bit -> Bit
succ :: Bit -> Bit
$cpred :: Bit -> Bit
pred :: Bit -> Bit
$ctoEnum :: Int -> Bit
toEnum :: Int -> Bit
$cfromEnum :: Bit -> Int
fromEnum :: Bit -> Int
$cenumFrom :: Bit -> [Bit]
enumFrom :: Bit -> [Bit]
$cenumFromThen :: Bit -> Bit -> [Bit]
enumFromThen :: Bit -> Bit -> [Bit]
$cenumFromTo :: Bit -> Bit -> [Bit]
enumFromTo :: Bit -> Bit -> [Bit]
$cenumFromThenTo :: Bit -> Bit -> Bit -> [Bit]
enumFromThenTo :: Bit -> Bit -> Bit -> [Bit]
Enum, Bit -> Bit -> Bool
(Bit -> Bit -> Bool) -> (Bit -> Bit -> Bool) -> Eq Bit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bit -> Bit -> Bool
== :: Bit -> Bit -> Bool
$c/= :: Bit -> Bit -> Bool
/= :: 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
$ccompare :: Bit -> Bit -> Ordering
compare :: Bit -> Bit -> Ordering
$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
>= :: Bit -> Bit -> Bool
$cmax :: Bit -> Bit -> Bit
max :: Bit -> Bit -> Bit
$cmin :: Bit -> Bit -> Bit
min :: Bit -> Bit -> Bit
Ord
, Bits Bit
Bits Bit =>
(Bit -> Int) -> (Bit -> Int) -> (Bit -> Int) -> FiniteBits Bit
Bit -> Int
forall b.
Bits b =>
(b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
$cfiniteBitSize :: Bit -> Int
finiteBitSize :: Bit -> Int
$ccountLeadingZeros :: Bit -> Int
countLeadingZeros :: Bit -> Int
$ccountTrailingZeros :: Bit -> Int
countTrailingZeros :: Bit -> Int
FiniteBits
, 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
$c.&. :: Bit -> Bit -> Bit
.&. :: Bit -> Bit -> Bit
$c.|. :: Bit -> Bit -> Bit
.|. :: Bit -> Bit -> Bit
$cxor :: Bit -> Bit -> Bit
xor :: Bit -> Bit -> Bit
$ccomplement :: Bit -> Bit
complement :: Bit -> Bit
$cshift :: Bit -> Int -> Bit
shift :: Bit -> Int -> Bit
$crotate :: Bit -> Int -> Bit
rotate :: Bit -> Int -> Bit
$czeroBits :: Bit
zeroBits :: Bit
$cbit :: Int -> Bit
bit :: Int -> Bit
$csetBit :: Bit -> Int -> Bit
setBit :: Bit -> Int -> Bit
$cclearBit :: Bit -> Int -> Bit
clearBit :: Bit -> Int -> Bit
$ccomplementBit :: Bit -> Int -> Bit
complementBit :: Bit -> Int -> Bit
$ctestBit :: Bit -> Int -> Bool
testBit :: Bit -> Int -> Bool
$cbitSizeMaybe :: Bit -> Maybe Int
bitSizeMaybe :: Bit -> Maybe Int
$cbitSize :: Bit -> Int
bitSize :: Bit -> Int
$cisSigned :: Bit -> Bool
isSigned :: Bit -> Bool
$cshiftL :: Bit -> Int -> Bit
shiftL :: Bit -> Int -> Bit
$cunsafeShiftL :: Bit -> Int -> Bit
unsafeShiftL :: Bit -> Int -> Bit
$cshiftR :: Bit -> Int -> Bit
shiftR :: Bit -> Int -> Bit
$cunsafeShiftR :: Bit -> Int -> Bit
unsafeShiftR :: Bit -> Int -> Bit
$crotateL :: Bit -> Int -> Bit
rotateL :: Bit -> Int -> Bit
$crotateR :: Bit -> Int -> Bit
rotateR :: Bit -> Int -> Bit
$cpopCount :: Bit -> Int
popCount :: Bit -> Int
Bits, Typeable
, (forall x. Bit -> Rep Bit x)
-> (forall x. Rep Bit x -> Bit) -> Generic Bit
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
$cfrom :: forall x. Bit -> Rep Bit x
from :: forall x. Bit -> Rep Bit x
$cto :: forall x. Rep Bit x -> Bit
to :: forall x. Rep Bit x -> Bit
Generic
, Bit -> ()
(Bit -> ()) -> NFData Bit
forall a. (a -> ()) -> NFData a
$crnf :: Bit -> ()
rnf :: 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 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
instance Real Bit where
toRational :: Bit -> Rational
toRational = Bit -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
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
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
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
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 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 #-}
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
_ = Word -> m Word
forall a. a -> m a
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 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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 :: 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 <- 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'', () #)
#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
_ = () -> m ()
forall a. a -> m a
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 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 :: forall s. MVector s Bit -> ST s ()
basicInitialize MVector s Bit
vec = MVector s Bit -> Bit -> ST s ()
forall s. 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 :: forall s. 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 a. a -> ST s a
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 :: forall s. 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 a. a -> ST s a
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 :: 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) =
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 :: 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 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 a. a -> ST s a
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 :: 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 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 :: forall s. MVector s Bit -> Bit -> ST s ()
basicSet (BitMVec Int
off Int
len MutableByteArray s
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 Int
off Int
len MutableByteArray s
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 :: 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 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 Int
offDst Int
lenDst MutableByteArray s
dst) (BitMVec Int
offSrc Int
_ MutableByteArray s
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 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 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 a. a -> ST s a
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
_)
| MVector s Bit -> MVector s Bit -> Bool
forall s. 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
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 s. 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 s. 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 s. 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 s. 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 :: forall s. Int -> Int -> MVector s Bit -> MVector s Bit
basicUnsafeSlice Int
offset Int
n (BitMVec Int
off Int
_ MutableByteArray s
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 :: forall s. MVector s Bit -> Int -> ST s (MVector s Bit)
basicUnsafeGrow (BitMVec Int
off Int
len MutableByteArray s
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 a. a -> ST s a
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 a. a -> ST s a
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
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)
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 :: 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 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 #-}
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)
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
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 (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 :: forall s. Vector Bit -> ST s (Mutable Vector s Bit)
basicUnsafeThaw (BitVec Int
s Int
n ByteArray
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 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i'
Bit -> Box Bit
forall a. a -> Box a
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 :: forall s. 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 s. 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 s. 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 Mutable Vector s Bit
MVector 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Int
n ByteArray
arr