{-# OPTIONS_HADDOCK hide #-}
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{ 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) }
{-# INLINE newArray_ #-}
newArray_ :: Ix i => (i, i) -> 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 }
{-# 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)
{-# 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
{-# 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
{-# 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
{-# 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
{-# 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