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
{ _first :: !Int
, _last :: !Int
, _words :: !(STUArray s Int Word64)
}
getBitArrayBounds :: STBitArray s -> ST s (Int,Int)
getBitArrayBounds (STA s t _) = return (s,t)
newBitArray :: (Int,Int) -> Bool -> ST s (STBitArray s)
newBitArray (s,t) b = if t<s
then error "STBitArray/newBitArray: empty range"
else do
words <- newArray (0,k1) w
return (STA s t words)
where
k = (ts+64) `shiftR` 6
w = case b of
False -> 0
True -> 0xFFFFFFFFFFFFFFFF
readBit :: STBitArray s -> Int -> ST s Bool
readBit ar@(STA s t _) j = if j<s || j>t
then error "STBitArray/readBit: index out of range"
else unsafeReadBit ar j
unsafeReadBit :: STBitArray s -> Int -> ST s Bool
unsafeReadBit (STA s t a) j = do
let (k,l) = ind (js)
w <- readArray a k
return (w `testBit` l)
writeBit :: STBitArray s -> Int -> Bool -> ST s ()
writeBit ar@(STA s t _) j b = if j<s || j>t
then error "STBitArray/writeBit: index out of range"
else unsafeWriteBit ar j b
unsafeWriteBit :: STBitArray s -> Int -> Bool -> ST s ()
unsafeWriteBit (STA s t a) j b = do
let (k,l) = ind (js)
w <- readArray a k
if b
then writeArray a k (w `setBit` l)
else writeArray a k (w `clearBit` l)
return ()
flipBit :: STBitArray s -> Int -> ST s Bool
flipBit ar@(STA s t _) j = if j<s || j>t
then error "STBitArray/flipBit: index out of range"
else unsafeFlipBit ar j
unsafeFlipBit :: STBitArray s -> Int -> ST s Bool
unsafeFlipBit ar@(STA s t a) j = do
let (k,l) = ind (js)
w <- readArray a k
let b = w `testBit` l
if b
then writeArray a k (w `clearBit` l)
else writeArray a k (w `setBit` l)
return b
thawBitArray :: BitArray -> ST s (STBitArray s)
thawBitArray (A s t x) =
thaw x >>= \y -> return (STA s t y)
unsafeThawBitArray :: BitArray -> ST s (STBitArray s)
unsafeThawBitArray (A s t x) =
unsafeThaw x >>= \y -> return (STA s t y)
freezeBitArray :: STBitArray s -> ST s BitArray
freezeBitArray (STA s t x) =
freeze x >>= \y -> return (A s t y)
unsafeFreezeBitArray :: STBitArray s -> ST s BitArray
unsafeFreezeBitArray (STA s t x) =
unsafeFreeze x >>= \y -> return (A s t y)