    {-|

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

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

    Unboxed mutable bit arrays in the 'IO' monad.

    -}
    module Data.Array.BitArray.IO
      ( IOBitArray()
      -- * MArray-like interface.
      , getBounds
      , newArray
      , newArray_
      , newListArray
      , readArray
      , writeArray
      , mapArray
      , mapIndices
      , getElems
      , getAssocs
      -- * Conversion to/from immutable bit arrays.
      , freeze
      , thaw
      -- * Construction
      , copy
      , fill
      -- * Short-circuiting reductions.
      , or
      , and
      , isUniform
      , elemIndex
      -- * Aggregate operations.
      , fold
      , map
      , zipWith
      , popCount
      -- * Unsafe.
      , unsafeReadArray
      , unsafeGetElems
      , unsafeFreeze
      , unsafeThaw
      ) where

    import Prelude hiding (and, or, map, zipWith)

    import Control.Monad (forM_, when)
    import Data.Bits (shiftL, shiftR, testBit, setBit, clearBit, (.&.), complement)
    import qualified Data.Bits
    import Data.Ix (Ix, index, inRange, range, rangeSize)
    import Data.List (foldl1')
    import Data.Word (Word8, Word64)
    import Foreign.ForeignPtr (withForeignPtr, touchForeignPtr)
    import Foreign.Ptr (Ptr, plusPtr, castPtr)
    import Foreign.Storable (poke, pokeByteOff, pokeElemOff, peekByteOff, peekElemOff)
    import System.IO.Unsafe (unsafeInterleaveIO)

    import Data.Bits.Bitwise (packWord8LE, mask)
    import qualified Data.Bits.Bitwise as Bitwise

    import Data.Array.BitArray.Internal
      ( IOBitArray(..)
      , getBounds
      , newArray_
      , freeze
      , unsafeFreeze
      , thaw
      , unsafeThaw
      , copy
      )

    -- | Create a new array filled with an initial value.
    {-# INLINE newArray #-}
    newArray :: Ix i => (i, i) {- ^ bounds -} -> Bool {- ^ initial value -} -> IO (IOBitArray i)
    newArray :: forall i. Ix i => (i, i) -> Bool -> IO (IOBitArray i)
    newArray (i, i)
    bs Bool
    b = do
      a <- (i, i) -> IO (IOBitArray i)
    forall i. Ix i => (i, i) -> IO (IOBitArray i)
    newArray_ (i, i)
    bs
      fill a b
      return a

    -- | Create a new array filled with values from a list.
    {-# INLINE newListArray #-}
    newListArray :: Ix i => (i, i) {- ^ bounds -} -> [Bool] {- ^ elems -} -> IO (IOBitArray i)
    newListArray :: forall i. Ix i => (i, i) -> [Bool] -> IO (IOBitArray i)
    newListArray (i, i)
    bs [Bool]
    es = do
      a <- (i, i) -> IO (IOBitArray i)
    forall i. Ix i => (i, i) -> IO (IOBitArray i)
    newArray_ (i, i)
    bs
      let byteBits = Int
    8
          writeBytes :: Ptr Word8 -> [Bool] -> IO ()
          writeBytes Ptr Word8
    p (Bool
    b0:Bool
    b1:Bool
    b2:Bool
    b3:Bool
    b4:Bool
    b5:Bool
    b6:Bool
    b7:[Bool]
    rest) = do
            Ptr Word8 -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr Word8
    p (Bool
    -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
    packWord8LE Bool
    b0 Bool
    b1 Bool
    b2 Bool
    b3 Bool
    b4 Bool
    b5 Bool
    b6 Bool
    b7)
            Ptr Word8 -> [Bool] -> IO ()
    writeBytes (Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    plusPtr Ptr Word8
    p Int
    1) [Bool]
    rest
          writeBytes Ptr Word8
    _ [] = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          writeBytes Ptr Word8
    p [Bool]
    rest = Ptr Word8 -> [Bool] -> IO ()
    writeBytes Ptr Word8
    p (Int -> [Bool] -> [Bool]
    forall a. Int -> [a] -> [a]
    take Int
    byteBits ([Bool]
    rest [Bool] -> [Bool] -> [Bool]
    forall a. [a] -> [a] -> [a]
    ++ Bool -> [Bool]
    forall a. a -> [a]
    repeat Bool
    False))
      withForeignPtr (iobData a) $ \Ptr Word64
    p -> do
        Ptr Word8 -> [Bool] -> IO ()
    writeBytes (Ptr Word64 -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word64
    p) (Int -> [Bool] -> [Bool]
    forall a. Int -> [a] -> [a]
    take (Int
    byteBits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * IOBitArray i -> Int
    forall i. IOBitArray i -> Int
    iobBytes IOBitArray i
    a) [Bool]
    es)
      return a

    -- | Read from an array at an index.
    {-# INLINE readArray #-}
    readArray :: Ix i => IOBitArray i -> i -> IO Bool
    readArray :: forall i. Ix i => IOBitArray i -> i -> IO Bool
    readArray IOBitArray i
    a i
    i = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      when (not (inRange bs i)) $ error "array index out of bounds"
      readArrayRaw a (index bs i)

    -- | Read from an array at an index without bounds checking.  Unsafe.
    {-# INLINE unsafeReadArray #-}
    unsafeReadArray :: Ix i => IOBitArray i -> i -> IO Bool
    unsafeReadArray :: forall i. Ix i => IOBitArray i -> i -> IO Bool
    unsafeReadArray IOBitArray i
    a i
    i = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      readArrayRaw a (index bs i)

    {-# INLINE readArrayRaw #-}
    readArrayRaw :: Ix i => IOBitArray i -> Int -> IO Bool
    readArrayRaw :: forall i. Ix i => IOBitArray i -> Int -> IO Bool
    readArrayRaw IOBitArray i
    a Int
    n = do
      let byte :: Int
    byte = Int
    n Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    3
          bit :: Int
    bit = Int
    n Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    7
      ForeignPtr Word64 -> (Ptr Word64 -> IO Bool) -> IO Bool
    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 Bool) -> IO Bool)
    -> (Ptr Word64 -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word64
    p -> do
        b0 <- Ptr Word64 -> Int -> IO Word8
    forall b. Ptr b -> Int -> IO Word8
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr Word64
    p Int
    byte
        return (testBit (b0 :: Word8) bit)

    -- | Write to an array at an index.
    {-# INLINE writeArray #-}
    writeArray :: Ix i => IOBitArray i -> i -> Bool -> IO ()
    writeArray :: forall i. Ix i => IOBitArray i -> i -> Bool -> IO ()
    writeArray IOBitArray i
    a i
    i Bool
    b = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      when (not (inRange bs i)) $ error "array index out of bounds"
      let n = (i, i) -> i -> Int
    forall a. Ix a => (a, a) -> a -> Int
    index (i, i)
    bs i
    i
          byte = Int
    n Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    3
          bit = Int
    n Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    7
      withForeignPtr (iobData a) $ \Ptr Word64
    p -> do
        b0 <- Ptr Word64 -> Int -> IO Word8
    forall b. Ptr b -> Int -> IO Word8
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr Word64
    p Int
    byte
        let b1 = (if Bool
    b then Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    setBit else Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    clearBit) (Word8
    b0 :: Word8) Int
    bit
        pokeByteOff p byte b1

    -- | Alias for 'map'.
    {-# INLINE mapArray #-}
    mapArray :: Ix i => (Bool -> Bool) -> IOBitArray i -> IO (IOBitArray i)
    mapArray :: forall i.
    Ix i =>
    (Bool -> Bool) -> IOBitArray i -> IO (IOBitArray i)
    mapArray = (Bool -> Bool) -> IOBitArray i -> IO (IOBitArray i)
    forall i.
    Ix i =>
    (Bool -> Bool) -> IOBitArray i -> IO (IOBitArray i)
    map

    -- unsafeInterleaveIO is used to avoid having to create the whole list in
    -- memory before the function can return, but need to keep the ForeignPtr
    -- alive to avoid GC stealing our data.
    interleavedMapMThenTouch :: Ix i => IOBitArray i -> (a -> IO b) -> [a] -> IO [b]
    interleavedMapMThenTouch :: forall i a b. Ix i => IOBitArray i -> (a -> IO b) -> [a] -> IO [b]
    interleavedMapMThenTouch IOBitArray i
    a a -> IO b
    _ [] = ForeignPtr Word64 -> IO ()
    forall a. ForeignPtr a -> IO ()
    touchForeignPtr (IOBitArray i -> ForeignPtr Word64
    forall i. IOBitArray i -> ForeignPtr Word64
    iobData IOBitArray i
    a) IO () -> IO [b] -> IO [b]
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [b] -> IO [b]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    interleavedMapMThenTouch IOBitArray i
    a a -> IO b
    f (a
    x:[a]
    xs) = IO [b] -> IO [b]
    forall a. IO a -> IO a
    unsafeInterleaveIO (IO [b] -> IO [b]) -> IO [b] -> IO [b]
    forall a b. (a -> b) -> a -> b
    $ do
      y <- a -> IO b
    f a
    x
      ys <- interleavedMapMThenTouch a f xs
      return (y:ys)

    -- | Create a new array by reading from another.
    {-# INLINE mapIndices #-}
    mapIndices :: (Ix i, Ix j) => (i, i) {- ^ new bounds -} -> (i -> j) {- ^ index transformation -} -> IOBitArray j {- ^ source array -} -> IO (IOBitArray i)
    mapIndices :: forall i j.
    (Ix i, Ix j) =>
    (i, i) -> (i -> j) -> IOBitArray j -> IO (IOBitArray i)
    mapIndices (i, i)
    bs i -> j
    h IOBitArray j
    a = (i, i) -> [Bool] -> IO (IOBitArray i)
    forall i. Ix i => (i, i) -> [Bool] -> IO (IOBitArray i)
    newListArray (i, i)
    bs ([Bool] -> IO (IOBitArray i)) -> IO [Bool] -> IO (IOBitArray i)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IOBitArray j -> (i -> IO Bool) -> [i] -> IO [Bool]
    forall i a b. Ix i => IOBitArray i -> (a -> IO b) -> [a] -> IO [b]
    interleavedMapMThenTouch IOBitArray j
    a (IOBitArray j -> j -> IO Bool
    forall i. Ix i => IOBitArray i -> i -> IO Bool
    readArray IOBitArray j
    a (j -> IO Bool) -> (i -> j) -> i -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . i -> j
    h) ((i, i) -> [i]
    forall a. Ix a => (a, a) -> [a]
    range (i, i)
    bs)

    -- | Get a list of all elements of an array.
    {-# INLINE getElems #-}
    getElems :: Ix i => IOBitArray i -> IO [Bool]
    getElems :: forall i. Ix i => IOBitArray i -> IO [Bool]
    getElems IOBitArray i
    a = IOBitArray i -> IO [Bool]
    forall i. Ix i => IOBitArray i -> IO [Bool]
    unsafeGetElems (IOBitArray i -> IO [Bool]) -> IO (IOBitArray i) -> IO [Bool]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IOBitArray i -> IO (IOBitArray i)
    forall i. Ix i => IOBitArray i -> IO (IOBitArray i)
    copy IOBitArray i
    a

    -- | Get a list of all elements of an array.  Unsafe when the source
    --   array can be modified later.
    {-# INLINE unsafeGetElems #-}
    unsafeGetElems :: Ix i => IOBitArray i -> IO [Bool]
    unsafeGetElems :: forall i. Ix i => IOBitArray i -> IO [Bool]
    unsafeGetElems IOBitArray i
    a' = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a'
      let r = (i, i) -> Int
    forall a. Ix a => (a, a) -> Int
    rangeSize (i, i)
    bs
          count = (Int
    r Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    7) Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    3
      p <- withForeignPtr (iobData a') $ return
      bytes <- interleavedMapMThenTouch a' (peekByteOff p) [0 .. count - 1]
      return . take r . concatMap Bitwise.toListLE $ (bytes :: [Word8])

    -- | Get a list of all (index, element) pairs.
    {-# INLINE getAssocs #-}
    getAssocs :: Ix i => IOBitArray i -> IO [(i, Bool)]
    getAssocs :: forall i. Ix i => IOBitArray i -> IO [(i, Bool)]
    getAssocs IOBitArray i
    a = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      zip (range bs) `fmap` getElems a

    -- | Fill an array with a uniform value.
    {-# INLINE fill #-}
    fill :: Ix i => IOBitArray i -> Bool -> IO ()
    fill :: forall i. Ix i => IOBitArray i -> Bool -> IO ()
    fill IOBitArray i
    a Bool
    b = do
      let count :: Int
    count = IOBitArray i -> Int
    forall i. IOBitArray i -> Int
    iobBytes IOBitArray i
    a Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    3
          word :: Word64
          word :: Word64
    word = if Bool
    b then Word64 -> Word64
    forall a. Bits a => a -> a
    complement Word64
    0 else Word64
    0
      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
    p ->
        [Int] -> (Int -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    i ->
          Ptr Word64 -> Int -> Word64 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word64
    p Int
    i Word64
    word

    -- | Short-circuit bitwise reduction: True when any bit is True.
    {-# INLINE or #-}
    or :: Ix i => IOBitArray i -> IO Bool
    or :: forall i. Ix i => IOBitArray i -> IO Bool
    or IOBitArray i
    a = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      let total = (i, i) -> Int
    forall a. Ix a => (a, a) -> Int
    rangeSize (i, i)
    bs
          full = Int
    total Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int -> Int
    forall a. Bits a => a -> a
    complement (Int -> Int
    forall b. (Num b, Bits b) => Int -> b
    mask Int
    6)
          count = Int
    full Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    6
          loop :: Ptr Word64 -> Int -> IO Bool
          loop Ptr Word64
    p Int
    n
            | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    count = do
                w <- Ptr Word64 -> Int -> IO Word64
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word64
    p Int
    n
                if w /= (0 :: Word64) then return True else loop p (n + 1)
            | Bool
    otherwise = Int -> IO Bool
    rest Int
    full
          rest Int
    m
            | Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    total = do
                b <- IOBitArray i -> Int -> IO Bool
    forall i. Ix i => IOBitArray i -> Int -> IO Bool
    readArrayRaw IOBitArray i
    a Int
    m
                if b then return True else rest (m + 1)
            | Bool
    otherwise = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      withForeignPtr (iobData a) $ \Ptr Word64
    p -> Ptr Word64 -> Int -> IO Bool
    loop Ptr Word64
    p Int
    0

    -- | Short-circuit bitwise reduction: False when any bit is False.
    {-# INLINE and #-}
    and :: Ix i => IOBitArray i -> IO Bool
    and :: forall i. Ix i => IOBitArray i -> IO Bool
    and IOBitArray i
    a = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      let total = (i, i) -> Int
    forall a. Ix a => (a, a) -> Int
    rangeSize (i, i)
    bs
          full = Int
    total Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int -> Int
    forall a. Bits a => a -> a
    complement (Int -> Int
    forall b. (Num b, Bits b) => Int -> b
    mask Int
    6)
          count = Int
    full Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    6
          loop :: Ptr Word64 -> Int -> IO Bool
          loop Ptr Word64
    p Int
    n
            | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    count = do
                w <- Ptr Word64 -> Int -> IO Word64
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word64
    p Int
    n
                if w /= (complement 0 :: Word64) then return False else loop p (n + 1)
            | Bool
    otherwise = Int -> IO Bool
    rest Int
    full
          rest Int
    m
            | Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    total = do
                b <- IOBitArray i -> Int -> IO Bool
    forall i. Ix i => IOBitArray i -> Int -> IO Bool
    readArrayRaw IOBitArray i
    a Int
    m
                if not b then return False else rest (m + 1)
            | Bool
    otherwise = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      withForeignPtr (iobData a) $ \Ptr Word64
    p -> Ptr Word64 -> Int -> IO Bool
    loop Ptr Word64
    p Int
    0

    -- | Short-circuit bitwise reduction: 'Nothing' when any bits differ,
    --   'Just' when all bits are the same.
    {-# INLINE isUniform #-}
    isUniform :: Ix i => IOBitArray i -> IO (Maybe Bool)
    isUniform :: forall i. Ix i => IOBitArray i -> IO (Maybe Bool)
    isUniform IOBitArray i
    a = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      let total = (i, i) -> Int
    forall a. Ix a => (a, a) -> Int
    rangeSize (i, i)
    bs
          full = Int
    total Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int -> Int
    forall a. Bits a => a -> a
    complement (Int -> Int
    forall b. (Num b, Bits b) => Int -> b
    mask Int
    6)
          count = Int
    full Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    6
          loop :: Ptr Word64 -> Int -> Bool -> Bool -> IO (Maybe Bool)
          loop Ptr Word64
    p Int
    n Bool
    st Bool
    sf
            | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    count = do
                w <- Ptr Word64 -> Int -> IO Word64
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word64
    p Int
    n
                let t = Word64
    w Word64 -> Word64 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= (Word64
    0 :: Word64)  Bool -> Bool -> Bool
    || Bool
    st
                    f = Word64
    w Word64 -> Word64 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= (Word64 -> Word64
    forall a. Bits a => a -> a
    complement Word64
    0) Bool -> Bool -> Bool
    || Bool
    sf
                if t && f then return Nothing else loop p (n + 1) t f
            | Bool
    otherwise = Int -> Bool -> Bool -> IO (Maybe Bool)
    rest Int
    full Bool
    st Bool
    sf
          rest Int
    m Bool
    st Bool
    sf
            | Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    total = do
                b <- IOBitArray i -> Int -> IO Bool
    forall i. Ix i => IOBitArray i -> Int -> IO Bool
    readArrayRaw IOBitArray i
    a Int
    m
                let t =     Bool
    b Bool -> Bool -> Bool
    || Bool
    st
                    f = Bool -> Bool
    not Bool
    b Bool -> Bool -> Bool
    || Bool
    sf
                if t && f then return Nothing else rest (m + 1) t f
            | Bool
    st Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    sf = Maybe Bool -> IO (Maybe Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True)
            | Bool -> Bool
    not Bool
    st Bool -> Bool -> Bool
    && Bool
    sf = Maybe Bool -> IO (Maybe Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False)
            | Bool
    otherwise = Maybe Bool -> IO (Maybe Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Bool
    forall a. Maybe a
    Nothing
      withForeignPtr (iobData a) $ \Ptr Word64
    p -> Ptr Word64 -> Int -> Bool -> Bool -> IO (Maybe Bool)
    loop Ptr Word64
    p Int
    0 Bool
    False Bool
    False

    -- | Look up index of first matching bit.
    --
    --   Note that the index type is limited to Int because there
    --   is no 'unindex' method in the 'Ix' class.
    {-# INLINE elemIndex #-}
    elemIndex :: Bool -> IOBitArray Int -> IO (Maybe Int)
    elemIndex :: Bool -> IOBitArray Int -> IO (Maybe Int)
    elemIndex Bool
    which IOBitArray Int
    a = do
      bs <- IOBitArray Int -> IO (Int, Int)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray Int
    a
      let skip :: Word64
          skip | Bool
    which = Word64
    0
               | Bool
    otherwise = Word64 -> Word64
    forall a. Bits a => a -> a
    complement Word64
    0
          total = (Int, Int) -> Int
    forall a. Ix a => (a, a) -> Int
    rangeSize (Int, Int)
    bs
          full = Int
    total Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int -> Int
    forall a. Bits a => a -> a
    complement (Int -> Int
    forall b. (Num b, Bits b) => Int -> b
    mask Int
    6)
          count = Int
    full Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    6
          loop :: Ptr Word64 -> Int -> IO (Maybe Int)
          loop Ptr Word64
    p Int
    n
            | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    count = do
                w <- Ptr Word64 -> Int -> IO Word64
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word64
    p Int
    n
                if w /= skip then rest (n `shiftL` 6) else loop p (n + 1)
            | Bool
    otherwise = Int -> IO (Maybe Int)
    rest Int
    full
          rest Int
    m
            | Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    total = do
                b <- IOBitArray Int -> Int -> IO Bool
    forall i. Ix i => IOBitArray i -> Int -> IO Bool
    readArrayRaw IOBitArray Int
    a Int
    m
                if b == which then return (Just (fst bs + m)) else rest (m + 1)
            | Bool
    otherwise = Maybe Int -> IO (Maybe Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Int
    forall a. Maybe a
    Nothing
      withForeignPtr (iobData a) $ \Ptr Word64
    p -> Ptr Word64 -> Int -> IO (Maybe Int)
    loop Ptr Word64
    p Int
    0

    -- | Bitwise reduction with an associative commutative boolean operator.
    --   Implementation lifts from 'Bool' to 'Bits' and folds large chunks
    --   at a time.  Each bit is used as a source exactly once.
    {-# INLINE fold #-}
    fold :: Ix i => (Bool -> Bool -> Bool) {- ^ operator -} -> IOBitArray i -> IO (Maybe Bool)
    fold :: forall i.
    Ix i =>
    (Bool -> Bool -> Bool) -> IOBitArray i -> IO (Maybe Bool)
    fold Bool -> Bool -> Bool
    f IOBitArray i
    a = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      let g = (Bool -> Bool -> Bool) -> Word64 -> Word64 -> Word64
    forall b. Bits b => (Bool -> Bool -> Bool) -> b -> b -> b
    Bitwise.zipWith Bool -> Bool -> Bool
    f
          total = (i, i) -> Int
    forall a. Ix a => (a, a) -> Int
    rangeSize (i, i)
    bs
          full = Int
    total Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int -> Int
    forall a. Bits a => a -> a
    complement (Int -> Int
    forall b. (Num b, Bits b) => Int -> b
    mask Int
    6)
          count = Int
    full Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    6
          loop :: Ptr Word64 -> Int -> Maybe Word64 -> IO (Maybe Bool)
          loop Ptr Word64
    p Int
    n Maybe Word64
    mw
            | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    count = do
                w <- Ptr Word64 -> Int -> IO Word64
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word64
    p Int
    n
                case mw of
                  Maybe Word64
    Nothing -> Ptr Word64 -> Int -> Maybe Word64 -> IO (Maybe Bool)
    loop Ptr Word64
    p (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Word64 -> Maybe Word64
    forall a. a -> Maybe a
    Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
    forall a b. (a -> b) -> a -> b
    $!      Word64
    w)
                  Just Word64
    w0 -> Ptr Word64 -> Int -> Maybe Word64 -> IO (Maybe Bool)
    loop Ptr Word64
    p (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Word64 -> Maybe Word64
    forall a. a -> Maybe a
    Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
    forall a b. (a -> b) -> a -> b
    $! Word64 -> Word64 -> Word64
    g Word64
    w0 Word64
    w)
            | Bool
    otherwise =
                case Maybe Word64
    mw of
                  Maybe Word64
    Nothing -> Int -> Maybe Bool -> IO (Maybe Bool)
    rest Int
    full Maybe Bool
    forall a. Maybe a
    Nothing
                  Just Word64
    w0 -> Int -> Maybe Bool -> IO (Maybe Bool)
    rest Int
    full (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
    forall a b. (a -> b) -> a -> b
    $! (Bool -> Bool -> Bool) -> [Bool] -> Bool
    forall a. HasCallStack => (a -> a -> a) -> [a] -> a
    foldl1' Bool -> Bool -> Bool
    f (Word64 -> [Bool]
    forall b. Bits b => b -> [Bool]
    Bitwise.toListLE Word64
    w0))
          rest Int
    m Maybe Bool
    mb
            | Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    total = do
                b <- IOBitArray i -> Int -> IO Bool
    forall i. Ix i => IOBitArray i -> Int -> IO Bool
    readArrayRaw IOBitArray i
    a Int
    m
                case mb of
                  Maybe Bool
    Nothing -> Int -> Maybe Bool -> IO (Maybe Bool)
    rest (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
    forall a b. (a -> b) -> a -> b
    $!      Bool
    b)
                  Just Bool
    b0 -> Int -> Maybe Bool -> IO (Maybe Bool)
    rest (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
    forall a b. (a -> b) -> a -> b
    $! Bool -> Bool -> Bool
    f Bool
    b0 Bool
    b)
            | Bool
    otherwise = Maybe Bool -> IO (Maybe Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Bool
    mb
      withForeignPtr (iobData a) $ \Ptr Word64
    p -> Ptr Word64 -> Int -> Maybe Word64 -> IO (Maybe Bool)
    loop Ptr Word64
    p Int
    0 Maybe Word64
    forall a. Maybe a
    Nothing

    -- | Bitwise map.  Implementation lifts from 'Bool' to 'Bits' and maps
    --   large chunks at a time.
    {-# INLINE map #-}
    map :: Ix i => (Bool -> Bool) -> IOBitArray i -> IO (IOBitArray i)
    map :: forall i.
    Ix i =>
    (Bool -> Bool) -> IOBitArray i -> IO (IOBitArray i)
    map Bool -> Bool
    f IOBitArray i
    a = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      b <- newArray_ bs
      mapTo b f a
      return b

    {-# INLINE mapTo #-}
    mapTo :: Ix i => IOBitArray i -> (Bool -> Bool) -> IOBitArray i -> IO ()
    mapTo :: forall i.
    Ix i =>
    IOBitArray i -> (Bool -> Bool) -> IOBitArray i -> IO ()
    mapTo IOBitArray i
    dst Bool -> Bool
    f IOBitArray i
    src = do
      -- {
      sbs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    src
      dbs <- getBounds dst
      when (sbs /= dbs) $ error "mapTo mismatched bounds"
      -- }
      let count = IOBitArray i -> Int
    forall i. IOBitArray i -> Int
    iobBytes IOBitArray i
    dst Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    3
          g :: Word64 -> Word64
          g = (Bool -> Bool) -> Word64 -> Word64
    forall b. Bits b => (Bool -> Bool) -> b -> b
    Bitwise.map Bool -> Bool
    f
      withForeignPtr (iobData src) $ \Ptr Word64
    sp ->
        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
    dst) ((Ptr Word64 -> IO ()) -> IO ()) -> (Ptr Word64 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word64
    dp ->
          [Int] -> (Int -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    n -> do
            Ptr Word64 -> Int -> Word64 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word64
    dp Int
    n (Word64 -> IO ()) -> (Word64 -> Word64) -> Word64 -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word64 -> Word64
    g (Word64 -> IO ()) -> IO Word64 -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Ptr Word64 -> Int -> IO Word64
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word64
    sp Int
    n

    -- | Bitwise zipWith.  Implementation lifts from 'Bool' to 'Bits' and
    --   combines large chunks at a time.
    --
    --   The bounds of the source arrays must be identical.
    {-# INLINE zipWith #-}
    zipWith :: Ix i => (Bool -> Bool -> Bool) -> IOBitArray i -> IOBitArray i -> IO (IOBitArray i)
    zipWith :: forall i.
    Ix i =>
    (Bool -> Bool -> Bool)
    -> IOBitArray i -> IOBitArray i -> IO (IOBitArray i)
    zipWith Bool -> Bool -> Bool
    f IOBitArray i
    l IOBitArray i
    r = do
      lbs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    l
      rbs <- getBounds r
      when (lbs /= rbs) $ error "zipWith mismatched bounds"
      c <- newArray_ lbs
      zipWithTo c f l r
      return c

    {-# INLINE zipWithTo #-}
    zipWithTo :: Ix i => IOBitArray i -> (Bool -> Bool -> Bool) -> IOBitArray i -> IOBitArray i -> IO ()
    zipWithTo :: forall i.
    Ix i =>
    IOBitArray i
    -> (Bool -> Bool -> Bool) -> IOBitArray i -> IOBitArray i -> IO ()
    zipWithTo IOBitArray i
    dst Bool -> Bool -> Bool
    f IOBitArray i
    l IOBitArray i
    r = do
      lbs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    l
      rbs <- getBounds r
      dbs <- getBounds dst
      when (lbs /= rbs || dbs /= lbs || dbs /= rbs) $ error "zipWithTo mismatched bounds"
      let count = IOBitArray i -> Int
    forall i. IOBitArray i -> Int
    iobBytes IOBitArray i
    dst Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    3
          g :: Word64 -> Word64 -> Word64
          g = (Bool -> Bool -> Bool) -> Word64 -> Word64 -> Word64
    forall b. Bits b => (Bool -> Bool -> Bool) -> b -> b -> b
    Bitwise.zipWith Bool -> Bool -> Bool
    f
      withForeignPtr (iobData l) $ \Ptr Word64
    lp ->
        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
    r) ((Ptr Word64 -> IO ()) -> IO ()) -> (Ptr Word64 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word64
    rp ->
          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
    dst) ((Ptr Word64 -> IO ()) -> IO ()) -> (Ptr Word64 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word64
    dp ->
              [Int] -> (Int -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    n -> do
                p <- Ptr Word64 -> Int -> IO Word64
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word64
    lp Int
    n
                q <- peekElemOff rp n
                pokeElemOff dp n (g p q)

    -- | Count set bits.
    {-# INLINE popCount #-}
    popCount :: Ix i => IOBitArray i -> IO Int
    popCount :: forall i. Ix i => IOBitArray i -> IO Int
    popCount IOBitArray i
    a = do
      bs <- IOBitArray i -> IO (i, i)
    forall i. Ix i => IOBitArray i -> IO (i, i)
    getBounds IOBitArray i
    a
      let total = (i, i) -> Int
    forall a. Ix a => (a, a) -> Int
    rangeSize (i, i)
    bs
          full = Int
    total Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int -> Int
    forall a. Bits a => a -> a
    complement (Int -> Int
    forall b. (Num b, Bits b) => Int -> b
    mask Int
    6)
          count = Int
    full Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    6
          loop :: Ptr Word64 -> Int -> Int -> IO Int
          loop Ptr Word64
    p Int
    n Int
    acc
            | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    count = Int
    acc Int -> IO Int -> IO Int
    forall a b. a -> b -> b
    `seq` do
                w <- Ptr Word64 -> Int -> IO Word64
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr Word64
    p Int
    n
                loop p (n + 1) (acc + Data.Bits.popCount w)
            | Bool
    otherwise = Int -> Int -> IO Int
    rest Int
    full Int
    acc
          rest Int
    m Int
    acc
            | Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    total = Int
    acc Int -> IO Int -> IO Int
    forall a b. a -> b -> b
    `seq` do
                b <- IOBitArray i -> Int -> IO Bool
    forall i. Ix i => IOBitArray i -> Int -> IO Bool
    readArrayRaw IOBitArray i
    a Int
    m
                rest (m + 1) (acc + fromEnum b)
            | Bool
    otherwise = Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    acc
      withForeignPtr (iobData a) $ \Ptr Word64
    p -> Ptr Word64 -> Int -> Int -> IO Int
    loop Ptr Word64
    p Int
    0 Int
    0