{-# LANGUAGE CPP                       #-}
{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MagicHash                 #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE UnboxedTuples             #-}
{-# LANGUAGE FlexibleContexts          #-}

#if MIN_VERSION_base(4,17,0)
{-# LANGUAGE TypeOperators             #-}
#endif

#include "inline.hs"

-- |
-- Module      : Streamly.Internal.Memory.Array.Types
-- Copyright   : (c) 2019 Composewell Technologies
--
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
module Streamly.Internal.Memory.Array.Types
    (
      Array (..)

    -- * Construction
    , withNewArray
    , newArray
    , unsafeSnoc
    , snoc
    , spliceWithDoubling
    , spliceTwo

    , fromList
    , fromListN
    , fromStreamDN
    -- , fromStreamD

    -- * Streams of arrays
    , fromStreamDArraysOf
    , FlattenState (..) -- for inspection testing
    , flattenArrays
    , flattenArraysRev
    , packArraysChunksOf
    , lpackArraysChunksOf
#if __GLASGOW_HASKELL__ < 900
#if !defined(mingw32_HOST_OS)
    , groupIOVecsOf
#endif
#endif
    , splitOn
    , breakOn

    -- * Elimination
    , unsafeIndexIO
    , unsafeIndex
    , length
    , byteLength
    , byteCapacity
    , foldl'
    , foldr
    , splitAt

    , toStreamD
    , toStreamDRev
    , toStreamK
    , toStreamKRev
    , toList
    , toArrayMinChunk
    , writeN
    , writeNUnsafe
    , writeNAligned
    , writeNAlignedUnmanaged
    , write
    , writeAligned

    -- * Utilities
    , defaultChunkSize
    , mkChunkSize
    , mkChunkSizeKB
    , unsafeInlineIO
    , realloc
    , shrinkToFit
    , memcpy
    , memcmp
    , bytesToElemCount

    , unlines
    )
where

import Control.Exception (assert)
import Control.DeepSeq (NFData(..))
import Control.Monad (when, void)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Functor.Identity (runIdentity)
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup (Semigroup(..))
#endif
import Data.Word (Word8)
import Foreign.C.String (CString)
import Foreign.C.Types (CSize(..), CInt(..))
import Foreign.ForeignPtr (withForeignPtr, touchForeignPtr)
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import Foreign.Ptr (plusPtr, minusPtr, castPtr, nullPtr)
import Foreign.Storable (Storable(..))
import Prelude hiding (length, foldr, read, unlines, splitAt)
import Text.Read (readPrec, readListPrec, readListPrecDefault)

import GHC.Base (Addr#, nullAddr#, realWorld#, build)
import GHC.Exts (IsList, IsString(..))
import GHC.ForeignPtr (ForeignPtr(..), newForeignPtr_)
import GHC.IO (IO(IO), unsafePerformIO)
import GHC.Ptr (Ptr(..))

import Streamly.Internal.Data.Fold.Types (Fold(..))
import Streamly.Internal.Data.Strict (Tuple'(..))
import Streamly.Internal.Data.SVar (adaptState)

#if __GLASGOW_HASKELL__ < 900
#if !defined(mingw32_HOST_OS)
import Streamly.FileSystem.FDIO (IOVec(..))
#endif
#endif

import qualified Streamly.Memory.Malloc as Malloc
import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
import qualified Streamly.Internal.Data.Stream.StreamK as K
import qualified GHC.Exts as Exts

#ifdef DEVBUILD
import qualified Data.Foldable as F
#endif

#if MIN_VERSION_base(4,10,0)
import Foreign.ForeignPtr (plusForeignPtr)
#else
import GHC.Base (Int(..), plusAddr#)
import GHC.ForeignPtr (ForeignPtr(..))
plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr (ForeignPtr addr c) (I# d) = ForeignPtr (plusAddr# addr d) c
#endif

-------------------------------------------------------------------------------
-- Design Notes
-------------------------------------------------------------------------------

-- There are two goals that we want to fulfill with arrays.  One, holding large
-- amounts of data in non-GC memory and the ability to pass this data to and
-- from the operating system without an extra copy overhead. Two, allow random
-- access to elements based on their indices. The first one falls in the
-- category of storage buffers while the second one falls in the category of
-- maps/multisets/hashmaps.
--
-- For the first requirement we use an array of Storables and store it in a
-- ForeignPtr. We can have both immutable and mutable variants of this array
-- using wrappers over the same underlying type.
--
-- For the second requirement, we need a separate type for arrays of
-- polymorphic values, for example vectors of handler functions, lookup tables.
-- We can call this type a "vector" in contrast to arrays.  It should not
-- require Storable instance for the type. In that case we need to use an
-- Array# instead of a ForeignPtr. This type of array would not reduce the GC
-- overhead much because each element of the array still needs to be scanned by
-- the GC.  However, it can store polymorphic elements and allow random access
-- to those.  But in most cases random access means storage, and it means we
-- need to avoid GC scanning except in cases of trivially small storage. One
-- way to achieve that would be to put the array in a Compact region. However,
-- if and when we mutate this, we will have to use a manual GC copying out to
-- another CR and freeing the old one.

-------------------------------------------------------------------------------
-- Array Data Type
-------------------------------------------------------------------------------

-- We require that an array stores only Storable. Arrays are used for buffering
-- data while streams are used for processing. If you want something to be
-- buffered it better be Storable so that we can store it in non-GC memory.
--
-- We can use a "Storable" constraint in the Array type and the Constraint can
-- be automatically provided to a function that pattern matches on the Array
-- type. However, it has huge performance cost, so we do not use it.
-- XXX Can this cost be alleviated in GHC-8.10 specialization fix?
--
-- XXX Another way to not require the Storable constraint in array operations
-- is to store the elemSize in the array at construction and use that instead
-- of using sizeOf. Need to charaterize perf cost of this.
--
-- XXX rename the fields to "start, next, end".
--
data Array a =
#ifdef DEVBUILD
    Storable a =>
#endif
    Array
    { forall a. Array a -> ForeignPtr a
aStart :: {-# UNPACK #-} !(ForeignPtr a) -- first address
    , forall a. Array a -> Ptr a
aEnd   :: {-# UNPACK #-} !(Ptr a)        -- first unused address
    , forall a. Array a -> Ptr a
aBound :: {-# UNPACK #-} !(Ptr a)        -- first address beyond allocated memory
    }

-------------------------------------------------------------------------------
-- Utility functions
-------------------------------------------------------------------------------

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

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

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

-- 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 = 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

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

-- 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CInt
r forall a. Eq a => a -> a -> Bool
== CInt
0

{-# INLINE unsafeInlineIO #-}
unsafeInlineIO :: IO a -> a
unsafeInlineIO :: forall a. IO a -> a
unsafeInlineIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) = case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
realWorld# of (# State# RealWorld
_, a
r #) -> a
r

{-# INLINE bytesToElemCount #-}
bytesToElemCount :: Storable a => a -> Int -> Int
bytesToElemCount :: forall a. Storable a => a -> Int -> Int
bytesToElemCount a
x Int
n =
    let elemSize :: Int
elemSize = forall a. Storable a => a -> Int
sizeOf a
x
    in Int
n forall a. Num a => a -> a -> a
+ Int
elemSize forall a. Num a => a -> a -> a
- Int
1 forall a. Integral a => a -> a -> a
`div` Int
elemSize

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

-- | allocate a new array using the provided allocator function.
{-# INLINE newArrayAlignedAllocWith #-}
newArrayAlignedAllocWith :: forall a. Storable a
    => (Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
newArrayAlignedAllocWith :: forall a.
Storable a =>
(Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
newArrayAlignedAllocWith Int -> Int -> IO (ForeignPtr a)
alloc Int
alignSize Int
count = do
    let size :: Int
size = Int
count forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)
    ForeignPtr a
fptr <- Int -> Int -> IO (ForeignPtr a)
alloc Int
size Int
alignSize
    let p :: Ptr a
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
fptr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array
        { aStart :: ForeignPtr a
aStart = ForeignPtr a
fptr
        , aEnd :: Ptr a
aEnd   = Ptr a
p
        , aBound :: Ptr a
aBound = Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size
        }

-- | Allocate a new array aligned to the specified alignmend and using
-- unmanaged pinned memory. The memory will not be automatically freed by GHC.
-- This could be useful in allocate once global data structures. Use carefully
-- as incorrect use can lead to memory leak.
{-# INLINE newArrayAlignedUnmanaged #-}
newArrayAlignedUnmanaged :: forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAlignedUnmanaged :: forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAlignedUnmanaged =
    forall a.
Storable a =>
(Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
newArrayAlignedAllocWith forall a. Int -> Int -> IO (ForeignPtr a)
Malloc.mallocForeignPtrAlignedUnmanagedBytes

{-# INLINE newArrayAligned #-}
newArrayAligned :: forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAligned :: forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAligned = forall a.
Storable a =>
(Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
newArrayAlignedAllocWith forall a. Int -> Int -> IO (ForeignPtr a)
Malloc.mallocForeignPtrAlignedBytes

-- XXX can unaligned allocation be more efficient when alignment is not needed?
--
-- | Allocate an array that can hold 'count' items.  The memory of the array is
-- uninitialized.
--
-- Note that this is internal routine, the reference to this array cannot be
-- given out until the array has been written to and frozen.
{-# INLINE newArray #-}
newArray :: forall a. Storable a => Int -> IO (Array a)
newArray :: forall a. Storable a => Int -> IO (Array a)
newArray = forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAligned (forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: a))

-- | Allocate an Array of the given size and run an IO action passing the array
-- start pointer.
{-# INLINE withNewArray #-}
withNewArray :: forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Array a)
withNewArray :: forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Array a)
withNewArray Int
count Ptr a -> IO ()
f = do
    Array a
arr <- forall a. Storable a => Int -> IO (Array a)
newArray Int
count
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (forall a. Array a -> ForeignPtr a
aStart Array a
arr) forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> Ptr a -> IO ()
f Ptr a
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Array a
arr

-- XXX grow the array when we are beyond bound.
--
-- Internal routine for when the array is being created. Appends one item at
-- the end of the array. Useful when sequentially writing a stream to the
-- array.
{-# INLINE unsafeSnoc #-}
unsafeSnoc :: forall a. Storable a => Array a -> a -> IO (Array a)
unsafeSnoc :: forall a. Storable a => Array a -> a -> IO (Array a)
unsafeSnoc arr :: Array a
arr@Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} a
x = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr a
aEnd forall a. Eq a => a -> a -> Bool
== Ptr a
aBound) forall a b. (a -> b) -> a -> b
$
        forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: unsafeSnoc: writing beyond array bounds"
    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
aEnd a
x
    forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array a
arr {aEnd :: Ptr a
aEnd = Ptr a
aEnd forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)}

{-# INLINE snoc #-}
snoc :: forall a. Storable a => Array a -> a -> IO (Array a)
snoc :: forall a. Storable a => Array a -> a -> IO (Array a)
snoc arr :: Array a
arr@Array {Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} a
x =
    if Ptr a
aEnd forall a. Eq a => a -> a -> Bool
== Ptr a
aBound
    then do
        let oldStart :: Ptr a
oldStart = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
            size :: Int
size = Ptr a
aEnd forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
oldStart
            newSize :: Int
newSize = Int
size forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)
        ForeignPtr a
newPtr <- forall a. Int -> Int -> IO (ForeignPtr a)
Malloc.mallocForeignPtrAlignedBytes
                    Int
newSize (forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: a))
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
newPtr forall a b. (a -> b) -> a -> b
$ \Ptr a
pNew -> do
          Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (forall a b. Ptr a -> Ptr b
castPtr Ptr a
pNew) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
oldStart) Int
size
          forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a
pNew forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size) a
x
          forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array
              { aStart :: ForeignPtr a
aStart = ForeignPtr a
newPtr
              , aEnd :: Ptr a
aEnd   = Ptr a
pNew forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
size forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))
              , aBound :: Ptr a
aBound = Ptr a
pNew forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
newSize
              }
    else do
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
aEnd a
x
        forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array a
arr {aEnd :: Ptr a
aEnd = Ptr a
aEnd forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)}

-- | Reallocate the array to the specified size in bytes. If the size is less
-- than the original array the array gets truncated.
{-# NOINLINE reallocAligned #-}
reallocAligned :: Int -> Int -> Array a -> IO (Array a)
reallocAligned :: forall a. Int -> Int -> Array a -> IO (Array a)
reallocAligned Int
alignSize Int
newSize Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} = do
    forall a. HasCallStack => Bool -> a -> a
assert (Ptr a
aEnd forall a. Ord a => a -> a -> Bool
<= Ptr a
aBound) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
    let oldStart :: Ptr a
oldStart = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
    let size :: Int
size = Ptr a
aEnd forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
oldStart
    ForeignPtr a
newPtr <- forall a. Int -> Int -> IO (ForeignPtr a)
Malloc.mallocForeignPtrAlignedBytes Int
newSize Int
alignSize
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
newPtr forall a b. (a -> b) -> a -> b
$ \Ptr a
pNew -> do
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (forall a b. Ptr a -> Ptr b
castPtr Ptr a
pNew) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
oldStart) Int
size
        forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array
            { aStart :: ForeignPtr a
aStart = ForeignPtr a
newPtr
            , aEnd :: Ptr a
aEnd   = Ptr a
pNew forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
size
            , aBound :: Ptr a
aBound = Ptr a
pNew forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
newSize
            }

-- XXX can unaligned allocation be more efficient when alignment is not needed?
{-# INLINABLE realloc #-}
realloc :: forall a. Storable a => Int -> Array a -> IO (Array a)
realloc :: forall a. Storable a => Int -> Array a -> IO (Array a)
realloc = forall a. Int -> Int -> Array a -> IO (Array a)
reallocAligned (forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: a))

-- | Remove the free space from an Array.
shrinkToFit :: forall a. Storable a => Array a -> IO (Array a)
shrinkToFit :: forall a. Storable a => Array a -> IO (Array a)
shrinkToFit arr :: Array a
arr@Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} = do
    forall a. HasCallStack => Bool -> a -> a
assert (Ptr a
aEnd forall a. Ord a => a -> a -> Bool
<= Ptr a
aBound) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
    let start :: Ptr a
start = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
    let used :: Int
used = Ptr a
aEnd forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
start
        waste :: Int
waste = Ptr a
aBound forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
aEnd
    -- if used == waste == 0 then do not realloc
    -- if the wastage is more than 25% of the array then realloc
    if Int
used forall a. Ord a => a -> a -> Bool
< Int
3 forall a. Num a => a -> a -> a
* Int
waste
    then forall a. Storable a => Int -> Array a -> IO (Array a)
realloc Int
used Array a
arr
    else forall (m :: * -> *) a. Monad m => a -> m a
return Array a
arr

-- XXX when converting an array of Word8 from a literal string we can simply
-- refer to the literal string. Is it possible to write rules such that
-- fromList Word8 can be rewritten so that GHC does not first convert the
-- literal to [Char] and then we convert it back to an Array Word8?
--
-- Note that the address must be a read-only address (meant to be used for
-- read-only string literals) because we are sharing it, any modification to
-- the original address would change our array. That's why this function is
-- unsafe.
{-# INLINE _fromCStringAddrUnsafe #-}
_fromCStringAddrUnsafe :: Addr# -> IO (Array Word8)
_fromCStringAddrUnsafe :: Addr# -> IO (Array Word8)
_fromCStringAddrUnsafe Addr#
addr# = do
    ForeignPtr Word8
ptr <- forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ (forall a b. Ptr a -> Ptr b
castPtr CString
cstr)
    CSize
len <- CString -> IO CSize
c_strlen CString
cstr
    let n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len
    let p :: Ptr Word8
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
ptr
    let end :: Ptr Word8
end = Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array
        { aStart :: ForeignPtr Word8
aStart = ForeignPtr Word8
ptr
        , aEnd :: Ptr Word8
aEnd   = Ptr Word8
end
        , aBound :: Ptr Word8
aBound = Ptr Word8
end
        }
  where
    cstr :: CString
    cstr :: CString
cstr = forall a. Addr# -> Ptr a
Ptr Addr#
addr#

-------------------------------------------------------------------------------
-- Elimination
-------------------------------------------------------------------------------

-- | Return element at the specified index without checking the bounds.
--
-- Unsafe because it does not check the bounds of the array.
{-# INLINE_NORMAL unsafeIndexIO #-}
unsafeIndexIO :: forall a. Storable a => Array a -> Int -> IO a
unsafeIndexIO :: forall a. Storable a => Array a -> Int -> IO a
unsafeIndexIO Array {Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} Int
i =
     forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
aStart forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
        let elemSize :: Int
elemSize = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)
            elemOff :: Ptr a
elemOff = Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
elemSize forall a. Num a => a -> a -> a
* Int
i)
        forall a. HasCallStack => Bool -> a -> a
assert (Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Ptr a
elemOff forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
elemSize forall a. Ord a => a -> a -> Bool
<= Ptr a
aEnd)
               (forall (m :: * -> *) a. Monad m => a -> m a
return ())
        forall a. Storable a => Ptr a -> IO a
peek Ptr a
elemOff

-- | Return element at the specified index without checking the bounds.
{-# INLINE_NORMAL unsafeIndex #-}
unsafeIndex :: forall a. Storable a => Array a -> Int -> a
unsafeIndex :: forall a. Storable a => Array a -> Int -> a
unsafeIndex Array a
arr Int
i = let !r :: a
r = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Array a -> Int -> IO a
unsafeIndexIO Array a
arr Int
i in a
r

-- | /O(1)/ Get the byte length of the array.
--
-- @since 0.7.0
{-# INLINE byteLength #-}
byteLength :: Array a -> Int
byteLength :: forall a. Array a -> Int
byteLength Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} =
    let p :: Ptr a
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
        len :: Int
len = Ptr a
aEnd forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
p
    in forall a. HasCallStack => Bool -> a -> a
assert (Int
len forall a. Ord a => a -> a -> Bool
>= Int
0) Int
len

-- | /O(1)/ Get the length of the array i.e. the number of elements in the
-- array.
--
-- @since 0.7.0
{-# INLINE length #-}
length :: forall a. Storable a => Array a -> Int
length :: forall a. Storable a => Array a -> Int
length Array a
arr = forall a. Array a -> Int
byteLength Array a
arr forall a. Integral a => a -> a -> a
`div` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)

{-# INLINE byteCapacity #-}
byteCapacity :: Array a -> Int
byteCapacity :: forall a. Array a -> Int
byteCapacity Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} =
    let p :: Ptr a
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
        len :: Int
len = Ptr a
aBound forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
p
    in forall a. HasCallStack => Bool -> a -> a
assert (Int
len forall a. Ord a => a -> a -> Bool
>= Int
0) Int
len

{-# INLINE_NORMAL toStreamD #-}
toStreamD :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a
toStreamD :: forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> Stream m a
toStreamD Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} =
    let p :: Ptr a
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
    in forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m a -> Ptr a -> m (Step (Ptr a) a)
step Ptr a
p

    where

    {-# INLINE_LATE step #-}
    step :: State Stream m a -> Ptr a -> m (Step (Ptr a) a)
step State Stream m a
_ Ptr a
p | Ptr a
p forall a. Eq a => a -> a -> Bool
== Ptr a
aEnd = forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop
    step State Stream m a
_ Ptr a
p = do
        -- 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.
        let !x :: a
x = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ do
                    a
r <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield a
x (Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))

{-# INLINE toStreamK #-}
toStreamK :: forall t m a. (K.IsStream t, Storable a) => Array a -> t m a
toStreamK :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Storable a) =>
Array a -> t m a
toStreamK Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} =
    let p :: Ptr a
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
    in Ptr a -> t m a
go Ptr a
p

    where

    go :: Ptr a -> t m a
go Ptr a
p | Ptr a
p forall a. Eq a => a -> a -> Bool
== Ptr a
aEnd = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a
K.nil
         | Bool
otherwise =
        -- See Note in toStreamD.
        let !x :: a
x = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ do
                    a
r <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        in a
x forall (t :: (* -> *) -> * -> *) a (m :: * -> *).
IsStream t =>
a -> t m a -> t m a
`K.cons` Ptr a -> t m a
go (Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))

{-# INLINE_NORMAL toStreamDRev #-}
toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a
toStreamDRev :: forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> Stream m a
toStreamDRev Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} =
    let p :: Ptr a
p = Ptr a
aEnd forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))
    in forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m a -> Ptr a -> m (Step (Ptr a) a)
step Ptr a
p

    where

    {-# INLINE_LATE step #-}
    step :: State Stream m a -> Ptr a -> m (Step (Ptr a) a)
step State Stream m a
_ Ptr a
p | Ptr a
p forall a. Ord a => a -> a -> Bool
< forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart = forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop
    step State Stream m a
_ Ptr a
p = do
        -- See comments in toStreamD for why we use unsafeInlineIO
        let !x :: a
x = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ do
                    a
r <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield a
x (Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)))

{-# INLINE toStreamKRev #-}
toStreamKRev :: forall t m a. (K.IsStream t, Storable a) => Array a -> t m a
toStreamKRev :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Storable a) =>
Array a -> t m a
toStreamKRev Array {Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} =
    let p :: Ptr a
p = Ptr a
aEnd forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))
    in Ptr a -> t m a
go Ptr a
p

    where

    go :: Ptr a -> t m a
go Ptr a
p | Ptr a
p forall a. Ord a => a -> a -> Bool
< forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a
K.nil
         | Bool
otherwise =
        let !x :: a
x = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ do
                    a
r <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        in a
x forall (t :: (* -> *) -> * -> *) a (m :: * -> *).
IsStream t =>
a -> t m a -> t m a
`K.cons` Ptr a -> t m a
go (Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)))

{-# INLINE_NORMAL foldl' #-}
foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b
foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f b
z Array a
arr = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> m b
D.foldl' b -> a -> b
f b
z forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> Stream m a
toStreamD Array a
arr

{-# INLINE_NORMAL foldr #-}
foldr :: Storable a => (a -> b -> b) -> b -> Array a -> b
foldr :: forall a b. Storable a => (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f b
z Array a
arr = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr a -> b -> b
f b
z forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> Stream m a
toStreamD Array a
arr

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

{-# INLINE_NORMAL writeNAllocWith #-}
writeNAllocWith :: forall m a. (MonadIO m, Storable a)
    => (Int -> IO (Array a)) -> Int -> Fold m a (Array a)
writeNAllocWith :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Int -> IO (Array a)) -> Int -> Fold m a (Array a)
writeNAllocWith Int -> IO (Array a)
alloc Int
n = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Array a -> a -> m (Array a)
step m (Array a)
initial forall {a}. a -> m a
extract

    where

    initial :: m (Array a)
initial = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO (Array a)
alloc (forall a. Ord a => a -> a -> a
max Int
n Int
0)
    step :: Array a -> a -> m (Array a)
step arr :: Array a
arr@(Array ForeignPtr a
_ Ptr a
end Ptr a
bound) a
_ | Ptr a
end forall a. Eq a => a -> a -> Bool
== Ptr a
bound = forall (m :: * -> *) a. Monad m => a -> m a
return Array a
arr
    step (Array ForeignPtr a
start Ptr a
end Ptr a
bound) a
x = do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
end a
x
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array ForeignPtr a
start (Ptr a
end forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)) Ptr a
bound
    -- XXX note that shirkToFit does not maintain alignment, in case we are
    -- using aligned allocation.
    extract :: a -> m a
extract = forall (m :: * -> *) a. Monad m => a -> m a
return -- liftIO . shrinkToFit

-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an
-- 'Array'.
--
-- @since 0.7.0
{-# INLINE_NORMAL writeN #-}
writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)
writeN :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m a (Array a)
writeN = forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Int -> IO (Array a)) -> Int -> Fold m a (Array a)
writeNAllocWith forall a. Storable a => Int -> IO (Array a)
newArray

-- | @writeNAligned alignment n@ folds a maximum of @n@ elements from the input
-- stream to an 'Array' aligned to the given size.
--
-- /Internal/
--
{-# INLINE_NORMAL writeNAligned #-}
writeNAligned :: forall m a. (MonadIO m, Storable a)
    => Int -> Int -> Fold m a (Array a)
writeNAligned :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Int -> Fold m a (Array a)
writeNAligned Int
alignSize = forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Int -> IO (Array a)) -> Int -> Fold m a (Array a)
writeNAllocWith (forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAligned Int
alignSize)

-- | @writeNAlignedUnmanaged n@ folds a maximum of @n@ elements from the input
-- stream to an 'Array' aligned to the given size and using unmanaged memory.
-- This could be useful to allocate memory that we need to allocate only once
-- in the lifetime of the program.
--
-- /Internal/
--
{-# INLINE_NORMAL writeNAlignedUnmanaged #-}
writeNAlignedUnmanaged :: forall m a. (MonadIO m, Storable a)
    => Int -> Int -> Fold m a (Array a)
writeNAlignedUnmanaged :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Int -> Fold m a (Array a)
writeNAlignedUnmanaged Int
alignSize =
    forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Int -> IO (Array a)) -> Int -> Fold m a (Array a)
writeNAllocWith (forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAlignedUnmanaged Int
alignSize)

data ArrayUnsafe a = ArrayUnsafe
    {-# UNPACK #-} !(ForeignPtr a) -- first address
    {-# UNPACK #-} !(Ptr a)        -- first unused address

-- | Like 'writeN' 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.
--
-- @since 0.7.0
{-# INLINE_NORMAL writeNUnsafe #-}
writeNUnsafe :: forall m a. (MonadIO m, Storable a)
    => Int -> Fold m a (Array a)
writeNUnsafe :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m a (Array a)
writeNUnsafe Int
n = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold ArrayUnsafe a -> a -> m (ArrayUnsafe a)
step m (ArrayUnsafe a)
initial forall {m :: * -> *} {a}. Monad m => ArrayUnsafe a -> m (Array a)
extract

    where

    initial :: m (ArrayUnsafe a)
initial = do
        (Array ForeignPtr a
start Ptr a
end Ptr a
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> IO (Array a)
newArray (forall a. Ord a => a -> a -> a
max Int
n Int
0)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Ptr a -> ArrayUnsafe a
ArrayUnsafe ForeignPtr a
start Ptr a
end
    step :: ArrayUnsafe a -> a -> m (ArrayUnsafe a)
step (ArrayUnsafe ForeignPtr a
start Ptr a
end) a
x = do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
end a
x
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Ptr a -> ArrayUnsafe a
ArrayUnsafe ForeignPtr a
start (Ptr a
end forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))
    extract :: ArrayUnsafe a -> m (Array a)
extract (ArrayUnsafe ForeignPtr a
start Ptr a
end) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array ForeignPtr a
start Ptr a
end Ptr a
end -- liftIO . shrinkToFit

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

{-# INLINE_NORMAL toArrayMinChunk #-}
toArrayMinChunk :: forall m a. (MonadIO m, Storable a)
    => Int -> Int -> Fold m a (Array a)
-- toArrayMinChunk n = FL.mapM spliceArrays $ toArraysOf n
toArrayMinChunk :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Int -> Fold m a (Array a)
toArrayMinChunk Int
alignSize Int
elemCount = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Array a -> a -> m (Array a)
step m (Array a)
initial Array a -> m (Array a)
extract

    where

    insertElem :: Array a -> a -> m (Array a)
insertElem (Array ForeignPtr a
start Ptr a
end Ptr a
bound) a
x = do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
end a
x
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array ForeignPtr a
start (Ptr a
end forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)) Ptr a
bound

    initial :: m (Array a)
initial = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
elemCount forall a. Ord a => a -> a -> Bool
< Int
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"toArrayMinChunk: elemCount is negative"
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAligned Int
alignSize Int
elemCount
    step :: Array a -> a -> m (Array a)
step arr :: Array a
arr@(Array ForeignPtr a
start Ptr a
end Ptr a
bound) a
x | Ptr a
end forall a. Eq a => a -> a -> Bool
== Ptr a
bound = do
        let p :: Ptr a
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
start
            oldSize :: Int
oldSize = Ptr a
end forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
p
            newSize :: Int
newSize = forall a. Ord a => a -> a -> a
max (Int
oldSize forall a. Num a => a -> a -> a
* Int
2) Int
1
        Array a
arr1 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Int -> Int -> Array a -> IO (Array a)
reallocAligned Int
alignSize Int
newSize Array a
arr
        Array a -> a -> m (Array a)
insertElem Array a
arr1 a
x
    step Array a
arr a
x = Array a -> a -> m (Array a)
insertElem Array a
arr a
x
    extract :: Array a -> m (Array a)
extract = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Array a -> IO (Array a)
shrinkToFit

-- | Fold the whole input to a single array.
--
-- /Caution! Do not use this on infinite streams./
--
-- @since 0.7.0
{-# INLINE write #-}
write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)
write :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Fold m a (Array a)
write = forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Int -> Fold m a (Array a)
toArrayMinChunk (forall a. Storable a => a -> Int
alignment (forall a. HasCallStack => a
undefined :: a))
                        (forall a. Storable a => a -> Int -> Int
bytesToElemCount (forall a. HasCallStack => a
undefined :: a)
                        (Int -> Int
mkChunkSize Int
1024))

-- | Like 'write' but the array memory is aligned according to the specified
-- alignment size. This could be useful when we have specific alignment, for
-- example, cache aligned arrays for lookup table etc.
--
-- /Caution! Do not use this on infinite streams./
--
-- @since 0.7.0
{-# INLINE writeAligned #-}
writeAligned :: forall m a. (MonadIO m, Storable a)
    => Int -> Fold m a (Array a)
writeAligned :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m a (Array a)
writeAligned Int
alignSize =
    forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Int -> Fold m a (Array a)
toArrayMinChunk Int
alignSize
                    (forall a. Storable a => a -> Int -> Int
bytesToElemCount (forall a. HasCallStack => a
undefined :: a)
                    (Int -> Int
mkChunkSize Int
1024))

{-# INLINE_NORMAL fromStreamDN #-}
fromStreamDN :: forall m a. (MonadIO m, Storable a)
    => Int -> D.Stream m a -> m (Array a)
fromStreamDN :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
limit Stream m a
str = do
    Array a
arr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> IO (Array a)
newArray Int
limit
    Ptr a
end <- forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> b -> Stream m a -> m b
D.foldlM' Ptr a -> a -> m (Ptr a)
fwrite (forall a. Array a -> Ptr a
aEnd Array a
arr) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Int -> Stream m a -> Stream m a
D.take Int
limit Stream m a
str
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array a
arr {aEnd :: Ptr a
aEnd = Ptr a
end}

    where

    fwrite :: Ptr a -> a -> m (Ptr a)
fwrite Ptr a
ptr a
x = do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)

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

-- | @fromStreamArraysOf n stream@ groups the input stream into a stream of
-- arrays of size n.
{-# INLINE_NORMAL fromStreamDArraysOf #-}
fromStreamDArraysOf :: forall m a. (MonadIO m, Storable a)
    => Int -> D.Stream m a -> D.Stream m (Array a)
-- fromStreamDArraysOf n str = D.groupsOf n (writeN n) str
fromStreamDArraysOf :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m a -> Stream m (Array a)
fromStreamDArraysOf Int
n (D.Stream State Stream m a -> s -> m (Step s a)
step s
state) =
    forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array a)
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
step' (forall s start end bound. s -> GroupState s start end bound
GroupStart s
state)

    where

    {-# INLINE_LATE step' #-}
    step' :: State Stream m (Array a)
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
step' State Stream m (Array a)
_ (GroupStart s
st) = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Ord a => a -> a -> Bool
<= Int
0) forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Internal.Memory.Array.Types.fromStreamDArraysOf: the size of "
                 forall a. [a] -> [a] -> [a]
++ [Char]
"arrays [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
        Array ForeignPtr a
start Ptr a
end Ptr a
bound <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> IO (Array a)
newArray Int
n
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (forall s start end bound.
s -> start -> end -> bound -> GroupState s start end bound
GroupBuffer s
st ForeignPtr a
start Ptr a
end Ptr a
bound)

    step' State Stream m (Array a)
gst (GroupBuffer s
st ForeignPtr a
start Ptr a
end Ptr a
bound) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m (Array a)
gst) s
st
        case Step s a
r of
            D.Yield a
x s
s -> do
                forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
end a
x
                let end' :: Ptr a
end' = Ptr a
end forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                    if Ptr a
end' forall a. Ord a => a -> a -> Bool
>= Ptr a
bound
                    then forall s a. s -> Step s a
D.Skip (forall s start end bound.
start
-> end
-> bound
-> GroupState s start end bound
-> GroupState s start end bound
GroupYield ForeignPtr a
start Ptr a
end' Ptr a
bound (forall s start end bound. s -> GroupState s start end bound
GroupStart s
s))
                    else forall s a. s -> Step s a
D.Skip (forall s start end bound.
s -> start -> end -> bound -> GroupState s start end bound
GroupBuffer s
s ForeignPtr a
start Ptr a
end' Ptr a
bound)
            D.Skip s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (forall s start end bound.
s -> start -> end -> bound -> GroupState s start end bound
GroupBuffer s
s ForeignPtr a
start Ptr a
end Ptr a
bound)
            Step s a
D.Stop -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (forall s start end bound.
start
-> end
-> bound
-> GroupState s start end bound
-> GroupState s start end bound
GroupYield ForeignPtr a
start Ptr a
end Ptr a
bound forall s start end bound. GroupState s start end bound
GroupFinish)

    step' State Stream m (Array a)
_ (GroupYield ForeignPtr a
start Ptr a
end Ptr a
bound GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
next) =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield (forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array ForeignPtr a
start Ptr a
end Ptr a
bound) GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
next

    step' State Stream m (Array a)
_ GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
GroupFinish = forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop

-- XXX concatMap does not seem to have the best possible performance so we have
-- a custom way to concat arrays.
data FlattenState s a =
      OuterLoop s
    | InnerLoop s !(ForeignPtr a) !(Ptr a) !(Ptr a)

{-# INLINE_NORMAL flattenArrays #-}
flattenArrays :: forall m a. (MonadIO m, Storable a)
    => D.Stream m (Array a) -> D.Stream m a
flattenArrays :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Stream m (Array a) -> Stream m a
flattenArrays (D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m a
-> FlattenState s a -> m (Step (FlattenState s a) a)
step' (forall s a. s -> FlattenState s a
OuterLoop s
state)

    where

    {-# INLINE_LATE step' #-}
    step' :: State Stream m a
-> FlattenState s a -> m (Step (FlattenState s a) a)
step' State Stream m a
gst (OuterLoop s
st) = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s (Array a)
r of
            D.Yield Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} s
s ->
                let p :: Ptr a
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
                in forall s a. s -> Step s a
D.Skip (forall s a. s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
s ForeignPtr a
aStart Ptr a
p Ptr a
aEnd)
            D.Skip s
s -> forall s a. s -> Step s a
D.Skip (forall s a. s -> FlattenState s a
OuterLoop s
s)
            Step s (Array a)
D.Stop -> forall s a. Step s a
D.Stop

    step' State Stream m a
_ (InnerLoop s
st ForeignPtr a
_ Ptr a
p Ptr a
end) | Ptr a
p forall a. Eq a => a -> a -> Bool
== Ptr a
end =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip forall a b. (a -> b) -> a -> b
$ forall s a. s -> FlattenState s a
OuterLoop s
st

    step' State Stream m a
_ (InnerLoop s
st ForeignPtr a
startf Ptr a
p Ptr a
end) = do
        a
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                    a
r <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
startf
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield a
x (forall s a. s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
st ForeignPtr a
startf
                            (Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)) Ptr a
end)

{-# INLINE_NORMAL flattenArraysRev #-}
flattenArraysRev :: forall m a. (MonadIO m, Storable a)
    => D.Stream m (Array a) -> D.Stream m a
flattenArraysRev :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Stream m (Array a) -> Stream m a
flattenArraysRev (D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m a
-> FlattenState s a -> m (Step (FlattenState s a) a)
step' (forall s a. s -> FlattenState s a
OuterLoop s
state)

    where

    {-# INLINE_LATE step' #-}
    step' :: State Stream m a
-> FlattenState s a -> m (Step (FlattenState s a) a)
step' State Stream m a
gst (OuterLoop s
st) = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s (Array a)
r of
            D.Yield Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} s
s ->
                let p :: Ptr a
p = Ptr a
aEnd forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))
                -- XXX we do not need aEnd
                in forall s a. s -> Step s a
D.Skip (forall s a. s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
s ForeignPtr a
aStart Ptr a
p Ptr a
aEnd)
            D.Skip s
s -> forall s a. s -> Step s a
D.Skip (forall s a. s -> FlattenState s a
OuterLoop s
s)
            Step s (Array a)
D.Stop -> forall s a. Step s a
D.Stop

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

    step' State Stream m a
_ (InnerLoop s
st ForeignPtr a
startf Ptr a
p Ptr a
end) = do
        a
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                    a
r <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
startf
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield a
x (forall s a. s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
st ForeignPtr a
startf
                            (Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Num a => a -> a
negate (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a))) Ptr a
end)

-- 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.
--
-- 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.
--
{-# INLINE fromStreamD #-}
fromStreamD :: (MonadIO m, Storable a) => D.Stream m a -> m (Array a)
fromStreamD :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Stream m a -> m (Array a)
fromStreamD Stream m a
m = do
    let s :: Stream m (Array a)
s = forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m a -> Stream m (Array a)
fromStreamDArraysOf Int
defaultChunkSize Stream m a
m
    Stream m (Array a)
buffered <- forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr forall (t :: (* -> *) -> * -> *) a (m :: * -> *).
IsStream t =>
a -> t m a -> t m a
K.cons forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a
K.nil Stream m (Array a)
s
    Int
len <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) b a.
(IsStream t, Monad m) =>
(b -> a -> b) -> b -> t m a -> m b
K.foldl' forall a. Num a => a -> a -> a
(+) Int
0 (forall (t :: (* -> *) -> * -> *) a b (m :: * -> *).
IsStream t =>
(a -> b) -> t m a -> t m b
K.map forall a. Storable a => Array a -> Int
length Stream m (Array a)
buffered)
    forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
len forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Stream m (Array a) -> Stream m a
flattenArrays forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => Stream m a -> Stream m a
D.fromStreamK Stream m (Array a)
buffered
{-
fromStreamD m = runFold write m
    where
    runFold (Fold step begin done) = D.foldlMx' step begin done
-}

-- 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. Storable a => (a -> b -> b) -> b -> Array a -> b
toListFB :: forall a b. Storable a => (a -> b -> b) -> b -> Array a -> b
toListFB a -> b -> b
c b
n Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} = Ptr a -> b
go (forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart)
    where

    go :: Ptr a -> b
go Ptr a
p | Ptr a
p forall a. Eq a => a -> a -> Bool
== Ptr a
aEnd = b
n
    go Ptr a
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.
        let !x :: a
x = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ do
                    a
r <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        in a -> b -> b
c a
x (Ptr a -> b
go (Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)))

-- | Convert an 'Array' into a list.
--
-- @since 0.7.0
{-# INLINE toList #-}
toList :: Storable a => Array a -> [a]
toList :: forall a. Storable a => Array a -> [a]
toList Array a
s = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
c b
n -> forall a b. Storable a => (a -> b -> b) -> b -> Array a -> b
toListFB a -> b -> b
c b
n Array a
s)

instance (Show a, Storable a) => Show (Array a) where
    {-# INLINE showsPrec #-}
    showsPrec :: Int -> Array a -> ShowS
showsPrec Int
_ = forall a. Show a => a -> ShowS
shows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Array a -> [a]
toList

-- | Create an 'Array' 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.
--
-- @since 0.7.0
{-# INLINABLE fromListN #-}
fromListN :: Storable a => Int -> [a] -> Array a
fromListN :: forall a. Storable a => Int -> [a] -> Array a
fromListN Int
n [a]
xs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
n forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs

-- | Create an 'Array' from a list. The list must be of finite size.
--
-- @since 0.7.0
{-# INLINABLE fromList #-}
fromList :: Storable a => [a] -> Array a
fromList :: forall a. Storable a => [a] -> Array a
fromList [a]
xs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Stream m a -> m (Array a)
fromStreamD forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [a]
xs

instance (Storable a, Read a, Show a) => Read (Array a) where
    {-# INLINE readPrec #-}
    readPrec :: ReadPrec (Array a)
readPrec = forall a. Storable a => [a] -> Array a
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec
    readListPrec :: ReadPrec [Array a]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance (a ~ Char) => IsString (Array a) where
    {-# INLINE fromString #-}
    fromString :: [Char] -> Array a
fromString = forall a. Storable a => [a] -> Array a
fromList

-- GHC versions 8.0 and below cannot derive IsList
instance Storable a => IsList (Array a) where
    type (Item (Array a)) = a
    {-# INLINE fromList #-}
    fromList :: [Item (Array a)] -> Array a
fromList = forall a. Storable a => [a] -> Array a
fromList
    {-# INLINE fromListN #-}
    fromListN :: Int -> [Item (Array a)] -> Array a
fromListN = forall a. Storable a => Int -> [a] -> Array a
fromListN
    {-# INLINE toList #-}
    toList :: Array a -> [Item (Array a)]
toList = forall a. Storable a => Array a -> [a]
toList

{-# INLINE arrcmp #-}
arrcmp :: Array a -> Array a -> Bool
arrcmp :: forall a. Array a -> Array a -> Bool
arrcmp Array a
arr1 Array a
arr2 =
    let !res :: Bool
res = forall a. IO a -> a
unsafeInlineIO forall a b. (a -> b) -> a -> b
$ do
            let ptr1 :: Ptr a
ptr1 = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr forall a b. (a -> b) -> a -> b
$ forall a. Array a -> ForeignPtr a
aStart Array a
arr1
            let ptr2 :: Ptr a
ptr2 = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr forall a b. (a -> b) -> a -> b
$ forall a. Array a -> ForeignPtr a
aStart Array a
arr2
            let len1 :: Int
len1 = forall a. Array a -> Ptr a
aEnd Array a
arr1 forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
ptr1
            let len2 :: Int
len2 = forall a. Array a -> Ptr a
aEnd Array a
arr2 forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
ptr2

            if Int
len1 forall a. Eq a => a -> a -> Bool
== Int
len2
            then do
                Bool
r <- Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
memcmp (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr1) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr2) Int
len1
                forall a. ForeignPtr a -> IO ()
touchForeignPtr forall a b. (a -> b) -> a -> b
$ forall a. Array a -> ForeignPtr a
aStart Array a
arr1
                forall a. ForeignPtr a -> IO ()
touchForeignPtr forall a b. (a -> b) -> a -> b
$ forall a. Array a -> ForeignPtr a
aStart Array a
arr2
                forall (m :: * -> *) a. Monad m => a -> m a
return Bool
r
            else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    in Bool
res

-- XXX we are assuming that Storable equality means element equality. This may
-- or may not be correct? arrcmp is 40% faster compared to stream equality.
instance (Storable a, Eq a) => Eq (Array a) where
    {-# INLINE (==) #-}
    == :: Array a -> Array a -> Bool
(==) = forall a. Array a -> Array a -> Bool
arrcmp
    -- arr1 == arr2 = runIdentity $ D.eqBy (==) (toStreamD arr1) (toStreamD arr2)

instance (Storable a, NFData a) => NFData (Array a) where
    {-# INLINE rnf #-}
    rnf :: Array a -> ()
rnf = forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b
foldl' (\()
_ a
x -> forall a. NFData a => a -> ()
rnf a
x) ()

instance (Storable a, Ord a) => Ord (Array a) where
    {-# INLINE compare #-}
    compare :: Array a -> Array a -> Ordering
compare Array a
arr1 Array a
arr2 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a b.
Monad m =>
(a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering
D.cmpBy forall a. Ord a => a -> a -> Ordering
compare (forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> Stream m a
toStreamD Array a
arr1) (forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> Stream m a
toStreamD Array a
arr2)

    -- Default definitions defined in base do not have an INLINE on them, so we
    -- replicate them here with an INLINE.
    {-# INLINE (<) #-}
    Array a
x < :: Array a -> Array a -> Bool
<  Array a
y = case forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
LT -> Bool
True;  Ordering
_ -> Bool
False }

    {-# INLINE (<=) #-}
    Array a
x <= :: Array a -> Array a -> Bool
<= Array a
y = case forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
GT -> Bool
False; Ordering
_ -> Bool
True }

    {-# INLINE (>) #-}
    Array a
x > :: Array a -> Array a -> Bool
>  Array a
y = case forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
GT -> Bool
True;  Ordering
_ -> Bool
False }

    {-# INLINE (>=) #-}
    Array a
x >= :: Array a -> Array a -> Bool
>= Array a
y = case forall a. Ord a => a -> a -> Ordering
compare Array a
x Array a
y of { Ordering
LT -> Bool
False; Ordering
_ -> Bool
True }

    -- These two default methods use '<=' rather than 'compare'
    -- because the latter is often more expensive
    {-# INLINE max #-}
    max :: Array a -> Array a -> Array a
max Array a
x Array a
y = if Array a
x forall a. Ord a => a -> a -> Bool
<= Array a
y then Array a
y else Array a
x

    {-# INLINE min #-}
    min :: Array a -> Array a -> Array a
min Array a
x Array a
y = if Array a
x forall a. Ord a => a -> a -> Bool
<= Array a
y then Array a
x else Array a
y

#ifdef DEVBUILD
-- Definitions using the Storable constraint from the Array type. These are to
-- make the Foldable instance possible though it is much slower (7x slower).
--
{-# INLINE_NORMAL toStreamD_ #-}
toStreamD_ :: forall m a. MonadIO m => Int -> Array a -> D.Stream m a
toStreamD_ size Array{..} =
    let p = unsafeForeignPtrToPtr aStart
    in D.Stream step p

    where

    {-# INLINE_LATE step #-}
    step _ p | p == aEnd = return D.Stop
    step _ p = do
        x <- liftIO $ do
                    r <- peek p
                    touchForeignPtr aStart
                    return r
        return $ D.Yield x (p `plusPtr` size)

{-# INLINE_NORMAL _foldr #-}
_foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b
_foldr f z arr@Array {..} =
    let !n = sizeOf (undefined :: a)
    in unsafePerformIO $ D.foldr f z $ toStreamD_ n arr

-- | Note that the 'Foldable' instance is 7x slower than the direct
-- operations.
instance Foldable Array where
  foldr = _foldr
#endif

-------------------------------------------------------------------------------
-- Semigroup and Monoid
-------------------------------------------------------------------------------

-- Splice two immutable arrays creating a new array.
{-# INLINE spliceTwo #-}
spliceTwo :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a)
spliceTwo :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
spliceTwo Array a
arr1 Array a
arr2 = do
    let src1 :: Ptr a
src1 = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (forall a. Array a -> ForeignPtr a
aStart Array a
arr1)
        src2 :: Ptr a
src2 = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (forall a. Array a -> ForeignPtr a
aStart Array a
arr2)
        len1 :: Int
len1 = forall a. Array a -> Ptr a
aEnd Array a
arr1 forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
src1
        len2 :: Int
len2 = forall a. Array a -> Ptr a
aEnd Array a
arr2 forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
src2

    Array a
arr <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> IO (Array a)
newArray (Int
len1 forall a. Num a => a -> a -> a
+ Int
len2)
    let dst :: Ptr a
dst = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (forall a. Array a -> ForeignPtr a
aStart Array a
arr)

    -- XXX Should we use copyMutableByteArray# instead? Is there an overhead to
    -- ccall?
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (forall a b. Ptr a -> Ptr b
castPtr Ptr a
dst) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
src1) Int
len1
        forall a. ForeignPtr a -> IO ()
touchForeignPtr (forall a. Array a -> ForeignPtr a
aStart Array a
arr1)
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (forall a b. Ptr a -> Ptr b
castPtr (Ptr a
dst forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len1)) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
src2) Int
len2
        forall a. ForeignPtr a -> IO ()
touchForeignPtr (forall a. Array a -> ForeignPtr a
aStart Array a
arr2)
    forall (m :: * -> *) a. Monad m => a -> m a
return Array a
arr { aEnd :: Ptr a
aEnd = Ptr a
dst forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
len1 forall a. Num a => a -> a -> a
+ Int
len2) }

instance Storable a => Semigroup (Array a) where
    Array a
arr1 <> :: Array a -> Array a -> Array a
<> Array a
arr2 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
spliceTwo Array a
arr1 Array a
arr2

nullForeignPtr :: ForeignPtr a
nullForeignPtr :: forall a. ForeignPtr a
nullForeignPtr = forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
nullAddr# (forall a. HasCallStack => [Char] -> a
error [Char]
"nullForeignPtr")

nil ::
#ifdef DEVBUILD
    Storable a =>
#endif
    Array a
nil :: forall a. Array a
nil = forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array forall a. ForeignPtr a
nullForeignPtr (forall a. Addr# -> Ptr a
Ptr Addr#
nullAddr#) (forall a. Addr# -> Ptr a
Ptr Addr#
nullAddr#)

instance Storable a => Monoid (Array a) where
    mempty :: Array a
mempty = forall a. Array a
nil
    mappend :: Array a -> Array a -> Array a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-------------------------------------------------------------------------------
-- IO
-------------------------------------------------------------------------------

-- | GHC memory management allocation header overhead
allocOverhead :: Int
allocOverhead :: Int
allocOverhead = Int
2 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: Int)

mkChunkSize :: Int -> Int
mkChunkSize :: Int -> Int
mkChunkSize Int
n = let size :: Int
size = Int
n forall a. Num a => a -> a -> a
- Int
allocOverhead in forall a. Ord a => a -> a -> a
max Int
size Int
0

mkChunkSizeKB :: Int -> Int
mkChunkSizeKB :: Int -> Int
mkChunkSizeKB Int
n = Int -> Int
mkChunkSize (Int
n forall a. Num a => a -> a -> a
* Int
k)
   where k :: Int
k = Int
1024

-- | Default maximum buffer size in bytes, for reading from and writing to IO
-- devices, the value is 32KB minus GHC allocation overhead, which is a few
-- bytes, so that the actual allocation is 32KB.
defaultChunkSize :: Int
defaultChunkSize :: Int
defaultChunkSize = Int -> Int
mkChunkSizeKB Int
32

{-# INLINE_NORMAL unlines #-}
unlines :: forall m a. (MonadIO m, Storable a)
    => a -> D.Stream m (Array a) -> D.Stream m a
unlines :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
a -> Stream m (Array a) -> Stream m a
unlines a
sep (D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m a
-> FlattenState s a -> m (Step (FlattenState s a) a)
step' (forall s a. s -> FlattenState s a
OuterLoop s
state)
    where
    {-# INLINE_LATE step' #-}
    step' :: State Stream m a
-> FlattenState s a -> m (Step (FlattenState s a) a)
step' State Stream m a
gst (OuterLoop s
st) = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s (Array a)
r of
            D.Yield Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} s
s ->
                let p :: Ptr a
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
                in forall s a. s -> Step s a
D.Skip (forall s a. s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
s ForeignPtr a
aStart Ptr a
p Ptr a
aEnd)
            D.Skip s
s -> forall s a. s -> Step s a
D.Skip (forall s a. s -> FlattenState s a
OuterLoop s
s)
            Step s (Array a)
D.Stop -> forall s a. Step s a
D.Stop

    step' State Stream m a
_ (InnerLoop s
st ForeignPtr a
_ Ptr a
p Ptr a
end) | Ptr a
p forall a. Eq a => a -> a -> Bool
== Ptr a
end =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield a
sep forall a b. (a -> b) -> a -> b
$ forall s a. s -> FlattenState s a
OuterLoop s
st

    step' State Stream m a
_ (InnerLoop s
st ForeignPtr a
startf Ptr a
p Ptr a
end) = do
        a
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                    a
r <- forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
startf
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield a
x (forall s a. s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
st ForeignPtr a
startf
                            (Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)) Ptr a
end)

-- Splice an array into a pre-reserved mutable array.  The user must ensure
-- that there is enough space in the mutable array.
{-# INLINE spliceWith #-}
spliceWith :: (MonadIO m) => Array a -> Array a -> m (Array a)
spliceWith :: forall (m :: * -> *) a.
MonadIO m =>
Array a -> Array a -> m (Array a)
spliceWith dst :: Array a
dst@(Array ForeignPtr a
_ Ptr a
end Ptr a
bound) Array a
src  = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    let srcLen :: Int
srcLen = forall a. Array a -> Int
byteLength Array a
src
    if Ptr a
end forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
srcLen forall a. Ord a => a -> a -> Bool
> Ptr a
bound
    then forall a. HasCallStack => [Char] -> a
error [Char]
"Bug: spliceIntoUnsafe: Not enough space in the target array"
    else
        forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (forall a. Array a -> ForeignPtr a
aStart Array a
dst) forall a b. (a -> b) -> a -> b
$ \Ptr a
_ ->
            forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (forall a. Array a -> ForeignPtr a
aStart Array a
src) forall a b. (a -> b) -> a -> b
$ \Ptr a
psrc -> do
                let pdst :: Ptr a
pdst = forall a. Array a -> Ptr a
aEnd Array a
dst
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (forall a b. Ptr a -> Ptr b
castPtr Ptr a
pdst) (forall a b. Ptr a -> Ptr b
castPtr Ptr a
psrc) Int
srcLen
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array a
dst { aEnd :: Ptr a
aEnd = Ptr a
pdst forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
srcLen }

-- Splice a new array into a preallocated mutable array, doubling the space if
-- there is no space in the target array.
{-# INLINE spliceWithDoubling #-}
spliceWithDoubling :: (MonadIO m, Storable a)
    => Array a -> Array a -> m (Array a)
spliceWithDoubling :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
spliceWithDoubling dst :: Array a
dst@(Array ForeignPtr a
start Ptr a
end Ptr a
bound) Array a
src  = do
    forall a. HasCallStack => Bool -> a -> a
assert (Ptr a
end forall a. Ord a => a -> a -> Bool
<= Ptr a
bound) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
    let srcLen :: Int
srcLen = forall a. Array a -> Ptr a
aEnd Array a
src forall a b. Ptr a -> Ptr b -> Int
`minusPtr` forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (forall a. Array a -> ForeignPtr a
aStart Array a
src)

    Array a
dst1 <-
        if Ptr a
end forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
srcLen forall a. Ord a => a -> a -> Bool
>= Ptr a
bound
        then do
            let oldStart :: Ptr a
oldStart = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
start
                oldSize :: Int
oldSize = Ptr a
end forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
oldStart
                newSize :: Int
newSize = forall a. Ord a => a -> a -> a
max (Int
oldSize forall a. Num a => a -> a -> a
* Int
2) (Int
oldSize forall a. Num a => a -> a -> a
+ Int
srcLen)
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Array a -> IO (Array a)
realloc Int
newSize Array a
dst
        else forall (m :: * -> *) a. Monad m => a -> m a
return Array a
dst
    forall (m :: * -> *) a.
MonadIO m =>
Array a -> Array a -> m (Array a)
spliceWith Array a
dst1 Array a
src

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

-- XXX can use general grouping combinators to achieve this?
-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a
-- maximum specified size. Note that if a single array is bigger than the
-- specified size we do not split it to fit. When we coalesce multiple arrays
-- if the size would exceed the specified size we do not coalesce therefore the
-- actual array size may be less than the specified chunk size.
--
-- @since 0.7.0
{-# INLINE_NORMAL packArraysChunksOf #-}
packArraysChunksOf :: (MonadIO m, Storable a)
    => Int -> D.Stream m (Array a) -> D.Stream m (Array a)
packArraysChunksOf :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m (Array a) -> Stream m (Array a)
packArraysChunksOf Int
n (D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) =
    forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array a)
-> SpliceState s (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
step' (forall s arr. s -> SpliceState s arr
SpliceInitial s
state)

    where

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

    step' State Stream m (Array a)
gst (SpliceBuffering s
st Array a
buf) = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step State Stream m (Array a)
gst s
st
        case Step s (Array a)
r of
            D.Yield Array a
arr s
s -> do
                let len :: Int
len = forall a. Array a -> Int
byteLength Array a
buf forall a. Num a => a -> a -> a
+ forall a. Array a -> Int
byteLength Array a
arr
                if Int
len forall a. Ord a => a -> a -> Bool
> Int
n
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                    forall s a. s -> Step s a
D.Skip (forall s arr. arr -> SpliceState s arr -> SpliceState s arr
SpliceYielding Array a
buf (forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s Array a
arr))
                else do
                    Array a
buf' <- if forall a. Array a -> Int
byteCapacity Array a
buf forall a. Ord a => a -> a -> Bool
< Int
n
                            then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Array a -> IO (Array a)
realloc Int
n Array a
buf
                            else forall (m :: * -> *) a. Monad m => a -> m a
return Array a
buf
                    Array a
buf'' <- forall (m :: * -> *) a.
MonadIO m =>
Array a -> Array a -> m (Array a)
spliceWith Array a
buf' Array a
arr
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s Array a
buf'')
            D.Skip s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s Array a
buf)
            Step s (Array a)
D.Stop -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (forall s arr. arr -> SpliceState s arr -> SpliceState s arr
SpliceYielding Array a
buf forall s arr. SpliceState s arr
SpliceFinish)

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

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

-- XXX instead of writing two different versions of this operation, we should
-- write it as a pipe.
{-# INLINE_NORMAL lpackArraysChunksOf #-}
lpackArraysChunksOf :: (MonadIO m, Storable a)
    => Int -> Fold m (Array a) () -> Fold m (Array a) ()
lpackArraysChunksOf :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m (Array a) () -> Fold m (Array a) ()
lpackArraysChunksOf Int
n (Fold s -> Array a -> m s
step1 m s
initial1 s -> m ()
extract1) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple' (Maybe (Array a)) s
-> Array a -> m (Tuple' (Maybe (Array a)) s)
step m (Tuple' (Maybe (Array a)) s)
initial Tuple' (Maybe (Array a)) s -> m ()
extract

    where

    initial :: m (Tuple' (Maybe (Array a)) s)
initial = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Ord a => a -> a -> Bool
<= Int
0) forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Internal.Memory.Array.Types.packArraysChunksOf: the size of "
                 forall a. [a] -> [a] -> [a]
++ [Char]
"arrays [" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
        s
r1 <- m s
initial1
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' forall a. Maybe a
Nothing s
r1)

    extract :: Tuple' (Maybe (Array a)) s -> m ()
extract (Tuple' Maybe (Array a)
Nothing s
r1) = s -> m ()
extract1 s
r1
    extract (Tuple' (Just Array a
buf) s
r1) = do
        s
r <- s -> Array a -> m s
step1 s
r1 Array a
buf
        s -> m ()
extract1 s
r

    step :: Tuple' (Maybe (Array a)) s
-> Array a -> m (Tuple' (Maybe (Array a)) s)
step (Tuple' Maybe (Array a)
Nothing s
r1) Array a
arr =
            let len :: Int
len = forall a. Array a -> Int
byteLength Array a
arr
             in if Int
len forall a. Ord a => a -> a -> Bool
>= Int
n
                then do
                    s
r <- s -> Array a -> m s
step1 s
r1 Array a
arr
                    s -> m ()
extract1 s
r
                    s
r1' <- m s
initial1
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' forall a. Maybe a
Nothing s
r1')
                else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' (forall a. a -> Maybe a
Just Array a
arr) s
r1)

    step (Tuple' (Just Array a
buf) s
r1) Array a
arr = do
            let len :: Int
len = forall a. Array a -> Int
byteLength Array a
buf forall a. Num a => a -> a -> a
+ forall a. Array a -> Int
byteLength Array a
arr
            Array a
buf' <- if forall a. Array a -> Int
byteCapacity Array a
buf forall a. Ord a => a -> a -> Bool
< Int
len
                    then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Array a -> IO (Array a)
realloc (forall a. Ord a => a -> a -> a
max Int
n Int
len) Array a
buf
                    else forall (m :: * -> *) a. Monad m => a -> m a
return Array a
buf
            Array a
buf'' <- forall (m :: * -> *) a.
MonadIO m =>
Array a -> Array a -> m (Array a)
spliceWith Array a
buf' Array a
arr

            if Int
len forall a. Ord a => a -> a -> Bool
>= Int
n
            then do
                s
r <- s -> Array a -> m s
step1 s
r1 Array a
buf''
                s -> m ()
extract1 s
r
                s
r1' <- m s
initial1
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' forall a. Maybe a
Nothing s
r1')
            else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' (forall a. a -> Maybe a
Just Array a
buf'') s
r1)

#if __GLASGOW_HASKELL__ < 900
#if !defined(mingw32_HOST_OS)
data GatherState s arr
    = GatherInitial s
    | GatherBuffering s arr Int
    | GatherYielding arr (GatherState s arr)
    | GatherFinish

-- | @groupIOVecsOf maxBytes maxEntries@ groups arrays in the incoming stream
-- to create a stream of 'IOVec' arrays with a maximum of @maxBytes@ bytes in
-- each array and a maximum of @maxEntries@ entries in each array.
--
-- @since 0.7.0
{-# INLINE_NORMAL groupIOVecsOf #-}
groupIOVecsOf :: MonadIO m
    => Int -> Int -> D.Stream m (Array a) -> D.Stream m (Array IOVec)
groupIOVecsOf n maxIOVLen (D.Stream step state) =
    D.Stream step' (GatherInitial state)

    where

    {-# INLINE_LATE step' #-}
    step' gst (GatherInitial st) = do
        when (n <= 0) $
            -- XXX we can pass the module string from the higher level API
            error $ "Streamly.Internal.Memory.Array.Types.groupIOVecsOf: the size of "
                 ++ "groups [" ++ show n ++ "] must be a natural number"
        when (maxIOVLen <= 0) $
            -- XXX we can pass the module string from the higher level API
            error $ "Streamly.Internal.Memory.Array.Types.groupIOVecsOf: the number of "
                 ++ "IOVec entries [" ++ show n ++ "] must be a natural number"
        r <- step (adaptState gst) st
        case r of
            D.Yield arr s -> do
                let p = unsafeForeignPtrToPtr (aStart arr)
                    len = byteLength arr
                iov <- liftIO $ newArray maxIOVLen
                iov' <- liftIO $ unsafeSnoc iov (IOVec (castPtr p)
                                                (fromIntegral len))
                if len >= n
                then return $ D.Skip (GatherYielding iov' (GatherInitial s))
                else return $ D.Skip (GatherBuffering s iov' len)
            D.Skip s -> return $ D.Skip (GatherInitial s)
            D.Stop -> return D.Stop

    step' gst (GatherBuffering st iov len) = do
        r <- step (adaptState gst) st
        case r of
            D.Yield arr s -> do
                let p = unsafeForeignPtrToPtr (aStart arr)
                    alen = byteLength arr
                    len' = len + alen
                if len' > n || length iov >= maxIOVLen
                then do
                    iov' <- liftIO $ newArray maxIOVLen
                    iov'' <- liftIO $ unsafeSnoc iov' (IOVec (castPtr p)
                                                      (fromIntegral alen))
                    return $ D.Skip (GatherYielding iov
                                        (GatherBuffering s iov'' alen))
                else do
                    iov' <- liftIO $ unsafeSnoc iov (IOVec (castPtr p)
                                                    (fromIntegral alen))
                    return $ D.Skip (GatherBuffering s iov' len')
            D.Skip s -> return $ D.Skip (GatherBuffering s iov len)
            D.Stop -> return $ D.Skip (GatherYielding iov GatherFinish)

    step' _ GatherFinish = return D.Stop

    step' _ (GatherYielding iov next) = return $ D.Yield iov next
#endif
#endif

-- | Create two slices of an array without copying the original array. The
-- specified index @i@ is the first index of the second slice.
--
-- @since 0.7.0
splitAt :: forall a. Storable a => Int -> Array a -> (Array a, Array a)
splitAt :: forall a. Storable a => Int -> Array a -> (Array a, Array a)
splitAt Int
i arr :: Array a
arr@Array{Ptr a
ForeignPtr a
aBound :: Ptr a
aEnd :: Ptr a
aStart :: ForeignPtr a
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} =
    let maxIndex :: Int
maxIndex = forall a. Storable a => Array a -> Int
length Array a
arr forall a. Num a => a -> a -> a
- Int
1
    in  if Int
i forall a. Ord a => a -> a -> Bool
< Int
0
        then forall a. HasCallStack => [Char] -> a
error [Char]
"sliceAt: negative array index"
        else if Int
i forall a. Ord a => a -> a -> Bool
> Int
maxIndex
             then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"sliceAt: specified array index " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i
                        forall a. [a] -> [a] -> [a]
++ [Char]
" is beyond the maximum index " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
maxIndex
             else let off :: Int
off = Int
i forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)
                      p :: Ptr a
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
                in ( Array
                  { aStart :: ForeignPtr a
aStart = ForeignPtr a
aStart
                  , aEnd :: Ptr a
aEnd = Ptr a
p
                  , aBound :: Ptr a
aBound = Ptr a
p
                  }
                , Array
                  { aStart :: ForeignPtr a
aStart = ForeignPtr a
aStart forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
off
                  , aEnd :: Ptr a
aEnd = Ptr a
aEnd
                  , aBound :: Ptr a
aBound = Ptr a
aBound
                  }
                )

-- Drops the separator byte
{-# INLINE breakOn #-}
breakOn :: MonadIO m
    => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
breakOn :: forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
breakOn Word8
sep arr :: Array Word8
arr@Array{Ptr Word8
ForeignPtr Word8
aBound :: Ptr Word8
aEnd :: Ptr Word8
aStart :: ForeignPtr Word8
aBound :: forall a. Array a -> Ptr a
aEnd :: forall a. Array a -> Ptr a
aStart :: forall a. Array a -> ForeignPtr a
..} = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    let p :: Ptr Word8
p = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
aStart
    Ptr Word8
loc <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
c_memchr Ptr Word8
p Word8
sep (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Ptr Word8
aEnd forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        if Ptr Word8
loc forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
        then (Array Word8
arr, forall a. Maybe a
Nothing)
        else
            ( Array
                { aStart :: ForeignPtr Word8
aStart = ForeignPtr Word8
aStart
                , aEnd :: Ptr Word8
aEnd = Ptr Word8
loc
                , aBound :: Ptr Word8
aBound = Ptr Word8
loc
                }
            , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Array
                    { aStart :: ForeignPtr Word8
aStart = ForeignPtr Word8
aStart forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` (Ptr Word8
loc forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p forall a. Num a => a -> a -> a
+ Int
1)
                    , aEnd :: Ptr Word8
aEnd = Ptr Word8
aEnd
                    , aBound :: Ptr Word8
aBound = Ptr Word8
aBound
                    }
            )

data SplitState s arr
    = Initial s
    | Buffering s arr
    | Splitting s arr
    | Yielding arr (SplitState s arr)
    | Finishing

-- | Split a stream of arrays on a given separator byte, dropping the separator
-- and coalescing all the arrays between two separators into a single array.
--
-- @since 0.7.0
{-# INLINE_NORMAL splitOn #-}
splitOn
    :: MonadIO m
    => Word8
    -> D.Stream m (Array Word8)
    -> D.Stream m (Array Word8)
splitOn :: forall (m :: * -> *).
MonadIO m =>
Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)
splitOn Word8
byte (D.Stream State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step s
state) = forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array Word8)
-> SplitState s (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
step' (forall s arr. s -> SplitState s arr
Initial s
state)

    where

    {-# INLINE_LATE step' #-}
    step' :: State Stream m (Array Word8)
-> SplitState s (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
step' State Stream m (Array Word8)
gst (Initial s
st) = do
        Step s (Array Word8)
r <- State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step State Stream m (Array Word8)
gst s
st
        case Step s (Array Word8)
r of
            D.Yield Array Word8
arr s
s -> do
                (Array Word8
arr1, Maybe (Array Word8)
marr2) <- forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
breakOn Word8
byte Array Word8
arr
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (Array Word8)
marr2 of
                    Maybe (Array Word8)
Nothing   -> forall s a. s -> Step s a
D.Skip (forall s arr. s -> arr -> SplitState s arr
Buffering s
s Array Word8
arr1)
                    Just Array Word8
arr2 -> forall s a. s -> Step s a
D.Skip (forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
arr1 (forall s arr. s -> arr -> SplitState s arr
Splitting s
s Array Word8
arr2))
            D.Skip s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (forall s arr. s -> SplitState s arr
Initial s
s)
            Step s (Array Word8)
D.Stop -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop

    step' State Stream m (Array Word8)
gst (Buffering s
st Array Word8
buf) = do
        Step s (Array Word8)
r <- State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step State Stream m (Array Word8)
gst s
st
        case Step s (Array Word8)
r of
            D.Yield Array Word8
arr s
s -> do
                (Array Word8
arr1, Maybe (Array Word8)
marr2) <- forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
breakOn Word8
byte Array Word8
arr
                Array Word8
buf' <- forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
spliceTwo Array Word8
buf Array Word8
arr1
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (Array Word8)
marr2 of
                    Maybe (Array Word8)
Nothing -> forall s a. s -> Step s a
D.Skip (forall s arr. s -> arr -> SplitState s arr
Buffering s
s Array Word8
buf')
                    Just Array Word8
x -> forall s a. s -> Step s a
D.Skip (forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
buf' (forall s arr. s -> arr -> SplitState s arr
Splitting s
s Array Word8
x))
            D.Skip s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. s -> Step s a
D.Skip (forall s arr. s -> arr -> SplitState s arr
Buffering s
s Array Word8
buf)
            Step s (Array Word8)
D.Stop -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                if forall a. Array a -> Int
byteLength Array Word8
buf forall a. Eq a => a -> a -> Bool
== Int
0
                then forall s a. Step s a
D.Stop
                else forall s a. s -> Step s a
D.Skip (forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
buf forall s arr. SplitState s arr
Finishing)

    step' State Stream m (Array Word8)
_ (Splitting s
st Array Word8
buf) = do
        (Array Word8
arr1, Maybe (Array Word8)
marr2) <- forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
breakOn Word8
byte Array Word8
buf
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (Array Word8)
marr2 of
                Maybe (Array Word8)
Nothing -> forall s a. s -> Step s a
D.Skip forall a b. (a -> b) -> a -> b
$ forall s arr. s -> arr -> SplitState s arr
Buffering s
st Array Word8
arr1
                Just Array Word8
arr2 -> forall s a. s -> Step s a
D.Skip forall a b. (a -> b) -> a -> b
$ forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
arr1 (forall s arr. s -> arr -> SplitState s arr
Splitting s
st Array Word8
arr2)

    step' State Stream m (Array Word8)
_ (Yielding Array Word8
arr SplitState s (Array Word8)
next) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. a -> s -> Step s a
D.Yield Array Word8
arr SplitState s (Array Word8)
next
    step' State Stream m (Array Word8)
_ SplitState s (Array Word8)
Finishing = forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Step s a
D.Stop