module Data.BitArray.ST
( STBitArray
, getBitArrayBounds
, newBitArray
, readBit
, writeBit
, flipBit
, unsafeReadBit
, unsafeWriteBit
, unsafeFlipBit
, thawBitArray
, unsafeThawBitArray
, freezeBitArray
, unsafeFreezeBitArray
)
where
import Control.Monad.ST
import Data.Word
import Data.Bits
import Data.Array.ST
import Data.Array.Unsafe
import Data.BitArray.Immutable
data STBitArray s = STA
{ STBitArray s -> Int
_first :: {-# UNPACK #-} !Int
, STBitArray s -> Int
_last :: {-# UNPACK #-} !Int
, STBitArray s -> STUArray s Int Word64
_words :: {-# UNPACK #-} !(STUArray s Int Word64)
}
getBitArrayBounds :: STBitArray s -> ST s (Int,Int)
getBitArrayBounds :: STBitArray s -> ST s (Int, Int)
getBitArrayBounds (STA Int
s Int
t STUArray s Int Word64
_) = (Int, Int) -> ST s (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
s,Int
t)
newBitArray :: (Int,Int) -> Bool -> ST s (STBitArray s)
newBitArray :: (Int, Int) -> Bool -> ST s (STBitArray s)
newBitArray (Int
s,Int
t) Bool
b = if Int
tInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
s
then [Char] -> ST s (STBitArray s)
forall a. HasCallStack => [Char] -> a
error [Char]
"STBitArray/newBitArray: empty range"
else do
STUArray s Int Word64
words <- (Int, Int) -> Word64 -> ST s (STUArray s Int Word64)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Word64
w
STBitArray s -> ST s (STBitArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> STUArray s Int Word64 -> STBitArray s
forall s. Int -> Int -> STUArray s Int Word64 -> STBitArray s
STA Int
s Int
t STUArray s Int Word64
words)
where
k :: Int
k = (Int
tInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
64) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6
w :: Word64
w = case Bool
b of
Bool
False -> Word64
0
Bool
True -> Word64
0xFFFFFFFFFFFFFFFF
readBit :: STBitArray s -> Int -> ST s Bool
readBit :: STBitArray s -> Int -> ST s Bool
readBit ar :: STBitArray s
ar@(STA Int
s Int
t STUArray s Int Word64
_) Int
j = if Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
s Bool -> Bool -> Bool
|| Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
t
then [Char] -> ST s Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"STBitArray/readBit: index out of range"
else STBitArray s -> Int -> ST s Bool
forall s. STBitArray s -> Int -> ST s Bool
unsafeReadBit STBitArray s
ar Int
j
unsafeReadBit :: STBitArray s -> Int -> ST s Bool
unsafeReadBit :: STBitArray s -> Int -> ST s Bool
unsafeReadBit (STA Int
s Int
t STUArray s Int Word64
a) Int
j = do
let (Int
k,Int
l) = Int -> (Int, Int)
ind (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s)
Word64
w <- STUArray s Int Word64 -> Int -> ST s Word64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word64
a Int
k
Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
w Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
l)
writeBit :: STBitArray s -> Int -> Bool -> ST s ()
writeBit :: STBitArray s -> Int -> Bool -> ST s ()
writeBit ar :: STBitArray s
ar@(STA Int
s Int
t STUArray s Int Word64
_) Int
j Bool
b = if Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
s Bool -> Bool -> Bool
|| Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
t
then [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"STBitArray/writeBit: index out of range"
else STBitArray s -> Int -> Bool -> ST s ()
forall s. STBitArray s -> Int -> Bool -> ST s ()
unsafeWriteBit STBitArray s
ar Int
j Bool
b
unsafeWriteBit :: STBitArray s -> Int -> Bool -> ST s ()
unsafeWriteBit :: STBitArray s -> Int -> Bool -> ST s ()
unsafeWriteBit (STA Int
s Int
t STUArray s Int Word64
a) Int
j Bool
b = do
let (Int
k,Int
l) = Int -> (Int, Int)
ind (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s)
Word64
w <- STUArray s Int Word64 -> Int -> ST s Word64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word64
a Int
k
if Bool
b
then STUArray s Int Word64 -> Int -> Word64 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word64
a Int
k (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`setBit` Int
l)
else STUArray s Int Word64 -> Int -> Word64 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word64
a Int
k (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`clearBit` Int
l)
() -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
flipBit :: STBitArray s -> Int -> ST s Bool
flipBit :: STBitArray s -> Int -> ST s Bool
flipBit ar :: STBitArray s
ar@(STA Int
s Int
t STUArray s Int Word64
_) Int
j = if Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
s Bool -> Bool -> Bool
|| Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
t
then [Char] -> ST s Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"STBitArray/flipBit: index out of range"
else STBitArray s -> Int -> ST s Bool
forall s. STBitArray s -> Int -> ST s Bool
unsafeFlipBit STBitArray s
ar Int
j
unsafeFlipBit :: STBitArray s -> Int -> ST s Bool
unsafeFlipBit :: STBitArray s -> Int -> ST s Bool
unsafeFlipBit ar :: STBitArray s
ar@(STA Int
s Int
t STUArray s Int Word64
a) Int
j = do
let (Int
k,Int
l) = Int -> (Int, Int)
ind (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s)
Word64
w <- STUArray s Int Word64 -> Int -> ST s Word64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word64
a Int
k
let b :: Bool
b = Word64
w Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
l
if Bool
b
then STUArray s Int Word64 -> Int -> Word64 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word64
a Int
k (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`clearBit` Int
l)
else STUArray s Int Word64 -> Int -> Word64 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Word64
a Int
k (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`setBit` Int
l)
Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
thawBitArray :: BitArray -> ST s (STBitArray s)
thawBitArray :: BitArray -> ST s (STBitArray s)
thawBitArray (A Int
s Int
t UArray Int Word64
x) =
UArray Int Word64 -> ST s (STUArray s Int Word64)
forall i (a :: * -> * -> *) e (b :: * -> * -> *) (m :: * -> *).
(Ix i, IArray a e, MArray b e m) =>
a i e -> m (b i e)
thaw UArray Int Word64
x ST s (STUArray s Int Word64)
-> (STUArray s Int Word64 -> ST s (STBitArray s))
-> ST s (STBitArray s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \STUArray s Int Word64
y -> STBitArray s -> ST s (STBitArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> STUArray s Int Word64 -> STBitArray s
forall s. Int -> Int -> STUArray s Int Word64 -> STBitArray s
STA Int
s Int
t STUArray s Int Word64
y)
unsafeThawBitArray :: BitArray -> ST s (STBitArray s)
unsafeThawBitArray :: BitArray -> ST s (STBitArray s)
unsafeThawBitArray (A Int
s Int
t UArray Int Word64
x) =
UArray Int Word64 -> ST s (STUArray s Int Word64)
forall i (a :: * -> * -> *) e (b :: * -> * -> *) (m :: * -> *).
(Ix i, IArray a e, MArray b e m) =>
a i e -> m (b i e)
unsafeThaw UArray Int Word64
x ST s (STUArray s Int Word64)
-> (STUArray s Int Word64 -> ST s (STBitArray s))
-> ST s (STBitArray s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \STUArray s Int Word64
y -> STBitArray s -> ST s (STBitArray s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> STUArray s Int Word64 -> STBitArray s
forall s. Int -> Int -> STUArray s Int Word64 -> STBitArray s
STA Int
s Int
t STUArray s Int Word64
y)
freezeBitArray :: STBitArray s -> ST s BitArray
freezeBitArray :: STBitArray s -> ST s BitArray
freezeBitArray (STA Int
s Int
t STUArray s Int Word64
x) =
STUArray s Int Word64 -> ST s (UArray Int Word64)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STUArray s Int Word64
x ST s (UArray Int Word64)
-> (UArray Int Word64 -> ST s BitArray) -> ST s BitArray
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UArray Int Word64
y -> BitArray -> ST s BitArray
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> UArray Int Word64 -> BitArray
A Int
s Int
t UArray Int Word64
y)
unsafeFreezeBitArray :: STBitArray s -> ST s BitArray
unsafeFreezeBitArray :: STBitArray s -> ST s BitArray
unsafeFreezeBitArray (STA Int
s Int
t STUArray s Int Word64
x) =
STUArray s Int Word64 -> ST s (UArray Int Word64)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze STUArray s Int Word64
x ST s (UArray Int Word64)
-> (UArray Int Word64 -> ST s BitArray) -> ST s BitArray
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UArray Int Word64
y -> BitArray -> ST s BitArray
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> UArray Int Word64 -> BitArray
A Int
s Int
t UArray Int Word64
y)