{-# LANGUAGE CPP                       #-}
{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MagicHash                 #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE UnboxedTuples             #-}
{-# LANGUAGE FlexibleContexts          #-}
#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 !defined(mingw32_HOST_OS)
    , groupIOVecsOf
#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 !defined(mingw32_HOST_OS)
import Streamly.FileSystem.FDIO (IOVec(..))
#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
    { Array a -> ForeignPtr a
aStart :: {-# UNPACK #-} !(ForeignPtr a) -- first address
    , Array a -> Ptr a
aEnd   :: {-# UNPACK #-} !(Ptr a)        -- first unused address
    , 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 = IO (Ptr Word8) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
c_memcpy Ptr Word8
dst Ptr Word8
src (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))

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

{-# INLINE unsafeInlineIO #-}
unsafeInlineIO :: IO a -> a
unsafeInlineIO :: 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 :: a -> Int -> Int
bytesToElemCount a
x Int
n =
    let elemSize :: Int
elemSize = a -> Int
forall a. Storable a => a -> Int
sizeOf a
x
    in Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
elemSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
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 :: (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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
    ForeignPtr a
fptr <- Int -> Int -> IO (ForeignPtr a)
alloc Int
size Int
alignSize
    let p :: Ptr a
p = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
fptr
    Array a -> IO (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> IO (Array a)) -> Array a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ Array :: forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array
        { aStart :: ForeignPtr a
aStart = ForeignPtr a
fptr
        , aEnd :: Ptr a
aEnd   = Ptr a
p
        , aBound :: Ptr a
aBound = Ptr a
p Ptr a -> Int -> Ptr a
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 :: Int -> Int -> IO (Array a)
newArrayAlignedUnmanaged =
    (Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
forall a.
Storable a =>
(Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
newArrayAlignedAllocWith Int -> Int -> IO (ForeignPtr a)
forall a. Int -> Int -> IO (ForeignPtr a)
Malloc.mallocForeignPtrAlignedUnmanagedBytes

{-# INLINE newArrayAligned #-}
newArrayAligned :: forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAligned :: Int -> Int -> IO (Array a)
newArrayAligned = (Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
forall a.
Storable a =>
(Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
newArrayAlignedAllocWith Int -> Int -> IO (ForeignPtr a)
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 :: Int -> IO (Array a)
newArray = Int -> Int -> IO (Array a)
forall a. Storable a => Int -> Int -> IO (Array a)
newArrayAligned (a -> Int
forall a. Storable a => a -> Int
alignment (a
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 :: Int -> (Ptr a -> IO ()) -> IO (Array a)
withNewArray Int
count Ptr a -> IO ()
f = do
    Array a
arr <- Int -> IO (Array a)
forall a. Storable a => Int -> IO (Array a)
newArray Int
count
    ForeignPtr a -> (Ptr a -> IO (Array a)) -> IO (Array a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
arr) ((Ptr a -> IO (Array a)) -> IO (Array a))
-> (Ptr a -> IO (Array a)) -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> Ptr a -> IO ()
f Ptr a
p IO () -> IO (Array a) -> IO (Array a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array a -> IO (Array a)
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 :: 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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr a
aEnd Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
aBound) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: unsafeSnoc: writing beyond array bounds"
    Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
aEnd a
x
    ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
    Array a -> IO (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> IO (Array a)) -> Array a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ Array a
arr {aEnd :: Ptr a
aEnd = Ptr a
aEnd Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)}

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

-- | Remove the free space from an Array.
shrinkToFit :: forall a. Storable a => Array a -> IO (Array a)
shrinkToFit :: 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
    Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Ptr a
aEnd Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr a
aBound) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    let start :: Ptr a
start = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
    let used :: Int
used = Ptr a
aEnd Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
start
        waste :: Int
waste = Ptr a
aBound Ptr a -> Ptr a -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
waste
    then Int -> Array a -> IO (Array a)
forall a. Storable a => Int -> Array a -> IO (Array a)
realloc Int
used Array a
arr
    else Array a -> IO (Array a)
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 <- Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cstr)
    CSize
len <- Ptr CChar -> IO CSize
c_strlen Ptr CChar
cstr
    let n :: Int
n = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len
    let p :: Ptr Word8
p = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
ptr
    let end :: Ptr Word8
end = Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n
    Array Word8 -> IO (Array Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array Word8 -> IO (Array Word8))
-> Array Word8 -> IO (Array Word8)
forall a b. (a -> b) -> a -> b
$ Array :: forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
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 :: Ptr CChar
cstr = Addr# -> Ptr CChar
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 :: 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 =
     ForeignPtr a -> (Ptr a -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
aStart ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
        let elemSize :: Int
elemSize = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
            elemOff :: Ptr a
elemOff = Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
elemSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)
        Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Ptr a
elemOff Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
elemSize Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr a
aEnd)
               (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        Ptr a -> IO a
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 :: Array a -> Int -> a
unsafeIndex Array a
arr Int
i = let !r :: a
r = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Array a -> Int -> IO a
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 :: 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 = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
        len :: Int
len = Ptr a
aEnd Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
p
    in Bool -> Int -> Int
forall a. HasCallStack => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
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 :: Array a -> Int
length Array a
arr = Array a -> Int
forall a. Array a -> Int
byteLength Array a
arr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)

{-# INLINE byteCapacity #-}
byteCapacity :: Array a -> Int
byteCapacity :: 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 = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
        len :: Int
len = Ptr a
aBound Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
p
    in Bool -> Int -> Int
forall a. HasCallStack => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
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 :: 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 = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
    in (State Stream m a -> Ptr a -> m (Step (Ptr a) a))
-> Ptr a -> Stream m a
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 Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
aEnd = Step (Ptr a) a -> m (Step (Ptr a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Ptr a) a
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 = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
                    a
r <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
                    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        Step (Ptr a) a -> m (Step (Ptr a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Ptr a) a -> m (Step (Ptr a) a))
-> Step (Ptr a) a -> m (Step (Ptr a) a)
forall a b. (a -> b) -> a -> b
$ a -> Ptr a -> Step (Ptr a) a
forall s a. a -> s -> Step s a
D.Yield a
x (Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))

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

{-# INLINE_NORMAL toStreamDRev #-}
toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a
toStreamDRev :: 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 Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a. Num a => a -> a
negate (a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
    in (State Stream m a -> Ptr a -> m (Step (Ptr a) a))
-> Ptr a -> Stream m a
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 Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
< ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart = Step (Ptr a) a -> m (Step (Ptr a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Ptr a) a
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 = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
                    a
r <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
                    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        Step (Ptr a) a -> m (Step (Ptr a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Ptr a) a -> m (Step (Ptr a) a))
-> Step (Ptr a) a -> m (Step (Ptr a) a)
forall a b. (a -> b) -> a -> b
$ a -> Ptr a -> Step (Ptr a) a
forall s a. a -> s -> Step s a
D.Yield a
x (Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a. Num a => a -> a
negate (a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)))

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

{-# INLINE_NORMAL foldl' #-}
foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b
foldl' :: (b -> a -> b) -> b -> Array a -> b
foldl' b -> a -> b
f b
z Array a
arr = Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> Identity b -> b
forall a b. (a -> b) -> a -> b
$ (b -> a -> b) -> b -> Stream Identity a -> Identity b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Stream m a -> m b
D.foldl' b -> a -> b
f b
z (Stream Identity a -> Identity b)
-> Stream Identity a -> Identity b
forall a b. (a -> b) -> a -> b
$ Array a -> Stream Identity a
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 :: (a -> b -> b) -> b -> Array a -> b
foldr a -> b -> b
f b
z Array a
arr = Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> Identity b -> b
forall a b. (a -> b) -> a -> b
$ (a -> b -> b) -> b -> Stream Identity a -> Identity b
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr a -> b -> b
f b
z (Stream Identity a -> Identity b)
-> Stream Identity a -> Identity b
forall a b. (a -> b) -> a -> b
$ Array a -> Stream Identity a
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 :: (Int -> IO (Array a)) -> Int -> Fold m a (Array a)
writeNAllocWith Int -> IO (Array a)
alloc Int
n = (Array a -> a -> m (Array a))
-> m (Array a) -> (Array a -> m (Array a)) -> Fold m a (Array a)
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)
forall a. a -> m a
extract

    where

    initial :: m (Array a)
initial = IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array a)
alloc (Int -> Int -> Int
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 Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
bound = Array a -> m (Array a)
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
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
end a
x
        Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> m (Array a)) -> Array a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> Ptr a -> Ptr a -> Array a
forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array ForeignPtr a
start (Ptr a
end Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
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 = a -> m a
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 :: Int -> Fold m a (Array a)
writeN = (Int -> IO (Array a)) -> Int -> Fold m a (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Int -> IO (Array a)) -> Int -> Fold m a (Array a)
writeNAllocWith Int -> IO (Array a)
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 :: Int -> Int -> Fold m a (Array a)
writeNAligned Int
alignSize = (Int -> IO (Array a)) -> Int -> Fold m a (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Int -> IO (Array a)) -> Int -> Fold m a (Array a)
writeNAllocWith (Int -> Int -> IO (Array a)
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 :: Int -> Int -> Fold m a (Array a)
writeNAlignedUnmanaged Int
alignSize =
    (Int -> IO (Array a)) -> Int -> Fold m a (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
(Int -> IO (Array a)) -> Int -> Fold m a (Array a)
writeNAllocWith (Int -> Int -> IO (Array a)
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 :: Int -> Fold m a (Array a)
writeNUnsafe Int
n = (ArrayUnsafe a -> a -> m (ArrayUnsafe a))
-> m (ArrayUnsafe a)
-> (ArrayUnsafe a -> m (Array a))
-> Fold m a (Array a)
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 ArrayUnsafe a -> m (Array a)
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
_) <- IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array a)
forall a. Storable a => Int -> IO (Array a)
newArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0)
        ArrayUnsafe a -> m (ArrayUnsafe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayUnsafe a -> m (ArrayUnsafe a))
-> ArrayUnsafe a -> m (ArrayUnsafe a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> Ptr a -> ArrayUnsafe a
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
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
end a
x
        ArrayUnsafe a -> m (ArrayUnsafe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayUnsafe a -> m (ArrayUnsafe a))
-> ArrayUnsafe a -> m (ArrayUnsafe a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> Ptr a -> ArrayUnsafe a
forall a. ForeignPtr a -> Ptr a -> ArrayUnsafe a
ArrayUnsafe ForeignPtr a
start (Ptr a
end Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
    extract :: ArrayUnsafe a -> m (Array a)
extract (ArrayUnsafe ForeignPtr a
start Ptr a
end) = Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> m (Array a)) -> Array a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> Ptr a -> Ptr a -> Array a
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 :: Int -> Int -> Fold m a (Array a)
toArrayMinChunk Int
alignSize Int
elemCount = (Array a -> a -> m (Array a))
-> m (Array a) -> (Array a -> m (Array a)) -> Fold m a (Array a)
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
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
end a
x
        Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> m (Array a)) -> Array a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> Ptr a -> Ptr a -> Array a
forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array ForeignPtr a
start (Ptr a
end Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)) Ptr a
bound

    initial :: m (Array a)
initial = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
elemCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"toArrayMinChunk: elemCount is negative"
        IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> IO (Array a)
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 Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
bound = do
        let p :: Ptr a
p = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
start
            oldSize :: Int
oldSize = Ptr a
end Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
p
            newSize :: Int
newSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Int
1
        Array a
arr1 <- IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Array a -> IO (Array a)
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 = IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a))
-> (Array a -> IO (Array a)) -> Array a -> m (Array a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array a -> IO (Array a)
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 :: Fold m a (Array a)
write = Int -> Int -> Fold m a (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Int -> Fold m a (Array a)
toArrayMinChunk (a -> Int
forall a. Storable a => a -> Int
alignment (a
forall a. HasCallStack => a
undefined :: a))
                        (a -> Int -> Int
forall a. Storable a => a -> Int -> Int
bytesToElemCount (a
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 :: Int -> Fold m a (Array a)
writeAligned Int
alignSize =
    Int -> Int -> Fold m a (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Int -> Fold m a (Array a)
toArrayMinChunk Int
alignSize
                    (a -> Int -> Int
forall a. Storable a => a -> Int -> Int
bytesToElemCount (a
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 :: Int -> Stream m a -> m (Array a)
fromStreamDN Int
limit Stream m a
str = do
    Array a
arr <- IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array a)
forall a. Storable a => Int -> IO (Array a)
newArray Int
limit
    Ptr a
end <- (Ptr a -> a -> m (Ptr a)) -> Ptr a -> Stream m a -> m (Ptr a)
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 (Array a -> Ptr a
forall a. Array a -> Ptr a
aEnd Array a
arr) (Stream m a -> m (Ptr a)) -> Stream m a -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Int -> Stream m a -> Stream m a
forall (m :: * -> *) a. Monad m => Int -> Stream m a -> Stream m a
D.take Int
limit Stream m a
str
    Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> m (Array a)) -> Array a -> m (Array a)
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
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
        Ptr a -> m (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> m (Ptr a)) -> Ptr a -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ptr a
ptr Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
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 :: 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) =
    (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)))
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> Stream m (Array a)
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' (s -> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
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
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Internal.Memory.Array.Types.fromStreamDArraysOf: the size of "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"arrays [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
        Array ForeignPtr a
start Ptr a
end Ptr a
bound <- IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array a)
forall a. Storable a => Int -> IO (Array a)
newArray Int
n
        Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
 -> m (Step
         (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)))
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall a b. (a -> b) -> a -> b
$ GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
forall s a. s -> Step s a
D.Skip (s
-> ForeignPtr a
-> Ptr a
-> Ptr a
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
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 (State Stream m (Array a) -> State Stream m a
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
                IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
end a
x
                let end' :: Ptr a
end' = Ptr a
end Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
                Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
 -> m (Step
         (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)))
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall a b. (a -> b) -> a -> b
$
                    if Ptr a
end' Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr a
bound
                    then GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
forall s a. s -> Step s a
D.Skip (ForeignPtr a
-> Ptr a
-> Ptr a
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
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 (s -> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
forall s start end bound. s -> GroupState s start end bound
GroupStart s
s))
                    else GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
forall s a. s -> Step s a
D.Skip (s
-> ForeignPtr a
-> Ptr a
-> Ptr a
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
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 -> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
 -> m (Step
         (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)))
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall a b. (a -> b) -> a -> b
$ GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
forall s a. s -> Step s a
D.Skip (s
-> ForeignPtr a
-> Ptr a
-> Ptr a
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
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 -> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
 -> m (Step
         (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)))
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall a b. (a -> b) -> a -> b
$ GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
forall s a. s -> Step s a
D.Skip (ForeignPtr a
-> Ptr a
-> Ptr a
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
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 GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
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) =
        Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
 -> m (Step
         (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)))
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall a b. (a -> b) -> a -> b
$ Array a
-> GroupState s (ForeignPtr a) (Ptr a) (Ptr a)
-> Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
forall s a. a -> s -> Step s a
D.Yield (ForeignPtr a -> Ptr a -> Ptr a -> Array a
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 = Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
-> m (Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (GroupState s (ForeignPtr a) (Ptr a) (Ptr a)) (Array a)
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 :: Stream m (Array a) -> Stream m a
flattenArrays (D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) = (State Stream m a
 -> FlattenState s a -> m (Step (FlattenState s a) a))
-> FlattenState s a -> Stream m a
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' (s -> FlattenState s a
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 (State Stream m a -> State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
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 = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
                in FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
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 -> FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (s -> FlattenState s a
forall s a. s -> FlattenState s a
OuterLoop s
s)
            Step s (Array a)
D.Stop -> Step (FlattenState s a) a
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 Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
end =
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall a b. (a -> b) -> a -> b
$ FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (FlattenState s a -> Step (FlattenState s a) a)
-> FlattenState s a -> Step (FlattenState s a) a
forall a b. (a -> b) -> a -> b
$ s -> FlattenState s a
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 <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
                    a
r <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
startf
                    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall a b. (a -> b) -> a -> b
$ a -> FlattenState s a -> Step (FlattenState s a) a
forall s a. a -> s -> Step s a
D.Yield a
x (s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
forall s a. s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
st ForeignPtr a
startf
                            (Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
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 :: Stream m (Array a) -> Stream m a
flattenArraysRev (D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) = (State Stream m a
 -> FlattenState s a -> m (Step (FlattenState s a) a))
-> FlattenState s a -> Stream m a
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' (s -> FlattenState s a
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 (State Stream m a -> State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
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 Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a. Num a => a -> a
negate (a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))
                -- XXX we do not need aEnd
                in FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
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 -> FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (s -> FlattenState s a
forall s a. s -> FlattenState s a
OuterLoop s
s)
            Step s (Array a)
D.Stop -> Step (FlattenState s a) a
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 Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
< ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
start =
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall a b. (a -> b) -> a -> b
$ FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (FlattenState s a -> Step (FlattenState s a) a)
-> FlattenState s a -> Step (FlattenState s a) a
forall a b. (a -> b) -> a -> b
$ s -> FlattenState s a
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 <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
                    a
r <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
startf
                    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall a b. (a -> b) -> a -> b
$ a -> FlattenState s a -> Step (FlattenState s a) a
forall s a. a -> s -> Step s a
D.Yield a
x (s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
forall s a. s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
st ForeignPtr a
startf
                            (Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a. Num a => a -> a
negate (a -> Int
forall a. Storable a => a -> Int
sizeOf (a
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 :: Stream m a -> m (Array a)
fromStreamD Stream m a
m = do
    let s :: Stream m (Array a)
s = Int -> Stream m a -> Stream m (Array a)
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 <- (Array a -> Stream m (Array a) -> Stream m (Array a))
-> Stream m (Array a)
-> Stream m (Array a)
-> m (Stream m (Array a))
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Stream m a -> m b
D.foldr Array a -> Stream m (Array a) -> Stream m (Array a)
forall (t :: (* -> *) -> * -> *) a (m :: * -> *).
IsStream t =>
a -> t m a -> t m a
K.cons Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a
K.nil Stream m (Array a)
s
    Int
len <- (Int -> Int -> Int) -> Int -> Stream m Int -> m Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) b a.
(IsStream t, Monad m) =>
(b -> a -> b) -> b -> t m a -> m b
K.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ((Array a -> Int) -> Stream m (Array a) -> Stream m Int
forall (t :: (* -> *) -> * -> *) a b (m :: * -> *).
IsStream t =>
(a -> b) -> t m a -> t m b
K.map Array a -> Int
forall a. Storable a => Array a -> Int
length Stream m (Array a)
buffered)
    Int -> Stream m a -> m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
len (Stream m a -> m (Array a)) -> Stream m a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Stream m (Array a) -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Stream m (Array a) -> Stream m a
flattenArrays (Stream m (Array a) -> Stream m a)
-> Stream m (Array a) -> Stream m a
forall a b. (a -> b) -> a -> b
$ Stream m (Array a) -> Stream m (Array a)
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 :: (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 (ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart)
    where

    go :: Ptr a -> b
go Ptr a
p | Ptr a
p Ptr a -> Ptr a -> Bool
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 = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
                    a
r <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
aStart
                    a -> IO a
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 Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
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 :: Array a -> [a]
toList Array a
s = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\a -> b -> b
c b
n -> (a -> b -> b) -> b -> Array a -> b
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 -> [Char] -> [Char]
showsPrec Int
_ = [a] -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows ([a] -> [Char] -> [Char])
-> (Array a -> [a]) -> Array a -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array a -> [a]
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 :: Int -> [a] -> Array a
fromListN Int
n [a]
xs = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ Int -> Stream IO a -> IO (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m a -> m (Array a)
fromStreamDN Int
n (Stream IO a -> IO (Array a)) -> Stream IO a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream IO a
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 :: [a] -> Array a
fromList [a]
xs = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ Stream IO a -> IO (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Stream m a -> m (Array a)
fromStreamD (Stream IO a -> IO (Array a)) -> Stream IO a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ [a] -> Stream IO a
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 = [a] -> Array a
forall a. Storable a => [a] -> Array a
fromList ([a] -> Array a) -> ReadPrec [a] -> ReadPrec (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
    readListPrec :: ReadPrec [Array a]
readListPrec = ReadPrec [Array a]
forall a. Read a => ReadPrec [a]
readListPrecDefault

instance (a ~ Char) => IsString (Array a) where
    {-# INLINE fromString #-}
    fromString :: [Char] -> Array a
fromString = [Char] -> Array a
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 = [Item (Array a)] -> Array a
forall a. Storable a => [a] -> Array a
fromList
    {-# INLINE fromListN #-}
    fromListN :: Int -> [Item (Array a)] -> Array a
fromListN = Int -> [Item (Array a)] -> Array a
forall a. Storable a => Int -> [a] -> Array a
fromListN
    {-# INLINE toList #-}
    toList :: Array a -> [Item (Array a)]
toList = Array a -> [Item (Array a)]
forall a. Storable a => Array a -> [a]
toList

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

            if Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len2
            then do
                Bool
r <- Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
memcmp (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr1) (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr2) Int
len1
                ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr (ForeignPtr a -> IO ()) -> ForeignPtr a -> IO ()
forall a b. (a -> b) -> a -> b
$ Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
arr1
                ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr (ForeignPtr a -> IO ()) -> ForeignPtr a -> IO ()
forall a b. (a -> b) -> a -> b
$ Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
arr2
                Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
r
            else Bool -> IO Bool
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
(==) = 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 = (() -> a -> ()) -> () -> Array a -> ()
forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b
foldl' (\()
_ a
x -> a -> ()
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 = IO Ordering -> Ordering
forall a. IO a -> a
unsafePerformIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
        (a -> a -> Ordering) -> Stream IO a -> Stream IO a -> IO Ordering
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering
D.cmpBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Array a -> Stream IO a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> Stream m a
toStreamD Array a
arr1) (Array a -> Stream IO a
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 Array a -> Array a -> Ordering
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 Array a -> Array a -> Ordering
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 Array a -> Array a -> Ordering
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 Array a -> Array a -> Ordering
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 Array a -> Array a -> Bool
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 Array a -> Array a -> Bool
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 :: Array a -> Array a -> m (Array a)
spliceTwo Array a
arr1 Array a
arr2 = do
    let src1 :: Ptr a
src1 = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
arr1)
        src2 :: Ptr a
src2 = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
arr2)
        len1 :: Int
len1 = Array a -> Ptr a
forall a. Array a -> Ptr a
aEnd Array a
arr1 Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
src1
        len2 :: Int
len2 = Array a -> Ptr a
forall a. Array a -> Ptr a
aEnd Array a
arr2 Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
src2

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

    -- XXX Should we use copyMutableByteArray# instead? Is there an overhead to
    -- ccall?
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
dst) (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
src1) Int
len1
        ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
arr1)
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr (Ptr a
dst Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len1)) (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
src2) Int
len2
        ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
arr2)
    Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return Array a
arr { aEnd :: Ptr a
aEnd = Ptr a
dst Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
len1 Int -> Int -> Int
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 = IO (Array a) -> Array a
forall a. IO a -> a
unsafePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ Array a -> Array a -> IO (Array a)
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 :: ForeignPtr a
nullForeignPtr = Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
nullAddr# ([Char] -> ForeignPtrContents
forall a. HasCallStack => [Char] -> a
error [Char]
"nullForeignPtr")

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

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

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

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

mkChunkSize :: Int -> Int
mkChunkSize :: Int -> Int
mkChunkSize Int
n = let size :: Int
size = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
allocOverhead in Int -> Int -> Int
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 Int -> Int -> Int
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 :: 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) = (State Stream m a
 -> FlattenState s a -> m (Step (FlattenState s a) a))
-> FlattenState s a -> Stream m a
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' (s -> FlattenState s a
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 (State Stream m a -> State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
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 = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart
                in FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
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 -> FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (s -> FlattenState s a
forall s a. s -> FlattenState s a
OuterLoop s
s)
            Step s (Array a)
D.Stop -> Step (FlattenState s a) a
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 Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
end =
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall a b. (a -> b) -> a -> b
$ a -> FlattenState s a -> Step (FlattenState s a) a
forall s a. a -> s -> Step s a
D.Yield a
sep (FlattenState s a -> Step (FlattenState s a) a)
-> FlattenState s a -> Step (FlattenState s a) a
forall a b. (a -> b) -> a -> b
$ s -> FlattenState s a
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 <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
                    a
r <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
startf
                    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall a b. (a -> b) -> a -> b
$ a -> FlattenState s a -> Step (FlattenState s a) a
forall s a. a -> s -> Step s a
D.Yield a
x (s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
forall s a. s -> ForeignPtr a -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
st ForeignPtr a
startf
                            (Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
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 :: Array a -> Array a -> m (Array a)
spliceWith dst :: Array a
dst@(Array ForeignPtr a
_ Ptr a
end Ptr a
bound) Array a
src  = IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ do
    let srcLen :: Int
srcLen = Array a -> Int
forall a. Array a -> Int
byteLength Array a
src
    if Ptr a
end Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
srcLen Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
> Ptr a
bound
    then [Char] -> IO (Array a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Bug: spliceIntoUnsafe: Not enough space in the target array"
    else
        ForeignPtr a -> (Ptr a -> IO (Array a)) -> IO (Array a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
dst) ((Ptr a -> IO (Array a)) -> IO (Array a))
-> (Ptr a -> IO (Array a)) -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
_ ->
            ForeignPtr a -> (Ptr a -> IO (Array a)) -> IO (Array a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
src) ((Ptr a -> IO (Array a)) -> IO (Array a))
-> (Ptr a -> IO (Array a)) -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
psrc -> do
                let pdst :: Ptr a
pdst = Array a -> Ptr a
forall a. Array a -> Ptr a
aEnd Array a
dst
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
pdst) (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
psrc) Int
srcLen
                Array a -> IO (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> IO (Array a)) -> Array a -> IO (Array a)
forall a b. (a -> b) -> a -> b
$ Array a
dst { aEnd :: Ptr a
aEnd = Ptr a
pdst Ptr a -> Int -> Ptr a
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 :: 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
    Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Ptr a
end Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr a
bound) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    let srcLen :: Int
srcLen = Array a -> Ptr a
forall a. Array a -> Ptr a
aEnd Array a
src Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
src)

    Array a
dst1 <-
        if Ptr a
end Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
srcLen Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr a
bound
        then do
            let oldStart :: Ptr a
oldStart = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
start
                oldSize :: Int
oldSize = Ptr a
end Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
oldStart
                newSize :: Int
newSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (Int
oldSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcLen)
            IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Array a -> IO (Array a)
forall a. Storable a => Int -> Array a -> IO (Array a)
realloc Int
newSize Array a
dst
        else Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return Array a
dst
    Array a -> Array a -> m (Array a)
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 :: 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) =
    (State Stream m (Array a)
 -> SpliceState s (Array a)
 -> m (Step (SpliceState s (Array a)) (Array a)))
-> SpliceState s (Array a) -> Stream m (Array a)
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' (s -> SpliceState s (Array a)
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
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Internal.Memory.Array.Types.packArraysChunksOf: the size of "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"arrays [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
        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 -> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (Array a)) (Array a)
 -> m (Step (SpliceState s (Array a)) (Array a)))
-> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall a b. (a -> b) -> a -> b
$
                let len :: Int
len = Array a -> Int
forall a. Array a -> Int
byteLength Array a
arr
                 in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
                    then SpliceState s (Array a) -> Step (SpliceState s (Array a)) (Array a)
forall s a. s -> Step s a
D.Skip (Array a -> SpliceState s (Array a) -> SpliceState s (Array a)
forall s arr. arr -> SpliceState s arr -> SpliceState s arr
SpliceYielding Array a
arr (s -> SpliceState s (Array a)
forall s arr. s -> SpliceState s arr
SpliceInitial s
s))
                    else SpliceState s (Array a) -> Step (SpliceState s (Array a)) (Array a)
forall s a. s -> Step s a
D.Skip (s -> Array a -> SpliceState s (Array a)
forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s Array a
arr)
            D.Skip s
s -> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (Array a)) (Array a)
 -> m (Step (SpliceState s (Array a)) (Array a)))
-> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall a b. (a -> b) -> a -> b
$ SpliceState s (Array a) -> Step (SpliceState s (Array a)) (Array a)
forall s a. s -> Step s a
D.Skip (s -> SpliceState s (Array a)
forall s arr. s -> SpliceState s arr
SpliceInitial s
s)
            Step s (Array a)
D.Stop -> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SpliceState s (Array a)) (Array a)
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 = Array a -> Int
forall a. Array a -> Int
byteLength Array a
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array a -> Int
forall a. Array a -> Int
byteLength Array a
arr
                if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n
                then Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (Array a)) (Array a)
 -> m (Step (SpliceState s (Array a)) (Array a)))
-> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall a b. (a -> b) -> a -> b
$
                    SpliceState s (Array a) -> Step (SpliceState s (Array a)) (Array a)
forall s a. s -> Step s a
D.Skip (Array a -> SpliceState s (Array a) -> SpliceState s (Array a)
forall s arr. arr -> SpliceState s arr -> SpliceState s arr
SpliceYielding Array a
buf (s -> Array a -> SpliceState s (Array a)
forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s Array a
arr))
                else do
                    Array a
buf' <- if Array a -> Int
forall a. Array a -> Int
byteCapacity Array a
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
                            then IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Array a -> IO (Array a)
forall a. Storable a => Int -> Array a -> IO (Array a)
realloc Int
n Array a
buf
                            else Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return Array a
buf
                    Array a
buf'' <- Array a -> Array a -> m (Array a)
forall (m :: * -> *) a.
MonadIO m =>
Array a -> Array a -> m (Array a)
spliceWith Array a
buf' Array a
arr
                    Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (Array a)) (Array a)
 -> m (Step (SpliceState s (Array a)) (Array a)))
-> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall a b. (a -> b) -> a -> b
$ SpliceState s (Array a) -> Step (SpliceState s (Array a)) (Array a)
forall s a. s -> Step s a
D.Skip (s -> Array a -> SpliceState s (Array a)
forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s Array a
buf'')
            D.Skip s
s -> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (Array a)) (Array a)
 -> m (Step (SpliceState s (Array a)) (Array a)))
-> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall a b. (a -> b) -> a -> b
$ SpliceState s (Array a) -> Step (SpliceState s (Array a)) (Array a)
forall s a. s -> Step s a
D.Skip (s -> Array a -> SpliceState s (Array a)
forall s arr. s -> arr -> SpliceState s arr
SpliceBuffering s
s Array a
buf)
            Step s (Array a)
D.Stop -> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (Array a)) (Array a)
 -> m (Step (SpliceState s (Array a)) (Array a)))
-> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall a b. (a -> b) -> a -> b
$ SpliceState s (Array a) -> Step (SpliceState s (Array a)) (Array a)
forall s a. s -> Step s a
D.Skip (Array a -> SpliceState s (Array a) -> SpliceState s (Array a)
forall s arr. arr -> SpliceState s arr -> SpliceState s arr
SpliceYielding Array a
buf SpliceState s (Array a)
forall s arr. SpliceState s arr
SpliceFinish)

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

    step' State Stream m (Array a)
_ (SpliceYielding Array a
arr SpliceState s (Array a)
next) = Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SpliceState s (Array a)) (Array a)
 -> m (Step (SpliceState s (Array a)) (Array a)))
-> Step (SpliceState s (Array a)) (Array a)
-> m (Step (SpliceState s (Array a)) (Array a))
forall a b. (a -> b) -> a -> b
$ Array a
-> SpliceState s (Array a)
-> Step (SpliceState s (Array a)) (Array a)
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 :: 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) =
    (Tuple' (Maybe (Array a)) s
 -> Array a -> m (Tuple' (Maybe (Array a)) s))
-> m (Tuple' (Maybe (Array a)) s)
-> (Tuple' (Maybe (Array a)) s -> m ())
-> Fold m (Array a) ()
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
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Internal.Memory.Array.Types.packArraysChunksOf: the size of "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"arrays [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
        s
r1 <- m s
initial1
        Tuple' (Maybe (Array a)) s -> m (Tuple' (Maybe (Array a)) s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Array a) -> s -> Tuple' (Maybe (Array a)) s
forall a b. a -> b -> Tuple' a b
Tuple' Maybe (Array a)
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 = Array a -> Int
forall a. Array a -> Int
byteLength Array a
arr
             in if Int
len Int -> Int -> Bool
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
                    Tuple' (Maybe (Array a)) s -> m (Tuple' (Maybe (Array a)) s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Array a) -> s -> Tuple' (Maybe (Array a)) s
forall a b. a -> b -> Tuple' a b
Tuple' Maybe (Array a)
forall a. Maybe a
Nothing s
r1')
                else Tuple' (Maybe (Array a)) s -> m (Tuple' (Maybe (Array a)) s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Array a) -> s -> Tuple' (Maybe (Array a)) s
forall a b. a -> b -> Tuple' a b
Tuple' (Array a -> Maybe (Array a)
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 = Array a -> Int
forall a. Array a -> Int
byteLength Array a
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array a -> Int
forall a. Array a -> Int
byteLength Array a
arr
            Array a
buf' <- if Array a -> Int
forall a. Array a -> Int
byteCapacity Array a
buf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
                    then IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Array a -> IO (Array a)
forall a. Storable a => Int -> Array a -> IO (Array a)
realloc (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
len) Array a
buf
                    else Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return Array a
buf
            Array a
buf'' <- Array a -> Array a -> m (Array a)
forall (m :: * -> *) a.
MonadIO m =>
Array a -> Array a -> m (Array a)
spliceWith Array a
buf' Array a
arr

            if Int
len Int -> Int -> Bool
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
                Tuple' (Maybe (Array a)) s -> m (Tuple' (Maybe (Array a)) s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Array a) -> s -> Tuple' (Maybe (Array a)) s
forall a b. a -> b -> Tuple' a b
Tuple' Maybe (Array a)
forall a. Maybe a
Nothing s
r1')
            else Tuple' (Maybe (Array a)) s -> m (Tuple' (Maybe (Array a)) s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Array a) -> s -> Tuple' (Maybe (Array a)) s
forall a b. a -> b -> Tuple' a b
Tuple' (Array a -> Maybe (Array a)
forall a. a -> Maybe a
Just Array a
buf'') s
r1)

#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 :: Int -> Int -> Stream m (Array a) -> Stream m (Array IOVec)
groupIOVecsOf Int
n Int
maxIOVLen (D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) =
    (State Stream m (Array IOVec)
 -> GatherState s (Array IOVec)
 -> m (Step (GatherState s (Array IOVec)) (Array IOVec)))
-> GatherState s (Array IOVec) -> Stream m (Array IOVec)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array IOVec)
-> GatherState s (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
step' (s -> GatherState s (Array IOVec)
forall s arr. s -> GatherState s arr
GatherInitial s
state)

    where

    {-# INLINE_LATE step' #-}
    step' :: State Stream m (Array IOVec)
-> GatherState s (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
step' State Stream m (Array IOVec)
gst (GatherInitial s
st) = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Internal.Memory.Array.Types.groupIOVecsOf: the size of "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"groups [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
maxIOVLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            -- XXX we can pass the module string from the higher level API
            [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Internal.Memory.Array.Types.groupIOVecsOf: the number of "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"IOVec entries [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] must be a natural number"
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step (State Stream m (Array IOVec) -> State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m (Array IOVec)
gst) s
st
        case Step s (Array a)
r of
            D.Yield Array a
arr s
s -> do
                let p :: Ptr a
p = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
arr)
                    len :: Int
len = Array a -> Int
forall a. Array a -> Int
byteLength Array a
arr
                Array IOVec
iov <- IO (Array IOVec) -> m (Array IOVec)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array IOVec) -> m (Array IOVec))
-> IO (Array IOVec) -> m (Array IOVec)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array IOVec)
forall a. Storable a => Int -> IO (Array a)
newArray Int
maxIOVLen
                Array IOVec
iov' <- IO (Array IOVec) -> m (Array IOVec)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array IOVec) -> m (Array IOVec))
-> IO (Array IOVec) -> m (Array IOVec)
forall a b. (a -> b) -> a -> b
$ Array IOVec -> IOVec -> IO (Array IOVec)
forall a. Storable a => Array a -> a -> IO (Array a)
unsafeSnoc Array IOVec
iov (Ptr Word8 -> Word64 -> IOVec
IOVec (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p)
                                                (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len))
                if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
                then Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GatherState s (Array IOVec)) (Array IOVec)
 -> m (Step (GatherState s (Array IOVec)) (Array IOVec)))
-> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall a b. (a -> b) -> a -> b
$ GatherState s (Array IOVec)
-> Step (GatherState s (Array IOVec)) (Array IOVec)
forall s a. s -> Step s a
D.Skip (Array IOVec
-> GatherState s (Array IOVec) -> GatherState s (Array IOVec)
forall s arr. arr -> GatherState s arr -> GatherState s arr
GatherYielding Array IOVec
iov' (s -> GatherState s (Array IOVec)
forall s arr. s -> GatherState s arr
GatherInitial s
s))
                else Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GatherState s (Array IOVec)) (Array IOVec)
 -> m (Step (GatherState s (Array IOVec)) (Array IOVec)))
-> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall a b. (a -> b) -> a -> b
$ GatherState s (Array IOVec)
-> Step (GatherState s (Array IOVec)) (Array IOVec)
forall s a. s -> Step s a
D.Skip (s -> Array IOVec -> Int -> GatherState s (Array IOVec)
forall s arr. s -> arr -> Int -> GatherState s arr
GatherBuffering s
s Array IOVec
iov' Int
len)
            D.Skip s
s -> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GatherState s (Array IOVec)) (Array IOVec)
 -> m (Step (GatherState s (Array IOVec)) (Array IOVec)))
-> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall a b. (a -> b) -> a -> b
$ GatherState s (Array IOVec)
-> Step (GatherState s (Array IOVec)) (Array IOVec)
forall s a. s -> Step s a
D.Skip (s -> GatherState s (Array IOVec)
forall s arr. s -> GatherState s arr
GatherInitial s
s)
            Step s (Array a)
D.Stop -> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (GatherState s (Array IOVec)) (Array IOVec)
forall s a. Step s a
D.Stop

    step' State Stream m (Array IOVec)
gst (GatherBuffering s
st Array IOVec
iov Int
len) = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step (State Stream m (Array IOVec) -> State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m (Array IOVec)
gst) s
st
        case Step s (Array a)
r of
            D.Yield Array a
arr s
s -> do
                let p :: Ptr a
p = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr (Array a -> ForeignPtr a
forall a. Array a -> ForeignPtr a
aStart Array a
arr)
                    alen :: Int
alen = Array a -> Int
forall a. Array a -> Int
byteLength Array a
arr
                    len' :: Int
len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alen
                if Int
len' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n Bool -> Bool -> Bool
|| Array IOVec -> Int
forall a. Storable a => Array a -> Int
length Array IOVec
iov Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxIOVLen
                then do
                    Array IOVec
iov' <- IO (Array IOVec) -> m (Array IOVec)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array IOVec) -> m (Array IOVec))
-> IO (Array IOVec) -> m (Array IOVec)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array IOVec)
forall a. Storable a => Int -> IO (Array a)
newArray Int
maxIOVLen
                    Array IOVec
iov'' <- IO (Array IOVec) -> m (Array IOVec)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array IOVec) -> m (Array IOVec))
-> IO (Array IOVec) -> m (Array IOVec)
forall a b. (a -> b) -> a -> b
$ Array IOVec -> IOVec -> IO (Array IOVec)
forall a. Storable a => Array a -> a -> IO (Array a)
unsafeSnoc Array IOVec
iov' (Ptr Word8 -> Word64 -> IOVec
IOVec (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p)
                                                      (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
alen))
                    Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GatherState s (Array IOVec)) (Array IOVec)
 -> m (Step (GatherState s (Array IOVec)) (Array IOVec)))
-> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall a b. (a -> b) -> a -> b
$ GatherState s (Array IOVec)
-> Step (GatherState s (Array IOVec)) (Array IOVec)
forall s a. s -> Step s a
D.Skip (Array IOVec
-> GatherState s (Array IOVec) -> GatherState s (Array IOVec)
forall s arr. arr -> GatherState s arr -> GatherState s arr
GatherYielding Array IOVec
iov
                                        (s -> Array IOVec -> Int -> GatherState s (Array IOVec)
forall s arr. s -> arr -> Int -> GatherState s arr
GatherBuffering s
s Array IOVec
iov'' Int
alen))
                else do
                    Array IOVec
iov' <- IO (Array IOVec) -> m (Array IOVec)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array IOVec) -> m (Array IOVec))
-> IO (Array IOVec) -> m (Array IOVec)
forall a b. (a -> b) -> a -> b
$ Array IOVec -> IOVec -> IO (Array IOVec)
forall a. Storable a => Array a -> a -> IO (Array a)
unsafeSnoc Array IOVec
iov (Ptr Word8 -> Word64 -> IOVec
IOVec (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p)
                                                    (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
alen))
                    Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GatherState s (Array IOVec)) (Array IOVec)
 -> m (Step (GatherState s (Array IOVec)) (Array IOVec)))
-> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall a b. (a -> b) -> a -> b
$ GatherState s (Array IOVec)
-> Step (GatherState s (Array IOVec)) (Array IOVec)
forall s a. s -> Step s a
D.Skip (s -> Array IOVec -> Int -> GatherState s (Array IOVec)
forall s arr. s -> arr -> Int -> GatherState s arr
GatherBuffering s
s Array IOVec
iov' Int
len')
            D.Skip s
s -> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GatherState s (Array IOVec)) (Array IOVec)
 -> m (Step (GatherState s (Array IOVec)) (Array IOVec)))
-> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall a b. (a -> b) -> a -> b
$ GatherState s (Array IOVec)
-> Step (GatherState s (Array IOVec)) (Array IOVec)
forall s a. s -> Step s a
D.Skip (s -> Array IOVec -> Int -> GatherState s (Array IOVec)
forall s arr. s -> arr -> Int -> GatherState s arr
GatherBuffering s
s Array IOVec
iov Int
len)
            Step s (Array a)
D.Stop -> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GatherState s (Array IOVec)) (Array IOVec)
 -> m (Step (GatherState s (Array IOVec)) (Array IOVec)))
-> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall a b. (a -> b) -> a -> b
$ GatherState s (Array IOVec)
-> Step (GatherState s (Array IOVec)) (Array IOVec)
forall s a. s -> Step s a
D.Skip (Array IOVec
-> GatherState s (Array IOVec) -> GatherState s (Array IOVec)
forall s arr. arr -> GatherState s arr -> GatherState s arr
GatherYielding Array IOVec
iov GatherState s (Array IOVec)
forall s arr. GatherState s arr
GatherFinish)

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

    step' State Stream m (Array IOVec)
_ (GatherYielding Array IOVec
iov GatherState s (Array IOVec)
next) = Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GatherState s (Array IOVec)) (Array IOVec)
 -> m (Step (GatherState s (Array IOVec)) (Array IOVec)))
-> Step (GatherState s (Array IOVec)) (Array IOVec)
-> m (Step (GatherState s (Array IOVec)) (Array IOVec))
forall a b. (a -> b) -> a -> b
$ Array IOVec
-> GatherState s (Array IOVec)
-> Step (GatherState s (Array IOVec)) (Array IOVec)
forall s a. a -> s -> Step s a
D.Yield Array IOVec
iov GatherState s (Array IOVec)
next
#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 :: 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 = Array a -> Int
forall a. Storable a => Array a -> Int
length Array a
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    in  if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
        then [Char] -> (Array a, Array a)
forall a. HasCallStack => [Char] -> a
error [Char]
"sliceAt: negative array index"
        else if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxIndex
             then [Char] -> (Array a, Array a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Array a, Array a)) -> [Char] -> (Array a, Array a)
forall a b. (a -> b) -> a -> b
$ [Char]
"sliceAt: specified array index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is beyond the maximum index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maxIndex
             else let off :: Int
off = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
                      p :: Ptr a
p = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr a
aStart Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
                in ( Array :: forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array
                  { aStart :: ForeignPtr a
aStart = ForeignPtr a
aStart
                  , aEnd :: Ptr a
aEnd = Ptr a
p
                  , aBound :: Ptr a
aBound = Ptr a
p
                  }
                , Array :: forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array
                  { aStart :: ForeignPtr a
aStart = ForeignPtr a
aStart ForeignPtr a -> Int -> ForeignPtr a
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 :: 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
..} = IO (Array Word8, Maybe (Array Word8))
-> m (Array Word8, Maybe (Array Word8))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array Word8, Maybe (Array Word8))
 -> m (Array Word8, Maybe (Array Word8)))
-> IO (Array Word8, Maybe (Array Word8))
-> m (Array Word8, Maybe (Array Word8))
forall a b. (a -> b) -> a -> b
$ do
    let p :: Ptr Word8
p = ForeignPtr Word8 -> Ptr Word8
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 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Ptr Word8
aEnd Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p)
    (Array Word8, Maybe (Array Word8))
-> IO (Array Word8, Maybe (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Array Word8, Maybe (Array Word8))
 -> IO (Array Word8, Maybe (Array Word8)))
-> (Array Word8, Maybe (Array Word8))
-> IO (Array Word8, Maybe (Array Word8))
forall a b. (a -> b) -> a -> b
$
        if Ptr Word8
loc Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr
        then (Array Word8
arr, Maybe (Array Word8)
forall a. Maybe a
Nothing)
        else
            ( Array :: forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array
                { aStart :: ForeignPtr Word8
aStart = ForeignPtr Word8
aStart
                , aEnd :: Ptr Word8
aEnd = Ptr Word8
loc
                , aBound :: Ptr Word8
aBound = Ptr Word8
loc
                }
            , Array Word8 -> Maybe (Array Word8)
forall a. a -> Maybe a
Just (Array Word8 -> Maybe (Array Word8))
-> Array Word8 -> Maybe (Array Word8)
forall a b. (a -> b) -> a -> b
$ Array :: forall a. ForeignPtr a -> Ptr a -> Ptr a -> Array a
Array
                    { aStart :: ForeignPtr Word8
aStart = ForeignPtr Word8
aStart ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` (Ptr Word8
loc Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p Int -> Int -> Int
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 :: 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) = (State Stream m (Array Word8)
 -> SplitState s (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> SplitState s (Array Word8) -> Stream m (Array Word8)
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' (s -> SplitState s (Array Word8)
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) <- Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
breakOn Word8
byte Array Word8
arr
                Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ case Maybe (Array Word8)
marr2 of
                    Maybe (Array Word8)
Nothing   -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Buffering s
s Array Word8
arr1)
                    Just Array Word8
arr2 -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (Array Word8
-> SplitState s (Array Word8) -> SplitState s (Array Word8)
forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
arr1 (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Splitting s
s Array Word8
arr2))
            D.Skip s
s -> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (s -> SplitState s (Array Word8)
forall s arr. s -> SplitState s arr
Initial s
s)
            Step s (Array Word8)
D.Stop -> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitState s (Array Word8)) (Array Word8)
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) <- Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
breakOn Word8
byte Array Word8
arr
                Array Word8
buf' <- Array Word8 -> Array Word8 -> m (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
spliceTwo Array Word8
buf Array Word8
arr1
                Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ case Maybe (Array Word8)
marr2 of
                    Maybe (Array Word8)
Nothing -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Buffering s
s Array Word8
buf')
                    Just Array Word8
x -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (Array Word8
-> SplitState s (Array Word8) -> SplitState s (Array Word8)
forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
buf' (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Splitting s
s Array Word8
x))
            D.Skip s
s -> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Buffering s
s Array Word8
buf)
            Step s (Array Word8)
D.Stop -> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$
                if Array Word8 -> Int
forall a. Array a -> Int
byteLength Array Word8
buf Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then Step (SplitState s (Array Word8)) (Array Word8)
forall s a. Step s a
D.Stop
                else SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (Array Word8
-> SplitState s (Array Word8) -> SplitState s (Array Word8)
forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
buf SplitState s (Array Word8)
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) <- Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
breakOn Word8
byte Array Word8
buf
        Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ case Maybe (Array Word8)
marr2 of
                Maybe (Array Word8)
Nothing -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (SplitState s (Array Word8)
 -> Step (SplitState s (Array Word8)) (Array Word8))
-> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall a b. (a -> b) -> a -> b
$ s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Buffering s
st Array Word8
arr1
                Just Array Word8
arr2 -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (SplitState s (Array Word8)
 -> Step (SplitState s (Array Word8)) (Array Word8))
-> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall a b. (a -> b) -> a -> b
$ Array Word8
-> SplitState s (Array Word8) -> SplitState s (Array Word8)
forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
arr1 (s -> Array Word8 -> SplitState s (Array Word8)
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) = Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ Array Word8
-> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
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 = Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitState s (Array Word8)) (Array Word8)
forall s a. Step s a
D.Stop