{-# LANGUAGE CPP #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Streamly.Internal.Data.MutArray.Type
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD3-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Pinned and unpinned mutable array for 'Unboxed' types. Fulfils the following
-- goals:
--
-- * Random access (array)
-- * Efficient storage (unboxed)
-- * Performance (unboxed access)
-- * Performance - in-place operations (mutable)
-- * Performance - GC (pinned, mutable)
-- * interfacing with OS (pinned)
--
-- Stream and Fold APIs allow easy, efficient and convenient operations on
-- arrays.
--
-- Mutable arrays and file system files are quite similar, they can grow and
-- their content is mutable. Therefore, both have similar APIs as well. We
-- strive to keep the API consistent for both. Ideally, you should be able to
-- replace one with another with little changes to the code.

module Streamly.Internal.Data.MutArray.Type
    (
    -- ** Type
    -- $arrayNotes
      MutArray (..)

    -- ** Conversion
    -- *** Pinned and Unpinned
    , pin
    , unpin
    , isPinned

    -- ** Casting
    , cast
    , castUnsafe -- XXX unsafeCast
    , asBytes
    , unsafePinnedAsPtr
    , unsafeAsPtr

    -- ** Construction
    , empty

    -- *** New
    -- | New arrays are always empty arrays with some reserve capacity to
    -- extend the length without reallocating.
    , emptyOf
    , newArrayWith -- emptyAlignedWith
    , pinnedEmptyOf
    , pinnedNewAligned -- XXX not required
    -- , new -- uninitialized array of specified length

    -- *** Cloning
    , clone
    , pinnedClone

    -- *** Slicing
    -- | Get a subarray without copying
    , getSliceUnsafe -- XXX unsafeGetSlice
    , getSlice
    , splitAt -- XXX should be able to express using getSlice
    , breakOn

    -- *** Stream Folds
    , ArrayUnsafe (..)
    , unsafeCreateOfWith
    , unsafeCreateOf
    , unsafePinnedCreateOf
    , pinnedCreateOf
    , createOfWith
    , createOf
    , revCreateOf

    , pinnedCreate
    , createWith
    , create
    -- , revCreate

    -- *** From containers
    , fromListN
    , pinnedFromListN
    , fromList
    , pinnedFromList
    , fromListRevN
    , fromListRev
    , fromStreamN
    , fromStream
    , fromPureStreamN
    , fromPureStream
    , fromByteStr#
    , fromPtrN
    , fromChunksK
    , fromChunksRealloced -- fromSmallChunks

    -- ** Random writes
    , putIndex
    , putIndexUnsafe -- XXX unsafePutIndex
    , putIndices
    -- , putFromThenTo
    -- , putFrom -- start writing at the given position
    -- , putUpto -- write from beginning up to the given position
    -- , putFromTo
    -- , putFromRev
    -- , putUptoRev
    , modifyIndexUnsafe -- XXX unsafeModifyIndex
    , modifyIndex
    , modifyIndices
    , modify
    , swapIndices
    , unsafeSwapIndices

    -- ** Reading

    -- *** Indexing
    , getIndex
    , getIndexUnsafe -- XXX unsafeGetIndex
    -- , getFromThenTo
    , getIndexRev -- getRevIndex?
    , indexReader
    , indexReaderWith

    -- *** To Streams
    , read
    , readRev
    , toStreamWith
    , toStreamRevWith
    , toStreamK
    , toStreamKWith
    , toStreamKRev
    , toStreamKRevWith

    -- *** To Containers
    , toList

    -- *** Unfolds
    -- experimental
    , producerWith
    , producer

    , reader
    , readerRevWith
    , readerRev

    -- ** Size and Capacity
    -- *** Size
    , length
    , byteLength

    -- *** Capacity
    -- , capacity
    , byteCapacity
    , bytesFree

    -- *** Capacity Management
    , blockSize
    , arrayChunkBytes
    , allocBytesToElemCount
    , realloc -- this is "resize"
    , grow
    , growExp
    , rightSize

    -- ** Folding
    , foldl'
    , foldr
    , byteCmp
    , byteEq

    -- ** In-place Mutation Algorithms
    , strip
    , reverse
    , permute
    , partitionBy
    , shuffleBy
    , divideBy
    , mergeBy
    , bubble

    -- ** Growing and Shrinking
    -- | Arrays grow only at the end, though it is possible to grow on both
    -- sides and therefore have a cons as well as snoc. But that will require
    -- both lower and upper bound in the array representation.

    -- *** Appending elements
    , snocWith
    , snoc
    , snocLinear
    , snocMay
    , snocUnsafe -- XXX unsafeSnoc

    -- *** Appending streams
    , unsafeAppendN
    , appendN
    , appendWith
    , append

    -- *** Appending arrays
    , spliceCopy
    , spliceWith
    , splice
    , spliceExp
    , spliceUnsafe -- XXX unsafeSplice
    -- , putSlice
    -- , appendSlice
    -- , appendSliceFrom

    -- ** Serialization using Unbox
    , pokeAppend
    , pokeAppendMay
    , pokeSkipUnsafe -- unsafePokeSkip

    -- ** Deserialization using Unbox
    , peekUncons
    , peekUnconsUnsafe -- unsafePeekUncons
    , peekSkipUnsafe -- unsafePeekSkip

    -- Arrays of arrays
    --  We can add dimensionality parameter to the array type to get
    --  multidimensional arrays. Multidimensional arrays would just be a
    --  convenience wrapper on top of single dimensional arrays.

    -- ** Streams of Arrays
    -- *** Chunk
    -- | Group a stream into arrays.
    , chunksOf
    , pinnedChunksOf
    , buildChunks

    -- *** Split
    -- | Split an array into slices.

    -- , getSlicesFromLenN
    , splitOn
    -- , slicesOf

    -- *** Concat
    -- | Append the arrays in a stream to form a stream of elements.
    , concatWith
    , concatRevWith
    , concat
    , concatRev

    -- *** Compact
    -- | Append the arrays in a stream to form a stream of larger arrays.
    , SpliceState (..)
    , pCompactLE
    , pPinnedCompactLE
    , compactLeAs
    , fCompactGE
    , fPinnedCompactGE
    , lCompactGE
    , lPinnedCompactGE
    , compactGE
    , compactEQ

    -- ** Utilities
    , roundUpToPower2
    , memcpy
    , memcmp
    , c_memchr

    -- * Deprecated
    , asPtrUnsafe
    , writeChunks
    , flattenArrays
    , flattenArraysRev
    , fromArrayStreamK
    , fromStreamDN
    , fromStreamD
    , cmp
    , getIndices
    , getIndicesWith
    , resize
    , resizeExp
    , nil
    , new
    , pinnedNew
    , pinnedNewBytes
    , writeAppendNUnsafe
    , writeAppendN
    , writeAppendWith
    , writeAppend
    , writeNWithUnsafe
    , writeNWith
    , writeNUnsafe
    , pinnedWriteNUnsafe
    , writeN
    , pinnedWriteN
    , pinnedWriteNAligned -- XXX not required
    , writeWith
    , write
    , pinnedWrite
    , writeRevN
    )
where

#include "assert.hs"
#include "inline.hs"
#include "ArrayMacros.h"
#include "MachDeps.h"

import Control.Monad (when, void)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bifunctor (first)
import Data.Bits (shiftR, (.|.), (.&.))
import Data.Functor.Identity (Identity(..))
import Data.Proxy (Proxy(..))
import Data.Word (Word8)
import Foreign.C.Types (CSize(..), CInt(..))
import Foreign.Ptr (plusPtr, minusPtr, nullPtr)
import Streamly.Internal.Data.MutByteArray.Type
    ( MutByteArray(..)
    , PinnedState(..)
    , getMutableByteArray#
    , putSliceUnsafe
    )
import Streamly.Internal.Data.Unbox (Unbox(..))
import GHC.Base
    ( IO(..)
    , Int(..)
    , compareByteArrays#
    , copyMutableByteArray#
    )
import GHC.Base (noinline)
import GHC.Exts (unsafeCoerce#, Addr#)
import GHC.Ptr (Ptr(..))

import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Producer.Type (Producer (..))
import Streamly.Internal.Data.Stream.Type (Stream)
import Streamly.Internal.Data.Parser.Type (Parser (..))
import Streamly.Internal.Data.StreamK.Type (StreamK)
import Streamly.Internal.Data.SVar.Type (adaptState, defState)
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)

import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed
import qualified Streamly.Internal.Data.Parser.Type as Parser
-- import qualified Streamly.Internal.Data.Fold.Type as Fold
import qualified Streamly.Internal.Data.Producer as Producer
import qualified Streamly.Internal.Data.Stream.Type as D
import qualified Streamly.Internal.Data.Stream.Lift as D
import qualified Streamly.Internal.Data.StreamK.Type as K
import qualified Prelude

import Prelude hiding
    (Foldable(..), concat, read, unlines, splitAt, reverse, truncate)

#include "DocTestDataMutArray.hs"

-------------------------------------------------------------------------------
-- Foreign helpers
-------------------------------------------------------------------------------

-- NOTE: Have to be "ccall unsafe" so that we can pass unpinned memory to these
foreign import ccall unsafe "string.h memcpy" c_memcpy
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)

foreign import ccall unsafe "string.h memchr" c_memchr
    :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)

foreign import ccall unsafe "string.h memcmp" c_memcmp
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt

foreign import ccall unsafe "string.h strlen" c_strlen
    :: Ptr Word8 -> IO CSize

-- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return
-- how many elements of that type will completely fit in those bytes.
--
{-# INLINE bytesToElemCount #-}
bytesToElemCount :: forall a. Unbox a => a -> Int -> Int
bytesToElemCount :: forall a. Unbox a => a -> Int -> Int
bytesToElemCount a
_ Int
n = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` SIZE_OF(a)

-- XXX we are converting Int to CSize
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
src Int
len = IO (Ptr Word8) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
c_memcpy Ptr Word8
dst Ptr Word8
src (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

-- XXX we are converting Int to CSize
-- return True if the memory locations have identical contents
{-# INLINE memcmp #-}
memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
memcmp Ptr Word8
p1 Ptr Word8
p2 Int
len = do
    CInt
r <- Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
c_memcmp Ptr Word8
p1 Ptr Word8
p2 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0

-------------------------------------------------------------------------------
-- MutArray Data Type
-------------------------------------------------------------------------------

-- $arrayNotes
--
-- We can use an 'Unboxed' constraint in the MutArray type and the constraint
-- can be automatically provided to a function that pattern matches on the
-- MutArray type. However, it has huge performance cost, so we do not use it.
-- Investigate a GHC improvement possiblity.

-- | An unboxed mutable array. An array is created with a given length
-- and capacity. Length is the number of valid elements in the array.  Capacity
-- is the maximum number of elements that the array can be expanded to without
-- having to reallocate the memory.
--
-- The elements in the array can be mutated in-place without changing the
-- reference (constructor). However, the length of the array cannot be mutated
-- in-place.  A new array reference is generated when the length changes.  When
-- the length is increased (upto the maximum reserved capacity of the array),
-- the array is not reallocated and the new reference uses the same underlying
-- memory as the old one.
--
-- Several routines in this module allow the programmer to control the capacity
-- of the array. The programmer can control the trade-off between memory usage
-- and performance impact due to reallocations when growing or shrinking the
-- array.
--
data MutArray a =
#ifdef DEVBUILD
    Unbox a =>
#endif
    -- The array is a range into arrContents. arrContents may be a superset of
    -- the slice represented by the array. All offsets are in bytes.
    MutArray
    { forall a. MutArray a -> MutByteArray
arrContents :: {-# UNPACK #-} !MutByteArray
    , forall a. MutArray a -> Int
arrStart :: {-# UNPACK #-} !Int  -- ^ index into arrContents
    , forall a. MutArray a -> Int
arrEnd   :: {-# UNPACK #-} !Int    -- ^ index into arrContents
                                       -- Represents the first invalid index of
                                       -- the array.
    , forall a. MutArray a -> Int
arrBound :: {-# UNPACK #-} !Int    -- ^ first invalid index of arrContents.
    }

-------------------------------------------------------------------------------
-- Pinning & Unpinning
-------------------------------------------------------------------------------

-- | Return a copy of the array in pinned memory if unpinned, else return the
-- original array.
{-# INLINE pin #-}
pin :: MutArray a -> IO (MutArray a)
pin :: forall a. MutArray a -> IO (MutArray a)
pin arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    if MutByteArray -> Bool
Unboxed.isPinned MutByteArray
arrContents
    then MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutArray a
arr
    else MutArray a -> IO (MutArray a)
forall (m :: * -> *) a. MonadIO m => MutArray a -> m (MutArray a)
pinnedClone MutArray a
arr

-- | Return a copy of the array in unpinned memory if pinned, else return the
-- original array.
{-# INLINE unpin #-}
unpin :: MutArray a -> IO (MutArray a)
unpin :: forall a. MutArray a -> IO (MutArray a)
unpin arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    if MutByteArray -> Bool
Unboxed.isPinned MutByteArray
arrContents
    then MutArray a -> IO (MutArray a)
forall (m :: * -> *) a. MonadIO m => MutArray a -> m (MutArray a)
clone MutArray a
arr
    else MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutArray a
arr

-- | Return 'True' if the array is allocated in pinned memory.
{-# INLINE isPinned #-}
isPinned :: MutArray a -> Bool
isPinned :: forall a. MutArray a -> Bool
isPinned MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = MutByteArray -> Bool
Unboxed.isPinned MutByteArray
arrContents

-------------------------------------------------------------------------------
-- Construction
-------------------------------------------------------------------------------

-- XXX Change the names to use "new" instead of "newArray". That way we can use
-- the same names for managed file system objects as well. For unmanaged ones
-- we can use open/create etc as usual.
--
-- A new array is similar to "touch" creating a zero length file. An mmapped
-- array would be similar to a sparse file with holes. TBD: support mmapped
-- files and arrays.

-- GHC always guarantees word-aligned memory, alignment is important only when
-- we need more than that.  See stg_pinnedNewAlignedByteArrayzh and
-- allocatePinned in GHC source.

-- XXX Rename to emptyAlignedWith, alignSize should be first arg.

-- | @newArrayWith allocator alignment count@ allocates a new array of zero
-- length and with a capacity to hold @count@ elements, using @allocator
-- size alignment@ as the memory allocator function.
--
-- Alignment must be greater than or equal to machine word size and a power of
-- 2.
--
-- Alignment is ignored if the allocator allocates unpinned memory.
--
-- /Pre-release/
{-# INLINE newArrayWith #-}
newArrayWith :: forall m a. (MonadIO m, Unbox a)
    => (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)
newArrayWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)
newArrayWith Int -> Int -> m MutByteArray
alloc Int
alignSize Int
count = do
    let size :: Int
size = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)) 0
    MutByteArray
contents <- Int -> Int -> m MutByteArray
alloc Int
size Int
alignSize
    MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> m (MutArray a)) -> MutArray a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutArray
        { arrContents :: MutByteArray
arrContents = MutByteArray
contents
        , arrStart :: Int
arrStart = Int
0
        , arrEnd :: Int
arrEnd   = Int
0
        , arrBound :: Int
arrBound = Int
size
        }

-- For arrays "nil" sounds a bit odd. empty is better. The only problem with
-- empty is that it is also used by the Alternative type class. But assuming we
-- will mostly import the Array module qualified this should be fine.

-- | Create an empty array.
empty ::
#ifdef DEVBUILD
    Unbox a =>
#endif
    MutArray a
empty :: forall a. MutArray a
empty = MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
Unboxed.empty Int
0 Int
0 Int
0

{-# DEPRECATED nil "Please use empty instead." #-}
nil ::
#ifdef DEVBUILD
    Unbox a =>
#endif
    MutArray a
nil :: forall a. MutArray a
nil = MutArray a
forall a. MutArray a
empty

{-# INLINE newBytesAs #-}
newBytesAs :: MonadIO m =>
#ifdef DEVBUILD
    Unbox a =>
#endif
    PinnedState -> Int -> m (MutArray a)
newBytesAs :: forall (m :: * -> *) a.
MonadIO m =>
PinnedState -> Int -> m (MutArray a)
newBytesAs PinnedState
ps Int
bytes = do
    MutByteArray
contents <- IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ PinnedState -> Int -> IO MutByteArray
Unboxed.newBytesAs PinnedState
ps Int
bytes
    MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> m (MutArray a)) -> MutArray a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutArray
        { arrContents :: MutByteArray
arrContents = MutByteArray
contents
        , arrStart :: Int
arrStart = Int
0
        , arrEnd :: Int
arrEnd   = Int
0
        , arrBound :: Int
arrBound = Int
bytes
        }

-- | Allocates a pinned empty array that with a reserved capacity of bytes.
-- The memory of the array is uninitialized and the allocation is aligned as
-- per the 'Unboxed' instance of the type.
--
-- /Pre-release/
{-# INLINE pinnedNewBytes #-}
{-# DEPRECATED pinnedNewBytes "Please use pinnedEmptyOf with appropriate calculation" #-}
pinnedNewBytes :: MonadIO m =>
#ifdef DEVBUILD
    Unbox a =>
#endif
    Int -> m (MutArray a)
pinnedNewBytes :: forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
pinnedNewBytes = PinnedState -> Int -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
PinnedState -> Int -> m (MutArray a)
newBytesAs PinnedState
Pinned

-- | Like 'newArrayWith' but using an allocator is a pinned memory allocator and
-- the alignment is dictated by the 'Unboxed' instance of the type.
--
-- /Internal/
{-# INLINE pinnedNewAligned #-}
pinnedNewAligned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)
pinnedNewAligned :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Int -> m (MutArray a)
pinnedNewAligned =
    (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)
newArrayWith (\Int
s Int
a -> IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> Int -> IO MutByteArray
Unboxed.pinnedNewAlignedBytes Int
s Int
a)

{-# INLINE newAs #-}
newAs :: (MonadIO m, Unbox a) => PinnedState -> Int -> m (MutArray a)
newAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> m (MutArray a)
newAs PinnedState
ps =
    (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)
newArrayWith
        (\Int
s Int
_ -> IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ PinnedState -> Int -> IO MutByteArray
Unboxed.newBytesAs PinnedState
ps Int
s)
        ([Char] -> Int
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"new: alignment is not used in unpinned arrays.")

-- XXX can unaligned allocation be more efficient when alignment is not needed?

-- | Allocates a pinned array of zero length but growable to the specified
-- capacity without reallocation.
{-# INLINE pinnedEmptyOf #-}
pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
pinnedEmptyOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
pinnedEmptyOf = PinnedState -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> m (MutArray a)
newAs PinnedState
Pinned

-- XXX Deprecate in major
-- {-# DEPRECATED pinnedNew "Please use pinnedEmptyOf instead." #-}
{-# INLINE pinnedNew #-}
pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)
pinnedNew :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
pinnedNew = Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
pinnedEmptyOf

-- | Allocates an unpinned array of zero length but growable to the specified
-- capacity without reallocation.
--
{-# INLINE emptyOf #-}
emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
emptyOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
emptyOf = PinnedState -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> m (MutArray a)
newAs PinnedState
Unpinned

-- XXX Deprecate in major
-- {-# DEPRECATED new "Please use emptyOf instead." #-}
{-# INLINE new #-}
new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)
new :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
new = Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
emptyOf

-------------------------------------------------------------------------------
-- Random writes
-------------------------------------------------------------------------------

-- | Write the given element to the given index of the array. Does not check if
-- the index is out of bounds of the array.
--
-- /Pre-release/
{-# INLINE putIndexUnsafe #-}
putIndexUnsafe :: forall m a. (MonadIO m, Unbox a)
    => Int -> MutArray a -> a -> m ()
putIndexUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m ()
putIndexUnsafe Int
i MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a
x = do
    let index :: Int
index = Int
INDEX_OF(arrStart, i, a)
    Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& INDEX_VALID(index, arrEnd, a)) (return ())
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
index MutByteArray
arrContents  a
x

invalidIndex :: String -> Int -> a
invalidIndex :: forall a. [Char] -> Int -> a
invalidIndex [Char]
label Int
i =
    [Char] -> a
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
label [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": invalid array index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i

-- | /O(1)/ Write the given element at the given index in the array.
-- Performs in-place mutation of the array.
--
-- >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))
-- >>> f = MutArray.putIndices
-- >>> putIndex ix arr val = Stream.fold (f arr) (Stream.fromPure (ix, val))
--
{-# INLINE putIndex #-}
putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()
putIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m ()
putIndex Int
i MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a
x = do
    let index :: Int
index = Int
INDEX_OF(arrStart,i,a)
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& INDEX_VALID(index,arrEnd,a)
    then IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
index MutByteArray
arrContents  a
x
    else [Char] -> Int -> m ()
forall a. [Char] -> Int -> a
invalidIndex [Char]
"putIndex" Int
i

-- | Write an input stream of (index, value) pairs to an array. Throws an
-- error if any index is out of bounds.
--
-- /Pre-release/
{-# INLINE putIndices #-}
putIndices :: forall m a. (MonadIO m, Unbox a)
    => MutArray a -> Fold m (Int, a) ()
putIndices :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> Fold m (Int, a) ()
putIndices MutArray a
arr = (() -> (Int, a) -> m ()) -> m () -> Fold m (Int, a) ()
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
FL.foldlM' () -> (Int, a) -> m ()
forall {m :: * -> *}. MonadIO m => () -> (Int, a) -> m ()
step (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

    where

    step :: () -> (Int, a) -> m ()
step () (Int
i, a
x) = Int -> MutArray a -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m ()
putIndex Int
i MutArray a
arr a
x

-- | Modify a given index of an array using a modifier function.
--
-- Unsafe because it does not check the bounds of the array.
--
-- /Pre-release/
modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>
    Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndexUnsafe :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndexUnsafe Int
i MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a -> (a, b)
f = IO b -> m b
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ do
        let index :: Int
index = Int
INDEX_OF(arrStart,i,a)
        Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& INDEX_NEXT(index,a) <= arrEnd) (return ())
        a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
index MutByteArray
arrContents
        let (a
x, b
res) = a -> (a, b)
f a
r
        Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
index MutByteArray
arrContents  a
x
        b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res

-- | Modify a given index of an array using a modifier function.
--
-- /Pre-release/
modifyIndex :: forall m a b. (MonadIO m, Unbox a) =>
    Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndex :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndex Int
i MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a -> (a, b)
f = do
    let index :: Int
index = Int
INDEX_OF(arrStart,i,a)
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& INDEX_VALID(index,arrEnd,a)
    then IO b -> m b
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ do
        a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
index MutByteArray
arrContents
        let (a
x, b
res) = a -> (a, b)
f a
r
        Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
index MutByteArray
arrContents  a
x
        b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
    else [Char] -> Int -> m b
forall a. [Char] -> Int -> a
invalidIndex [Char]
"modifyIndex" Int
i

-- | Modify the array indices generated by the supplied stream.
--
-- /Pre-release/
{-# INLINE modifyIndices #-}
modifyIndices :: forall m a . (MonadIO m, Unbox a)
    => MutArray a -> (Int -> a -> a) -> Fold m Int ()
modifyIndices :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> (Int -> a -> a) -> Fold m Int ()
modifyIndices MutArray a
arr Int -> a -> a
f = (() -> Int -> m ()) -> m () -> Fold m Int ()
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
FL.foldlM' () -> Int -> m ()
forall {m :: * -> *}. MonadIO m => () -> Int -> m ()
step m ()
initial

    where

    initial :: m ()
initial = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    step :: () -> Int -> m ()
step () Int
i =
        let f1 :: a -> (a, ())
f1 a
x = (Int -> a -> a
f Int
i a
x, ())
         in Int -> MutArray a -> (a -> (a, ())) -> m ()
forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndex Int
i MutArray a
arr a -> (a, ())
f1

-- | Modify each element of an array using the supplied modifier function.
--
-- This is an in-place equivalent of an immutable map operation.
--
-- /Pre-release/
modify :: forall m a. (MonadIO m, Unbox a)
    => MutArray a -> (a -> a) -> m ()
modify :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> (a -> a) -> m ()
modify MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a -> a
f = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    Int -> IO ()
go Int
arrStart

    where

    go :: Int -> IO ()
go Int
i =
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (INDEX_VALID(i,arrEnd,a)) $ do
            r <- peekAt i arrContents
            pokeAt i arrContents (f r)
            go (INDEX_NEXT(i,a))

-- XXX We could specify the number of bytes to swap instead of Proxy. Need
-- to ensure that the memory does not overlap.
{-# INLINE swapArrayByteIndices #-}
swapArrayByteIndices ::
       forall a. Unbox a
    => Proxy a
    -> MutByteArray
    -> Int
    -> Int
    -> IO ()
swapArrayByteIndices :: forall a. Unbox a => Proxy a -> MutByteArray -> Int -> Int -> IO ()
swapArrayByteIndices Proxy a
_ MutByteArray
arrContents Int
i1 Int
i2 = do
    a
r1 <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
i1 MutByteArray
arrContents
    a
r2 <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
i2 MutByteArray
arrContents
    Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
i1 MutByteArray
arrContents (a
r2 :: a)
    Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
i2 MutByteArray
arrContents (a
r1 :: a)

-- | Swap the elements at two indices without validating the indices.
--
-- /Unsafe/: This could result in memory corruption if indices are not valid.
--
-- /Pre-release/
{-# INLINE unsafeSwapIndices #-}
unsafeSwapIndices :: forall m a. (MonadIO m, Unbox a)
    => Int -> Int -> MutArray a -> m ()
unsafeSwapIndices :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Int -> MutArray a -> m ()
unsafeSwapIndices Int
i1 Int
i2 MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        let t1 :: Int
t1 = Int
INDEX_OF(arrStart,i1,a)
            t2 :: Int
t2 = Int
INDEX_OF(arrStart,i2,a)
        Proxy a -> MutByteArray -> Int -> Int -> IO ()
forall a. Unbox a => Proxy a -> MutByteArray -> Int -> Int -> IO ()
swapArrayByteIndices (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) MutByteArray
arrContents Int
t1 Int
t2

-- | Swap the elements at two indices.
--
-- /Pre-release/
swapIndices :: forall m a. (MonadIO m, Unbox a)
    => Int -> Int -> MutArray a -> m ()
swapIndices :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Int -> MutArray a -> m ()
swapIndices Int
i1 Int
i2 MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        let t1 :: Int
t1 = Int
INDEX_OF(arrStart,i1,a)
            t2 :: Int
t2 = Int
INDEX_OF(arrStart,i2,a)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| INDEX_INVALID(t1,arrEnd,a))
            (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Int -> IO ()
forall a. [Char] -> Int -> a
invalidIndex [Char]
"swapIndices" Int
i1
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| INDEX_INVALID(t2,arrEnd,a))
            (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Int -> IO ()
forall a. [Char] -> Int -> a
invalidIndex [Char]
"swapIndices" Int
i2
        Proxy a -> MutByteArray -> Int -> Int -> IO ()
forall a. Unbox a => Proxy a -> MutByteArray -> Int -> Int -> IO ()
swapArrayByteIndices (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) MutByteArray
arrContents Int
t1 Int
t2

-------------------------------------------------------------------------------
-- Rounding
-------------------------------------------------------------------------------

-- XXX Should we use bitshifts in calculations or it gets optimized by the
-- compiler/processor itself?
--
-- | The page or block size used by the GHC allocator. Allocator allocates at
-- least a block and then allocates smaller allocations from within a block.
blockSize :: Int
blockSize :: Int
blockSize = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

-- | Allocations larger than 'largeObjectThreshold' are in multiples of block
-- size and are always pinned. The space beyond the end of a large object up to
-- the end of the block is unused.
largeObjectThreshold :: Int
largeObjectThreshold :: Int
largeObjectThreshold = (Int
blockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10

-- XXX Should be done only when we are using the GHC allocator.
-- | Round up an array larger than 'largeObjectThreshold' to use the whole
-- block.
{-# INLINE roundUpLargeArray #-}
roundUpLargeArray :: Int -> Int
roundUpLargeArray :: Int -> Int
roundUpLargeArray Int
size =
    if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
largeObjectThreshold
    then
        Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert
            (Int
blockSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& ((Int
blockSize Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
blockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0))
            ((Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Num a => a -> a
negate Int
blockSize)
    else Int
size

{-# INLINE isPower2 #-}
isPower2 :: Int -> Bool
isPower2 :: Int -> Bool
isPower2 Int
n = Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

{-# INLINE roundUpToPower2 #-}
roundUpToPower2 :: Int -> Int
roundUpToPower2 :: Int -> Int
roundUpToPower2 Int
n =
#if WORD_SIZE_IN_BITS == 64
    Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
z6
#else
    1 + z5
#endif

    where

    z0 :: Int
z0 = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    z1 :: Int
z1 = Int
z0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
z0 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
    z2 :: Int
z2 = Int
z1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
z1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
2
    z3 :: Int
z3 = Int
z2 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
z2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
    z4 :: Int
z4 = Int
z3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
z3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8
    z5 :: Int
z5 = Int
z4 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
z4 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16
    z6 :: Int
z6 = Int
z5 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
z5 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
32

-- | @allocBytesToBytes elem allocatedBytes@ returns the array size in bytes
-- such that the real allocation is less than or equal to @allocatedBytes@,
-- unless @allocatedBytes@ is less than the size of one array element in which
-- case it returns one element's size.
--
{-# INLINE allocBytesToBytes #-}
allocBytesToBytes :: forall a. Unbox a => a -> Int -> Int
allocBytesToBytes :: forall a. Unbox a => a -> Int -> Int
allocBytesToBytes a
_ Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int
arrayPayloadSize Int
n) (SIZE_OF(a))

-- | Given an 'Unboxed' type (unused first arg) and real allocation size
-- (including overhead), return how many elements of that type will completely
-- fit in it, returns at least 1.
--
{-# INLINE allocBytesToElemCount #-}
allocBytesToElemCount :: Unbox a => a -> Int -> Int
allocBytesToElemCount :: forall a. Unbox a => a -> Int -> Int
allocBytesToElemCount a
x Int
bytes =
    let n :: Int
n = a -> Int -> Int
forall a. Unbox a => a -> Int -> Int
bytesToElemCount a
x (a -> Int -> Int
forall a. Unbox a => a -> Int -> Int
allocBytesToBytes a
x Int
bytes)
     in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1) Int
n

-- | The default chunk size by which the array creation routines increase the
-- size of the array when the array is grown linearly.
arrayChunkBytes :: Int
arrayChunkBytes :: Int
arrayChunkBytes = Int
1024

-------------------------------------------------------------------------------
-- Resizing
-------------------------------------------------------------------------------

-- | Round the second argument down to multiples of the first argument.
{-# INLINE roundDownTo #-}
roundDownTo :: Int -> Int -> Int
roundDownTo :: Int -> Int -> Int
roundDownTo Int
elemSize Int
size = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
elemSize)

-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.
-- Since this is not inlined Unboxed consrraint leads to dictionary passing
-- which complicates some inspection tests.
--
{-# NOINLINE reallocExplicitAs #-}
reallocExplicitAs :: PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
reallocExplicitAs :: forall a.
PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
reallocExplicitAs PinnedState
ps Int
elemSize Int
newCapacityInBytes MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = do
    assertM(Int
arrEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrBound)

    -- Allocate new array
    let newCapMaxInBytes :: Int
newCapMaxInBytes = Int -> Int
roundUpLargeArray Int
newCapacityInBytes
    MutByteArray
contents <-
        if PinnedState
ps PinnedState -> PinnedState -> Bool
forall a. Eq a => a -> a -> Bool
== PinnedState
Pinned
        then Int -> IO MutByteArray
Unboxed.pinnedNew Int
newCapMaxInBytes
        else Int -> IO MutByteArray
Unboxed.new Int
newCapMaxInBytes
    let !(MutByteArray MutableByteArray# RealWorld
mbarrFrom#) = MutByteArray
arrContents
        !(MutByteArray MutableByteArray# RealWorld
mbarrTo#) = MutByteArray
contents

    -- Copy old data
    let oldStart :: Int
oldStart = Int
arrStart
        !(I# Int#
oldStartInBytes#) = Int
oldStart
        oldSizeInBytes :: Int
oldSizeInBytes = Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
oldStart
        newCapInBytes :: Int
newCapInBytes = Int -> Int -> Int
roundDownTo Int
elemSize Int
newCapMaxInBytes
        !newLenInBytes :: Int
newLenInBytes@(I# Int#
newLenInBytes#) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
oldSizeInBytes Int
newCapInBytes
    Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
oldSizeInBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
elemSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newLenInBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newLenInBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
elemSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# -> (# MutableByteArray# RealWorld
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# RealWorld
mbarrFrom# Int#
oldStartInBytes#
                        MutableByteArray# RealWorld
mbarrTo# Int#
0# Int#
newLenInBytes# State# RealWorld
s#, () #)

    MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> IO (MutArray a)) -> MutArray a -> IO (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutArray
        { arrStart :: Int
arrStart = Int
0
        , arrContents :: MutByteArray
arrContents = MutByteArray
contents
        , arrEnd :: Int
arrEnd   = Int
newLenInBytes
        , arrBound :: Int
arrBound = Int
newCapInBytes
        }

-- XXX Should these be called reallocBytes etc?
-- XXX We may also need reallocAs to allocate as pinned/unpinned explicitly. In
-- fact clone/pinnedClone can be implemented using reallocAs.

-- | @realloc newCapacity array@ reallocates the array to the specified
-- capacity in bytes.
--
-- If the new size is less than the original array the array gets truncated.
-- If the new size is not a multiple of array element size then it is rounded
-- down to multiples of array size.  If the new size is more than
-- 'largeObjectThreshold' then it is rounded up to the block size (4K).
--
-- If the original array is pinned, the newly allocated array is also pinned.
{-# INLINABLE realloc #-}
realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)
realloc :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
realloc Int
bytes MutArray a
arr =
    let ps :: PinnedState
ps =
            if MutArray a -> Bool
forall a. MutArray a -> Bool
isPinned MutArray a
arr
            then PinnedState
Pinned
            else PinnedState
Unpinned
     in IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
forall a.
PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
reallocExplicitAs PinnedState
ps (SIZE_OF(a)) bytes arr

-- | @reallocWith label capSizer minIncrBytes array@. The label is used
-- in error messages and the capSizer is used to determine the capacity of the
-- new array in bytes given the current byte length of the array.
reallocWith :: forall m a. (MonadIO m , Unbox a) =>
       String
    -> (Int -> Int)
    -> Int
    -> MutArray a
    -> m (MutArray a)
reallocWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
[Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith [Char]
label Int -> Int
capSizer Int
minIncrBytes MutArray a
arr = do
    let oldSizeBytes :: Int
oldSizeBytes = MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr
        newCapBytes :: Int
newCapBytes = Int -> Int
capSizer Int
oldSizeBytes
        newSizeBytes :: Int
newSizeBytes = Int
oldSizeBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minIncrBytes
        safeCapBytes :: Int
safeCapBytes = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
newCapBytes Int
newSizeBytes
    assertM(Int
safeCapBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
newSizeBytes Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. (?callStack::CallStack) => [Char] -> a
error (Int -> [Char]
forall a. Show a => a -> [Char]
badSize Int
newSizeBytes))

    Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
realloc Int
safeCapBytes MutArray a
arr

    where

    badSize :: a -> [Char]
badSize a
newSize =
        [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Prelude.concat
            [ [Char]
label
            , [Char]
": new array size (in bytes) is less than required size "
            , a -> [Char]
forall a. Show a => a -> [Char]
show a
newSize
            , [Char]
". Please check the sizing function passed."
            ]

-- | @grow newCapacity array@ changes the total capacity of the array so that
-- it is enough to hold the specified number of elements.  Nothing is done if
-- the specified capacity is less than the length of the array.
--
-- If the capacity is more than 'largeObjectThreshold' then it is rounded up to
-- the block size (4K).
--
-- /Pre-release/
{-# INLINE grow #-}
grow :: forall m a. (MonadIO m, Unbox a) =>
    Int -> MutArray a -> m (MutArray a)
grow :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
grow Int
nElems arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = do
    let req :: Int
req = SIZE_OF(a) * nElems
        cap :: Int
cap = Int
arrBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrStart
    if Int
req Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cap
    then MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
arr
    else Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
realloc Int
req MutArray a
arr

{-# DEPRECATED resize "Please use grow instead." #-}
{-# INLINE resize #-}
resize :: forall m a. (MonadIO m, Unbox a) =>
    Int -> MutArray a -> m (MutArray a)
resize :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
resize = Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
grow

-- | Like 'grow' but if the requested byte capacity is more than
-- 'largeObjectThreshold' then it is rounded up to the closest power of 2.
--
-- /Pre-release/
{-# INLINE growExp #-}
growExp :: forall m a. (MonadIO m, Unbox a) =>
    Int -> MutArray a -> m (MutArray a)
growExp :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
growExp Int
nElems arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = do
    let req :: Int
req = Int -> Int
roundUpLargeArray (SIZE_OF(a) * nElems)
        req1 :: Int
req1 =
            if Int
req Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
largeObjectThreshold
            then Int -> Int
roundUpToPower2 Int
req
            else Int
req
        cap :: Int
cap = Int
arrBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrStart
    if Int
req1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cap
    then MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
arr
    else Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
realloc Int
req1 MutArray a
arr

{-# DEPRECATED resizeExp "Please use growExp instead." #-}
{-# INLINE resizeExp #-}
resizeExp :: forall m a. (MonadIO m, Unbox a) =>
    Int -> MutArray a -> m (MutArray a)
resizeExp :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
resizeExp = Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
growExp

-- | Resize the allocated memory to drop any reserved free space at the end of
-- the array and reallocate it to reduce wastage.
--
-- Up to 25% wastage is allowed to avoid reallocations.  If the capacity is
-- more than 'largeObjectThreshold' then free space up to the 'blockSize' is
-- retained.
--
-- /Pre-release/
{-# INLINE rightSize #-}
rightSize :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m (MutArray a)
rightSize :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> m (MutArray a)
rightSize arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = do
    Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
arrEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrBound) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    let start :: Int
start = Int
arrStart
        len :: Int
len = Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
        capacity :: Int
capacity = Int
arrBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
        target :: Int
target = Int -> Int
roundUpLargeArray Int
len
        waste :: Int
waste = Int
arrBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrEnd
    Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
target Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` SIZE_OF(a) == 0) (return ())
    -- We trade off some wastage (25%) to avoid reallocations and copying.
    if Int
target Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
capacity Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
waste
    then Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
realloc Int
target MutArray a
arr
    else MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
arr

-------------------------------------------------------------------------------
-- Snoc
-------------------------------------------------------------------------------

-- XXX We can possibly use a smallMutableByteArray to hold the start, end,
-- bound pointers.  Using fully mutable handle will ensure that we do not have
-- multiple references to the same array of different lengths lying around and
-- potentially misused. In that case "snoc" need not return a new array (snoc
-- :: MutArray a -> a -> m ()), it will just modify the old reference.  The array
-- length will be mutable.  This means the length function would also be
-- monadic.  Mutable arrays would behave more like files that grow in that
-- case.

-- | Snoc using a 'Ptr'. Low level reusable function.
--
-- /Internal/
{-# INLINE snocNewEnd #-}
snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)
snocNewEnd :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m (MutArray a)
snocNewEnd Int
newEnd arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a
x = IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ do
    Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrBound) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
arrEnd MutByteArray
arrContents a
x
    MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> IO (MutArray a)) -> MutArray a -> IO (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutArray a
arr {arrEnd = newEnd}

-- | Really really unsafe, appends the element into the first array, may
-- cause silent data corruption or if you are lucky a segfault if the first
-- array does not have enough space to append the element.
--
-- /Internal/
{-# INLINE snocUnsafe #-}
snocUnsafe :: forall m a. (MonadIO m, Unbox a) =>
    MutArray a -> a -> m (MutArray a)
snocUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (MutArray a)
snocUnsafe arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = Int -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m (MutArray a)
snocNewEnd (INDEX_NEXT(arrEnd,a)) arr

-- | Like 'snoc' but does not reallocate when pre-allocated array capacity
-- becomes full.
--
-- /Internal/
{-# INLINE snocMay #-}
snocMay :: forall m a. (MonadIO m, Unbox a) =>
    MutArray a -> a -> m (Maybe (MutArray a))
snocMay :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (Maybe (MutArray a))
snocMay arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a
x = do
    let newEnd :: Int
newEnd = INDEX_NEXT(arrEnd,a)
    if Int
newEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrBound
    then MutArray a -> Maybe (MutArray a)
forall a. a -> Maybe a
Just (MutArray a -> Maybe (MutArray a))
-> m (MutArray a) -> m (Maybe (MutArray a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m (MutArray a)
snocNewEnd Int
newEnd MutArray a
arr a
x
    else Maybe (MutArray a) -> m (Maybe (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MutArray a)
forall a. Maybe a
Nothing

-- NOINLINE to move it out of the way and not pollute the instruction cache.
{-# NOINLINE snocWithRealloc #-}
snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>
       (Int -> Int)
    -> MutArray a
    -> a
    -> m (MutArray a)
snocWithRealloc :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWithRealloc Int -> Int
sizer MutArray a
arr a
x = do
    MutArray a
arr1 <- [Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
[Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith [Char]
"snocWith" Int -> Int
sizer (SIZE_OF(a)) arr
    MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (MutArray a)
snocUnsafe MutArray a
arr1 a
x

-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of
-- the array increases by 1.
--
-- If there is no reserved space available in @arr@ it is reallocated to a size
-- in bytes determined by the @sizer oldSizeBytes@ function, where
-- @oldSizeBytes@ is the original size of the array in bytes.
--
-- If the new array size is more than 'largeObjectThreshold' we automatically
-- round it up to 'blockSize'.
--
-- Note that the returned array may be a mutated version of the original array.
--
-- /Pre-release/
{-# INLINE snocWith #-}
snocWith :: forall m a. (MonadIO m, Unbox a) =>
       (Int -> Int)
    -> MutArray a
    -> a
    -> m (MutArray a)
snocWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith Int -> Int
allocSize MutArray a
arr a
x = do
    let newEnd :: Int
newEnd = INDEX_NEXT(arrEnd arr,a)
    if Int
newEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MutArray a -> Int
forall a. MutArray a -> Int
arrBound MutArray a
arr
    then Int -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m (MutArray a)
snocNewEnd Int
newEnd MutArray a
arr a
x
    else (Int -> Int) -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWithRealloc Int -> Int
allocSize MutArray a
arr a
x

-- | The array is mutated to append an additional element to it. If there
-- is no reserved space available in the array then it is reallocated to grow
-- it by 'arrayChunkBytes' rounded up to 'blockSize' when the size becomes more
-- than 'largeObjectThreshold'.
--
-- Note that the returned array may be a mutated version of the original array.
--
-- Performs O(n^2) copies to grow but is thrifty on memory.
--
-- /Pre-release/
{-# INLINE snocLinear #-}
snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)
snocLinear :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (MutArray a)
snocLinear = (Int -> Int) -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int -> Int
forall a. Unbox a => a -> Int -> Int
allocBytesToBytes (a
forall a. (?callStack::CallStack) => a
undefined :: a) Int
arrayChunkBytes)

-- | The array is mutated to append an additional element to it. If there is no
-- reserved space available in the array then it is reallocated to double the
-- original size.
--
-- This is useful to reduce allocations when appending unknown number of
-- elements.
--
-- Note that the returned array may be a mutated version of the original array.
--
-- >>> snoc = MutArray.snocWith (* 2)
--
-- Performs O(n * log n) copies to grow, but is liberal with memory allocation.
--
{-# INLINE snoc #-}
snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)
snoc :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (MutArray a)
snoc = (Int -> Int) -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith Int -> Int
f

    where

    f :: Int -> Int
f Int
oldSize =
        if Int -> Bool
isPower2 Int
oldSize
        then Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
        else Int -> Int
roundUpToPower2 Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2

-------------------------------------------------------------------------------
-- Serialization/Deserialization
-------------------------------------------------------------------------------

{-# INLINE pokeNewEnd #-}
pokeNewEnd :: (MonadIO m, Unbox a) =>
    Int -> MutArray Word8 -> a -> m (MutArray Word8)
pokeNewEnd :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray Word8 -> a -> m (MutArray Word8)
pokeNewEnd Int
newEnd arr :: MutArray Word8
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a
x = IO (MutArray Word8) -> m (MutArray Word8)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray Word8) -> m (MutArray Word8))
-> IO (MutArray Word8) -> m (MutArray Word8)
forall a b. (a -> b) -> a -> b
$ do
    Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrBound) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
arrEnd MutByteArray
arrContents a
x
    MutArray Word8 -> IO (MutArray Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray Word8 -> IO (MutArray Word8))
-> MutArray Word8 -> IO (MutArray Word8)
forall a b. (a -> b) -> a -> b
$ MutArray Word8
arr {arrEnd = newEnd}

-- | Really really unsafe, unboxes a Haskell type and appends the resulting
-- bytes to the byte array, may cause silent data corruption or if you are
-- lucky a segfault if the array does not have enough space to append the
-- element.
--
-- /Internal/
{-# INLINE pokeAppendUnsafe #-}
pokeAppendUnsafe :: forall m a. (MonadIO m, Unbox a) =>
    MutArray Word8 -> a -> m (MutArray Word8)
pokeAppendUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray Word8 -> a -> m (MutArray Word8)
pokeAppendUnsafe arr :: MutArray Word8
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = Int -> MutArray Word8 -> a -> m (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray Word8 -> a -> m (MutArray Word8)
pokeNewEnd (Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)) arr

-- | Skip the specified number of bytes in the array. The data in the skipped
-- region remains uninitialzed.
{-# INLINE pokeSkipUnsafe #-}
pokeSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8
pokeSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8
pokeSkipUnsafe Int
n arr :: MutArray Word8
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =  do
    let newEnd :: Int
newEnd = Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
     in Bool -> MutArray Word8 -> MutArray Word8
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
newEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrBound) (MutArray Word8
arr {arrEnd = newEnd})

-- | Like 'pokeAppend' but does not grow the array when pre-allocated array
-- capacity becomes full.
--
-- /Internal/
{-# INLINE pokeAppendMay #-}
pokeAppendMay :: forall m a. (MonadIO m, Unbox a) =>
    MutArray Word8 -> a -> m (Maybe (MutArray Word8))
pokeAppendMay :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray Word8 -> a -> m (Maybe (MutArray Word8))
pokeAppendMay arr :: MutArray Word8
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a
x = IO (Maybe (MutArray Word8)) -> m (Maybe (MutArray Word8))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (MutArray Word8)) -> m (Maybe (MutArray Word8)))
-> IO (Maybe (MutArray Word8)) -> m (Maybe (MutArray Word8))
forall a b. (a -> b) -> a -> b
$ do
    let newEnd :: Int
newEnd = Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)
    if Int
newEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrBound
    then MutArray Word8 -> Maybe (MutArray Word8)
forall a. a -> Maybe a
Just (MutArray Word8 -> Maybe (MutArray Word8))
-> IO (MutArray Word8) -> IO (Maybe (MutArray Word8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutArray Word8 -> a -> IO (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray Word8 -> a -> m (MutArray Word8)
pokeNewEnd Int
newEnd MutArray Word8
arr a
x
    else Maybe (MutArray Word8) -> IO (Maybe (MutArray Word8))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MutArray Word8)
forall a. Maybe a
Nothing

{-# NOINLINE pokeWithRealloc #-}
pokeWithRealloc :: forall m a. (MonadIO m, Unbox a) =>
       (Int -> Int)
    -> MutArray Word8
    -> a
    -> m (MutArray Word8)
pokeWithRealloc :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray Word8 -> a -> m (MutArray Word8)
pokeWithRealloc Int -> Int
sizer MutArray Word8
arr a
x = do
    MutArray Word8
arr1 <- IO (MutArray Word8) -> m (MutArray Word8)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray Word8) -> m (MutArray Word8))
-> IO (MutArray Word8) -> m (MutArray Word8)
forall a b. (a -> b) -> a -> b
$ [Char]
-> (Int -> Int) -> Int -> MutArray Word8 -> IO (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
[Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith [Char]
"pokeWithRealloc" Int -> Int
sizer (SIZE_OF(a)) arr
    MutArray Word8 -> a -> m (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray Word8 -> a -> m (MutArray Word8)
pokeAppendUnsafe MutArray Word8
arr1 a
x

{-# INLINE pokeAppendWith #-}
pokeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
       (Int -> Int)
    -> MutArray Word8
    -> a
    -> m (MutArray Word8)
pokeAppendWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray Word8 -> a -> m (MutArray Word8)
pokeAppendWith Int -> Int
allocSize MutArray Word8
arr a
x = IO (MutArray Word8) -> m (MutArray Word8)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray Word8) -> m (MutArray Word8))
-> IO (MutArray Word8) -> m (MutArray Word8)
forall a b. (a -> b) -> a -> b
$ do
    let newEnd :: Int
newEnd = MutArray Word8 -> Int
forall a. MutArray a -> Int
arrEnd MutArray Word8
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)
    if Int
newEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MutArray Word8 -> Int
forall a. MutArray a -> Int
arrBound MutArray Word8
arr
    then Int -> MutArray Word8 -> a -> IO (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray Word8 -> a -> m (MutArray Word8)
pokeNewEnd Int
newEnd MutArray Word8
arr a
x
    else (Int -> Int) -> MutArray Word8 -> a -> IO (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray Word8 -> a -> m (MutArray Word8)
pokeWithRealloc Int -> Int
allocSize MutArray Word8
arr a
x

-- | Unbox a Haskell type and append the resulting bytes to a mutable byte
-- array. The array is grown exponentially when more space is needed.
--
-- Definition:
--
-- >>> pokeAppend arr x = MutArray.castUnsafe <$> MutArray.snoc (MutArray.castUnsafe arr) x
--
{-# INLINE pokeAppend #-}
pokeAppend :: forall m a. (MonadIO m, Unbox a) =>
    MutArray Word8 -> a -> m (MutArray Word8)
pokeAppend :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray Word8 -> a -> m (MutArray Word8)
pokeAppend = (Int -> Int) -> MutArray Word8 -> a -> m (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray Word8 -> a -> m (MutArray Word8)
pokeAppendWith Int -> Int
f

    where

    f :: Int -> Int
f Int
oldSize =
        if Int -> Bool
isPower2 Int
oldSize
        then Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
        else Int -> Int
roundUpToPower2 Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2

-- | Really really unsafe, create a Haskell value from an unboxed byte array,
-- does not check if the array is big enough, may return garbage or if you are
-- lucky may cause a segfault.
--
-- /Internal/
{-# INLINE peekUnconsUnsafe #-}
peekUnconsUnsafe :: forall m a. (MonadIO m, Unbox a) =>
    MutArray Word8 -> m (a, MutArray Word8)
peekUnconsUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray Word8 -> m (a, MutArray Word8)
peekUnconsUnsafe MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = do
    let start1 :: Int
start1 = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)
    Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
start1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrEnd) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    IO (a, MutArray Word8) -> m (a, MutArray Word8)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, MutArray Word8) -> m (a, MutArray Word8))
-> IO (a, MutArray Word8) -> m (a, MutArray Word8)
forall a b. (a -> b) -> a -> b
$ do
        a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
arrStart MutByteArray
arrContents
        (a, MutArray Word8) -> IO (a, MutArray Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, MutByteArray -> Int -> Int -> Int -> MutArray Word8
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
arrContents Int
start1 Int
arrEnd Int
arrBound)

-- | Discard the specified number of bytes in the array.
{-# INLINE peekSkipUnsafe #-}
peekSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8
peekSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8
peekSkipUnsafe Int
n MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    let start1 :: Int
start1 = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
     in Bool -> MutArray Word8 -> MutArray Word8
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
start1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrEnd) (MutByteArray -> Int -> Int -> Int -> MutArray Word8
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
arrContents Int
start1 Int
arrEnd Int
arrBound)

-- | Create a Haskell value from its unboxed representation from the head of a
-- byte array, return the value and the remaining array.
{-# INLINE peekUncons #-}
peekUncons :: forall m a. (MonadIO m, Unbox a) =>
    MutArray Word8 -> m (Maybe a, MutArray Word8)
peekUncons :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray Word8 -> m (Maybe a, MutArray Word8)
peekUncons arr :: MutArray Word8
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = do
    let start1 :: Int
start1 = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)
    if Int
start1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
arrEnd
    then (Maybe a, MutArray Word8) -> m (Maybe a, MutArray Word8)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, MutArray Word8
arr)
    else IO (Maybe a, MutArray Word8) -> m (Maybe a, MutArray Word8)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a, MutArray Word8) -> m (Maybe a, MutArray Word8))
-> IO (Maybe a, MutArray Word8) -> m (Maybe a, MutArray Word8)
forall a b. (a -> b) -> a -> b
$ do
        a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
arrStart MutByteArray
arrContents
        (Maybe a, MutArray Word8) -> IO (Maybe a, MutArray Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
r, MutByteArray -> Int -> Int -> Int -> MutArray Word8
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
arrContents Int
start1 Int
arrEnd Int
arrBound)

-------------------------------------------------------------------------------
-- Random reads
-------------------------------------------------------------------------------

-- XXX Can this be deduplicated with array/foreign

-- | Return the element at the specified index without checking the bounds.
--
-- Unsafe because it does not check the bounds of the array.
{-# INLINE_NORMAL getIndexUnsafe #-}
getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a
getIndexUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m a
getIndexUnsafe Int
i MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = do
    let index :: Int
index = Int
INDEX_OF(arrStart,i,a)
    Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& INDEX_VALID(index,arrEnd,a)) (return ())
    IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
index MutByteArray
arrContents

-- | /O(1)/ Lookup the element at the given index. Index starts from 0.
--
{-# INLINE getIndex #-}
getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)
getIndex :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (Maybe a)
getIndex Int
i MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = do
    let index :: Int
index = Int
INDEX_OF(arrStart,i,a)
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& INDEX_VALID(index,arrEnd,a)
    then IO (Maybe a) -> m (Maybe a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
index MutByteArray
arrContents
    else Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | /O(1)/ Lookup the element at the given index from the end of the array.
-- Index starts from 0.
--
-- Slightly faster than computing the forward index and using getIndex.
--
{-# INLINE getIndexRev #-}
getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a
getIndexRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m a
getIndexRev Int
i MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = do
    let index :: Int
index = RINDEX_OF(Proxy a -> Int
forall a. Unbox a => Proxy a -> Int
arrEnd,i,a)
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
arrStart
    then IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
index MutByteArray
arrContents
    else [Char] -> Int -> m a
forall a. [Char] -> Int -> a
invalidIndex [Char]
"getIndexRev" Int
i

data GetIndicesState contents start end st =
    GetIndicesState contents start end st

{-# INLINE indexReaderWith #-}
indexReaderWith :: (Monad m, Unbox a) =>
    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
indexReaderWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a
indexReaderWith forall b. IO b -> m b
liftio (D.Stream State StreamK m Int -> s -> m (Step s Int)
stepi s
sti) = (GetIndicesState MutByteArray Int Int s
 -> m (Step (GetIndicesState MutByteArray Int Int s) a))
-> (MutArray a -> m (GetIndicesState MutByteArray Int Int s))
-> Unfold m (MutArray a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold GetIndicesState MutByteArray Int Int s
-> m (Step (GetIndicesState MutByteArray Int Int s) a)
forall {a}.
Unbox a =>
GetIndicesState MutByteArray Int Int s
-> m (Step (GetIndicesState MutByteArray Int Int s) a)
step MutArray a -> m (GetIndicesState MutByteArray Int Int s)
forall {m :: * -> *} {a}.
Monad m =>
MutArray a -> m (GetIndicesState MutByteArray Int Int s)
inject

    where

    inject :: MutArray a -> m (GetIndicesState MutByteArray Int Int s)
inject (MutArray MutByteArray
contents Int
start Int
end Int
_) =
        GetIndicesState MutByteArray Int Int s
-> m (GetIndicesState MutByteArray Int Int s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetIndicesState MutByteArray Int Int s
 -> m (GetIndicesState MutByteArray Int Int s))
-> GetIndicesState MutByteArray Int Int s
-> m (GetIndicesState MutByteArray Int Int s)
forall a b. (a -> b) -> a -> b
$ MutByteArray
-> Int -> Int -> s -> GetIndicesState MutByteArray Int Int s
forall contents start end st.
contents
-> start -> end -> st -> GetIndicesState contents start end st
GetIndicesState MutByteArray
contents Int
start Int
end s
sti

    {-# INLINE_LATE step #-}
    step :: GetIndicesState MutByteArray Int Int s
-> m (Step (GetIndicesState MutByteArray Int Int s) a)
step (GetIndicesState MutByteArray
contents Int
start Int
end s
st) = do
        Step s Int
r <- State StreamK m Int -> s -> m (Step s Int)
stepi State StreamK m Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s Int
r of
            D.Yield Int
i s
s -> do
                Maybe a
x <- IO (Maybe a) -> m (Maybe a)
forall b. IO b -> m b
liftio (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> IO (Maybe a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (Maybe a)
getIndex Int
i (MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
contents Int
start Int
end Int
forall a. (?callStack::CallStack) => a
undefined)
                case Maybe a
x of
                    Just a
v -> Step (GetIndicesState MutByteArray Int Int s) a
-> m (Step (GetIndicesState MutByteArray Int Int s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GetIndicesState MutByteArray Int Int s) a
 -> m (Step (GetIndicesState MutByteArray Int Int s) a))
-> Step (GetIndicesState MutByteArray Int Int s) a
-> m (Step (GetIndicesState MutByteArray Int Int s) a)
forall a b. (a -> b) -> a -> b
$ a
-> GetIndicesState MutByteArray Int Int s
-> Step (GetIndicesState MutByteArray Int Int s) a
forall s a. a -> s -> Step s a
D.Yield a
v (MutByteArray
-> Int -> Int -> s -> GetIndicesState MutByteArray Int Int s
forall contents start end st.
contents
-> start -> end -> st -> GetIndicesState contents start end st
GetIndicesState MutByteArray
contents Int
start Int
end s
s)
                    Maybe a
Nothing -> [Char] -> m (Step (GetIndicesState MutByteArray Int Int s) a)
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"Invalid Index"
            D.Skip s
s -> Step (GetIndicesState MutByteArray Int Int s) a
-> m (Step (GetIndicesState MutByteArray Int Int s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GetIndicesState MutByteArray Int Int s) a
 -> m (Step (GetIndicesState MutByteArray Int Int s) a))
-> Step (GetIndicesState MutByteArray Int Int s) a
-> m (Step (GetIndicesState MutByteArray Int Int s) a)
forall a b. (a -> b) -> a -> b
$ GetIndicesState MutByteArray Int Int s
-> Step (GetIndicesState MutByteArray Int Int s) a
forall s a. s -> Step s a
D.Skip (MutByteArray
-> Int -> Int -> s -> GetIndicesState MutByteArray Int Int s
forall contents start end st.
contents
-> start -> end -> st -> GetIndicesState contents start end st
GetIndicesState MutByteArray
contents Int
start Int
end s
s)
            Step s Int
D.Stop -> Step (GetIndicesState MutByteArray Int Int s) a
-> m (Step (GetIndicesState MutByteArray Int Int s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (GetIndicesState MutByteArray Int Int s) a
forall s a. Step s a
D.Stop

{-# DEPRECATED getIndicesWith "Please use indexReaderWith instead." #-}
{-# INLINE getIndicesWith #-}
getIndicesWith :: (Monad m, Unbox a) =>
    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a
getIndicesWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a
getIndicesWith = (forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a
indexReaderWith

-- | Given an unfold that generates array indices, read the elements on those
-- indices from the supplied MutArray. An error is thrown if an index is out of
-- bounds.
--
-- /Pre-release/
{-# INLINE indexReader #-}
indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
indexReader :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m Int -> Unfold m (MutArray a) a
indexReader = (forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a
indexReaderWith IO b -> m b
forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold
{-# DEPRECATED getIndices "Please use indexReader instead." #-}
{-# INLINE getIndices #-}
getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a
getIndices :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m Int -> Unfold m (MutArray a) a
getIndices = Stream m Int -> Unfold m (MutArray a) a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m Int -> Unfold m (MutArray a) a
indexReader

-------------------------------------------------------------------------------
-- Subarrays
-------------------------------------------------------------------------------

-- XXX We can also get immutable slices.

-- | /O(1)/ Slice an array in constant time.
--
-- Unsafe: The bounds of the slice are not checked.
--
-- /Unsafe/
--
-- /Pre-release/
{-# INLINE getSliceUnsafe #-}
getSliceUnsafe :: forall a. Unbox a
    => Int -- ^ from index
    -> Int -- ^ length of the slice
    -> MutArray a
    -> MutArray a
getSliceUnsafe :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a
getSliceUnsafe Int
index Int
len (MutArray MutByteArray
contents Int
start Int
e Int
_) =
    let fp1 :: Int
fp1 = INDEX_OF(start,index,a)
        end :: Int
end = Int
fp1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
     in Bool -> MutArray a -> MutArray a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert
            (Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e)
            -- Note: In a slice we always use bound = end so that the slice
            -- user cannot overwrite elements beyond the end of the slice.
            (MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
contents Int
fp1 Int
end Int
end)

-- | /O(1)/ Slice an array in constant time. Throws an error if the slice
-- extends out of the array bounds.
--
-- /Pre-release/
{-# INLINE getSlice #-}
getSlice :: forall a. Unbox a =>
       Int -- ^ from index
    -> Int -- ^ length of the slice
    -> MutArray a
    -> MutArray a
getSlice :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a
getSlice Int
index Int
len (MutArray MutByteArray
contents Int
start Int
e Int
_) =
    let fp1 :: Int
fp1 = INDEX_OF(start,index,a)
        end :: Int
end = Int
fp1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
     in if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
e
        -- Note: In a slice we always use bound = end so that the slice user
        -- cannot overwrite elements beyond the end of the slice.
        then MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
contents Int
fp1 Int
end Int
end
        else [Char] -> MutArray a
forall a. (?callStack::CallStack) => [Char] -> a
error
                ([Char] -> MutArray a) -> [Char] -> MutArray a
forall a b. (a -> b) -> a -> b
$ [Char]
"getSlice: invalid slice, index "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
index [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" length " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
len

-------------------------------------------------------------------------------
-- In-place mutation algorithms
-------------------------------------------------------------------------------

-- XXX consider the bulk update/accumulation/permutation APIs from vector.

-- | You may not need to reverse an array because you can consume it in reverse
-- using 'readerRev'. To reverse large arrays you can read in reverse and write
-- to another array. However, in-place reverse can be useful to take adavantage
-- of cache locality and when you do not want to allocate additional memory.
--
{-# INLINE reverse #-}
reverse :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m ()
reverse :: forall (m :: * -> *) a. (MonadIO m, Unbox a) => MutArray a -> m ()
reverse MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let l :: Int
l = Int
arrStart
        h :: Int
h = INDEX_PREV(arrEnd,a)
     in Int -> Int -> IO ()
swap Int
l Int
h

    where

    swap :: Int -> Int -> IO ()
swap Int
l Int
h = do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Proxy a -> MutByteArray -> Int -> Int -> IO ()
forall a. Unbox a => Proxy a -> MutByteArray -> Int -> Int -> IO ()
swapArrayByteIndices (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) MutByteArray
arrContents Int
l Int
h
            Int -> Int -> IO ()
swap (INDEX_NEXT(l,a)) (INDEX_PREV(h,aInt
))

-- | Generate the next permutation of the sequence, returns False if this is
-- the last permutation.
--
-- /Unimplemented/
{-# INLINE permute #-}
permute :: MutArray a -> m Bool
permute :: forall a (m :: * -> *). MutArray a -> m Bool
permute = MutArray a -> m Bool
forall a. (?callStack::CallStack) => a
undefined

-- | Partition an array into two halves using a partitioning predicate. The
-- first half retains values where the predicate is 'False' and the second half
-- retains values where the predicate is 'True'.
--
-- /Pre-release/
{-# INLINE partitionBy #-}
partitionBy :: forall m a. (MonadIO m, Unbox a)
    => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)
partitionBy :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)
partitionBy a -> Bool
f arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = IO (MutArray a, MutArray a) -> m (MutArray a, MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a, MutArray a) -> m (MutArray a, MutArray a))
-> IO (MutArray a, MutArray a) -> m (MutArray a, MutArray a)
forall a b. (a -> b) -> a -> b
$ do
    if Int
arrStart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
arrEnd
    then (MutArray a, MutArray a) -> IO (MutArray a, MutArray a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a
arr, MutArray a
arr)
    else do
        Int
ptr <- Int -> Int -> IO Int
go Int
arrStart (INDEX_PREV(arrEnd,a))
        let pl :: MutArray a
pl = MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
arrContents Int
arrStart Int
ptr Int
ptr
            pr :: MutArray a
pr = MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
arrContents Int
ptr Int
arrEnd Int
arrEnd
        (MutArray a, MutArray a) -> IO (MutArray a, MutArray a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a
forall a. MutArray a
pl, MutArray a
forall a. MutArray a
pr)

    where

    -- Invariant low < high on entry, and on return as well
    moveHigh :: Int -> Int -> IO (Maybe (Int, a))
moveHigh Int
low Int
high = do
        a
h <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
high MutByteArray
arrContents
        if a -> Bool
f a
h
        then
            -- Correctly classified, continue the loop
            let high1 :: Int
high1 = INDEX_PREV(high,a)
             in if Int
low Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
high1
                then Maybe (Int, a) -> IO (Maybe (Int, a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, a)
forall a. Maybe a
Nothing
                else Int -> Int -> IO (Maybe (Int, a))
moveHigh Int
low Int
high1
        else Maybe (Int, a) -> IO (Maybe (Int, a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
high, a
h)) -- incorrectly classified

    -- Keep a low pointer starting at the start of the array (first partition)
    -- and a high pointer starting at the end of the array (second partition).
    -- Keep incrementing the low ptr and decrementing the high ptr until both
    -- are wrongly classified, at that point swap the two and continue until
    -- the two pointer cross each other.
    --
    -- Invariants when entering this loop:
    -- low <= high
    -- Both low and high are valid locations within the array
    go :: Int -> Int -> IO Int
go Int
low Int
high = do
        a
l <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
low MutByteArray
arrContents
        if a -> Bool
f a
l
        then
            -- low is wrongly classified
            if Int
low Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
high
            then Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
low
            else do -- low < high
                Maybe (Int, a)
r <- Int -> Int -> IO (Maybe (Int, a))
moveHigh Int
low Int
high
                case Maybe (Int, a)
r of
                    Maybe (Int, a)
Nothing -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
low
                    Just (Int
high1, a
h) -> do -- low < high1
                        Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
low MutByteArray
arrContents a
h
                        Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
high1 MutByteArray
arrContents a
l
                        let low1 :: Int
low1 = INDEX_NEXT(low,a)
                            high2 :: Int
high2 = INDEX_PREV(high1,a)
                        if Int
low1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
high2
                        then Int -> Int -> IO Int
go Int
low1 Int
high2
                        else Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
low1 -- low1 > high2

        else do
            -- low is correctly classified
            let low1 :: Int
low1 = INDEX_NEXT(low,a)
            if Int
low Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
high
            then Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
low1
            else Int -> Int -> IO Int
go Int
low1 Int
high

-- | Shuffle corresponding elements from two arrays using a shuffle function.
-- If the shuffle function returns 'False' then do nothing otherwise swap the
-- elements. This can be used in a bottom up fold to shuffle or reorder the
-- elements.
--
-- /Unimplemented/
{-# INLINE shuffleBy #-}
shuffleBy :: (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()
shuffleBy :: forall a (m :: * -> *).
(a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()
shuffleBy = (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()
forall a. (?callStack::CallStack) => a
undefined

-- XXX we can also make the folds partial by stopping at a certain level.
--
-- | @divideBy level partition array@  performs a top down hierarchical
-- recursive partitioning fold of items in the container using the given
-- function as the partition function.  Level indicates the level in the tree
-- where the fold would stop.
--
-- This performs a quick sort if the partition function is
-- 'partitionBy (< pivot)'.
--
-- /Unimplemented/
{-# INLINABLE divideBy #-}
divideBy ::
    Int -> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()
divideBy :: forall a (m :: * -> *).
Int
-> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()
divideBy = Int
-> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()
forall a. (?callStack::CallStack) => a
undefined

-- | @mergeBy level merge array@ performs a pairwise bottom up fold recursively
-- merging the pairs using the supplied merge function. Level indicates the
-- level in the tree where the fold would stop.
--
-- This performs a random shuffle if the merge function is random.  If we
-- stop at level 0 and repeatedly apply the function then we can do a bubble
-- sort.
--
-- /Unimplemented/
mergeBy :: Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()
mergeBy :: forall a (m :: * -> *).
Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()
mergeBy = Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()
forall a. (?callStack::CallStack) => a
undefined

-------------------------------------------------------------------------------
-- Size
-------------------------------------------------------------------------------

-- | /O(1)/ Get the byte length of the array.
--
{-# INLINE byteLength #-}
byteLength :: MutArray a -> Int
byteLength :: forall a. MutArray a -> Int
byteLength MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    let len :: Int
len = Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrStart
    in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Int
len

-- Note: try to avoid the use of length in performance sensitive internal
-- routines as it involves a costly 'div' operation. Instead use the end ptr
-- in the array to check the bounds etc.
--
-- | /O(1)/ Get the length of the array i.e. the number of elements in the
-- array.
--
-- Note that 'byteLength' is less expensive than this operation, as 'length'
-- involves a costly division operation.
--
{-# INLINE length #-}
length :: forall a. Unbox a => MutArray a -> Int
length :: forall a. Unbox a => MutArray a -> Int
length MutArray a
arr =
    let elemSize :: Int
elemSize = SIZE_OF(a)
        blen :: Int
blen = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr
     in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
blen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
elemSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int
blen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
elemSize)

-- | Get the total capacity of an array. An array may have space reserved
-- beyond the current used length of the array.
--
-- /Pre-release/
{-# INLINE byteCapacity #-}
byteCapacity :: MutArray a -> Int
byteCapacity :: forall a. MutArray a -> Int
byteCapacity MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    let len :: Int
len = Int
arrBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrStart
    in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Int
len

-- | The remaining capacity in the array for appending more elements without
-- reallocation.
--
-- /Pre-release/
{-# INLINE bytesFree #-}
bytesFree :: MutArray a -> Int
bytesFree :: forall a. MutArray a -> Int
bytesFree MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    let n :: Int
n = Int
arrBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
arrEnd
    in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Int
n

-------------------------------------------------------------------------------
-- Streams of arrays - Creation
-------------------------------------------------------------------------------

data GroupState s contents start end bound
    = GroupStart s
    | GroupBuffer s contents start end bound
    | GroupYield
        contents start end bound (GroupState s contents start end bound)
    | GroupFinish

{-# INLINE_NORMAL chunksOfAs #-}
chunksOfAs :: forall m a. (MonadIO m, Unbox a)
    => PinnedState -> Int -> D.Stream m a -> D.Stream m (MutArray a)
chunksOfAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Stream m a -> Stream m (MutArray a)
chunksOfAs PinnedState
ps Int
n (D.Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m (MutArray a)
 -> GroupState s MutByteArray Int Int Int
 -> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a)))
-> GroupState s MutByteArray Int Int Int -> Stream m (MutArray a)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State StreamK m (MutArray a)
-> GroupState s MutByteArray Int Int Int
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall {m :: * -> *} {a} {a}.
State StreamK m a
-> GroupState s MutByteArray Int Int Int
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
step' (s -> GroupState s MutByteArray Int Int Int
forall s contents start end bound.
s -> GroupState s contents start end bound
GroupStart s
state)

    where

    {-# INLINE_LATE step' #-}
    step' :: State StreamK m a
-> GroupState s MutByteArray Int Int Int
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
step' State StreamK m a
_ (GroupStart s
st) = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Internal.Data.MutArray.Mut.Type.chunksOf: "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"the size of arrays [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
        (MutArray MutByteArray
contents Int
start Int
end Int
bound :: MutArray a) <- PinnedState -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> m (MutArray a)
newAs PinnedState
ps Int
n
        Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s MutByteArray Int Int Int) (MutArray a)
 -> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a)))
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a b. (a -> b) -> a -> b
$ GroupState s MutByteArray Int Int Int
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip (s
-> MutByteArray
-> Int
-> Int
-> Int
-> GroupState s MutByteArray Int Int Int
forall s contents start end bound.
s
-> contents
-> start
-> end
-> bound
-> GroupState s contents start end bound
GroupBuffer s
st MutByteArray
contents Int
start Int
end Int
bound)

    step' State StreamK m a
gst (GroupBuffer s
st MutByteArray
contents Int
start Int
end Int
bound) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
r of
            D.Yield a
x s
s -> do
                IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
end MutByteArray
contents  a
x
                let end1 :: Int
end1 = INDEX_NEXT(end,a)
                Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s MutByteArray Int Int Int) (MutArray a)
 -> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a)))
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a b. (a -> b) -> a -> b
$
                    if Int
end1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bound
                    then GroupState s MutByteArray Int Int Int
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip
                            (MutByteArray
-> Int
-> Int
-> Int
-> GroupState s MutByteArray Int Int Int
-> GroupState s MutByteArray Int Int Int
forall s contents start end bound.
contents
-> start
-> end
-> bound
-> GroupState s contents start end bound
-> GroupState s contents start end bound
GroupYield
                                MutByteArray
contents Int
start Int
end1 Int
bound (s -> GroupState s MutByteArray Int Int Int
forall s contents start end bound.
s -> GroupState s contents start end bound
GroupStart s
s))
                    else GroupState s MutByteArray Int Int Int
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip (s
-> MutByteArray
-> Int
-> Int
-> Int
-> GroupState s MutByteArray Int Int Int
forall s contents start end bound.
s
-> contents
-> start
-> end
-> bound
-> GroupState s contents start end bound
GroupBuffer s
s MutByteArray
contents Int
start Int
end1 Int
bound)
            D.Skip s
s ->
                Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s MutByteArray Int Int Int) (MutArray a)
 -> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a)))
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a b. (a -> b) -> a -> b
$ GroupState s MutByteArray Int Int Int
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip (s
-> MutByteArray
-> Int
-> Int
-> Int
-> GroupState s MutByteArray Int Int Int
forall s contents start end bound.
s
-> contents
-> start
-> end
-> bound
-> GroupState s contents start end bound
GroupBuffer s
s MutByteArray
contents Int
start Int
end Int
bound)
            Step s a
D.Stop ->
                Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (GroupState s MutByteArray Int Int Int) (MutArray a)
 -> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a)))
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a b. (a -> b) -> a -> b
$ GroupState s MutByteArray Int Int Int
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip (MutByteArray
-> Int
-> Int
-> Int
-> GroupState s MutByteArray Int Int Int
-> GroupState s MutByteArray Int Int Int
forall s contents start end bound.
contents
-> start
-> end
-> bound
-> GroupState s contents start end bound
-> GroupState s contents start end bound
GroupYield MutByteArray
contents Int
start Int
end Int
bound GroupState s MutByteArray Int Int Int
forall s contents start end bound.
GroupState s contents start end bound
GroupFinish)

    step' State StreamK m a
_ (GroupYield MutByteArray
contents Int
start Int
end Int
bound GroupState s MutByteArray Int Int Int
next) =
        Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s MutByteArray Int Int Int) (MutArray a)
 -> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a)))
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a b. (a -> b) -> a -> b
$ MutArray a
-> GroupState s MutByteArray Int Int Int
-> Step (GroupState s MutByteArray Int Int Int) (MutArray a)
forall s a. a -> s -> Step s a
D.Yield (MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
contents Int
start Int
end Int
bound) GroupState s MutByteArray Int Int Int
next

    step' State StreamK m a
_ GroupState s MutByteArray Int Int Int
GroupFinish = Step (GroupState s MutByteArray Int Int Int) (MutArray a)
-> m (Step (GroupState s MutByteArray Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (GroupState s MutByteArray Int Int Int) (MutArray a)
forall s a. Step s a
D.Stop

-- | @chunksOf n stream@ groups the elements in the input stream into arrays of
-- @n@ elements each.
--
-- Same as the following but may be more efficient:
--
-- >>> chunksOf n = Stream.foldMany (MutArray.createOf n)
--
-- /Pre-release/
{-# INLINE_NORMAL chunksOf #-}
chunksOf :: forall m a. (MonadIO m, Unbox a)
    => Int -> D.Stream m a -> D.Stream m (MutArray a)
-- XXX the idiomatic implementation leads to large regression in the D.reverse'
-- benchmark. It seems it has difficulty producing optimized code when
-- converting to StreamK. Investigate GHC optimizations.
-- chunksOf n = D.foldMany (createOf n)
chunksOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> Stream m (MutArray a)
chunksOf = PinnedState -> Int -> Stream m a -> Stream m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Stream m a -> Stream m (MutArray a)
chunksOfAs PinnedState
Unpinned

-- | Like 'chunksOf' but creates pinned arrays.
{-# INLINE_NORMAL pinnedChunksOf #-}
pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)
    => Int -> D.Stream m a -> D.Stream m (MutArray a)
-- pinnedChunksOf n = D.foldMany (pinnedCreateOf n)
pinnedChunksOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> Stream m (MutArray a)
pinnedChunksOf = PinnedState -> Int -> Stream m a -> Stream m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Stream m a -> Stream m (MutArray a)
chunksOfAs PinnedState
Pinned

-- | When we are buffering a stream of unknown size into an array we do not
-- know how much space to pre-allocate. So we start with the min size and emit
-- the array then keep on doubling the size every time. Thus we do not need to
-- guess the optimum chunk size.
--
-- We can incorporate this in chunksOfAs if the additional size parameter does
-- not impact perf.
--
{-# INLINE _chunksOfRange #-}
_chunksOfRange :: -- (MonadIO m, Unbox a) =>
    PinnedState -> Int -> Int -> D.Stream m a -> D.Stream m (MutArray a)
_chunksOfRange :: forall (m :: * -> *) a.
PinnedState -> Int -> Int -> Stream m a -> Stream m (MutArray a)
_chunksOfRange PinnedState
_ps Int
_low Int
_hi = Stream m a -> Stream m (MutArray a)
forall a. (?callStack::CallStack) => a
undefined

-- XXX buffer to a list instead?
-- | Buffer the stream into arrays in memory.
{-# INLINE arrayStreamKFromStreamDAs #-}
arrayStreamKFromStreamDAs :: forall m a. (MonadIO m, Unbox a) =>
    PinnedState -> D.Stream m a -> m (StreamK m (MutArray a))
arrayStreamKFromStreamDAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Stream m a -> m (StreamK m (MutArray a))
arrayStreamKFromStreamDAs PinnedState
ps =
    let n :: Int
n = a -> Int -> Int
forall a. Unbox a => a -> Int -> Int
allocBytesToElemCount (a
forall a. (?callStack::CallStack) => a
undefined :: a) Int
defaultChunkSize
     in (MutArray a -> StreamK m (MutArray a) -> StreamK m (MutArray a))
-> StreamK m (MutArray a)
-> Stream m (MutArray a)
-> m (StreamK m (MutArray a))
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr MutArray a -> StreamK m (MutArray a) -> StreamK m (MutArray a)
forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
K.cons StreamK m (MutArray a)
forall (m :: * -> *) a. StreamK m a
K.nil (Stream m (MutArray a) -> m (StreamK m (MutArray a)))
-> (Stream m a -> Stream m (MutArray a))
-> Stream m a
-> m (StreamK m (MutArray a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinnedState -> Int -> Stream m a -> Stream m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Stream m a -> Stream m (MutArray a)
chunksOfAs PinnedState
ps Int
n

-------------------------------------------------------------------------------
-- Streams of arrays - Flattening
-------------------------------------------------------------------------------

data FlattenState s contents a =
      OuterLoop s
    | InnerLoop s contents !Int !Int

{-# INLINE_NORMAL concatWith #-}
concatWith :: forall m a. (Monad m, Unbox a)
    => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
concatWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a
concatWith forall b. IO b -> m b
liftio (D.Stream State StreamK m (MutArray a) -> s -> m (Step s (MutArray a))
step s
state) = (State StreamK m a
 -> FlattenState s MutByteArray Any
 -> m (Step (FlattenState s MutByteArray Any) a))
-> FlattenState s MutByteArray Any -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State StreamK m a
-> FlattenState s MutByteArray Any
-> m (Step (FlattenState s MutByteArray Any) a)
forall {a} {m :: * -> *} {a} {a} {a}.
Unbox a =>
State StreamK m a
-> FlattenState s MutByteArray a
-> m (Step (FlattenState s MutByteArray a) a)
step' (s -> FlattenState s MutByteArray Any
forall s contents a. s -> FlattenState s contents a
OuterLoop s
state)

    where

    {-# INLINE_LATE step' #-}
    step' :: State StreamK m a
-> FlattenState s MutByteArray a
-> m (Step (FlattenState s MutByteArray a) a)
step' State StreamK m a
gst (OuterLoop s
st) = do
        Step s (MutArray a)
r <- State StreamK m (MutArray a) -> s -> m (Step s (MutArray a))
step (State StreamK m a -> State StreamK m (MutArray a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s MutByteArray a) a
 -> m (Step (FlattenState s MutByteArray a) a))
-> Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a b. (a -> b) -> a -> b
$ case Step s (MutArray a)
r of
            D.Yield MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} s
s ->
                FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall s a. s -> Step s a
D.Skip (s -> MutByteArray -> Int -> Int -> FlattenState s MutByteArray a
forall s contents a.
s -> contents -> Int -> Int -> FlattenState s contents a
InnerLoop s
s MutByteArray
arrContents Int
arrStart Int
arrEnd)
            D.Skip s
s -> FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall s a. s -> Step s a
D.Skip (s -> FlattenState s MutByteArray a
forall s contents a. s -> FlattenState s contents a
OuterLoop s
s)
            Step s (MutArray a)
D.Stop -> Step (FlattenState s MutByteArray a) a
forall s a. Step s a
D.Stop

    step' State StreamK m a
_ (InnerLoop s
st MutByteArray
_ Int
p Int
end) | Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
end) (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end) =
        Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s MutByteArray a) a
 -> m (Step (FlattenState s MutByteArray a) a))
-> Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a b. (a -> b) -> a -> b
$ FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall s a. s -> Step s a
D.Skip (FlattenState s MutByteArray a
 -> Step (FlattenState s MutByteArray a) a)
-> FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall a b. (a -> b) -> a -> b
$ s -> FlattenState s MutByteArray a
forall s contents a. s -> FlattenState s contents a
OuterLoop s
st

    step' State StreamK m a
_ (InnerLoop s
st MutByteArray
contents Int
p Int
end) = do
        a
x <- IO a -> m a
forall b. IO b -> m b
liftio (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
contents
        Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s MutByteArray a) a
 -> m (Step (FlattenState s MutByteArray a) a))
-> Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a b. (a -> b) -> a -> b
$ a
-> FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall s a. a -> s -> Step s a
D.Yield a
x (s -> MutByteArray -> Int -> Int -> FlattenState s MutByteArray a
forall s contents a.
s -> contents -> Int -> Int -> FlattenState s contents a
InnerLoop s
st MutByteArray
contents (INDEX_NEXT(p,a)) end)

-- | Use the "reader" unfold instead.
--
-- @concat = unfoldMany reader@
--
-- We can try this if there are any fusion issues in the unfold.
--
{-# INLINE_NORMAL concat #-}
concat :: forall m a. (MonadIO m, Unbox a)
    => D.Stream m (MutArray a) -> D.Stream m a
concat :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m (MutArray a) -> Stream m a
concat = (forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a
concatWith IO b -> m b
forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}
{-# INLINE flattenArrays #-}
flattenArrays :: forall m a. (MonadIO m, Unbox a)
    => D.Stream m (MutArray a) -> D.Stream m a
flattenArrays :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m (MutArray a) -> Stream m a
flattenArrays = Stream m (MutArray a) -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m (MutArray a) -> Stream m a
concat

{-# INLINE_NORMAL concatRevWith #-}
concatRevWith :: forall m a. (Monad m, Unbox a)
    => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a
concatRevWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a
concatRevWith forall b. IO b -> m b
liftio (D.Stream State StreamK m (MutArray a) -> s -> m (Step s (MutArray a))
step s
state) = (State StreamK m a
 -> FlattenState s MutByteArray Any
 -> m (Step (FlattenState s MutByteArray Any) a))
-> FlattenState s MutByteArray Any -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State StreamK m a
-> FlattenState s MutByteArray Any
-> m (Step (FlattenState s MutByteArray Any) a)
forall {a} {m :: * -> *} {a} {a} {a}.
Unbox a =>
State StreamK m a
-> FlattenState s MutByteArray a
-> m (Step (FlattenState s MutByteArray a) a)
step' (s -> FlattenState s MutByteArray Any
forall s contents a. s -> FlattenState s contents a
OuterLoop s
state)

    where

    {-# INLINE_LATE step' #-}
    step' :: State StreamK m a
-> FlattenState s MutByteArray a
-> m (Step (FlattenState s MutByteArray a) a)
step' State StreamK m a
gst (OuterLoop s
st) = do
        Step s (MutArray a)
r <- State StreamK m (MutArray a) -> s -> m (Step s (MutArray a))
step (State StreamK m a -> State StreamK m (MutArray a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s MutByteArray a) a
 -> m (Step (FlattenState s MutByteArray a) a))
-> Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a b. (a -> b) -> a -> b
$ case Step s (MutArray a)
r of
            D.Yield MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} s
s ->
                let p :: Int
p = INDEX_PREV(arrEnd,a)
                 in FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall s a. s -> Step s a
D.Skip (s -> MutByteArray -> Int -> Int -> FlattenState s MutByteArray a
forall s contents a.
s -> contents -> Int -> Int -> FlattenState s contents a
InnerLoop s
s MutByteArray
arrContents Int
p Int
arrStart)
            D.Skip s
s -> FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall s a. s -> Step s a
D.Skip (s -> FlattenState s MutByteArray a
forall s contents a. s -> FlattenState s contents a
OuterLoop s
s)
            Step s (MutArray a)
D.Stop -> Step (FlattenState s MutByteArray a) a
forall s a. Step s a
D.Stop

    step' State StreamK m a
_ (InnerLoop s
st MutByteArray
_ Int
p Int
start) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
start =
        Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s MutByteArray a) a
 -> m (Step (FlattenState s MutByteArray a) a))
-> Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a b. (a -> b) -> a -> b
$ FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall s a. s -> Step s a
D.Skip (FlattenState s MutByteArray a
 -> Step (FlattenState s MutByteArray a) a)
-> FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall a b. (a -> b) -> a -> b
$ s -> FlattenState s MutByteArray a
forall s contents a. s -> FlattenState s contents a
OuterLoop s
st

    step' State StreamK m a
_ (InnerLoop s
st MutByteArray
contents Int
p Int
start) = do
        a
x <- IO a -> m a
forall b. IO b -> m b
liftio (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
contents
        let cur :: Int
cur = INDEX_PREV(p,a)
        Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s MutByteArray a) a
 -> m (Step (FlattenState s MutByteArray a) a))
-> Step (FlattenState s MutByteArray a) a
-> m (Step (FlattenState s MutByteArray a) a)
forall a b. (a -> b) -> a -> b
$ a
-> FlattenState s MutByteArray a
-> Step (FlattenState s MutByteArray a) a
forall s a. a -> s -> Step s a
D.Yield a
x (s -> MutByteArray -> Int -> Int -> FlattenState s MutByteArray a
forall s contents a.
s -> contents -> Int -> Int -> FlattenState s contents a
InnerLoop s
st MutByteArray
contents Int
cur Int
start)

-- | Use the "readerRev" unfold instead.
--
-- @concat = unfoldMany readerRev@
--
-- We can try this if there are any fusion issues in the unfold.
--
{-# INLINE_NORMAL concatRev #-}
concatRev :: forall m a. (MonadIO m, Unbox a)
    => D.Stream m (MutArray a) -> D.Stream m a
concatRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m (MutArray a) -> Stream m a
concatRev = (forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a
concatRevWith IO b -> m b
forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}
{-# INLINE flattenArraysRev #-}
flattenArraysRev :: forall m a. (MonadIO m, Unbox a)
    => D.Stream m (MutArray a) -> D.Stream m a
flattenArraysRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m (MutArray a) -> Stream m a
flattenArraysRev = Stream m (MutArray a) -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m (MutArray a) -> Stream m a
concatRev

-------------------------------------------------------------------------------
-- Unfolds
-------------------------------------------------------------------------------

data ArrayUnsafe a = ArrayUnsafe
    {-# UNPACK #-} !MutByteArray   -- contents
    {-# UNPACK #-} !Int                -- index 1
    {-# UNPACK #-} !Int                -- index 2

toArrayUnsafe :: MutArray a -> ArrayUnsafe a
toArrayUnsafe :: forall a. MutArray a -> ArrayUnsafe a
toArrayUnsafe (MutArray MutByteArray
contents Int
start Int
end Int
_) = MutByteArray -> Int -> Int -> ArrayUnsafe a
forall a. MutByteArray -> Int -> Int -> ArrayUnsafe a
ArrayUnsafe MutByteArray
contents Int
start Int
end

fromArrayUnsafe ::
#ifdef DEVBUILD
    Unbox a =>
#endif
    ArrayUnsafe a -> MutArray a
fromArrayUnsafe :: forall a. ArrayUnsafe a -> MutArray a
fromArrayUnsafe (ArrayUnsafe MutByteArray
contents Int
start Int
end) =
         MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
contents Int
start Int
end Int
end

{-# INLINE_NORMAL producerWith #-}
producerWith ::
       forall m a. (Monad m, Unbox a)
    => (forall b. IO b -> m b) -> Producer m (MutArray a) a
producerWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Producer m (MutArray a) a
producerWith forall b. IO b -> m b
liftio = (ArrayUnsafe a -> m (Step (ArrayUnsafe a) a))
-> (MutArray a -> m (ArrayUnsafe a))
-> (ArrayUnsafe a -> m (MutArray a))
-> Producer m (MutArray a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> (s -> m a) -> Producer m a b
Producer ArrayUnsafe a -> m (Step (ArrayUnsafe a) a)
forall {a} {a} {a}.
Unbox a =>
ArrayUnsafe a -> m (Step (ArrayUnsafe a) a)
step (ArrayUnsafe a -> m (ArrayUnsafe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayUnsafe a -> m (ArrayUnsafe a))
-> (MutArray a -> ArrayUnsafe a) -> MutArray a -> m (ArrayUnsafe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutArray a -> ArrayUnsafe a
forall a. MutArray a -> ArrayUnsafe a
toArrayUnsafe) ArrayUnsafe a -> m (MutArray a)
forall {a}. ArrayUnsafe a -> m (MutArray a)
extract
    where

    {-# INLINE_LATE step #-}
    step :: ArrayUnsafe a -> m (Step (ArrayUnsafe a) a)
step (ArrayUnsafe MutByteArray
_ Int
cur Int
end)
        | Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
end) (Int
cur Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end) = Step (ArrayUnsafe a) a -> m (Step (ArrayUnsafe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ArrayUnsafe a) a
forall s a. Step s a
D.Stop
    step (ArrayUnsafe MutByteArray
contents Int
cur Int
end) = do
            -- When we use a purely lazy Monad like Identity, we need to force a
            -- few actions for correctness and execution order sanity. We want
            -- the peek to occur right here and not lazily at some later point
            -- because we want the peek to be ordered with respect to the touch.
            !a
x <- IO a -> m a
forall b. IO b -> m b
liftio (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
cur MutByteArray
contents
            Step (ArrayUnsafe a) a -> m (Step (ArrayUnsafe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ArrayUnsafe a) a -> m (Step (ArrayUnsafe a) a))
-> Step (ArrayUnsafe a) a -> m (Step (ArrayUnsafe a) a)
forall a b. (a -> b) -> a -> b
$ a -> ArrayUnsafe a -> Step (ArrayUnsafe a) a
forall s a. a -> s -> Step s a
D.Yield a
x (MutByteArray -> Int -> Int -> ArrayUnsafe a
forall a. MutByteArray -> Int -> Int -> ArrayUnsafe a
ArrayUnsafe MutByteArray
contents (INDEX_NEXT(cur,a)) end)

    extract :: ArrayUnsafe a -> m (MutArray a)
extract = MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> m (MutArray a))
-> (ArrayUnsafe a -> MutArray a) -> ArrayUnsafe a -> m (MutArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayUnsafe a -> MutArray a
forall a. ArrayUnsafe a -> MutArray a
fromArrayUnsafe

-- | Resumable unfold of an array.
--
{-# INLINE_NORMAL producer #-}
producer :: forall m a. (MonadIO m, Unbox a) => Producer m (MutArray a) a
producer :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Producer m (MutArray a) a
producer = (forall b. IO b -> m b) -> Producer m (MutArray a) a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Producer m (MutArray a) a
producerWith IO b -> m b
forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Unfold an array into a stream.
--
{-# INLINE_NORMAL reader #-}
reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a
reader :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (MutArray a) a
reader = Producer m (MutArray a) a -> Unfold m (MutArray a) a
forall (m :: * -> *) a b. Producer m a b -> Unfold m a b
Producer.simplify Producer m (MutArray a) a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Producer m (MutArray a) a
producer

{-# INLINE_NORMAL readerRevWith #-}
readerRevWith ::
       forall m a. (Monad m, Unbox a)
    => (forall b. IO b -> m b) -> Unfold m (MutArray a) a
readerRevWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Unfold m (MutArray a) a
readerRevWith forall b. IO b -> m b
liftio = (ArrayUnsafe Any -> m (Step (ArrayUnsafe Any) a))
-> (MutArray a -> m (ArrayUnsafe Any)) -> Unfold m (MutArray a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold ArrayUnsafe Any -> m (Step (ArrayUnsafe Any) a)
forall {a} {a} {a}.
Unbox a =>
ArrayUnsafe a -> m (Step (ArrayUnsafe a) a)
step MutArray a -> m (ArrayUnsafe Any)
forall {m :: * -> *} {a} {a}.
Monad m =>
MutArray a -> m (ArrayUnsafe a)
inject
    where

    inject :: MutArray a -> m (ArrayUnsafe a)
inject (MutArray MutByteArray
contents Int
start Int
end Int
_) =
        let p :: Int
p = INDEX_PREV(end,a)
         in ArrayUnsafe a -> m (ArrayUnsafe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayUnsafe a -> m (ArrayUnsafe a))
-> ArrayUnsafe a -> m (ArrayUnsafe a)
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> ArrayUnsafe a
forall a. MutByteArray -> Int -> Int -> ArrayUnsafe a
ArrayUnsafe MutByteArray
contents Int
start Int
p

    {-# INLINE_LATE step #-}
    step :: ArrayUnsafe a -> m (Step (ArrayUnsafe a) a)
step (ArrayUnsafe MutByteArray
_ Int
start Int
p) | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
start = Step (ArrayUnsafe a) a -> m (Step (ArrayUnsafe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ArrayUnsafe a) a
forall s a. Step s a
D.Stop
    step (ArrayUnsafe MutByteArray
contents Int
start Int
p) = do
        !a
x <- IO a -> m a
forall b. IO b -> m b
liftio (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
contents
        Step (ArrayUnsafe a) a -> m (Step (ArrayUnsafe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ArrayUnsafe a) a -> m (Step (ArrayUnsafe a) a))
-> Step (ArrayUnsafe a) a -> m (Step (ArrayUnsafe a) a)
forall a b. (a -> b) -> a -> b
$ a -> ArrayUnsafe a -> Step (ArrayUnsafe a) a
forall s a. a -> s -> Step s a
D.Yield a
x (MutByteArray -> Int -> Int -> ArrayUnsafe a
forall a. MutByteArray -> Int -> Int -> ArrayUnsafe a
ArrayUnsafe MutByteArray
contents Int
start (INDEX_PREV(p,a)))

-- | Unfold an array into a stream in reverse order.
--
{-# INLINE_NORMAL readerRev #-}
readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a
readerRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Unfold m (MutArray a) a
readerRev = (forall b. IO b -> m b) -> Unfold m (MutArray a) a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> Unfold m (MutArray a) a
readerRevWith IO b -> m b
forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-------------------------------------------------------------------------------
-- to Lists and streams
-------------------------------------------------------------------------------

{-
-- Use foldr/build fusion to fuse with list consumers
-- This can be useful when using the IsList instance
{-# INLINE_LATE toListFB #-}
toListFB :: forall a b. Unbox a => (a -> b -> b) -> b -> MutArray a -> b
toListFB c n MutArray{..} = go arrStart
    where

    go p | assert (p <= arrEnd) (p == arrEnd) = n
    go p =
        -- unsafeInlineIO allows us to run this in Identity monad for pure
        -- toList/foldr case which makes them much faster due to not
        -- accumulating the list and fusing better with the pure consumers.
        --
        -- This should be safe as the array contents are guaranteed to be
        -- evaluated/written to before we peek at them.
        -- XXX
        let !x = unsafeInlineIO $ do
                    r <- peekAt arrContents p
                    return r
        in c x (go (PTR_NEXT(p,a)))
-}

-- XXX Monadic foldr/build fusion?
-- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion

-- | Convert a 'MutArray' into a list.
--
{-# INLINE toList #-}
toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]
toList :: forall (m :: * -> *) a. (MonadIO m, Unbox a) => MutArray a -> m [a]
toList MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = IO [a] -> m [a]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> m [a]) -> IO [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ Int -> IO [a]
forall {a}. Unbox a => Int -> IO [a]
go Int
arrStart
    where

    go :: Int -> IO [a]
go Int
p | Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrEnd) (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arrEnd) = [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    go Int
p = do
        a
x <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
arrContents
        (:) a
x ([a] -> [a]) -> IO [a] -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO [a]
go (INDEX_NEXT(p,a))

{-# INLINE_NORMAL toStreamWith #-}
toStreamWith ::
       forall m a. (Monad m, Unbox a)
    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
toStreamWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> MutArray a -> Stream m a
toStreamWith forall b. IO b -> m b
liftio MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = (State StreamK m a -> Int -> m (Step Int a)) -> Int -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State StreamK m a -> Int -> m (Step Int a)
forall {a} {p}. Unbox a => p -> Int -> m (Step Int a)
step Int
arrStart

    where

    {-# INLINE_LATE step #-}
    step :: p -> Int -> m (Step Int a)
step p
_ Int
p | Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrEnd) (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arrEnd) = Step Int a -> m (Step Int a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step Int a
forall s a. Step s a
D.Stop
    step p
_ Int
p = IO (Step Int a) -> m (Step Int a)
forall b. IO b -> m b
liftio (IO (Step Int a) -> m (Step Int a))
-> IO (Step Int a) -> m (Step Int a)
forall a b. (a -> b) -> a -> b
$ do
        a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
arrContents
        Step Int a -> IO (Step Int a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step Int a -> IO (Step Int a)) -> Step Int a -> IO (Step Int a)
forall a b. (a -> b) -> a -> b
$ a -> Int -> Step Int a
forall s a. a -> s -> Step s a
D.Yield a
r (INDEX_NEXT(p,a))

-- | Convert a 'MutArray' into a stream.
--
-- >>> read = Stream.unfold MutArray.reader
--
{-# INLINE_NORMAL read #-}
read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
read :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> Stream m a
read = (forall b. IO b -> m b) -> MutArray a -> Stream m a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> MutArray a -> Stream m a
toStreamWith IO b -> m b
forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

{-# INLINE toStreamKWith #-}
toStreamKWith ::
       forall m a. (Monad m, Unbox a)
    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a
toStreamKWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> MutArray a -> StreamK m a
toStreamKWith forall b. IO b -> m b
liftio MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = Int -> StreamK m a
forall {a}. Unbox a => Int -> StreamK m a
go Int
arrStart

    where

    go :: Int -> StreamK m a
go Int
p | Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrEnd) (Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arrEnd) = StreamK m a
forall (m :: * -> *) a. StreamK m a
K.nil
         | Bool
otherwise =
        let elemM :: IO a
elemM = Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
arrContents
        in IO a -> m a
forall b. IO b -> m b
liftio IO a
elemM m a -> StreamK m a -> StreamK m a
forall (m :: * -> *) a.
Monad m =>
m a -> StreamK m a -> StreamK m a
`K.consM` Int -> StreamK m a
go (INDEX_NEXT(p,a))

{-# INLINE toStreamK #-}
toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a
toStreamK :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> StreamK m a
toStreamK = (forall b. IO b -> m b) -> MutArray a -> StreamK m a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> MutArray a -> StreamK m a
toStreamKWith IO b -> m b
forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

{-# INLINE_NORMAL toStreamRevWith #-}
toStreamRevWith ::
       forall m a. (Monad m, Unbox a)
    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a
toStreamRevWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> MutArray a -> Stream m a
toStreamRevWith forall b. IO b -> m b
liftio MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    let p :: Int
p = INDEX_PREV(arrEnd,a)
    in (State StreamK m a -> Int -> m (Step Int a)) -> Int -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State StreamK m a -> Int -> m (Step Int a)
forall {a} {p}. Unbox a => p -> Int -> m (Step Int a)
step Int
p

    where

    {-# INLINE_LATE step #-}
    step :: p -> Int -> m (Step Int a)
step p
_ Int
p | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrStart = Step Int a -> m (Step Int a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step Int a
forall s a. Step s a
D.Stop
    step p
_ Int
p = IO (Step Int a) -> m (Step Int a)
forall b. IO b -> m b
liftio (IO (Step Int a) -> m (Step Int a))
-> IO (Step Int a) -> m (Step Int a)
forall a b. (a -> b) -> a -> b
$ do
        a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
arrContents
        Step Int a -> IO (Step Int a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step Int a -> IO (Step Int a)) -> Step Int a -> IO (Step Int a)
forall a b. (a -> b) -> a -> b
$ a -> Int -> Step Int a
forall s a. a -> s -> Step s a
D.Yield a
r (INDEX_PREV(p,a))

-- | Convert a 'MutArray' into a stream in reverse order.
--
-- >>> readRev = Stream.unfold MutArray.readerRev
--
{-# INLINE_NORMAL readRev #-}
readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a
readRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> Stream m a
readRev = (forall b. IO b -> m b) -> MutArray a -> Stream m a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> MutArray a -> Stream m a
toStreamRevWith IO b -> m b
forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

{-# INLINE toStreamKRevWith #-}
toStreamKRevWith ::
       forall m a. (Monad m, Unbox a)
    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a
toStreamKRevWith :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> MutArray a -> StreamK m a
toStreamKRevWith forall b. IO b -> m b
liftio MutArray {Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    let p :: Int
p = INDEX_PREV(arrEnd,a)
    in Int -> StreamK m a
forall {a}. Unbox a => Int -> StreamK m a
go Int
p

    where

    go :: Int -> StreamK m a
go Int
p | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrStart = StreamK m a
forall (m :: * -> *) a. StreamK m a
K.nil
         | Bool
otherwise =
        let elemM :: IO a
elemM = Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
arrContents
        in IO a -> m a
forall b. IO b -> m b
liftio IO a
elemM m a -> StreamK m a -> StreamK m a
forall (m :: * -> *) a.
Monad m =>
m a -> StreamK m a -> StreamK m a
`K.consM` Int -> StreamK m a
go (INDEX_PREV(p,a))

{-# INLINE toStreamKRev #-}
toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a
toStreamKRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> StreamK m a
toStreamKRev = (forall b. IO b -> m b) -> MutArray a -> StreamK m a
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
(forall b. IO b -> m b) -> MutArray a -> StreamK m a
toStreamKRevWith IO b -> m b
forall b. IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-------------------------------------------------------------------------------
-- Folding
-------------------------------------------------------------------------------

-- XXX Need something like "MutArray m a" enforcing monadic action to avoid the
-- possibility of such APIs.
--
-- | Strict left fold of an array.
{-# INLINE_NORMAL foldl' #-}
foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b
foldl' :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(b -> a -> b) -> b -> MutArray a -> m b
foldl' b -> a -> b
f b
z MutArray a
arr = (b -> a -> b) -> b -> Stream m a -> m b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> m b
D.foldl' b -> a -> b
f b
z (Stream m a -> m b) -> Stream m a -> m b
forall a b. (a -> b) -> a -> b
$ MutArray a -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> Stream m a
read MutArray a
arr

-- | Right fold of an array.
{-# INLINE_NORMAL foldr #-}
foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b
foldr :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a) =>
(a -> b -> b) -> b -> MutArray a -> m b
foldr a -> b -> b
f b
z MutArray a
arr = (a -> b -> b) -> b -> Stream m a -> m b
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr a -> b -> b
f b
z (Stream m a -> m b) -> Stream m a -> m b
forall a b. (a -> b) -> a -> b
$ MutArray a -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> Stream m a
read MutArray a
arr

-------------------------------------------------------------------------------
-- Folds
-------------------------------------------------------------------------------

-- Note: Arrays may be allocated with a specific alignment at the beginning of
-- the array. If you need to maintain that alignment on reallocations then you
-- can resize the array manually before append, using an aligned resize
-- operation.

-- XXX Keep the bound intact to not lose any free space? Perf impact?

-- | @unsafeAppendN n arr@ appends up to @n@ input items to the supplied
-- array.
--
-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory
-- corruption or segfault.
--
-- Any free space left in the array after appending @n@ elements is lost.
--
-- /Internal/
{-# INLINE_NORMAL unsafeAppendN #-}
unsafeAppendN :: forall m a. (MonadIO m, Unbox a) =>
       Int
    -> m (MutArray a)
    -> Fold m a (MutArray a)
unsafeAppendN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a) -> Fold m a (MutArray a)
unsafeAppendN Int
n m (MutArray a)
action = (ArrayUnsafe a -> MutArray a)
-> Fold m a (ArrayUnsafe a) -> Fold m a (MutArray a)
forall a b. (a -> b) -> Fold m a a -> Fold m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ArrayUnsafe a -> MutArray a
forall a. ArrayUnsafe a -> MutArray a
fromArrayUnsafe (Fold m a (ArrayUnsafe a) -> Fold m a (MutArray a))
-> Fold m a (ArrayUnsafe a) -> Fold m a (MutArray a)
forall a b. (a -> b) -> a -> b
$ (ArrayUnsafe a -> a -> m (ArrayUnsafe a))
-> m (ArrayUnsafe a) -> Fold m a (ArrayUnsafe a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
FL.foldlM' ArrayUnsafe a -> a -> m (ArrayUnsafe a)
forall {m :: * -> *} {a} {a} {a}.
(MonadIO m, Unbox a) =>
ArrayUnsafe a -> a -> m (ArrayUnsafe a)
step m (ArrayUnsafe a)
initial

    where

    initial :: m (ArrayUnsafe a)
initial = do
        Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        arr :: MutArray a
arr@(MutArray MutByteArray
_ Int
_ Int
end Int
bound) <- m (MutArray a)
action
        let free :: Int
free = Int
bound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
end
            needed :: Int
needed = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)
        -- XXX We can also reallocate if the array has too much free space,
        -- otherwise we lose that space.
        MutArray a
arr1 <-
            if Int
free Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
needed
            then ([Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a))
-> [Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
forall a. a -> a
noinline [Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
[Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith [Char]
"unsafeAppendN" (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
needed) Int
needed MutArray a
arr
            else MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
arr
        ArrayUnsafe a -> m (ArrayUnsafe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayUnsafe a -> m (ArrayUnsafe a))
-> ArrayUnsafe a -> m (ArrayUnsafe a)
forall a b. (a -> b) -> a -> b
$ MutArray a -> ArrayUnsafe a
forall a. MutArray a -> ArrayUnsafe a
toArrayUnsafe MutArray a
arr1

    step :: ArrayUnsafe a -> a -> m (ArrayUnsafe a)
step (ArrayUnsafe MutByteArray
contents Int
start Int
end) a
x = do
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
end MutByteArray
contents a
x
        ArrayUnsafe a -> m (ArrayUnsafe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayUnsafe a -> m (ArrayUnsafe a))
-> ArrayUnsafe a -> m (ArrayUnsafe a)
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> ArrayUnsafe a
forall a. MutByteArray -> Int -> Int -> ArrayUnsafe a
ArrayUnsafe MutByteArray
contents Int
start (INDEX_NEXT(end,a))

{-# DEPRECATED writeAppendNUnsafe "Please use unsafeAppendN instead." #-}
{-# INLINE writeAppendNUnsafe #-}
writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>
       Int
    -> m (MutArray a)
    -> Fold m a (MutArray a)
writeAppendNUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a) -> Fold m a (MutArray a)
writeAppendNUnsafe = Int -> m (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a) -> Fold m a (MutArray a)
unsafeAppendN

-- | Append @n@ elements to an existing array. Any free space left in the array
-- after appending @n@ elements is lost.
--
-- >>> appendN n initial = Fold.take n (MutArray.unsafeAppendN n initial)
--
{-# INLINE_NORMAL appendN #-}
appendN :: forall m a. (MonadIO m, Unbox a) =>
    Int -> m (MutArray a) -> Fold m a (MutArray a)
appendN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a) -> Fold m a (MutArray a)
appendN Int
n m (MutArray a)
initial = Int -> Fold m a (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
FL.take Int
n (Int -> m (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a) -> Fold m a (MutArray a)
unsafeAppendN Int
n m (MutArray a)
initial)

-- XXX Deprecate in major
-- {-# DEPRECATED writeAppendN "Please use appendN instead." #-}
{-# INLINE writeAppendN #-}
writeAppendN :: forall m a. (MonadIO m, Unbox a) =>
    Int -> m (MutArray a) -> Fold m a (MutArray a)
writeAppendN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a) -> Fold m a (MutArray a)
writeAppendN = Int -> m (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a) -> Fold m a (MutArray a)
appendN

-- | @appendWith realloc action@ mutates the array generated by @action@ to
-- append the input stream. If there is no reserved space available in the
-- array it is reallocated to a size in bytes  determined by @realloc oldSize@,
-- where @oldSize@ is the current size of the array in bytes.
--
-- Note that the returned array may be a mutated version of original array.
--
-- >>> appendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)
--
-- /Pre-release/
{-# INLINE appendWith #-}
appendWith :: forall m a. (MonadIO m, Unbox a) =>
    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
appendWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
appendWith Int -> Int
sizer = (MutArray a -> a -> m (MutArray a))
-> m (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
FL.foldlM' ((Int -> Int) -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith Int -> Int
sizer)

{-# DEPRECATED writeAppendWith "Please use appendWith instead." #-}
{-# INLINE writeAppendWith #-}
writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>
    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
writeAppendWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
writeAppendWith = (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
appendWith

-- | @append action@ mutates the array generated by @action@ to append the
-- input stream. If there is no reserved space available in the array it is
-- reallocated to double the size.
--
-- Note that the returned array may be a mutated version of original array.
--
-- >>> append = MutArray.appendWith (* 2)
--
{-# INLINE append #-}
append :: forall m a. (MonadIO m, Unbox a) =>
    m (MutArray a) -> Fold m a (MutArray a)
append :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
m (MutArray a) -> Fold m a (MutArray a)
append = (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)
appendWith (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)

-- XXX Deprecate in major
-- {-# DEPRECATED writeAppend "Please use append instead." #-}
{-# INLINE writeAppend #-}
writeAppend :: forall m a. (MonadIO m, Unbox a) =>
    m (MutArray a) -> Fold m a (MutArray a)
writeAppend :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
m (MutArray a) -> Fold m a (MutArray a)
writeAppend = m (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
m (MutArray a) -> Fold m a (MutArray a)
append

-- XXX We can carry bound as well in the state to make sure we do not lose the
-- remaining capacity. Need to check perf impact.
--
-- | Like 'unsafeCreateOf' but takes a new array allocator @alloc size@
-- function as argument.
--
-- >>> unsafeCreateOfWith alloc n = MutArray.unsafeAppendN (alloc n) n
--
-- /Pre-release/
{-# INLINE_NORMAL unsafeCreateOfWith #-}
unsafeCreateOfWith :: forall m a. (MonadIO m, Unbox a)
    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
unsafeCreateOfWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
unsafeCreateOfWith Int -> m (MutArray a)
alloc Int
n = ArrayUnsafe a -> MutArray a
forall a. ArrayUnsafe a -> MutArray a
fromArrayUnsafe (ArrayUnsafe a -> MutArray a)
-> Fold m a (ArrayUnsafe a) -> Fold m a (MutArray a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArrayUnsafe a -> a -> m (ArrayUnsafe a))
-> m (ArrayUnsafe a) -> Fold m a (ArrayUnsafe a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
FL.foldlM' ArrayUnsafe a -> a -> m (ArrayUnsafe a)
forall {m :: * -> *} {a} {a} {a}.
(MonadIO m, Unbox a) =>
ArrayUnsafe a -> a -> m (ArrayUnsafe a)
step m (ArrayUnsafe a)
initial

    where

    initial :: m (ArrayUnsafe a)
initial = MutArray a -> ArrayUnsafe a
forall a. MutArray a -> ArrayUnsafe a
toArrayUnsafe (MutArray a -> ArrayUnsafe a)
-> m (MutArray a) -> m (ArrayUnsafe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MutArray a)
alloc (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0)

    step :: ArrayUnsafe a -> a -> m (ArrayUnsafe a)
step (ArrayUnsafe MutByteArray
contents Int
start Int
end) a
x = do
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
end MutByteArray
contents a
x
        ArrayUnsafe a -> m (ArrayUnsafe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
          (ArrayUnsafe a -> m (ArrayUnsafe a))
-> ArrayUnsafe a -> m (ArrayUnsafe a)
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> ArrayUnsafe a
forall a. MutByteArray -> Int -> Int -> ArrayUnsafe a
ArrayUnsafe MutByteArray
contents Int
start (INDEX_NEXT(end,a))

{-# DEPRECATED writeNWithUnsafe "Please use unsafeCreateOfWith instead." #-}
{-# INLINE writeNWithUnsafe #-}
writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)
    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeNWithUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeNWithUnsafe = (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
unsafeCreateOfWith

{-# INLINE_NORMAL writeNUnsafeAs #-}
writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)
    => PinnedState -> Int -> Fold m a (MutArray a)
writeNUnsafeAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m a (MutArray a)
writeNUnsafeAs PinnedState
ps = (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
unsafeCreateOfWith (PinnedState -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> m (MutArray a)
newAs PinnedState
ps)

-- | Like 'createOf' but does not check the array bounds when writing. The fold
-- driver must not call the step function more than 'n' times otherwise it will
-- corrupt the memory and crash. This function exists mainly because any
-- conditional in the step function blocks fusion causing 10x performance
-- slowdown.
--
-- >>> unsafeCreateOf = MutArray.unsafeCreateOfWith MutArray.emptyOf
--
{-# INLINE_NORMAL unsafeCreateOf #-}
unsafeCreateOf :: forall m a. (MonadIO m, Unbox a)
    => Int -> Fold m a (MutArray a)
unsafeCreateOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
unsafeCreateOf = PinnedState -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m a (MutArray a)
writeNUnsafeAs PinnedState
Unpinned

{-# DEPRECATED writeNUnsafe "Please use unsafeCreateOf instead." #-}
{-# INLINE writeNUnsafe #-}
writeNUnsafe :: forall m a. (MonadIO m, Unbox a)
    => Int -> Fold m a (MutArray a)
writeNUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
writeNUnsafe = Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
unsafeCreateOf

-- | Like 'unsafeCreateOf' but creates a pinned array.
{-# INLINE_NORMAL unsafePinnedCreateOf #-}
unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a)
    => Int -> Fold m a (MutArray a)
unsafePinnedCreateOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
unsafePinnedCreateOf = PinnedState -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m a (MutArray a)
writeNUnsafeAs PinnedState
Pinned

{-# DEPRECATED pinnedWriteNUnsafe "Please use unsafePinnedCreateOf instead." #-}
{-# INLINE pinnedWriteNUnsafe #-}
pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)
    => Int -> Fold m a (MutArray a)
pinnedWriteNUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
pinnedWriteNUnsafe = Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
unsafePinnedCreateOf

-- | @createOfWith alloc n@ folds a maximum of @n@ elements into an array
-- allocated using the @alloc@ function.
--
-- >>> createOfWith alloc n = Fold.take n (MutArray.unsafeCreateOfWith alloc n)
-- >>> createOfWith alloc n = MutArray.appendN (alloc n) n
--
{-# INLINE_NORMAL createOfWith #-}
createOfWith :: forall m a. (MonadIO m, Unbox a)
    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
createOfWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
createOfWith Int -> m (MutArray a)
alloc Int
n = Int -> Fold m a (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
FL.take Int
n ((Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
unsafeCreateOfWith Int -> m (MutArray a)
alloc Int
n)

-- {-# DEPRECATED writeNWith "Please use createOfWith instead." #-}
{-# INLINE writeNWith #-}
writeNWith :: forall m a. (MonadIO m, Unbox a)
    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeNWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeNWith = (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
createOfWith

{-# INLINE_NORMAL writeNAs #-}
writeNAs ::
       forall m a. (MonadIO m, Unbox a)
    => PinnedState
    -> Int
    -> Fold m a (MutArray a)
writeNAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m a (MutArray a)
writeNAs PinnedState
ps = (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
createOfWith (PinnedState -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> m (MutArray a)
newAs PinnedState
ps)

-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an
-- 'MutArray'.
--
-- >>> createOf = MutArray.createOfWith MutArray.new
-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)
-- >>> createOf n = MutArray.appendN n (MutArray.emptyOf n)
--
{-# INLINE_NORMAL createOf #-}
createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
createOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
createOf = PinnedState -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m a (MutArray a)
writeNAs PinnedState
Unpinned

-- XXX Deprecate in major
-- {-# DEPRECATED writeN "Please use createOf instead." #-}
{-# INLINE writeN #-}
writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
writeN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
writeN = Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
createOf

-- | Like 'createOf' but creates a pinned array.
{-# INLINE_NORMAL pinnedCreateOf #-}
pinnedCreateOf ::
       forall m a. (MonadIO m, Unbox a)
    => Int
    -> Fold m a (MutArray a)
pinnedCreateOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
pinnedCreateOf = PinnedState -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m a (MutArray a)
writeNAs PinnedState
Pinned

{-# DEPRECATED pinnedWriteN "Please use pinnedCreateOf instead." #-}
{-# INLINE pinnedWriteN #-}
pinnedWriteN ::
       forall m a. (MonadIO m, Unbox a)
    => Int
    -> Fold m a (MutArray a)
pinnedWriteN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
pinnedWriteN = Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
pinnedCreateOf

-- | Like unsafeCreateOfWith but writes the array in reverse order.
--
-- /Internal/
{-# INLINE_NORMAL writeRevNWithUnsafe #-}
writeRevNWithUnsafe :: forall m a. (MonadIO m, Unbox a)
    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeRevNWithUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeRevNWithUnsafe Int -> m (MutArray a)
alloc Int
n = ArrayUnsafe a -> MutArray a
forall a. ArrayUnsafe a -> MutArray a
fromArrayUnsafe (ArrayUnsafe a -> MutArray a)
-> Fold m a (ArrayUnsafe a) -> Fold m a (MutArray a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArrayUnsafe a -> a -> m (ArrayUnsafe a))
-> m (ArrayUnsafe a) -> Fold m a (ArrayUnsafe a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
FL.foldlM' ArrayUnsafe a -> a -> m (ArrayUnsafe a)
forall {m :: * -> *} {a} {a} {a}.
(MonadIO m, Unbox a) =>
ArrayUnsafe a -> a -> m (ArrayUnsafe a)
step m (ArrayUnsafe a)
forall {a}. m (ArrayUnsafe a)
initial

    where

    toArrayUnsafeRev :: MutArray a -> ArrayUnsafe a
toArrayUnsafeRev (MutArray MutByteArray
contents Int
_ Int
_ Int
bound) =
         MutByteArray -> Int -> Int -> ArrayUnsafe a
forall a. MutByteArray -> Int -> Int -> ArrayUnsafe a
ArrayUnsafe MutByteArray
contents Int
bound Int
bound

    initial :: m (ArrayUnsafe a)
initial = MutArray a -> ArrayUnsafe a
forall {a} {a}. MutArray a -> ArrayUnsafe a
toArrayUnsafeRev (MutArray a -> ArrayUnsafe a)
-> m (MutArray a) -> m (ArrayUnsafe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MutArray a)
alloc (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0)

    step :: ArrayUnsafe a -> a -> m (ArrayUnsafe a)
step (ArrayUnsafe MutByteArray
contents Int
start Int
end) a
x = do
        let ptr :: Int
ptr = INDEX_PREV(start,a)
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
ptr MutByteArray
contents a
x
        ArrayUnsafe a -> m (ArrayUnsafe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
          (ArrayUnsafe a -> m (ArrayUnsafe a))
-> ArrayUnsafe a -> m (ArrayUnsafe a)
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> ArrayUnsafe a
forall a. MutByteArray -> Int -> Int -> ArrayUnsafe a
ArrayUnsafe MutByteArray
contents Int
ptr Int
end

-- | Like createOfWith but writes the array in reverse order.
--
-- /Internal/
{-# INLINE_NORMAL writeRevNWith #-}
writeRevNWith :: forall m a. (MonadIO m, Unbox a)
    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeRevNWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeRevNWith Int -> m (MutArray a)
alloc Int
n = Int -> Fold m a (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
FL.take Int
n ((Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeRevNWithUnsafe Int -> m (MutArray a)
alloc Int
n)

-- | Like 'createOf' but writes the array in reverse order.
--
-- /Pre-release/
{-# INLINE_NORMAL revCreateOf #-}
revCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
revCreateOf :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
revCreateOf = (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
writeRevNWith Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
new

{-# DEPRECATED writeRevN "Please use revCreateOf instead." #-}
{-# INLINE writeRevN #-}
writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)
writeRevN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
writeRevN = Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
revCreateOf

-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the
-- input stream to a 'MutArray' aligned to the given size.
--
-- >>> pinnedWriteNAligned align = MutArray.createOfWith (MutArray.pinnedNewAligned align)
-- >>> pinnedWriteNAligned align n = MutArray.appendN n (MutArray.pinnedNewAligned align n)
--
-- /Pre-release/
--
{-# INLINE_NORMAL pinnedWriteNAligned #-}
pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)
    => Int -> Int -> Fold m a (MutArray a)
pinnedWriteNAligned :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Int -> Fold m a (MutArray a)
pinnedWriteNAligned Int
align = (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)
createOfWith (Int -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Int -> m (MutArray a)
pinnedNewAligned Int
align)

-- XXX Buffer to a list instead?

-- | Buffer a stream into a stream of arrays.
--
-- >>> buildChunks n = Fold.many (MutArray.createOf n) Fold.toStreamK
--
-- Breaking an array into an array stream  can be useful to consume a large
-- array sequentially such that memory of the array is released incrementatlly.
--
-- See also: 'arrayStreamKFromStreamD'.
--
-- /Unimplemented/
--
{-# INLINE_NORMAL buildChunks #-}
buildChunks :: (MonadIO m, Unbox a) =>
    Int -> Fold m a (StreamK n (MutArray a))
buildChunks :: forall (m :: * -> *) a (n :: * -> *).
(MonadIO m, Unbox a) =>
Int -> Fold m a (StreamK n (MutArray a))
buildChunks Int
n = Fold m a (MutArray a)
-> Fold m (MutArray a) (StreamK n (MutArray a))
-> Fold m a (StreamK n (MutArray a))
forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
FL.many (Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
createOf Int
n) Fold m (MutArray a) (StreamK n (MutArray a))
forall (m :: * -> *) a (n :: * -> *).
Monad m =>
Fold m a (StreamK n a)
FL.toStreamK

{-# DEPRECATED writeChunks "Please use buildChunks instead." #-}
{-# INLINE writeChunks #-}
writeChunks :: (MonadIO m, Unbox a) =>
    Int -> Fold m a (StreamK n (MutArray a))
writeChunks :: forall (m :: * -> *) a (n :: * -> *).
(MonadIO m, Unbox a) =>
Int -> Fold m a (StreamK n (MutArray a))
writeChunks = Int -> Fold m a (StreamK n (MutArray a))
forall (m :: * -> *) a (n :: * -> *).
(MonadIO m, Unbox a) =>
Int -> Fold m a (StreamK n (MutArray a))
buildChunks

{-# INLINE_NORMAL writeWithAs #-}
writeWithAs :: forall m a. (MonadIO m, Unbox a)
    => PinnedState -> Int -> Fold m a (MutArray a)
-- writeWithAs ps n = FL.rmapM rightSize $ appendWith (* 2) (newAs ps n)
writeWithAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m a (MutArray a)
writeWithAs PinnedState
ps Int
elemCount =
    (MutArray a -> m (MutArray a))
-> Fold m a (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
FL.rmapM MutArray a -> m (MutArray a)
extract (Fold m a (MutArray a) -> Fold m a (MutArray a))
-> Fold m a (MutArray a) -> Fold m a (MutArray a)
forall a b. (a -> b) -> a -> b
$ (MutArray a -> a -> m (MutArray a))
-> m (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
FL.foldlM' MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (MutArray a)
step m (MutArray a)
initial

    where

    initial :: m (MutArray a)
initial = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
elemCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"createWith: elemCount is negative"
        PinnedState -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> m (MutArray a)
newAs PinnedState
ps Int
elemCount

    step :: MutArray a -> a -> m (MutArray a)
step arr :: MutArray a
arr@(MutArray MutByteArray
_ Int
start Int
end Int
bound) a
x
        | INDEX_NEXT(end,a) > bound = do
        let oldSize = end - start
            newSize = max (oldSize * 2) 1
        arr1 <- liftIO $ reallocExplicitAs ps (SIZE_OF(a)) newSize arr
        snocUnsafe arr1 x
    step MutArray a
arr a
x = MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> a -> m (MutArray a)
snocUnsafe MutArray a
arr a
x

    extract :: MutArray a -> m (MutArray a)
extract = IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> (MutArray a -> IO (MutArray a)) -> MutArray a -> m (MutArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutArray a -> IO (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> m (MutArray a)
rightSize

-- XXX Compare createWith with fromStreamD which uses an array of streams
-- implementation. We can write this using buildChunks above if that is faster.
-- If createWith is faster then we should use that to implement
-- fromStreamD.
--
-- XXX The realloc based implementation needs to make one extra copy if we use
-- shrinkToFit.  On the other hand, the stream of arrays implementation may
-- buffer the array chunk pointers in memory but it does not have to shrink as
-- we know the exact size in the end. However, memory copying does not seem to
-- be as expensive as the allocations. Therefore, we need to reduce the number
-- of allocations instead. Also, the size of allocations matters, right sizing
-- an allocation even at the cost of copying sems to help.  Should be measured
-- on a big stream with heavy calls to toArray to see the effect.
--
-- XXX check if GHC's memory allocator is efficient enough. We can try the C
-- malloc to compare against.

-- | @createWith minCount@ folds the whole input to a single array. The array
-- starts at a size big enough to hold minCount elements, the size is doubled
-- every time the array needs to be grown.
--
-- /Caution! Do not use this on infinite streams./
--
-- >>> f n = MutArray.appendWith (* 2) (MutArray.emptyOf n)
-- >>> createWith n = Fold.rmapM MutArray.rightSize (f n)
-- >>> createWith n = Fold.rmapM MutArray.fromChunksK (MutArray.buildChunks n)
--
-- /Pre-release/
{-# INLINE_NORMAL createWith #-}
createWith :: forall m a. (MonadIO m, Unbox a)
    => Int -> Fold m a (MutArray a)
-- createWith n = FL.rmapM rightSize $ appendWith (* 2) (emptyOf n)
createWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
createWith = PinnedState -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m a (MutArray a)
writeWithAs PinnedState
Unpinned

{-# DEPRECATED writeWith "Please use createWith instead." #-}
{-# INLINE writeWith #-}
writeWith :: forall m a. (MonadIO m, Unbox a)
    => Int -> Fold m a (MutArray a)
writeWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
writeWith = Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
createWith

-- | Fold the whole input to a single array.
--
-- Same as 'createWith' using an initial array size of 'arrayChunkBytes' bytes
-- rounded up to the element size.
--
-- /Caution! Do not use this on infinite streams./
--
{-# INLINE create #-}
create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
create :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Fold m a (MutArray a)
create = Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
createWith (a -> Int -> Int
forall a. Unbox a => a -> Int -> Int
allocBytesToElemCount (a
forall a. (?callStack::CallStack) => a
undefined :: a) Int
arrayChunkBytes)

-- XXX Deprecate in major
-- {-# DEPRECATED write "Please use create instead." #-}
{-# INLINE write #-}
write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
write :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Fold m a (MutArray a)
write = Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Fold m a (MutArray a)
create

-- | Like 'create' but creates a pinned array.
{-# INLINE pinnedCreate #-}
pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
pinnedCreate :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Fold m a (MutArray a)
pinnedCreate =
    PinnedState -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m a (MutArray a)
writeWithAs PinnedState
Pinned (a -> Int -> Int
forall a. Unbox a => a -> Int -> Int
allocBytesToElemCount (a
forall a. (?callStack::CallStack) => a
undefined :: a) Int
arrayChunkBytes)

{-# DEPRECATED pinnedWrite "Please use pinnedCreate instead." #-}
{-# INLINE pinnedWrite #-}
pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)
pinnedWrite :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Fold m a (MutArray a)
pinnedWrite = Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Fold m a (MutArray a)
pinnedCreate

-------------------------------------------------------------------------------
-- construct from streams, known size
-------------------------------------------------------------------------------

{-# INLINE_NORMAL fromStreamDNAs #-}
fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)
    => PinnedState -> Int -> D.Stream m a -> m (MutArray a)
fromStreamDNAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Stream m a -> m (MutArray a)
fromStreamDNAs PinnedState
ps Int
limit Stream m a
str = do
    (MutArray a
arr :: MutArray a) <- PinnedState -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> m (MutArray a)
newAs PinnedState
ps Int
limit
    Int
end <- (Int -> a -> m Int) -> m Int -> Stream m a -> m Int
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Stream m a -> m b
D.foldlM' (MutByteArray -> Int -> a -> m Int
forall {m :: * -> *} {a}.
(MonadIO m, Unbox a) =>
MutByteArray -> Int -> a -> m Int
fwrite (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr)) (Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
arr) (Stream m a -> m Int) -> Stream m a -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Stream m a -> Stream m a
forall (m :: * -> *) a.
Applicative m =>
Int -> Stream m a -> Stream m a
D.take Int
limit Stream m a
str
    MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> m (MutArray a)) -> MutArray a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutArray a
arr {arrEnd = end}

    where

    fwrite :: MutByteArray -> Int -> a -> m Int
fwrite MutByteArray
arrContents Int
ptr a
x = do
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
ptr MutByteArray
arrContents  a
x
        Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ INDEX_NEXT(ptr,a)

-- | Use the 'createOf' fold instead.
--
-- >>> fromStreamN n = Stream.fold (MutArray.createOf n)
--
{-# INLINE_NORMAL fromStreamN #-}
fromStreamN :: forall m a. (MonadIO m, Unbox a)
    => Int -> D.Stream m a -> m (MutArray a)
-- fromStreamDN n = D.fold (createOf n)
fromStreamN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> m (MutArray a)
fromStreamN = PinnedState -> Int -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Stream m a -> m (MutArray a)
fromStreamDNAs PinnedState
Unpinned

{-# DEPRECATED fromStreamDN "Please use fromStreamN instead." #-}
{-# INLINE fromStreamDN #-}
fromStreamDN :: forall m a. (MonadIO m, Unbox a)
    => Int -> D.Stream m a -> m (MutArray a)
fromStreamDN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> m (MutArray a)
fromStreamDN = Int -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> m (MutArray a)
fromStreamN

-- | Create a 'MutArray' from the first N elements of a list. The array is
-- allocated to size N, if the list terminates before N elements then the
-- array may hold less than N elements.
--
{-# INLINABLE fromListN #-}
fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
fromListN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> [a] -> m (MutArray a)
fromListN Int
n [a]
xs = Int -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m a -> m (MutArray a)
fromStreamDN Int
n (Stream m a -> m (MutArray a)) -> Stream m a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream m a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs

-- | Like 'fromListN' but creates a pinned array.
{-# INLINABLE pinnedFromListN #-}
pinnedFromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
pinnedFromListN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> [a] -> m (MutArray a)
pinnedFromListN Int
n [a]
xs = PinnedState -> Int -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Stream m a -> m (MutArray a)
fromStreamDNAs PinnedState
Pinned Int
n (Stream m a -> m (MutArray a)) -> Stream m a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream m a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs

-- | Like fromListN but writes the array in reverse order.
--
-- /Pre-release/
{-# INLINE fromListRevN #-}
fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)
fromListRevN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> [a] -> m (MutArray a)
fromListRevN Int
n [a]
xs = Fold m a (MutArray a) -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold (Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
revCreateOf Int
n) (Stream m a -> m (MutArray a)) -> Stream m a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream m a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs

-- | Convert a pure stream in Identity monad to a mutable array.
{-# INLINABLE fromPureStreamN #-}
fromPureStreamN :: (MonadIO m, Unbox a) =>
    Int -> Stream Identity a -> m (MutArray a)
fromPureStreamN :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream Identity a -> m (MutArray a)
fromPureStreamN Int
n Stream Identity a
xs =
    Fold m a (MutArray a) -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold (Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m a (MutArray a)
createOf Int
n) (Stream m a -> m (MutArray a)) -> Stream m a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ (forall x. Identity x -> m x) -> Stream Identity a -> Stream m a
forall (n :: * -> *) (m :: * -> *) a.
Monad n =>
(forall x. m x -> n x) -> Stream m a -> Stream n a
D.morphInner (x -> m x
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> m x) -> (Identity x -> x) -> Identity x -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> x
forall a. Identity a -> a
runIdentity) Stream Identity a
xs

-- | Convert a pure stream in Identity monad to a mutable array.
{-# INLINABLE fromPureStream #-}
fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)
fromPureStream :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream Identity a -> m (MutArray a)
fromPureStream Stream Identity a
xs =
    Fold m a (MutArray a) -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Fold m a (MutArray a)
create (Stream m a -> m (MutArray a)) -> Stream m a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ (forall x. Identity x -> m x) -> Stream Identity a -> Stream m a
forall (n :: * -> *) (m :: * -> *) a.
Monad n =>
(forall x. m x -> n x) -> Stream m a -> Stream n a
D.morphInner (x -> m x
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> m x) -> (Identity x -> x) -> Identity x -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> x
forall a. Identity a -> a
runIdentity) Stream Identity a
xs

{-# INLINABLE fromPtrN #-}
fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)
fromPtrN :: forall (m :: * -> *).
MonadIO m =>
Int -> Ptr Word8 -> m (MutArray Word8)
fromPtrN Int
len Ptr Word8
addr = do
    -- memcpy is better than stream copy when the size is known.
    -- XXX We can implement a stream copy in a similar way by streaming Word64
    -- first and then remaining Word8.
    MutArray Word8
arr <- Int -> m (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
new Int
len
    Ptr Word8
_ <- MutArray Word8 -> (Ptr Word8 -> m (Ptr Word8)) -> m (Ptr Word8)
forall (m :: * -> *) a b.
MonadIO m =>
MutArray a -> (Ptr a -> m b) -> m b
unsafeAsPtr MutArray Word8
arr
            (\Ptr Word8
ptr -> IO (Ptr Word8) -> m (Ptr Word8)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Word8) -> m (Ptr Word8))
-> IO (Ptr Word8) -> m (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
c_memcpy Ptr Word8
ptr Ptr Word8
addr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
    MutArray Word8 -> m (MutArray Word8)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray Word8
arr {arrEnd = len})

{-# INLINABLE fromByteStr# #-}
fromByteStr# :: MonadIO m => Addr# -> m (MutArray Word8)
fromByteStr# :: forall (m :: * -> *). MonadIO m => Addr# -> m (MutArray Word8)
fromByteStr# Addr#
addr = do
    -- It is better to count the size first and allocate exact space.
    -- Also, memcpy is better than stream copy when the size is known.
    -- C strlen compares 4 bytes at a time, so is better than the stream
    -- version. https://github.com/bminor/glibc/blob/master/string/strlen.c
    -- XXX We can possibly use a stream of Word64 to do the same.
    -- fromByteStr# addr = fromPureStream (D.fromByteStr# addr)
    CSize
len <- IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> IO CSize
c_strlen (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr)
    let lenInt :: Int
lenInt = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len
    MutArray Word8
arr <- Int -> m (MutArray Word8)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
new Int
lenInt
    Ptr Word8
_ <- MutArray Word8 -> (Ptr Word8 -> m (Ptr Word8)) -> m (Ptr Word8)
forall (m :: * -> *) a b.
MonadIO m =>
MutArray a -> (Ptr a -> m b) -> m b
unsafeAsPtr MutArray Word8
arr (\Ptr Word8
ptr -> IO (Ptr Word8) -> m (Ptr Word8)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Word8) -> m (Ptr Word8))
-> IO (Ptr Word8) -> m (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
c_memcpy Ptr Word8
ptr (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr) CSize
len)
    MutArray Word8 -> m (MutArray Word8)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray Word8
arr {arrEnd = lenInt})

-------------------------------------------------------------------------------
-- convert a stream of arrays to a single array by reallocating and copying
-------------------------------------------------------------------------------

-- XXX Both of these implementations of splicing seem to perform equally well.
-- We need to perform benchmarks over a range of sizes though.

-- | Also see 'fromChunksK'.
{-# INLINE fromChunksRealloced #-}
fromChunksRealloced :: forall m a. (MonadIO m, Unbox a)
    => Stream m (MutArray a) -> m (MutArray a)
fromChunksRealloced :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m (MutArray a) -> m (MutArray a)
fromChunksRealloced Stream m (MutArray a)
s = do
    Maybe (MutArray a, Stream m (MutArray a))
res <- Stream m (MutArray a)
-> m (Maybe (MutArray a, Stream m (MutArray a)))
forall (m :: * -> *) a.
Monad m =>
Stream m a -> m (Maybe (a, Stream m a))
D.uncons Stream m (MutArray a)
s
    case Maybe (MutArray a, Stream m (MutArray a))
res of
        Just (MutArray a
a, Stream m (MutArray a)
strm) -> do
            MutArray a
arr <- (MutArray a -> MutArray a -> m (MutArray a))
-> m (MutArray a) -> Stream m (MutArray a) -> m (MutArray a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Stream m a -> m b
D.foldlM' MutArray a -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> MutArray a -> m (MutArray a)
spliceExp (MutArray a -> m (MutArray a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutArray a
a) Stream m (MutArray a)
strm
            -- Reallocation is exponential so there may be 50% empty space in
            -- worst case. One more reallocation to reclaim the space.
            MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> m (MutArray a)
rightSize MutArray a
arr
        Maybe (MutArray a, Stream m (MutArray a))
Nothing -> MutArray a -> m (MutArray a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutArray a
forall a. MutArray a
nil

-------------------------------------------------------------------------------
-- convert a stream of arrays to a single array by buffering arrays first
-------------------------------------------------------------------------------

{-# INLINE arrayStreamKLength #-}
arrayStreamKLength :: (Monad m, Unbox a) => StreamK m (MutArray a) -> m Int
arrayStreamKLength :: forall (m :: * -> *) a.
(Monad m, Unbox a) =>
StreamK m (MutArray a) -> m Int
arrayStreamKLength StreamK m (MutArray a)
as = (Int -> Int -> Int) -> Int -> StreamK m Int -> m Int
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> StreamK m a -> m b
K.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ((MutArray a -> Int) -> StreamK m (MutArray a) -> StreamK m Int
forall a b (m :: * -> *). (a -> b) -> StreamK m a -> StreamK m b
K.map MutArray a -> Int
forall a. Unbox a => MutArray a -> Int
length StreamK m (MutArray a)
as)

-- | Convert an array stream to an array. Note that this requires peak memory
-- that is double the size of the array stream.
--
{-# INLINE fromChunkskAs #-}
fromChunkskAs :: (Unbox a, MonadIO m) =>
    PinnedState -> StreamK m (MutArray a) -> m (MutArray a)
fromChunkskAs :: forall a (m :: * -> *).
(Unbox a, MonadIO m) =>
PinnedState -> StreamK m (MutArray a) -> m (MutArray a)
fromChunkskAs PinnedState
ps StreamK m (MutArray a)
as = do
    Int
len <- StreamK m (MutArray a) -> m Int
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
StreamK m (MutArray a) -> m Int
arrayStreamKLength StreamK m (MutArray a)
as
    MutArray a
arr <- PinnedState -> Int -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> m (MutArray a)
newAs PinnedState
ps Int
len
    -- XXX is StreamK fold faster or StreamD fold?
    (MutArray a -> MutArray a -> m (MutArray a))
-> m (MutArray a) -> StreamK m (MutArray a) -> m (MutArray a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> StreamK m a -> m b
K.foldlM' MutArray a -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
spliceUnsafe (MutArray a -> m (MutArray a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutArray a
arr) StreamK m (MutArray a)
as
    -- fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as

-- XXX Need to compare this with fromChunks and fromChunkList and keep the
-- fastest or simplest one if all are equally fast.

-- | Convert an array stream to an array. Note that this requires peak memory
-- that is double the size of the array stream.
--
-- Also see 'fromChunksRealloced'.
--
{-# INLINE fromChunksK #-}
fromChunksK :: (Unbox a, MonadIO m) =>
    StreamK m (MutArray a) -> m (MutArray a)
fromChunksK :: forall a (m :: * -> *).
(Unbox a, MonadIO m) =>
StreamK m (MutArray a) -> m (MutArray a)
fromChunksK = PinnedState -> StreamK m (MutArray a) -> m (MutArray a)
forall a (m :: * -> *).
(Unbox a, MonadIO m) =>
PinnedState -> StreamK m (MutArray a) -> m (MutArray a)
fromChunkskAs PinnedState
Unpinned

{-# DEPRECATED fromArrayStreamK "Please use fromChunksK instead." #-}
{-# INLINE fromArrayStreamK #-}
fromArrayStreamK :: (Unbox a, MonadIO m) =>
    StreamK m (MutArray a) -> m (MutArray a)
fromArrayStreamK :: forall a (m :: * -> *).
(Unbox a, MonadIO m) =>
StreamK m (MutArray a) -> m (MutArray a)
fromArrayStreamK = StreamK m (MutArray a) -> m (MutArray a)
forall a (m :: * -> *).
(Unbox a, MonadIO m) =>
StreamK m (MutArray a) -> m (MutArray a)
fromChunksK

{-# INLINE fromStreamDAs #-}
fromStreamDAs ::
       (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)
fromStreamDAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Stream m a -> m (MutArray a)
fromStreamDAs PinnedState
ps Stream m a
m =
    PinnedState -> Stream m a -> m (StreamK m (MutArray a))
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Stream m a -> m (StreamK m (MutArray a))
arrayStreamKFromStreamDAs PinnedState
Unpinned Stream m a
m m (StreamK m (MutArray a))
-> (StreamK m (MutArray a) -> m (MutArray a)) -> m (MutArray a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PinnedState -> StreamK m (MutArray a) -> m (MutArray a)
forall a (m :: * -> *).
(Unbox a, MonadIO m) =>
PinnedState -> StreamK m (MutArray a) -> m (MutArray a)
fromChunkskAs PinnedState
ps

-- | Create an 'Array' from a stream. This is useful when we want to create a
-- single array from a stream of unknown size. 'createOf' is at least twice
-- as efficient when the size is already known.
--
-- Note that if the input stream is too large memory allocation for the array
-- may fail.  When the stream size is not known, `chunksOf` followed by
-- processing of indvidual arrays in the resulting stream should be preferred.
--
-- /Pre-release/
{-# INLINE fromStream #-}
fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)
fromStream :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m a -> m (MutArray a)
fromStream = PinnedState -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Stream m a -> m (MutArray a)
fromStreamDAs PinnedState
Unpinned

-- fromStream (Stream m) = P.fold create m
-- CAUTION: a very large number (millions) of arrays can degrade performance
-- due to GC overhead because we need to buffer the arrays before we flatten
-- all the arrays.
--
-- XXX Compare if this is faster or "fold create".
--
-- | We could take the approach of doubling the memory allocation on each
-- overflow. This would result in more or less the same amount of copying as in
-- the chunking approach. However, if we have to shrink in the end then it may
-- result in an extra copy of the entire data.
--
-- >>> fromStreamD = StreamD.fold MutArray.create
--
{-# INLINE fromStreamD #-}
{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}
fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)
fromStreamD :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m a -> m (MutArray a)
fromStreamD = Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m a -> m (MutArray a)
fromStream

-- | Create a 'MutArray' from a list. The list must be of finite size.
--
{-# INLINE fromList #-}
fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)
fromList :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
[a] -> m (MutArray a)
fromList [a]
xs = Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Stream m a -> m (MutArray a)
fromStreamD (Stream m a -> m (MutArray a)) -> Stream m a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream m a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs

-- | Like 'fromList' but creates a pinned array.
{-# INLINE pinnedFromList #-}
pinnedFromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)
pinnedFromList :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
[a] -> m (MutArray a)
pinnedFromList [a]
xs = PinnedState -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Stream m a -> m (MutArray a)
fromStreamDAs PinnedState
Pinned (Stream m a -> m (MutArray a)) -> Stream m a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream m a
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs

-- XXX We are materializing the whole list first for getting the length. Check
-- if the 'fromList' like chunked implementation would fare better.

-- | Like 'fromList' but writes the contents of the list in reverse order.
{-# INLINE fromListRev #-}
fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)
fromListRev :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
[a] -> m (MutArray a)
fromListRev [a]
xs = Int -> [a] -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> [a] -> m (MutArray a)
fromListRevN ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [a]
xs) [a]
xs

-------------------------------------------------------------------------------
-- Cloning
-------------------------------------------------------------------------------

-- Arrays are aligned on 64-bit boundaries. The fastest way to copy an array is
-- to unsafeCast it to Word64, read it, write it to Word64 array and unsafeCast
-- it again. We can use SIMD read/write as well.

{-# INLINE cloneAs #-}
cloneAs ::
    ( MonadIO m
#ifdef DEVBUILD
    , Unbox a
#endif
    )
    => PinnedState -> MutArray a -> m (MutArray a)
cloneAs :: forall (m :: * -> *) a.
MonadIO m =>
PinnedState -> MutArray a -> m (MutArray a)
cloneAs PinnedState
ps MutArray a
src =
    do
        let startSrc :: Int
startSrc = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
src
            srcLen :: Int
srcLen = MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
src Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startSrc
        MutByteArray
newArrContents <-
            PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray
forall (m :: * -> *).
MonadIO m =>
PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray
Unboxed.cloneSliceUnsafeAs PinnedState
ps Int
startSrc Int
srcLen (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
src)
        MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> m (MutArray a)) -> MutArray a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
newArrContents Int
0 Int
srcLen Int
srcLen

{-# INLINE clone #-}
clone ::
    ( MonadIO m
#ifdef DEVBUILD
    , Unbox a
#endif
    )
    => MutArray a -> m (MutArray a)
clone :: forall (m :: * -> *) a. MonadIO m => MutArray a -> m (MutArray a)
clone = PinnedState -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
PinnedState -> MutArray a -> m (MutArray a)
cloneAs PinnedState
Unpinned

{-# INLINE pinnedClone #-}
pinnedClone ::
    ( MonadIO m
#ifdef DEVBUILD
    , Unbox a
#endif
    )
    => MutArray a -> m (MutArray a)
pinnedClone :: forall (m :: * -> *) a. MonadIO m => MutArray a -> m (MutArray a)
pinnedClone = PinnedState -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
PinnedState -> MutArray a -> m (MutArray a)
cloneAs PinnedState
Pinned

-------------------------------------------------------------------------------
-- Combining
-------------------------------------------------------------------------------

-- | Copy two arrays into a newly allocated array. If the first array is pinned
-- the spliced array is also pinned.
{-# INLINE spliceCopy #-}
spliceCopy :: forall m a. MonadIO m =>
#ifdef DEVBUILD
    Unbox a =>
#endif
    MutArray a -> MutArray a -> m (MutArray a)
spliceCopy :: forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
spliceCopy MutArray a
arr1 MutArray a
arr2 = do
    let start1 :: Int
start1 = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr1
        start2 :: Int
start2 = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr2
        len1 :: Int
len1 = MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
arr1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start1
        len2 :: Int
len2 = MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
arr2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start2
    let len :: Int
len = Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2
    MutByteArray
newArrContents <-
        if MutByteArray -> Bool
Unboxed.isPinned (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr1)
        then IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> IO MutByteArray
Unboxed.pinnedNew Int
len
        else IO MutByteArray -> m MutByteArray
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MutByteArray -> m MutByteArray)
-> IO MutByteArray -> m MutByteArray
forall a b. (a -> b) -> a -> b
$ Int -> IO MutByteArray
Unboxed.new Int
len
    MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
forall (m :: * -> *).
MonadIO m =>
MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
putSliceUnsafe (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr1) Int
start1 MutByteArray
newArrContents Int
0 Int
len1
    MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
forall (m :: * -> *).
MonadIO m =>
MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
putSliceUnsafe (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr2) Int
start2 MutByteArray
newArrContents Int
len1 Int
len2
    MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> m (MutArray a)) -> MutArray a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutByteArray -> Int -> Int -> Int -> MutArray a
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
newArrContents Int
0 Int
len Int
len

-- | Really really unsafe, appends the second array into the first array. If
-- the first array does not have enough space it may cause silent data
-- corruption or if you are lucky a segfault.
{-# INLINE spliceUnsafe #-}
spliceUnsafe :: MonadIO m =>
    MutArray a -> MutArray a -> m (MutArray a)
spliceUnsafe :: forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
spliceUnsafe MutArray a
dst MutArray a
src =
    do
         let startSrc :: Int
startSrc = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
src
             srcLen :: Int
srcLen = MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
src Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startSrc
             endDst :: Int
endDst = MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
dst
         assertM(Int
endDst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MutArray a -> Int
forall a. MutArray a -> Int
arrBound MutArray a
dst)
         MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
forall (m :: * -> *).
MonadIO m =>
MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()
putSliceUnsafe
             (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
src) Int
startSrc (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
dst) Int
endDst Int
srcLen
         MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MutArray a -> m (MutArray a)) -> MutArray a -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ MutArray a
dst {arrEnd = endDst + srcLen}

-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no
-- reserved space available in @dst@ it is reallocated to a size determined by
-- the @sizer dstBytes srcBytes@ function, where @dstBytes@ is the size of the
-- first array and @srcBytes@ is the size of the second array, in bytes.
--
-- Note that the returned array may be a mutated version of first array.
--
-- /Pre-release/
{-# INLINE spliceWith #-}
spliceWith :: forall m a. (MonadIO m, Unbox a) =>
    (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
spliceWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
spliceWith Int -> Int -> Int
sizer dst :: MutArray a
dst@(MutArray MutByteArray
_ Int
start Int
end Int
bound) MutArray a
src = do
{-
    let f = appendWith (`sizer` byteLength src) (return dst)
     in D.fold f (toStreamD src)
-}
    Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bound) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    let srcBytes :: Int
srcBytes = MutArray a -> Int
forall a. MutArray a -> Int
arrEnd MutArray a
src Int -> Int -> Int
forall a. Num a => a -> a -> a
- MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
src

    MutArray a
dst1 <-
        if Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bound
        then do
            let dstBytes :: Int
dstBytes = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
                newSizeInBytes :: Int
newSizeInBytes = Int -> Int -> Int
sizer Int
dstBytes Int
srcBytes
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
newSizeInBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dstBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcBytes)
                (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error
                    ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"splice: newSize is less than the total size "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"of arrays being appended. Please check the "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"sizer function passed."
            Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m (MutArray a)
realloc Int
newSizeInBytes MutArray a
dst
        else MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
dst
    MutArray a -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
spliceUnsafe MutArray a
dst1 MutArray a
src

-- | The first array is mutated to append the second array. If there is no
-- reserved space available in the first array a new allocation of exact
-- required size is done.
--
-- Note that the returned array may be a mutated version of first array.
--
-- >>> splice = MutArray.spliceWith (+)
--
-- If the original array is pinned the spliced array is also pinned.
--
-- /Pre-release/
{-# INLINE splice #-}
splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)
splice :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> MutArray a -> m (MutArray a)
splice = (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
spliceWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)

-- | Like 'append' but the growth of the array is exponential. Whenever a new
-- allocation is required the previous array size is at least doubled.
--
-- This is useful to reduce allocations when folding many arrays together.
--
-- Note that the returned array may be a mutated version of first array.
--
-- >>> spliceExp = MutArray.spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))
--
-- /Pre-release/
{-# INLINE spliceExp #-}
spliceExp :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)
spliceExp :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> MutArray a -> m (MutArray a)
spliceExp = (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)
spliceWith (\Int
l1 Int
l2 -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2))

-------------------------------------------------------------------------------
-- Splitting
-------------------------------------------------------------------------------

-- | Generate a stream of array slices using a predicate. The array element
-- matching the predicate is dropped.
--
-- /Pre-release/
{-# INLINE splitOn #-}
splitOn :: (MonadIO m, Unbox a) =>
    (a -> Bool) -> MutArray a -> Stream m (MutArray a)
splitOn :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(a -> Bool) -> MutArray a -> Stream m (MutArray a)
splitOn a -> Bool
predicate MutArray a
arr =
    ((Int, Int) -> MutArray a)
-> Stream m (Int, Int) -> Stream m (MutArray a)
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
i, Int
len) -> Int -> Int -> MutArray a -> MutArray a
forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a
getSliceUnsafe Int
i Int
len MutArray a
arr)
        (Stream m (Int, Int) -> Stream m (MutArray a))
-> Stream m (Int, Int) -> Stream m (MutArray a)
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Stream m a -> Stream m (Int, Int)
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Stream m a -> Stream m (Int, Int)
D.indexOnSuffix a -> Bool
predicate (MutArray a -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
MutArray a -> Stream m a
read MutArray a
arr)

-- | Drops the separator byte
{-# INLINE breakOn #-}
breakOn :: MonadIO m
    => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
breakOn :: forall (m :: * -> *).
MonadIO m =>
Word8
-> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))
breakOn Word8
sep arr :: MutArray Word8
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = MutArray Word8
-> (Ptr Word8 -> m (MutArray Word8, Maybe (MutArray Word8)))
-> m (MutArray Word8, Maybe (MutArray Word8))
forall (m :: * -> *) a b.
MonadIO m =>
MutArray a -> (Ptr a -> m b) -> m b
unsafeAsPtr MutArray Word8
arr ((Ptr Word8 -> m (MutArray Word8, Maybe (MutArray Word8)))
 -> m (MutArray Word8, Maybe (MutArray Word8)))
-> (Ptr Word8 -> m (MutArray Word8, Maybe (MutArray Word8)))
-> m (MutArray Word8, Maybe (MutArray Word8))
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> IO (MutArray Word8, Maybe (MutArray Word8))
-> m (MutArray Word8, Maybe (MutArray Word8))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray Word8, Maybe (MutArray Word8))
 -> m (MutArray Word8, Maybe (MutArray Word8)))
-> IO (MutArray Word8, Maybe (MutArray Word8))
-> m (MutArray Word8, Maybe (MutArray Word8))
forall a b. (a -> b) -> a -> b
$ do
    -- XXX We do not need memchr here, we can use a Haskell equivalent.
    -- Need efficient stream based primitives that work on Word64.
    Ptr Word8
loc <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
c_memchr Ptr Word8
p Word8
sep (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ MutArray Word8 -> Int
forall a. MutArray a -> Int
byteLength MutArray Word8
arr)
    let sepIndex :: Int
sepIndex = Ptr Word8
loc Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p
    (MutArray Word8, Maybe (MutArray Word8))
-> IO (MutArray Word8, Maybe (MutArray Word8))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((MutArray Word8, Maybe (MutArray Word8))
 -> IO (MutArray Word8, Maybe (MutArray Word8)))
-> (MutArray Word8, Maybe (MutArray Word8))
-> IO (MutArray Word8, Maybe (MutArray Word8))
forall a b. (a -> b) -> a -> b
$
        if Ptr Word8
loc Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr
        then (MutArray Word8
arr, Maybe (MutArray Word8)
forall a. Maybe a
Nothing)
        else
            ( MutArray
                { arrContents :: MutByteArray
arrContents = MutByteArray
arrContents
                , arrStart :: Int
arrStart = Int
arrStart
                , arrEnd :: Int
arrEnd = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sepIndex -- exclude the separator
                , arrBound :: Int
arrBound = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sepIndex
                }
            , MutArray Word8 -> Maybe (MutArray Word8)
forall a. a -> Maybe a
Just (MutArray Word8 -> Maybe (MutArray Word8))
-> MutArray Word8 -> Maybe (MutArray Word8)
forall a b. (a -> b) -> a -> b
$ MutArray
                    { arrContents :: MutByteArray
arrContents = MutByteArray
arrContents
                    , arrStart :: Int
arrStart = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
sepIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    , arrEnd :: Int
arrEnd = Int
arrEnd
                    , arrBound :: Int
arrBound = Int
arrBound
                    }
            )

-- | Like 'splitAt' but does not check whether the index is valid.
--
{-# INLINE unsafeSplitAt #-}
unsafeSplitAt :: forall a. Unbox a =>
    Int -> MutArray a -> (MutArray a, MutArray a)
unsafeSplitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
unsafeSplitAt Int
i MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    let off :: Int
off = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)
        p :: Int
p = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off
     in ( MutArray
         { arrContents :: MutByteArray
arrContents = MutByteArray
arrContents
         , arrStart :: Int
arrStart = Int
arrStart
         , arrEnd :: Int
arrEnd = Int
p
         , arrBound :: Int
arrBound = Int
p
         }
        , MutArray
          { arrContents :: MutByteArray
arrContents = MutByteArray
arrContents
          , arrStart :: Int
arrStart = Int
p
          , arrEnd :: Int
arrEnd = Int
arrEnd
          , arrBound :: Int
arrBound = Int
arrBound
          }
        )

-- | Create two slices of an array without copying the original array. The
-- specified index @i@ is the first index of the second slice.
--
{-# INLINE splitAt #-}
splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
splitAt Int
i MutArray a
arr =
    let maxIndex :: Int
maxIndex = MutArray a -> Int
forall a. Unbox a => MutArray a -> Int
length MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    in  if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
        then [Char] -> (MutArray a, MutArray a)
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"sliceAt: negative array index"
        else if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxIndex
             then [Char] -> (MutArray a, MutArray a)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> (MutArray a, MutArray a))
-> [Char] -> (MutArray a, MutArray a)
forall a b. (a -> b) -> a -> b
$ [Char]
"sliceAt: specified array index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is beyond the maximum index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maxIndex
             else Int -> MutArray a -> (MutArray a, MutArray a)
forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)
unsafeSplitAt Int
i MutArray a
arr

-------------------------------------------------------------------------------
-- Casting
-------------------------------------------------------------------------------

-- | Cast an array having elements of type @a@ into an array having elements of
-- type @b@. The array size must be a multiple of the size of type @b@
-- otherwise accessing the last element of the array may result into a crash or
-- a random value.
--
-- /Pre-release/
--
castUnsafe ::
#ifdef DEVBUILD
    Unbox b =>
#endif
    MutArray a -> MutArray b
castUnsafe :: forall a b. MutArray a -> MutArray b
castUnsafe (MutArray MutByteArray
contents Int
start Int
end Int
bound) =
    MutByteArray -> Int -> Int -> Int -> MutArray b
forall a. MutByteArray -> Int -> Int -> Int -> MutArray a
MutArray MutByteArray
contents Int
start Int
end Int
bound

-- | Cast an @MutArray a@ into an @MutArray Word8@.
--
asBytes :: MutArray a -> MutArray Word8
asBytes :: forall a. MutArray a -> MutArray Word8
asBytes = MutArray a -> MutArray Word8
forall a b. MutArray a -> MutArray b
castUnsafe

-- | Cast an array having elements of type @a@ into an array having elements of
-- type @b@. The length of the array should be a multiple of the size of the
-- target element otherwise 'Nothing' is returned.
--
cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)
cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)
cast MutArray a
arr =
    let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr
        r :: Int
r = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` SIZE_OF(b)
     in if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then Maybe (MutArray b)
forall a. Maybe a
Nothing
        else MutArray b -> Maybe (MutArray b)
forall a. a -> Maybe a
Just (MutArray b -> Maybe (MutArray b))
-> MutArray b -> Maybe (MutArray b)
forall a b. (a -> b) -> a -> b
$ MutArray a -> MutArray b
forall a b. MutArray a -> MutArray b
castUnsafe MutArray a
arr

-- XXX We can provide another API for "unsafe" FFI calls passing an unlifted
-- pointer to the FFI call. For unsafe calls we do not need to pin the array.
-- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in
-- before the pointer is wrapped.
--
-- From the GHC manual:
--
-- GHC, since version 8.4, guarantees that garbage collection will never occur
-- during an unsafe call, even in the bytecode interpreter, and further
-- guarantees that unsafe calls will be performed in the calling thread. Making
-- it safe to pass heap-allocated objects to unsafe functions.

-- XXX Should we just name it asPtr, the unsafety is implicit for any pointer
-- operations. And we are safe from Haskell perspective because we will be
-- pinning the memory.
--
-- XXX we cannot pass the length of the ptr here as in some cases it may not be
-- available e.g. a null terminated C string. However, we can create another
-- flavor of the API e.g. asPtrN.

-- | Use a @MutArray a@ as @Ptr a@. This is useful when we want to pass an
-- array as a pointer to some operating system call or to a "safe" FFI call.
--
-- If the array is not pinned it is copied to pinned memory before passing it
-- to the monadic action.
--
-- /Performance Notes:/ Forces a copy if the array is not pinned. It is advised
-- that the programmer keeps this in mind and creates a pinned array
-- opportunistically before this operation occurs, to avoid the cost of a copy
-- if possible.
--
-- /Unsafe/ because of direct pointer operations. The user must ensure that
-- they are writing within the legal bounds of the array.
--
-- /Pre-release/
--
{-# INLINE unsafePinnedAsPtr #-}
unsafePinnedAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
unsafePinnedAsPtr :: forall (m :: * -> *) a b.
MonadIO m =>
MutArray a -> (Ptr a -> m b) -> m b
unsafePinnedAsPtr MutArray a
arr Ptr a -> m b
f =
    MutByteArray -> (Ptr Any -> m b) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
MutByteArray -> (Ptr a -> m b) -> m b
Unboxed.unsafePinnedAsPtr
        (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr) (\Ptr Any
ptr -> Ptr a -> m b
f (Ptr Any
ptr Ptr Any -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr))

{-# DEPRECATED asPtrUnsafe "Please use unsafePinnedAsPtr instead." #-}
{-# INLINE asPtrUnsafe #-}
asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
asPtrUnsafe :: forall (m :: * -> *) a b.
MonadIO m =>
MutArray a -> (Ptr a -> m b) -> m b
asPtrUnsafe = MutArray a -> (Ptr a -> m b) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
MutArray a -> (Ptr a -> m b) -> m b
unsafePinnedAsPtr

{-# INLINE unsafeAsPtr #-}
unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b
unsafeAsPtr :: forall (m :: * -> *) a b.
MonadIO m =>
MutArray a -> (Ptr a -> m b) -> m b
unsafeAsPtr MutArray a
arr Ptr a -> m b
f =
    MutByteArray -> (Ptr Any -> m b) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
MutByteArray -> (Ptr a -> m b) -> m b
Unboxed.unsafeAsPtr
        (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr) (\Ptr Any
ptr -> Ptr a -> m b
f (Ptr Any
ptr Ptr Any -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr))

-------------------------------------------------------------------------------
-- Equality
-------------------------------------------------------------------------------

-- | Byte compare two arrays. Compare the length of the arrays. If the length
-- is equal, compare the lexicographical ordering of two underlying byte arrays
-- otherwise return the result of length comparison.
--
-- /Unsafe/: Note that the 'Unbox' instance of sum types with constructors of
-- different sizes may leave some memory uninitialized which can make byte
-- comparison unreliable.
--
-- /Pre-release/
{-# INLINE byteCmp #-}
byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
byteCmp :: forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m Ordering
byteCmp MutArray a
arr1 MutArray a
arr2 = do
    let marr1 :: MutableByteArray# RealWorld
marr1 = MutByteArray -> MutableByteArray# RealWorld
getMutableByteArray# (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr1)
        marr2 :: MutableByteArray# RealWorld
marr2 = MutByteArray -> MutableByteArray# RealWorld
getMutableByteArray# (MutArray a -> MutByteArray
forall a. MutArray a -> MutByteArray
arrContents MutArray a
arr2)
        !(I# Int#
st1#) = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr1
        !(I# Int#
st2#) = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr2
        !(I# Int#
len#) = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr1
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr1) (MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr2) of
        Ordering
EQ -> do
            Int
r <- IO Int -> m Int
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int)
-> (State# RealWorld -> (# State# RealWorld, Int #)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
                     let res :: Int
res =
                             Int# -> Int
I#
                                 (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays#
                                      (MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# MutableByteArray# RealWorld
marr1)
                                      Int#
st1#
                                      (MutableByteArray# RealWorld -> ByteArray#
forall a b. a -> b
unsafeCoerce# MutableByteArray# RealWorld
marr2)
                                      Int#
st2#
                                      Int#
len#)
                      in (# State# RealWorld
s#, Int
res #)
            Ordering -> m Ordering
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ordering -> m Ordering) -> Ordering -> m Ordering
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
r Int
0
        Ordering
x -> Ordering -> m Ordering
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
x

{-# INLINE cmp #-}
{-# DEPRECATED cmp "Please use byteCmp instead." #-}
cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering
cmp :: forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m Ordering
cmp = MutArray a -> MutArray a -> m Ordering
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m Ordering
byteCmp

-- | Byte equality of two arrays.
--
-- >>> byteEq arr1 arr2 = (==) EQ $ MArray.byteCmp arr1 arr2
--
-- /Unsafe/: See 'byteCmp'.
{-# INLINE byteEq #-}
byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool
byteEq :: forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m Bool
byteEq MutArray a
arr1 MutArray a
arr2 = (Ordering -> Bool) -> m Ordering -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (m Ordering -> m Bool) -> m Ordering -> m Bool
forall a b. (a -> b) -> a -> b
$ MutArray a -> MutArray a -> m Ordering
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m Ordering
byteCmp MutArray a
arr1 MutArray a
arr2

-------------------------------------------------------------------------------
-- Compact
-------------------------------------------------------------------------------

-- Note: LE versions avoid an extra copy compared to GE. LE parser trades
-- backtracking one array in lieu of avoiding a copy. However, LE and GE both
-- can leave some memory unused. They can split the last array to fit it
-- exactly in the space.

{-# INLINE_NORMAL pCompactLeAs #-}
pCompactLeAs ::
       forall m a. (MonadIO m, Unbox a)
    => PinnedState -> Int -> Parser (MutArray a) m (MutArray a)
pCompactLeAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Parser (MutArray a) m (MutArray a)
pCompactLeAs PinnedState
ps Int
maxElems = (Maybe (MutArray a)
 -> MutArray a -> m (Step (Maybe (MutArray a)) (MutArray a)))
-> m (Initial (Maybe (MutArray a)) (MutArray a))
-> (Maybe (MutArray a)
    -> m (Step (Maybe (MutArray a)) (MutArray a)))
-> Parser (MutArray a) m (MutArray a)
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
Parser Maybe (MutArray a)
-> MutArray a -> m (Step (Maybe (MutArray a)) (MutArray a))
forall {m :: * -> *} {a}.
MonadIO m =>
Maybe (MutArray a)
-> MutArray a -> m (Step (Maybe (MutArray a)) (MutArray a))
step m (Initial (Maybe (MutArray a)) (MutArray a))
forall {a} {b}. m (Initial (Maybe a) b)
initial Maybe (MutArray a) -> m (Step (Maybe (MutArray a)) (MutArray a))
forall {m :: * -> *} {a} {s}.
Monad m =>
Maybe (MutArray a) -> m (Step s (MutArray a))
extract

    where

    maxBytes :: Int
maxBytes = Int
maxElems Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)

    functionName :: [Char]
functionName = [Char]
"Streamly.Internal.Data.MutArray.pCompactLE"

    initial :: m (Initial (Maybe a) b)
initial =
        Initial (Maybe a) b -> m (Initial (Maybe a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Initial (Maybe a) b -> m (Initial (Maybe a) b))
-> Initial (Maybe a) b -> m (Initial (Maybe a) b)
forall a b. (a -> b) -> a -> b
$ if Int
maxElems Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
              then [Char] -> Initial (Maybe a) b
forall a. (?callStack::CallStack) => [Char] -> a
error
                       ([Char] -> Initial (Maybe a) b) -> [Char] -> Initial (Maybe a) b
forall a b. (a -> b) -> a -> b
$ [Char]
functionName
                       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": the size of arrays ["
                       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maxElems [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
              else Maybe a -> Initial (Maybe a) b
forall s b. s -> Initial s b
Parser.IPartial Maybe a
forall a. Maybe a
Nothing

    step :: Maybe (MutArray a)
-> MutArray a -> m (Step (Maybe (MutArray a)) (MutArray a))
step Maybe (MutArray a)
Nothing MutArray a
arr =
        Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Maybe (MutArray a)) (MutArray a)
 -> m (Step (Maybe (MutArray a)) (MutArray a)))
-> Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr
               in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxBytes
                  then Int -> MutArray a -> Step (Maybe (MutArray a)) (MutArray a)
forall s b. Int -> b -> Step s b
Parser.Done Int
0 MutArray a
arr
                  else Int -> Maybe (MutArray a) -> Step (Maybe (MutArray a)) (MutArray a)
forall s b. Int -> s -> Step s b
Parser.Partial Int
0 (MutArray a -> Maybe (MutArray a)
forall a. a -> Maybe a
Just MutArray a
arr)
    -- XXX Split the last array to use the space more compactly.
    step (Just MutArray a
buf) MutArray a
arr =
        let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr
         in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxBytes
            then Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe (MutArray a)) (MutArray a)
 -> m (Step (Maybe (MutArray a)) (MutArray a)))
-> Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> Step (Maybe (MutArray a)) (MutArray a)
forall s b. Int -> b -> Step s b
Parser.Done Int
1 MutArray a
buf
            else do
                MutArray a
buf1 <-
                    if MutArray a -> Int
forall a. MutArray a -> Int
byteCapacity MutArray a
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxBytes
                    then IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
forall a.
PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
reallocExplicitAs
                            PinnedState
ps (SIZE_OF(a)) maxBytes buf
                    else MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
buf
                MutArray a
buf2 <- MutArray a -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
spliceUnsafe MutArray a
buf1 MutArray a
arr
                Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe (MutArray a)) (MutArray a)
 -> m (Step (Maybe (MutArray a)) (MutArray a)))
-> Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ Int -> Maybe (MutArray a) -> Step (Maybe (MutArray a)) (MutArray a)
forall s b. Int -> s -> Step s b
Parser.Partial Int
0 (MutArray a -> Maybe (MutArray a)
forall a. a -> Maybe a
Just MutArray a
buf2)

    extract :: Maybe (MutArray a) -> m (Step s (MutArray a))
extract Maybe (MutArray a)
Nothing = Step s (MutArray a) -> m (Step s (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s (MutArray a) -> m (Step s (MutArray a)))
-> Step s (MutArray a) -> m (Step s (MutArray a))
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> Step s (MutArray a)
forall s b. Int -> b -> Step s b
Parser.Done Int
0 MutArray a
forall a. MutArray a
nil
    extract (Just MutArray a
buf) = Step s (MutArray a) -> m (Step s (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s (MutArray a) -> m (Step s (MutArray a)))
-> Step s (MutArray a) -> m (Step s (MutArray a))
forall a b. (a -> b) -> a -> b
$ Int -> MutArray a -> Step s (MutArray a)
forall s b. Int -> b -> Step s b
Parser.Done Int
0 MutArray a
buf

-- | Parser @pCompactLE maxElems@ coalesces adjacent arrays in the input stream
-- only if the combined size would be less than or equal to @maxElems@
-- elements. Note that it won't split an array if the original array is already
-- larger than maxElems.
--
-- @maxElems@ must be greater than 0.
--
-- Generates unpinned arrays irrespective of the pinning status of input
-- arrays.
--
-- /Internal/
{-# INLINE pCompactLE #-}
pCompactLE ::
       forall m a. (MonadIO m, Unbox a)
    => Int -> Parser (MutArray a) m (MutArray a)
pCompactLE :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Parser (MutArray a) m (MutArray a)
pCompactLE = PinnedState -> Int -> Parser (MutArray a) m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Parser (MutArray a) m (MutArray a)
pCompactLeAs PinnedState
Unpinned

-- | Pinned version of 'pCompactLE'.
{-# INLINE pPinnedCompactLE #-}
pPinnedCompactLE ::
       forall m a. (MonadIO m, Unbox a)
    => Int -> Parser (MutArray a) m (MutArray a)
pPinnedCompactLE :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Parser (MutArray a) m (MutArray a)
pPinnedCompactLE = PinnedState -> Int -> Parser (MutArray a) m (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Parser (MutArray a) m (MutArray a)
pCompactLeAs PinnedState
Pinned

data SpliceState s arr
    = SpliceInitial s
    | SpliceBuffering s arr
    | SpliceYielding arr (SpliceState s arr)
    | SpliceFinish

-- This mutates the first array (if it has space) to append values from the
-- second one. This would work for immutable arrays as well because an
-- immutable array never has additional space so a new array is allocated
-- instead of mutating it.

{-# INLINE_NORMAL compactLeAs #-}
compactLeAs :: forall m a. (MonadIO m, Unbox a)
    => PinnedState -> Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)
compactLeAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState
-> Int -> Stream m (MutArray a) -> Stream m (MutArray a)
compactLeAs PinnedState
ps Int
maxElems (D.Stream State StreamK m (MutArray a) -> s -> m (Step s (MutArray a))
step s
state) =
    (State StreamK m (MutArray a)
 -> SpliceState s (MutArray a)
 -> m (Step (SpliceState s (MutArray a)) (MutArray a)))
-> SpliceState s (MutArray a) -> Stream m (MutArray a)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State StreamK m (MutArray a)
-> SpliceState s (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
step' (s -> SpliceState s (MutArray a)
forall s arr. s -> SpliceState s arr
SpliceInitial s
state)

    where

    maxBytes :: Int
maxBytes = Int
maxElems Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)

    functionName :: [Char]
functionName = [Char]
"Streamly.Internal.Data.MutArray.rCompactLE"

    {-# INLINE_LATE step' #-}
    step' :: State StreamK m (MutArray a)
-> SpliceState s (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
step' State StreamK m (MutArray a)
gst (SpliceInitial s
st) = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
maxElems Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
functionName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": the size of arrays [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maxElems
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
        Step s (MutArray a)
r <- State StreamK m (MutArray a) -> s -> m (Step s (MutArray a))
step State StreamK m (MutArray a)
gst s
st
        case Step s (MutArray a)
r of
            D.Yield MutArray a
arr s
s -> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (MutArray a)) (MutArray a)
 -> m (Step (SpliceState s (MutArray a)) (MutArray a)))
-> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$
                let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr
                 in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxBytes
                    then SpliceState s (MutArray a)
-> Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. s -> Step s a
D.Skip (MutArray a
-> SpliceState s (MutArray a) -> SpliceState s (MutArray a)
forall s arr. arr -> SpliceState s arr -> SpliceState s arr
SpliceYielding MutArray a
arr (s -> SpliceState s (MutArray a)
forall s arr. s -> SpliceState s arr
SpliceInitial s
s))
                    else SpliceState s (MutArray a)
-> Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. s -> Step s a
D.Skip (s -> MutArray a -> SpliceState s (MutArray a)
forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s MutArray a
arr)
            D.Skip s
s -> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (MutArray a)) (MutArray a)
 -> m (Step (SpliceState s (MutArray a)) (MutArray a)))
-> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ SpliceState s (MutArray a)
-> Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. s -> Step s a
D.Skip (s -> SpliceState s (MutArray a)
forall s arr. s -> SpliceState s arr
SpliceInitial s
s)
            Step s (MutArray a)
D.Stop -> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. Step s a
D.Stop

    -- XXX Split the last array to use the space more compactly.
    step' State StreamK m (MutArray a)
gst (SpliceBuffering s
st MutArray a
buf) = do
        Step s (MutArray a)
r <- State StreamK m (MutArray a) -> s -> m (Step s (MutArray a))
step State StreamK m (MutArray a)
gst s
st
        case Step s (MutArray a)
r of
            D.Yield MutArray a
arr s
s -> do
                let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr
                if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxBytes
                then Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (MutArray a)) (MutArray a)
 -> m (Step (SpliceState s (MutArray a)) (MutArray a)))
-> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$
                    SpliceState s (MutArray a)
-> Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. s -> Step s a
D.Skip (MutArray a
-> SpliceState s (MutArray a) -> SpliceState s (MutArray a)
forall s arr. arr -> SpliceState s arr -> SpliceState s arr
SpliceYielding MutArray a
buf (s -> MutArray a -> SpliceState s (MutArray a)
forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s MutArray a
arr))
                else do
                    MutArray a
buf1 <- if MutArray a -> Int
forall a. MutArray a -> Int
byteCapacity MutArray a
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxBytes
                            then IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
forall a.
PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
reallocExplicitAs
                                    PinnedState
ps (SIZE_OF(a)) maxBytes buf
                            else MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
buf
                    MutArray a
buf2 <- MutArray a -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
spliceUnsafe MutArray a
buf1 MutArray a
arr
                    Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (MutArray a)) (MutArray a)
 -> m (Step (SpliceState s (MutArray a)) (MutArray a)))
-> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ SpliceState s (MutArray a)
-> Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. s -> Step s a
D.Skip (s -> MutArray a -> SpliceState s (MutArray a)
forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s MutArray a
buf2)
            D.Skip s
s -> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (MutArray a)) (MutArray a)
 -> m (Step (SpliceState s (MutArray a)) (MutArray a)))
-> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ SpliceState s (MutArray a)
-> Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. s -> Step s a
D.Skip (s -> MutArray a -> SpliceState s (MutArray a)
forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s MutArray a
buf)
            Step s (MutArray a)
D.Stop -> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (MutArray a)) (MutArray a)
 -> m (Step (SpliceState s (MutArray a)) (MutArray a)))
-> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ SpliceState s (MutArray a)
-> Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. s -> Step s a
D.Skip (MutArray a
-> SpliceState s (MutArray a) -> SpliceState s (MutArray a)
forall s arr. arr -> SpliceState s arr -> SpliceState s arr
SpliceYielding MutArray a
buf SpliceState s (MutArray a)
forall s arr. SpliceState s arr
SpliceFinish)

    step' State StreamK m (MutArray a)
_ SpliceState s (MutArray a)
SpliceFinish = Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. Step s a
D.Stop

    step' State StreamK m (MutArray a)
_ (SpliceYielding MutArray a
arr SpliceState s (MutArray a)
next) = Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (MutArray a)) (MutArray a)
 -> m (Step (SpliceState s (MutArray a)) (MutArray a)))
-> Step (SpliceState s (MutArray a)) (MutArray a)
-> m (Step (SpliceState s (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ MutArray a
-> SpliceState s (MutArray a)
-> Step (SpliceState s (MutArray a)) (MutArray a)
forall s a. a -> s -> Step s a
D.Yield MutArray a
arr SpliceState s (MutArray a)
next


{-# INLINE_NORMAL fCompactGeAs #-}
fCompactGeAs ::
       forall m a. (MonadIO m, Unbox a)
    => PinnedState -> Int -> FL.Fold m (MutArray a) (MutArray a)
fCompactGeAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m (MutArray a) (MutArray a)
fCompactGeAs PinnedState
ps Int
minElems = (Maybe (MutArray a)
 -> MutArray a -> m (Step (Maybe (MutArray a)) (MutArray a)))
-> m (Step (Maybe (MutArray a)) (MutArray a))
-> (Maybe (MutArray a) -> m (MutArray a))
-> (Maybe (MutArray a) -> m (MutArray a))
-> Fold m (MutArray a) (MutArray a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Maybe (MutArray a)
-> MutArray a -> m (Step (Maybe (MutArray a)) (MutArray a))
forall {m :: * -> *} {a}.
MonadIO m =>
Maybe (MutArray a)
-> MutArray a -> m (Step (Maybe (MutArray a)) (MutArray a))
step m (Step (Maybe (MutArray a)) (MutArray a))
forall {a} {b}. m (Step (Maybe a) b)
initial Maybe (MutArray a) -> m (MutArray a)
forall {m :: * -> *} {a}.
Monad m =>
Maybe (MutArray a) -> m (MutArray a)
extract Maybe (MutArray a) -> m (MutArray a)
forall {m :: * -> *} {a}.
Monad m =>
Maybe (MutArray a) -> m (MutArray a)
extract

    where

    minBytes :: Int
minBytes = Int
minElems Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)

    functionName :: [Char]
functionName = [Char]
"Streamly.Internal.Data.MutArray.fCompactGE"

    initial :: m (Step (Maybe a) b)
initial =
        Step (Maybe a) b -> m (Step (Maybe a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Maybe a) b -> m (Step (Maybe a) b))
-> Step (Maybe a) b -> m (Step (Maybe a) b)
forall a b. (a -> b) -> a -> b
$ if Int
minElems Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
              then [Char] -> Step (Maybe a) b
forall a. (?callStack::CallStack) => [Char] -> a
error
                       ([Char] -> Step (Maybe a) b) -> [Char] -> Step (Maybe a) b
forall a b. (a -> b) -> a -> b
$ [Char]
functionName
                       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": the size of arrays ["
                       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
minElems [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
              else Maybe a -> Step (Maybe a) b
forall s b. s -> Step s b
FL.Partial Maybe a
forall a. Maybe a
Nothing

    step :: Maybe (MutArray a)
-> MutArray a -> m (Step (Maybe (MutArray a)) (MutArray a))
step Maybe (MutArray a)
Nothing MutArray a
arr =
        Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Maybe (MutArray a)) (MutArray a)
 -> m (Step (Maybe (MutArray a)) (MutArray a)))
-> Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr
               in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minBytes
                  then MutArray a -> Step (Maybe (MutArray a)) (MutArray a)
forall s b. b -> Step s b
FL.Done MutArray a
arr
                  else Maybe (MutArray a) -> Step (Maybe (MutArray a)) (MutArray a)
forall s b. s -> Step s b
FL.Partial (MutArray a -> Maybe (MutArray a)
forall a. a -> Maybe a
Just MutArray a
arr)
    -- XXX Buffer arrays as a list to avoid copy and reallocations
    step (Just MutArray a
buf) MutArray a
arr = do
        let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr
        MutArray a
buf1 <-
            if MutArray a -> Int
forall a. MutArray a -> Int
byteCapacity MutArray a
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
            then IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
forall a.
PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
reallocExplicitAs
                    PinnedState
ps (SIZE_OF(a)) (max minBytes len) buf
            else MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
buf
        MutArray a
buf2 <- MutArray a -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
spliceUnsafe MutArray a
buf1 MutArray a
arr
        if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minBytes
        then Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe (MutArray a)) (MutArray a)
 -> m (Step (Maybe (MutArray a)) (MutArray a)))
-> Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ MutArray a -> Step (Maybe (MutArray a)) (MutArray a)
forall s b. b -> Step s b
FL.Done MutArray a
buf2
        else Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe (MutArray a)) (MutArray a)
 -> m (Step (Maybe (MutArray a)) (MutArray a)))
-> Step (Maybe (MutArray a)) (MutArray a)
-> m (Step (Maybe (MutArray a)) (MutArray a))
forall a b. (a -> b) -> a -> b
$ Maybe (MutArray a) -> Step (Maybe (MutArray a)) (MutArray a)
forall s b. s -> Step s b
FL.Partial (MutArray a -> Maybe (MutArray a)
forall a. a -> Maybe a
Just MutArray a
buf2)

    extract :: Maybe (MutArray a) -> m (MutArray a)
extract Maybe (MutArray a)
Nothing = MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
forall a. MutArray a
nil
    extract (Just MutArray a
buf) = MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
buf

-- | Fold @fCompactGE minElems@ coalesces adjacent arrays in the input stream
-- until the size becomes greater than or equal to @minElems@.
--
-- Generates unpinned arrays irrespective of the pinning status of input
-- arrays.
{-# INLINE fCompactGE #-}
fCompactGE ::
       forall m a. (MonadIO m, Unbox a)
    => Int -> FL.Fold m (MutArray a) (MutArray a)
fCompactGE :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m (MutArray a) (MutArray a)
fCompactGE = PinnedState -> Int -> Fold m (MutArray a) (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m (MutArray a) (MutArray a)
fCompactGeAs PinnedState
Unpinned

-- | Pinned version of 'fCompactGE'.
{-# INLINE fPinnedCompactGE #-}
fPinnedCompactGE ::
       forall m a. (MonadIO m, Unbox a)
    => Int -> FL.Fold m (MutArray a) (MutArray a)
fPinnedCompactGE :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m (MutArray a) (MutArray a)
fPinnedCompactGE = PinnedState -> Int -> Fold m (MutArray a) (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState -> Int -> Fold m (MutArray a) (MutArray a)
fCompactGeAs PinnedState
Pinned

{-# INLINE_NORMAL lCompactGeAs #-}
lCompactGeAs :: forall m a. (MonadIO m, Unbox a)
    => PinnedState -> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
-- The fold version turns out to be a little bit slower.
-- lCompactGeAs ps n = FL.many (fCompactGeAs ps n)
lCompactGeAs :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState
-> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
lCompactGeAs PinnedState
ps Int
minElems (Fold s -> MutArray a -> m (Step s ())
step1 m (Step s ())
initial1 s -> m ()
_ s -> m ()
final1) =
    (Tuple' (Maybe (MutArray a)) s
 -> MutArray a -> m (Step (Tuple' (Maybe (MutArray a)) s) ()))
-> m (Step (Tuple' (Maybe (MutArray a)) s) ())
-> (Tuple' (Maybe (MutArray a)) s -> m ())
-> (Tuple' (Maybe (MutArray a)) s -> m ())
-> Fold m (MutArray a) ()
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Tuple' (Maybe (MutArray a)) s
-> MutArray a -> m (Step (Tuple' (Maybe (MutArray a)) s) ())
step m (Step (Tuple' (Maybe (MutArray a)) s) ())
forall {a}. m (Step (Tuple' (Maybe a) s) ())
initial Tuple' (Maybe (MutArray a)) s -> m ()
forall {p} {a}. p -> a
extract Tuple' (Maybe (MutArray a)) s -> m ()
final

    where

    minBytes :: Int
minBytes = Int
minElems Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a)

    functionName :: [Char]
functionName = [Char]
"Streamly.Internal.Data.MutArray.lCompactGE"

    initial :: m (Step (Tuple' (Maybe a) s) ())
initial = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
minElems Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
functionName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": the size of arrays ["
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
minElems [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"

        Step s ()
r <- m (Step s ())
initial1
        Step (Tuple' (Maybe a) s) () -> m (Step (Tuple' (Maybe a) s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' (Maybe a) s) () -> m (Step (Tuple' (Maybe a) s) ()))
-> Step (Tuple' (Maybe a) s) () -> m (Step (Tuple' (Maybe a) s) ())
forall a b. (a -> b) -> a -> b
$ (s -> Tuple' (Maybe a) s)
-> Step s () -> Step (Tuple' (Maybe a) s) ()
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Maybe a -> s -> Tuple' (Maybe a) s
forall a b. a -> b -> Tuple' a b
Tuple' Maybe a
forall a. Maybe a
Nothing) Step s ()
r

    {-# INLINE runInner #-}
    runInner :: Int
-> s -> MutArray a -> m (Step (Tuple' (Maybe (MutArray a)) s) ())
runInner Int
len s
acc MutArray a
buf =
            if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minBytes
            then do
                Step s ()
r <- s -> MutArray a -> m (Step s ())
step1 s
acc MutArray a
buf
                case Step s ()
r of
                    FL.Done ()
_ -> Step (Tuple' (Maybe (MutArray a)) s) ()
-> m (Step (Tuple' (Maybe (MutArray a)) s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' (Maybe (MutArray a)) s) ()
 -> m (Step (Tuple' (Maybe (MutArray a)) s) ()))
-> Step (Tuple' (Maybe (MutArray a)) s) ()
-> m (Step (Tuple' (Maybe (MutArray a)) s) ())
forall a b. (a -> b) -> a -> b
$ () -> Step (Tuple' (Maybe (MutArray a)) s) ()
forall s b. b -> Step s b
FL.Done ()
                    FL.Partial s
s -> do
                        ()
_ <- s -> m ()
final1 s
s
                        Step s ()
res <- m (Step s ())
initial1
                        Step (Tuple' (Maybe (MutArray a)) s) ()
-> m (Step (Tuple' (Maybe (MutArray a)) s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' (Maybe (MutArray a)) s) ()
 -> m (Step (Tuple' (Maybe (MutArray a)) s) ()))
-> Step (Tuple' (Maybe (MutArray a)) s) ()
-> m (Step (Tuple' (Maybe (MutArray a)) s) ())
forall a b. (a -> b) -> a -> b
$ (s -> Tuple' (Maybe (MutArray a)) s)
-> Step s () -> Step (Tuple' (Maybe (MutArray a)) s) ()
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Maybe (MutArray a) -> s -> Tuple' (Maybe (MutArray a)) s
forall a b. a -> b -> Tuple' a b
Tuple' Maybe (MutArray a)
forall a. Maybe a
Nothing) Step s ()
res
            else Step (Tuple' (Maybe (MutArray a)) s) ()
-> m (Step (Tuple' (Maybe (MutArray a)) s) ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' (Maybe (MutArray a)) s) ()
 -> m (Step (Tuple' (Maybe (MutArray a)) s) ()))
-> Step (Tuple' (Maybe (MutArray a)) s) ()
-> m (Step (Tuple' (Maybe (MutArray a)) s) ())
forall a b. (a -> b) -> a -> b
$ Tuple' (Maybe (MutArray a)) s
-> Step (Tuple' (Maybe (MutArray a)) s) ()
forall s b. s -> Step s b
FL.Partial (Tuple' (Maybe (MutArray a)) s
 -> Step (Tuple' (Maybe (MutArray a)) s) ())
-> Tuple' (Maybe (MutArray a)) s
-> Step (Tuple' (Maybe (MutArray a)) s) ()
forall a b. (a -> b) -> a -> b
$ Maybe (MutArray a) -> s -> Tuple' (Maybe (MutArray a)) s
forall a b. a -> b -> Tuple' a b
Tuple' (MutArray a -> Maybe (MutArray a)
forall a. a -> Maybe a
Just MutArray a
buf) s
acc

    step :: Tuple' (Maybe (MutArray a)) s
-> MutArray a -> m (Step (Tuple' (Maybe (MutArray a)) s) ())
step (Tuple' Maybe (MutArray a)
Nothing s
r1) MutArray a
arr =
         Int
-> s -> MutArray a -> m (Step (Tuple' (Maybe (MutArray a)) s) ())
runInner (MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr) s
r1 MutArray a
arr

    -- XXX Buffer arrays as a list to avoid copy and reallocations
    step (Tuple' (Just MutArray a
buf) s
r1) MutArray a
arr = do
        let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutArray a -> Int
forall a. MutArray a -> Int
byteLength MutArray a
arr
        MutArray a
buf1 <- if MutArray a -> Int
forall a. MutArray a -> Int
byteCapacity MutArray a
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
                then IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
forall a.
PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)
reallocExplicitAs
                        PinnedState
ps (SIZE_OF(a)) (max minBytes len) buf
                else MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
buf
        MutArray a
buf2 <- MutArray a -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> MutArray a -> m (MutArray a)
spliceUnsafe MutArray a
buf1 MutArray a
arr
        Int
-> s -> MutArray a -> m (Step (Tuple' (Maybe (MutArray a)) s) ())
runInner Int
len s
r1 MutArray a
buf2

    -- XXX Several folds do extract >=> final, therefore, we need to make final
    -- return "m b" rather than using extract post it if we want extract to be
    -- partial.
    --
    -- extract forces the pending buffer to be sent to the fold which is not
    -- what we want.
    extract :: p -> a
extract p
_ = [Char] -> a
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"lCompactGE: not designed for scanning"

    final :: Tuple' (Maybe (MutArray a)) s -> m ()
final (Tuple' Maybe (MutArray a)
Nothing s
r1) = s -> m ()
final1 s
r1
    final (Tuple' (Just MutArray a
buf) s
r1) = do
        Step s ()
r <- s -> MutArray a -> m (Step s ())
step1 s
r1 MutArray a
buf
        case Step s ()
r of
            FL.Partial s
rr -> s -> m ()
final1 s
rr
            FL.Done ()
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Like 'compactGE' but for transforming folds instead of stream.
--
-- >>> lCompactGE n = Fold.many (MutArray.fCompactGE n)
--
-- Generates unpinned arrays irrespective of the pinning status of input
-- arrays.
{-# INLINE lCompactGE #-}
lCompactGE :: forall m a. (MonadIO m, Unbox a)
    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
lCompactGE :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
lCompactGE = PinnedState
-> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState
-> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
lCompactGeAs PinnedState
Unpinned

-- | Pinned version of 'lCompactGE'.
{-# INLINE lPinnedCompactGE #-}
lPinnedCompactGE :: forall m a. (MonadIO m, Unbox a)
    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
lPinnedCompactGE :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
lPinnedCompactGE = PinnedState
-> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
PinnedState
-> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()
lCompactGeAs PinnedState
Pinned

-- | @compactGE n stream@ coalesces adjacent arrays in the @stream@ until
-- the size becomes greater than or equal to @n@.
--
-- >>> compactGE n = Stream.foldMany (MutArray.fCompactGE n)
--
{-# INLINE compactGE #-}
compactGE ::
       (MonadIO m, Unbox a)
    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)
compactGE :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Stream m (MutArray a) -> Stream m (MutArray a)
compactGE Int
n = Fold m (MutArray a) (MutArray a)
-> Stream m (MutArray a) -> Stream m (MutArray a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> Stream m b
D.foldMany (Int -> Fold m (MutArray a) (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> Fold m (MutArray a) (MutArray a)
fCompactGE Int
n)

-- | 'compactEQ n' coalesces adajacent arrays in the input stream to
-- arrays of exact size @n@.
--
-- /Unimplemented/
{-# INLINE compactEQ #-}
compactEQ :: -- (MonadIO m, Unbox a) =>
    Int -> Stream m (MutArray a) -> Stream m (MutArray a)
compactEQ :: forall (m :: * -> *) a.
Int -> Stream m (MutArray a) -> Stream m (MutArray a)
compactEQ Int
_n = Stream m (MutArray a) -> Stream m (MutArray a)
forall a. (?callStack::CallStack) => a
undefined -- D.parseManyD (pCompactEQ n)

-------------------------------------------------------------------------------
-- In-place mutation algorithms
-------------------------------------------------------------------------------

-- | Strip elements which match with predicate from both ends.
--
-- /Pre-release/
{-# INLINE strip #-}
strip :: forall a m. (Unbox a, MonadIO m) =>
    (a -> Bool) -> MutArray a -> m (MutArray a)
strip :: forall a (m :: * -> *).
(Unbox a, MonadIO m) =>
(a -> Bool) -> MutArray a -> m (MutArray a)
strip a -> Bool
eq arr :: MutArray a
arr@MutArray{Int
MutByteArray
arrContents :: forall a. MutArray a -> MutByteArray
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ do
    Int
st <- Int -> IO Int
getStart Int
arrStart
    Int
end <- Int -> Int -> IO Int
getLast Int
arrEnd Int
st
    MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
arr {arrStart = st, arrEnd = end, arrBound = end}

    where

    {-
    -- XXX This should have the same perf but it does not, investigate.
    getStart = do
        r <- liftIO $ D.head $ D.findIndices (not . eq) $ toStreamD arr
        pure $
            case r of
                Nothing -> arrEnd
                Just i -> PTR_INDEX(arrStart,i,a)
    -}

    getStart :: Int -> IO Int
getStart Int
cur = do
        if Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrEnd
        then do
            a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
cur MutByteArray
arrContents
            if a -> Bool
eq a
r
            then Int -> IO Int
getStart (INDEX_NEXT(cur,a))
            else Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
cur
        else Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
cur

    getLast :: Int -> Int -> IO Int
getLast Int
cur Int
low = do
        if Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
low
        then do
            let prev :: Int
prev = INDEX_PREV(cur,a)
            a
r <- Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
prev MutByteArray
arrContents
            if a -> Bool
eq a
r
            then Int -> Int -> IO Int
getLast Int
prev Int
low
            else Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
cur
        else Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
cur

-- | Given an array sorted in ascending order except the last element being out
-- of order, use bubble sort to place the last element at the right place such
-- that the array remains sorted in ascending order.
--
-- /Pre-release/
{-# INLINE bubble #-}
bubble :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> MutArray a -> m ()
bubble :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(a -> a -> Ordering) -> MutArray a -> m ()
bubble a -> a -> Ordering
cmp0 MutArray a
arr =
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        a
x <- Int -> MutArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m a
getIndexUnsafe (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) MutArray a
arr
        a -> Int -> m ()
forall {m :: * -> *}. MonadIO m => a -> Int -> m ()
go a
x (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)

        where

        l :: Int
l = MutArray a -> Int
forall a. Unbox a => MutArray a -> Int
length MutArray a
arr

        go :: a -> Int -> m ()
go a
x Int
i =
            if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
            then do
                a
x1 <- Int -> MutArray a -> m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> m a
getIndexUnsafe Int
i MutArray a
arr
                case a
x a -> a -> Ordering
`cmp0` a
x1 of
                    Ordering
LT -> do
                        Int -> MutArray a -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m ()
putIndexUnsafe (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MutArray a
arr a
x1
                        a -> Int -> m ()
go a
x (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    Ordering
_ -> Int -> MutArray a -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m ()
putIndexUnsafe (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MutArray a
arr a
x
            else Int -> MutArray a -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> MutArray a -> a -> m ()
putIndexUnsafe (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) MutArray a
arr a
x