{-# LANGUAGE CPP #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Streamly.Internal.Data.MutArray.Generic
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD3-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
module Streamly.Internal.Data.MutArray.Generic
(
    -- * Type
    -- $arrayNotes
      MutArray (..)

    -- * Constructing and Writing
    -- ** Construction
    , nil

    -- *** Uninitialized Arrays
    , emptyOf
    -- , newArrayWith

    -- *** From streams
    , unsafeCreateOf
    , createOf
    , createWith -- createOfMin/createMin/createGE?
    , create
    , fromStreamN
    , fromStream
    , fromPureStream

    -- , writeRevN
    -- , writeRev

    -- ** From containers
    , fromListN
    , fromList

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

    -- * 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 two
    -- bounds in the array representation.

    -- ** Reallocation
    , realloc
    , uninit

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

    -- ** Appending streams
    -- , writeAppendNUnsafe
    -- , writeAppendN
    -- , writeAppendWith
    -- , writeAppend

    -- ** Truncation
    -- These are not the same as slicing the array at the beginning, they may
    -- reduce the length as well as the capacity of the array.
    -- , truncateWith
    -- , truncate
    -- , truncateExp

    -- * Eliminating and Reading

    -- ** Unfolds
    , reader
    -- , readerRev
    , producerWith -- experimental
    , producer -- experimental

    -- ** To containers
    , read
    , readRev
    , toStreamK
    -- , toStreamKRev
    , toList

    -- ** Random reads
    , getIndex
    , unsafeGetIndex
    , unsafeGetIndexWith
    -- , getIndices
    -- , getFromThenTo
    -- , getIndexRev

    -- * Size
    , length

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

    -- * Folding
    -- , foldl'
    -- , foldr
    , cmp
    , eq

    -- * 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.

    -- | Operations dealing with multiple arrays, streams of arrays or
    -- multidimensional array representations.

    -- ** Construct from streams
    , chunksOf
    -- , arrayStreamKFromStreamD
    -- , writeChunks

    -- ** Eliminate to streams
    -- , flattenArrays
    -- , flattenArraysRev
    -- , fromArrayStreamK

    -- ** Construct from arrays
    -- get chunks without copying
    , unsafeSliceOffLen
    , sliceOffLen
    -- , getSlicesFromLenN
    -- , splitAt -- XXX should be able to express using sliceOffLen
    -- , breakOn

    -- ** Appending arrays
    -- , spliceCopy
    -- , spliceWith
    -- , splice
    -- , spliceExp
    , unsafePutSlice
    -- , appendSlice
    -- , appendSliceFrom

    , clone

    -- * Deprecated
    , unsafeGetSlice
    , getSlice
    , strip
    , new
    , writeNUnsafe
    , writeN
    , writeWith
    , write
    , getIndexUnsafe
    , getIndexUnsafeWith
    , putIndexUnsafe
    , modifyIndexUnsafe
    , snocUnsafe
    , getSliceUnsafe
    , putSliceUnsafe
    )
where

#include "inline.hs"
#include "deprecation.h"
#include "assert.hs"

import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Functor.Identity (Identity(..))
import GHC.Base
    ( MutableArray#
    , RealWorld
    , copyMutableArray#
    , newArray#
    , readArray#
    , writeArray#
    )
import GHC.IO (IO(..))
import GHC.Int (Int(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Producer.Type (Producer (..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.Data.Stream.Type (Stream)
import Streamly.Internal.Data.SVar.Type (adaptState)

import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Producer as Producer
import qualified Streamly.Internal.Data.Stream.Type as D
import qualified Streamly.Internal.Data.Stream.Generate as D
import qualified Streamly.Internal.Data.Stream.Lift as D
import qualified Streamly.Internal.Data.StreamK.Type as K

import Prelude hiding (read, length)

#include "DocTestDataMutArrayGeneric.hs"

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

data MutArray a =
    MutArray
        { forall a. MutArray a -> MutableArray# RealWorld a
arrContents# :: MutableArray# RealWorld a
          -- ^ The internal contents of the array representing the entire array.

        , forall a. MutArray a -> Int
arrStart :: {-# UNPACK #-}!Int
          -- ^ The starting index of this slice.

        , forall a. MutArray a -> Int
arrEnd :: {-# UNPACK #-}!Int
          -- ^ The index after the last initialized index.

        , forall a. MutArray a -> Int
arrBound :: {-# UNPACK #-}!Int
          -- ^ The first invalid index.
        }

{-# INLINE bottomElement #-}
bottomElement :: a
bottomElement :: forall a. a
bottomElement =
    [Char] -> a
forall a. HasCallStack => [Char] -> a
error
        ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords
              [ [Char]
funcName
              , [Char]
"This is the bottom element of the array."
              , [Char]
"This is a place holder and should never be reached!"
              ]

    where

    funcName :: [Char]
funcName = [Char]
"Streamly.Internal.Data.MutArray.Generic.bottomElement:"

-- XXX Would be nice if GHC can provide something like newUninitializedArray# so
-- that we do not have to write undefined or error in the whole array.

-- | @emptyOf count@ allocates a zero length array that can be extended to hold
-- up to 'count' items without reallocating.
--
-- /Pre-release/
{-# INLINE emptyOf #-}
emptyOf :: MonadIO m => Int -> m (MutArray a)
emptyOf :: forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
emptyOf n :: Int
n@(I# Int#
n#) =
    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
$ (State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
        ((State# RealWorld -> (# State# RealWorld, MutArray a #))
 -> IO (MutArray a))
-> (State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
              case Int#
-> a
-> State# RealWorld
-> (# State# RealWorld, MutableArray# RealWorld a #)
forall a d.
Int# -> a -> State# d -> (# State# d, MutableArray# d a #)
newArray# Int#
n# a
forall a. a
bottomElement State# RealWorld
s# of
                  (# State# RealWorld
s1#, MutableArray# RealWorld a
arr# #) ->
                      let ma :: MutArray a
ma = MutableArray# RealWorld a -> Int -> Int -> Int -> MutArray a
forall a.
MutableArray# RealWorld a -> Int -> Int -> Int -> MutArray a
MutArray MutableArray# RealWorld a
arr# Int
0 Int
0 Int
n
                       in (# State# RealWorld
s1#, MutArray a
ma #)

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

-- XXX This could be pure?

-- |
-- Definition:
--
-- >>> nil = MutArray.emptyOf 0
{-# INLINE nil #-}
nil :: MonadIO m => m (MutArray a)
nil :: forall (m :: * -> *) a. MonadIO m => m (MutArray a)
nil = Int -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new Int
0

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

-- | Write the given element to the given index of the 'MutableArray#'. Does not
-- check if the index is out of bounds of the array.
--
-- /Pre-release/
{-# INLINE putIndexUnderlying #-}
putIndexUnderlying :: MonadIO m => Int -> MutableArray# RealWorld a -> a -> m ()
putIndexUnderlying :: forall (m :: * -> *) a.
MonadIO m =>
Int -> MutableArray# RealWorld a -> a -> m ()
putIndexUnderlying Int
n MutableArray# RealWorld a
_arrContents# a
x =
    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
$ (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# ->
              case Int
n of
                  I# Int#
n# ->
                      let s1# :: State# RealWorld
s1# = MutableArray# RealWorld a
-> Int# -> a -> State# RealWorld -> State# RealWorld
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# MutableArray# RealWorld a
_arrContents# Int#
n# a
x State# RealWorld
s#
                       in (# State# RealWorld
s1#, () #)

-- | 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 unsafePutIndex #-}
unsafePutIndex, putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()
unsafePutIndex :: forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> a -> m ()
unsafePutIndex Int
i arr :: MutArray a
arr@(MutArray {Int
MutableArray# RealWorld a
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents# :: MutableArray# RealWorld a
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..}) a
x =
    Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr)
        (Int -> MutableArray# RealWorld a -> a -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Int -> MutableArray# RealWorld a -> a -> m ()
putIndexUnderlying (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arrStart) MutableArray# RealWorld a
arrContents# a
x)

invalidIndex :: String -> Int -> a
invalidIndex :: forall a. [Char] -> Int -> a
invalidIndex [Char]
label Int
i =
    [Char] -> a
forall a. HasCallStack => [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, ()))
--
-- /Pre-release/
{-# INLINE putIndex #-}
putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()
putIndex :: forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> a -> m ()
putIndex Int
i MutArray a
arr a
x =
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr
    then Int -> MutArray a -> a -> m ()
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> a -> m ()
unsafePutIndex Int
i MutArray a
arr 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 :: MonadIO m
    => MutArray a -> Fold m (Int, a) ()
putIndices :: forall (m :: * -> *) a.
MonadIO m =>
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 => Int -> MutArray a -> a -> m ()
putIndex Int
i MutArray a
arr a
x

-- | Modify a given index of an array using a modifier function without checking
-- the bounds.
--
-- Unsafe because it does not check the bounds of the array.
--
-- /Pre-release/
unsafeModifyIndex, modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b
unsafeModifyIndex :: forall (m :: * -> *) a b.
MonadIO m =>
Int -> MutArray a -> (a -> (a, b)) -> m b
unsafeModifyIndex Int
i MutArray {Int
MutableArray# RealWorld a
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents# :: MutableArray# RealWorld a
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a -> (a, b)
f = do
    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
$ (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
        ((State# RealWorld -> (# State# RealWorld, b #)) -> IO b)
-> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
              case Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arrStart of
                  I# Int#
n# ->
                      case MutableArray# RealWorld a
-> Int# -> State# RealWorld -> (# State# RealWorld, a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# MutableArray# RealWorld a
arrContents# Int#
n# State# RealWorld
s# of
                          (# State# RealWorld
s1#, a
a #) ->
                              let (a
a1, b
b) = a -> (a, b)
f a
a
                                  s2# :: State# RealWorld
s2# = MutableArray# RealWorld a
-> Int# -> a -> State# RealWorld -> State# RealWorld
forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d
writeArray# MutableArray# RealWorld a
arrContents# Int#
n# a
a1 State# RealWorld
s1#
                               in (# State# RealWorld
s2#, b
b #)

-- | Modify a given index of an array using a modifier function.
--
-- /Pre-release/
modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndex :: forall (m :: * -> *) a b.
MonadIO m =>
Int -> MutArray a -> (a -> (a, b)) -> m b
modifyIndex Int
i MutArray a
arr a -> (a, b)
f = do
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr
    then Int -> MutArray a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadIO m =>
Int -> MutArray a -> (a -> (a, b)) -> m b
unsafeModifyIndex Int
i MutArray a
arr a -> (a, b)
f
    else [Char] -> Int -> m b
forall a. [Char] -> Int -> a
invalidIndex [Char]
"modifyIndex" Int
i

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

-- | Reallocates the array according to the new size. This is a safe function
-- that always creates a new array and copies the old array into the new one.
-- If the reallocated size is less than the original array it results in a
-- truncated version of the original array.
--
realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a)
realloc :: forall (m :: * -> *) a.
MonadIO m =>
Int -> MutArray a -> m (MutArray a)
realloc Int
n MutArray a
arr = do
    MutArray a
arr1 <- Int -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new Int
n
    let !newLen :: Int
newLen@(I# Int#
newLen#) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n (MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr)
        !(I# Int#
arrS#) = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr
        !(I# Int#
arr1S#) = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr1
        arrC# :: MutableArray# RealWorld a
arrC# = MutArray a -> MutableArray# RealWorld a
forall a. MutArray a -> MutableArray# RealWorld a
arrContents# MutArray a
arr
        arr1C# :: MutableArray# RealWorld a
arr1C# = MutArray a -> MutableArray# RealWorld a
forall a. MutArray a -> MutableArray# RealWorld a
arrContents# MutArray a
arr1
        !newEnd :: Int
newEnd = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
newLen
        !newBound :: Int
newBound = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
    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
$ (State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
        ((State# RealWorld -> (# State# RealWorld, MutArray a #))
 -> IO (MutArray a))
-> (State# RealWorld -> (# State# RealWorld, MutArray a #))
-> IO (MutArray a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
              let s1# :: State# RealWorld
s1# = MutableArray# RealWorld a
-> Int#
-> MutableArray# RealWorld a
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d a.
MutableArray# d a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableArray# MutableArray# RealWorld a
arrC# Int#
arrS# MutableArray# RealWorld a
arr1C# Int#
arr1S# Int#
newLen# State# RealWorld
s#
               in (# State# RealWorld
s1#, MutArray a
arr1 {arrEnd :: Int
arrEnd = Int
newEnd, arrBound :: Int
arrBound = Int
newBound} #)

reallocWith ::
       MonadIO m => String -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith :: forall (m :: * -> *) a.
MonadIO m =>
[Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith [Char]
label Int -> Int
sizer Int
reqSize MutArray a
arr = do
    let oldSize :: Int
oldSize = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr
        newSize :: Int
newSize = Int -> Int
sizer Int
oldSize
        safeSize :: Int
safeSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
newSize (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
reqSize)
    Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
newSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
reqSize Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
badSize) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> MutArray a -> m (MutArray a)
realloc Int
safeSize MutArray a
arr

    where

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

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

-- XXX Not sure of the behavior of writeArray# if we specify an index which is
-- out of bounds. This comment should be rewritten based on that.
-- | Really really unsafe, appends the element into the first array, may
-- cause silent data corruption or if you are lucky a segfault if the index
-- is out of bounds.
--
-- /Internal/
{-# INLINE unsafeSnoc #-}
snocUnsafe, unsafeSnoc :: MonadIO m => MutArray a -> a -> m (MutArray a)
unsafeSnoc :: forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
unsafeSnoc arr :: MutArray a
arr@(MutArray{Int
MutableArray# RealWorld a
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents# :: MutableArray# RealWorld a
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..}) a
x = do
    let newEnd :: Int
newEnd = Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    Int -> MutableArray# RealWorld a -> a -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Int -> MutableArray# RealWorld a -> a -> m ()
putIndexUnderlying Int
arrEnd MutableArray# RealWorld a
arrContents# a
x
    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 :: Int
arrEnd = Int
newEnd}

-- NOINLINE to move it out of the way and not pollute the instruction cache.
{-# NOINLINE snocWithRealloc #-}
snocWithRealloc :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWithRealloc :: forall (m :: * -> *) a.
MonadIO m =>
(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 =>
[Char] -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)
reallocWith [Char]
"snocWithRealloc" Int -> Int
sizer Int
1 MutArray a
arr
    MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
unsafeSnoc 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 oldSize@ function, where @oldSize@ is the
-- original size of the array.
--
-- Note that the returned array may be a mutated version of the original array.
--
-- /Pre-release/
{-# INLINE snocWith #-}
snocWith :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith :: forall (m :: * -> *) a.
MonadIO m =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith Int -> Int
sizer arr :: MutArray a
arr@MutArray {Int
MutableArray# RealWorld a
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents# :: MutableArray# RealWorld a
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} a
x = do
    if Int
arrEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arrBound
    then MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
unsafeSnoc MutArray a
arr a
x
    else (Int -> Int) -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWithRealloc Int -> Int
sizer MutArray a
arr a
x

-- XXX round it to next power of 2.

-- | 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.
--
-- /Pre-release/
{-# INLINE snoc #-}
snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)
snoc :: forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
snoc = (Int -> Int) -> MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
(Int -> Int) -> MutArray a -> a -> m (MutArray a)
snocWith (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)

-- | Make the uninitialized memory in the array available for use extending it
-- by the supplied length beyond the current length of the array. The array may
-- be reallocated.
--
{-# INLINE uninit #-}
uninit :: MonadIO m => MutArray a -> Int -> m (MutArray a)
uninit :: forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> Int -> m (MutArray a)
uninit arr :: MutArray a
arr@MutArray{Int
MutableArray# RealWorld a
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents# :: MutableArray# RealWorld a
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} Int
len =
    if Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
arrBound
    then 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 :: Int
arrEnd = Int
arrEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len}
    else Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> MutArray a -> m (MutArray a)
realloc (MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) MutArray a
arr

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

-- | Return the element at the specified index without checking the bounds from
-- a @MutableArray# RealWorld@.
--
-- Unsafe because it does not check the bounds of the array.
{-# INLINE unsafeGetIndexWith #-}
unsafeGetIndexWith, getIndexUnsafeWith :: MonadIO m => MutableArray# RealWorld a -> Int -> m a
unsafeGetIndexWith :: forall (m :: * -> *) a.
MonadIO m =>
MutableArray# RealWorld a -> Int -> m a
unsafeGetIndexWith MutableArray# RealWorld a
_arrContents# Int
n =
    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
$ (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO
        ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s# ->
              let !(I# Int#
i#) = Int
n
               in MutableArray# RealWorld a
-> Int# -> State# RealWorld -> (# State# RealWorld, a #)
forall d a.
MutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readArray# MutableArray# RealWorld a
_arrContents# Int#
i# State# RealWorld
s#

-- | Return the element at the specified index without checking the bounds.
--
-- Unsafe because it does not check the bounds of the array.
{-# INLINE_NORMAL unsafeGetIndex #-}
unsafeGetIndex, getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex :: forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
n MutArray {Int
MutableArray# RealWorld a
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents# :: MutableArray# RealWorld a
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} = MutableArray# RealWorld a -> Int -> m a
forall (m :: * -> *) a.
MonadIO m =>
MutableArray# RealWorld a -> Int -> m a
unsafeGetIndexWith MutableArray# RealWorld a
arrContents# (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arrStart)

-- | /O(1)/ Lookup the element at the given index. Index starts from 0.
--
{-# INLINE getIndex #-}
getIndex :: MonadIO m => Int -> MutArray a -> m (Maybe a)
getIndex :: forall (m :: * -> *) a.
MonadIO m =>
Int -> MutArray a -> m (Maybe a)
getIndex Int
i MutArray a
arr =
    if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr
    then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
i MutArray a
arr
    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

-------------------------------------------------------------------------------
-- 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 unsafeSliceOffLen #-}
unsafeSliceOffLen, getSliceUnsafe, unsafeGetSlice
    :: Int -- ^ from index
    -> Int -- ^ length of the slice
    -> MutArray a
    -> MutArray a
unsafeSliceOffLen :: forall a. Int -> Int -> MutArray a -> MutArray a
unsafeSliceOffLen Int
index Int
len arr :: MutArray a
arr@MutArray {Int
MutableArray# RealWorld a
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents# :: MutableArray# RealWorld a
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    Bool -> MutArray a -> MutArray a
forall a. HasCallStack => 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
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr)
        (MutArray a -> MutArray a) -> MutArray a -> MutArray a
forall a b. (a -> b) -> a -> b
$ MutArray a
arr {arrStart :: Int
arrStart = Int
newStart, arrEnd :: Int
arrEnd = Int
newEnd}
    where
    newStart :: Int
newStart = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index
    newEnd :: Int
newEnd = Int
newStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len

-- | /O(1)/ Slice an array in constant time. Throws an error if the slice
-- extends out of the array bounds.
--
-- /Pre-release/
{-# INLINE sliceOffLen #-}
sliceOffLen, getSlice
    :: Int -- ^ from index
    -> Int -- ^ length of the slice
    -> MutArray a
    -> MutArray a
sliceOffLen :: forall a. Int -> Int -> MutArray a -> MutArray a
sliceOffLen Int
index Int
len arr :: MutArray a
arr@MutArray{Int
MutableArray# RealWorld a
arrContents# :: forall a. MutArray a -> MutableArray# RealWorld a
arrStart :: forall a. MutArray a -> Int
arrEnd :: forall a. MutArray a -> Int
arrBound :: forall a. MutArray a -> Int
arrContents# :: MutableArray# RealWorld a
arrStart :: Int
arrEnd :: Int
arrBound :: Int
..} =
    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
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr
    then MutArray a
arr {arrStart :: Int
arrStart = Int
newStart, arrEnd :: Int
arrEnd = Int
newEnd}
    else [Char] -> MutArray a
forall a. HasCallStack => [Char] -> a
error
             ([Char] -> MutArray a) -> [Char] -> MutArray a
forall a b. (a -> b) -> a -> b
$ [Char]
"sliceOffLen: 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
    where
    newStart :: Int
newStart = Int
arrStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index
    newEnd :: Int
newEnd = Int
newStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len

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

-- XXX Maybe faster to create a list explicitly instead of mapM, if list fusion
-- does not work well.

-- | Convert an 'Array' into a list.
--
-- /Pre-release/
{-# INLINE toList #-}
toList :: MonadIO m => MutArray a -> m [a]
toList :: forall (m :: * -> *) a. MonadIO m => MutArray a -> m [a]
toList MutArray a
arr = (Int -> m a) -> [Int] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
`unsafeGetIndex` MutArray a
arr) [Int
0 .. (MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]

-- | Generates a stream from the elements of a @MutArray@.
--
-- >>> read = Stream.unfold MutArray.reader
--
{-# INLINE_NORMAL read #-}
read :: MonadIO m => MutArray a -> D.Stream m a
read :: forall (m :: * -> *) a. MonadIO m => MutArray a -> Stream m a
read MutArray a
arr =
    (Int -> m a) -> Stream m Int -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stream m a -> Stream m b
D.mapM (Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
`unsafeGetIndex` MutArray a
arr) (Stream m Int -> Stream m a) -> Stream m Int -> Stream m a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Stream m Int
forall (m :: * -> *) a.
(Monad m, Integral a) =>
a -> a -> Stream m a
D.enumerateFromToIntegral Int
0 (MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- Check equivalence with StreamK.fromStream . toStreamD and remove
{-# INLINE toStreamK #-}
toStreamK :: MonadIO m => MutArray a -> K.StreamK m a
toStreamK :: forall (m :: * -> *) a. MonadIO m => MutArray a -> StreamK m a
toStreamK MutArray a
arr = (Int -> m (Maybe (a, Int))) -> Int -> StreamK m a
forall (m :: * -> *) b a.
Monad m =>
(b -> m (Maybe (a, b))) -> b -> StreamK m a
K.unfoldrM Int -> m (Maybe (a, Int))
forall {m :: * -> *}. MonadIO m => Int -> m (Maybe (a, Int))
step Int
0

    where

    arrLen :: Int
arrLen = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr
    step :: Int -> m (Maybe (a, Int))
step Int
i
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arrLen = Maybe (a, Int) -> m (Maybe (a, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, Int)
forall a. Maybe a
Nothing
        | Bool
otherwise = do
            a
x <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
i MutArray a
arr
            Maybe (a, Int) -> m (Maybe (a, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (a, Int) -> m (Maybe (a, Int)))
-> Maybe (a, Int) -> m (Maybe (a, Int))
forall a b. (a -> b) -> a -> b
$ (a, Int) -> Maybe (a, Int)
forall a. a -> Maybe a
Just (a
x, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

{-# INLINE_NORMAL readRev #-}
readRev :: MonadIO m => MutArray a -> D.Stream m a
readRev :: forall (m :: * -> *) a. MonadIO m => MutArray a -> Stream m a
readRev MutArray a
arr =
    (Int -> m a) -> Stream m Int -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stream m a -> Stream m b
D.mapM (Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
`unsafeGetIndex` MutArray a
arr)
        (Stream m Int -> Stream m a) -> Stream m Int -> Stream m a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Stream m Int
forall (m :: * -> *) a.
(Monad m, Integral a) =>
a -> a -> a -> Stream m a
D.enumerateFromThenToIntegral (Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
arrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
0
    where
    arrLen :: Int
arrLen = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr

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

-- XXX deduplicate this across unboxed array and this module?

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

-- | 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.
--
-- /Pre-release/
{-# INLINE_NORMAL unsafeCreateOf #-}
unsafeCreateOf :: MonadIO m => Int -> Fold m a (MutArray a)
unsafeCreateOf :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
unsafeCreateOf Int
n = (MutArray a -> a -> m (Step (MutArray a) (MutArray a)))
-> m (Step (MutArray a) (MutArray a))
-> (MutArray a -> m (MutArray a))
-> (MutArray a -> m (MutArray a))
-> Fold m 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 MutArray a -> a -> m (Step (MutArray a) (MutArray a))
forall {f :: * -> *} {a} {b}.
MonadIO f =>
MutArray a -> a -> f (Step (MutArray a) b)
step m (Step (MutArray a) (MutArray a))
forall {a} {b}. m (Step (MutArray a) b)
initial MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

    where

    initial :: m (Step (MutArray a) b)
initial = MutArray a -> Step (MutArray a) b
forall s b. s -> Step s b
FL.Partial (MutArray a -> Step (MutArray a) b)
-> m (MutArray a) -> m (Step (MutArray a) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0)

    step :: MutArray a -> a -> f (Step (MutArray a) b)
step MutArray a
arr a
x = MutArray a -> Step (MutArray a) b
forall s b. s -> Step s b
FL.Partial (MutArray a -> Step (MutArray a) b)
-> f (MutArray a) -> f (Step (MutArray a) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutArray a -> a -> f (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
unsafeSnoc MutArray a
arr a
x

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

-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an
-- 'Array'.
--
-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)
--
-- /Pre-release/
{-# INLINE_NORMAL createOf #-}
createOf :: MonadIO m => Int -> Fold m a (MutArray a)
createOf :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
createOf 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 (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
$ Int -> Fold m a (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
unsafeCreateOf Int
n

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

-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.pinnedNew n)
-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)
-- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)

-- | @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./
--
-- /Pre-release/
{-# INLINE_NORMAL createWith #-}
createWith :: MonadIO m => Int -> Fold m a (MutArray a)
-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (pinnedNew n)
createWith :: forall (m :: * -> *) a. MonadIO m => Int -> Fold m a (MutArray a)
createWith 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)
forall {a}. a -> m 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 =>
MutArray a -> a -> m (MutArray a)
step m (MutArray a)
forall {a}. 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. HasCallStack => [Char] -> a
error [Char]
"createWith: elemCount is negative"
        Int -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new Int
elemCount

    step :: MutArray a -> a -> m (MutArray a)
step arr :: MutArray a
arr@(MutArray MutableArray# RealWorld a
_ Int
start Int
end Int
bound) a
x
        | Int
end Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bound = do
        let oldSize :: Int
oldSize = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
            newSize :: Int
newSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Int
1
        MutArray a
arr1 <- Int -> MutArray a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> MutArray a -> m (MutArray a)
realloc Int
newSize MutArray a
arr
        MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
unsafeSnoc MutArray a
arr1 a
x
    step MutArray a
arr a
x = MutArray a -> a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> a -> m (MutArray a)
unsafeSnoc MutArray a
arr a
x

    -- extract = rightSize
    extract :: a -> m a
extract = a -> m a
forall {a}. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

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

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

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

-- | Create a 'MutArray' from the first @n@ elements of a stream. The
-- array is allocated to size @n@, if the stream terminates before @n@
-- elements then the array may hold less than @n@ elements.
--
{-# INLINE fromStreamN #-}
fromStreamN :: MonadIO m => Int -> Stream m a -> m (MutArray a)
fromStreamN :: forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (MutArray a)
fromStreamN Int
n = 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 => Int -> Fold m a (MutArray a)
writeN Int
n)

{-# INLINE fromStream #-}
fromStream :: MonadIO m => Stream m a -> m (MutArray a)
fromStream :: forall (m :: * -> *) a. MonadIO m => Stream m a -> m (MutArray a)
fromStream = 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 => Fold m a (MutArray a)
write

{-# INLINABLE fromListN #-}
fromListN :: MonadIO m => Int -> [a] -> m (MutArray a)
fromListN :: forall (m :: * -> *) a. MonadIO m => Int -> [a] -> m (MutArray a)
fromListN Int
n [a]
xs = Int -> Stream m a -> m (MutArray a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> m (MutArray a)
fromStreamN 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

{-# INLINABLE fromList #-}
fromList :: MonadIO m => [a] -> m (MutArray a)
fromList :: forall (m :: * -> *) a. MonadIO m => [a] -> m (MutArray a)
fromList [a]
xs = Stream m a -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Stream m a -> m (MutArray a)
fromStream (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

{-# INLINABLE fromPureStream #-}
fromPureStream :: MonadIO m => Stream Identity a -> m (MutArray a)
fromPureStream :: forall (m :: * -> *) a.
MonadIO m =>
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 => Fold m a (MutArray a)
write (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

-------------------------------------------------------------------------------
-- Chunking
-------------------------------------------------------------------------------

data GroupState s a start end bound
    = GroupStart s
    | GroupBuffer s (MutableArray# RealWorld a) start end bound
    | GroupYield
          (MutableArray# RealWorld a)
          start
          end
          bound
          (GroupState s a start end bound)
    | GroupFinish

-- | @chunksOf n stream@ groups the input stream into a stream of
-- arrays of size n.
--
-- @chunksOf n = foldMany (MutArray.writeN n)@
--
-- /Pre-release/
{-# INLINE_NORMAL chunksOf #-}
chunksOf :: forall m a. MonadIO m
    => 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 (writeN n)
chunksOf :: forall (m :: * -> *) a.
MonadIO m =>
Int -> Stream m a -> Stream m (MutArray a)
chunksOf Int
n (D.Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m (MutArray a)
 -> GroupState s a Int Int Int
 -> m (Step (GroupState s a Int Int Int) (MutArray a)))
-> GroupState s a 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 a Int Int Int
-> m (Step (GroupState s a Int Int Int) (MutArray a))
forall {m :: * -> *} {a}.
State StreamK m a
-> GroupState s a Int Int Int
-> m (Step (GroupState s a Int Int Int) (MutArray a))
step' (s -> GroupState s a Int Int Int
forall s a start end bound. s -> GroupState s a start end bound
GroupStart s
state)

    where

    -- start is always 0
    -- end and len are always equal

    {-# INLINE_LATE step' #-}
    step' :: State StreamK m a
-> GroupState s a Int Int Int
-> m (Step (GroupState s a 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. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Internal.Data.Array.Generic.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 MutableArray# RealWorld a
contents Int
start Int
end Int
bound :: MutArray a) <- Int -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new Int
n
        Step (GroupState s a Int Int Int) (MutArray a)
-> m (Step (GroupState s a Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s a Int Int Int) (MutArray a)
 -> m (Step (GroupState s a Int Int Int) (MutArray a)))
-> Step (GroupState s a Int Int Int) (MutArray a)
-> m (Step (GroupState s a Int Int Int) (MutArray a))
forall a b. (a -> b) -> a -> b
$ GroupState s a Int Int Int
-> Step (GroupState s a Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip (s
-> MutableArray# RealWorld a
-> Int
-> Int
-> Int
-> GroupState s a Int Int Int
forall s a start end bound.
s
-> MutableArray# RealWorld a
-> start
-> end
-> bound
-> GroupState s a start end bound
GroupBuffer s
st MutableArray# RealWorld a
contents Int
start Int
end Int
bound)

    step' State StreamK m a
gst (GroupBuffer s
st MutableArray# RealWorld a
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
                Int -> MutableArray# RealWorld a -> a -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Int -> MutableArray# RealWorld a -> a -> m ()
putIndexUnderlying Int
end MutableArray# RealWorld a
contents a
x
                let end1 :: Int
end1 = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                Step (GroupState s a Int Int Int) (MutArray a)
-> m (Step (GroupState s a Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s a Int Int Int) (MutArray a)
 -> m (Step (GroupState s a Int Int Int) (MutArray a)))
-> Step (GroupState s a Int Int Int) (MutArray a)
-> m (Step (GroupState s a 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 a Int Int Int
-> Step (GroupState s a Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip
                            (MutableArray# RealWorld a
-> Int
-> Int
-> Int
-> GroupState s a Int Int Int
-> GroupState s a Int Int Int
forall s a start end bound.
MutableArray# RealWorld a
-> start
-> end
-> bound
-> GroupState s a start end bound
-> GroupState s a start end bound
GroupYield
                                MutableArray# RealWorld a
contents Int
start Int
end1 Int
bound (s -> GroupState s a Int Int Int
forall s a start end bound. s -> GroupState s a start end bound
GroupStart s
s))
                    else GroupState s a Int Int Int
-> Step (GroupState s a Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip (s
-> MutableArray# RealWorld a
-> Int
-> Int
-> Int
-> GroupState s a Int Int Int
forall s a start end bound.
s
-> MutableArray# RealWorld a
-> start
-> end
-> bound
-> GroupState s a start end bound
GroupBuffer s
s MutableArray# RealWorld a
contents Int
start Int
end1 Int
bound)
            D.Skip s
s ->
                Step (GroupState s a Int Int Int) (MutArray a)
-> m (Step (GroupState s a Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s a Int Int Int) (MutArray a)
 -> m (Step (GroupState s a Int Int Int) (MutArray a)))
-> Step (GroupState s a Int Int Int) (MutArray a)
-> m (Step (GroupState s a Int Int Int) (MutArray a))
forall a b. (a -> b) -> a -> b
$ GroupState s a Int Int Int
-> Step (GroupState s a Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip (s
-> MutableArray# RealWorld a
-> Int
-> Int
-> Int
-> GroupState s a Int Int Int
forall s a start end bound.
s
-> MutableArray# RealWorld a
-> start
-> end
-> bound
-> GroupState s a start end bound
GroupBuffer s
s MutableArray# RealWorld a
contents Int
start Int
end Int
bound)
            Step s a
D.Stop ->
                Step (GroupState s a Int Int Int) (MutArray a)
-> m (Step (GroupState s a Int Int Int) (MutArray a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (GroupState s a Int Int Int) (MutArray a)
 -> m (Step (GroupState s a Int Int Int) (MutArray a)))
-> Step (GroupState s a Int Int Int) (MutArray a)
-> m (Step (GroupState s a Int Int Int) (MutArray a))
forall a b. (a -> b) -> a -> b
$ GroupState s a Int Int Int
-> Step (GroupState s a Int Int Int) (MutArray a)
forall s a. s -> Step s a
D.Skip (MutableArray# RealWorld a
-> Int
-> Int
-> Int
-> GroupState s a Int Int Int
-> GroupState s a Int Int Int
forall s a start end bound.
MutableArray# RealWorld a
-> start
-> end
-> bound
-> GroupState s a start end bound
-> GroupState s a start end bound
GroupYield MutableArray# RealWorld a
contents Int
start Int
end Int
bound GroupState s a Int Int Int
forall s a start end bound. GroupState s a start end bound
GroupFinish)

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

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

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

-- | Resumable unfold of an array.
--
{-# INLINE_NORMAL producerWith #-}
producerWith :: Monad m => (forall b. IO b -> m b) -> Producer m (MutArray a) a
producerWith :: forall (m :: * -> *) a.
Monad m =>
(forall b. IO b -> m b) -> Producer m (MutArray a) a
producerWith forall b. IO b -> m b
liftio = ((MutArray a, Int) -> m (Step (MutArray a, Int) a))
-> (MutArray a -> m (MutArray a, Int))
-> ((MutArray a, Int) -> 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 (MutArray a, Int) -> m (Step (MutArray a, Int) a)
forall {a}. (MutArray a, Int) -> m (Step (MutArray a, Int) a)
step MutArray a -> m (MutArray a, Int)
forall {m :: * -> *} {b} {a}. (Monad m, Num b) => a -> m (a, b)
inject (MutArray a, Int) -> m (MutArray a)
forall {m :: * -> *} {a}.
Monad m =>
(MutArray a, Int) -> m (MutArray a)
extract

    where

    {-# INLINE inject #-}
    inject :: a -> m (a, b)
inject a
arr = (a, b) -> m (a, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
arr, b
0)

    {-# INLINE extract #-}
    extract :: (MutArray a, Int) -> m (MutArray a)
extract (MutArray a
arr, Int
i) =
        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 {arrStart :: Int
arrStart = MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i}

    {-# INLINE_LATE step #-}
    step :: (MutArray a, Int) -> m (Step (MutArray a, Int) a)
step (MutArray a
arr, Int
i)
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr = Step (MutArray a, Int) a -> m (Step (MutArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (MutArray a, Int) a
forall s a. Step s a
D.Stop
    step (MutArray a
arr, Int
i) = 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 -> MutArray a -> IO a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
i MutArray a
arr
        Step (MutArray a, Int) a -> m (Step (MutArray a, Int) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (MutArray a, Int) a -> m (Step (MutArray a, Int) a))
-> Step (MutArray a, Int) a -> m (Step (MutArray a, Int) a)
forall a b. (a -> b) -> a -> b
$ a -> (MutArray a, Int) -> Step (MutArray a, Int) a
forall s a. a -> s -> Step s a
D.Yield a
x (MutArray a
arr, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Resumable unfold of an array.
--
{-# INLINE_NORMAL producer #-}
producer :: MonadIO m => Producer m (MutArray a) a
producer :: forall (m :: * -> *) a. MonadIO m => Producer m (MutArray a) a
producer = (forall b. IO b -> m b) -> Producer m (MutArray a) a
forall (m :: * -> *) a.
Monad m =>
(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 :: MonadIO m => Unfold m (MutArray a) a
reader :: forall (m :: * -> *) a. MonadIO m => 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 => Producer m (MutArray a) a
producer

--------------------------------------------------------------------------------
-- Appending arrays
--------------------------------------------------------------------------------

-- | Put a sub range of a source array into a subrange of a destination array.
-- This is not safe as it does not check the bounds.
{-# INLINE unsafePutSlice #-}
unsafePutSlice, putSliceUnsafe :: MonadIO m =>
    MutArray a -> Int -> MutArray a -> Int -> Int -> m ()
unsafePutSlice :: forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> Int -> MutArray a -> Int -> Int -> m ()
unsafePutSlice MutArray a
src Int
srcStart MutArray a
dst Int
dstStart Int
len = 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
    assertM(Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
dst)
    assertM(Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
src)
    let !(I# Int#
srcStart#) = Int
srcStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
src
        !(I# Int#
dstStart#) = Int
dstStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutArray a -> Int
forall a. MutArray a -> Int
arrStart MutArray a
dst
        !(I# Int#
len#) = Int
len
    let arrS# :: MutableArray# RealWorld a
arrS# = MutArray a -> MutableArray# RealWorld a
forall a. MutArray a -> MutableArray# RealWorld a
arrContents# MutArray a
src
        arrD# :: MutableArray# RealWorld a
arrD# = MutArray a -> MutableArray# RealWorld a
forall a. MutArray a -> MutableArray# RealWorld a
arrContents# MutArray a
dst
    (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# -> (# MutableArray# RealWorld a
-> Int#
-> MutableArray# RealWorld a
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d a.
MutableArray# d a
-> Int#
-> MutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableArray#
                    MutableArray# RealWorld a
arrS# Int#
srcStart# MutableArray# RealWorld a
arrD# Int#
dstStart# Int#
len# State# RealWorld
s#
                , () #)

{-# INLINE clone #-}
clone :: MonadIO m => MutArray a -> m (MutArray a)
clone :: forall (m :: * -> *) a. MonadIO m => MutArray a -> m (MutArray a)
clone MutArray a
src = do
    let len :: Int
len = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
src
    MutArray a
dst <- Int -> m (MutArray a)
forall (m :: * -> *) a. MonadIO m => Int -> m (MutArray a)
new Int
len
    MutArray a -> Int -> MutArray a -> Int -> Int -> m ()
forall (m :: * -> *) a.
MonadIO m =>
MutArray a -> Int -> MutArray a -> Int -> Int -> m ()
unsafePutSlice MutArray a
src Int
0 MutArray a
dst Int
0 Int
len
    MutArray a -> m (MutArray a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
dst

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

{-# INLINE length #-}
length :: MutArray a -> Int
length :: forall a. MutArray a -> Int
length MutArray a
arr = 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

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

-- | 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.
--
-- /Pre-release/
{-# INLINE cmp #-}
cmp :: (MonadIO m, Ord a) => MutArray a -> MutArray a -> m Ordering
cmp :: forall (m :: * -> *) a.
(MonadIO m, Ord a) =>
MutArray a -> MutArray a -> m Ordering
cmp MutArray a
a1 MutArray a
a2 =
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
lenA1 Int
lenA2 of
        Ordering
EQ -> Int -> m Ordering
forall {m :: * -> *}. MonadIO m => Int -> m Ordering
loop (Int
lenA1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Ordering
x -> Ordering -> m Ordering
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
x

    where

    lenA1 :: Int
lenA1 = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
a1
    lenA2 :: Int
lenA2 = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
a2

    loop :: Int -> m Ordering
loop Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Ordering -> m Ordering
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ
        | Bool
otherwise = do
            a
v1 <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
i MutArray a
a1
            a
v2 <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
i MutArray a
a2
            case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
v1 a
v2 of
                Ordering
EQ -> Int -> m Ordering
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                Ordering
x -> Ordering -> m Ordering
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
x

{-# INLINE eq #-}
eq :: (MonadIO m, Eq a) => MutArray a -> MutArray a -> m Bool
eq :: forall (m :: * -> *) a.
(MonadIO m, Eq a) =>
MutArray a -> MutArray a -> m Bool
eq MutArray a
a1 MutArray a
a2 =
    if Int
lenA1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lenA2
    then Int -> m Bool
forall {m :: * -> *}. MonadIO m => Int -> m Bool
loop (Int
lenA1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    else Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    where

    lenA1 :: Int
lenA1 = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
a1
    lenA2 :: Int
lenA2 = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
a2

    loop :: Int -> m Bool
loop Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        | Bool
otherwise = do
            a
v1 <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
i MutArray a
a1
            a
v2 <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
i MutArray a
a2
            if a
v1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v2
            then Int -> m Bool
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            else Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

{-# INLINE dropAround #-}
dropAround, strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)
dropAround :: forall (m :: * -> *) a.
MonadIO m =>
(a -> Bool) -> MutArray a -> m (MutArray a)
dropAround a -> Bool
p MutArray a
arr = 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
    let lastIndex :: Int
lastIndex = MutArray a -> Int
forall a. MutArray a -> Int
length MutArray a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    Int
indexR <- Int -> IO Int
forall {m :: * -> *}. MonadIO m => Int -> m Int
getIndexR Int
lastIndex -- last predicate failing index
    if Int
indexR Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
    then IO (MutArray a)
forall (m :: * -> *) a. MonadIO m => m (MutArray a)
nil
    else do
        Int
indexL <- Int -> IO Int
forall {m :: * -> *}. MonadIO m => Int -> m Int
getIndexL Int
0 -- first predicate failing index
        if Int
indexL Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
indexR Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lastIndex
        then MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MutArray a
arr
        else
           let newLen :: Int
newLen = Int
indexR Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
indexL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            in 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
$ Int -> Int -> MutArray a -> MutArray a
forall a. Int -> Int -> MutArray a -> MutArray a
unsafeSliceOffLen Int
indexL Int
newLen MutArray a
arr

    where

    getIndexR :: Int -> m Int
getIndexR Int
idx
        | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
        | Bool
otherwise = do
            a
r <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
idx MutArray a
arr
            if a -> Bool
p a
r
            then Int -> m Int
getIndexR (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
            else Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx

    getIndexL :: Int -> m Int
getIndexL Int
idx = do
        a
r <- Int -> MutArray a -> m a
forall (m :: * -> *) a. MonadIO m => Int -> MutArray a -> m a
unsafeGetIndex Int
idx MutArray a
arr
        if a -> Bool
p a
r
        then Int -> m Int
getIndexL (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        else Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx

--------------------------------------------------------------------------------
-- Renaming
--------------------------------------------------------------------------------

RENAME(strip,dropAround)
RENAME(putIndexUnsafe, unsafePutIndex)
RENAME(modifyIndexUnsafe, unsafeModifyIndex)
RENAME(getIndexUnsafe, unsafeGetIndex)
RENAME(getIndexUnsafeWith, unsafeGetIndexWith)
RENAME(getSliceUnsafe,unsafeSliceOffLen)
RENAME(unsafeGetSlice,unsafeSliceOffLen)
RENAME(putSliceUnsafe, unsafePutSlice)
RENAME(getSlice,sliceOffLen)
RENAME(snocUnsafe, unsafeSnoc)