{-# OPTIONS_HADDOCK hide #-}
{-|

Module      :  Data.Array.BitArray.Internal
Copyright   :  (c) Claude Heiland-Allen 2012
License     :  BSD3

Maintainer  :  claude@mathr.co.uk
Stability   :  unstable
Portability :  portable

Bit arrays internals.  Not exposed.

-}
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)

-- | The type of immutable bit arrays.
newtype BitArray i = B (IOBitArray i)

-- | The type of mutable bit arrays in the 'IO' monad.
data IOBitArray i = IOB{ forall i. IOBitArray i -> i
iobBoundLo :: !i, forall i. IOBitArray i -> i
iobBoundHi :: !i, forall i. IOBitArray i -> Int
iobBytes :: {-# UNPACK #-} !Int, forall i. IOBitArray i -> ForeignPtr Word64
iobData :: {-# UNPACK #-} !(ForeignPtr Word64) }

-- | Create a new array filled with unspecified initial values.
{-# INLINE newArray_ #-}
newArray_ :: Ix i => (i, i) {- ^ bounds -} -> IO (IOBitArray i)
newArray_ :: forall i. Ix i => (i, i) -> IO (IOBitArray i)
newArray_ bs :: (i, i)
bs@(i
bl, i
bh) = do
  let bits :: Int
bits = (i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i, i)
bs
      nwords :: Int
nwords = (Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6
      bytes :: Int
bytes = Int
nwords Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
3
  ForeignPtr Word64
p <- Int -> IO (ForeignPtr Word64)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
bytes
  IOBitArray i -> IO (IOBitArray i)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOB{ iobBoundLo :: i
iobBoundLo = i
bl, iobBoundHi :: i
iobBoundHi = i
bh, iobBytes :: Int
iobBytes = Int
bytes, iobData :: ForeignPtr Word64
iobData = ForeignPtr Word64
p }

-- | Get the bounds of a bit array.
{-# INLINE getBounds #-}
getBounds :: Ix i => IOBitArray i -> IO (i, i)
getBounds :: forall i. Ix i => IOBitArray i -> IO (i, i)
getBounds IOBitArray i
a = (i, i) -> IO (i, i)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOBitArray i -> i
forall i. IOBitArray i -> i
iobBoundLo IOBitArray i
a, IOBitArray i -> i
forall i. IOBitArray i -> i
iobBoundHi IOBitArray i
a)

-- | Snapshot the array into an immutable form.
{-# INLINE freeze #-}
freeze :: Ix i => IOBitArray i -> IO (BitArray i)
freeze :: forall i. Ix i => IOBitArray i -> IO (BitArray i)
freeze IOBitArray i
a = IOBitArray i -> BitArray i
forall i. IOBitArray i -> BitArray i
B (IOBitArray i -> BitArray i)
-> IO (IOBitArray i) -> IO (BitArray i)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IOBitArray i -> IO (IOBitArray i)
forall i. Ix i => IOBitArray i -> IO (IOBitArray i)
copy IOBitArray i
a

-- | Snapshot the array into an immutable form.  Unsafe when the source
--   array can be modified later.
{-# INLINE unsafeFreeze #-}
unsafeFreeze :: Ix i => IOBitArray i -> IO (BitArray i)
unsafeFreeze :: forall i. Ix i => IOBitArray i -> IO (BitArray i)
unsafeFreeze IOBitArray i
a = IOBitArray i -> BitArray i
forall i. IOBitArray i -> BitArray i
B (IOBitArray i -> BitArray i)
-> IO (IOBitArray i) -> IO (BitArray i)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IOBitArray i -> IO (IOBitArray i)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitArray i
a

-- | Convert an array from immutable form.
{-# INLINE thaw #-}
thaw :: Ix i => BitArray i -> IO (IOBitArray i)
thaw :: forall i. Ix i => BitArray i -> IO (IOBitArray i)
thaw (B IOBitArray i
a) = IOBitArray i -> IO (IOBitArray i)
forall i. Ix i => IOBitArray i -> IO (IOBitArray i)
copy IOBitArray i
a

-- | Convert an array from immutable form.  Unsafe to modify the result
--   unless the source array is never used later.
{-# INLINE unsafeThaw #-}
unsafeThaw :: Ix i => BitArray i -> IO (IOBitArray i)
unsafeThaw :: forall i. Ix i => BitArray i -> IO (IOBitArray i)
unsafeThaw (B IOBitArray i
a) = IOBitArray i -> IO (IOBitArray i)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitArray i
a

-- | Copy an array.
{-# INLINE copy #-}
copy :: Ix i => IOBitArray i -> IO (IOBitArray i)
copy :: forall i. Ix i => IOBitArray i -> IO (IOBitArray i)
copy IOBitArray i
a = do
  IOBitArray i
b <- (i, i) -> IO (IOBitArray i)
forall i. Ix i => (i, i) -> IO (IOBitArray i)
newArray_ ((i, i) -> IO (IOBitArray i)) -> IO (i, i) -> IO (IOBitArray i)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IOBitArray i -> IO (i, i)
forall i. Ix i => IOBitArray i -> IO (i, i)
getBounds IOBitArray i
a
  ForeignPtr Word64 -> (Ptr Word64 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (IOBitArray i -> ForeignPtr Word64
forall i. IOBitArray i -> ForeignPtr Word64
iobData IOBitArray i
a) ((Ptr Word64 -> IO ()) -> IO ()) -> (Ptr Word64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
ap ->
    ForeignPtr Word64 -> (Ptr Word64 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (IOBitArray i -> ForeignPtr Word64
forall i. IOBitArray i -> ForeignPtr Word64
iobData IOBitArray i
b) ((Ptr Word64 -> IO ()) -> IO ()) -> (Ptr Word64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
bp ->
      Ptr Word64 -> Ptr Word64 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word64
bp Ptr Word64
ap (IOBitArray i -> Int
forall i. IOBitArray i -> Int
iobBytes IOBitArray i
b)
  IOBitArray i -> IO (IOBitArray i)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOBitArray i
b