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