module Data.Array.BitArray
( BitArray()
, bounds
, array
, listArray
, accumArray
, (!)
, indices
, elems
, assocs
, (//)
, accum
, amap
, ixmap
, fill
, false
, true
, or
, and
, isUniform
, elemIndex
, fold
, map
, zipWith
, popCount
, (!?)
, (!!!)
) where
import Prelude hiding (and, or, map, zipWith)
import qualified Prelude as P
import Control.Monad (forM_)
import Control.Monad.ST (runST)
import Data.Ix (Ix, range, inRange)
import Data.Array.BitArray.Internal (BitArray)
import qualified Data.Array.BitArray.ST as ST
{-# INLINE bounds #-}
bounds :: Ix i => BitArray i -> (i, i)
bounds a = runST (ST.getBounds =<< ST.unsafeThaw a)
{-# INLINE array #-}
array :: Ix i => (i, i) -> [(i, Bool)] -> BitArray i
array bs ies = false bs // ies
{-# INLINE listArray #-}
listArray :: Ix i => (i, i) -> [Bool] -> BitArray i
listArray bs es = runST (ST.unsafeFreeze =<< ST.newListArray bs es)
{-# INLINE accumArray #-}
accumArray :: Ix i => (Bool -> a -> Bool) -> Bool -> (i, i) -> [(i, a)] -> BitArray i
accumArray f d bs = accum f (fill bs d)
{-# INLINE (!) #-}
(!) :: Ix i => BitArray i -> i -> Bool
a ! i = runST (do
a' <- ST.unsafeThaw a
ST.readArray a' i)
{-# INLINE (!!!) #-}
(!!!) :: Ix i => BitArray i -> i -> Bool
a !!! i = runST (do
a' <- ST.unsafeThaw a
ST.unsafeReadArray a' i)
{-# INLINE indices #-}
indices :: Ix i => BitArray i -> [i]
indices = range . bounds
{-# INLINE elems #-}
elems :: Ix i => BitArray i -> [Bool]
elems a = runST (ST.unsafeGetElems =<< ST.unsafeThaw a)
{-# INLINE assocs #-}
assocs :: Ix i => BitArray i -> [(i, Bool)]
assocs ba = P.map (\i -> (i, ba ! i)) (indices ba)
{-# INLINE (//) #-}
(//) :: Ix i => BitArray i -> [(i, Bool)] -> BitArray i
ba // ies = accum (\_ a -> a) ba ies
{-# INLINE accum #-}
accum :: Ix i => (Bool -> a -> Bool) -> BitArray i -> [(i, a)] -> BitArray i
accum f a ies = runST (do
a' <- ST.thaw a
forM_ ies $ \(i, x) -> do
b <- ST.readArray a' i
ST.writeArray a' i (f b x)
ST.unsafeFreeze a')
{-# INLINE amap #-}
amap :: Ix i => (Bool -> Bool) -> BitArray i -> BitArray i
amap = map
{-# INLINE ixmap #-}
ixmap :: (Ix i, Ix j) => (i, i) -> (i -> j) -> BitArray j -> BitArray i
ixmap bs h ba = array bs (P.map (\i -> (i, ba ! h i)) (range bs))
{-# INLINE fill #-}
fill :: Ix i => (i, i) -> Bool -> BitArray i
fill bs b = runST (ST.unsafeFreeze =<< ST.newArray bs b)
{-# INLINE false #-}
false :: Ix i => (i, i) -> BitArray i
false bs = fill bs False
{-# INLINE true #-}
true :: Ix i => (i, i) -> BitArray i
true bs = fill bs True
{-# INLINE (!?) #-}
(!?) :: Ix i => BitArray i -> i -> Maybe Bool
b !? i
| inRange (bounds b) i = Just (b ! i)
| otherwise = Nothing
{-# INLINE or #-}
or :: Ix i => BitArray i -> Bool
or a = runST (ST.or =<< ST.unsafeThaw a)
{-# INLINE and #-}
and :: Ix i => BitArray i -> Bool
and a = runST (ST.and =<< ST.unsafeThaw a)
{-# INLINE isUniform #-}
isUniform :: Ix i => BitArray i -> Maybe Bool
isUniform a = runST (ST.isUniform =<< ST.unsafeThaw a)
{-# INLINE elemIndex #-}
elemIndex :: Bool -> BitArray Int -> Maybe Int
elemIndex b a = runST (ST.elemIndex b =<< ST.unsafeThaw a)
{-# INLINE fold #-}
fold :: Ix i => (Bool -> Bool -> Bool) -> BitArray i -> Maybe Bool
fold f a = runST (ST.fold f =<< ST.unsafeThaw a)
{-# INLINE map #-}
map :: Ix i => (Bool -> Bool) -> BitArray i -> BitArray i
map f a = runST (ST.unsafeFreeze =<< ST.map f =<< ST.unsafeThaw a)
{-# INLINE zipWith #-}
zipWith :: Ix i => (Bool -> Bool -> Bool) -> BitArray i -> BitArray i -> BitArray i
zipWith f a b
| bounds a == bounds b = runST (do
a' <- ST.unsafeThaw a
b' <- ST.unsafeThaw b
ST.unsafeFreeze =<< ST.zipWith f a' b')
| otherwise = error "zipWith bounds mismatch"
{-# INLINE popCount #-}
popCount :: Ix i => BitArray i -> Int
popCount a = runST (ST.popCount =<< ST.unsafeThaw a)