{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ScopedTypeVariables #-}
#include "inline.hs"
module Streamly.Internal.Memory.ArrayStream
(
arraysOf
, concat
, concatRev
, interpose
, interposeSuffix
, intercalateSuffix
, splitOn
, splitOnSuffix
, compact
, toArray
)
where
import Control.Monad.IO.Class (MonadIO(..))
import Data.Word (Word8)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (minusPtr, plusPtr, castPtr)
import Foreign.Storable (Storable(..))
import Prelude hiding (length, null, last, map, (!!), read, concat)
import Streamly.Internal.Memory.Array.Types (Array(..), length)
import Streamly.Streams.Serial (SerialT)
import Streamly.Streams.StreamK.Type (IsStream)
import qualified Streamly.Internal.Memory.Array as A
import qualified Streamly.Internal.Memory.Array.Types as A
import qualified Streamly.Internal.Prelude as S
import qualified Streamly.Streams.StreamD as D
import qualified Streamly.Streams.Prelude as P
{-# INLINE concat #-}
concat :: (IsStream t, MonadIO m, Storable a) => t m (Array a) -> t m a
concat m = D.fromStreamD $ D.concatMapU A.read (D.toStreamD m)
{-# INLINE concatRev #-}
concatRev :: (IsStream t, MonadIO m, Storable a) => t m (Array a) -> t m a
concatRev m = D.fromStreamD $ A.flattenArraysRev (D.toStreamD m)
{-# INLINE interpose #-}
interpose :: (MonadIO m, IsStream t, Storable a) => a -> t m (Array a) -> t m a
interpose x = S.interpose x A.read
{-# INLINE intercalateSuffix #-}
intercalateSuffix :: (MonadIO m, IsStream t, Storable a)
=> Array a -> t m (Array a) -> t m a
intercalateSuffix arr = S.intercalateSuffix arr A.read
{-# INLINE interposeSuffix #-}
interposeSuffix :: (MonadIO m, IsStream t, Storable a)
=> a -> t m (Array a) -> t m a
interposeSuffix x = S.interposeSuffix x A.read
{-# INLINE splitOn #-}
splitOn
:: (IsStream t, MonadIO m)
=> Word8
-> t m (Array Word8)
-> t m (Array Word8)
splitOn byte s =
D.fromStreamD $ D.splitInnerBy (A.breakOn byte) A.spliceTwo $ D.toStreamD s
{-# INLINE splitOnSuffix #-}
splitOnSuffix
:: (IsStream t, MonadIO m)
=> Word8
-> t m (Array Word8)
-> t m (Array Word8)
splitOnSuffix byte s =
D.fromStreamD $ D.splitInnerBySuffix (A.breakOn byte) A.spliceTwo $ D.toStreamD s
{-# INLINE compact #-}
compact :: (MonadIO m, Storable a)
=> Int -> SerialT m (Array a) -> SerialT m (Array a)
compact n xs = D.fromStreamD $ A.packArraysChunksOf n (D.toStreamD xs)
{-# INLINE arraysOf #-}
arraysOf :: (IsStream t, MonadIO m, Storable a)
=> Int -> t m a -> t m (Array a)
arraysOf n str =
D.fromStreamD $ A.fromStreamDArraysOf n (D.toStreamD str)
{-# INLINE spliceArraysLenUnsafe #-}
spliceArraysLenUnsafe :: (MonadIO m, Storable a)
=> Int -> SerialT m (Array a) -> m (Array a)
spliceArraysLenUnsafe len buffered = do
arr <- liftIO $ A.newArray len
end <- S.foldlM' writeArr (aEnd arr) buffered
return $ arr {aEnd = end}
where
writeArr dst Array{..} =
liftIO $ withForeignPtr aStart $ \src -> do
let count = aEnd `minusPtr` src
A.memcpy (castPtr dst) (castPtr src) count
return $ dst `plusPtr` count
{-# INLINE _spliceArraysBuffered #-}
_spliceArraysBuffered :: (MonadIO m, Storable a)
=> SerialT m (Array a) -> m (Array a)
_spliceArraysBuffered s = do
buffered <- P.foldr S.cons S.nil s
len <- S.sum (S.map length buffered)
spliceArraysLenUnsafe len s
{-# INLINE spliceArraysRealloced #-}
spliceArraysRealloced :: forall m a. (MonadIO m, Storable a)
=> SerialT m (Array a) -> m (Array a)
spliceArraysRealloced s = do
idst <- liftIO $ A.newArray (A.bytesToElemCount (undefined :: a)
(A.mkChunkSizeKB 4))
arr <- S.foldlM' A.spliceWithDoubling idst s
liftIO $ A.shrinkToFit arr
{-# INLINE toArray #-}
toArray :: (MonadIO m, Storable a) => SerialT m (Array a) -> m (Array a)
toArray = spliceArraysRealloced