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
{ forall s. STBitArray s -> Int
_first :: {-# UNPACK #-} !Int
, forall s. STBitArray s -> Int
_last :: {-# UNPACK #-} !Int
, forall s. STBitArray s -> STUArray s Int Word64
_words :: {-# UNPACK #-} !(STUArray s Int Word64)
}
getBitArrayBounds :: STBitArray s -> ST s (Int,Int)
getBitArrayBounds :: forall s. STBitArray s -> ST s (Int, Int)
getBitArrayBounds (STA Int
s Int
t STUArray s Int Word64
_) = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
s,Int
t)
newBitArray :: (Int,Int) -> Bool -> ST s (STBitArray s)
newBitArray :: forall s. (Int, Int) -> Bool -> ST s (STBitArray s)
newBitArray (Int
s,Int
t) Bool
b = if Int
tforall a. Ord a => a -> a -> Bool
<Int
s
then forall a. HasCallStack => [Char] -> a
error [Char]
"STBitArray/newBitArray: empty range"
else do
STUArray s Int Word64
words <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
kforall a. Num a => a -> a -> a
-Int
1) Word64
w
forall (m :: * -> *) a. Monad m => a -> m a
return (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
tforall a. Num a => a -> a -> a
-Int
sforall a. Num a => a -> a -> a
+Int
64) 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 :: forall s. STBitArray s -> Int -> ST s Bool
readBit ar :: STBitArray s
ar@(STA Int
s Int
t STUArray s Int Word64
_) Int
j = if Int
jforall a. Ord a => a -> a -> Bool
<Int
s Bool -> Bool -> Bool
|| Int
jforall a. Ord a => a -> a -> Bool
>Int
t
then forall a. HasCallStack => [Char] -> a
error [Char]
"STBitArray/readBit: index out of range"
else forall s. STBitArray s -> Int -> ST s Bool
unsafeReadBit STBitArray s
ar Int
j
unsafeReadBit :: STBitArray s -> Int -> ST s Bool
unsafeReadBit :: forall s. 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
jforall a. Num a => a -> a -> a
-Int
s)
Word64
w <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
w forall a. Bits a => a -> Int -> Bool
`testBit` Int
l)
writeBit :: STBitArray s -> Int -> Bool -> ST s ()
writeBit :: forall s. 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
jforall a. Ord a => a -> a -> Bool
<Int
s Bool -> Bool -> Bool
|| Int
jforall a. Ord a => a -> a -> Bool
>Int
t
then forall a. HasCallStack => [Char] -> a
error [Char]
"STBitArray/writeBit: index out of range"
else forall s. STBitArray s -> Int -> Bool -> ST s ()
unsafeWriteBit STBitArray s
ar Int
j Bool
b
unsafeWriteBit :: STBitArray s -> Int -> Bool -> ST s ()
unsafeWriteBit :: forall s. 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
jforall a. Num a => a -> a -> a
-Int
s)
Word64
w <- 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 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 forall a. Bits a => a -> Int -> a
`setBit` Int
l)
else 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 forall a. Bits a => a -> Int -> a
`clearBit` Int
l)
forall (m :: * -> *) a. Monad m => a -> m a
return ()
flipBit :: STBitArray s -> Int -> ST s Bool
flipBit :: forall s. STBitArray s -> Int -> ST s Bool
flipBit ar :: STBitArray s
ar@(STA Int
s Int
t STUArray s Int Word64
_) Int
j = if Int
jforall a. Ord a => a -> a -> Bool
<Int
s Bool -> Bool -> Bool
|| Int
jforall a. Ord a => a -> a -> Bool
>Int
t
then forall a. HasCallStack => [Char] -> a
error [Char]
"STBitArray/flipBit: index out of range"
else forall s. STBitArray s -> Int -> ST s Bool
unsafeFlipBit STBitArray s
ar Int
j
unsafeFlipBit :: STBitArray s -> Int -> ST s Bool
unsafeFlipBit :: forall s. 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
jforall a. Num a => a -> a -> a
-Int
s)
Word64
w <- 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 forall a. Bits a => a -> Int -> Bool
`testBit` Int
l
if Bool
b
then 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 forall a. Bits a => a -> Int -> a
`clearBit` Int
l)
else 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 forall a. Bits a => a -> Int -> a
`setBit` Int
l)
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
thawBitArray :: BitArray -> ST s (STBitArray s)
thawBitArray :: forall s. BitArray -> ST s (STBitArray s)
thawBitArray (A Int
s Int
t UArray Int Word64
x) =
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \STUArray s Int Word64
y -> forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall s. BitArray -> ST s (STBitArray s)
unsafeThawBitArray (A Int
s Int
t UArray Int Word64
x) =
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \STUArray s Int Word64
y -> forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall s. STBitArray s -> ST s BitArray
freezeBitArray (STA Int
s Int
t STUArray s Int Word64
x) =
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UArray Int Word64
y -> 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 :: forall s. STBitArray s -> ST s BitArray
unsafeFreezeBitArray (STA Int
s Int
t STUArray s Int Word64
x) =
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UArray Int Word64
y -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> UArray Int Word64 -> BitArray
A Int
s Int
t UArray Int Word64
y)