module Data.Array.BitArray.Internal
( BitArray(..)
, IOBitArray(..)
, getBounds
, newArray_
, freeze
, thaw
, copy
, unsafeFreeze
, unsafeThaw
) where
import Data.Bits (shiftL, shiftR)
import Data.Ix (Ix, rangeSize)
import Data.Word (Word64)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes, withForeignPtr)
newtype BitArray i = B (IOBitArray i)
data IOBitArray i = IOB{ iobBoundLo :: !i, iobBoundHi :: !i, iobBytes :: !Int, iobData :: !(ForeignPtr Word64) }
newArray_ :: Ix i => (i, i) -> IO (IOBitArray i)
newArray_ bs@(bl, bh) = do
let bits = rangeSize bs
nwords = (bits + 63) `shiftR` 6
bytes = nwords `shiftL` 3
p <- mallocForeignPtrBytes bytes
return IOB{ iobBoundLo = bl, iobBoundHi = bh, iobBytes = bytes, iobData = p }
getBounds :: Ix i => IOBitArray i -> IO (i, i)
getBounds a = return (iobBoundLo a, iobBoundHi a)
freeze :: Ix i => IOBitArray i -> IO (BitArray i)
freeze a = B `fmap` copy a
unsafeFreeze :: Ix i => IOBitArray i -> IO (BitArray i)
unsafeFreeze a = B `fmap` return a
thaw :: Ix i => BitArray i -> IO (IOBitArray i)
thaw (B a) = copy a
unsafeThaw :: Ix i => BitArray i -> IO (IOBitArray i)
unsafeThaw (B a) = return a
copy :: Ix i => IOBitArray i -> IO (IOBitArray i)
copy a = do
b <- newArray_ =<< getBounds a
withForeignPtr (iobData a) $ \ap ->
withForeignPtr (iobData b) $ \bp ->
copyBytes bp ap (iobBytes b)
return b