{-# 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
#include "vector.h"
import Control.DeepSeq
import Control.Exception
import Control.Monad
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
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, 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
countTrailingZeros :: Bit -> Int
$ccountTrailingZeros :: Bit -> Int
countLeadingZeros :: Bit -> Int
$ccountLeadingZeros :: Bit -> Int
finiteBitSize :: Bit -> Int
$cfiniteBitSize :: Bit -> Int
$cp1FiniteBits :: Bits Bit
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
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, (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
$cto :: forall x. Rep Bit x -> Bit
$cfrom :: forall x. Bit -> Rep Bit x
Generic, Bit -> ()
(Bit -> ()) -> NFData 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 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 _ 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 = if Int
nMod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then 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
loWord Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
nMod)
else
(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 :: 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'', () #)
#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 :: 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 (PrimState m) Bit -> m ()
basicInitialize MVector (PrimState m) Bit
vec = MVector (PrimState m) Bit -> Bit -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
MV.basicSet MVector (PrimState m) Bit
vec (Bool -> Bit
Bit Bool
False)
{-# INLINE basicUnsafeNew #-}
basicUnsafeNew :: Int -> m (MVector (PrimState m) Bit)
basicUnsafeNew Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> m (MVector (PrimState m) Bit)
forall a. HasCallStack => String -> a
error (String -> m (MVector (PrimState m) Bit))
-> String -> m (MVector (PrimState m) 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 (PrimState m)
arr <- Int -> m (MutableByteArray (PrimState m))
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 (PrimState m) Bit -> m (MVector (PrimState m) Bit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit))
-> MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> MutableByteArray (PrimState m)
-> MVector (PrimState m) Bit
forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
0 Int
n MutableByteArray (PrimState m)
arr
{-# INLINE basicUnsafeReplicate #-}
basicUnsafeReplicate :: Int -> Bit -> m (MVector (PrimState m) Bit)
basicUnsafeReplicate Int
n Bit
x
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> m (MVector (PrimState m) Bit)
forall a. HasCallStack => String -> a
error (String -> m (MVector (PrimState m) Bit))
-> String -> m (MVector (PrimState m) 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 (PrimState m)
arr <- Int -> m (MutableByteArray (PrimState m))
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 m) -> Int -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray (PrimState m)
arr Int
0 (Int -> Int
nWords Int
n) (Bit -> Word
extendToWord Bit
x :: Word)
MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit))
-> MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> MutableByteArray (PrimState m)
-> MVector (PrimState m) Bit
forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
0 Int
n MutableByteArray (PrimState m)
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 (PrimState m) Bit -> Int -> m 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 m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
arr (Int -> Int
forall a. Bits a => a -> a
divWordSize Int
i)
Bit -> m Bit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bit -> m Bit) -> Bit -> m 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 (PrimState m) Bit -> Int -> Bit -> m ()
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 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 (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 (PrimState m) Bit -> Bit -> m ()
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 m) -> Int -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray (PrimState m)
arr Int
offWords Int
lWords (Word
x :: Word)
Int
nMod -> do
MutableByteArray (PrimState m) -> Int -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray (PrimState m)
arr Int
offWords (Int
lWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word
x :: Word)
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 m) -> Int -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray (PrimState m)
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 m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 m) -> Int -> Int -> Word -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> Int -> a -> m ()
setByteArray MutableByteArray (PrimState m)
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 m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 (PrimState m) Bit -> MVector (PrimState m) Bit -> m ()
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 m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray (PrimState m)
dst
(Int -> Int
wordsToBytes Int
offDstWords)
MutableByteArray (PrimState m)
src
(Int -> Int
wordsToBytes Int
offSrcWords)
(Int -> Int
wordsToBytes Int
lDstWords)
Int
nMod -> do
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray (PrimState m)
dst
(Int -> Int
wordsToBytes Int
offDstWords)
MutableByteArray (PrimState m)
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 m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
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 m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
src Int
offSrcWords
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray (PrimState m)
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 (PrimState m)
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 m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
src Int
offSrcWords
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
src Int
offSrcWords
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray (PrimState m)
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 (PrimState m)
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 m) -> Int -> m Word
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
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 m) -> Int -> Word -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
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 (PrimState m) Bit
dst@(BitMVec _ len _) MVector (PrimState m) Bit
src = Int -> m ()
do_copy Int
0
where
n :: Int
n = Int -> Int
alignUp Int
len
do_copy :: Int -> m ()
do_copy Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = do
Word
x <- MVector (PrimState m) Bit -> Int -> m Word
forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
src Int
i
MVector (PrimState m) Bit -> Int -> Word -> m ()
forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
dst Int
i Word
x
Int -> m ()
do_copy (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wordSize)
| Bool
otherwise = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE basicUnsafeMove #-}
basicUnsafeMove :: MVector (PrimState m) Bit -> MVector (PrimState m) Bit -> m ()
basicUnsafeMove !MVector (PrimState m) Bit
dst !src :: MVector (PrimState m) Bit
src@(BitMVec srcShift srcLen _)
| MVector (PrimState m) Bit -> MVector (PrimState m) Bit -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
MV.basicOverlaps MVector (PrimState m) Bit
dst MVector (PrimState m) Bit
src = do
MVector (PrimState m) Bit
srcCopy <- Int -> MVector (PrimState m) Bit -> MVector (PrimState m) Bit
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
MV.drop (Int -> Int
modWordSize Int
srcShift)
(MVector (PrimState m) Bit -> MVector (PrimState m) Bit)
-> m (MVector (PrimState m) Bit) -> m (MVector (PrimState m) Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) Bit)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
MV.basicUnsafeNew (Int -> Int
modWordSize Int
srcShift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen)
MVector (PrimState m) Bit -> MVector (PrimState m) Bit -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MV.basicUnsafeCopy MVector (PrimState m) Bit
srcCopy MVector (PrimState m) Bit
src
MVector (PrimState m) Bit -> MVector (PrimState m) Bit -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MV.basicUnsafeCopy MVector (PrimState m) Bit
dst MVector (PrimState m) Bit
srcCopy
| Bool
otherwise = MVector (PrimState m) Bit -> MVector (PrimState m) Bit -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MV.basicUnsafeCopy MVector (PrimState m) Bit
dst MVector (PrimState m) 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 (PrimState m) Bit -> Int -> m (MVector (PrimState m) Bit)
basicUnsafeGrow (BitMVec off len src) Int
byBits
| Int
byWords Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit))
-> MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> MutableByteArray (PrimState m)
-> MVector (PrimState m) 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 (PrimState m)
src
| Bool
otherwise = do
MutableByteArray (PrimState m)
dst <- Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int -> Int
wordsToBytes Int
newWords)
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray (PrimState m)
dst Int
0 MutableByteArray (PrimState m)
src Int
0 (Int -> Int
wordsToBytes Int
oldWords)
MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit))
-> MVector (PrimState m) Bit -> m (MVector (PrimState m) Bit)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> MutableByteArray (PrimState m)
-> MVector (PrimState m) 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 (PrimState m)
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 :: MVector (PrimState m) Bit -> Int -> m ()
unsafeFlipBit (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 unsafeFlipBit #-}
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 =
BOUNDS_CHECK(checkIndex) "flipBit" i (MV.length v) $
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 (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 unsafeFlipBit #-}
flipBit :: PrimMonad m => U.MVector (PrimState m) Bit -> Int -> m ()
flipBit v i =
BOUNDS_CHECK(checkIndex) "flipBit" i (MV.length v) $ unsafeFlipBit v i
{-# INLINE flipBit #-}
#endif
instance V.Vector U.Vector Bit where
basicUnsafeFreeze :: Mutable Vector (PrimState m) Bit -> m (Vector Bit)
basicUnsafeFreeze (BitMVec s n v) =
(ByteArray -> Vector Bit) -> m ByteArray -> m (Vector Bit)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Int -> ByteArray -> Vector Bit
BitVec Int
s Int
n) (MutableByteArray (PrimState m) -> m ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray (PrimState m)
v)
basicUnsafeThaw :: Vector Bit -> m (Mutable Vector (PrimState m) Bit)
basicUnsafeThaw (BitVec s n v) = (MutableByteArray (PrimState m) -> MVector (PrimState m) Bit)
-> m (MutableByteArray (PrimState m))
-> m (MVector (PrimState m) Bit)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int
-> Int
-> MutableByteArray (PrimState m)
-> MVector (PrimState m) Bit
forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
s Int
n) (ByteArray -> m (MutableByteArray (PrimState m))
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 -> m 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 -> m Bit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bit -> m Bit) -> Bit -> m 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 (PrimState m) Bit -> Vector Bit -> m ()
basicUnsafeCopy Mutable Vector (PrimState m) Bit
dst Vector Bit
src = do
MVector (PrimState m) Bit
src1 <- Vector Bit -> m (Mutable Vector (PrimState m) Bit)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
V.basicUnsafeThaw Vector Bit
src
MVector (PrimState m) Bit -> MVector (PrimState m) Bit -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
MV.basicUnsafeCopy MVector (PrimState m) Bit
Mutable Vector (PrimState m) Bit
dst MVector (PrimState m) 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