packages feed

streamly-core 0.2.1 → 0.2.2

raw patch · 33 files changed

+5788/−3734 lines, 33 filesdep ~base

Dependency ranges changed: base

Files

Changelog.md view
@@ -1,5 +1,13 @@ # Changelog +## 0.2.2 (Jan 2024)++* Add fixities `infixr 5` for `cons` and `consM` functions.+* Fix a bug in Array `Eq` instance when the type is a sum type with+  differently sized constructors.+* lpackArraysChunksOf, compact, writeChunksWith, putChunksWith now take the+  buffer size in number of array elements instead of bytes.+ ## 0.2.1 (Dec 2023)  * Make the serialization of the unit constructor deterministic.
configure view
@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.71 for streamly-core 0.2.1.+# Generated by GNU Autoconf 2.71 for streamly-core 0.2.2. # # Report bugs to <streamly@composewell.com>. #@@ -610,8 +610,8 @@ # Identity of this package. PACKAGE_NAME='streamly-core' PACKAGE_TARNAME='streamly-core'-PACKAGE_VERSION='0.2.1'-PACKAGE_STRING='streamly-core 0.2.1'+PACKAGE_VERSION='0.2.2'+PACKAGE_STRING='streamly-core 0.2.2' PACKAGE_BUGREPORT='streamly@composewell.com' PACKAGE_URL='https://streamly.composewell.com' @@ -1256,7 +1256,7 @@   # Omit some internal or obsolete options to make the list less imposing.   # This message is too long to be a string in the A/UX 3.1 sh.   cat <<_ACEOF-\`configure' configures streamly-core 0.2.1 to adapt to many kinds of systems.+\`configure' configures streamly-core 0.2.2 to adapt to many kinds of systems.  Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1318,7 +1318,7 @@  if test -n "$ac_init_help"; then   case $ac_init_help in-     short | recursive ) echo "Configuration of streamly-core 0.2.1:";;+     short | recursive ) echo "Configuration of streamly-core 0.2.2:";;    esac   cat <<\_ACEOF @@ -1404,7 +1404,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then   cat <<\_ACEOF-streamly-core configure 0.2.1+streamly-core configure 0.2.2 generated by GNU Autoconf 2.71  Copyright (C) 2021 Free Software Foundation, Inc.@@ -1622,7 +1622,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by streamly-core $as_me 0.2.1, which was+It was created by streamly-core $as_me 0.2.2, which was generated by GNU Autoconf 2.71.  Invocation command line was    $ $0$ac_configure_args_raw@@ -3832,7 +3832,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by streamly-core $as_me 0.2.1, which was+This file was extended by streamly-core $as_me 0.2.2, which was generated by GNU Autoconf 2.71.  Invocation command line was    CONFIG_FILES    = $CONFIG_FILES@@ -3888,7 +3888,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\-streamly-core config.status 0.2.1+streamly-core config.status 0.2.2 configured by $0, generated by GNU Autoconf 2.71,   with options \\"\$ac_cs_config\\"
configure.ac view
@@ -3,7 +3,7 @@ # See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on # the macros used in this file. -AC_INIT([streamly-core], [0.2.1], [streamly@composewell.com], [streamly-core], [https://streamly.composewell.com])+AC_INIT([streamly-core], [0.2.2], [streamly@composewell.com], [streamly-core], [https://streamly.composewell.com])  # To suppress "WARNING: unrecognized options: --with-compiler" AC_ARG_WITH([compiler], [GHC])
+ docs/ApiChangelogs/0.2.0-0.2.2.txt view
@@ -0,0 +1,306 @@+---------------------------------+API Annotations+---------------------------------++[A] : Added+[R] : Removed+[C] : Changed+[O] : Old definition+[N] : New definition+[D] : Deprecated++---------------------------------+API diff+---------------------------------++[C] Streamly.Data.Stream+    [A] (FixityR,5)+    [A] (FixityR,5)+[C] Streamly.Data.MutArray.Generic+    [A] emptyOf :: MonadIO m => Int -> m (MutArray a)+    [A] createOf :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] create :: MonadIO m => Fold m a (MutArray a)+[C] Streamly.Data.MutArray+    [A] pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] appendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] append :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+[C] Streamly.Data.Array.Generic+    [A] createOf :: MonadIO m => Int -> Fold m a (Array a)+    [A] create :: MonadIO m => Fold m a (Array a)+[C] Streamly.Data.Array+    [A] class Serialize a+    [A] serializeAt :: Serialize a => Int -> MutByteArray -> a -> IO Int+    [A] pinnedSerialize :: Serialize a => a -> Array Word8+    [A] deserializeAt :: Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)+    [A] deserialize :: Serialize a => Array Word8 -> a+    [A] createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] create :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] addSizeTo :: Serialize a => Int -> a -> Int++---------------------------------+Internal API diff+---------------------------------++[C] Streamly.Internal.Unicode.Stream+    [A] encodeUtf16le' :: Stream m Char -> Stream m Word16+    [A] decodeUtf16le' :: Stream m Word16 -> Stream m Char+[A] Streamly.Internal.FileSystem.Path+    [A] class IsPath a+    [A] Rel+    [A] File+    [A] Dir+    [A] Abs+    [A] Streamly.Internal.FileSystem.Path.IsPath+        [A] instance Streamly.Internal.FileSystem.Path.IsPath Streamly.Internal.FileSystem.Path.Path+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Rel Streamly.Internal.FileSystem.Path.Path)+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Rel (Streamly.Internal.FileSystem.Path.File Streamly.Internal.FileSystem.Path.Path))+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Rel (Streamly.Internal.FileSystem.Path.Dir Streamly.Internal.FileSystem.Path.Path))+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.File Streamly.Internal.FileSystem.Path.Path)+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Dir Streamly.Internal.FileSystem.Path.Path)+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Abs Streamly.Internal.FileSystem.Path.Path)+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Abs (Streamly.Internal.FileSystem.Path.File Streamly.Internal.FileSystem.Path.Path))+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Abs (Streamly.Internal.FileSystem.Path.Dir Streamly.Internal.FileSystem.Path.Path))+    [A] GHC.Show.Show+        [A] instance GHC.Show.Show Streamly.Internal.FileSystem.Path.PathException+    [A] GHC.Exception.Type.Exception+        [A] instance GHC.Exception.Type.Exception Streamly.Internal.FileSystem.Path.PathException+    [A] GHC.Classes.Eq+        [A] instance GHC.Classes.Eq Streamly.Internal.FileSystem.Path.PathException+    [A] Path+        [A] Path :: Array Word8 -> Path+    [A] toString :: Path -> [Char]+    [A] toPath :: IsPath a => a -> Path+    [A] toChunk :: Path -> Array Word8+    [A] toChars :: Monad m => Path -> Stream m Char+    [A] relfile :: QuasiQuoter+    [A] reldir :: QuasiQuoter+    [A] rel :: QuasiQuoter+    [A] primarySeparator :: Char+    [A] path :: QuasiQuoter+    [A] mkRelFile :: String -> Q Exp+    [A] mkRelDir :: String -> Q Exp+    [A] mkRel :: String -> Q Exp+    [A] mkPath :: String -> Q Exp+    [A] mkFile :: String -> Q Exp+    [A] mkDir :: String -> Q Exp+    [A] mkAbsFile :: String -> Q Exp+    [A] mkAbsDir :: String -> Q Exp+    [A] mkAbs :: String -> Q Exp+    [A] isSeparator :: Char -> Bool+    [A] fromString :: MonadThrow m => [Char] -> m Path+    [A] fromPathUnsafe :: IsPath a => Path -> a+    [A] fromPath :: (IsPath a, MonadThrow m) => Path -> m a+    [A] fromChunkUnsafe :: Array Word8 -> Path+    [A] fromChunk :: MonadThrow m => Array Word8 -> m Path+    [A] fromChars :: MonadThrow m => Stream Identity Char -> m Path+    [A] file :: QuasiQuoter+    [A] extendPath :: Path -> Path -> Path+    [A] extendDir :: (IsPath (a (Dir Path)), IsPath b, IsPath (a b)) => a (Dir Path) -> Rel b -> a b+    [A] dir :: QuasiQuoter+    [A] adaptPath :: (MonadThrow m, IsPath a, IsPath b) => a -> m b+    [A] absfile :: QuasiQuoter+    [A] absdir :: QuasiQuoter+    [A] abs :: QuasiQuoter+[C] Streamly.Internal.Data.Stream+    [A] (FixityR,5)+    [A] (FixityR,5)+    [C] splitInnerBySuffix+        [O] splitInnerBySuffix :: (Monad m, Eq (f a), Monoid (f a)) => (f a -> m (f a, Maybe (f a))) -> (f a -> f a -> m (f a)) -> Stream m (f a) -> Stream m (f a)+        [N] splitInnerBySuffix :: Monad m => (f a -> Bool) -> (f a -> m (f a, Maybe (f a))) -> (f a -> f a -> m (f a)) -> Stream m (f a) -> Stream m (f a)+    [D] sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [A] indexOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+[C] Streamly.Internal.Data.MutByteArray+    [A] unsafePinnedAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+    [A] unsafeAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+    [D] nil :: MutByteArray+    [A] empty :: MutByteArray+    [D] asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+[D] Streamly.Internal.Data.MutArray.Stream+    [D] writeChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [D] fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [D] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [D] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+[C] Streamly.Internal.Data.MutArray.Generic+    [D] writeWith :: MonadIO m => Int -> Fold m a (MutArray a)+    [D] writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] unsafeCreateOf :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] emptyOf :: MonadIO m => Int -> m (MutArray a)+    [A] createWith :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] createOf :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] create :: MonadIO m => Fold m a (MutArray a)+[C] Streamly.Internal.Data.MutArray+    [A] SpliceState+        [A] SpliceYielding :: arr -> SpliceState s arr -> SpliceState s arr+        [A] SpliceInitial :: s -> SpliceState s arr+        [A] SpliceFinish :: SpliceState s arr+        [A] SpliceBuffering :: s -> arr -> SpliceState s arr+    [R] MutByteArray+    [D] writeWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [D] writeNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] writeChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [D] writeAppendWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+    [D] writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] unsafePinnedAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+    [A] unsafeCreateOfWith :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [A] unsafeCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+    [A] unsafeAppendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] toStreamWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [A] toStreamRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [R] toStreamDWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [R] toStreamDRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [A] slicerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (MutArray a)+    [A] sliceIndexerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (Int, Int)+    [A] revCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] resizeExp :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [D] resize :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] pokeSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8+    [A] pokeAppendMay :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> a -> m (Maybe (MutArray Word8))+    [A] pokeAppend :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> a -> m (MutArray Word8)+    [D] pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [D] pinnedNewBytes :: MonadIO m => Int -> m (MutArray a)+    [A] pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] pinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] pinnedCompactLE :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] peekUnconsUnsafe :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> m (a, MutArray Word8)+    [A] peekUncons :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> m (Maybe a, MutArray Word8)+    [A] peekSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8+    [A] pPinnedCompactLE :: forall m a. (MonadIO m, Unbox a) => Int -> Parser (MutArray a) m (MutArray a)+    [A] pCompactLE :: forall m a. (MonadIO m, Unbox a) => Int -> Parser (MutArray a) m (MutArray a)+    [D] nil :: MutArray a+    [A] lPinnedCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+    [A] lCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+    [A] indexReaderWith :: (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a+    [A] indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+    [A] growExp :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] grow :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [D] getSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (MutArray a)+    [R] getIndicesD :: (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a+    [D] getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+    [D] genSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (Int, Int)+    [A] fromStreamN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (MutArray a)+    [D] fromStreamDN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (MutArray a)+    [D] fromStreamD :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)+    [A] fromPureStreamN :: (MonadIO m, Unbox a) => Int -> Stream Identity a -> m (MutArray a)+    [A] fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)+    [A] fromChunksRealloced :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> m (MutArray a)+    [A] fromChunksK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [A] fromByteStr# :: MonadIO m => Addr# -> m (MutArray Word8)+    [D] fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [D] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [D] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] fPinnedCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) (MutArray a)+    [A] fCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) (MutArray a)+    [A] emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] empty :: MutArray a+    [A] createWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] createOfWith :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [A] createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] concatWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a+    [A] concatRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a+    [A] concatRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] concat :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] compactOnByteSuffix :: MonadIO m => Word8 -> Stream m (MutArray Word8) -> Stream m (MutArray Word8)+    [A] compactOnByte :: MonadIO m => Word8 -> Stream m (MutArray Word8) -> Stream m (MutArray Word8)+    [A] compactLeAs :: forall m a. (MonadIO m, Unbox a) => PinnedState -> Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactLE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactGE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactEQ :: Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [D] cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+    [A] byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool+    [A] byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+    [A] buildChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [D] asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+    [A] appendWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+    [A] appendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] append :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+[D] Streamly.Internal.Data.Array.Stream+    [C] interposeSuffix+        [O] interposeSuffix :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+        [N] interposeSuffix :: forall m a. (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [D] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [D] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [C] concatRev+        [O] concatRev :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+        [N] concatRev :: forall m a. (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [D] bufferChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+[C] Streamly.Internal.Data.Array.Generic+    [A] createOf :: MonadIO m => Int -> Fold m a (Array a)+    [A] create :: MonadIO m => Fold m a (Array a)+[C] Streamly.Internal.Data.Array+    [R] ArrayUnsafe+    [D] writeWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] writeNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] unsafePinnedAsPtr :: MonadIO m => Array a -> (Ptr a -> m b) -> m b+    [A] unsafeCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] toStreamDRev :: forall m a. (Monad m, Unbox a) => Array a -> Stream m a+    [D] toStreamD :: forall m a. (Monad m, Unbox a) => Array a -> Stream m a+    [C] splice+        [O] splice :: (MonadIO m, Unbox a) => Array a -> Array a -> m (Array a)+        [N] splice :: MonadIO m => Array a -> Array a -> m (Array a)+    [A] slicerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Array a)+    [A] sliceIndexerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Int, Int)+    [D] pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> Fold m a (Array a)+    [D] pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] pinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] pinnedCompactLE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] parseBreakChunksK :: forall m a b. (MonadIO m, Unbox a) => Parser a m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [D] nil :: Array a+    [A] lPinnedCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) () -> Fold m (Array a) ()+    [A] lCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) () -> Fold m (Array a) ()+    [A] interposeSuffix :: forall m a. (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] intercalateSuffix :: (Monad m, Unbox a) => Array a -> Stream m (Array a) -> Stream m a+    [A] indexReaderFromThenTo :: Unfold m (Int, Int, Int, Array a) a+    [A] indexReader :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a+    [A] indexFinder :: (a -> Bool) -> Unfold Identity (Array a) Int+    [D] getSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Array a)+    [R] getIndicesFromThenTo :: Unfold m (Int, Int, Int, Array a) a+    [D] getIndices :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a+    [D] genSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Int, Int)+    [D] fromStreamDN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (Array a)+    [D] fromStreamD :: forall m a. (MonadIO m, Unbox a) => Stream m a -> m (Array a)+    [A] fromPureStreamN :: Unbox a => Int -> Stream Identity a -> Array a+    [A] fromPtrN :: Int -> Ptr Word8 -> Array Word8+    [A] fromChunksK :: (MonadIO m, Unbox a) => StreamK m (Array a) -> m (Array a)+    [A] fromChunks :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)+    [A] fromByteStr :: Ptr Word8 -> Array Word8+    [A] foldChunks :: (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m b+    [A] foldBreakChunksK :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a))+    [A] foldBreakChunks :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))+    [D] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [D] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [C] findIndicesOf+        [O] findIndicesOf :: (a -> Bool) -> Unfold Identity (Array a) Int+        [N] findIndicesOf :: (a -> Bool) -> Array a -> Stream Identity Int+    [A] fPinnedCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+    [A] fCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+    [A] empty :: Array a+    [A] createWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] create :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] concatRev :: forall m a. (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] concat :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] compactOnByteSuffix :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [A] compactOnByte :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [A] compactLE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] compactGE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] byteEq :: Array a -> Array a -> Bool+    [A] byteCmp :: Array a -> Array a -> Ordering+    [A] buildChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+    [D] bufferChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+    [D] asPtrUnsafe :: MonadIO m => Array a -> (Ptr a -> m b) -> m b
docs/Changelog.md view
@@ -1,5 +1,13 @@ # Changelog +## 0.2.2 (Jan 2024)++* Add fixities `infixr 5` for `cons` and `consM` functions.+* Fix a bug in Array `Eq` instance when the type is a sum type with+  differently sized constructors.+* lpackArraysChunksOf, compact, writeChunksWith, putChunksWith now take the+  buffer size in number of array elements instead of bytes.+ ## 0.2.1 (Dec 2023)  * Make the serialization of the unit constructor deterministic.
src/DocTestDataArray.hs view
@@ -11,9 +11,12 @@  >>> import qualified Streamly.Data.Array as Array >>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.ParserK as ParserK >>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.StreamK as StreamK  For APIs that have not been released yet.  >>> import qualified Streamly.Internal.Data.Array as Array+>>> import qualified Streamly.Internal.Data.Stream as Stream -}
src/DocTestFileSystemHandle.hs view
@@ -8,7 +8,7 @@  For APIs that have not been released yet. ->>> import qualified Streamly.Internal.Data.Array as Array (writeNUnsafe)+>>> import qualified Streamly.Internal.Data.Array as Array (unsafeCreateOf) >>> import qualified Streamly.Internal.Data.Unfold as Unfold (first) >>> import qualified Streamly.Internal.FileSystem.Handle as Handle >>> import qualified Streamly.Internal.System.IO as IO (defaultChunkSize)
src/Streamly/Data/Array.hs view
@@ -31,42 +31,42 @@     -- * The Array Type       Array +    -- * Pinning & Unpinning+    -- | Arrays are created unpinned by default unless pinned versions of+    -- creation APIs are used. Look for APIs with @pinned@ prefix in+    -- "Streamly.Internal.Data.Array" for some unreleased pinned creation APIs.+    -- If an array is to be sent to the OS without any further modification+    -- then it should be created pinned in the first place instead of pinning+    -- it later. Pinning an unpinned array has a copy overhead. OS interfacing+    -- APIs create a pinned array directly or convert an unpinned array to+    -- pinned array before sending it to the OS.+    , pin+    , unpin+    , isPinned+     -- * Construction     -- | When performance matters, the fastest way to generate an array is-    -- 'writeN'. 'IsList' and 'IsString' instances can be+    -- 'createOf'. 'IsList' and 'IsString' instances can be     -- used to conveniently construct arrays from literal values.     -- 'OverloadedLists' extension or 'fromList' can be used to construct an     -- array from a list literal.  Similarly, 'OverloadedStrings' extension or     -- 'fromList' can be used to construct an array from a string literal. -    -- Pure List APIs+    -- ** From Stream+    , createOf+    , create+    , writeLastN    -- drop old (ring buffer)++    -- ** From List     , fromListN     , fromList -    -- Monadic APIs-    , writeN      -- drop new-    , write       -- full buffer-    , writeLastN    -- drop old (ring buffer)--    -- * Conversion+    -- * To List     -- 'GHC.Exts.toList' from "GHC.Exts" can be used to convert an array to a     -- list.     , toList -    -- * Pinning & Unpinning-    -- | Arrays are created unpinned by default unless pinned versions of-    -- creation APIs are used. Look for APIs with @pinned@ prefix in-    -- "Streamly.Internal.Data.Array" for some unreleased pinned creation APIs.-    -- If an array is to be sent to the OS without any further modification-    -- then it should be created pinned in the first place instead of pinning-    -- it later. Pinning an unpinned array has a copy overhead. OS interfacing-    -- APIs create a pinned array directly or convert an unpinned array to-    -- pinned array before sending it to the OS.-    , pin-    , unpin-    , isPinned--    -- * Streams+    -- * To Stream     , read     , readRev @@ -90,6 +90,10 @@     -- * Re-exports     , Unbox (..)     , Serialize(..)++    -- * Deprecated+    , writeN      -- drop new+    , write       -- full buffer     ) where @@ -122,7 +126,7 @@ -- -- Convert array to stream, transform, and fold back to array: ----- >>> amap f arr = Array.read arr & fmap f & Stream.fold Array.write+-- >>> amap f arr = Array.read arr & fmap f & Stream.fold Array.create -- >>> amap (+1) (Array.fromList [1,2,3::Int]) -- fromList [2,3,4] --@@ -154,7 +158,7 @@ -- -- >>> pure = Stream.fromList [1,2,3] :: Stream Identity Int -- >>> generally = Stream.morphInner (return . runIdentity)--- >>> Stream.fold Array.write (generally pure :: Stream IO Int)+-- >>> Stream.fold Array.create (generally pure :: Stream IO Int) -- fromList [1,2,3] -- -- == Programming Tips
src/Streamly/Data/Array/Generic.hs view
@@ -15,34 +15,37 @@     ( Array      -- * Construction-    , A.fromListN-    , A.fromList+    , fromListN+    , fromList      -- MonadicAPIs-    , A.writeN-    , A.write+    , createOf+    , create      -- * Conversion-    , A.toList+    , toList      -- * Streams-    , A.read-    , A.readRev+    , read+    , readRev      -- * Unfolds-    , A.reader+    , reader     -- , A.readerRev      -- * Random Access-    , A.length-    , A.getIndex+    , length+    , getIndex      -- -- * Folding Arrays     -- , A.streamFold     -- , A.fold++    -- * Deprecated+    , writeN+    , write     ) where -import Streamly.Internal.Data.Array.Generic (Array)--import qualified Streamly.Internal.Data.Array.Generic as A+import Streamly.Internal.Data.Array.Generic+import Prelude hiding (length, read)
src/Streamly/Data/MutArray.hs view
@@ -32,14 +32,14 @@     -- * Construction      -- Uninitialized Arrays-    , new-    , pinnedNew+    , emptyOf+    , pinnedEmptyOf      -- From containers     , fromListN     , fromList-    , writeN      -- drop new-    , write       -- full buffer+    , createOf+    , create     -- writeLastN      -- * Pinning & Unpinning@@ -51,8 +51,8 @@     , snoc      -- * Appending streams-    , writeAppendN -- XXX Rename to writeSnocN?-    , writeAppend -- XXX Rename to writeSnoc?+    , appendN+    , append      -- * Inplace mutation     , putIndex@@ -88,6 +88,12 @@      -- * Deprecated     , newPinned+    , new+    , pinnedNew+    , writeN+    , write+    , writeAppendN+    , writeAppend     ) where
src/Streamly/Data/MutArray/Generic.hs view
@@ -23,11 +23,11 @@       MutArray      -- * Construction-    , new+    , emptyOf     , fromListN     , fromList-    , writeN-    , write+    , createOf+    , create      -- * Appending elements     , snoc@@ -56,6 +56,11 @@      -- * Size     , length++    -- * Deprecated+    , new+    , writeN+    , write     ) where
src/Streamly/Internal/Data/Array.hs view
@@ -2,7 +2,6 @@ -- | -- Module      : Streamly.Internal.Data.Array -- Copyright   : (c) 2019 Composewell Technologies--- -- License     : BSD3 -- Maintainer  : streamly@composewell.com -- Stability   : experimental@@ -20,30 +19,21 @@       module Streamly.Internal.Data.Array.Type      -- * Construction-    -- Stream Folds-    , fromStreamN-    , fromStream-     -- Monadic Folds     , writeLastN -    -- * Unfolds-    , reader-    , readerUnsafe-    , producer -- experimental-     -- * Random Access     -- , (!!)     , getIndex     , getIndexRev-    , last           -- XXX getIndexLast?-    , getIndices-    , getIndicesFromThenTo+    , last           -- XXX getLastIndex?     -- , getIndicesFrom    -- read from a given position to the end of file     -- , getIndicesUpto    -- read from beginning up to the given position     -- , getIndicesFromTo     -- , getIndicesFromRev  -- read from a given position to the beginning of file     -- , getIndicesUptoRev  -- read from end to the given position in file+    , indexReader+    , indexReaderFromThenTo      -- * Size     , null@@ -51,6 +41,8 @@     -- * Search     , binarySearch     , findIndicesOf+    -- getIndicesOf+    , indexFinder -- see splitOn     -- , findIndexOf     -- , find @@ -63,8 +55,8 @@     -- * Subarrays     , getSliceUnsafe     -- , getSlice-    , genSlicesFromLen-    , getSlicesFromLen+    , sliceIndexerFromLen+    , slicerFromLen     , splitOn      -- * Streaming Operations@@ -74,11 +66,34 @@     , streamFold     , fold +    -- * Stream of Arrays++    -- XXX these are probably not very useful to have in this module as we can+    -- express these idiomatically using streams.+    , interpose+    , interposeSuffix+    , intercalateSuffix++    , compactLE+    , pinnedCompactLE+    , compactOnByte+    , compactOnByteSuffix++    , foldBreakChunks+    , foldChunks+    , foldBreakChunksK+    , parseBreakChunksK+     -- * Serialization     , encodeAs     , serialize     , pinnedSerialize     , deserialize++    -- * Deprecated+    , genSlicesFromLen+    , getSlicesFromLen+    , getIndices     ) where @@ -86,37 +101,43 @@ #include "inline.hs" #include "ArrayMacros.h" -import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..))+-- import Data.Bifunctor (first)+-- import Data.Either (fromRight) import Data.Functor.Identity (Identity) import Data.Proxy (Proxy(..)) import Data.Word (Word8) import Foreign.C.String (CString) import Foreign.Ptr (castPtr) import Foreign.Storable (Storable)+import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Unbox (Unbox(..)) import Prelude hiding (length, null, last, map, (!!), read, concat) -import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..))+import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..), MutByteArray) import Streamly.Internal.Data.Serialize.Type (Serialize) import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.Data.Stream (Stream)-import Streamly.Internal.Data.Tuple.Strict (Tuple3Fused'(..))+import Streamly.Internal.Data.Parser (Parser(..), Initial(..), ParseError(..))+import Streamly.Internal.Data.Stream (Stream(..))+import Streamly.Internal.Data.StreamK (StreamK)+import Streamly.Internal.Data.SVar.Type (adaptState, defState)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3Fused'(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (unsafeInlineIO) +import qualified Streamly.Internal.Data.Fold.Type as Fold import qualified Streamly.Internal.Data.Serialize.Type as Serialize import qualified Streamly.Internal.Data.MutByteArray.Type as MBA import qualified Streamly.Internal.Data.MutArray as MA-import qualified Streamly.Internal.Data.Array.Type as A import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Producer.Type as Producer-import qualified Streamly.Internal.Data.Producer as Producer import qualified Streamly.Internal.Data.Ring as RB+import qualified Streamly.Internal.Data.Parser as Parser+-- import qualified Streamly.Internal.Data.ParserK as ParserK import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.StreamK as StreamK import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Prelude  import Streamly.Internal.Data.Array.Type @@ -146,81 +167,9 @@ -- pressure to GC.  ---------------------------------------------------------------------------------- Construction------------------------------------------------------------------------------------ | Create an 'Array' from the first N elements of a stream. The array is--- allocated to size N, if the stream terminates before N elements then the--- array may hold less than N elements.------ /Pre-release/-{-# INLINE fromStreamN #-}-fromStreamN :: (MonadIO m, Unbox a) => Int -> Stream m a -> m (Array a)-fromStreamN n m = do-    when (n < 0) $ error "writeN: negative write count specified"-    A.fromStreamDN n m---- | Create an 'Array' from a stream. This is useful when we want to create a--- single array from a stream of unknown size. 'writeN' is at least twice--- as efficient when the size is already known.------ Note that if the input stream is too large memory allocation for the array--- may fail.  When the stream size is not known, `chunksOf` followed by--- processing of indvidual arrays in the resulting stream should be preferred.------ /Pre-release/-{-# INLINE fromStream #-}-fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (Array a)-fromStream = Stream.fold A.write--- write m = A.fromStreamD $ D.fromStreamK m--------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- -{-# INLINE_NORMAL producer #-}-producer :: forall m a. (Monad m, Unbox a) => Producer m (Array a) a-producer =-    Producer.translate A.unsafeThaw A.unsafeFreeze-        $ MA.producerWith (return . unsafeInlineIO)---- | Unfold an array into a stream.----{-# INLINE_NORMAL reader #-}-reader :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a-reader = Producer.simplify producer---- | Unfold an array into a stream, does not check the end of the array, the--- user is responsible for terminating the stream within the array bounds. For--- high performance application where the end condition can be determined by--- a terminating fold.------ Written in the hope that it may be faster than "read", however, in the case--- for which this was written, "read" proves to be faster even though the core--- generated with unsafeRead looks simpler.------ /Pre-release/----{-# INLINE_NORMAL readerUnsafe #-}-readerUnsafe :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a-readerUnsafe = Unfold step inject-    where--    inject (Array contents start end) =-        return (ArrayUnsafe contents end start)--    {-# INLINE_LATE step #-}-    step (ArrayUnsafe contents end 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 = unsafeInlineIO $ peekAt p contents-            let !p1 = INDEX_NEXT(p,a)-            return $ D.Yield x (ArrayUnsafe contents end p1)- -- | -- -- >>> null arr = Array.byteLength arr == 0@@ -228,7 +177,7 @@ -- /Pre-release/ {-# INLINE null #-} null :: Array a -> Bool-null arr = A.byteLength arr == 0+null arr = byteLength arr == 0  -- | Like 'getIndex' but indexes the array in reverse from the end. --@@ -256,6 +205,8 @@ -- Folds with Array as the container ------------------------------------------------------------------------------- +-- XXX We should generate this from Ring.+ -- | @writeLastN n@ folds a maximum of @n@ elements from the end of the input -- stream to an 'Array'. --@@ -264,7 +215,7 @@        (Storable a, Unbox a, MonadIO m) => Int -> Fold m a (Array a) writeLastN n     | n <= 0 = fmap (const mempty) FL.drain-    | otherwise = A.unsafeFreeze <$> Fold step initial done done+    | otherwise = unsafeFreeze <$> Fold step initial done done      where @@ -277,11 +228,9 @@          in fmap f $ liftIO $ RB.new n      done (Tuple3Fused' rb rh i) = do-        arr <- liftIO $ MA.new n-        foldFunc i rh snoc' arr rb--    -- XXX We should write a read unfold for ring.-    snoc' b a = liftIO $ MA.snocUnsafe b a+        arr <- MA.new n+        -- XXX We should write a read unfold for ring.+        foldFunc i rh MA.snocUnsafe arr rb      foldFunc i         | i < n = RB.unsafeFoldRingM@@ -307,19 +256,26 @@ -- compared to streams by using SIMD instructions. -- We can also return a bit array instead. +-- Can use SIMD.+ -- | Perform a linear search to find all the indices where a given element is -- present in an array. -- -- /Unimplemented/-findIndicesOf :: (a -> Bool) -> Unfold Identity (Array a) Int-findIndicesOf = undefined+indexFinder :: (a -> Bool) -> Unfold Identity (Array a) Int+indexFinder = undefined +-- |+-- /Unimplemented/+findIndicesOf :: (a -> Bool) -> Array a -> Stream Identity Int+findIndicesOf p = Stream.unfold (indexFinder p)+ {- findIndexOf :: (a -> Bool) -> Array a -> Maybe Int-findIndexOf p = Unfold.fold Fold.one . Stream.unfold (findIndicesOf p)+findIndexOf p = Unfold.fold Fold.one . Stream.unfold (indexFinder p)  find :: (a -> Bool) -> Array a -> Bool-find = Unfold.fold Fold.null . Stream.unfold (findIndicesOf p)+find = Unfold.fold Fold.null . Stream.unfold (indexFinder p) -}  -------------------------------------------------------------------------------@@ -361,29 +317,45 @@     (a -> Bool) -> Array a -> Stream m (Array a) splitOn predicate arr =     fmap (\(i, len) -> getSliceUnsafe i len arr)-        $ D.sliceOnSuffix predicate (A.toStreamD arr)+        $ D.indexOnSuffix predicate (read arr) +{-# INLINE sliceIndexerFromLen #-}+sliceIndexerFromLen :: forall m a. (Monad m, Unbox a)+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> Unfold m (Array a) (Int, Int)+sliceIndexerFromLen from len =+    Unfold.lmap unsafeThaw (MA.sliceIndexerFromLen from len)++{-# DEPRECATED genSlicesFromLen "Please use sliceIndexerFromLen instead." #-} {-# INLINE genSlicesFromLen #-} genSlicesFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (Array a) (Int, Int)-genSlicesFromLen from len =-    Unfold.lmap A.unsafeThaw (MA.genSlicesFromLen from len)+genSlicesFromLen = sliceIndexerFromLen  -- | Generate a stream of slices of specified length from an array, starting -- from the supplied array index. The last slice may be shorter than the -- requested length. -- -- /Pre-release//+{-# INLINE slicerFromLen #-}+slicerFromLen :: forall m a. (Monad m, Unbox a)+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> Unfold m (Array a) (Array a)+slicerFromLen from len =+    fmap unsafeFreeze+        $ Unfold.lmap unsafeThaw (MA.slicerFromLen from len)++{-# DEPRECATED getSlicesFromLen "Please use slicerFromLen instead." #-} {-# INLINE getSlicesFromLen #-} getSlicesFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (Array a) (Array a)-getSlicesFromLen from len =-    fmap A.unsafeFreeze-        $ Unfold.lmap A.unsafeThaw (MA.getSlicesFromLen from len)+getSlicesFromLen = slicerFromLen  ------------------------------------------------------------------------------- -- Random reads and writes@@ -413,19 +385,25 @@ -- @ -- read = --      let u = lmap (\arr -> (0, length arr - 1)) Unfold.enumerateFromTo---       in Unfold.lmap f (getIndices arr)+--       in Unfold.lmap f (indexReader arr) -- -- readRev = --      let i = length arr - 1---       in Unfold.lmap f (getIndicesFromThenTo i (i - 1) 0)+--       in Unfold.lmap f (indexReaderFromThenTo i (i - 1) 0) -- @ -- -- /Pre-release/+{-# INLINE indexReader #-}+indexReader :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a+indexReader m =+    let unf = MA.indexReaderWith (return . unsafeInlineIO) m+     in Unfold.lmap unsafeThaw unf++-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold+{-# DEPRECATED getIndices "Please use getIndices instead." #-} {-# INLINE getIndices #-} getIndices :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a-getIndices m =-    let unf = MA.getIndicesD (return . unsafeInlineIO) m-     in Unfold.lmap A.unsafeThaw unf+getIndices = indexReader  -- | Unfolds @(from, then, to, array)@ generating a finite stream whose first -- element is the array value from the index @from@ and the successive elements@@ -441,9 +419,9 @@ -- @ -- -- /Unimplemented/-{-# INLINE getIndicesFromThenTo #-}-getIndicesFromThenTo :: Unfold m (Int, Int, Int, Array a) a-getIndicesFromThenTo = undefined+{-# INLINE indexReaderFromThenTo #-}+indexReaderFromThenTo :: Unfold m (Int, Int, Int, Array a) a+indexReaderFromThenTo = undefined  ------------------------------------------------------------------------------- -- Transform via stream operations@@ -460,7 +438,7 @@ {-# INLINE runPipe #-} runPipe :: (MonadIO m, Unbox a, Unbox b)     => Pipe m a b -> Array a -> m (Array b)-runPipe f arr = P.runPipe (toArrayMinChunk (length arr)) $ f (A.read arr)+runPipe f arr = P.runPipe (toArrayMinChunk (length arr)) $ f (read arr) -}  -- XXX For transformations that cannot change the number of elements e.g. "map"@@ -474,7 +452,7 @@ streamTransform :: forall m a b. (MonadIO m, Unbox a, Unbox b)     => (Stream m a -> Stream m b) -> Array a -> m (Array b) streamTransform f arr =-    Stream.fold (A.writeWith (length arr)) $ f (A.read arr)+    Stream.fold (createWith (length arr)) $ f (read arr)  ------------------------------------------------------------------------------- -- Casts@@ -508,7 +486,7 @@ -- cast :: forall a b. (Unbox b) => Array a -> Maybe (Array b) cast arr =-    let len = A.byteLength arr+    let len = byteLength arr         r = len `mod` SIZE_OF(b)      in if r /= 0         then Nothing@@ -526,9 +504,9 @@ -- asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b asCStringUnsafe arr act = do-    let arr1 = asBytes arr <> A.fromList [0]-    -- asPtrUnsafe makes sure the array is pinned-    asPtrUnsafe arr1 $ \ptr -> act (castPtr ptr)+    let arr1 = asBytes arr <> fromList [0]+    -- unsafePinnedAsPtr makes sure the array is pinned+    unsafePinnedAsPtr arr1 $ \ptr -> act (castPtr ptr)  ------------------------------------------------------------------------------- -- Folds@@ -541,14 +519,14 @@ -- /Pre-release/ {-# INLINE fold #-} fold :: forall m a b. (Monad m, Unbox a) => Fold m a b -> Array a -> m b-fold f arr = Stream.fold f (A.read arr)+fold f arr = Stream.fold f (read arr)  -- | Fold an array using a stream fold operation. -- -- /Pre-release/ {-# INLINE streamFold #-} streamFold :: (Monad m, Unbox a) => (Stream m a -> m b) -> Array a -> m b-streamFold f arr = f (A.read arr)+streamFold f arr = f (read arr)  -------------------------------------------------------------------------------- -- Serialization@@ -593,3 +571,448 @@         Serialize.deserializeAt arrStart arrContents (arrStart + lenArr)     assertM(off == arrStart + lenArr)     pure val++-------------------------------------------------------------------------------+-- Streams of Arrays+-------------------------------------------------------------------------------++-- TODO: efficiently compare two streams of arrays. Two streams can have chunks+-- of different sizes, we can handle that in the stream comparison abstraction.+-- This could be useful e.g. to fast compare whether two files differ.++-- | Insert the given element between arrays and flatten.+--+-- >>> interpose x = Stream.interpose x Array.reader+--+{-# INLINE interpose #-}+interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+interpose x = D.interpose x reader++data FlattenState s =+      OuterLoop s+    | InnerLoop s !MutByteArray !Int !Int++-- | Insert the given element after each array and flatten. This is similar to+-- unlines.+--+-- >>> interposeSuffix x = Stream.interposeSuffix x Array.reader+--+{-# INLINE_NORMAL interposeSuffix #-}+interposeSuffix :: forall m a. (Monad m, Unbox a)+    => a -> Stream m (Array a) -> Stream m a+-- This does not require MonadIO constraint.+-- interposeSuffix x = D.interposeSuffix x reader+interposeSuffix sep (D.Stream step state) = D.Stream step' (OuterLoop state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (OuterLoop st) = do+        r <- step (adaptState gst) st+        return $ case r of+            D.Yield Array{..} s ->+                D.Skip (InnerLoop s arrContents arrStart arrEnd)+            D.Skip s -> D.Skip (OuterLoop s)+            D.Stop -> D.Stop++    step' _ (InnerLoop st _ p end) | p == end =+        return $ D.Yield sep $ OuterLoop st++    step' _ (InnerLoop st contents p end) = do+        x <- pure $ unsafeInlineIO $ peekAt p contents+        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)++-- | Insert the given array after each array and flatten.+--+-- >>> intercalateSuffix = Stream.intercalateSuffix Array.reader+--+{-# INLINE intercalateSuffix #-}+intercalateSuffix :: (Monad m, Unbox a)+    => Array a -> Stream m (Array a) -> Stream m a+intercalateSuffix = D.intercalateSuffix reader++-- | @compactLE n@ coalesces adjacent arrays in the input stream+-- only if the combined size would be less than or equal to n.+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# INLINE_NORMAL compactLE #-}+compactLE :: (MonadIO m, Unbox a)+    => Int -> Stream m (Array a) -> Stream m (Array a)+compactLE n stream =+    D.map unsafeFreeze $ MA.compactLE n $ D.map unsafeThaw stream++-- | Pinned version of 'compactLE'.+{-# INLINE_NORMAL pinnedCompactLE #-}+pinnedCompactLE :: (MonadIO m, Unbox a)+    => Int -> Stream m (Array a) -> Stream m (Array a)+pinnedCompactLE n stream =+    D.map unsafeFreeze $ MA.pinnedCompactLE n $ D.map unsafeThaw stream++-- | 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.+--+{-# INLINE compactOnByte #-}+compactOnByte+    :: (MonadIO m)+    => Word8+    -> Stream m (Array Word8)+    -> Stream m (Array Word8)+compactOnByte byte =+    fmap unsafeFreeze . MA.compactOnByte byte . fmap unsafeThaw++-- | Like 'compactOnByte' considers the separator in suffix position instead of+-- infix position.+{-# INLINE compactOnByteSuffix #-}+compactOnByteSuffix+    :: (MonadIO m)+    => Word8+    -> Stream m (Array Word8)+    -> Stream m (Array Word8)+compactOnByteSuffix byte =+    fmap unsafeFreeze . MA.compactOnByteSuffix byte . fmap unsafeThaw++-------------------------------------------------------------------------------+-- Folding Streams of Arrays+-------------------------------------------------------------------------------++-- XXX This should not be used for breaking a stream as the D.cons used in+-- reconstructing the stream could be very bad for performance. This can only+-- be useful in folding without breaking.+{-# INLINE_NORMAL foldBreakChunks #-}+foldBreakChunks :: forall m a b. (MonadIO m, Unbox a) =>+    Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))+foldBreakChunks (Fold fstep initial _ final) stream@(Stream step state) = do+    res <- initial+    case res of+        Fold.Partial fs -> go SPEC state fs+        Fold.Done fb -> return $! (fb, stream)++    where++    {-# INLINE go #-}+    go !_ st !fs = do+        r <- step defState st+        case r of+            Stream.Yield (Array contents start end) s ->+                let fp = Tuple' end contents+                 in goArray SPEC s fp start fs+            Stream.Skip s -> go SPEC s fs+            Stream.Stop -> do+                b <- final fs+                return (b, D.nil)++    goArray !_ s (Tuple' end _) !cur !fs+        | cur == end = do+            go SPEC s fs+    goArray !_ st fp@(Tuple' end contents) !cur !fs = do+        x <- liftIO $ peekAt cur contents+        res <- fstep fs x+        let next = INDEX_NEXT(cur,a)+        case res of+            Fold.Done b -> do+                let arr = Array contents next end+                return $! (b, D.cons arr (D.Stream step st))+            Fold.Partial fs1 -> goArray SPEC st fp next fs1++-- This may be more robust wrt fusion compared to unfoldMany?++-- | Fold a stream of arrays using a 'Fold'. This is equivalent to the+-- following:+--+-- >>> foldChunks f = Stream.fold f . Stream.unfoldMany Array.reader+--+foldChunks :: (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m b+foldChunks f s = fmap fst (foldBreakChunks f s)+-- foldStream f = Stream.fold f . Stream.unfoldMany reader++-- | Fold a stream of arrays using a 'Fold' and return the remaining stream.+--+-- The following alternative to this function allows composing the fold using+-- the parser Monad:+--+-- @+-- foldBreakStreamK f s =+--       fmap (first (fromRight undefined))+--     $ StreamK.parseBreakChunks (ParserK.adaptC (Parser.fromFold f)) s+-- @+--+-- We can compare perf and remove this one or define it in terms of that.+--+foldBreakChunksK :: forall m a b. (MonadIO m, Unbox a) =>+    Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a))+{-+foldBreakChunksK f s =+      fmap (first (fromRight undefined))+    $ StreamK.parseBreakChunks (ParserK.adaptC (Parser.fromFold f)) s+-}+foldBreakChunksK (Fold fstep initial _ final) stream = do+    res <- initial+    case res of+        Fold.Partial fs -> go fs stream+        Fold.Done fb -> return (fb, stream)++    where++    {-# INLINE go #-}+    go !fs st = do+        let stop = (, StreamK.nil) <$> final fs+            single a = yieldk a StreamK.nil+            yieldk (Array contents start end) r =+                let fp = Tuple' end contents+                 in goArray fs r fp start+         in StreamK.foldStream defState yieldk single stop st++    goArray !fs st (Tuple' end _) !cur+        | cur == end = do+            go fs st+    goArray !fs st fp@(Tuple' end contents) !cur = do+        x <- liftIO $ peekAt cur contents+        res <- fstep fs x+        let next = INDEX_NEXT(cur,a)+        case res of+            Fold.Done b -> do+                let arr = Array contents next end+                return $! (b, StreamK.cons arr st)+            Fold.Partial fs1 -> goArray fs1 st fp next++{-+-- This can be generalized to any type provided it can be unfolded to a stream+-- and it can be combined using a semigroup operation.+--+{-# INLINE_NORMAL parseBreakD #-}+parseBreakD ::+       forall m a b. (MonadIO m, MonadThrow m, Unbox a)+    => PRD.Parser a m b+    -> D.Stream m (Array.Array a)+    -> m (b, D.Stream m (Array.Array a))+parseBreakD+    (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do++    res <- initial+    case res of+        PRD.IPartial s -> go SPEC state (List []) s+        PRD.IDone b -> return (b, stream)+        PRD.IError err -> throwM $ ParseError err++    where++    -- "backBuf" contains last few items in the stream that we may have to+    -- backtrack to.+    --+    -- XXX currently we are using a dumb list based approach for backtracking+    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.+    -- That will allow us more efficient random back and forth movement.+    go !_ st backBuf !pst = do+        r <- step defState st+        case r of+            D.Yield (Array contents start end) s ->+                gobuf SPEC s backBuf+                    (Tuple' end contents) start pst+            D.Skip s -> go SPEC s backBuf pst+            D.Stop -> do+                b <- extract pst+                return (b, D.nil)++    -- Use strictness on "cur" to keep it unboxed+    gobuf !_ s backBuf (Tuple' end _) !cur !pst+        | cur == end = do+            go SPEC s backBuf pst+    gobuf !_ s backBuf fp@(Tuple' end contents) !cur !pst = do+        x <- liftIO $ peekByteIndex contents cur+        pRes <- pstep pst x+        let next = INDEX_NEXT(cur,a)+        case pRes of+            PR.Partial 0 pst1 ->+                 gobuf SPEC s (List []) fp next pst1+            PR.Partial n pst1 -> do+                assert (n <= Prelude.length (x:getList backBuf)) (return ())+                let src0 = Prelude.take n (x:getList backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                let !(Array cont1 start end1) = src+                    fp1 = Tuple' end1 cont1+                gobuf SPEC s (List []) fp1 start pst1+            PR.Continue 0 pst1 ->+                gobuf SPEC s (List (x:getList backBuf)) fp next pst1+            PR.Continue n pst1 -> do+                assert (n <= Prelude.length (x:getList backBuf)) (return ())+                let (src0, buf1) = splitAt n (x:getList backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                let !(Array cont1 start end1) = src+                    fp1 = Tuple' end1 cont1+                gobuf SPEC s (List buf1) fp1 start pst1+            PR.Done 0 b -> do+                let arr = Array contents next end+                return (b, D.cons arr (D.Stream step s))+            PR.Done n b -> do+                assert (n <= Prelude.length (x:getList backBuf)) (return ())+                let src0 = Prelude.take n (x:getList backBuf)+                    -- XXX create the array in reverse instead+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    -- XXX Use StreamK to avoid adding arbitrary layers of+                    -- constructors every time.+                    str = D.cons arr0 (D.cons arr1 (D.Stream step s))+                return (b, str)+            PR.Error err -> throwM $ ParseError err+-}++-- | Parse an array stream using the supplied 'Parser'.  Returns the parse+-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.+--+-- The following alternative to this function allows composing the parser using+-- the parser Monad:+--+-- >>> parseBreakStreamK p = StreamK.parseBreakChunks (ParserK.adaptC p)+--+-- We can compare perf and remove this one or define it in terms of that.+--+-- /Internal/+--+{-# INLINE_NORMAL parseBreakChunksK #-}+parseBreakChunksK ::+       forall m a b. (MonadIO m, Unbox a)+    => Parser a m b+    -> StreamK m (Array a)+    -> m (Either ParseError b, StreamK m (Array a))+-- parseBreakStreamK p = StreamK.parseBreakChunks (ParserK.adaptC p)+parseBreakChunksK (Parser pstep initial extract) stream = do+    res <- initial+    case res of+        IPartial s -> go s stream []+        IDone b -> return (Right b, stream)+        IError err -> return (Left (ParseError err), stream)++    where++    -- "backBuf" contains last few items in the stream that we may have to+    -- backtrack to.+    --+    -- XXX currently we are using a dumb list based approach for backtracking+    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.+    -- That will allow us more efficient random back and forth movement.+    go !pst st backBuf = do+        let stop = goStop pst backBuf -- (, K.nil) <$> extract pst+            single a = yieldk a StreamK.nil+            yieldk arr r = goArray pst backBuf r arr+         in StreamK.foldStream defState yieldk single stop st++    -- Use strictness on "cur" to keep it unboxed+    goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf+    goArray !pst backBuf st (Array contents cur end) = do+        x <- liftIO $ peekAt cur contents+        pRes <- pstep pst x+        let next = INDEX_NEXT(cur,a)+        case pRes of+            Parser.Partial 0 s ->+                 goArray s [] st (Array contents next end)+            Parser.Partial n s -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let src0 = Prelude.take n (x:backBuf)+                    arr0 = fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                goArray s [] st src+            Parser.Continue 0 s ->+                goArray s (x:backBuf) st (Array contents next end)+            Parser.Continue n s -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let (src0, buf1) = Prelude.splitAt n (x:backBuf)+                    arr0 = fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                goArray s buf1 st src+            Parser.Done 0 b -> do+                let arr = Array contents next end+                return (Right b, StreamK.cons arr st)+            Parser.Done n b -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let src0 = Prelude.take n (x:backBuf)+                    -- XXX Use fromListRevN once implemented+                    -- arr0 = A.fromListRevN n src0+                    arr0 = fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    str = StreamK.cons arr0 (StreamK.cons arr1 st)+                return (Right b, str)+            Parser.Error err -> do+                let n = Prelude.length backBuf+                    arr0 = fromListN n (Prelude.reverse backBuf)+                    arr1 = Array contents cur end+                    str = StreamK.cons arr0 (StreamK.cons arr1 stream)+                return (Left (ParseError err), str)++    -- This is a simplified goArray+    goExtract !pst backBuf (Array _ cur end)+        | cur == end = goStop pst backBuf+    goExtract !pst backBuf (Array contents cur end) = do+        x <- liftIO $ peekAt cur contents+        pRes <- pstep pst x+        let next = INDEX_NEXT(cur,a)+        case pRes of+            Parser.Partial 0 s ->+                 goExtract s [] (Array contents next end)+            Parser.Partial n s -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let src0 = Prelude.take n (x:backBuf)+                    arr0 = fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                goExtract s [] src+            Parser.Continue 0 s ->+                goExtract s backBuf (Array contents next end)+            Parser.Continue n s -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let (src0, buf1) = Prelude.splitAt n (x:backBuf)+                    arr0 = fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                goExtract s buf1 src+            Parser.Done 0 b -> do+                let arr = Array contents next end+                return (Right b, StreamK.fromPure arr)+            Parser.Done n b -> do+                assert (n <= Prelude.length backBuf) (return ())+                let src0 = Prelude.take n backBuf+                    -- XXX Use fromListRevN once implemented+                    -- arr0 = A.fromListRevN n src0+                    arr0 = fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    str = StreamK.cons arr0 (StreamK.fromPure arr1)+                return (Right b, str)+            Parser.Error err -> do+                let n = Prelude.length backBuf+                    arr0 = fromListN n (Prelude.reverse backBuf)+                    arr1 = Array contents cur end+                    str = StreamK.cons arr0 (StreamK.cons arr1 stream)+                return (Left (ParseError err), str)++    -- This is a simplified goExtract+    {-# INLINE goStop #-}+    goStop !pst backBuf = do+        pRes <- extract pst+        case pRes of+            Parser.Partial _ _ -> error "Bug: parseBreak: Partial in extract"+            Parser.Continue 0 s ->+                goStop s backBuf+            Parser.Continue n s -> do+                assert (n <= Prelude.length backBuf) (return ())+                let (src0, buf1) = Prelude.splitAt n backBuf+                    arr = fromListN n (Prelude.reverse src0)+                goExtract s buf1 arr+            Parser.Done 0 b ->+                return (Right b, StreamK.nil)+            Parser.Done n b -> do+                assert (n <= Prelude.length backBuf) (return ())+                let src0 = Prelude.take n backBuf+                    -- XXX Use fromListRevN once implemented+                    -- arr0 = A.fromListRevN n src0+                    arr0 = fromListN n (Prelude.reverse src0)+                return (Right b, StreamK.fromPure arr0)+            Parser.Error err -> do+                let n = Prelude.length backBuf+                    arr0 = fromListN n (Prelude.reverse backBuf)+                return (Left (ParseError err), StreamK.fromPure arr0)
src/Streamly/Internal/Data/Array/Generic.hs view
@@ -11,8 +11,8 @@      -- * Construction     , nil-    , writeN-    , write+    , createOf+    , create     , writeWith     , writeLastN @@ -44,6 +44,10 @@     , getIndex     , getSliceUnsafe     , strip++    -- * Deprecated+    , writeN+    , write     ) where @@ -104,21 +108,33 @@ -- Construction - Folds ------------------------------------------------------------------------------- -{-# INLINE_NORMAL writeN #-}+{-# INLINE_NORMAL createOf #-}+createOf :: MonadIO m => Int -> Fold m a (Array a)+createOf = fmap unsafeFreeze <$> MArray.createOf++-- XXX Deprecate in major+-- {-# DEPRECATED writeN "Please use createOf instead." #-}+{-# INLINE writeN #-} writeN :: MonadIO m => Int -> Fold m a (Array a)-writeN = fmap unsafeFreeze <$> MArray.writeN+writeN = createOf  {-# INLINE_NORMAL writeWith #-} writeWith :: MonadIO m => Int -> Fold m a (Array a)-writeWith elemCount = unsafeFreeze <$> MArray.writeWith elemCount+writeWith elemCount = unsafeFreeze <$> MArray.createWith elemCount  -- | Fold the whole input to a single array. -- -- /Caution! Do not use this on infinite streams./ --+{-# INLINE create #-}+create :: MonadIO m => Fold m a (Array a)+create = fmap unsafeFreeze MArray.create++-- XXX Deprecate in major+-- {-# DEPRECATED write "Please use create instead." #-} {-# INLINE write #-} write :: MonadIO m => Fold m a (Array a)-write = fmap unsafeFreeze MArray.write+write = create  fromPureStream :: Stream Identity a -> Array a fromPureStream x =
src/Streamly/Internal/Data/Array/Stream.hs view
@@ -12,6 +12,7 @@ -- keep this as a separate module and release it. -- module Streamly.Internal.Data.Array.Stream+{-# DEPRECATED "Please use \"Streamly.Internal.Data.Array\" instead." #-}     (     -- * Creation       Array.chunksOf@@ -19,13 +20,13 @@     , Array.bufferChunks      -- * Flattening to elements-    , concat+    , Array.concat     , Array.flattenArrays-    , concatRev+    , Array.concatRev     , Array.flattenArraysRev-    , interpose-    , interposeSuffix-    , intercalateSuffix+    , Array.interpose+    , Array.interposeSuffix+    , Array.intercalateSuffix     , unlines      -- * Elimination@@ -36,10 +37,11 @@     -- could also be implemented using parseBreak.     , foldBreak     , foldBreakD-    -- The byte level parseBreak cannot work efficiently. Because the stream-    -- will have to be a StreamK for backtracking, StreamK at byte level would-    -- not be efficient.-    , parseBreak -- StreamK.parseBreakChunks+    -- This is chunked parseBreak. A byte level parseBreak cannot work+    -- efficiently. Because the stream will have to be a StreamK for+    -- backtracking, StreamK at byte level would not be efficient.+    -- parseBreak p = K.parseBreakChunks (ParserK.adaptC p)+    , parseBreak     -- , parseBreakD     -- , foldManyChunks     -- , parseManyChunks@@ -77,6 +79,8 @@ import Data.Bifunctor (second) import Control.Exception (assert) import Control.Monad.IO.Class (MonadIO(..))+-- import Data.Bifunctor (first)+-- import Data.Either (fromRight) import Data.Proxy (Proxy(..)) import Data.Word (Word8) import Streamly.Internal.Data.Unbox (Unbox(..))@@ -92,17 +96,13 @@ import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.StreamK (StreamK, fromStream, toStream) import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) -import qualified Streamly.Data.Fold as FL import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.MutArray.Type as MA-import qualified Streamly.Internal.Data.MutArray.Stream as AS-import qualified Streamly.Internal.Data.Fold.Type as FL (Fold(..), Step(..)) import qualified Streamly.Internal.Data.Parser as PR import qualified Streamly.Internal.Data.Parser as PRD     (Parser(..), Initial(..))+-- import qualified Streamly.Internal.Data.ParserK as ParserK import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.StreamK as K @@ -110,109 +110,18 @@ -- most places.  ---------------------------------------------------------------------------------- Append------------------------------------------------------------------------------------ XXX efficiently compare two streams of arrays. Two streams can have chunks--- of different sizes, we can handle that in the stream comparison abstraction.--- This could be useful e.g. to fast compare whether two files differ.---- | Convert a stream of arrays into a stream of their elements.------ Same as the following:------ > concat = Stream.unfoldMany Array.read------ @since 0.7.0-{-# INLINE concat #-}-concat :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a--- concat m = fromStreamD $ A.flattenArrays (toStreamD m)--- concat m = fromStreamD $ D.concatMap A.toStreamD (toStreamD m)-concat = D.unfoldMany A.reader---- | Convert a stream of arrays into a stream of their elements reversing the--- contents of each array before flattening.------ > concatRev = Stream.unfoldMany Array.readerRev------ @since 0.7.0-{-# INLINE concatRev #-}-concatRev :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a--- concatRev m = fromStreamD $ A.flattenArraysRev (toStreamD m)-concatRev = D.unfoldMany A.readerRev--------------------------------------------------------------------------------- -- Intersperse and append ------------------------------------------------------------------------------- --- | Flatten a stream of arrays after inserting the given element between--- arrays.------ /Pre-release/-{-# INLINE interpose #-}-interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a-interpose x = D.interpose x A.reader--{-# INLINE intercalateSuffix #-}-intercalateSuffix :: (Monad m, Unbox a)-    => Array a -> Stream m (Array a) -> Stream m a-intercalateSuffix = D.intercalateSuffix A.reader---- | Flatten a stream of arrays appending the given element after each--- array.------ @since 0.7.0-{-# INLINE interposeSuffix #-}-interposeSuffix :: (Monad m, Unbox a)-    => a -> Stream m (Array a) -> Stream m a--- interposeSuffix x = fromStreamD . A.unlines x . toStreamD-interposeSuffix x = D.interposeSuffix x A.reader--data FlattenState s =-      OuterLoop s-    | InnerLoop s !MA.MutableByteArray !Int !Int---- XXX This is a special case of interposeSuffix, can be removed.--- XXX Remove monadIO constraint {-# INLINE_NORMAL unlines #-} unlines :: forall m a. (MonadIO m, Unbox a)     => a -> D.Stream m (Array a) -> D.Stream m a-unlines sep (D.Stream step state) = D.Stream step' (OuterLoop state)-    where-    {-# INLINE_LATE step' #-}-    step' gst (OuterLoop st) = do-        r <- step (adaptState gst) st-        return $ case r of-            D.Yield Array{..} s ->-                D.Skip (InnerLoop s arrContents arrStart arrEnd)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ p end) | p == end =-        return $ D.Yield sep $ OuterLoop st--    step' _ (InnerLoop st contents p end) = do-        x <- liftIO $ peekByteIndex p contents-        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)+unlines = Array.interposeSuffix  ------------------------------------------------------------------------------- -- Compact ------------------------------------------------------------------------------- --- XXX These would not be needed once we implement compactLEFold, see--- module Streamly.Internal.Data.Stream.MutChunked------ XXX Note that this thaws immutable arrays for appending, that may be--- problematic if multiple users do the same thing, however, immutable arrays--- would usually have no capacity to append, therefore, a copy will be forced--- anyway. Confirm this. We can forcefully trim the array capacity before thaw--- to ensure this.-{-# INLINE_NORMAL packArraysChunksOf #-}-packArraysChunksOf :: (MonadIO m, Unbox a)-    => Int -> D.Stream m (Array a) -> D.Stream m (Array a)-packArraysChunksOf n str =-    D.map A.unsafeFreeze $ AS.packArraysChunksOf n $ D.map A.unsafeThaw str- -- XXX instead of writing two different versions of this operation, we should -- write it as a pipe. --@@ -220,8 +129,7 @@ {-# INLINE_NORMAL lpackArraysChunksOf #-} lpackArraysChunksOf :: (MonadIO m, Unbox a)     => Int -> Fold m (Array a) () -> Fold m (Array a) ()-lpackArraysChunksOf n fld =-    FL.lmap A.unsafeThaw $ AS.lpackArraysChunksOf n (FL.lmap A.unsafeFreeze fld)+lpackArraysChunksOf = Array.lCompactGE  -- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a -- maximum specified size in bytes.@@ -230,68 +138,19 @@ {-# INLINE compact #-} compact :: (MonadIO m, Unbox a)     => Int -> Stream m (Array a) -> Stream m (Array a)-compact = packArraysChunksOf------------------------------------------------------------------------------------ Split----------------------------------------------------------------------------------data SplitState s arr-    = Initial s-    | Buffering s arr-    | Splitting s arr-    | Yielding arr (SplitState s arr)-    | Finishing+compact = Array.compactLE --- | 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.+-- | Given a stream of arrays, splice them all together to generate a single+-- array. The stream must be /finite/. -- -- @since 0.7.0-{-# INLINE_NORMAL _splitOn #-}-_splitOn-    :: MonadIO m-    => Word8-    -> D.Stream m (Array Word8)-    -> D.Stream m (Array Word8)-_splitOn byte (D.Stream step state) = D.Stream step' (Initial state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (Initial st) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                (arr1, marr2) <- A.breakOn byte arr-                return $ case marr2 of-                    Nothing   -> D.Skip (Buffering s arr1)-                    Just arr2 -> D.Skip (Yielding arr1 (Splitting s arr2))-            D.Skip s -> return $ D.Skip (Initial s)-            D.Stop -> return D.Stop--    step' gst (Buffering st buf) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                (arr1, marr2) <- A.breakOn byte arr-                buf' <- A.splice buf arr1-                return $ case marr2 of-                    Nothing -> D.Skip (Buffering s buf')-                    Just x -> D.Skip (Yielding buf' (Splitting s x))-            D.Skip s -> return $ D.Skip (Buffering s buf)-            D.Stop -> return $-                if A.byteLength buf == 0-                then D.Stop-                else D.Skip (Yielding buf Finishing)--    step' _ (Splitting st buf) = do-        (arr1, marr2) <- A.breakOn byte buf-        return $ case marr2 of-                Nothing -> D.Skip $ Buffering st arr1-                Just arr2 -> D.Skip $ Yielding arr1 (Splitting st arr2)+{-# INLINE toArray #-}+toArray :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)+toArray = Array.fromChunks -    step' _ (Yielding arr next) = return $ D.Yield arr next-    step' _ Finishing = return D.Stop+-------------------------------------------------------------------------------+-- Split+-------------------------------------------------------------------------------  -- XXX Remove MonadIO constraint. -- | Split a stream of arrays on a given separator byte, dropping the separator@@ -304,7 +163,7 @@     => Word8     -> Stream m (Array Word8)     -> Stream m (Array Word8)-splitOn byte = D.splitInnerBy (A.breakOn byte) A.splice+splitOn = Array.compactOnByte  {-# INLINE splitOnSuffix #-} splitOnSuffix@@ -312,8 +171,7 @@     => Word8     -> Stream m (Array Word8)     -> Stream m (Array Word8)--- splitOn byte s = fromStreamD $ A.splitOn byte $ toStreamD s-splitOnSuffix byte = D.splitInnerBySuffix (A.breakOn byte) A.splice+splitOnSuffix = Array.compactOnByteSuffix  ------------------------------------------------------------------------------- -- Elimination - Running folds@@ -322,77 +180,24 @@ {-# INLINE_NORMAL foldBreakD #-} foldBreakD :: forall m a b. (MonadIO m, Unbox a) =>     Fold m a b -> D.Stream m (Array a) -> m (b, D.Stream m (Array a))-foldBreakD (FL.Fold fstep initial _ final) stream@(D.Stream step state) = do-    res <- initial-    case res of-        FL.Partial fs -> go SPEC state fs-        FL.Done fb -> return $! (fb, stream)--    where--    {-# INLINE go #-}-    go !_ st !fs = do-        r <- step defState st-        case r of-            D.Yield (Array contents start end) s ->-                let fp = Tuple' end contents-                 in goArray SPEC s fp start fs-            D.Skip s -> go SPEC s fs-            D.Stop -> do-                b <- final fs-                return (b, D.nil)--    goArray !_ s (Tuple' end _) !cur !fs-        | cur == end = do-            go SPEC s fs-    goArray !_ st fp@(Tuple' end contents) !cur !fs = do-        x <- liftIO $ peekByteIndex cur contents-        res <- fstep fs x-        let next = INDEX_NEXT(cur,a)-        case res of-            FL.Done b -> do-                let arr = Array contents next end-                return $! (b, D.cons arr (D.Stream step st))-            FL.Partial fs1 -> goArray SPEC st fp next fs1--{-# INLINE_NORMAL foldBreakK #-}-foldBreakK :: forall m a b. (MonadIO m, Unbox a) =>-    Fold m a b -> K.StreamK m (Array a) -> m (b, K.StreamK m (Array a))-foldBreakK (FL.Fold fstep initial _ final) stream = do-    res <- initial-    case res of-        FL.Partial fs -> go fs stream-        FL.Done fb -> return (fb, stream)--    where--    {-# INLINE go #-}-    go !fs st = do-        let stop = (, K.nil) <$> final fs-            single a = yieldk a K.nil-            yieldk (Array contents start end) r =-                let fp = Tuple' end contents-                 in goArray fs r fp start-         in K.foldStream defState yieldk single stop st--    goArray !fs st (Tuple' end _) !cur-        | cur == end = do-            go fs st-    goArray !fs st fp@(Tuple' end contents) !cur = do-        x <- liftIO $ peekByteIndex cur contents-        res <- fstep fs x-        let next = INDEX_NEXT(cur,a)-        case res of-            FL.Done b -> do-                let arr = Array contents next end-                return $! (b, K.cons arr st)-            FL.Partial fs1 -> goArray fs1 st fp next+foldBreakD = Array.foldBreakChunks  -- | Fold an array stream using the supplied 'Fold'. Returns the fold result -- and the unconsumed stream. -- -- > foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f) --+-- Instead of using this we can adapt the fold to ParserK and use+-- parseBreakChunks instead. ParserK allows composing using Monad as well.+--+-- @+-- foldBreak f s =+--       fmap (first (fromRight undefined))+--     $ K.parseBreakChunks (ParserK.adaptC (PR.fromFold f)) s+-- @+--+-- We can compare perf and remove this one or define it in terms of that.+-- -- /Internal/ -- {-# INLINE_NORMAL foldBreak #-}@@ -401,14 +206,20 @@     => Fold m a b     -> StreamK m (A.Array a)     -> m (b, StreamK m (A.Array a))+foldBreak = Array.foldBreakChunksK+-- -- foldBreak f s = fmap fromStreamD <$> foldBreakD f (toStreamD s)-foldBreak = foldBreakK+--+-- foldBreak f s =+--       fmap (first (fromRight undefined))+--     $ K.parseBreakChunks (ParserK.adaptC (PR.fromFold f)) s+-- -- If foldBreak performs better than runArrayFoldBreak we can use a rewrite -- rule to rewrite runArrayFoldBreak to fold. -- foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f)  ---------------------------------------------------------------------------------- Fold to a single Array+-- Elimination - running element parsers -------------------------------------------------------------------------------  -- When we have to take an array partially, take the last part of the array.@@ -454,341 +265,22 @@                          arr1 = Array contents end1 end                       in ([arr1], arr2:xs) ----------------------------------------------------------------------------------- Fold to a single Array----------------------------------------------------------------------------------{----- XXX Both of these implementations of splicing seem to perform equally well.--- We need to perform benchmarks over a range of sizes though.---- CAUTION! length must more than equal to lengths of all the arrays in the--- stream.-{-# INLINE spliceArraysLenUnsafe #-}-spliceArraysLenUnsafe :: (MonadIO m, Unbox a)-    => Int -> Stream m (MutArray a) -> m (MutArray a)-spliceArraysLenUnsafe len buffered = do-    -- XXX The new array's pinned state should depend on the first element-    -- of the stream. We should uncons the stream and do the required.-    arr <- undefined-    D.foldlM' MA.spliceUnsafe (return arr) buffered--{-# INLINE _spliceArrays #-}-_spliceArrays :: (MonadIO m, Unbox a)-    => Stream m (Array a) -> m (Array a)-_spliceArrays s = do-    buffered <- D.foldr K.cons K.nil s-    len <- K.fold FL.sum (fmap Array.length buffered)-    -- XXX The new array's pinned state should depend on the first element-    -- of the stream. We should uncons the stream and do the required.-    arr <- undefined-    final <- D.foldlM' writeArr (return arr) (toStream buffered)-    return $ A.unsafeFreeze final--    where--    writeArr dst arr = MA.spliceUnsafe dst (A.unsafeThaw arr)--{-# INLINE _spliceArraysBuffered #-}-_spliceArraysBuffered :: (MonadIO m, Unbox a)-    => Stream m (Array a) -> m (Array a)-_spliceArraysBuffered s = do-    buffered <- D.foldr K.cons K.nil s-    len <- K.fold FL.sum (fmap Array.length buffered)-    A.unsafeFreeze <$>-        spliceArraysLenUnsafe len (fmap A.unsafeThaw (toStream buffered))---}--{-# INLINE spliceArraysRealloced #-}-spliceArraysRealloced :: forall m a. (MonadIO m, Unbox a)-    => Stream m (Array a) -> m (Array a)-spliceArraysRealloced s = do-    res <- D.uncons s-    case res of-        Just (a, strm) -> do-            arr <--                D.foldlM'-                    MA.spliceExp-                    (pure (A.unsafeThaw a))-                    (fmap A.unsafeThaw strm)-            liftIO $ A.unsafeFreeze <$> MA.rightSize arr-        Nothing -> pure A.nil---- XXX This should just be "fold A.write"------ | Given a stream of arrays, splice them all together to generate a single--- array. The stream must be /finite/.------ @since 0.7.0-{-# INLINE toArray #-}-toArray :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)-toArray = spliceArraysRealloced--- spliceArrays = _spliceArraysBuffered---- exponentially increasing sizes of the chunks upto the max limit.--- XXX this will be easier to implement with parsers/terminating folds--- With this we should be able to reduce the number of chunks/allocations.--- The reallocation/copy based toArray can also be implemented using this.----{--{-# INLINE toArraysInRange #-}-toArraysInRange :: (MonadIO m, Unbox a)-    => Int -> Int -> Fold m (Array a) b -> Fold m a b-toArraysInRange low high (Fold step initial extract) =--}--{---- | Fold the input to a pure buffered stream (List) of arrays.-{-# INLINE _toArraysOf #-}-_toArraysOf :: (MonadIO m, Unbox a)-    => Int -> Fold m a (Stream Identity (Array a))-_toArraysOf n = FL.groupsOf n (A.writeNF n) FL.toStream--}------------------------------------------------------------------------------------ Elimination - running element parsers--------------------------------------------------------------------------------- -- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need -- to make a newtype. {-# ANN type List NoSpecConstr #-} newtype List a = List {getList :: [a]} -{---- This can be generalized to any type provided it can be unfolded to a stream--- and it can be combined using a semigroup operation.------ XXX This should be written using CPS (as parseK) if we want it to scale wrt--- to the number of times it can be called on the same stream.-{-# INLINE_NORMAL parseBreakD #-}-parseBreakD ::-       forall m a b. (MonadIO m, MonadThrow m, Unbox a)-    => PRD.Parser a m b-    -> D.Stream m (Array.Array a)-    -> m (b, D.Stream m (Array.Array a))-parseBreakD-    (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do--    res <- initial-    case res of-        PRD.IPartial s -> go SPEC state (List []) s-        PRD.IDone b -> return (b, stream)-        PRD.IError err -> throwM $ ParseError err--    where--    -- "backBuf" contains last few items in the stream that we may have to-    -- backtrack to.-    ---    -- XXX currently we are using a dumb list based approach for backtracking-    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.-    -- That will allow us more efficient random back and forth movement.-    go !_ st backBuf !pst = do-        r <- step defState st-        case r of-            D.Yield (Array contents start end) s ->-                gobuf SPEC s backBuf-                    (Tuple' end contents) start pst-            D.Skip s -> go SPEC s backBuf pst-            D.Stop -> do-                b <- extract pst-                return (b, D.nil)--    -- Use strictness on "cur" to keep it unboxed-    gobuf !_ s backBuf (Tuple' end _) !cur !pst-        | cur == end = do-            go SPEC s backBuf pst-    gobuf !_ s backBuf fp@(Tuple' end contents) !cur !pst = do-        x <- liftIO $ peekByteIndex contents cur-        pRes <- pstep pst x-        let next = INDEX_NEXT(cur,a)-        case pRes of-            PR.Partial 0 pst1 ->-                 gobuf SPEC s (List []) fp next pst1-            PR.Partial n pst1 -> do-                assert (n <= Prelude.length (x:getList backBuf)) (return ())-                let src0 = Prelude.take n (x:getList backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                let !(Array cont1 start end1) = src-                    fp1 = Tuple' end1 cont1-                gobuf SPEC s (List []) fp1 start pst1-            PR.Continue 0 pst1 ->-                gobuf SPEC s (List (x:getList backBuf)) fp next pst1-            PR.Continue n pst1 -> do-                assert (n <= Prelude.length (x:getList backBuf)) (return ())-                let (src0, buf1) = splitAt n (x:getList backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                let !(Array cont1 start end1) = src-                    fp1 = Tuple' end1 cont1-                gobuf SPEC s (List buf1) fp1 start pst1-            PR.Done 0 b -> do-                let arr = Array contents next end-                return (b, D.cons arr (D.Stream step s))-            PR.Done n b -> do-                assert (n <= Prelude.length (x:getList backBuf)) (return ())-                let src0 = Prelude.take n (x:getList backBuf)-                    -- XXX create the array in reverse instead-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    -- XXX Use StreamK to avoid adding arbitrary layers of-                    -- constructors every time.-                    str = D.cons arr0 (D.cons arr1 (D.Stream step s))-                return (b, str)-            PR.Error err -> throwM $ ParseError err--}--{-# INLINE_NORMAL parseBreakK #-}-parseBreakK ::-       forall m a b. (MonadIO m, Unbox a)-    => PRD.Parser a m b-    -> K.StreamK m (Array.Array a)-    -> m (Either ParseError b, K.StreamK m (Array.Array a))-parseBreakK (PRD.Parser pstep initial extract) stream = do-    res <- initial-    case res of-        PRD.IPartial s -> go s stream []-        PRD.IDone b -> return (Right b, stream)-        PRD.IError err -> return (Left (ParseError err), stream)--    where--    -- "backBuf" contains last few items in the stream that we may have to-    -- backtrack to.-    ---    -- XXX currently we are using a dumb list based approach for backtracking-    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.-    -- That will allow us more efficient random back and forth movement.-    go !pst st backBuf = do-        let stop = goStop pst backBuf -- (, K.nil) <$> extract pst-            single a = yieldk a K.nil-            yieldk arr r = goArray pst backBuf r arr-         in K.foldStream defState yieldk single stop st--    -- Use strictness on "cur" to keep it unboxed-    goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf-    goArray !pst backBuf st (Array contents cur end) = do-        x <- liftIO $ peekByteIndex cur contents-        pRes <- pstep pst x-        let next = INDEX_NEXT(cur,a)-        case pRes of-            PR.Partial 0 s ->-                 goArray s [] st (Array contents next end)-            PR.Partial n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let src0 = Prelude.take n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goArray s [] st src-            PR.Continue 0 s ->-                goArray s (x:backBuf) st (Array contents next end)-            PR.Continue n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let (src0, buf1) = splitAt n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goArray s buf1 st src-            PR.Done 0 b -> do-                let arr = Array contents next end-                return (Right b, K.cons arr st)-            PR.Done n b -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let src0 = Prelude.take n (x:backBuf)-                    -- XXX Use fromListRevN once implemented-                    -- arr0 = A.fromListRevN n src0-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    str = K.cons arr0 (K.cons arr1 st)-                return (Right b, str)-            PR.Error err -> do-                let n = Prelude.length backBuf-                    arr0 = A.fromListN n (Prelude.reverse backBuf)-                    arr1 = Array contents cur end-                    str = K.cons arr0 (K.cons arr1 stream)-                return (Left (ParseError err), str)--    -- This is a simplified goArray-    goExtract !pst backBuf (Array _ cur end)-        | cur == end = goStop pst backBuf-    goExtract !pst backBuf (Array contents cur end) = do-        x <- liftIO $ peekByteIndex cur contents-        pRes <- pstep pst x-        let next = INDEX_NEXT(cur,a)-        case pRes of-            PR.Partial 0 s ->-                 goExtract s [] (Array contents next end)-            PR.Partial n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let src0 = Prelude.take n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goExtract s [] src-            PR.Continue 0 s ->-                goExtract s backBuf (Array contents next end)-            PR.Continue n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let (src0, buf1) = splitAt n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goExtract s buf1 src-            PR.Done 0 b -> do-                let arr = Array contents next end-                return (Right b, K.fromPure arr)-            PR.Done n b -> do-                assert (n <= Prelude.length backBuf) (return ())-                let src0 = Prelude.take n backBuf-                    -- XXX Use fromListRevN once implemented-                    -- arr0 = A.fromListRevN n src0-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    str = K.cons arr0 (K.fromPure arr1)-                return (Right b, str)-            PR.Error err -> do-                let n = Prelude.length backBuf-                    arr0 = A.fromListN n (Prelude.reverse backBuf)-                    arr1 = Array contents cur end-                    str = K.cons arr0 (K.cons arr1 stream)-                return (Left (ParseError err), str)--    -- This is a simplified goExtract-    {-# INLINE goStop #-}-    goStop !pst backBuf = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"-            PR.Continue 0 s ->-                goStop s backBuf-            PR.Continue n s -> do-                assert (n <= Prelude.length backBuf) (return ())-                let (src0, buf1) = splitAt n backBuf-                    arr = A.fromListN n (Prelude.reverse src0)-                goExtract s buf1 arr-            PR.Done 0 b ->-                return (Right b, K.nil)-            PR.Done n b -> do-                assert (n <= Prelude.length backBuf) (return ())-                let src0 = Prelude.take n backBuf-                    -- XXX Use fromListRevN once implemented-                    -- arr0 = A.fromListRevN n src0-                    arr0 = A.fromListN n (Prelude.reverse src0)-                return (Right b, K.fromPure arr0)-            PR.Error err -> do-                let n = Prelude.length backBuf-                    arr0 = A.fromListN n (Prelude.reverse backBuf)-                return (Left (ParseError err), K.fromPure arr0)- -- | Parse an array stream using the supplied 'Parser'.  Returns the parse -- result and the unconsumed stream. Throws 'ParseError' if the parse fails. --+-- >> parseBreak p = K.parseBreakChunks (ParserK.adaptC p)+--+-- This is redundant and we can just use parseBreakChunks, as ParserK can be+-- composed using Monad. The only advantage of this is that we do not need to+-- adapt.+--+-- We can compare perf and remove this one or define it in terms of that.+-- -- /Internal/ -- {-# INLINE_NORMAL parseBreak #-}@@ -801,7 +293,8 @@ parseBreak p s =     fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s) -}-parseBreak = parseBreakK+parseBreak = Array.parseBreakChunksK+-- parseBreak p = K.parseBreakChunks (ParserK.adaptC p)  ------------------------------------------------------------------------------- -- Elimination - Running Array Folds and parsers
src/Streamly/Internal/Data/Array/Type.hs view
@@ -2,7 +2,6 @@ -- | -- Module      : Streamly.Internal.Data.Array.Type -- Copyright   : (c) 2020 Composewell Technologies--- -- License     : BSD3-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental@@ -10,87 +9,146 @@ -- -- See notes in "Streamly.Internal.Data.MutArray.Type" --+ module Streamly.Internal.Data.Array.Type     (     -- ** Type     -- $arrayNotes       Array (..)-    , asPtrUnsafe-    , nil -    -- ** Freezing and Thawing+    -- ** Conversion+    -- *** Mutable and Immutable     , unsafeFreeze     , unsafeFreezeWithShrink     , unsafeThaw -    -- ** Pinning and Unpinning+    -- *** Pinned and Unpinned     , pin     , unpin     , isPinned +    -- *** Casting+    , unsafePinnedAsPtr+     -- ** Construction-    , splice+    , empty -    , fromList-    , pinnedFromList+    -- *** Cloning+    -- XXX Why would we clone an immutable array?+    , clone+    , pinnedClone++    -- *** Slicing+    -- | Get a subarray without copying+    , splitAt+    , breakOn -- XXX requires MonadIO++    -- *** Stream Folds+    , unsafeMakePure+    , createOf+    , pinnedCreateOf+    , unsafeCreateOf+    , unsafePinnedCreateOf+    , create+    , pinnedCreate+    , createWith++    -- *** From containers     , fromListN     , pinnedFromListN-    , fromListRev+    , fromList+    , pinnedFromList     , fromListRevN-    , fromStreamDN-    , fromStreamD+    , fromListRev+    , fromStreamN+    , fromStream+    , fromPureStreamN     , fromPureStream     , fromByteStr#+    , fromByteStr+    , fromPtrN+    , fromChunks+    , fromChunksK -    -- ** Split-    , breakOn+    -- ** Reading -    -- ** Cloning arrays-    , clone-    , pinnedClone+    -- *** Indexing+    , unsafeIndexIO -- XXX unsafeGetIndexIO+    , getIndexUnsafe -- XXX unsafeGetIndex -    -- ** Elimination-    , unsafeIndexIO-    , getIndexUnsafe-    , byteLength+    -- *** To Streams+    , read+    , readRev+    , toStreamK+    , toStreamKRev++    -- *** To Containers+    , toList++    -- *** Unfolds+    , producer -- experimental+    , readerUnsafe+    , reader+    , readerRev++    -- *** Size     , length+    , byteLength +    -- ** Folding     , foldl'     , foldr-    , splitAt+    , byteCmp+    , byteEq +    -- ** Appending+    , splice -- XXX requires MonadIO++    -- ** Streams of arrays+    -- *** Chunk+    -- | Group a stream into arrays.+    , chunksOf+    , pinnedChunksOf+    , buildChunks++    -- *** Split+    -- | Split an array into slices.++    -- *** Concat+    -- | Append the arrays in a stream to form a stream of elements.+    , concat+    , concatRev++    -- *** Compact+    -- | Append the arrays in a stream to form a stream of larger arrays.+    , fCompactGE+    , fPinnedCompactGE+    , lCompactGE+    , lPinnedCompactGE+    , compactGE++    -- ** Deprecated+    , asPtrUnsafe+    , unsafeIndex+    , bufferChunks+    , flattenArrays+    , flattenArraysRev+    , fromArrayStreamK+    , fromStreamDN+    , fromStreamD     , toStreamD     , toStreamDRev-    , toStreamK-    , toStreamKRev     , toStream     , toStreamRev-    , read-    , readRev-    , readerRev-    , toList--    -- ** Folds+    , nil     , writeWith     , writeN     , pinnedWriteN     , writeNUnsafe     , pinnedWriteNUnsafe-    , MA.ArrayUnsafe (..)     , pinnedWriteNAligned     , write     , pinnedWrite-    , unsafeMakePure--    -- ** Streams of arrays-    , chunksOf-    , pinnedChunksOf-    , bufferChunks-    , flattenArrays-    , flattenArraysRev--    -- ** Deprecated-    , unsafeIndex     ) where @@ -98,31 +156,36 @@ #include "inline.hs"  import Control.Exception (assert)-import Control.Monad (replicateM)+import Control.Monad (replicateM, when) import Control.Monad.IO.Class (MonadIO(..)) import Data.Functor.Identity (Identity(..))+import Data.Int (Int8, Int16, Int32, Int64) import Data.Proxy (Proxy(..))-import Data.Word (Word8)+import Data.Word (Word8, Word16, Word32, Word64) import GHC.Base (build) import GHC.Exts (IsList, IsString(..), Addr#)  import GHC.IO (unsafePerformIO) import GHC.Ptr (Ptr(..))-import Streamly.Internal.Data.MutArray.Type (MutArray(..), MutByteArray)+import Streamly.Internal.Data.Producer.Type (Producer(..))+import Streamly.Internal.Data.MutArray.Type (MutArray(..))+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.StreamK.Type (StreamK) import Streamly.Internal.Data.Unbox (Unbox(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Text.Read (readPrec) -import Prelude hiding (Foldable(..), read, unlines, splitAt)+import Prelude hiding (Foldable(..), concat, read, unlines, splitAt)  import qualified GHC.Exts as Exts+import qualified Streamly.Internal.Data.Fold.Type as Fold import qualified Streamly.Internal.Data.MutArray.Type as MA import qualified Streamly.Internal.Data.Stream.Type as D-import qualified Streamly.Internal.Data.Stream.Generate as D import qualified Streamly.Internal.Data.StreamK.Type as K import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed+import qualified Streamly.Internal.Data.Producer as Producer import qualified Streamly.Internal.Data.Unfold.Type as Unfold import qualified Text.ParserCombinators.ReadPrec as ReadPrec @@ -176,15 +239,20 @@  -- | Use an @Array a@ as @Ptr a@. ----- See 'MA.asPtrUnsafe' in the Mutable array module for more details.+-- See 'MA.unsafePinnedAsPtr' in the Mutable array module for more details. -- -- /Unsafe/ -- -- /Pre-release/ --+{-# INLINE unsafePinnedAsPtr #-}+unsafePinnedAsPtr :: MonadIO m => Array a -> (Ptr a -> m b) -> m b+unsafePinnedAsPtr arr = MA.unsafePinnedAsPtr (unsafeThaw arr)++{-# DEPRECATED asPtrUnsafe "Please use unsafePinnedAsPtr instead." #-} {-# INLINE asPtrUnsafe #-} asPtrUnsafe :: MonadIO m => Array a -> (Ptr a -> m b) -> m b-asPtrUnsafe arr = MA.asPtrUnsafe (unsafeThaw arr)+asPtrUnsafe = unsafePinnedAsPtr  ------------------------------------------------------------------------------- -- Freezing and Thawing@@ -252,11 +320,14 @@ -- Construction ------------------------------------------------------------------------------- --- Splice two immutable arrays creating a new array.+-- | Copy two immutable arrays into a new array. If you want to splice more+-- than two arrays then this operation would be highly inefficient because it+-- would make a copy on every splice operation, instead use the+-- 'fromChunksK' operation to combine n immutable arrays. {-# INLINE splice #-}-splice :: (MonadIO m, Unbox a) => Array a -> Array a -> m (Array a)+splice :: MonadIO m => Array a -> Array a -> m (Array a) splice arr1 arr2 =-    unsafeFreeze <$> MA.splice (unsafeThaw arr1) (unsafeThaw arr2)+    unsafeFreeze <$> MA.spliceCopy (unsafeThaw arr1) (unsafeThaw arr2)  -- | 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@@ -300,15 +371,45 @@ fromListRev :: Unbox a => [a] -> Array a fromListRev xs = unsafePerformIO $ unsafeFreeze <$> MA.fromListRev xs -{-# INLINE_NORMAL fromStreamDN #-}+-- | Create an 'Array' from the first N elements of a stream. The array is+-- allocated to size N, if the stream terminates before N elements then the+-- array may hold less than N elements.+--+-- >>> fromStreamN n = Stream.fold (Array.writeN n)+--+-- /Pre-release/+{-# INLINE_NORMAL fromStreamN #-}+fromStreamN :: (MonadIO m, Unbox a) => Int -> Stream m a -> m (Array a)+fromStreamN n m = do+    when (n < 0) $ error "writeN: negative write count specified"+    unsafeFreeze <$> MA.fromStreamN n m+-- fromStreamN n = D.fold (writeN n)++{-# DEPRECATED fromStreamDN "Please use fromStreamN instead." #-} fromStreamDN :: forall m a. (MonadIO m, Unbox a)     => Int -> D.Stream m a -> m (Array a)-fromStreamDN limit str = unsafeFreeze <$> MA.fromStreamDN limit str+fromStreamDN = fromStreamN +-- | Create an 'Array' from a stream. This is useful when we want to create a+-- single array from a stream of unknown size. 'writeN' is at least twice+-- as efficient when the size is already known.+--+-- >>> fromStream = Stream.fold Array.write+--+-- Note that if the input stream is too large memory allocation for the array+-- may fail.  When the stream size is not known, `chunksOf` followed by+-- processing of indvidual arrays in the resulting stream should be preferred.+--+-- /Pre-release/ {-# INLINE_NORMAL fromStreamD #-}+fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (Array a)+fromStream = D.fold write+-- fromStreamD str = unsafeFreeze <$> MA.fromStream str++{-# DEPRECATED fromStreamD "Please use fromStream instead." #-} fromStreamD :: forall m a. (MonadIO m, Unbox a)     => D.Stream m a -> m (Array a)-fromStreamD str = unsafeFreeze <$> MA.fromStreamD str+fromStreamD = fromStream  ------------------------------------------------------------------------------- -- Cloning@@ -338,10 +439,15 @@ -- Streams of arrays ------------------------------------------------------------------------------- -{-# INLINE bufferChunks #-}+{-# INLINE buildChunks #-}+buildChunks :: (MonadIO m, Unbox a) =>+    D.Stream m a -> m (K.StreamK m (Array a))+buildChunks m = D.foldr K.cons K.nil $ chunksOf defaultChunkSize m++{-# DEPRECATED bufferChunks "Please use buildChunks instead." #-} bufferChunks :: (MonadIO m, Unbox a) =>     D.Stream m a -> m (K.StreamK m (Array a))-bufferChunks m = D.foldr K.cons K.nil $ chunksOf defaultChunkSize m+bufferChunks = buildChunks  -- | @chunksOf n stream@ groups the elements in the input stream into arrays of -- @n@ elements each.@@ -362,28 +468,101 @@     => Int -> D.Stream m a -> D.Stream m (Array a) pinnedChunksOf n str = D.map unsafeFreeze $ MA.pinnedChunksOf n str --- | Use the "read" unfold instead.------ @flattenArrays = unfoldMany read@+-- | Convert a stream of arrays into a stream of their elements. ----- We can try this if there are any fusion issues in the unfold.+-- >>> concat = Stream.unfoldMany Array.reader ---{-# INLINE_NORMAL flattenArrays #-}+{-# INLINE_NORMAL concat #-}+concat :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+-- XXX this requires MonadIO whereas the unfoldMany version does not+concat = MA.concatWith (pure . unsafeInlineIO) . D.map unsafeThaw+-- concat = D.unfoldMany reader++{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}+{-# INLINE flattenArrays #-} flattenArrays :: forall m a. (MonadIO m, Unbox a)     => D.Stream m (Array a) -> D.Stream m a-flattenArrays = MA.flattenArrays . D.map unsafeThaw+flattenArrays = concat --- | Use the "readRev" unfold instead.------ @flattenArrays = unfoldMany readRev@+-- | Convert a stream of arrays into a stream of their elements reversing the+-- contents of each array before flattening. ----- We can try this if there are any fusion issues in the unfold.+-- >>> concatRev = Stream.unfoldMany Array.readerRev ---{-# INLINE_NORMAL flattenArraysRev #-}+{-# INLINE_NORMAL concatRev #-}+concatRev :: forall m a. (Monad m, Unbox a)+    => D.Stream m (Array a) -> D.Stream m a+-- XXX this requires MonadIO whereas the unfoldMany version does not+concatRev = MA.concatRevWith (pure . unsafeInlineIO) . D.map unsafeThaw+-- concatRev = D.unfoldMany readerRev++{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}+{-# INLINE flattenArraysRev #-} flattenArraysRev :: forall m a. (MonadIO m, Unbox a)     => D.Stream m (Array a) -> D.Stream m a-flattenArraysRev = MA.flattenArraysRev . D.map unsafeThaw+flattenArraysRev = concatRev +-------------------------------------------------------------------------------+-- Compact+-------------------------------------------------------------------------------++-- XXX Note that this thaws immutable arrays for appending, that may be+-- problematic if multiple users do the same thing, however, thawed immutable+-- arrays would have no capacity to append, therefore, a copy will be forced+-- anyway.++-- | Fold @fCompactGE n@ coalesces adjacent arrays in the input stream+-- until the size becomes greater than or equal to n.+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# INLINE_NORMAL fCompactGE #-}+fCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+fCompactGE n = fmap unsafeFreeze $ Fold.lmap unsafeThaw $ MA.fCompactGE n++-- | PInned version of 'fCompactGE'.+{-# INLINE_NORMAL fPinnedCompactGE #-}+fPinnedCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+fPinnedCompactGE n =+    fmap unsafeFreeze $ Fold.lmap unsafeThaw $ MA.fPinnedCompactGE n++-- | @compactGE n stream@ coalesces adjacent arrays in the @stream@ until+-- the size becomes greater than or equal to @n@.+--+-- >>> compactGE n = Stream.foldMany (Array.fCompactGE n)+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# INLINE compactGE #-}+compactGE ::+       (MonadIO m, Unbox a)+    => Int -> Stream m (Array a) -> Stream m (Array a)+compactGE n stream =+    D.map unsafeFreeze $ MA.compactGE n $ D.map unsafeThaw stream++-- | Like 'compactGE' but for transforming folds instead of stream.+--+-- >>> lCompactGE n = Fold.many (Array.fCompactGE n)+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# INLINE_NORMAL lCompactGE #-}+lCompactGE :: (MonadIO m, Unbox a)+    => Int -> Fold m (Array a) () -> Fold m (Array a) ()+lCompactGE n fld =+    Fold.lmap unsafeThaw $ MA.lCompactGE n (Fold.lmap unsafeFreeze fld)++-- | Pinned version of 'lCompactGE'.+{-# INLINE_NORMAL lPinnedCompactGE #-}+lPinnedCompactGE :: (MonadIO m, Unbox a)+    => Int -> Fold m (Array a) () -> Fold m (Array a) ()+lPinnedCompactGE n fld =+    Fold.lmap unsafeThaw $ MA.lPinnedCompactGE n (Fold.lmap unsafeFreeze fld)++-------------------------------------------------------------------------------+-- Splitting+-------------------------------------------------------------------------------+ -- Drops the separator byte {-# INLINE breakOn #-} breakOn :: MonadIO m@@ -426,24 +605,68 @@ length :: Unbox a => Array a -> Int length arr = MA.length (unsafeThaw arr) +{-# INLINE_NORMAL producer #-}+producer :: forall m a. (Monad m, Unbox a) => Producer m (Array a) a+producer =+    Producer.translate unsafeThaw unsafeFreeze+        $ MA.producerWith (return . unsafeInlineIO)++-- | Unfold an array into a stream.+--+{-# INLINE_NORMAL reader #-}+reader :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a+reader = Producer.simplify producer++-- | Unfold an array into a stream, does not check the end of the array, the+-- user is responsible for terminating the stream within the array bounds. For+-- high performance application where the end condition can be determined by+-- a terminating fold.+--+-- Written in the hope that it may be faster than "read", however, in the case+-- for which this was written, "read" proves to be faster even though the core+-- generated with unsafeRead looks simpler.+--+-- /Pre-release/+--+{-# INLINE_NORMAL readerUnsafe #-}+readerUnsafe :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a+readerUnsafe = Unfold step inject+    where++    inject (Array contents start end) =+        return (MA.ArrayUnsafe contents end start)++    {-# INLINE_LATE step #-}+    step (MA.ArrayUnsafe contents end 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 = unsafeInlineIO $ peekAt p contents+            let !p1 = INDEX_NEXT(p,a)+            return $ D.Yield x (MA.ArrayUnsafe contents end p1)+ -- | Unfold an array into a stream in reverse order. -- {-# INLINE_NORMAL readerRev #-} readerRev :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a readerRev = Unfold.lmap unsafeThaw $ MA.readerRevWith (return . unsafeInlineIO) +{-# DEPRECATED toStreamD "Please use 'read' instead." #-} {-# INLINE_NORMAL toStreamD #-} toStreamD :: forall m a. (Monad m, Unbox a) => Array a -> D.Stream m a-toStreamD arr = MA.toStreamDWith (return . unsafeInlineIO) (unsafeThaw arr)+toStreamD = read  {-# INLINE toStreamK #-} toStreamK :: forall m a. (Monad m, Unbox a) => Array a -> K.StreamK m a toStreamK arr = MA.toStreamKWith (return . unsafeInlineIO) (unsafeThaw arr) +{-# DEPRECATED toStreamDRev "Please use 'readRev' instead." #-} {-# INLINE_NORMAL toStreamDRev #-} toStreamDRev :: forall m a. (Monad m, Unbox a) => Array a -> D.Stream m a-toStreamDRev arr =-    MA.toStreamDRevWith (return . unsafeInlineIO) (unsafeThaw arr)+toStreamDRev = readRev  {-# INLINE toStreamKRev #-} toStreamKRev :: forall m a. (Monad m, Unbox a) => Array a -> K.StreamK m a@@ -455,7 +678,7 @@ -- /Pre-release/ {-# INLINE_EARLY read #-} read :: (Monad m, Unbox a) => Array a -> Stream m a-read = toStreamD+read arr = MA.toStreamWith (return . unsafeInlineIO) (unsafeThaw arr)  -- | Same as 'read' --@@ -472,7 +695,7 @@ -- /Pre-release/ {-# INLINE_EARLY readRev #-} readRev :: (Monad m, Unbox a) => Array a -> Stream m a-readRev = toStreamDRev+readRev arr = MA.toStreamRevWith (return . unsafeInlineIO) (unsafeThaw arr)  -- | Same as 'readRev' --@@ -496,6 +719,7 @@ -- | Create two slices of an array without copying the original array. The -- specified index @i@ is the first index of the second slice. --+{-# INLINE splitAt #-} splitAt :: Unbox a => Int -> Array a -> (Array a, Array a) splitAt i arr = (unsafeFreeze a, unsafeFreeze b)   where@@ -529,17 +753,28 @@ -- Folds ------------------------------------------------------------------------------- --- | @writeN n@ folds a maximum of @n@ elements from the input stream to an+-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an -- 'Array'. ---{-# INLINE_NORMAL writeN #-}+{-# INLINE_NORMAL createOf #-}+createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+createOf = fmap unsafeFreeze . MA.createOf++-- XXX Deprecate in major+-- {-# DEPRECATED writeN  "Please use createOf instead." #-}+{-# INLINE writeN #-} writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)-writeN = fmap unsafeFreeze . MA.writeN+writeN = createOf --- | Like 'fromListN' but creates a pinned array.-{-# INLINE_NORMAL pinnedWriteN #-}+-- | Like 'createOf' but creates a pinned array.+{-# INLINE_NORMAL pinnedCreateOf #-}+pinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+pinnedCreateOf = fmap unsafeFreeze . MA.pinnedCreateOf++{-# DEPRECATED pinnedWriteN  "Please use pinnedCreateOf instead." #-}+{-# INLINE pinnedWriteN #-} pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)-pinnedWriteN = fmap unsafeFreeze . MA.pinnedWriteN+pinnedWriteN = pinnedCreateOf  -- | @pinnedWriteNAligned alignment n@ folds a maximum of @n@ elements from the input -- stream to an 'Array' aligned to the given size.@@ -547,44 +782,74 @@ -- /Pre-release/ -- {-# INLINE_NORMAL pinnedWriteNAligned #-}+{-# DEPRECATED pinnedWriteNAligned  "To be removed." #-} pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)     => Int -> Int -> Fold m a (Array a) pinnedWriteNAligned alignSize = fmap unsafeFreeze . MA.pinnedWriteNAligned alignSize --- | Like 'writeN' but does not check the array bounds when writing. The fold+-- | Like 'createOf' but does not check the array bounds when writing. The fold -- driver must not call the step function more than 'n' times otherwise it will -- corrupt the memory and crash. This function exists mainly because any -- conditional in the step function blocks fusion causing 10x performance -- slowdown. ---{-# INLINE_NORMAL writeNUnsafe #-}+{-# INLINE_NORMAL unsafeCreateOf #-}+unsafeCreateOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (Array a)+unsafeCreateOf n = unsafeFreeze <$> MA.unsafeCreateOf n++{-# DEPRECATED writeNUnsafe  "Please use unsafeCreateOf instead." #-}+{-# INLINE writeNUnsafe #-} writeNUnsafe :: forall m a. (MonadIO m, Unbox a)     => Int -> Fold m a (Array a)-writeNUnsafe n = unsafeFreeze <$> MA.writeNUnsafe n+writeNUnsafe = unsafeCreateOf -{-# INLINE_NORMAL pinnedWriteNUnsafe #-}+{-# INLINE_NORMAL unsafePinnedCreateOf #-}+unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (Array a)+unsafePinnedCreateOf n = unsafeFreeze <$> MA.unsafePinnedCreateOf n++{-# DEPRECATED pinnedWriteNUnsafe  "Please use unsafePinnedCreateOf instead." #-}+{-# INLINE pinnedWriteNUnsafe #-} pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)     => Int -> Fold m a (Array a)-pinnedWriteNUnsafe n = unsafeFreeze <$> MA.pinnedWriteNUnsafe n+pinnedWriteNUnsafe = unsafePinnedCreateOf -{-# INLINE_NORMAL writeWith #-}+{-# INLINE_NORMAL createWith #-}+createWith :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (Array a)+-- createWith n = FL.rmapM spliceArrays $ toArraysOf n+createWith elemCount = unsafeFreeze <$> MA.createWith elemCount++{-# DEPRECATED writeWith "Please use createWith instead." #-}+{-# INLINE writeWith #-} writeWith :: forall m a. (MonadIO m, Unbox a)     => Int -> Fold m a (Array a)--- writeWith n = FL.rmapM spliceArrays $ toArraysOf n-writeWith elemCount = unsafeFreeze <$> MA.writeWith elemCount+writeWith = createWith  -- | Fold the whole input to a single array. -- -- /Caution! Do not use this on infinite streams./ --+{-# INLINE create #-}+create :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+create = fmap unsafeFreeze MA.create++-- XXX Deprecate in major+-- {-# DEPRECATED write  "Please use create instead." #-} {-# INLINE write #-} write :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)-write = fmap unsafeFreeze MA.write+write = create --- | Like 'write' but creates a pinned array.+-- | Like 'create' but creates a pinned array.+{-# INLINE pinnedCreate #-}+pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+pinnedCreate = fmap unsafeFreeze MA.pinnedCreate++{-# DEPRECATED pinnedWrite  "Please use pinnedCreate instead." #-} {-# INLINE pinnedWrite #-} pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)-pinnedWrite = fmap unsafeFreeze MA.pinnedWrite+pinnedWrite = pinnedCreate  -- | Fold "step" has a dependency on "initial", and each step is dependent on -- the previous invocation of step due to state passing, finally extract@@ -616,6 +881,11 @@          (\s -> return $! unsafeInlineIO $ extract s)          (\s -> return $! unsafeInlineIO $ final s) +{-# INLINE fromPureStreamN #-}+fromPureStreamN :: Unbox a => Int -> Stream Identity a -> Array a+fromPureStreamN n x =+    unsafePerformIO $ fmap unsafeFreeze (MA.fromPureStreamN n x)+ -- | Convert a pure stream in Identity monad to an immutable array. -- -- Same as the following but with better performance:@@ -627,6 +897,19 @@ -- fromPureStream = runIdentity . D.fold (unsafeMakePure write) -- fromPureStream = fromList . runIdentity . D.toList +-- XXX This should be monadic.++-- | Copy an immutable 'Ptr Word8' sequence into an array.+--+-- /Unsafe:/ The caller is responsible for safe addressing.+--+-- Note that this should be evaluated strictly to ensure that we do not hold+-- the reference to the pointer in a lazy thunk.+fromPtrN :: Int -> Ptr Word8 -> Array Word8+fromPtrN n addr = unsafePerformIO $ fmap unsafeFreeze (MA.fromPtrN n addr)++-- XXX This should be monadic.+ -- | Copy a null terminated immutable 'Addr#' Word8 sequence into an array. -- -- /Unsafe:/ The caller is responsible for safe addressing.@@ -637,9 +920,47 @@ -- >>> Array.toList $ Array.fromByteStr# "\1\2\3\0"# -- [1,2,3] --+-- Note that this should be evaluated strictly to ensure that we do not hold+-- the reference to the pointer in a lazy thunk. fromByteStr# :: Addr# -> Array Word8-fromByteStr# addr = fromPureStream (D.fromByteStr# addr)+fromByteStr# addr = unsafePerformIO $ fmap unsafeFreeze (MA.fromByteStr# addr) +-- XXX This should be monadic.++-- | Note that this should be evaluated strictly to ensure that we do not hold+-- the reference to the pointer in a lazy thunk.+fromByteStr :: Ptr Word8 -> Array Word8+fromByteStr (Ptr addr#) = fromByteStr# addr#++-- XXX implement fromChunks/fromChunkList instead?++-- | Convert an array stream to an array. Note that this requires peak memory+-- that is double the size of the array stream.+--+{-# INLINE fromChunksK #-}+fromChunksK :: (MonadIO m, Unbox a) => StreamK m (Array a) -> m (Array a)+fromChunksK stream =+    -- We buffer the entire stream and then allocate the target array of the+    -- same size, thus requiring double the memory.+    fmap unsafeFreeze $ MA.fromChunksK $ fmap unsafeThaw stream++{-# DEPRECATED fromArrayStreamK "Please use fromChunksK instead." #-}+fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (Array a) -> m (Array a)+fromArrayStreamK = fromChunksK++-- | Given a stream of arrays, splice them all together to generate a single+-- array. The stream must be /finite/.+--+{-# INLINE fromChunks #-}+fromChunks :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)+fromChunks s =+    -- XXX Check which implementation is better+    -- This may also require double the memory as we double the space every+    -- time, when copying the last array we may have reallocated almost double+    -- the space required before we right size it.+    fmap unsafeFreeze $ MA.fromChunksRealloced (fmap unsafeThaw s)+    -- fromChunkStreamK $ D.toStreamK s+ ------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------@@ -670,12 +991,66 @@     {-# INLINE toList #-}     toList = toList --- XXX we are assuming that Unboxed equality means element equality. This may--- or may not be correct? arrcmp is 40% faster compared to stream equality.-instance (Unbox a, Eq a) => Eq (Array a) where+-- | Byte compare two arrays. Compare the length of the arrays. If the length+-- is equal, compare the lexicographical ordering of two underlying byte arrays+-- otherwise return the result of length comparison.+--+-- /Unsafe/: Note that the 'Unbox' instance of sum types with constructors of+-- different sizes may leave some memory uninitialized which can make byte+-- comparison unreliable.+--+-- /Pre-release/+{-# INLINE byteCmp #-}+byteCmp :: Array a -> Array a -> Ordering+byteCmp arr1 arr2 =+    -- unsafePerformIO?+    unsafeInlineIO $! unsafeThaw arr1 `MA.byteCmp` unsafeThaw arr2++-- | Byte equality of two arrays.+--+-- >>> byteEq arr1 arr2 = (==) EQ $ Array.byteCmp arr1 arr2+--+-- /Unsafe/: See 'byteCmp'.+{-# INLINE byteEq #-}+byteEq :: Array a -> Array a -> Bool+byteEq arr1 arr2 = (==) EQ $ byteCmp arr1 arr2++#define MK_EQ_INSTANCE(typ)                              \+instance {-# OVERLAPPING #-} Eq (Array typ) where {      \+;    {-# INLINE (==) #-}                                 \+;    (==) = byteEq \+}++MK_EQ_INSTANCE(Char)+MK_EQ_INSTANCE(Word8)+MK_EQ_INSTANCE(Word16)+MK_EQ_INSTANCE(Word32)++-- XXX The Word64 default instance should be as fast because we are comparing+-- 64-bit at a time.+MK_EQ_INSTANCE(Word64)+MK_EQ_INSTANCE(Int)+MK_EQ_INSTANCE(Int8)+MK_EQ_INSTANCE(Int16)+MK_EQ_INSTANCE(Int32)++-- XXX The Int64 default instance should be as fast.+MK_EQ_INSTANCE(Int64)++-- | If the type allows a byte-by-byte comparison this instance can be+-- overlapped by a more specific instance that uses 'byteCmp'. Byte comparison+-- can be significantly faster.+--+instance {-# OVERLAPPABLE #-} (Unbox a, Eq a) => Eq (Array a) where     {-# INLINE (==) #-}     arr1 == arr2 =-        (==) EQ $ unsafeInlineIO $! unsafeThaw arr1 `MA.cmp` unsafeThaw arr2+        -- Does unboxed byte equality mean element equality?+        -- XXX This is incorrect for sum types, as we may have some+        -- uninitialized memory in that case. If we always initialize the+        -- unused memory to zero we can use this.+        -- Byte comparison is 40% faster compared to stream equality.+        -- (==) EQ $ unsafeInlineIO $! unsafeThaw arr1 `MA.cmp` unsafeThaw arr2+           (toStreamD arr1 :: Stream Identity a) == toStreamD arr2  instance (Unbox a, Ord a) => Ord (Array a) where     {-# INLINE compare #-}@@ -740,15 +1115,29 @@ -- Semigroup and Monoid ------------------------------------------------------------------------------- +-- XXX Deprecate and remove the Semigroup and Monoid instances because of+-- potential misuse chances.++-- | This should not be used for combining many or N arrays as it would copy+-- the two arrays everytime to a new array. For coalescing multiple arrays use+-- 'fromChunksK' instead. instance Unbox a => Semigroup (Array a) where     arr1 <> arr2 = unsafePerformIO $ splice arr1 arr2 +empty ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    Array a+empty = Array Unboxed.empty 0 0++{-# DEPRECATED nil "Please use empty instead." #-} nil :: #ifdef DEVBUILD     Unbox a => #endif     Array a-nil = Array Unboxed.nil 0 0+nil = empty  instance Unbox a => Monoid (Array a) where     mempty = nil
src/Streamly/Internal/Data/Fold/Combinators.hs view
@@ -30,8 +30,6 @@     -- *** Reducers     , drainMapM     , the-    , length-    , lengthGeneric     , mean     , rollingHash     , defaultSalt@@ -166,8 +164,6 @@     -- ** Trimming      -- By elements-    , takeEndBy-    , takeEndBy_     , takeEndBySeq     , takeEndBySeq_     {-@@ -709,30 +705,6 @@ -- To Summary ------------------------------------------------------------------------------ --- | Like 'length', except with a more general 'Num' return value------ Definition:------ >>> lengthGeneric = fmap getSum $ Fold.foldMap (Sum . const  1)--- >>> lengthGeneric = Fold.foldl' (\n _ -> n + 1) 0------ /Pre-release/-{-# INLINE lengthGeneric #-}-lengthGeneric :: (Monad m, Num b) => Fold m a b-lengthGeneric = foldl' (\n _ -> n + 1) 0---- | Determine the length of the input stream.------ Definition:------ >>> length = Fold.lengthGeneric--- >>> length = fmap getSum $ Fold.foldMap (Sum . const  1)----{-# INLINE length #-}-length :: Monad m => Fold m a Int-length = lengthGeneric-- -- | Determine the sum of all elements of a stream of numbers. Returns additive -- identity (@0@) when the stream is empty. Note that this is not numerically -- stable for floating point numbers.@@ -1509,70 +1481,6 @@ {-# INLINE droppingWhile #-} droppingWhile :: Monad m => (a -> Bool) -> Fold m a (Maybe a) droppingWhile p = droppingWhileM (return . p)---- Note: Keep this consistent with S.splitOn. In fact we should eliminate--- S.splitOn in favor of the fold.------ XXX Use Fold.many instead once it is fixed.--- > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)---- | Like 'takeEndBy' but drops the element on which the predicate succeeds.------ Example:------ >>> input = Stream.fromList "hello\nthere\n"--- >>> line = Fold.takeEndBy_ (== '\n') Fold.toList--- >>> Stream.fold line input--- "hello"------ >>> Stream.fold Fold.toList $ Stream.foldMany line input--- ["hello","there"]----{-# INLINE takeEndBy_ #-}-takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b--- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)-takeEndBy_ predicate (Fold fstep finitial fextract ffinal) =-    Fold step finitial fextract ffinal--    where--    step s a =-        if not (predicate a)-        then fstep s a-        else Done <$> ffinal s---- Note:--- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)---- | Take the input, stop when the predicate succeeds taking the succeeding--- element as well.------ Example:------ >>> input = Stream.fromList "hello\nthere\n"--- >>> line = Fold.takeEndBy (== '\n') Fold.toList--- >>> Stream.fold line input--- "hello\n"------ >>> Stream.fold Fold.toList $ Stream.foldMany line input--- ["hello\n","there\n"]----{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b--- takeEndBy predicate = scanMaybe (takingEndBy predicate)-takeEndBy predicate (Fold fstep finitial fextract ffinal) =-    Fold step finitial fextract ffinal--    where--    step s a = do-        res <- fstep s a-        if not (predicate a)-        then return res-        else do-            case res of-                Partial s1 -> Done <$> ffinal s1-                Done b -> return $ Done b  ------------------------------------------------------------------------------ -- Binary splitting on a separator
src/Streamly/Internal/Data/Fold/Type.hs view
@@ -367,6 +367,8 @@     , toList     , toStreamK     , toStreamKRev+    , lengthGeneric+    , length      -- * Combinators @@ -391,6 +393,8 @@     -- ** Trimming     , take     , taking+    , takeEndBy_+    , takeEndBy     , dropping      -- ** Sequential application@@ -767,6 +771,29 @@ toStreamK :: Monad m => Fold m a (K.StreamK n a) toStreamK = foldr K.cons K.nil +-- | Like 'length', except with a more general 'Num' return value+--+-- Definition:+--+-- >>> lengthGeneric = fmap getSum $ Fold.foldMap (Sum . const  1)+-- >>> lengthGeneric = Fold.foldl' (\n _ -> n + 1) 0+--+-- /Pre-release/+{-# INLINE lengthGeneric #-}+lengthGeneric :: (Monad m, Num b) => Fold m a b+lengthGeneric = foldl' (\n _ -> n + 1) 0++-- | Determine the length of the input stream.+--+-- Definition:+--+-- >>> length = Fold.lengthGeneric+-- >>> length = fmap getSum $ Fold.foldMap (Sum . const  1)+--+{-# INLINE length #-}+length :: Monad m => Fold m a Int+length = lengthGeneric+ ------------------------------------------------------------------------------ -- Instances ------------------------------------------------------------------------------@@ -1516,6 +1543,70 @@     extract (Tuple'Fused _ r) = fextract r      final (Tuple'Fused _ r) = ffinal r++-- Note: Keep this consistent with S.splitOn. In fact we should eliminate+-- S.splitOn in favor of the fold.+--+-- XXX Use Fold.many instead once it is fixed.+-- > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)++-- | Like 'takeEndBy' but drops the element on which the predicate succeeds.+--+-- Example:+--+-- >>> input = Stream.fromList "hello\nthere\n"+-- >>> line = Fold.takeEndBy_ (== '\n') Fold.toList+-- >>> Stream.fold line input+-- "hello"+--+-- >>> Stream.fold Fold.toList $ Stream.foldMany line input+-- ["hello","there"]+--+{-# INLINE takeEndBy_ #-}+takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+-- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)+takeEndBy_ predicate (Fold fstep finitial fextract ffinal) =+    Fold step finitial fextract ffinal++    where++    step s a =+        if not (predicate a)+        then fstep s a+        else Done <$> ffinal s++-- Note:+-- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)++-- | Take the input, stop when the predicate succeeds taking the succeeding+-- element as well.+--+-- Example:+--+-- >>> input = Stream.fromList "hello\nthere\n"+-- >>> line = Fold.takeEndBy (== '\n') Fold.toList+-- >>> Stream.fold line input+-- "hello\n"+--+-- >>> Stream.fold Fold.toList $ Stream.foldMany line input+-- ["hello\n","there\n"]+--+{-# INLINE takeEndBy #-}+takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+-- takeEndBy predicate = scanMaybe (takingEndBy predicate)+takeEndBy predicate (Fold fstep finitial fextract ffinal) =+    Fold step finitial fextract ffinal++    where++    step s a = do+        res <- fstep s a+        if not (predicate a)+        then return res+        else do+            case res of+                Partial s1 -> Done <$> ffinal s1+                Done b -> return $ Done b  ------------------------------------------------------------------------------ -- Nesting
src/Streamly/Internal/Data/MutArray.hs view
@@ -11,81 +11,197 @@     -- * MutArray.Type module       module Streamly.Internal.Data.MutArray.Type     -- * MutArray module-    , splitOn-    , genSlicesFromLen-    , getSlicesFromLen-    , fromStream+    , sliceIndexerFromLen+    , slicerFromLen+    , compactLE+    , pinnedCompactLE+    , compactOnByte+    , compactOnByteSuffix     -- * Unboxed IORef     , module Streamly.Internal.Data.IORef.Unboxed++    -- * Deprecated+    , genSlicesFromLen+    , getSlicesFromLen     ) where  #include "inline.hs"  import Control.Monad.IO.Class (MonadIO(..))+import Data.Word (Word8)+import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..))+import Streamly.Internal.Data.Stream.Type (Stream) import Streamly.Internal.Data.Unbox (Unbox)-import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) -import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.Stream.Type as Stream+import qualified Streamly.Internal.Data.Stream.Nesting as Stream+-- import qualified Streamly.Internal.Data.Stream.Transform as Stream import qualified Streamly.Internal.Data.Unfold as Unfold  import Prelude hiding (foldr, length, read, splitAt) import Streamly.Internal.Data.MutArray.Type import Streamly.Internal.Data.IORef.Unboxed --- | Split the array into a stream of slices using a predicate. The element--- matching the predicate is dropped.------ /Pre-release/-{-# INLINE splitOn #-}-splitOn :: (MonadIO m, Unbox a) =>-    (a -> Bool) -> MutArray a -> Stream m (MutArray a)-splitOn predicate arr =-    fmap (\(i, len) -> getSliceUnsafe i len arr)-        $ D.sliceOnSuffix predicate (read arr)- -- | Generate a stream of array slice descriptors ((index, len)) of specified -- length from an array, starting from the supplied array index. The last slice -- may be shorter than the requested length depending on the array length. -- -- /Pre-release/-{-# INLINE genSlicesFromLen #-}-genSlicesFromLen :: forall m a. (Monad m, Unbox a)+{-# INLINE sliceIndexerFromLen #-}+sliceIndexerFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (MutArray a) (Int, Int)-genSlicesFromLen from len =+sliceIndexerFromLen from len =     let fromThenTo n = (from, from + len, n - 1)         mkSlice n i = return (i, min len (n - i))      in Unfold.lmap length         $ Unfold.mapM2 mkSlice         $ Unfold.lmap fromThenTo Unfold.enumerateFromThenTo +{-# DEPRECATED genSlicesFromLen "Please use sliceIndexerFromLen instead." #-}+genSlicesFromLen :: forall m a. (Monad m, Unbox a)+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> Unfold m (MutArray a) (Int, Int)+genSlicesFromLen = sliceIndexerFromLen+ -- | Generate a stream of slices of specified length from an array, starting -- from the supplied array index. The last slice may be shorter than the -- requested length depending on the array length. -- -- /Pre-release/-{-# INLINE getSlicesFromLen #-}-getSlicesFromLen :: forall m a. (Monad m, Unbox a)+{-# INLINE slicerFromLen #-}+slicerFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (MutArray a) (MutArray a)-getSlicesFromLen from len =+slicerFromLen from len =     let mkSlice arr (i, n) = return $ getSliceUnsafe i n arr-     in Unfold.mapM2 mkSlice (genSlicesFromLen from len)+     in Unfold.mapM2 mkSlice (sliceIndexerFromLen from len) --- | Create an 'Array' from a stream. This is useful when we want to create a--- single array from a stream of unknown size. 'writeN' is at least twice--- as efficient when the size is already known.+{-# DEPRECATED getSlicesFromLen "Please use slicerFromLen instead." #-}+getSlicesFromLen :: forall m a. (Monad m, Unbox a)+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> Unfold m (MutArray a) (MutArray a)+getSlicesFromLen = slicerFromLen++-------------------------------------------------------------------------------+-- Compacting Streams of Arrays+-------------------------------------------------------------------------------++-- | @compactLE maxElems@ coalesces adjacent arrays in the input stream+-- only if the combined size would be less than or equal to @maxElems@+-- elements. Note that it won't split an array if the original array is already+-- larger than maxElems. ----- Note that if the input stream is too large memory allocation for the array--- may fail.  When the stream size is not known, `chunksOf` followed by--- processing of indvidual arrays in the resulting stream should be preferred.+-- @maxElems@ must be greater than 0. ----- /Pre-release/-{-# INLINE fromStream #-}-fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)-fromStream = fromStreamD--- fromStream (Stream m) = P.fold write m+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# INLINE compactLE #-}+compactLE :: (MonadIO m, Unbox a) =>+    Int -> Stream m (MutArray a) -> Stream m (MutArray a)+-- XXX compactLE can be moved to MutArray/Type if we are not using the parser+-- to implement it.+compactLE = compactLeAs Unpinned+-- The parser version turns out to be a little bit slower.+-- compactLE n = Stream.catRights . Stream.parseManyD (pCompactLE n)++-- | Pinned version of 'compactLE'.+{-# INLINE pinnedCompactLE #-}+pinnedCompactLE :: forall m a. (MonadIO m, Unbox a)+    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+pinnedCompactLE = compactLeAs Pinned+-- pinnedCompactLE n = Stream.catRights . Stream.parseManyD (pPinnedCompactLE n)++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.+--+{-# INLINE_NORMAL _compactOnByteCustom #-}+_compactOnByteCustom+    :: MonadIO m+    => Word8+    -> Stream m (MutArray Word8)+    -> Stream m (MutArray Word8)+_compactOnByteCustom byte (Stream.Stream step state) =+    Stream.Stream step' (Initial state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (Initial st) = do+        r <- step gst st+        case r of+            Stream.Yield arr s -> do+                (arr1, marr2) <- breakOn byte arr+                return $ case marr2 of+                    Nothing   -> Stream.Skip (Buffering s arr1)+                    Just arr2 -> Stream.Skip (Yielding arr1 (Splitting s arr2))+            Stream.Skip s -> return $ Stream.Skip (Initial s)+            Stream.Stop -> return Stream.Stop++    step' gst (Buffering st buf) = do+        r <- step gst st+        case r of+            Stream.Yield arr s -> do+                (arr1, marr2) <- breakOn byte arr+                -- XXX Use spliceExp instead and then rightSize?+                buf1 <- splice buf arr1+                return $ case marr2 of+                    Nothing -> Stream.Skip (Buffering s buf1)+                    Just x -> Stream.Skip (Yielding buf1 (Splitting s x))+            Stream.Skip s -> return $ Stream.Skip (Buffering s buf)+            Stream.Stop -> return $+                if byteLength buf == 0+                then Stream.Stop+                else Stream.Skip (Yielding buf Finishing)++    step' _ (Splitting st buf) = do+        (arr1, marr2) <- breakOn byte buf+        return $ case marr2 of+                Nothing -> Stream.Skip $ Buffering st arr1+                Just arr2 -> Stream.Skip $ Yielding arr1 (Splitting st arr2)++    step' _ (Yielding arr next) = return $ Stream.Yield arr next+    step' _ Finishing = return Stream.Stop++-- XXX implement predicate based version of this+-- XXX Naming of predicate based vs custom version++-- | 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.+--+{-# INLINE compactOnByte #-}+compactOnByte+    :: (MonadIO m)+    => Word8+    -> Stream m (MutArray Word8)+    -> Stream m (MutArray Word8)+-- XXX compare perf of custom vs idiomatic version+-- compactOnByte = _compactOnByteCustom+-- XXX use spliceExp and rightSize?+compactOnByte byte = Stream.splitInnerBy (breakOn byte) splice++-- | Like 'compactOnByte' considers the separator in suffix position instead of+-- infix position.+{-# INLINE compactOnByteSuffix #-}+compactOnByteSuffix+    :: (MonadIO m)+    => Word8+    -> Stream m (MutArray Word8)+    -> Stream m (MutArray Word8)+compactOnByteSuffix byte =+        -- XXX use spliceExp and rightSize?+        Stream.splitInnerBySuffix+            (\arr -> byteLength arr == 0) (breakOn byte) splice
src/Streamly/Internal/Data/MutArray/Generic.hs view
@@ -19,14 +19,14 @@     , nil      -- *** Uninitialized Arrays-    , new+    , emptyOf     -- , newArrayWith      -- *** From streams-    , writeNUnsafe-    , writeN-    , writeWith-    , write+    , unsafeCreateOf+    , createOf+    , createWith -- createOfMin/createMin/createGE?+    , create     , fromStreamN     , fromStream     , fromPureStream@@ -160,6 +160,13 @@     -- , appendSliceFrom      , clone++    -- * Deprecated+    , new+    , writeNUnsafe+    , writeN+    , writeWith+    , write     ) where @@ -236,13 +243,13 @@ -- XXX Would be nice if GHC can provide something like newUninitializedArray# so -- that we do not have to write undefined or error in the whole array. --- | @new count@ allocates a zero length array that can be extended to hold+-- | @emptyOf count@ allocates a zero length array that can be extended to hold -- up to 'count' items without reallocating. -- -- /Pre-release/-{-# INLINE new #-}-new :: MonadIO m => Int -> m (MutArray a)-new n@(I# n#) =+{-# INLINE emptyOf #-}+emptyOf :: MonadIO m => Int -> m (MutArray a)+emptyOf n@(I# n#) =     liftIO         $ IO         $ \s# ->@@ -251,6 +258,12 @@                       let ma = MutArray arr# 0 0 n                        in (# s1#, ma #) +-- XXX Deprecate in major+-- {-# DEPRECATED new "Please use emptyOf instead." #-}+{-# INLINE new #-}+new :: MonadIO m => Int -> m (MutArray a)+new = emptyOf+ -- XXX This could be pure?  -- |@@ -318,7 +331,7 @@      where -    step () (i, x) = liftIO (putIndex i arr x)+    step () (i, x) = putIndex i arr x  -- | Modify a given index of an array using a modifier function without checking -- the bounds.@@ -589,16 +602,16 @@ arrayChunkSize :: Int arrayChunkSize = 1024 --- | Like 'writeN' but does not check the array bounds when writing. The fold+-- | Like 'createOf' but does not check the array bounds when writing. The fold -- driver must not call the step function more than 'n' times otherwise it will -- corrupt the memory and crash. This function exists mainly because any -- conditional in the step function blocks fusion causing 10x performance -- slowdown. -- -- /Pre-release/-{-# INLINE_NORMAL writeNUnsafe #-}-writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)-writeNUnsafe n = Fold step initial return return+{-# INLINE_NORMAL unsafeCreateOf #-}+unsafeCreateOf :: MonadIO m => Int -> Fold m a (MutArray a)+unsafeCreateOf n = Fold step initial return return      where @@ -606,59 +619,81 @@      step arr x = FL.Partial <$> snocUnsafe arr x --- | @writeN n@ folds a maximum of @n@ elements from the input stream to an+{-# DEPRECATED writeNUnsafe "Please use unsafeCreateOf instead." #-}+{-# INLINE writeNUnsafe #-}+writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)+writeNUnsafe = unsafeCreateOf++-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an -- 'Array'. ----- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)+-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n) -- -- /Pre-release/-{-# INLINE_NORMAL writeN #-}+{-# INLINE_NORMAL createOf #-}+createOf :: MonadIO m => Int -> Fold m a (MutArray a)+createOf n = FL.take n $ unsafeCreateOf n++-- XXX Deprecate in major+-- {-# DEPRECATED writeN "Please use createOf instead." #-}+{-# INLINE writeN #-} writeN :: MonadIO m => Int -> Fold m a (MutArray a)-writeN n = FL.take n $ writeNUnsafe n+writeN = createOf  -- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.pinnedNew n) -- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n) -- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n) --- | @writeWith minCount@ folds the whole input to a single array. The array+-- | @createWith minCount@ folds the whole input to a single array. The array -- starts at a size big enough to hold minCount elements, the size is doubled -- every time the array needs to be grown. -- -- /Caution! Do not use this on infinite streams./ -- -- /Pre-release/-{-# INLINE_NORMAL writeWith #-}-writeWith :: MonadIO m => Int -> Fold m a (MutArray a)+{-# INLINE_NORMAL createWith #-}+createWith :: MonadIO m => Int -> Fold m a (MutArray a) -- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (pinnedNew n)-writeWith elemCount = FL.rmapM extract $ FL.foldlM' step initial+createWith elemCount = FL.rmapM extract $ FL.foldlM' step initial      where      initial = do-        when (elemCount < 0) $ error "writeWith: elemCount is negative"-        liftIO $ new elemCount+        when (elemCount < 0) $ error "createWith: elemCount is negative"+        new elemCount      step arr@(MutArray _ start end bound) x         | end == bound = do         let oldSize = end - start             newSize = max (oldSize * 2) 1-        arr1 <- liftIO $ realloc newSize arr+        arr1 <- realloc newSize arr         snocUnsafe arr1 x     step arr x = snocUnsafe arr x -    -- extract = liftIO . rightSize+    -- extract = rightSize     extract = return +{-# DEPRECATED writeWith "Please use createWith instead." #-}+{-# INLINE writeWith #-}+writeWith :: MonadIO m => Int -> Fold m a (MutArray a)+writeWith = createWith+ -- | Fold the whole input to a single array. ----- Same as 'writeWith' using an initial array size of 'arrayChunkSize' bytes+-- Same as 'createWith' using an initial array size of 'arrayChunkSize' bytes -- rounded up to the element size. -- -- /Caution! Do not use this on infinite streams./ --+{-# INLINE create #-}+create :: MonadIO m => Fold m a (MutArray a)+create = writeWith arrayChunkSize++-- XXX Deprecate in major+-- {-# DEPRECATED write "Please use create instead." #-} {-# INLINE write #-} write :: MonadIO m => Fold m a (MutArray a)-write = writeWith arrayChunkSize+write = create  -- | Create a 'MutArray' from the first @n@ elements of a stream. The -- array is allocated to size @n@, if the stream terminates before @n@@@ -683,7 +718,7 @@ {-# INLINABLE fromPureStream #-} fromPureStream :: MonadIO m => Stream Identity a -> m (MutArray a) fromPureStream xs =-    liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs+    D.fold write $ D.morphInner (return . runIdentity) xs  ------------------------------------------------------------------------------- -- Chunking@@ -815,7 +850,7 @@  {-# INLINE clone #-} clone :: MonadIO m => MutArray a -> m (MutArray a)-clone src = liftIO $ do+clone src = do     let len = arrLen src     dst <- new len     putSliceUnsafe src 0 dst 0 len
src/Streamly/Internal/Data/MutArray/Stream.hs view
@@ -12,6 +12,7 @@ -- keep this as a separate module and release it. -- module Streamly.Internal.Data.MutArray.Stream+{-# DEPRECATED "Please use \"Streamly.Internal.Data.MutArray\" instead." #-}     (     -- * Generation       MArray.chunksOf@@ -21,7 +22,7 @@      -- * Compaction     , packArraysChunksOf-    , SpliceState (..)+    , MArray.SpliceState (..)     , lpackArraysChunksOf     , compact -- chunksCompact     , compactLE@@ -35,19 +36,12 @@     ) where -#include "inline.hs"-#include "ArrayMacros.h"- import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (when)-import Data.Bifunctor (first)-import Data.Proxy (Proxy(..))-import Streamly.Internal.Data.Unbox (Unbox, sizeOf)+import Streamly.Internal.Data.Unbox (Unbox) import Streamly.Internal.Data.MutArray.Type (MutArray(..)) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Internal.Data.Parser (ParseError) import Streamly.Internal.Data.Stream.Type (Stream)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))  import qualified Streamly.Internal.Data.MutArray as MArray import qualified Streamly.Internal.Data.Fold.Type as FL@@ -58,12 +52,6 @@ -- Compact ------------------------------------------------------------------------------- -data SpliceState s arr-    = SpliceInitial s-    | SpliceBuffering s arr-    | SpliceYielding arr (SpliceState s arr)-    | SpliceFinish- -- XXX This can be removed once compactLEFold/compactLE are implemented. -- -- | This mutates the first array (if it has space) to append values from the@@ -78,117 +66,18 @@ -- actual array size may be less than the specified chunk size. -- -- @since 0.7.0-{-# INLINE_NORMAL packArraysChunksOf #-}+{-# INLINE packArraysChunksOf #-} packArraysChunksOf :: (MonadIO m, Unbox a)     => Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)-packArraysChunksOf n (D.Stream step state) =-    D.Stream step' (SpliceInitial state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (SpliceInitial st) = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.MutArray.Type.packArraysChunksOf: the size of "-                 ++ "arrays [" ++ show n ++ "] must be a natural number"-        r <- step gst st-        case r of-            D.Yield arr s -> return $-                let len = MArray.byteLength arr-                 in if len >= n-                    then D.Skip (SpliceYielding arr (SpliceInitial s))-                    else D.Skip (SpliceBuffering s arr)-            D.Skip s -> return $ D.Skip (SpliceInitial s)-            D.Stop -> return D.Stop--    step' gst (SpliceBuffering st buf) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                let len = MArray.byteLength buf + MArray.byteLength arr-                if len > n-                then return $-                    D.Skip (SpliceYielding buf (SpliceBuffering s arr))-                else do-                    buf' <- if MArray.byteCapacity buf < n-                            then liftIO $ MArray.realloc n buf-                            else return buf-                    buf'' <- MArray.splice buf' arr-                    return $ D.Skip (SpliceBuffering s buf'')-            D.Skip s -> return $ D.Skip (SpliceBuffering s buf)-            D.Stop -> return $ D.Skip (SpliceYielding buf SpliceFinish)--    step' _ SpliceFinish = return D.Stop--    step' _ (SpliceYielding arr next) = return $ D.Yield arr next+packArraysChunksOf = MArray.compactLE  -- XXX Remove this once compactLEFold is implemented -- lpackArraysChunksOf = Fold.many compactLEFold ---{-# INLINE_NORMAL lpackArraysChunksOf #-}+{-# INLINE lpackArraysChunksOf #-} lpackArraysChunksOf :: (MonadIO m, Unbox a)     => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()-lpackArraysChunksOf n (Fold step1 initial1 _ final1) =-    Fold step initial extract final--    where--    initial = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.MutArray.Type.packArraysChunksOf: the size of "-                 ++ "arrays [" ++ show n ++ "] must be a natural number"--        r <- initial1-        return $ first (Tuple' Nothing) r--    step (Tuple' Nothing r1) arr =-            let len = MArray.byteLength arr-             in if len >= n-                then do-                    r <- step1 r1 arr-                    case r of-                        FL.Done _ -> return $ FL.Done ()-                        FL.Partial s -> do-                            _ <- final1 s-                            res <- initial1-                            return $ first (Tuple' Nothing) res-                else return $ FL.Partial $ Tuple' (Just arr) r1--    step (Tuple' (Just buf) r1) arr = do-            let len = MArray.byteLength buf + MArray.byteLength arr-            buf' <- if MArray.byteCapacity buf < len-                    then liftIO $ MArray.realloc (max n len) buf-                    else return buf-            buf'' <- MArray.splice buf' arr--            -- XXX this is common in both the equations of step-            if len >= n-            then do-                r <- step1 r1 buf''-                case r of-                    FL.Done _ -> return $ FL.Done ()-                    FL.Partial s -> do-                        _ <- final1 s-                        res <- initial1-                        return $ first (Tuple' Nothing) res-            else return $ FL.Partial $ Tuple' (Just buf'') r1--    -- XXX Several folds do extract >=> final, therefore, we need to make final-    -- return  "m b" rather than using extract post it if we want extract to be-    -- partial.-    ---    -- extract forces the pending buffer to be sent to the fold which is not-    -- what we want.-    extract _ = error "lpackArraysChunksOf: not designed for scanning"--    final (Tuple' Nothing r1) = final1 r1-    final (Tuple' (Just buf) r1) = do-        r <- step1 r1 buf-        case r of-            FL.Partial rr -> final1 rr-            FL.Done _ -> return ()+lpackArraysChunksOf = MArray.lCompactGE  -- XXX Same as compactLE, to be removed once that is implemented. --@@ -208,48 +97,11 @@ -- actual array size may be less than the specified chunk size. -- -- /Internal/-{-# INLINE_NORMAL compactLEParserD #-}+{-# INLINE compactLEParserD #-} compactLEParserD ::        forall m a. (MonadIO m, Unbox a)     => Int -> ParserD.Parser (MutArray a) m (MutArray a)-compactLEParserD n = ParserD.Parser step initial extract--    where--    nBytes = n * SIZE_OF(a)--    initial =-        return-            $ if n <= 0-              then error-                       $ functionPath-                       ++ ": the size of arrays ["-                       ++ show n ++ "] must be a natural number"-              else ParserD.IPartial Nothing--    step Nothing arr =-        return-            $ let len = MArray.byteLength arr-               in if len >= nBytes-                  then ParserD.Done 0 arr-                  else ParserD.Partial 0 (Just arr)-    step (Just buf) arr =-        let len = MArray.byteLength buf + MArray.byteLength arr-         in if len > nBytes-            then return $ ParserD.Done 1 buf-            else do-                buf1 <--                    if MArray.byteCapacity buf < nBytes-                    then liftIO $ MArray.realloc nBytes buf-                    else return buf-                buf2 <- MArray.splice buf1 arr-                return $ ParserD.Partial 0 (Just buf2)--    extract Nothing = return $ ParserD.Done 0 MArray.nil-    extract (Just buf) = return $ ParserD.Done 0 buf--    functionPath =-        "Streamly.Internal.Data.Stream.MutChunked.compactLEParserD"+compactLEParserD = MArray.pCompactLE  -- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a -- minimum specified size. Note that if all the arrays in the stream together@@ -258,47 +110,11 @@ -- the specified size we stop coalescing further. -- -- /Internal/-{-# INLINE_NORMAL compactGEFold #-}+{-# INLINE compactGEFold #-} compactGEFold ::        forall m a. (MonadIO m, Unbox a)     => Int -> FL.Fold m (MutArray a) (MutArray a)-compactGEFold n = Fold step initial extract extract--    where--    nBytes = n * SIZE_OF(a)--    initial =-        return-            $ if n < 0-              then error-                       $ functionPath-                       ++ ": the size of arrays ["-                       ++ show n ++ "] must be a natural number"-              else FL.Partial Nothing--    step Nothing arr =-        return-            $ let len = MArray.byteLength arr-               in if len >= nBytes-                  then FL.Done arr-                  else FL.Partial (Just arr)-    step (Just buf) arr = do-        let len = MArray.byteLength buf + MArray.byteLength arr-        buf1 <--            if MArray.byteCapacity buf < len-            then liftIO $ MArray.realloc (max len nBytes) buf-            else return buf-        buf2 <- MArray.splice buf1 arr-        if len >= n-        then return $ FL.Done buf2-        else return $ FL.Partial (Just buf2)--    extract Nothing = return MArray.nil-    extract (Just buf) = return buf--    functionPath =-        "Streamly.Internal.Data.Stream.MutChunked.compactGEFold"+compactGEFold = MArray.fCompactGE  -- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a -- maximum specified size in bytes.
src/Streamly/Internal/Data/MutArray/Type.hs view
@@ -31,2382 +31,3221 @@     -- ** Type     -- $arrayNotes       MutArray (..)-    , MutByteArray-    , MutableByteArray-    , pin-    , unpin-    , isPinned--    -- -- * Constructing and Writing-    -- ** Construction-    , nil--    -- *** Uninitialized Arrays-    , pinnedNew-    , pinnedNewBytes-    , pinnedNewAligned-    , new-    , newArrayWith--    -- *** From streams-    , ArrayUnsafe (..)-    , writeNWithUnsafe-    , writeNWith-    , writeNUnsafe-    , pinnedWriteNUnsafe-    , writeN-    , pinnedWriteN-    , pinnedWriteNAligned--    , writeWith-    , write-    , pinnedWrite--    , writeRevN-    -- , writeRev--    -- *** From containers-    , fromListN-    , pinnedFromListN-    , fromList-    , pinnedFromList-    , fromListRevN-    , fromListRev-    , fromStreamDN-    , fromStreamD-    , fromPureStream--    -- ** Random writes-    , putIndex-    , putIndexUnsafe-    , putIndices-    -- , putFromThenTo-    -- , putFrom -- start writing at the given position-    -- , putUpto -- write from beginning up to the given position-    -- , putFromTo-    -- , putFromRev-    -- , putUptoRev-    , modifyIndexUnsafe-    , modifyIndex-    , modifyIndices-    , modify-    , swapIndices-    , unsafeSwapIndices--    -- ** Growing and Shrinking-    -- | Arrays grow only at the end, though it is possible to grow on both sides-    -- and therefore have a cons as well as snoc. But that will require two-    -- bounds in the array representation.--    -- *** Appending elements-    , snocWith-    , snoc-    , snocLinear-    , snocMay-    , snocUnsafe--    -- *** Appending streams-    , writeAppendNUnsafe-    , writeAppendN-    , writeAppendWith-    , writeAppend--    -- ** Eliminating and Reading--    -- *** To streams-    , reader-    , readerRevWith-    , readerRev--    -- *** To containers-    , toStreamDWith-    , toStreamDRevWith-    , toStreamKWith-    , toStreamKRevWith-    , read-    , readRev-    , toStreamK-    , toStreamKRev-    , toList--    -- experimental-    , producerWith-    , producer--    -- *** Random reads-    , getIndex-    , getIndexUnsafe-    , getIndices-    , getIndicesD-    -- , getFromThenTo-    , getIndexRev--    -- ** Memory Management-    , blockSize-    , arrayChunkBytes-    , allocBytesToElemCount-    , realloc-    , resize-    , resizeExp-    , rightSize--    -- ** Size-    , length-    , byteLength-    -- , capacity-    , byteCapacity-    , bytesFree--    -- ** In-place Mutation Algorithms-    , strip-    , reverse-    , permute-    , partitionBy-    , shuffleBy-    , divideBy-    , mergeBy-    , bubble--    -- ** Casting-    , cast-    , castUnsafe-    , asBytes-    , asPtrUnsafe--    -- ** Folding-    , foldl'-    , foldr-    , cmp--    -- ** Arrays of arrays-    --  We can add dimensionality parameter to the array type to get-    --  multidimensional arrays. Multidimensional arrays would just be a-    --  convenience wrapper on top of single dimensional arrays.--    -- | Operations dealing with multiple arrays, streams of arrays or-    -- multidimensional array representations.--    -- *** Construct from streams-    , chunksOf-    , pinnedChunksOf-    , writeChunks--    -- *** Eliminate to streams-    , flattenArrays-    , flattenArraysRev-    , fromArrayStreamK--    -- *** Construct from arrays-    -- get chunks without copying-    , getSliceUnsafe-    , getSlice-    -- , getSlicesFromLenN-    , splitAt -- XXX should be able to express using getSlice-    , breakOn--    -- ** Cloning arrays-    , clone-    , pinnedClone--    -- ** Appending arrays-    , spliceCopy-    , spliceWith-    , splice-    , spliceExp-    , spliceUnsafe-    -- , putSlice-    -- , appendSlice-    -- , appendSliceFrom--    -- ** Utilities-    , roundUpToPower2-    , memcpy-    , memcmp-    , c_memchr-    )-where--#include "assert.hs"-#include "inline.hs"-#include "ArrayMacros.h"-#include "MachDeps.h"--import Control.Monad (when, void)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bits (shiftR, (.|.), (.&.))-import Data.Functor.Identity (Identity(..))-import Data.Proxy (Proxy(..))-import Data.Word (Word8)-import Foreign.C.Types (CSize(..), CInt(..))-import Foreign.Ptr (plusPtr, minusPtr, nullPtr)-import Streamly.Internal.Data.MutByteArray.Type-    ( MutByteArray(..)-    , MutableByteArray-    , PinnedState(..)-    , getMutableByteArray#-    , putSliceUnsafe-    )-import Streamly.Internal.Data.Unbox (Unbox(..))-import GHC.Base-    ( IO(..)-    , Int(..)-    , compareByteArrays#-    , copyMutableByteArray#-    )-import GHC.Base (noinline)-import GHC.Exts (unsafeCoerce#)-import GHC.Ptr (Ptr(..))--import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer (..))-import Streamly.Internal.Data.Stream.Type (Stream)-import Streamly.Internal.Data.StreamK.Type (StreamK)-import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)--import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Stream.Type as D-import qualified Streamly.Internal.Data.Stream.Lift as D-import qualified Streamly.Internal.Data.StreamK.Type as K-import qualified Prelude--import Prelude hiding-    (Foldable(..), read, unlines, splitAt, reverse, truncate)--#include "DocTestDataMutArray.hs"------------------------------------------------------------------------------------ Foreign helpers----------------------------------------------------------------------------------foreign import ccall unsafe "string.h memcpy" c_memcpy-    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)--foreign import ccall unsafe "string.h memchr" c_memchr-    :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)--foreign import ccall unsafe "string.h memcmp" c_memcmp-    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt---- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return--- how many elements of that type will completely fit in those bytes.----{-# INLINE bytesToElemCount #-}-bytesToElemCount :: forall a. Unbox a => a -> Int -> Int-bytesToElemCount _ n = n `div` SIZE_OF(a)---- XXX we are converting Int to CSize-memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()-memcpy dst src len = void (c_memcpy dst src (fromIntegral len))---- XXX we are converting Int to CSize--- return True if the memory locations have identical contents-{-# INLINE memcmp #-}-memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool-memcmp p1 p2 len = do-    r <- c_memcmp p1 p2 (fromIntegral len)-    return $ r == 0------------------------------------------------------------------------------------ MutArray Data Type------------------------------------------------------------------------------------ $arrayNotes------ We can use an 'Unboxed' constraint in the MutArray type and the constraint--- can be automatically provided to a function that pattern matches on the--- MutArray type. However, it has huge performance cost, so we do not use it.--- Investigate a GHC improvement possiblity.---- | An unboxed mutable array. An array is created with a given length--- and capacity. Length is the number of valid elements in the array.  Capacity--- is the maximum number of elements that the array can be expanded to without--- having to reallocate the memory.------ The elements in the array can be mutated in-place without changing the--- reference (constructor). However, the length of the array cannot be mutated--- in-place.  A new array reference is generated when the length changes.  When--- the length is increased (upto the maximum reserved capacity of the array),--- the array is not reallocated and the new reference uses the same underlying--- memory as the old one.------ Several routines in this module allow the programmer to control the capacity--- of the array. The programmer can control the trade-off between memory usage--- and performance impact due to reallocations when growing or shrinking the--- array.----data MutArray a =-#ifdef DEVBUILD-    Unbox a =>-#endif-    -- The array is a range into arrContents. arrContents may be a superset of-    -- the slice represented by the array. All offsets are in bytes.-    MutArray-    { arrContents :: {-# UNPACK #-} !MutByteArray-    , arrStart :: {-# UNPACK #-} !Int  -- ^ index into arrContents-    , arrEnd   :: {-# UNPACK #-} !Int    -- ^ index into arrContents-                                       -- Represents the first invalid index of-                                       -- the array.-    , arrBound :: {-# UNPACK #-} !Int    -- ^ first invalid index of arrContents.-    }------------------------------------------------------------------------------------ Pinning & Unpinning------------------------------------------------------------------------------------ | Return a copy of the array in pinned memory if unpinned, else return the--- original array.-{-# INLINE pin #-}-pin :: MutArray a -> IO (MutArray a)-pin arr@MutArray{..} =-    if Unboxed.isPinned arrContents-    then pure arr-    else pinnedClone arr---- | Return a copy of the array in unpinned memory if pinned, else return the--- original array.-{-# INLINE unpin #-}-unpin :: MutArray a -> IO (MutArray a)-unpin arr@MutArray{..} =-    if Unboxed.isPinned arrContents-    then clone arr-    else pure arr---- | Return 'True' if the array is allocated in pinned memory.-{-# INLINE isPinned #-}-isPinned :: MutArray a -> Bool-isPinned MutArray{..} = Unboxed.isPinned arrContents------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ XXX Change the names to use "new" instead of "newArray". That way we can use--- the same names for managed file system objects as well. For unmanaged ones--- we can use open/create etc as usual.------ A new array is similar to "touch" creating a zero length file. An mmapped--- array would be similar to a sparse file with holes. TBD: support mmapped--- files and arrays.---- GHC always guarantees word-aligned memory, alignment is important only when--- we need more than that.  See stg_pinnedNewAlignedByteArrayzh and--- allocatePinned in GHC source.---- | @newArrayWith allocator alignment count@ allocates a new array of zero--- length and with a capacity to hold @count@ elements, using @allocator--- size alignment@ as the memory allocator function.------ Alignment must be greater than or equal to machine word size and a power of--- 2.------ Alignment is ignored if the allocator allocates unpinned memory.------ /Pre-release/-{-# INLINE newArrayWith #-}-newArrayWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)-newArrayWith alloc alignSize count = do-    let size = max (count * SIZE_OF(a)) 0-    contents <- alloc size alignSize-    return $ MutArray-        { arrContents = contents-        , arrStart = 0-        , arrEnd   = 0-        , arrBound = size-        }--nil ::-#ifdef DEVBUILD-    Unbox a =>-#endif-    MutArray a-nil = MutArray Unboxed.nil 0 0 0--{-# INLINE newBytesAs #-}-newBytesAs :: MonadIO m =>-#ifdef DEVBUILD-    Unbox a =>-#endif-    PinnedState -> Int -> m (MutArray a)-newBytesAs ps bytes = do-    contents <- liftIO $ Unboxed.newBytesAs ps bytes-    return $ MutArray-        { arrContents = contents-        , arrStart = 0-        , arrEnd   = 0-        , arrBound = bytes-        }---- | Allocates a pinned empty array that can hold 'count' items.  The memory of--- the array is uninitialized and the allocation is aligned as per the--- 'Unboxed' instance of the type.------ /Pre-release/-{-# INLINE pinnedNewBytes #-}-pinnedNewBytes :: MonadIO m =>-#ifdef DEVBUILD-    Unbox a =>-#endif-    Int -> m (MutArray a)-pinnedNewBytes = newBytesAs Pinned---- | Like 'newArrayWith' but using an allocator is a pinned memory allocator and--- the alignment is dictated by the 'Unboxed' instance of the type.------ /Internal/-{-# INLINE pinnedNewAligned #-}-pinnedNewAligned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)-pinnedNewAligned =-    newArrayWith (\s a -> liftIO $ Unboxed.pinnedNewAlignedBytes s a)--{-# INLINE newAs #-}-newAs :: (MonadIO m, Unbox a) => PinnedState -> Int -> m (MutArray a)-newAs ps =-    newArrayWith-        (\s _ -> liftIO $ Unboxed.newBytesAs ps s)-        (error "new: alignment is not used in unpinned arrays.")---- XXX can unaligned allocation be more efficient when alignment is not needed?------ | Allocates an empty pinned array that can hold 'count' items.  The memory of--- the array is uninitialized and the allocation is aligned as per the 'Unboxed'--- instance of the type.----{-# INLINE pinnedNew #-}-pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)-pinnedNew = newAs Pinned---- | Allocates an empty unpinned array that can hold 'count' items.  The memory--- of the array is uninitialized.----{-# INLINE new #-}-new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)-new = newAs Unpinned------------------------------------------------------------------------------------ Random writes------------------------------------------------------------------------------------ | Write the given element to the given index of the array. Does not check if--- the index is out of bounds of the array.------ /Pre-release/-{-# INLINE putIndexUnsafe #-}-putIndexUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> MutArray a -> a -> m ()-putIndexUnsafe i MutArray{..} x = do-    let index = INDEX_OF(arrStart, i, a)-    assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())-    liftIO $ pokeAt index arrContents  x--invalidIndex :: String -> Int -> a-invalidIndex label i =-    error $ label ++ ": invalid array index " ++ show i---- | /O(1)/ Write the given element at the given index in the array.--- Performs in-place mutation of the array.------ >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))--- >>> f = MutArray.putIndices--- >>> putIndex ix arr val = Stream.fold (f arr) (Stream.fromPure (ix, val))----{-# INLINE putIndex #-}-putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()-putIndex i MutArray{..} x = do-    let index = INDEX_OF(arrStart,i,a)-    if i >= 0 && INDEX_VALID(index,arrEnd,a)-    then liftIO $ pokeAt index arrContents  x-    else invalidIndex "putIndex" i---- | Write an input stream of (index, value) pairs to an array. Throws an--- error if any index is out of bounds.------ /Pre-release/-{-# INLINE putIndices #-}-putIndices :: forall m a. (MonadIO m, Unbox a)-    => MutArray a -> Fold m (Int, a) ()-putIndices arr = FL.foldlM' step (return ())--    where--    step () (i, x) = liftIO (putIndex i arr x)---- | Modify a given index of an array using a modifier function.------ Unsafe because it does not check the bounds of the array.------ /Pre-release/-modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndexUnsafe i MutArray{..} f = liftIO $ do-        let index = INDEX_OF(arrStart,i,a)-        assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())-        r <- peekAt index arrContents-        let (x, res) = f r-        pokeAt index arrContents  x-        return res---- | Modify a given index of an array using a modifier function.------ /Pre-release/-modifyIndex :: forall m a b. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndex i MutArray{..} f = do-    let index = INDEX_OF(arrStart,i,a)-    if i >= 0 && INDEX_VALID(index,arrEnd,a)-    then liftIO $ do-        r <- peekAt index arrContents-        let (x, res) = f r-        pokeAt index arrContents  x-        return res-    else invalidIndex "modifyIndex" i---- | Modify the array indices generated by the supplied stream.------ /Pre-release/-{-# INLINE modifyIndices #-}-modifyIndices :: forall m a . (MonadIO m, Unbox a)-    => MutArray a -> (Int -> a -> a) -> Fold m Int ()-modifyIndices arr f = FL.foldlM' step initial--    where--    initial = return ()--    step () i =-        let f1 x = (f i x, ())-         in modifyIndex i arr f1---- | Modify each element of an array using the supplied modifier function.------ This is an in-place equivalent of an immutable map operation.------ /Pre-release/-modify :: forall m a. (MonadIO m, Unbox a)-    => MutArray a -> (a -> a) -> m ()-modify MutArray{..} f = liftIO $-    go arrStart--    where--    go i =-        when (INDEX_VALID(i,arrEnd,a)) $ do-            r <- peekAt i arrContents-            pokeAt i arrContents (f r)-            go (INDEX_NEXT(i,a))---- XXX We could specify the number of bytes to swap instead of Proxy. Need--- to ensure that the memory does not overlap.-{-# INLINE swapArrayByteIndices #-}-swapArrayByteIndices ::-       forall a. Unbox a-    => Proxy a-    -> MutByteArray-    -> Int-    -> Int-    -> IO ()-swapArrayByteIndices _ arrContents i1 i2 = do-    r1 <- peekAt i1 arrContents-    r2 <- peekAt i2 arrContents-    pokeAt i1 arrContents (r2 :: a)-    pokeAt i2 arrContents (r1 :: a)---- | Swap the elements at two indices without validating the indices.------ /Unsafe/: This could result in memory corruption if indices are not valid.------ /Pre-release/-{-# INLINE unsafeSwapIndices #-}-unsafeSwapIndices :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> MutArray a -> m ()-unsafeSwapIndices i1 i2 MutArray{..} = liftIO $ do-        let t1 = INDEX_OF(arrStart,i1,a)-            t2 = INDEX_OF(arrStart,i2,a)-        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2---- | Swap the elements at two indices.------ /Pre-release/-swapIndices :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> MutArray a -> m ()-swapIndices i1 i2 MutArray{..} = liftIO $ do-        let t1 = INDEX_OF(arrStart,i1,a)-            t2 = INDEX_OF(arrStart,i2,a)-        when (i1 < 0 || INDEX_INVALID(t1,arrEnd,a))-            $ invalidIndex "swapIndices" i1-        when (i2 < 0 || INDEX_INVALID(t2,arrEnd,a))-            $ invalidIndex "swapIndices" i2-        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2------------------------------------------------------------------------------------ Rounding------------------------------------------------------------------------------------ XXX Should we use bitshifts in calculations or it gets optimized by the--- compiler/processor itself?------ | The page or block size used by the GHC allocator. Allocator allocates at--- least a block and then allocates smaller allocations from within a block.-blockSize :: Int-blockSize = 4 * 1024---- | Allocations larger than 'largeObjectThreshold' are in multiples of block--- size and are always pinned. The space beyond the end of a large object up to--- the end of the block is unused.-largeObjectThreshold :: Int-largeObjectThreshold = (blockSize * 8) `div` 10---- XXX Should be done only when we are using the GHC allocator.--- | Round up an array larger than 'largeObjectThreshold' to use the whole--- block.-{-# INLINE roundUpLargeArray #-}-roundUpLargeArray :: Int -> Int-roundUpLargeArray size =-    if size >= largeObjectThreshold-    then-        assert-            (blockSize /= 0 && ((blockSize .&. (blockSize - 1)) == 0))-            ((size + blockSize - 1) .&. negate blockSize)-    else size--{-# INLINE isPower2 #-}-isPower2 :: Int -> Bool-isPower2 n = n .&. (n - 1) == 0--{-# INLINE roundUpToPower2 #-}-roundUpToPower2 :: Int -> Int-roundUpToPower2 n =-#if WORD_SIZE_IN_BITS == 64-    1 + z6-#else-    1 + z5-#endif--    where--    z0 = n - 1-    z1 = z0 .|. z0 `shiftR` 1-    z2 = z1 .|. z1 `shiftR` 2-    z3 = z2 .|. z2 `shiftR` 4-    z4 = z3 .|. z3 `shiftR` 8-    z5 = z4 .|. z4 `shiftR` 16-    z6 = z5 .|. z5 `shiftR` 32---- | @allocBytesToBytes elem allocatedBytes@ returns the array size in bytes--- such that the real allocation is less than or equal to @allocatedBytes@,--- unless @allocatedBytes@ is less than the size of one array element in which--- case it returns one element's size.----{-# INLINE allocBytesToBytes #-}-allocBytesToBytes :: forall a. Unbox a => a -> Int -> Int-allocBytesToBytes _ n = max (arrayPayloadSize n) (SIZE_OF(a))---- | Given an 'Unboxed' type (unused first arg) and real allocation size--- (including overhead), return how many elements of that type will completely--- fit in it, returns at least 1.----{-# INLINE allocBytesToElemCount #-}-allocBytesToElemCount :: Unbox a => a -> Int -> Int-allocBytesToElemCount x bytes =-    let n = bytesToElemCount x (allocBytesToBytes x bytes)-     in assert (n >= 1) n---- | The default chunk size by which the array creation routines increase the--- size of the array when the array is grown linearly.-arrayChunkBytes :: Int-arrayChunkBytes = 1024------------------------------------------------------------------------------------ Resizing------------------------------------------------------------------------------------ | Round the second argument down to multiples of the first argument.-{-# INLINE roundDownTo #-}-roundDownTo :: Int -> Int -> Int-roundDownTo elemSize size = size - (size `mod` elemSize)---- XXX See if resizing can be implemented by reading the old array as a stream--- and then using writeN to the new array.------ NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.--- Since this is not inlined Unboxed consrraint leads to dictionary passing--- which complicates some inspection tests.----{-# NOINLINE reallocExplicit #-}-reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)-reallocExplicit elemSize newCapacityInBytes MutArray{..} = do-    assertM(arrEnd <= arrBound)--    -- Allocate new array-    let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes-    contents <--        if Unboxed.isPinned arrContents-        then Unboxed.pinnedNew newCapMaxInBytes-        else Unboxed.new newCapMaxInBytes-    let !(MutByteArray mbarrFrom#) = arrContents-        !(MutByteArray mbarrTo#) = contents--    -- Copy old data-    let oldStart = arrStart-        !(I# oldStartInBytes#) = oldStart-        oldSizeInBytes = arrEnd - oldStart-        newCapInBytes = roundDownTo elemSize newCapMaxInBytes-        !newLenInBytes@(I# newLenInBytes#) = min oldSizeInBytes newCapInBytes-    assert (oldSizeInBytes `mod` elemSize == 0) (return ())-    assert (newLenInBytes >= 0) (return ())-    assert (newLenInBytes `mod` elemSize == 0) (return ())-    IO $ \s# -> (# copyMutableByteArray# mbarrFrom# oldStartInBytes#-                        mbarrTo# 0# newLenInBytes# s#, () #)--    return $ MutArray-        { arrStart = 0-        , arrContents = contents-        , arrEnd   = newLenInBytes-        , arrBound = newCapInBytes-        }---- | @realloc newCapacity array@ reallocates the array to the specified--- capacity in bytes.------ If the new size is less than the original array the array gets truncated.--- If the new size is not a multiple of array element size then it is rounded--- down to multiples of array size.  If the new size is more than--- 'largeObjectThreshold' then it is rounded up to the block size (4K).------ If the original array is pinned, the newly allocated array is also pinned.-{-# INLINABLE realloc #-}-realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)-realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr---- | @reallocWith label capSizer minIncrBytes array@. The label is used--- in error messages and the capSizer is used to determine the capacity of the--- new array in bytes given the current byte length of the array.-reallocWith :: forall m a. (MonadIO m , Unbox a) =>-       String-    -> (Int -> Int)-    -> Int-    -> MutArray a-    -> m (MutArray a)-reallocWith label capSizer minIncrBytes arr = do-    let oldSizeBytes = arrEnd arr - arrStart arr-        newCapBytes = capSizer oldSizeBytes-        newSizeBytes = oldSizeBytes + minIncrBytes-        safeCapBytes = max newCapBytes newSizeBytes-    assertM(safeCapBytes >= newSizeBytes || error (badSize newSizeBytes))--    realloc safeCapBytes arr--    where--    badSize newSize =-        concat-            [ label-            , ": new array size (in bytes) is less than required size "-            , show newSize-            , ". Please check the sizing function passed."-            ]---- | @resize newCapacity array@ changes the total capacity of the array so that--- it is enough to hold the specified number of elements.  Nothing is done if--- the specified capacity is less than the length of the array.------ If the capacity is more than 'largeObjectThreshold' then it is rounded up to--- the block size (4K).------ /Pre-release/-{-# INLINE resize #-}-resize :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-resize nElems arr@MutArray{..} = do-    let req = SIZE_OF(a) * nElems-        len = arrEnd - arrStart-    if req < len-    then return arr-    else realloc req arr---- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'--- then it is rounded up to the closest power of 2.------ /Pre-release/-{-# INLINE resizeExp #-}-resizeExp :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-resizeExp nElems arr@MutArray{..} = do-    let req = roundUpLargeArray (SIZE_OF(a) * nElems)-        req1 =-            if req > largeObjectThreshold-            then roundUpToPower2 req-            else req-        len = arrEnd - arrStart-    if req1 < len-    then return arr-    else realloc req1 arr---- | Resize the allocated memory to drop any reserved free space at the end of--- the array and reallocate it to reduce wastage.------ Up to 25% wastage is allowed to avoid reallocations.  If the capacity is--- more than 'largeObjectThreshold' then free space up to the 'blockSize' is--- retained.------ /Pre-release/-{-# INLINE rightSize #-}-rightSize :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m (MutArray a)-rightSize arr@MutArray{..} = do-    assert (arrEnd <= arrBound) (return ())-    let start = arrStart-        len = arrEnd - start-        capacity = arrBound - start-        target = roundUpLargeArray len-        waste = arrBound - arrEnd-    assert (target >= len) (return ())-    assert (len `mod` SIZE_OF(a) == 0) (return ())-    -- We trade off some wastage (25%) to avoid reallocations and copying.-    if target < capacity && len < 3 * waste-    then realloc target arr-    else return arr------------------------------------------------------------------------------------ Snoc------------------------------------------------------------------------------------ XXX We can possibly use a smallMutableByteArray to hold the start, end,--- bound pointers.  Using fully mutable handle will ensure that we do not have--- multiple references to the same array of different lengths lying around and--- potentially misused. In that case "snoc" need not return a new array (snoc--- :: MutArray a -> a -> m ()), it will just modify the old reference.  The array--- length will be mutable.  This means the length function would also be--- monadic.  Mutable arrays would behave more like files that grow in that--- case.---- | Snoc using a 'Ptr'. Low level reusable function.------ /Internal/-{-# INLINE snocNewEnd #-}-snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)-snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do-    assert (newEnd <= arrBound) (return ())-    pokeAt arrEnd arrContents x-    return $ arr {arrEnd = newEnd}---- | Really really unsafe, appends the element into the first array, may--- cause silent data corruption or if you are lucky a segfault if the first--- array does not have enough space to append the element.------ /Internal/-{-# INLINE snocUnsafe #-}-snocUnsafe :: forall m a. (MonadIO m, Unbox a) =>-    MutArray a -> a -> m (MutArray a)-snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr---- | Like 'snoc' but does not reallocate when pre-allocated array capacity--- becomes full.------ /Internal/-{-# INLINE snocMay #-}-snocMay :: forall m a. (MonadIO m, Unbox a) =>-    MutArray a -> a -> m (Maybe (MutArray a))-snocMay arr@MutArray{..} x = liftIO $ do-    let newEnd = INDEX_NEXT(arrEnd,a)-    if newEnd <= arrBound-    then Just <$> snocNewEnd newEnd arr x-    else return Nothing---- NOINLINE to move it out of the way and not pollute the instruction cache.-{-# NOINLINE snocWithRealloc #-}-snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>-       (Int -> Int)-    -> MutArray a-    -> a-    -> m (MutArray a)-snocWithRealloc sizer arr x = do-    arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr-    snocUnsafe arr1 x---- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of--- the array increases by 1.------ If there is no reserved space available in @arr@ it is reallocated to a size--- in bytes determined by the @sizer oldSizeBytes@ function, where--- @oldSizeBytes@ is the original size of the array in bytes.------ If the new array size is more than 'largeObjectThreshold' we automatically--- round it up to 'blockSize'.------ Note that the returned array may be a mutated version of the original array.------ /Pre-release/-{-# INLINE snocWith #-}-snocWith :: forall m a. (MonadIO m, Unbox a) =>-       (Int -> Int)-    -> MutArray a-    -> a-    -> m (MutArray a)-snocWith allocSize arr x = liftIO $ do-    let newEnd = INDEX_NEXT(arrEnd arr,a)-    if newEnd <= arrBound arr-    then snocNewEnd newEnd arr x-    else snocWithRealloc allocSize arr x---- | The array is mutated to append an additional element to it. If there--- is no reserved space available in the array then it is reallocated to grow--- it by 'arrayChunkBytes' rounded up to 'blockSize' when the size becomes more--- than 'largeObjectThreshold'.------ Note that the returned array may be a mutated version of the original array.------ Performs O(n^2) copies to grow but is thrifty on memory.------ /Pre-release/-{-# INLINE snocLinear #-}-snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)-snocLinear = snocWith (+ allocBytesToBytes (undefined :: a) arrayChunkBytes)---- | The array is mutated to append an additional element to it. If there is no--- reserved space available in the array then it is reallocated to double the--- original size.------ This is useful to reduce allocations when appending unknown number of--- elements.------ Note that the returned array may be a mutated version of the original array.------ >>> snoc = MutArray.snocWith (* 2)------ Performs O(n * log n) copies to grow, but is liberal with memory allocation.----{-# INLINE snoc #-}-snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)-snoc = snocWith f--    where--    f oldSize =-        if isPower2 oldSize-        then oldSize * 2-        else roundUpToPower2 oldSize * 2------------------------------------------------------------------------------------ Random reads------------------------------------------------------------------------------------ XXX Can this be deduplicated with array/foreign---- | Return the element at the specified index without checking the bounds.------ Unsafe because it does not check the bounds of the array.-{-# INLINE_NORMAL getIndexUnsafe #-}-getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a-getIndexUnsafe i MutArray{..} = do-    let index = INDEX_OF(arrStart,i,a)-    assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())-    liftIO $ peekAt index arrContents---- | /O(1)/ Lookup the element at the given index. Index starts from 0.----{-# INLINE getIndex #-}-getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)-getIndex i MutArray{..} = do-    let index = INDEX_OF(arrStart,i,a)-    if i >= 0 && INDEX_VALID(index,arrEnd,a)-    then liftIO $ Just <$> peekAt index arrContents-    else return Nothing---- | /O(1)/ Lookup the element at the given index from the end of the array.--- Index starts from 0.------ Slightly faster than computing the forward index and using getIndex.----{-# INLINE getIndexRev #-}-getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a-getIndexRev i MutArray{..} = do-    let index = RINDEX_OF(arrEnd,i,a)-    if i >= 0 && index >= arrStart-    then liftIO $ peekAt index arrContents-    else invalidIndex "getIndexRev" i--data GetIndicesState contents start end st =-    GetIndicesState contents start end st---- | Given an unfold that generates array indices, read the elements on those--- indices from the supplied MutArray. An error is thrown if an index is out of--- bounds.------ /Pre-release/-{-# INLINE getIndicesD #-}-getIndicesD :: (Monad m, Unbox a) =>-    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a-getIndicesD liftio (D.Stream stepi sti) = Unfold step inject--    where--    inject (MutArray contents start end _) =-        return $ GetIndicesState contents start end sti--    {-# INLINE_LATE step #-}-    step (GetIndicesState contents start end st) = do-        r <- stepi defState st-        case r of-            D.Yield i s -> do-                x <- liftio $ getIndex i (MutArray contents start end undefined)-                case x of-                    Just v -> return $ D.Yield v (GetIndicesState contents start end s)-                    Nothing -> error "Invalid Index"-            D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)-            D.Stop -> return D.Stop--{-# INLINE getIndices #-}-getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a-getIndices = getIndicesD liftIO------------------------------------------------------------------------------------ Subarrays------------------------------------------------------------------------------------ XXX We can also get immutable slices.---- | /O(1)/ Slice an array in constant time.------ Unsafe: The bounds of the slice are not checked.------ /Unsafe/------ /Pre-release/-{-# INLINE getSliceUnsafe #-}-getSliceUnsafe :: forall a. Unbox a-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSliceUnsafe index len (MutArray contents start e _) =-    let fp1 = INDEX_OF(start,index,a)-        end = fp1 + (len * SIZE_OF(a))-     in assert-            (index >= 0 && len >= 0 && end <= e)-            -- Note: In a slice we always use bound = end so that the slice-            -- user cannot overwrite elements beyond the end of the slice.-            (MutArray contents fp1 end end)---- | /O(1)/ Slice an array in constant time. Throws an error if the slice--- extends out of the array bounds.------ /Pre-release/-{-# INLINE getSlice #-}-getSlice :: forall a. Unbox a =>-       Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSlice index len (MutArray contents start e _) =-    let fp1 = INDEX_OF(start,index,a)-        end = fp1 + (len * SIZE_OF(a))-     in if index >= 0 && len >= 0 && end <= e-        -- Note: In a slice we always use bound = end so that the slice user-        -- cannot overwrite elements beyond the end of the slice.-        then MutArray contents fp1 end end-        else error-                $ "getSlice: invalid slice, index "-                ++ show index ++ " length " ++ show len------------------------------------------------------------------------------------ In-place mutation algorithms------------------------------------------------------------------------------------ XXX consider the bulk update/accumulation/permutation APIs from vector.---- | You may not need to reverse an array because you can consume it in reverse--- using 'readerRev'. To reverse large arrays you can read in reverse and write--- to another array. However, in-place reverse can be useful to take adavantage--- of cache locality and when you do not want to allocate additional memory.----{-# INLINE reverse #-}-reverse :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m ()-reverse MutArray{..} = liftIO $ do-    let l = arrStart-        h = INDEX_PREV(arrEnd,a)-     in swap l h--    where--    swap l h = do-        when (l < h) $ do-            swapArrayByteIndices (Proxy :: Proxy a) arrContents l h-            swap (INDEX_NEXT(l,a)) (INDEX_PREV(h,a))---- | Generate the next permutation of the sequence, returns False if this is--- the last permutation.------ /Unimplemented/-{-# INLINE permute #-}-permute :: MutArray a -> m Bool-permute = undefined---- | Partition an array into two halves using a partitioning predicate. The--- first half retains values where the predicate is 'False' and the second half--- retains values where the predicate is 'True'.------ /Pre-release/-{-# INLINE partitionBy #-}-partitionBy :: forall m a. (MonadIO m, Unbox a)-    => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)-partitionBy f arr@MutArray{..} = liftIO $ do-    if arrStart >= arrEnd-    then return (arr, arr)-    else do-        ptr <- go arrStart (INDEX_PREV(arrEnd,a))-        let pl = MutArray arrContents arrStart ptr ptr-            pr = MutArray arrContents ptr arrEnd arrEnd-        return (pl, pr)--    where--    -- Invariant low < high on entry, and on return as well-    moveHigh low high = do-        h <- peekAt high arrContents-        if f h-        then-            -- Correctly classified, continue the loop-            let high1 = INDEX_PREV(high,a)-             in if low == high1-                then return Nothing-                else moveHigh low high1-        else return (Just (high, h)) -- incorrectly classified--    -- Keep a low pointer starting at the start of the array (first partition)-    -- and a high pointer starting at the end of the array (second partition).-    -- Keep incrementing the low ptr and decrementing the high ptr until both-    -- are wrongly classified, at that point swap the two and continue until-    -- the two pointer cross each other.-    ---    -- Invariants when entering this loop:-    -- low <= high-    -- Both low and high are valid locations within the array-    go low high = do-        l <- peekAt low arrContents-        if f l-        then-            -- low is wrongly classified-            if low == high-            then return low-            else do -- low < high-                r <- moveHigh low high-                case r of-                    Nothing -> return low-                    Just (high1, h) -> do -- low < high1-                        pokeAt low arrContents h-                        pokeAt high1 arrContents l-                        let low1 = INDEX_NEXT(low,a)-                            high2 = INDEX_PREV(high1,a)-                        if low1 <= high2-                        then go low1 high2-                        else return low1 -- low1 > high2--        else do-            -- low is correctly classified-            let low1 = INDEX_NEXT(low,a)-            if low == high-            then return low1-            else go low1 high---- | Shuffle corresponding elements from two arrays using a shuffle function.--- If the shuffle function returns 'False' then do nothing otherwise swap the--- elements. This can be used in a bottom up fold to shuffle or reorder the--- elements.------ /Unimplemented/-{-# INLINE shuffleBy #-}-shuffleBy :: (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()-shuffleBy = undefined---- XXX we can also make the folds partial by stopping at a certain level.------ | @divideBy level partition array@  performs a top down hierarchical--- recursive partitioning fold of items in the container using the given--- function as the partition function.  Level indicates the level in the tree--- where the fold would stop.------ This performs a quick sort if the partition function is--- 'partitionBy (< pivot)'.------ /Unimplemented/-{-# INLINABLE divideBy #-}-divideBy ::-    Int -> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()-divideBy = undefined---- | @mergeBy level merge array@ performs a pairwise bottom up fold recursively--- merging the pairs using the supplied merge function. Level indicates the--- level in the tree where the fold would stop.------ This performs a random shuffle if the merge function is random.  If we--- stop at level 0 and repeatedly apply the function then we can do a bubble--- sort.------ /Unimplemented/-mergeBy :: Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()-mergeBy = undefined------------------------------------------------------------------------------------ Size------------------------------------------------------------------------------------ | /O(1)/ Get the byte length of the array.----{-# INLINE byteLength #-}-byteLength :: MutArray a -> Int-byteLength MutArray{..} =-    let len = arrEnd - arrStart-    in assert (len >= 0) len---- Note: try to avoid the use of length in performance sensitive internal--- routines as it involves a costly 'div' operation. Instead use the end ptr--- in the array to check the bounds etc.------ | /O(1)/ Get the length of the array i.e. the number of elements in the--- array.------ Note that 'byteLength' is less expensive than this operation, as 'length'--- involves a costly division operation.----{-# INLINE length #-}-length :: forall a. Unbox a => MutArray a -> Int-length arr =-    let elemSize = SIZE_OF(a)-        blen = byteLength arr-     in assert (blen `mod` elemSize == 0) (blen `div` elemSize)---- | Get the total capacity of an array. An array may have space reserved--- beyond the current used length of the array.------ /Pre-release/-{-# INLINE byteCapacity #-}-byteCapacity :: MutArray a -> Int-byteCapacity MutArray{..} =-    let len = arrBound - arrStart-    in assert (len >= 0) len---- | The remaining capacity in the array for appending more elements without--- reallocation.------ /Pre-release/-{-# INLINE bytesFree #-}-bytesFree :: MutArray a -> Int-bytesFree MutArray{..} =-    let n = arrBound - arrEnd-    in assert (n >= 0) n------------------------------------------------------------------------------------ Streams of arrays - Creation----------------------------------------------------------------------------------data GroupState s contents start end bound-    = GroupStart s-    | GroupBuffer s contents start end bound-    | GroupYield-        contents start end bound (GroupState s contents start end bound)-    | GroupFinish--{-# INLINE_NORMAL chunksOfAs #-}-chunksOfAs :: forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> D.Stream m a -> D.Stream m (MutArray a)-chunksOfAs ps n (D.Stream step state) =-    D.Stream step' (GroupStart state)--    where--    {-# INLINE_LATE step' #-}-    step' _ (GroupStart st) = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.MutArray.Mut.Type.chunksOf: "-                    ++ "the size of arrays [" ++ show n-                    ++ "] must be a natural number"-        (MutArray contents start end bound :: MutArray a) <- newAs ps n-        return $ D.Skip (GroupBuffer st contents start end bound)--    step' gst (GroupBuffer st contents start end bound) = do-        r <- step (adaptState gst) st-        case r of-            D.Yield x s -> do-                liftIO $ pokeAt end contents  x-                let end1 = INDEX_NEXT(end,a)-                return $-                    if end1 >= bound-                    then D.Skip-                            (GroupYield-                                contents start end1 bound (GroupStart s))-                    else D.Skip (GroupBuffer s contents start end1 bound)-            D.Skip s ->-                return $ D.Skip (GroupBuffer s contents start end bound)-            D.Stop ->-                return-                    $ D.Skip (GroupYield contents start end bound GroupFinish)--    step' _ (GroupYield contents start end bound next) =-        return $ D.Yield (MutArray contents start end bound) next--    step' _ GroupFinish = return D.Stop---- | @chunksOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ Same as the following but may be more efficient:------ >>> chunksOf n = Stream.foldMany (MutArray.writeN n)------ /Pre-release/-{-# INLINE_NORMAL chunksOf #-}-chunksOf :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> D.Stream m (MutArray a)--- XXX the idiomatic implementation leads to large regression in the D.reverse'--- benchmark. It seems it has difficulty producing optimized code when--- converting to StreamK. Investigate GHC optimizations.--- chunksOf n = D.foldMany (writeN n)-chunksOf = chunksOfAs Unpinned---- | Like 'chunksOf' but creates pinned arrays.-{-# INLINE_NORMAL pinnedChunksOf #-}-pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> D.Stream m (MutArray a)--- pinnedChunksOf n = D.foldMany (pinnedWriteN n)-pinnedChunksOf = chunksOfAs Pinned---- XXX This should take a PinnedState--- XXX buffer to a list instead?--- | Buffer the stream into arrays in memory.-{-# INLINE arrayStreamKFromStreamDAs #-}-arrayStreamKFromStreamDAs :: forall m a. (MonadIO m, Unbox a) =>-    PinnedState -> D.Stream m a -> m (StreamK m (MutArray a))-arrayStreamKFromStreamDAs ps =-    let n = allocBytesToElemCount (undefined :: a) defaultChunkSize-     in D.foldr K.cons K.nil . chunksOfAs ps n------------------------------------------------------------------------------------ Streams of arrays - Flattening----------------------------------------------------------------------------------data FlattenState s contents a =-      OuterLoop s-    | InnerLoop s contents !Int !Int---- | Use the "reader" unfold instead.------ @flattenArrays = unfoldMany reader@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL flattenArrays #-}-flattenArrays :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (OuterLoop st) = do-        r <- step (adaptState gst) st-        return $ case r of-            D.Yield MutArray{..} s ->-                D.Skip (InnerLoop s arrContents arrStart arrEnd)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ p end) | assert (p <= end) (p == end) =-        return $ D.Skip $ OuterLoop st--    step' _ (InnerLoop st contents p end) = do-        x <- liftIO $ peekAt p contents-        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)---- | Use the "readerRev" unfold instead.------ @flattenArrays = unfoldMany readerRev@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL flattenArraysRev #-}-flattenArraysRev :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (OuterLoop st) = do-        r <- step (adaptState gst) st-        return $ case r of-            D.Yield MutArray{..} s ->-                let p = INDEX_PREV(arrEnd,a)-                 in D.Skip (InnerLoop s arrContents p arrStart)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ p start) | p < start =-        return $ D.Skip $ OuterLoop st--    step' _ (InnerLoop st contents p start) = do-        x <- liftIO $ peekAt p contents-        let cur = INDEX_PREV(p,a)-        return $ D.Yield x (InnerLoop st contents cur start)------------------------------------------------------------------------------------ Unfolds----------------------------------------------------------------------------------data ArrayUnsafe a = ArrayUnsafe-    {-# UNPACK #-} !MutByteArray   -- contents-    {-# UNPACK #-} !Int                -- index 1-    {-# UNPACK #-} !Int                -- index 2--toArrayUnsafe :: MutArray a -> ArrayUnsafe a-toArrayUnsafe (MutArray contents start end _) = ArrayUnsafe contents start end--fromArrayUnsafe ::-#ifdef DEVBUILD-    Unbox a =>-#endif-    ArrayUnsafe a -> MutArray a-fromArrayUnsafe (ArrayUnsafe contents start end) =-         MutArray contents start end end--{-# INLINE_NORMAL producerWith #-}-producerWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> Producer m (MutArray a) a-producerWith liftio = Producer step (return . toArrayUnsafe) extract-    where--    {-# INLINE_LATE step #-}-    step (ArrayUnsafe _ cur end)-        | assert (cur <= end) (cur == end) = return D.Stop-    step (ArrayUnsafe contents cur end) = do-            -- When we use a purely lazy Monad like Identity, we need to force a-            -- few actions for correctness and execution order sanity. We want-            -- the peek to occur right here and not lazily at some later point-            -- because we want the peek to be ordered with respect to the touch.-            !x <- liftio $ peekAt cur contents-            return $ D.Yield x (ArrayUnsafe contents (INDEX_NEXT(cur,a)) end)--    extract = return . fromArrayUnsafe---- | Resumable unfold of an array.----{-# INLINE_NORMAL producer #-}-producer :: forall m a. (MonadIO m, Unbox a) => Producer m (MutArray a) a-producer = producerWith liftIO---- | Unfold an array into a stream.----{-# INLINE_NORMAL reader #-}-reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a-reader = Producer.simplify producer--{-# INLINE_NORMAL readerRevWith #-}-readerRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> Unfold m (MutArray a) a-readerRevWith liftio = Unfold step inject-    where--    inject (MutArray contents start end _) =-        let p = INDEX_PREV(end,a)-         in return $ ArrayUnsafe contents start p--    {-# INLINE_LATE step #-}-    step (ArrayUnsafe _ start p) | p < start = return D.Stop-    step (ArrayUnsafe contents start p) = do-        !x <- liftio $ peekAt p contents-        return $ D.Yield x (ArrayUnsafe contents start (INDEX_PREV(p,a)))---- | Unfold an array into a stream in reverse order.----{-# INLINE_NORMAL readerRev #-}-readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a-readerRev = readerRevWith liftIO------------------------------------------------------------------------------------ to Lists and streams----------------------------------------------------------------------------------{---- Use foldr/build fusion to fuse with list consumers--- This can be useful when using the IsList instance-{-# INLINE_LATE toListFB #-}-toListFB :: forall a b. Unbox a => (a -> b -> b) -> b -> MutArray a -> b-toListFB c n MutArray{..} = go arrStart-    where--    go p | assert (p <= arrEnd) (p == arrEnd) = n-    go p =-        -- unsafeInlineIO allows us to run this in Identity monad for pure-        -- toList/foldr case which makes them much faster due to not-        -- accumulating the list and fusing better with the pure consumers.-        ---        -- This should be safe as the array contents are guaranteed to be-        -- evaluated/written to before we peek at them.-        -- XXX-        let !x = unsafeInlineIO $ do-                    r <- peekAt arrContents p-                    return r-        in c x (go (PTR_NEXT(p,a)))--}---- XXX Monadic foldr/build fusion?--- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion---- | Convert a 'MutArray' into a list.----{-# INLINE toList #-}-toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]-toList MutArray{..} = liftIO $ go arrStart-    where--    go p | assert (p <= arrEnd) (p == arrEnd) = return []-    go p = do-        x <- peekAt p arrContents-        (:) x <$> go (INDEX_NEXT(p,a))--{-# INLINE_NORMAL toStreamDWith #-}-toStreamDWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a-toStreamDWith liftio MutArray{..} = D.Stream step arrStart--    where--    {-# INLINE_LATE step #-}-    step _ p | assert (p <= arrEnd) (p == arrEnd) = return D.Stop-    step _ p = liftio $ do-        r <- peekAt p arrContents-        return $ D.Yield r (INDEX_NEXT(p,a))---- | Convert a 'MutArray' into a stream.------ >>> read = Stream.unfold MutArray.reader----{-# INLINE_NORMAL read #-}-read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a-read = toStreamDWith liftIO--{-# INLINE toStreamKWith #-}-toStreamKWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a-toStreamKWith liftio MutArray{..} = go arrStart--    where--    go p | assert (p <= arrEnd) (p == arrEnd) = K.nil-         | otherwise =-        let elemM = peekAt p arrContents-        in liftio elemM `K.consM` go (INDEX_NEXT(p,a))--{-# INLINE toStreamK #-}-toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a-toStreamK = toStreamKWith liftIO--{-# INLINE_NORMAL toStreamDRevWith #-}-toStreamDRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a-toStreamDRevWith liftio MutArray{..} =-    let p = INDEX_PREV(arrEnd,a)-    in D.Stream step p--    where--    {-# INLINE_LATE step #-}-    step _ p | p < arrStart = return D.Stop-    step _ p = liftio $ do-        r <- peekAt p arrContents-        return $ D.Yield r (INDEX_PREV(p,a))---- | Convert a 'MutArray' into a stream in reverse order.------ >>> readRev = Stream.unfold MutArray.readerRev----{-# INLINE_NORMAL readRev #-}-readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a-readRev = toStreamDRevWith liftIO--{-# INLINE toStreamKRevWith #-}-toStreamKRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a-toStreamKRevWith liftio MutArray {..} =-    let p = INDEX_PREV(arrEnd,a)-    in go p--    where--    go p | p < arrStart = K.nil-         | otherwise =-        let elemM = peekAt p arrContents-        in liftio elemM `K.consM` go (INDEX_PREV(p,a))--{-# INLINE toStreamKRev #-}-toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a-toStreamKRev = toStreamKRevWith liftIO------------------------------------------------------------------------------------ Folding------------------------------------------------------------------------------------ XXX Need something like "MutArray m a" enforcing monadic action to avoid the--- possibility of such APIs.------ | Strict left fold of an array.-{-# INLINE_NORMAL foldl' #-}-foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b-foldl' f z arr = D.foldl' f z $ read arr---- | Right fold of an array.-{-# INLINE_NORMAL foldr #-}-foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b-foldr f z arr = D.foldr f z $ read arr------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ Note: Arrays may be allocated with a specific alignment at the beginning of--- the array. If you need to maintain that alignment on reallocations then you--- can resize the array manually before append, using an aligned resize--- operation.---- XXX Keep the bound intact to not lose any free space? Perf impact?---- | @writeAppendNUnsafe n arr@ appends up to @n@ input items to the supplied--- array.------ Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory--- corruption or segfault.------ Any free space left in the array after appending @n@ elements is lost.------ /Internal/-{-# INLINE_NORMAL writeAppendNUnsafe #-}-writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>-       Int-    -> m (MutArray a)-    -> Fold m a (MutArray a)-writeAppendNUnsafe n action =-    fmap fromArrayUnsafe $ FL.foldlM' step initial--    where--    initial = do-        assert (n >= 0) (return ())-        arr@(MutArray _ _ end bound) <- action-        let free = bound - end-            needed = n * SIZE_OF(a)-        -- XXX We can also reallocate if the array has too much free space,-        -- otherwise we lose that space.-        arr1 <--            if free < needed-            then noinline reallocWith "writeAppendNUnsafeWith" (+ needed) needed arr-            else return arr-        return $ toArrayUnsafe arr1--    step (ArrayUnsafe contents start end) x = do-        liftIO $ pokeAt end contents x-        return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))---- | Append @n@ elements to an existing array. Any free space left in the array--- after appending @n@ elements is lost.------ >>> writeAppendN n initial = Fold.take n (MutArray.writeAppendNUnsafe n initial)----{-# INLINE_NORMAL writeAppendN #-}-writeAppendN :: forall m a. (MonadIO m, Unbox a) =>-    Int -> m (MutArray a) -> Fold m a (MutArray a)-writeAppendN n initial = FL.take n (writeAppendNUnsafe n initial)---- | @writeAppendWith realloc action@ mutates the array generated by @action@ to--- append the input stream. If there is no reserved space available in the--- array it is reallocated to a size in bytes  determined by @realloc oldSize@,--- where @oldSize@ is the current size of the array in bytes.------ Note that the returned array may be a mutated version of original array.------ >>> writeAppendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)------ /Pre-release/-{-# INLINE writeAppendWith #-}-writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>-    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)-writeAppendWith sizer = FL.foldlM' (snocWith sizer)---- | @append action@ mutates the array generated by @action@ to append the--- input stream. If there is no reserved space available in the array it is--- reallocated to double the size.------ Note that the returned array may be a mutated version of original array.------ >>> writeAppend = MutArray.writeAppendWith (* 2)----{-# INLINE writeAppend #-}-writeAppend :: forall m a. (MonadIO m, Unbox a) =>-    m (MutArray a) -> Fold m a (MutArray a)-writeAppend = writeAppendWith (* 2)---- XXX We can carry bound as well in the state to make sure we do not lose the--- remaining capacity. Need to check perf impact.------ | Like 'writeNUnsafe' but takes a new array allocator @alloc size@ function--- as argument.------ >>> writeNWithUnsafe alloc n = MutArray.writeAppendNUnsafe (alloc n) n------ /Pre-release/-{-# INLINE_NORMAL writeNWithUnsafe #-}-writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial--    where--    initial = toArrayUnsafe <$> alloc (max n 0)--    step (ArrayUnsafe contents start end) x = do-        liftIO $ pokeAt end contents x-        return-          $ ArrayUnsafe contents start (INDEX_NEXT(end,a))--{-# INLINE_NORMAL writeNUnsafeAs #-}-writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> Fold m a (MutArray a)-writeNUnsafeAs ps = writeNWithUnsafe (newAs ps)---- | 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.------ >>> writeNUnsafe = MutArray.writeNWithUnsafe MutArray.new----{-# INLINE_NORMAL writeNUnsafe #-}-writeNUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)-writeNUnsafe = writeNUnsafeAs Unpinned---- | Like 'writeNUnsafe' but creates a pinned array.-{-# INLINE_NORMAL pinnedWriteNUnsafe #-}-pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)-pinnedWriteNUnsafe = writeNUnsafeAs Pinned---- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array--- allocated using the @alloc@ function.------ >>> writeNWith alloc n = Fold.take n (MutArray.writeNWithUnsafe alloc n)--- >>> writeNWith alloc n = MutArray.writeAppendN (alloc n) n----{-# INLINE_NORMAL writeNWith #-}-writeNWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)--{-# INLINE_NORMAL writeNAs #-}-writeNAs ::-       forall m a. (MonadIO m, Unbox a)-    => PinnedState-    -> Int-    -> Fold m a (MutArray a)-writeNAs ps = writeNWith (newAs ps)---- | @writeN n@ folds a maximum of @n@ elements from the input stream to an--- 'MutArray'.------ >>> writeN = MutArray.writeNWith MutArray.new--- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)--- >>> writeN n = MutArray.writeAppendN n (MutArray.new n)----{-# INLINE_NORMAL writeN #-}-writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-writeN = writeNAs Unpinned---- | Like 'writeN' but creates a pinned array.-{-# INLINE_NORMAL pinnedWriteN #-}-pinnedWriteN ::-       forall m a. (MonadIO m, Unbox a)-    => Int-    -> Fold m a (MutArray a)-pinnedWriteN = writeNAs Pinned---- | Like writeNWithUnsafe but writes the array in reverse order.------ /Internal/-{-# INLINE_NORMAL writeRevNWithUnsafe #-}-writeRevNWithUnsafe :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial--    where--    toArrayUnsafeRev (MutArray contents _ _ bound) =-         ArrayUnsafe contents bound bound--    initial = toArrayUnsafeRev <$> alloc (max n 0)--    step (ArrayUnsafe contents start end) x = do-        let ptr = INDEX_PREV(start,a)-        liftIO $ pokeAt ptr contents x-        return-          $ ArrayUnsafe contents ptr end---- | Like writeNWith but writes the array in reverse order.------ /Internal/-{-# INLINE_NORMAL writeRevNWith #-}-writeRevNWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)---- | Like writeN but writes the array in reverse order.------ /Pre-release/-{-# INLINE_NORMAL writeRevN #-}-writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-writeRevN = writeRevNWith new---- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the--- input stream to a 'MutArray' aligned to the given size.------ >>> pinnedWriteNAligned align = MutArray.writeNWith (MutArray.pinnedNewAligned align)--- >>> pinnedWriteNAligned align n = MutArray.writeAppendN n (MutArray.pinnedNewAligned align n)------ /Pre-release/----{-# INLINE_NORMAL pinnedWriteNAligned #-}-pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> Fold m a (MutArray a)-pinnedWriteNAligned align = writeNWith (pinnedNewAligned align)---- XXX Buffer to a list instead?---- | Buffer a stream into a stream of arrays.------ >>> writeChunks n = Fold.many (MutArray.writeN n) Fold.toStreamK------ Breaking an array into an array stream  can be useful to consume a large--- array sequentially such that memory of the array is released incrementatlly.------ See also: 'arrayStreamKFromStreamD'.------ /Unimplemented/----{-# INLINE_NORMAL writeChunks #-}-writeChunks :: (MonadIO m, Unbox a) =>-    Int -> Fold m a (StreamK n (MutArray a))-writeChunks n = FL.many (writeN n) FL.toStreamK--{-# INLINE_NORMAL writeWithAs #-}-writeWithAs :: forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> Fold m a (MutArray a)--- writeWithAs ps n = FL.rmapM rightSize $ writeAppendWith (* 2) (newAs ps n)-writeWithAs ps elemCount =-    FL.rmapM extract $ FL.foldlM' step initial--    where--    initial = do-        when (elemCount < 0) $ error "writeWith: elemCount is negative"-        liftIO $ newAs ps elemCount--    step arr@(MutArray _ start end bound) x-        | INDEX_NEXT(end,a) > bound = do-        let oldSize = end - start-            newSize = max (oldSize * 2) 1-        arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr-        snocUnsafe arr1 x-    step arr x = snocUnsafe arr x--    extract = liftIO . rightSize---- XXX Compare writeWith with fromStreamD which uses an array of streams--- implementation. We can write this using writeChunks above if that is faster.--- If writeWith is faster then we should use that to implement--- fromStreamD.------ XXX The realloc based implementation needs to make one extra copy if we use--- shrinkToFit.  On the other hand, the stream of arrays implementation may--- buffer the array chunk pointers in memory but it does not have to shrink as--- we know the exact size in the end. However, memory copying does not seem to--- be as expensive as the allocations. Therefore, we need to reduce the number--- of allocations instead. Also, the size of allocations matters, right sizing--- an allocation even at the cost of copying sems to help.  Should be measured--- on a big stream with heavy calls to toArray to see the effect.------ XXX check if GHC's memory allocator is efficient enough. We can try the C--- malloc to compare against.---- | @writeWith minCount@ folds the whole input to a single array. The array--- starts at a size big enough to hold minCount elements, the size is doubled--- every time the array needs to be grown.------ /Caution! Do not use this on infinite streams./------ >>> f n = MutArray.writeAppendWith (* 2) (MutArray.new n)--- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)--- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)------ /Pre-release/-{-# INLINE_NORMAL writeWith #-}-writeWith :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)--- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (new n)-writeWith = writeWithAs Unpinned---- | Fold the whole input to a single array.------ Same as 'writeWith' using an initial array size of 'arrayChunkBytes' bytes--- rounded up to the element size.------ /Caution! Do not use this on infinite streams./----{-# INLINE write #-}-write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)-write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)---- | Like 'write' but creates a pinned array.-{-# INLINE pinnedWrite #-}-pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)-pinnedWrite =-    writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)------------------------------------------------------------------------------------ construct from streams, known size----------------------------------------------------------------------------------{-# INLINE_NORMAL fromStreamDNAs #-}-fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> D.Stream m a -> m (MutArray a)-fromStreamDNAs ps limit str = do-    (arr :: MutArray a) <- liftIO $ newAs ps limit-    end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str-    return $ arr {arrEnd = end}--    where--    fwrite arrContents ptr x = do-        liftIO $ pokeAt ptr arrContents  x-        return $ INDEX_NEXT(ptr,a)---- | Use the 'writeN' fold instead.------ >>> fromStreamDN n = Stream.fold (MutArray.writeN n)----{-# INLINE_NORMAL fromStreamDN #-}-fromStreamDN :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> m (MutArray a)--- fromStreamDN n = D.fold (writeN n)-fromStreamDN = fromStreamDNAs Unpinned---- | Create a 'MutArray' from the first N elements of a list. The array is--- allocated to size N, if the list terminates before N elements then the--- array may hold less than N elements.----{-# INLINABLE fromListN #-}-fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)-fromListN n xs = fromStreamDN n $ D.fromList xs---- | Like 'fromListN' but creates a pinned array.-{-# INLINABLE pinnedFromListN #-}-pinnedFromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)-pinnedFromListN n xs = fromStreamDNAs Pinned n $ D.fromList xs---- | Like fromListN but writes the array in reverse order.------ /Pre-release/-{-# INLINE fromListRevN #-}-fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)-fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs---- | Convert a pure stream in Identity monad to a mutable array.-{-# INLINABLE fromPureStream #-}-fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)-fromPureStream xs =-    liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs------------------------------------------------------------------------------------ convert stream to a single array----------------------------------------------------------------------------------{-# INLINE arrayStreamKLength #-}-arrayStreamKLength :: (Monad m, Unbox a) => StreamK m (MutArray a) -> m Int-arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)---- | Convert an array stream to an array. Note that this requires peak memory--- that is double the size of the array stream.----{-# INLINE fromArrayStreamK #-}-fromArrayStreamK :: (Unbox a, MonadIO m) =>-    StreamK m (MutArray a) -> m (MutArray a)-fromArrayStreamK as = do-    len <- arrayStreamKLength as-    fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as--{-# INLINE fromStreamDAs #-}-fromStreamDAs ::-       (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)-fromStreamDAs ps m = arrayStreamKFromStreamDAs ps m >>= fromArrayStreamK---- CAUTION: a very large number (millions) of arrays can degrade performance--- due to GC overhead because we need to buffer the arrays before we flatten--- all the arrays.------ XXX Compare if this is faster or "fold write".------ | We could take the approach of doubling the memory allocation on each--- overflow. This would result in more or less the same amount of copying as in--- the chunking approach. However, if we have to shrink in the end then it may--- result in an extra copy of the entire data.------ >>> fromStreamD = StreamD.fold MutArray.write----{-# INLINE fromStreamD #-}-fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)-fromStreamD = fromStreamDAs Unpinned---- | Create a 'MutArray' from a list. The list must be of finite size.----{-# INLINE fromList #-}-fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)-fromList xs = fromStreamD $ D.fromList xs---- | Like 'fromList' but creates a pinned array.-{-# INLINE pinnedFromList #-}-pinnedFromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)-pinnedFromList xs = fromStreamDAs Pinned $ D.fromList xs---- XXX We are materializing the whole list first for getting the length. Check--- if the 'fromList' like chunked implementation would fare better.---- | Like 'fromList' but writes the contents of the list in reverse order.-{-# INLINE fromListRev #-}-fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)-fromListRev xs = fromListRevN (Prelude.length xs) xs------------------------------------------------------------------------------------ Cloning----------------------------------------------------------------------------------{-# INLINE cloneAs #-}-cloneAs ::-    ( MonadIO m-#ifdef DEVBUILD-    , Unbox a-#endif-    )-    => PinnedState -> MutArray a -> m (MutArray a)-cloneAs ps src =-    liftIO $ do-        let startSrc = arrStart src-            srcLen = arrEnd src - startSrc-        newArrContents <--            Unboxed.cloneSliceUnsafeAs ps startSrc srcLen (arrContents src)-        return $ MutArray newArrContents 0 srcLen srcLen--{-# INLINE clone #-}-clone ::-    ( MonadIO m-#ifdef DEVBUILD-    , Unbox a-#endif-    )-    => MutArray a -> m (MutArray a)-clone = cloneAs Unpinned--{-# INLINE pinnedClone #-}-pinnedClone ::-    ( MonadIO m-#ifdef DEVBUILD-    , Unbox a-#endif-    )-    => MutArray a -> m (MutArray a)-pinnedClone = cloneAs Pinned------------------------------------------------------------------------------------ Combining------------------------------------------------------------------------------------ | Copy two arrays into a newly allocated array. If the first array is pinned--- the spliced array is also pinned.-{-# INLINE spliceCopy #-}-spliceCopy :: forall m a. MonadIO m =>-#ifdef DEVBUILD-    Unbox a =>-#endif-    MutArray a -> MutArray a -> m (MutArray a)-spliceCopy arr1 arr2 = liftIO $ do-    let start1 = arrStart arr1-        start2 = arrStart arr2-        len1 = arrEnd arr1 - start1-        len2 = arrEnd arr2 - start2-    let newLen = len1 + len2-    newArrContents <--        if Unboxed.isPinned (arrContents arr1)-        then Unboxed.pinnedNew newLen-        else Unboxed.new newLen-    let len = len1 + len2-    putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1-    putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2-    return $ MutArray newArrContents 0 len len---- | Really really unsafe, appends the second array into the first array. If--- the first array does not have enough space it may cause silent data--- corruption or if you are lucky a segfault.-{-# INLINE spliceUnsafe #-}-spliceUnsafe :: MonadIO m =>-    MutArray a -> MutArray a -> m (MutArray a)-spliceUnsafe dst src =-    liftIO $ do-         let startSrc = arrStart src-             srcLen = arrEnd src - startSrc-             endDst = arrEnd dst-         assertM(endDst + srcLen <= arrBound dst)-         putSliceUnsafe-             (arrContents src) startSrc (arrContents dst) endDst srcLen-         return $ dst {arrEnd = endDst + srcLen}---- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no--- reserved space available in @dst@ it is reallocated to a size determined by--- the @sizer dstBytes srcBytes@ function, where @dstBytes@ is the size of the--- first array and @srcBytes@ is the size of the second array, in bytes.------ Note that the returned array may be a mutated version of first array.------ /Pre-release/-{-# INLINE spliceWith #-}-spliceWith :: forall m a. (MonadIO m, Unbox a) =>-    (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)-spliceWith sizer dst@(MutArray _ start end bound) src = do-{--    let f = writeAppendWith (`sizer` byteLength src) (return dst)-     in D.fold f (toStreamD src)--}-    assert (end <= bound) (return ())-    let srcBytes = arrEnd src - arrStart src--    dst1 <--        if end + srcBytes >= bound-        then do-            let dstBytes = end - start-                newSizeInBytes = sizer dstBytes srcBytes-            when (newSizeInBytes < dstBytes + srcBytes)-                $ error-                    $ "splice: newSize is less than the total size "-                    ++ "of arrays being appended. Please check the "-                    ++ "sizer function passed."-            liftIO $ realloc newSizeInBytes dst-        else return dst-    spliceUnsafe dst1 src---- | The first array is mutated to append the second array. If there is no--- reserved space available in the first array a new allocation of exact--- required size is done.------ Note that the returned array may be a mutated version of first array.------ >>> splice = MutArray.spliceWith (+)------ If the original array is pinned the spliced array is also pinned.------ /Pre-release/-{-# INLINE splice #-}-splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)-splice = spliceWith (+)---- | Like 'append' but the growth of the array is exponential. Whenever a new--- allocation is required the previous array size is at least doubled.------ This is useful to reduce allocations when folding many arrays together.------ Note that the returned array may be a mutated version of first array.------ >>> spliceExp = MutArray.spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))------ /Pre-release/-{-# INLINE spliceExp #-}-spliceExp :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)-spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))------------------------------------------------------------------------------------ Splitting------------------------------------------------------------------------------------ | Drops the separator byte-{-# INLINE breakOn #-}-breakOn :: MonadIO m-    => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))-breakOn sep arr@MutArray{..} = asPtrUnsafe arr $ \p -> liftIO $ do-    -- XXX Instead of using asPtrUnsafe (pinning memory) we can pass unlifted-    -- Addr# to memchr and it should be safe (from ghc 8.4).-    -- XXX We do not need memchr here, we can use a Haskell equivalent.-    loc <- c_memchr p sep (fromIntegral $ byteLength arr)-    let sepIndex = loc `minusPtr` p-    return $-        if loc == nullPtr-        then (arr, Nothing)-        else-            ( MutArray-                { arrContents = arrContents-                , arrStart = arrStart-                , arrEnd = arrStart + sepIndex -- exclude the separator-                , arrBound = arrStart + sepIndex-                }-            , Just $ MutArray-                    { arrContents = arrContents-                    , arrStart = arrStart + (sepIndex + 1)-                    , arrEnd = arrEnd-                    , arrBound = arrBound-                    }-            )---- | Create two slices of an array without copying the original array. The--- specified index @i@ is the first index of the second slice.----splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)-splitAt i arr@MutArray{..} =-    let maxIndex = length arr - 1-    in  if i < 0-        then error "sliceAt: negative array index"-        else if i > maxIndex-             then error $ "sliceAt: specified array index " ++ show i-                        ++ " is beyond the maximum index " ++ show maxIndex-             else let off = i * SIZE_OF(a)-                      p = arrStart + off-                in ( MutArray-                  { arrContents = arrContents-                  , arrStart = arrStart-                  , arrEnd = p-                  , arrBound = p-                  }-                , MutArray-                  { arrContents = arrContents-                  , arrStart = p-                  , arrEnd = arrEnd-                  , arrBound = arrBound-                  }-                )------------------------------------------------------------------------------------ Casting------------------------------------------------------------------------------------ | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The array size must be a multiple of the size of type @b@--- otherwise accessing the last element of the array may result into a crash or--- a random value.------ /Pre-release/----castUnsafe ::-#ifdef DEVBUILD-    Unbox b =>-#endif-    MutArray a -> MutArray b-castUnsafe (MutArray contents start end bound) =-    MutArray contents start end bound---- | Cast an @MutArray a@ into an @MutArray Word8@.----asBytes :: MutArray a -> MutArray Word8-asBytes = castUnsafe---- | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The length of the array should be a multiple of the size of the--- target element otherwise 'Nothing' is returned.----cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)-cast arr =-    let len = byteLength arr-        r = len `mod` SIZE_OF(b)-     in if r /= 0-        then Nothing-        else Just $ castUnsafe arr---- XXX We can provide another API for "unsafe" FFI calls passing an unlifted--- pointer to the FFI call. For unsafe calls we do not need to pin the array.--- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in--- before the pointer is wrapped.------ From the GHC manual:------ GHC, since version 8.4, guarantees that garbage collection will never occur--- during an unsafe call, even in the bytecode interpreter, and further--- guarantees that unsafe calls will be performed in the calling thread. Making--- it safe to pass heap-allocated objects to unsafe functions.---- Should we just name it asPtr, the unsafety is implicit for any pointer--- operations. And we are safe from Haskell perspective because we will be--- pinning the memory.---- | Use a @MutArray a@ as @Ptr a@. This is useful when we want to pass an--- array as a pointer to some operating system call or to a "safe" FFI call.------ If the array is not pinned it is copied to pinned memory before passing it--- to the monadic action.------ /Performance Notes:/ Forces a copy if the array is not pinned. It is advised--- that the programmer keeps this in mind and creates a pinned array--- opportunistically before this operation occurs, to avoid the cost of a copy--- if possible.------ /Unsafe/ because of direct pointer operations. The user must ensure that--- they are writing within the legal bounds of the array.------ /Pre-release/----{-# INLINE asPtrUnsafe #-}-asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b-asPtrUnsafe arr f =-    Unboxed.asPtrUnsafe-        (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))------------------------------------------------------------------------------------ Equality------------------------------------------------------------------------------------ | Compare the length of the arrays. If the length is equal, compare the--- lexicographical ordering of two underlying byte arrays otherwise return the--- result of length comparison.------ /Pre-release/-{-# INLINE cmp #-}-cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering-cmp arr1 arr2 =-    liftIO-        $ do-            let marr1 = getMutableByteArray# (arrContents arr1)-                marr2 = getMutableByteArray# (arrContents arr2)-                !(I# st1#) = arrStart arr1-                !(I# st2#) = arrStart arr2-                !(I# len#) = byteLength arr1-            case compare (byteLength arr1) (byteLength arr2) of-                EQ -> do-                    r <- liftIO $ IO $ \s# ->-                             let res =-                                     I#-                                         (compareByteArrays#-                                              (unsafeCoerce# marr1)-                                              st1#-                                              (unsafeCoerce# marr2)-                                              st2#-                                              len#)-                              in (# s#, res #)-                    return $ compare r 0-                x -> return x------------------------------------------------------------------------------------ NFData++    -- ** Conversion+    -- *** Pinned and Unpinned+    , pin+    , unpin+    , isPinned++    -- ** Casting+    , cast+    , castUnsafe -- XXX unsafeCast+    , asBytes+    , unsafePinnedAsPtr+    , unsafeAsPtr++    -- ** Construction+    , empty++    -- *** New+    -- | New arrays are always empty arrays with some reserve capacity to+    -- extend the length without reallocating.+    , emptyOf+    , newArrayWith -- emptyAlignedWith+    , pinnedEmptyOf+    , pinnedNewAligned -- XXX not required+    -- , new -- uninitialized array of specified length++    -- *** Cloning+    , clone+    , pinnedClone++    -- *** Slicing+    -- | Get a subarray without copying+    , getSliceUnsafe -- XXX unsafeGetSlice+    , getSlice+    , splitAt -- XXX should be able to express using getSlice+    , breakOn++    -- *** Stream Folds+    , ArrayUnsafe (..)+    , unsafeCreateOfWith+    , unsafeCreateOf+    , unsafePinnedCreateOf+    , pinnedCreateOf+    , createOfWith+    , createOf+    , revCreateOf++    , pinnedCreate+    , createWith+    , create+    -- , revCreate++    -- *** From containers+    , fromListN+    , pinnedFromListN+    , fromList+    , pinnedFromList+    , fromListRevN+    , fromListRev+    , fromStreamN+    , fromStream+    , fromPureStreamN+    , fromPureStream+    , fromByteStr#+    , fromPtrN+    , fromChunksK+    , fromChunksRealloced -- fromSmallChunks++    -- ** Random writes+    , putIndex+    , putIndexUnsafe -- XXX unsafePutIndex+    , putIndices+    -- , putFromThenTo+    -- , putFrom -- start writing at the given position+    -- , putUpto -- write from beginning up to the given position+    -- , putFromTo+    -- , putFromRev+    -- , putUptoRev+    , modifyIndexUnsafe -- XXX unsafeModifyIndex+    , modifyIndex+    , modifyIndices+    , modify+    , swapIndices+    , unsafeSwapIndices++    -- ** Reading++    -- *** Indexing+    , getIndex+    , getIndexUnsafe -- XXX unsafeGetIndex+    -- , getFromThenTo+    , getIndexRev -- getRevIndex?+    , indexReader+    , indexReaderWith++    -- *** To Streams+    , read+    , readRev+    , toStreamWith+    , toStreamRevWith+    , toStreamK+    , toStreamKWith+    , toStreamKRev+    , toStreamKRevWith++    -- *** To Containers+    , toList++    -- *** Unfolds+    -- experimental+    , producerWith+    , producer++    , reader+    , readerRevWith+    , readerRev++    -- ** Size and Capacity+    -- *** Size+    , length+    , byteLength++    -- *** Capacity+    -- , capacity+    , byteCapacity+    , bytesFree++    -- *** Capacity Management+    , blockSize+    , arrayChunkBytes+    , allocBytesToElemCount+    , realloc -- this is "resize"+    , grow+    , growExp+    , rightSize++    -- ** Folding+    , foldl'+    , foldr+    , byteCmp+    , byteEq++    -- ** In-place Mutation Algorithms+    , strip+    , reverse+    , permute+    , partitionBy+    , shuffleBy+    , divideBy+    , mergeBy+    , bubble++    -- ** Growing and Shrinking+    -- | Arrays grow only at the end, though it is possible to grow on both+    -- sides and therefore have a cons as well as snoc. But that will require+    -- both lower and upper bound in the array representation.++    -- *** Appending elements+    , snocWith+    , snoc+    , snocLinear+    , snocMay+    , snocUnsafe -- XXX unsafeSnoc++    -- *** Appending streams+    , unsafeAppendN+    , appendN+    , appendWith+    , append++    -- *** Appending arrays+    , spliceCopy+    , spliceWith+    , splice+    , spliceExp+    , spliceUnsafe -- XXX unsafeSplice+    -- , putSlice+    -- , appendSlice+    -- , appendSliceFrom++    -- ** Serialization using Unbox+    , pokeAppend+    , pokeAppendMay+    , pokeSkipUnsafe -- unsafePokeSkip++    -- ** Deserialization using Unbox+    , peekUncons+    , peekUnconsUnsafe -- unsafePeekUncons+    , peekSkipUnsafe -- unsafePeekSkip++    -- Arrays of arrays+    --  We can add dimensionality parameter to the array type to get+    --  multidimensional arrays. Multidimensional arrays would just be a+    --  convenience wrapper on top of single dimensional arrays.++    -- ** Streams of Arrays+    -- *** Chunk+    -- | Group a stream into arrays.+    , chunksOf+    , pinnedChunksOf+    , buildChunks++    -- *** Split+    -- | Split an array into slices.++    -- , getSlicesFromLenN+    , splitOn+    -- , slicesOf++    -- *** Concat+    -- | Append the arrays in a stream to form a stream of elements.+    , concatWith+    , concatRevWith+    , concat+    , concatRev++    -- *** Compact+    -- | Append the arrays in a stream to form a stream of larger arrays.+    , SpliceState (..)+    , pCompactLE+    , pPinnedCompactLE+    , compactLeAs+    , fCompactGE+    , fPinnedCompactGE+    , lCompactGE+    , lPinnedCompactGE+    , compactGE+    , compactEQ++    -- ** Utilities+    , roundUpToPower2+    , memcpy+    , memcmp+    , c_memchr++    -- * Deprecated+    , asPtrUnsafe+    , writeChunks+    , flattenArrays+    , flattenArraysRev+    , fromArrayStreamK+    , fromStreamDN+    , fromStreamD+    , cmp+    , getIndices+    , getIndicesWith+    , resize+    , resizeExp+    , nil+    , new+    , pinnedNew+    , pinnedNewBytes+    , writeAppendNUnsafe+    , writeAppendN+    , writeAppendWith+    , writeAppend+    , writeNWithUnsafe+    , writeNWith+    , writeNUnsafe+    , pinnedWriteNUnsafe+    , writeN+    , pinnedWriteN+    , pinnedWriteNAligned -- XXX not required+    , writeWith+    , write+    , pinnedWrite+    , writeRevN+    )+where++#include "assert.hs"+#include "inline.hs"+#include "ArrayMacros.h"+#include "MachDeps.h"++import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Bifunctor (first)+import Data.Bits (shiftR, (.|.), (.&.))+import Data.Functor.Identity (Identity(..))+import Data.Proxy (Proxy(..))+import Data.Word (Word8)+import Foreign.C.Types (CSize(..), CInt(..))+import Foreign.Ptr (plusPtr, minusPtr, nullPtr)+import Streamly.Internal.Data.MutByteArray.Type+    ( MutByteArray(..)+    , PinnedState(..)+    , getMutableByteArray#+    , putSliceUnsafe+    )+import Streamly.Internal.Data.Unbox (Unbox(..))+import GHC.Base+    ( IO(..)+    , Int(..)+    , compareByteArrays#+    , copyMutableByteArray#+    )+import GHC.Base (noinline)+import GHC.Exts (unsafeCoerce#, Addr#)+import GHC.Ptr (Ptr(..))++import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Producer.Type (Producer (..))+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Parser.Type (Parser (..))+import Streamly.Internal.Data.StreamK.Type (StreamK)+import Streamly.Internal.Data.SVar.Type (adaptState, defState)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)++import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed+import qualified Streamly.Internal.Data.Parser.Type as Parser+-- import qualified Streamly.Internal.Data.Fold.Type as Fold+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.Stream.Lift as D+import qualified Streamly.Internal.Data.StreamK.Type as K+import qualified Prelude++import Prelude hiding+    (Foldable(..), concat, read, unlines, splitAt, reverse, truncate)++#include "DocTestDataMutArray.hs"++-------------------------------------------------------------------------------+-- Foreign helpers+-------------------------------------------------------------------------------++-- NOTE: Have to be "ccall unsafe" so that we can pass unpinned memory to these+foreign import ccall unsafe "string.h memcpy" c_memcpy+    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)++foreign import ccall unsafe "string.h memchr" c_memchr+    :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)++foreign import ccall unsafe "string.h memcmp" c_memcmp+    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt++foreign import ccall unsafe "string.h strlen" c_strlen+    :: Ptr Word8 -> IO CSize++-- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return+-- how many elements of that type will completely fit in those bytes.+--+{-# INLINE bytesToElemCount #-}+bytesToElemCount :: forall a. Unbox a => a -> Int -> Int+bytesToElemCount _ n = n `div` SIZE_OF(a)++-- XXX we are converting Int to CSize+memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()+memcpy dst src len = void (c_memcpy dst src (fromIntegral len))++-- XXX we are converting Int to CSize+-- return True if the memory locations have identical contents+{-# INLINE memcmp #-}+memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool+memcmp p1 p2 len = do+    r <- c_memcmp p1 p2 (fromIntegral len)+    return $ r == 0++-------------------------------------------------------------------------------+-- MutArray Data Type+-------------------------------------------------------------------------------++-- $arrayNotes+--+-- We can use an 'Unboxed' constraint in the MutArray type and the constraint+-- can be automatically provided to a function that pattern matches on the+-- MutArray type. However, it has huge performance cost, so we do not use it.+-- Investigate a GHC improvement possiblity.++-- | An unboxed mutable array. An array is created with a given length+-- and capacity. Length is the number of valid elements in the array.  Capacity+-- is the maximum number of elements that the array can be expanded to without+-- having to reallocate the memory.+--+-- The elements in the array can be mutated in-place without changing the+-- reference (constructor). However, the length of the array cannot be mutated+-- in-place.  A new array reference is generated when the length changes.  When+-- the length is increased (upto the maximum reserved capacity of the array),+-- the array is not reallocated and the new reference uses the same underlying+-- memory as the old one.+--+-- Several routines in this module allow the programmer to control the capacity+-- of the array. The programmer can control the trade-off between memory usage+-- and performance impact due to reallocations when growing or shrinking the+-- array.+--+data MutArray a =+#ifdef DEVBUILD+    Unbox a =>+#endif+    -- The array is a range into arrContents. arrContents may be a superset of+    -- the slice represented by the array. All offsets are in bytes.+    MutArray+    { arrContents :: {-# UNPACK #-} !MutByteArray+    , arrStart :: {-# UNPACK #-} !Int  -- ^ index into arrContents+    , arrEnd   :: {-# UNPACK #-} !Int    -- ^ index into arrContents+                                       -- Represents the first invalid index of+                                       -- the array.+    , arrBound :: {-# UNPACK #-} !Int    -- ^ first invalid index of arrContents.+    }++-------------------------------------------------------------------------------+-- Pinning & Unpinning+-------------------------------------------------------------------------------++-- | Return a copy of the array in pinned memory if unpinned, else return the+-- original array.+{-# INLINE pin #-}+pin :: MutArray a -> IO (MutArray a)+pin arr@MutArray{..} =+    if Unboxed.isPinned arrContents+    then pure arr+    else pinnedClone arr++-- | Return a copy of the array in unpinned memory if pinned, else return the+-- original array.+{-# INLINE unpin #-}+unpin :: MutArray a -> IO (MutArray a)+unpin arr@MutArray{..} =+    if Unboxed.isPinned arrContents+    then clone arr+    else pure arr++-- | Return 'True' if the array is allocated in pinned memory.+{-# INLINE isPinned #-}+isPinned :: MutArray a -> Bool+isPinned MutArray{..} = Unboxed.isPinned arrContents++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++-- XXX Change the names to use "new" instead of "newArray". That way we can use+-- the same names for managed file system objects as well. For unmanaged ones+-- we can use open/create etc as usual.+--+-- A new array is similar to "touch" creating a zero length file. An mmapped+-- array would be similar to a sparse file with holes. TBD: support mmapped+-- files and arrays.++-- GHC always guarantees word-aligned memory, alignment is important only when+-- we need more than that.  See stg_pinnedNewAlignedByteArrayzh and+-- allocatePinned in GHC source.++-- XXX Rename to emptyAlignedWith, alignSize should be first arg.++-- | @newArrayWith allocator alignment count@ allocates a new array of zero+-- length and with a capacity to hold @count@ elements, using @allocator+-- size alignment@ as the memory allocator function.+--+-- Alignment must be greater than or equal to machine word size and a power of+-- 2.+--+-- Alignment is ignored if the allocator allocates unpinned memory.+--+-- /Pre-release/+{-# INLINE newArrayWith #-}+newArrayWith :: forall m a. (MonadIO m, Unbox a)+    => (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)+newArrayWith alloc alignSize count = do+    let size = max (count * SIZE_OF(a)) 0+    contents <- alloc size alignSize+    return $ MutArray+        { arrContents = contents+        , arrStart = 0+        , arrEnd   = 0+        , arrBound = size+        }++-- For arrays "nil" sounds a bit odd. empty is better. The only problem with+-- empty is that it is also used by the Alternative type class. But assuming we+-- will mostly import the Array module qualified this should be fine.++-- | Create an empty array.+empty ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    MutArray a+empty = MutArray Unboxed.empty 0 0 0++{-# DEPRECATED nil "Please use empty instead." #-}+nil ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    MutArray a+nil = empty++{-# INLINE newBytesAs #-}+newBytesAs :: MonadIO m =>+#ifdef DEVBUILD+    Unbox a =>+#endif+    PinnedState -> Int -> m (MutArray a)+newBytesAs ps bytes = do+    contents <- liftIO $ Unboxed.newBytesAs ps bytes+    return $ MutArray+        { arrContents = contents+        , arrStart = 0+        , arrEnd   = 0+        , arrBound = bytes+        }++-- | Allocates a pinned empty array that with a reserved capacity of bytes.+-- The memory of the array is uninitialized and the allocation is aligned as+-- per the 'Unboxed' instance of the type.+--+-- /Pre-release/+{-# INLINE pinnedNewBytes #-}+{-# DEPRECATED pinnedNewBytes "Please use pinnedEmptyOf with appropriate calculation" #-}+pinnedNewBytes :: MonadIO m =>+#ifdef DEVBUILD+    Unbox a =>+#endif+    Int -> m (MutArray a)+pinnedNewBytes = newBytesAs Pinned++-- | Like 'newArrayWith' but using an allocator is a pinned memory allocator and+-- the alignment is dictated by the 'Unboxed' instance of the type.+--+-- /Internal/+{-# INLINE pinnedNewAligned #-}+pinnedNewAligned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)+pinnedNewAligned =+    newArrayWith (\s a -> liftIO $ Unboxed.pinnedNewAlignedBytes s a)++{-# INLINE newAs #-}+newAs :: (MonadIO m, Unbox a) => PinnedState -> Int -> m (MutArray a)+newAs ps =+    newArrayWith+        (\s _ -> liftIO $ Unboxed.newBytesAs ps s)+        (error "new: alignment is not used in unpinned arrays.")++-- XXX can unaligned allocation be more efficient when alignment is not needed?++-- | Allocates a pinned array of zero length but growable to the specified+-- capacity without reallocation.+{-# INLINE pinnedEmptyOf #-}+pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+pinnedEmptyOf = newAs Pinned++-- XXX Deprecate in major+-- {-# DEPRECATED pinnedNew "Please use pinnedEmptyOf instead." #-}+{-# INLINE pinnedNew #-}+pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+pinnedNew = pinnedEmptyOf++-- | Allocates an unpinned array of zero length but growable to the specified+-- capacity without reallocation.+--+{-# INLINE emptyOf #-}+emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+emptyOf = newAs Unpinned++-- XXX Deprecate in major+-- {-# DEPRECATED new "Please use emptyOf instead." #-}+{-# INLINE new #-}+new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+new = emptyOf++-------------------------------------------------------------------------------+-- Random writes+-------------------------------------------------------------------------------++-- | Write the given element to the given index of the array. Does not check if+-- the index is out of bounds of the array.+--+-- /Pre-release/+{-# INLINE putIndexUnsafe #-}+putIndexUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> MutArray a -> a -> m ()+putIndexUnsafe i MutArray{..} x = do+    let index = INDEX_OF(arrStart, i, a)+    assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())+    liftIO $ pokeAt index arrContents  x++invalidIndex :: String -> Int -> a+invalidIndex label i =+    error $ label ++ ": invalid array index " ++ show i++-- | /O(1)/ Write the given element at the given index in the array.+-- Performs in-place mutation of the array.+--+-- >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))+-- >>> f = MutArray.putIndices+-- >>> putIndex ix arr val = Stream.fold (f arr) (Stream.fromPure (ix, val))+--+{-# INLINE putIndex #-}+putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+putIndex i MutArray{..} x = do+    let index = INDEX_OF(arrStart,i,a)+    if i >= 0 && INDEX_VALID(index,arrEnd,a)+    then liftIO $ pokeAt index arrContents  x+    else invalidIndex "putIndex" i++-- | Write an input stream of (index, value) pairs to an array. Throws an+-- error if any index is out of bounds.+--+-- /Pre-release/+{-# INLINE putIndices #-}+putIndices :: forall m a. (MonadIO m, Unbox a)+    => MutArray a -> Fold m (Int, a) ()+putIndices arr = FL.foldlM' step (return ())++    where++    step () (i, x) = putIndex i arr x++-- | Modify a given index of an array using a modifier function.+--+-- Unsafe because it does not check the bounds of the array.+--+-- /Pre-release/+modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> (a -> (a, b)) -> m b+modifyIndexUnsafe i MutArray{..} f = liftIO $ do+        let index = INDEX_OF(arrStart,i,a)+        assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())+        r <- peekAt index arrContents+        let (x, res) = f r+        pokeAt index arrContents  x+        return res++-- | Modify a given index of an array using a modifier function.+--+-- /Pre-release/+modifyIndex :: forall m a b. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> (a -> (a, b)) -> m b+modifyIndex i MutArray{..} f = do+    let index = INDEX_OF(arrStart,i,a)+    if i >= 0 && INDEX_VALID(index,arrEnd,a)+    then liftIO $ do+        r <- peekAt index arrContents+        let (x, res) = f r+        pokeAt index arrContents  x+        return res+    else invalidIndex "modifyIndex" i++-- | Modify the array indices generated by the supplied stream.+--+-- /Pre-release/+{-# INLINE modifyIndices #-}+modifyIndices :: forall m a . (MonadIO m, Unbox a)+    => MutArray a -> (Int -> a -> a) -> Fold m Int ()+modifyIndices arr f = FL.foldlM' step initial++    where++    initial = return ()++    step () i =+        let f1 x = (f i x, ())+         in modifyIndex i arr f1++-- | Modify each element of an array using the supplied modifier function.+--+-- This is an in-place equivalent of an immutable map operation.+--+-- /Pre-release/+modify :: forall m a. (MonadIO m, Unbox a)+    => MutArray a -> (a -> a) -> m ()+modify MutArray{..} f = liftIO $+    go arrStart++    where++    go i =+        when (INDEX_VALID(i,arrEnd,a)) $ do+            r <- peekAt i arrContents+            pokeAt i arrContents (f r)+            go (INDEX_NEXT(i,a))++-- XXX We could specify the number of bytes to swap instead of Proxy. Need+-- to ensure that the memory does not overlap.+{-# INLINE swapArrayByteIndices #-}+swapArrayByteIndices ::+       forall a. Unbox a+    => Proxy a+    -> MutByteArray+    -> Int+    -> Int+    -> IO ()+swapArrayByteIndices _ arrContents i1 i2 = do+    r1 <- peekAt i1 arrContents+    r2 <- peekAt i2 arrContents+    pokeAt i1 arrContents (r2 :: a)+    pokeAt i2 arrContents (r1 :: a)++-- | Swap the elements at two indices without validating the indices.+--+-- /Unsafe/: This could result in memory corruption if indices are not valid.+--+-- /Pre-release/+{-# INLINE unsafeSwapIndices #-}+unsafeSwapIndices :: forall m a. (MonadIO m, Unbox a)+    => Int -> Int -> MutArray a -> m ()+unsafeSwapIndices i1 i2 MutArray{..} = liftIO $ do+        let t1 = INDEX_OF(arrStart,i1,a)+            t2 = INDEX_OF(arrStart,i2,a)+        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2++-- | Swap the elements at two indices.+--+-- /Pre-release/+swapIndices :: forall m a. (MonadIO m, Unbox a)+    => Int -> Int -> MutArray a -> m ()+swapIndices i1 i2 MutArray{..} = liftIO $ do+        let t1 = INDEX_OF(arrStart,i1,a)+            t2 = INDEX_OF(arrStart,i2,a)+        when (i1 < 0 || INDEX_INVALID(t1,arrEnd,a))+            $ invalidIndex "swapIndices" i1+        when (i2 < 0 || INDEX_INVALID(t2,arrEnd,a))+            $ invalidIndex "swapIndices" i2+        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2++-------------------------------------------------------------------------------+-- Rounding+-------------------------------------------------------------------------------++-- XXX Should we use bitshifts in calculations or it gets optimized by the+-- compiler/processor itself?+--+-- | The page or block size used by the GHC allocator. Allocator allocates at+-- least a block and then allocates smaller allocations from within a block.+blockSize :: Int+blockSize = 4 * 1024++-- | Allocations larger than 'largeObjectThreshold' are in multiples of block+-- size and are always pinned. The space beyond the end of a large object up to+-- the end of the block is unused.+largeObjectThreshold :: Int+largeObjectThreshold = (blockSize * 8) `div` 10++-- XXX Should be done only when we are using the GHC allocator.+-- | Round up an array larger than 'largeObjectThreshold' to use the whole+-- block.+{-# INLINE roundUpLargeArray #-}+roundUpLargeArray :: Int -> Int+roundUpLargeArray size =+    if size >= largeObjectThreshold+    then+        assert+            (blockSize /= 0 && ((blockSize .&. (blockSize - 1)) == 0))+            ((size + blockSize - 1) .&. negate blockSize)+    else size++{-# INLINE isPower2 #-}+isPower2 :: Int -> Bool+isPower2 n = n .&. (n - 1) == 0++{-# INLINE roundUpToPower2 #-}+roundUpToPower2 :: Int -> Int+roundUpToPower2 n =+#if WORD_SIZE_IN_BITS == 64+    1 + z6+#else+    1 + z5+#endif++    where++    z0 = n - 1+    z1 = z0 .|. z0 `shiftR` 1+    z2 = z1 .|. z1 `shiftR` 2+    z3 = z2 .|. z2 `shiftR` 4+    z4 = z3 .|. z3 `shiftR` 8+    z5 = z4 .|. z4 `shiftR` 16+    z6 = z5 .|. z5 `shiftR` 32++-- | @allocBytesToBytes elem allocatedBytes@ returns the array size in bytes+-- such that the real allocation is less than or equal to @allocatedBytes@,+-- unless @allocatedBytes@ is less than the size of one array element in which+-- case it returns one element's size.+--+{-# INLINE allocBytesToBytes #-}+allocBytesToBytes :: forall a. Unbox a => a -> Int -> Int+allocBytesToBytes _ n = max (arrayPayloadSize n) (SIZE_OF(a))++-- | Given an 'Unboxed' type (unused first arg) and real allocation size+-- (including overhead), return how many elements of that type will completely+-- fit in it, returns at least 1.+--+{-# INLINE allocBytesToElemCount #-}+allocBytesToElemCount :: Unbox a => a -> Int -> Int+allocBytesToElemCount x bytes =+    let n = bytesToElemCount x (allocBytesToBytes x bytes)+     in assert (n >= 1) n++-- | The default chunk size by which the array creation routines increase the+-- size of the array when the array is grown linearly.+arrayChunkBytes :: Int+arrayChunkBytes = 1024++-------------------------------------------------------------------------------+-- Resizing+-------------------------------------------------------------------------------++-- | Round the second argument down to multiples of the first argument.+{-# INLINE roundDownTo #-}+roundDownTo :: Int -> Int -> Int+roundDownTo elemSize size = size - (size `mod` elemSize)++-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.+-- Since this is not inlined Unboxed consrraint leads to dictionary passing+-- which complicates some inspection tests.+--+{-# NOINLINE reallocExplicitAs #-}+reallocExplicitAs :: PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)+reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do+    assertM(arrEnd <= arrBound)++    -- Allocate new array+    let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes+    contents <-+        if ps == Pinned+        then Unboxed.pinnedNew newCapMaxInBytes+        else Unboxed.new newCapMaxInBytes+    let !(MutByteArray mbarrFrom#) = arrContents+        !(MutByteArray mbarrTo#) = contents++    -- Copy old data+    let oldStart = arrStart+        !(I# oldStartInBytes#) = oldStart+        oldSizeInBytes = arrEnd - oldStart+        newCapInBytes = roundDownTo elemSize newCapMaxInBytes+        !newLenInBytes@(I# newLenInBytes#) = min oldSizeInBytes newCapInBytes+    assert (oldSizeInBytes `mod` elemSize == 0) (return ())+    assert (newLenInBytes >= 0) (return ())+    assert (newLenInBytes `mod` elemSize == 0) (return ())+    IO $ \s# -> (# copyMutableByteArray# mbarrFrom# oldStartInBytes#+                        mbarrTo# 0# newLenInBytes# s#, () #)++    return $ MutArray+        { arrStart = 0+        , arrContents = contents+        , arrEnd   = newLenInBytes+        , arrBound = newCapInBytes+        }++-- XXX Should these be called reallocBytes etc?+-- XXX We may also need reallocAs to allocate as pinned/unpinned explicitly. In+-- fact clone/pinnedClone can be implemented using reallocAs.++-- | @realloc newCapacity array@ reallocates the array to the specified+-- capacity in bytes.+--+-- If the new size is less than the original array the array gets truncated.+-- If the new size is not a multiple of array element size then it is rounded+-- down to multiples of array size.  If the new size is more than+-- 'largeObjectThreshold' then it is rounded up to the block size (4K).+--+-- If the original array is pinned, the newly allocated array is also pinned.+{-# INLINABLE realloc #-}+realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+realloc bytes arr =+    let ps =+            if isPinned arr+            then Pinned+            else Unpinned+     in liftIO $ reallocExplicitAs ps (SIZE_OF(a)) bytes arr++-- | @reallocWith label capSizer minIncrBytes array@. The label is used+-- in error messages and the capSizer is used to determine the capacity of the+-- new array in bytes given the current byte length of the array.+reallocWith :: forall m a. (MonadIO m , Unbox a) =>+       String+    -> (Int -> Int)+    -> Int+    -> MutArray a+    -> m (MutArray a)+reallocWith label capSizer minIncrBytes arr = do+    let oldSizeBytes = arrEnd arr - arrStart arr+        newCapBytes = capSizer oldSizeBytes+        newSizeBytes = oldSizeBytes + minIncrBytes+        safeCapBytes = max newCapBytes newSizeBytes+    assertM(safeCapBytes >= newSizeBytes || error (badSize newSizeBytes))++    realloc safeCapBytes arr++    where++    badSize newSize =+        Prelude.concat+            [ label+            , ": new array size (in bytes) is less than required size "+            , show newSize+            , ". Please check the sizing function passed."+            ]++-- | @grow newCapacity array@ changes the total capacity of the array so that+-- it is enough to hold the specified number of elements.  Nothing is done if+-- the specified capacity is less than the length of the array.+--+-- If the capacity is more than 'largeObjectThreshold' then it is rounded up to+-- the block size (4K).+--+-- /Pre-release/+{-# INLINE grow #-}+grow :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+grow nElems arr@MutArray{..} = do+    let req = SIZE_OF(a) * nElems+        cap = arrBound - arrStart+    if req < cap+    then return arr+    else realloc req arr++{-# DEPRECATED resize "Please use grow instead." #-}+{-# INLINE resize #-}+resize :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+resize = grow++-- | Like 'grow' but if the requested byte capacity is more than+-- 'largeObjectThreshold' then it is rounded up to the closest power of 2.+--+-- /Pre-release/+{-# INLINE growExp #-}+growExp :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+growExp nElems arr@MutArray{..} = do+    let req = roundUpLargeArray (SIZE_OF(a) * nElems)+        req1 =+            if req > largeObjectThreshold+            then roundUpToPower2 req+            else req+        cap = arrBound - arrStart+    if req1 < cap+    then return arr+    else realloc req1 arr++{-# DEPRECATED resizeExp "Please use growExp instead." #-}+{-# INLINE resizeExp #-}+resizeExp :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+resizeExp = growExp++-- | Resize the allocated memory to drop any reserved free space at the end of+-- the array and reallocate it to reduce wastage.+--+-- Up to 25% wastage is allowed to avoid reallocations.  If the capacity is+-- more than 'largeObjectThreshold' then free space up to the 'blockSize' is+-- retained.+--+-- /Pre-release/+{-# INLINE rightSize #-}+rightSize :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m (MutArray a)+rightSize arr@MutArray{..} = do+    assert (arrEnd <= arrBound) (return ())+    let start = arrStart+        len = arrEnd - start+        capacity = arrBound - start+        target = roundUpLargeArray len+        waste = arrBound - arrEnd+    assert (target >= len) (return ())+    assert (len `mod` SIZE_OF(a) == 0) (return ())+    -- We trade off some wastage (25%) to avoid reallocations and copying.+    if target < capacity && len < 3 * waste+    then realloc target arr+    else return arr++-------------------------------------------------------------------------------+-- Snoc+-------------------------------------------------------------------------------++-- XXX We can possibly use a smallMutableByteArray to hold the start, end,+-- bound pointers.  Using fully mutable handle will ensure that we do not have+-- multiple references to the same array of different lengths lying around and+-- potentially misused. In that case "snoc" need not return a new array (snoc+-- :: MutArray a -> a -> m ()), it will just modify the old reference.  The array+-- length will be mutable.  This means the length function would also be+-- monadic.  Mutable arrays would behave more like files that grow in that+-- case.++-- | Snoc using a 'Ptr'. Low level reusable function.+--+-- /Internal/+{-# INLINE snocNewEnd #-}+snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)+snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do+    assert (newEnd <= arrBound) (return ())+    pokeAt arrEnd arrContents x+    return $ arr {arrEnd = newEnd}++-- | Really really unsafe, appends the element into the first array, may+-- cause silent data corruption or if you are lucky a segfault if the first+-- array does not have enough space to append the element.+--+-- /Internal/+{-# INLINE snocUnsafe #-}+snocUnsafe :: forall m a. (MonadIO m, Unbox a) =>+    MutArray a -> a -> m (MutArray a)+snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr++-- | Like 'snoc' but does not reallocate when pre-allocated array capacity+-- becomes full.+--+-- /Internal/+{-# INLINE snocMay #-}+snocMay :: forall m a. (MonadIO m, Unbox a) =>+    MutArray a -> a -> m (Maybe (MutArray a))+snocMay arr@MutArray{..} x = do+    let newEnd = INDEX_NEXT(arrEnd,a)+    if newEnd <= arrBound+    then Just <$> snocNewEnd newEnd arr x+    else return Nothing++-- NOINLINE to move it out of the way and not pollute the instruction cache.+{-# NOINLINE snocWithRealloc #-}+snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>+       (Int -> Int)+    -> MutArray a+    -> a+    -> m (MutArray a)+snocWithRealloc sizer arr x = do+    arr1 <- reallocWith "snocWith" sizer (SIZE_OF(a)) arr+    snocUnsafe arr1 x++-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of+-- the array increases by 1.+--+-- If there is no reserved space available in @arr@ it is reallocated to a size+-- in bytes determined by the @sizer oldSizeBytes@ function, where+-- @oldSizeBytes@ is the original size of the array in bytes.+--+-- If the new array size is more than 'largeObjectThreshold' we automatically+-- round it up to 'blockSize'.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- /Pre-release/+{-# INLINE snocWith #-}+snocWith :: forall m a. (MonadIO m, Unbox a) =>+       (Int -> Int)+    -> MutArray a+    -> a+    -> m (MutArray a)+snocWith allocSize arr x = do+    let newEnd = INDEX_NEXT(arrEnd arr,a)+    if newEnd <= arrBound arr+    then snocNewEnd newEnd arr x+    else snocWithRealloc allocSize arr x++-- | The array is mutated to append an additional element to it. If there+-- is no reserved space available in the array then it is reallocated to grow+-- it by 'arrayChunkBytes' rounded up to 'blockSize' when the size becomes more+-- than 'largeObjectThreshold'.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- Performs O(n^2) copies to grow but is thrifty on memory.+--+-- /Pre-release/+{-# INLINE snocLinear #-}+snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+snocLinear = snocWith (+ allocBytesToBytes (undefined :: a) arrayChunkBytes)++-- | The array is mutated to append an additional element to it. If there is no+-- reserved space available in the array then it is reallocated to double the+-- original size.+--+-- This is useful to reduce allocations when appending unknown number of+-- elements.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- >>> snoc = MutArray.snocWith (* 2)+--+-- Performs O(n * log n) copies to grow, but is liberal with memory allocation.+--+{-# INLINE snoc #-}+snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+snoc = snocWith f++    where++    f oldSize =+        if isPower2 oldSize+        then oldSize * 2+        else roundUpToPower2 oldSize * 2++-------------------------------------------------------------------------------+-- Serialization/Deserialization+-------------------------------------------------------------------------------++{-# INLINE pokeNewEnd #-}+pokeNewEnd :: (MonadIO m, Unbox a) =>+    Int -> MutArray Word8 -> a -> m (MutArray Word8)+pokeNewEnd newEnd arr@MutArray{..} x = liftIO $ do+    assert (newEnd <= arrBound) (return ())+    liftIO $ pokeAt arrEnd arrContents x+    return $ arr {arrEnd = newEnd}++-- | Really really unsafe, unboxes a Haskell type and appends the resulting+-- bytes to the byte array, may cause silent data corruption or if you are+-- lucky a segfault if the array does not have enough space to append the+-- element.+--+-- /Internal/+{-# INLINE pokeAppendUnsafe #-}+pokeAppendUnsafe :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> a -> m (MutArray Word8)+pokeAppendUnsafe arr@MutArray{..} = pokeNewEnd (arrEnd + SIZE_OF(a)) arr++-- | Skip the specified number of bytes in the array. The data in the skipped+-- region remains uninitialzed.+{-# INLINE pokeSkipUnsafe #-}+pokeSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8+pokeSkipUnsafe n arr@MutArray{..} =  do+    let newEnd = arrEnd + n+     in assert (newEnd <= arrBound) (arr {arrEnd = newEnd})++-- | Like 'pokeAppend' but does not grow the array when pre-allocated array+-- capacity becomes full.+--+-- /Internal/+{-# INLINE pokeAppendMay #-}+pokeAppendMay :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> a -> m (Maybe (MutArray Word8))+pokeAppendMay arr@MutArray{..} x = liftIO $ do+    let newEnd = arrEnd + SIZE_OF(a)+    if newEnd <= arrBound+    then Just <$> pokeNewEnd newEnd arr x+    else return Nothing++{-# NOINLINE pokeWithRealloc #-}+pokeWithRealloc :: forall m a. (MonadIO m, Unbox a) =>+       (Int -> Int)+    -> MutArray Word8+    -> a+    -> m (MutArray Word8)+pokeWithRealloc sizer arr x = do+    arr1 <- liftIO $ reallocWith "pokeWithRealloc" sizer (SIZE_OF(a)) arr+    pokeAppendUnsafe arr1 x++{-# INLINE pokeAppendWith #-}+pokeAppendWith :: forall m a. (MonadIO m, Unbox a) =>+       (Int -> Int)+    -> MutArray Word8+    -> a+    -> m (MutArray Word8)+pokeAppendWith allocSize arr x = liftIO $ do+    let newEnd = arrEnd arr + SIZE_OF(a)+    if newEnd <= arrBound arr+    then pokeNewEnd newEnd arr x+    else pokeWithRealloc allocSize arr x++-- | Unbox a Haskell type and append the resulting bytes to a mutable byte+-- array. The array is grown exponentially when more space is needed.+--+-- Definition:+--+-- >>> pokeAppend arr x = MutArray.castUnsafe <$> MutArray.snoc (MutArray.castUnsafe arr) x+--+{-# INLINE pokeAppend #-}+pokeAppend :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> a -> m (MutArray Word8)+pokeAppend = pokeAppendWith f++    where++    f oldSize =+        if isPower2 oldSize+        then oldSize * 2+        else roundUpToPower2 oldSize * 2++-- | Really really unsafe, create a Haskell value from an unboxed byte array,+-- does not check if the array is big enough, may return garbage or if you are+-- lucky may cause a segfault.+--+-- /Internal/+{-# INLINE peekUnconsUnsafe #-}+peekUnconsUnsafe :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> m (a, MutArray Word8)+peekUnconsUnsafe MutArray{..} = do+    let start1 = arrStart + SIZE_OF(a)+    assert (start1 <= arrEnd) (return ())+    liftIO $ do+        r <- peekAt arrStart arrContents+        return (r, MutArray arrContents start1 arrEnd arrBound)++-- | Discard the specified number of bytes in the array.+{-# INLINE peekSkipUnsafe #-}+peekSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8+peekSkipUnsafe n MutArray{..} =+    let start1 = arrStart + n+     in assert (start1 <= arrEnd) (MutArray arrContents start1 arrEnd arrBound)++-- | Create a Haskell value from its unboxed representation from the head of a+-- byte array, return the value and the remaining array.+{-# INLINE peekUncons #-}+peekUncons :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> m (Maybe a, MutArray Word8)+peekUncons arr@MutArray{..} = do+    let start1 = arrStart + SIZE_OF(a)+    if start1 > arrEnd+    then return (Nothing, arr)+    else liftIO $ do+        r <- peekAt arrStart arrContents+        return (Just r, MutArray arrContents start1 arrEnd arrBound)++-------------------------------------------------------------------------------+-- Random reads+-------------------------------------------------------------------------------++-- XXX Can this be deduplicated with array/foreign++-- | Return the element at the specified index without checking the bounds.+--+-- Unsafe because it does not check the bounds of the array.+{-# INLINE_NORMAL getIndexUnsafe #-}+getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+getIndexUnsafe i MutArray{..} = do+    let index = INDEX_OF(arrStart,i,a)+    assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())+    liftIO $ peekAt index arrContents++-- | /O(1)/ Lookup the element at the given index. Index starts from 0.+--+{-# INLINE getIndex #-}+getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)+getIndex i MutArray{..} = do+    let index = INDEX_OF(arrStart,i,a)+    if i >= 0 && INDEX_VALID(index,arrEnd,a)+    then liftIO $ Just <$> peekAt index arrContents+    else return Nothing++-- | /O(1)/ Lookup the element at the given index from the end of the array.+-- Index starts from 0.+--+-- Slightly faster than computing the forward index and using getIndex.+--+{-# INLINE getIndexRev #-}+getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+getIndexRev i MutArray{..} = do+    let index = RINDEX_OF(arrEnd,i,a)+    if i >= 0 && index >= arrStart+    then liftIO $ peekAt index arrContents+    else invalidIndex "getIndexRev" i++data GetIndicesState contents start end st =+    GetIndicesState contents start end st++{-# INLINE indexReaderWith #-}+indexReaderWith :: (Monad m, Unbox a) =>+    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a+indexReaderWith liftio (D.Stream stepi sti) = Unfold step inject++    where++    inject (MutArray contents start end _) =+        return $ GetIndicesState contents start end sti++    {-# INLINE_LATE step #-}+    step (GetIndicesState contents start end st) = do+        r <- stepi defState st+        case r of+            D.Yield i s -> do+                x <- liftio $ getIndex i (MutArray contents start end undefined)+                case x of+                    Just v -> return $ D.Yield v (GetIndicesState contents start end s)+                    Nothing -> error "Invalid Index"+            D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)+            D.Stop -> return D.Stop++{-# DEPRECATED getIndicesWith "Please use indexReaderWith instead." #-}+{-# INLINE getIndicesWith #-}+getIndicesWith :: (Monad m, Unbox a) =>+    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a+getIndicesWith = indexReaderWith++-- | Given an unfold that generates array indices, read the elements on those+-- indices from the supplied MutArray. An error is thrown if an index is out of+-- bounds.+--+-- /Pre-release/+{-# INLINE indexReader #-}+indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+indexReader = indexReaderWith liftIO++-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold+{-# DEPRECATED getIndices "Please use indexReader instead." #-}+{-# INLINE getIndices #-}+getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+getIndices = indexReader++-------------------------------------------------------------------------------+-- Subarrays+-------------------------------------------------------------------------------++-- XXX We can also get immutable slices.++-- | /O(1)/ Slice an array in constant time.+--+-- Unsafe: The bounds of the slice are not checked.+--+-- /Unsafe/+--+-- /Pre-release/+{-# INLINE getSliceUnsafe #-}+getSliceUnsafe :: forall a. Unbox a+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+getSliceUnsafe index len (MutArray contents start e _) =+    let fp1 = INDEX_OF(start,index,a)+        end = fp1 + (len * SIZE_OF(a))+     in assert+            (index >= 0 && len >= 0 && end <= e)+            -- Note: In a slice we always use bound = end so that the slice+            -- user cannot overwrite elements beyond the end of the slice.+            (MutArray contents fp1 end end)++-- | /O(1)/ Slice an array in constant time. Throws an error if the slice+-- extends out of the array bounds.+--+-- /Pre-release/+{-# INLINE getSlice #-}+getSlice :: forall a. Unbox a =>+       Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+getSlice index len (MutArray contents start e _) =+    let fp1 = INDEX_OF(start,index,a)+        end = fp1 + (len * SIZE_OF(a))+     in if index >= 0 && len >= 0 && end <= e+        -- Note: In a slice we always use bound = end so that the slice user+        -- cannot overwrite elements beyond the end of the slice.+        then MutArray contents fp1 end end+        else error+                $ "getSlice: invalid slice, index "+                ++ show index ++ " length " ++ show len++-------------------------------------------------------------------------------+-- In-place mutation algorithms+-------------------------------------------------------------------------------++-- XXX consider the bulk update/accumulation/permutation APIs from vector.++-- | You may not need to reverse an array because you can consume it in reverse+-- using 'readerRev'. To reverse large arrays you can read in reverse and write+-- to another array. However, in-place reverse can be useful to take adavantage+-- of cache locality and when you do not want to allocate additional memory.+--+{-# INLINE reverse #-}+reverse :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m ()+reverse MutArray{..} = liftIO $ do+    let l = arrStart+        h = INDEX_PREV(arrEnd,a)+     in swap l h++    where++    swap l h = do+        when (l < h) $ do+            swapArrayByteIndices (Proxy :: Proxy a) arrContents l h+            swap (INDEX_NEXT(l,a)) (INDEX_PREV(h,a))++-- | Generate the next permutation of the sequence, returns False if this is+-- the last permutation.+--+-- /Unimplemented/+{-# INLINE permute #-}+permute :: MutArray a -> m Bool+permute = undefined++-- | Partition an array into two halves using a partitioning predicate. The+-- first half retains values where the predicate is 'False' and the second half+-- retains values where the predicate is 'True'.+--+-- /Pre-release/+{-# INLINE partitionBy #-}+partitionBy :: forall m a. (MonadIO m, Unbox a)+    => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+partitionBy f arr@MutArray{..} = liftIO $ do+    if arrStart >= arrEnd+    then return (arr, arr)+    else do+        ptr <- go arrStart (INDEX_PREV(arrEnd,a))+        let pl = MutArray arrContents arrStart ptr ptr+            pr = MutArray arrContents ptr arrEnd arrEnd+        return (pl, pr)++    where++    -- Invariant low < high on entry, and on return as well+    moveHigh low high = do+        h <- peekAt high arrContents+        if f h+        then+            -- Correctly classified, continue the loop+            let high1 = INDEX_PREV(high,a)+             in if low == high1+                then return Nothing+                else moveHigh low high1+        else return (Just (high, h)) -- incorrectly classified++    -- Keep a low pointer starting at the start of the array (first partition)+    -- and a high pointer starting at the end of the array (second partition).+    -- Keep incrementing the low ptr and decrementing the high ptr until both+    -- are wrongly classified, at that point swap the two and continue until+    -- the two pointer cross each other.+    --+    -- Invariants when entering this loop:+    -- low <= high+    -- Both low and high are valid locations within the array+    go low high = do+        l <- peekAt low arrContents+        if f l+        then+            -- low is wrongly classified+            if low == high+            then return low+            else do -- low < high+                r <- moveHigh low high+                case r of+                    Nothing -> return low+                    Just (high1, h) -> do -- low < high1+                        pokeAt low arrContents h+                        pokeAt high1 arrContents l+                        let low1 = INDEX_NEXT(low,a)+                            high2 = INDEX_PREV(high1,a)+                        if low1 <= high2+                        then go low1 high2+                        else return low1 -- low1 > high2++        else do+            -- low is correctly classified+            let low1 = INDEX_NEXT(low,a)+            if low == high+            then return low1+            else go low1 high++-- | Shuffle corresponding elements from two arrays using a shuffle function.+-- If the shuffle function returns 'False' then do nothing otherwise swap the+-- elements. This can be used in a bottom up fold to shuffle or reorder the+-- elements.+--+-- /Unimplemented/+{-# INLINE shuffleBy #-}+shuffleBy :: (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()+shuffleBy = undefined++-- XXX we can also make the folds partial by stopping at a certain level.+--+-- | @divideBy level partition array@  performs a top down hierarchical+-- recursive partitioning fold of items in the container using the given+-- function as the partition function.  Level indicates the level in the tree+-- where the fold would stop.+--+-- This performs a quick sort if the partition function is+-- 'partitionBy (< pivot)'.+--+-- /Unimplemented/+{-# INLINABLE divideBy #-}+divideBy ::+    Int -> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()+divideBy = undefined++-- | @mergeBy level merge array@ performs a pairwise bottom up fold recursively+-- merging the pairs using the supplied merge function. Level indicates the+-- level in the tree where the fold would stop.+--+-- This performs a random shuffle if the merge function is random.  If we+-- stop at level 0 and repeatedly apply the function then we can do a bubble+-- sort.+--+-- /Unimplemented/+mergeBy :: Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()+mergeBy = undefined++-------------------------------------------------------------------------------+-- Size+-------------------------------------------------------------------------------++-- | /O(1)/ Get the byte length of the array.+--+{-# INLINE byteLength #-}+byteLength :: MutArray a -> Int+byteLength MutArray{..} =+    let len = arrEnd - arrStart+    in assert (len >= 0) len++-- Note: try to avoid the use of length in performance sensitive internal+-- routines as it involves a costly 'div' operation. Instead use the end ptr+-- in the array to check the bounds etc.+--+-- | /O(1)/ Get the length of the array i.e. the number of elements in the+-- array.+--+-- Note that 'byteLength' is less expensive than this operation, as 'length'+-- involves a costly division operation.+--+{-# INLINE length #-}+length :: forall a. Unbox a => MutArray a -> Int+length arr =+    let elemSize = SIZE_OF(a)+        blen = byteLength arr+     in assert (blen `mod` elemSize == 0) (blen `div` elemSize)++-- | Get the total capacity of an array. An array may have space reserved+-- beyond the current used length of the array.+--+-- /Pre-release/+{-# INLINE byteCapacity #-}+byteCapacity :: MutArray a -> Int+byteCapacity MutArray{..} =+    let len = arrBound - arrStart+    in assert (len >= 0) len++-- | The remaining capacity in the array for appending more elements without+-- reallocation.+--+-- /Pre-release/+{-# INLINE bytesFree #-}+bytesFree :: MutArray a -> Int+bytesFree MutArray{..} =+    let n = arrBound - arrEnd+    in assert (n >= 0) n++-------------------------------------------------------------------------------+-- Streams of arrays - Creation+-------------------------------------------------------------------------------++data GroupState s contents start end bound+    = GroupStart s+    | GroupBuffer s contents start end bound+    | GroupYield+        contents start end bound (GroupState s contents start end bound)+    | GroupFinish++{-# INLINE_NORMAL chunksOfAs #-}+chunksOfAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> D.Stream m a -> D.Stream m (MutArray a)+chunksOfAs ps n (D.Stream step state) =+    D.Stream step' (GroupStart state)++    where++    {-# INLINE_LATE step' #-}+    step' _ (GroupStart st) = do+        when (n <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ "Streamly.Internal.Data.MutArray.Mut.Type.chunksOf: "+                    ++ "the size of arrays [" ++ show n+                    ++ "] must be a natural number"+        (MutArray contents start end bound :: MutArray a) <- newAs ps n+        return $ D.Skip (GroupBuffer st contents start end bound)++    step' gst (GroupBuffer st contents start end bound) = do+        r <- step (adaptState gst) st+        case r of+            D.Yield x s -> do+                liftIO $ pokeAt end contents  x+                let end1 = INDEX_NEXT(end,a)+                return $+                    if end1 >= bound+                    then D.Skip+                            (GroupYield+                                contents start end1 bound (GroupStart s))+                    else D.Skip (GroupBuffer s contents start end1 bound)+            D.Skip s ->+                return $ D.Skip (GroupBuffer s contents start end bound)+            D.Stop ->+                return+                    $ D.Skip (GroupYield contents start end bound GroupFinish)++    step' _ (GroupYield contents start end bound next) =+        return $ D.Yield (MutArray contents start end bound) next++    step' _ GroupFinish = return D.Stop++-- | @chunksOf n stream@ groups the elements in the input stream into arrays of+-- @n@ elements each.+--+-- Same as the following but may be more efficient:+--+-- >>> chunksOf n = Stream.foldMany (MutArray.createOf n)+--+-- /Pre-release/+{-# INLINE_NORMAL chunksOf #-}+chunksOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> D.Stream m (MutArray a)+-- XXX the idiomatic implementation leads to large regression in the D.reverse'+-- benchmark. It seems it has difficulty producing optimized code when+-- converting to StreamK. Investigate GHC optimizations.+-- chunksOf n = D.foldMany (createOf n)+chunksOf = chunksOfAs Unpinned++-- | Like 'chunksOf' but creates pinned arrays.+{-# INLINE_NORMAL pinnedChunksOf #-}+pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> D.Stream m (MutArray a)+-- pinnedChunksOf n = D.foldMany (pinnedCreateOf n)+pinnedChunksOf = chunksOfAs Pinned++-- | When we are buffering a stream of unknown size into an array we do not+-- know how much space to pre-allocate. So we start with the min size and emit+-- the array then keep on doubling the size every time. Thus we do not need to+-- guess the optimum chunk size.+--+-- We can incorporate this in chunksOfAs if the additional size parameter does+-- not impact perf.+--+{-# INLINE _chunksOfRange #-}+_chunksOfRange :: -- (MonadIO m, Unbox a) =>+    PinnedState -> Int -> Int -> D.Stream m a -> D.Stream m (MutArray a)+_chunksOfRange _ps _low _hi = undefined++-- XXX buffer to a list instead?+-- | Buffer the stream into arrays in memory.+{-# INLINE arrayStreamKFromStreamDAs #-}+arrayStreamKFromStreamDAs :: forall m a. (MonadIO m, Unbox a) =>+    PinnedState -> D.Stream m a -> m (StreamK m (MutArray a))+arrayStreamKFromStreamDAs ps =+    let n = allocBytesToElemCount (undefined :: a) defaultChunkSize+     in D.foldr K.cons K.nil . chunksOfAs ps n++-------------------------------------------------------------------------------+-- Streams of arrays - Flattening+-------------------------------------------------------------------------------++data FlattenState s contents a =+      OuterLoop s+    | InnerLoop s contents !Int !Int++{-# INLINE_NORMAL concatWith #-}+concatWith :: forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a+concatWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (OuterLoop st) = do+        r <- step (adaptState gst) st+        return $ case r of+            D.Yield MutArray{..} s ->+                D.Skip (InnerLoop s arrContents arrStart arrEnd)+            D.Skip s -> D.Skip (OuterLoop s)+            D.Stop -> D.Stop++    step' _ (InnerLoop st _ p end) | assert (p <= end) (p == end) =+        return $ D.Skip $ OuterLoop st++    step' _ (InnerLoop st contents p end) = do+        x <- liftio $ peekAt p contents+        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)++-- | Use the "reader" unfold instead.+--+-- @concat = unfoldMany reader@+--+-- We can try this if there are any fusion issues in the unfold.+--+{-# INLINE_NORMAL concat #-}+concat :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+concat = concatWith liftIO++{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}+{-# INLINE flattenArrays #-}+flattenArrays :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+flattenArrays = concat++{-# INLINE_NORMAL concatRevWith #-}+concatRevWith :: forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a+concatRevWith liftio (D.Stream step state) = D.Stream step' (OuterLoop state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (OuterLoop st) = do+        r <- step (adaptState gst) st+        return $ case r of+            D.Yield MutArray{..} s ->+                let p = INDEX_PREV(arrEnd,a)+                 in D.Skip (InnerLoop s arrContents p arrStart)+            D.Skip s -> D.Skip (OuterLoop s)+            D.Stop -> D.Stop++    step' _ (InnerLoop st _ p start) | p < start =+        return $ D.Skip $ OuterLoop st++    step' _ (InnerLoop st contents p start) = do+        x <- liftio $ peekAt p contents+        let cur = INDEX_PREV(p,a)+        return $ D.Yield x (InnerLoop st contents cur start)++-- | Use the "readerRev" unfold instead.+--+-- @concat = unfoldMany readerRev@+--+-- We can try this if there are any fusion issues in the unfold.+--+{-# INLINE_NORMAL concatRev #-}+concatRev :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+concatRev = concatRevWith liftIO++{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}+{-# INLINE flattenArraysRev #-}+flattenArraysRev :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+flattenArraysRev = concatRev++-------------------------------------------------------------------------------+-- Unfolds+-------------------------------------------------------------------------------++data ArrayUnsafe a = ArrayUnsafe+    {-# UNPACK #-} !MutByteArray   -- contents+    {-# UNPACK #-} !Int                -- index 1+    {-# UNPACK #-} !Int                -- index 2++toArrayUnsafe :: MutArray a -> ArrayUnsafe a+toArrayUnsafe (MutArray contents start end _) = ArrayUnsafe contents start end++fromArrayUnsafe ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    ArrayUnsafe a -> MutArray a+fromArrayUnsafe (ArrayUnsafe contents start end) =+         MutArray contents start end end++{-# INLINE_NORMAL producerWith #-}+producerWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> Producer m (MutArray a) a+producerWith liftio = Producer step (return . toArrayUnsafe) extract+    where++    {-# INLINE_LATE step #-}+    step (ArrayUnsafe _ cur end)+        | assert (cur <= end) (cur == end) = return D.Stop+    step (ArrayUnsafe contents cur end) = do+            -- When we use a purely lazy Monad like Identity, we need to force a+            -- few actions for correctness and execution order sanity. We want+            -- the peek to occur right here and not lazily at some later point+            -- because we want the peek to be ordered with respect to the touch.+            !x <- liftio $ peekAt cur contents+            return $ D.Yield x (ArrayUnsafe contents (INDEX_NEXT(cur,a)) end)++    extract = return . fromArrayUnsafe++-- | Resumable unfold of an array.+--+{-# INLINE_NORMAL producer #-}+producer :: forall m a. (MonadIO m, Unbox a) => Producer m (MutArray a) a+producer = producerWith liftIO++-- | Unfold an array into a stream.+--+{-# INLINE_NORMAL reader #-}+reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a+reader = Producer.simplify producer++{-# INLINE_NORMAL readerRevWith #-}+readerRevWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> Unfold m (MutArray a) a+readerRevWith liftio = Unfold step inject+    where++    inject (MutArray contents start end _) =+        let p = INDEX_PREV(end,a)+         in return $ ArrayUnsafe contents start p++    {-# INLINE_LATE step #-}+    step (ArrayUnsafe _ start p) | p < start = return D.Stop+    step (ArrayUnsafe contents start p) = do+        !x <- liftio $ peekAt p contents+        return $ D.Yield x (ArrayUnsafe contents start (INDEX_PREV(p,a)))++-- | Unfold an array into a stream in reverse order.+--+{-# INLINE_NORMAL readerRev #-}+readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a+readerRev = readerRevWith liftIO++-------------------------------------------------------------------------------+-- to Lists and streams+-------------------------------------------------------------------------------++{-+-- Use foldr/build fusion to fuse with list consumers+-- This can be useful when using the IsList instance+{-# INLINE_LATE toListFB #-}+toListFB :: forall a b. Unbox a => (a -> b -> b) -> b -> MutArray a -> b+toListFB c n MutArray{..} = go arrStart+    where++    go p | assert (p <= arrEnd) (p == arrEnd) = n+    go p =+        -- unsafeInlineIO allows us to run this in Identity monad for pure+        -- toList/foldr case which makes them much faster due to not+        -- accumulating the list and fusing better with the pure consumers.+        --+        -- This should be safe as the array contents are guaranteed to be+        -- evaluated/written to before we peek at them.+        -- XXX+        let !x = unsafeInlineIO $ do+                    r <- peekAt arrContents p+                    return r+        in c x (go (PTR_NEXT(p,a)))+-}++-- XXX Monadic foldr/build fusion?+-- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion++-- | Convert a 'MutArray' into a list.+--+{-# INLINE toList #-}+toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]+toList MutArray{..} = liftIO $ go arrStart+    where++    go p | assert (p <= arrEnd) (p == arrEnd) = return []+    go p = do+        x <- peekAt p arrContents+        (:) x <$> go (INDEX_NEXT(p,a))++{-# INLINE_NORMAL toStreamWith #-}+toStreamWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a+toStreamWith liftio MutArray{..} = D.Stream step arrStart++    where++    {-# INLINE_LATE step #-}+    step _ p | assert (p <= arrEnd) (p == arrEnd) = return D.Stop+    step _ p = liftio $ do+        r <- peekAt p arrContents+        return $ D.Yield r (INDEX_NEXT(p,a))++-- | Convert a 'MutArray' into a stream.+--+-- >>> read = Stream.unfold MutArray.reader+--+{-# INLINE_NORMAL read #-}+read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a+read = toStreamWith liftIO++{-# INLINE toStreamKWith #-}+toStreamKWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a+toStreamKWith liftio MutArray{..} = go arrStart++    where++    go p | assert (p <= arrEnd) (p == arrEnd) = K.nil+         | otherwise =+        let elemM = peekAt p arrContents+        in liftio elemM `K.consM` go (INDEX_NEXT(p,a))++{-# INLINE toStreamK #-}+toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a+toStreamK = toStreamKWith liftIO++{-# INLINE_NORMAL toStreamRevWith #-}+toStreamRevWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a+toStreamRevWith liftio MutArray{..} =+    let p = INDEX_PREV(arrEnd,a)+    in D.Stream step p++    where++    {-# INLINE_LATE step #-}+    step _ p | p < arrStart = return D.Stop+    step _ p = liftio $ do+        r <- peekAt p arrContents+        return $ D.Yield r (INDEX_PREV(p,a))++-- | Convert a 'MutArray' into a stream in reverse order.+--+-- >>> readRev = Stream.unfold MutArray.readerRev+--+{-# INLINE_NORMAL readRev #-}+readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a+readRev = toStreamRevWith liftIO++{-# INLINE toStreamKRevWith #-}+toStreamKRevWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a+toStreamKRevWith liftio MutArray {..} =+    let p = INDEX_PREV(arrEnd,a)+    in go p++    where++    go p | p < arrStart = K.nil+         | otherwise =+        let elemM = peekAt p arrContents+        in liftio elemM `K.consM` go (INDEX_PREV(p,a))++{-# INLINE toStreamKRev #-}+toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a+toStreamKRev = toStreamKRevWith liftIO++-------------------------------------------------------------------------------+-- Folding+-------------------------------------------------------------------------------++-- XXX Need something like "MutArray m a" enforcing monadic action to avoid the+-- possibility of such APIs.+--+-- | Strict left fold of an array.+{-# INLINE_NORMAL foldl' #-}+foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b+foldl' f z arr = D.foldl' f z $ read arr++-- | Right fold of an array.+{-# INLINE_NORMAL foldr #-}+foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b+foldr f z arr = D.foldr f z $ read arr++-------------------------------------------------------------------------------+-- Folds+-------------------------------------------------------------------------------++-- Note: Arrays may be allocated with a specific alignment at the beginning of+-- the array. If you need to maintain that alignment on reallocations then you+-- can resize the array manually before append, using an aligned resize+-- operation.++-- XXX Keep the bound intact to not lose any free space? Perf impact?++-- | @unsafeAppendN n arr@ appends up to @n@ input items to the supplied+-- array.+--+-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory+-- corruption or segfault.+--+-- Any free space left in the array after appending @n@ elements is lost.+--+-- /Internal/+{-# INLINE_NORMAL unsafeAppendN #-}+unsafeAppendN :: forall m a. (MonadIO m, Unbox a) =>+       Int+    -> m (MutArray a)+    -> Fold m a (MutArray a)+unsafeAppendN n action = fmap fromArrayUnsafe $ FL.foldlM' step initial++    where++    initial = do+        assert (n >= 0) (return ())+        arr@(MutArray _ _ end bound) <- action+        let free = bound - end+            needed = n * SIZE_OF(a)+        -- XXX We can also reallocate if the array has too much free space,+        -- otherwise we lose that space.+        arr1 <-+            if free < needed+            then noinline reallocWith "unsafeAppendN" (+ needed) needed arr+            else return arr+        return $ toArrayUnsafe arr1++    step (ArrayUnsafe contents start end) x = do+        liftIO $ pokeAt end contents x+        return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))++{-# DEPRECATED writeAppendNUnsafe "Please use unsafeAppendN instead." #-}+{-# INLINE writeAppendNUnsafe #-}+writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>+       Int+    -> m (MutArray a)+    -> Fold m a (MutArray a)+writeAppendNUnsafe = unsafeAppendN++-- | Append @n@ elements to an existing array. Any free space left in the array+-- after appending @n@ elements is lost.+--+-- >>> appendN n initial = Fold.take n (MutArray.unsafeAppendN n initial)+--+{-# INLINE_NORMAL appendN #-}+appendN :: forall m a. (MonadIO m, Unbox a) =>+    Int -> m (MutArray a) -> Fold m a (MutArray a)+appendN n initial = FL.take n (unsafeAppendN n initial)++-- XXX Deprecate in major+-- {-# DEPRECATED writeAppendN "Please use appendN instead." #-}+{-# INLINE writeAppendN #-}+writeAppendN :: forall m a. (MonadIO m, Unbox a) =>+    Int -> m (MutArray a) -> Fold m a (MutArray a)+writeAppendN = appendN++-- | @appendWith realloc action@ mutates the array generated by @action@ to+-- append the input stream. If there is no reserved space available in the+-- array it is reallocated to a size in bytes  determined by @realloc oldSize@,+-- where @oldSize@ is the current size of the array in bytes.+--+-- Note that the returned array may be a mutated version of original array.+--+-- >>> appendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)+--+-- /Pre-release/+{-# INLINE appendWith #-}+appendWith :: forall m a. (MonadIO m, Unbox a) =>+    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+appendWith sizer = FL.foldlM' (snocWith sizer)++{-# DEPRECATED writeAppendWith "Please use appendWith instead." #-}+{-# INLINE writeAppendWith #-}+writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>+    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+writeAppendWith = appendWith++-- | @append action@ mutates the array generated by @action@ to append the+-- input stream. If there is no reserved space available in the array it is+-- reallocated to double the size.+--+-- Note that the returned array may be a mutated version of original array.+--+-- >>> append = MutArray.appendWith (* 2)+--+{-# INLINE append #-}+append :: forall m a. (MonadIO m, Unbox a) =>+    m (MutArray a) -> Fold m a (MutArray a)+append = appendWith (* 2)++-- XXX Deprecate in major+-- {-# DEPRECATED writeAppend "Please use append instead." #-}+{-# INLINE writeAppend #-}+writeAppend :: forall m a. (MonadIO m, Unbox a) =>+    m (MutArray a) -> Fold m a (MutArray a)+writeAppend = append++-- XXX We can carry bound as well in the state to make sure we do not lose the+-- remaining capacity. Need to check perf impact.+--+-- | Like 'unsafeCreateOf' but takes a new array allocator @alloc size@+-- function as argument.+--+-- >>> unsafeCreateOfWith alloc n = MutArray.unsafeAppendN (alloc n) n+--+-- /Pre-release/+{-# INLINE_NORMAL unsafeCreateOfWith #-}+unsafeCreateOfWith :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+unsafeCreateOfWith alloc n = fromArrayUnsafe <$> FL.foldlM' step initial++    where++    initial = toArrayUnsafe <$> alloc (max n 0)++    step (ArrayUnsafe contents start end) x = do+        liftIO $ pokeAt end contents x+        return+          $ ArrayUnsafe contents start (INDEX_NEXT(end,a))++{-# DEPRECATED writeNWithUnsafe "Please use unsafeCreateOfWith instead." #-}+{-# INLINE writeNWithUnsafe #-}+writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeNWithUnsafe = unsafeCreateOfWith++{-# INLINE_NORMAL writeNUnsafeAs #-}+writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Fold m a (MutArray a)+writeNUnsafeAs ps = unsafeCreateOfWith (newAs ps)++-- | Like 'createOf' but does not check the array bounds when writing. The fold+-- driver must not call the step function more than 'n' times otherwise it will+-- corrupt the memory and crash. This function exists mainly because any+-- conditional in the step function blocks fusion causing 10x performance+-- slowdown.+--+-- >>> unsafeCreateOf = MutArray.unsafeCreateOfWith MutArray.emptyOf+--+{-# INLINE_NORMAL unsafeCreateOf #-}+unsafeCreateOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+unsafeCreateOf = writeNUnsafeAs Unpinned++{-# DEPRECATED writeNUnsafe "Please use unsafeCreateOf instead." #-}+{-# INLINE writeNUnsafe #-}+writeNUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+writeNUnsafe = unsafeCreateOf++-- | Like 'unsafeCreateOf' but creates a pinned array.+{-# INLINE_NORMAL unsafePinnedCreateOf #-}+unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+unsafePinnedCreateOf = writeNUnsafeAs Pinned++{-# DEPRECATED pinnedWriteNUnsafe "Please use unsafePinnedCreateOf instead." #-}+{-# INLINE pinnedWriteNUnsafe #-}+pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+pinnedWriteNUnsafe = unsafePinnedCreateOf++-- | @createOfWith alloc n@ folds a maximum of @n@ elements into an array+-- allocated using the @alloc@ function.+--+-- >>> createOfWith alloc n = Fold.take n (MutArray.unsafeCreateOfWith alloc n)+-- >>> createOfWith alloc n = MutArray.appendN (alloc n) n+--+{-# INLINE_NORMAL createOfWith #-}+createOfWith :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+createOfWith alloc n = FL.take n (unsafeCreateOfWith alloc n)++-- {-# DEPRECATED writeNWith "Please use createOfWith instead." #-}+{-# INLINE writeNWith #-}+writeNWith :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeNWith = createOfWith++{-# INLINE_NORMAL writeNAs #-}+writeNAs ::+       forall m a. (MonadIO m, Unbox a)+    => PinnedState+    -> Int+    -> Fold m a (MutArray a)+writeNAs ps = createOfWith (newAs ps)++-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an+-- 'MutArray'.+--+-- >>> createOf = MutArray.createOfWith MutArray.new+-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)+-- >>> createOf n = MutArray.appendN n (MutArray.emptyOf n)+--+{-# INLINE_NORMAL createOf #-}+createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+createOf = writeNAs Unpinned++-- XXX Deprecate in major+-- {-# DEPRECATED writeN "Please use createOf instead." #-}+{-# INLINE writeN #-}+writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+writeN = createOf++-- | Like 'createOf' but creates a pinned array.+{-# INLINE_NORMAL pinnedCreateOf #-}+pinnedCreateOf ::+       forall m a. (MonadIO m, Unbox a)+    => Int+    -> Fold m a (MutArray a)+pinnedCreateOf = writeNAs Pinned++{-# DEPRECATED pinnedWriteN "Please use pinnedCreateOf instead." #-}+{-# INLINE pinnedWriteN #-}+pinnedWriteN ::+       forall m a. (MonadIO m, Unbox a)+    => Int+    -> Fold m a (MutArray a)+pinnedWriteN = pinnedCreateOf++-- | Like unsafeCreateOfWith but writes the array in reverse order.+--+-- /Internal/+{-# INLINE_NORMAL writeRevNWithUnsafe #-}+writeRevNWithUnsafe :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial++    where++    toArrayUnsafeRev (MutArray contents _ _ bound) =+         ArrayUnsafe contents bound bound++    initial = toArrayUnsafeRev <$> alloc (max n 0)++    step (ArrayUnsafe contents start end) x = do+        let ptr = INDEX_PREV(start,a)+        liftIO $ pokeAt ptr contents x+        return+          $ ArrayUnsafe contents ptr end++-- | Like createOfWith but writes the array in reverse order.+--+-- /Internal/+{-# INLINE_NORMAL writeRevNWith #-}+writeRevNWith :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)++-- | Like 'createOf' but writes the array in reverse order.+--+-- /Pre-release/+{-# INLINE_NORMAL revCreateOf #-}+revCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+revCreateOf = writeRevNWith new++{-# DEPRECATED writeRevN "Please use revCreateOf instead." #-}+{-# INLINE writeRevN #-}+writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+writeRevN = revCreateOf++-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the+-- input stream to a 'MutArray' aligned to the given size.+--+-- >>> pinnedWriteNAligned align = MutArray.createOfWith (MutArray.pinnedNewAligned align)+-- >>> pinnedWriteNAligned align n = MutArray.appendN n (MutArray.pinnedNewAligned align n)+--+-- /Pre-release/+--+{-# INLINE_NORMAL pinnedWriteNAligned #-}+pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)+    => Int -> Int -> Fold m a (MutArray a)+pinnedWriteNAligned align = createOfWith (pinnedNewAligned align)++-- XXX Buffer to a list instead?++-- | Buffer a stream into a stream of arrays.+--+-- >>> buildChunks n = Fold.many (MutArray.createOf n) Fold.toStreamK+--+-- Breaking an array into an array stream  can be useful to consume a large+-- array sequentially such that memory of the array is released incrementatlly.+--+-- See also: 'arrayStreamKFromStreamD'.+--+-- /Unimplemented/+--+{-# INLINE_NORMAL buildChunks #-}+buildChunks :: (MonadIO m, Unbox a) =>+    Int -> Fold m a (StreamK n (MutArray a))+buildChunks n = FL.many (createOf n) FL.toStreamK++{-# DEPRECATED writeChunks "Please use buildChunks instead." #-}+{-# INLINE writeChunks #-}+writeChunks :: (MonadIO m, Unbox a) =>+    Int -> Fold m a (StreamK n (MutArray a))+writeChunks = buildChunks++{-# INLINE_NORMAL writeWithAs #-}+writeWithAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Fold m a (MutArray a)+-- writeWithAs ps n = FL.rmapM rightSize $ appendWith (* 2) (newAs ps n)+writeWithAs ps elemCount =+    FL.rmapM extract $ FL.foldlM' step initial++    where++    initial = do+        when (elemCount < 0) $ error "createWith: elemCount is negative"+        newAs ps elemCount++    step arr@(MutArray _ start end bound) x+        | INDEX_NEXT(end,a) > bound = do+        let oldSize = end - start+            newSize = max (oldSize * 2) 1+        arr1 <- liftIO $ reallocExplicitAs ps (SIZE_OF(a)) newSize arr+        snocUnsafe arr1 x+    step arr x = snocUnsafe arr x++    extract = liftIO . rightSize++-- XXX Compare createWith with fromStreamD which uses an array of streams+-- implementation. We can write this using buildChunks above if that is faster.+-- If createWith is faster then we should use that to implement+-- fromStreamD.+--+-- XXX The realloc based implementation needs to make one extra copy if we use+-- shrinkToFit.  On the other hand, the stream of arrays implementation may+-- buffer the array chunk pointers in memory but it does not have to shrink as+-- we know the exact size in the end. However, memory copying does not seem to+-- be as expensive as the allocations. Therefore, we need to reduce the number+-- of allocations instead. Also, the size of allocations matters, right sizing+-- an allocation even at the cost of copying sems to help.  Should be measured+-- on a big stream with heavy calls to toArray to see the effect.+--+-- XXX check if GHC's memory allocator is efficient enough. We can try the C+-- malloc to compare against.++-- | @createWith minCount@ folds the whole input to a single array. The array+-- starts at a size big enough to hold minCount elements, the size is doubled+-- every time the array needs to be grown.+--+-- /Caution! Do not use this on infinite streams./+--+-- >>> f n = MutArray.appendWith (* 2) (MutArray.emptyOf n)+-- >>> createWith n = Fold.rmapM MutArray.rightSize (f n)+-- >>> createWith n = Fold.rmapM MutArray.fromChunksK (MutArray.buildChunks n)+--+-- /Pre-release/+{-# INLINE_NORMAL createWith #-}+createWith :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+-- createWith n = FL.rmapM rightSize $ appendWith (* 2) (emptyOf n)+createWith = writeWithAs Unpinned++{-# DEPRECATED writeWith "Please use createWith instead." #-}+{-# INLINE writeWith #-}+writeWith :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+writeWith = createWith++-- | Fold the whole input to a single array.+--+-- Same as 'createWith' using an initial array size of 'arrayChunkBytes' bytes+-- rounded up to the element size.+--+-- /Caution! Do not use this on infinite streams./+--+{-# INLINE create #-}+create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+create = createWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)++-- XXX Deprecate in major+-- {-# DEPRECATED write "Please use create instead." #-}+{-# INLINE write #-}+write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+write = create++-- | Like 'create' but creates a pinned array.+{-# INLINE pinnedCreate #-}+pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+pinnedCreate =+    writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)++{-# DEPRECATED pinnedWrite "Please use pinnedCreate instead." #-}+{-# INLINE pinnedWrite #-}+pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+pinnedWrite = pinnedCreate++-------------------------------------------------------------------------------+-- construct from streams, known size+-------------------------------------------------------------------------------++{-# INLINE_NORMAL fromStreamDNAs #-}+fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> D.Stream m a -> m (MutArray a)+fromStreamDNAs ps limit str = do+    (arr :: MutArray a) <- newAs ps limit+    end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str+    return $ arr {arrEnd = end}++    where++    fwrite arrContents ptr x = do+        liftIO $ pokeAt ptr arrContents  x+        return $ INDEX_NEXT(ptr,a)++-- | Use the 'createOf' fold instead.+--+-- >>> fromStreamN n = Stream.fold (MutArray.createOf n)+--+{-# INLINE_NORMAL fromStreamN #-}+fromStreamN :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> m (MutArray a)+-- fromStreamDN n = D.fold (createOf n)+fromStreamN = fromStreamDNAs Unpinned++{-# DEPRECATED fromStreamDN "Please use fromStreamN instead." #-}+{-# INLINE fromStreamDN #-}+fromStreamDN :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> m (MutArray a)+fromStreamDN = fromStreamN++-- | Create a 'MutArray' from the first N elements of a list. The array is+-- allocated to size N, if the list terminates before N elements then the+-- array may hold less than N elements.+--+{-# INLINABLE fromListN #-}+fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+fromListN n xs = fromStreamDN n $ D.fromList xs++-- | Like 'fromListN' but creates a pinned array.+{-# INLINABLE pinnedFromListN #-}+pinnedFromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+pinnedFromListN n xs = fromStreamDNAs Pinned n $ D.fromList xs++-- | Like fromListN but writes the array in reverse order.+--+-- /Pre-release/+{-# INLINE fromListRevN #-}+fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+fromListRevN n xs = D.fold (revCreateOf n) $ D.fromList xs++-- | Convert a pure stream in Identity monad to a mutable array.+{-# INLINABLE fromPureStreamN #-}+fromPureStreamN :: (MonadIO m, Unbox a) =>+    Int -> Stream Identity a -> m (MutArray a)+fromPureStreamN n xs =+    D.fold (createOf n) $ D.morphInner (return . runIdentity) xs++-- | Convert a pure stream in Identity monad to a mutable array.+{-# INLINABLE fromPureStream #-}+fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)+fromPureStream xs =+    D.fold create $ D.morphInner (return . runIdentity) xs++{-# INLINABLE fromPtrN #-}+fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)+fromPtrN len addr = do+    -- memcpy is better than stream copy when the size is known.+    -- XXX We can implement a stream copy in a similar way by streaming Word64+    -- first and then remaining Word8.+    arr <- new len+    _ <- unsafeAsPtr arr+            (\ptr -> liftIO $ c_memcpy ptr addr (fromIntegral len))+    return (arr {arrEnd = len})++{-# INLINABLE fromByteStr# #-}+fromByteStr# :: MonadIO m => Addr# -> m (MutArray Word8)+fromByteStr# addr = do+    -- It is better to count the size first and allocate exact space.+    -- Also, memcpy is better than stream copy when the size is known.+    -- C strlen compares 4 bytes at a time, so is better than the stream+    -- version. https://github.com/bminor/glibc/blob/master/string/strlen.c+    -- XXX We can possibly use a stream of Word64 to do the same.+    -- fromByteStr# addr = fromPureStream (D.fromByteStr# addr)+    len <- liftIO $ c_strlen (Ptr addr)+    let lenInt = fromIntegral len+    arr <- new lenInt+    _ <- unsafeAsPtr arr (\ptr -> liftIO $ c_memcpy ptr (Ptr addr) len)+    return (arr {arrEnd = lenInt})++-------------------------------------------------------------------------------+-- convert a stream of arrays to a single array by reallocating and copying+-------------------------------------------------------------------------------++-- XXX Both of these implementations of splicing seem to perform equally well.+-- We need to perform benchmarks over a range of sizes though.++-- | Also see 'fromChunksK'.+{-# INLINE fromChunksRealloced #-}+fromChunksRealloced :: forall m a. (MonadIO m, Unbox a)+    => Stream m (MutArray a) -> m (MutArray a)+fromChunksRealloced s = do+    res <- D.uncons s+    case res of+        Just (a, strm) -> do+            arr <- D.foldlM' spliceExp (pure a) strm+            -- Reallocation is exponential so there may be 50% empty space in+            -- worst case. One more reallocation to reclaim the space.+            rightSize arr+        Nothing -> pure nil++-------------------------------------------------------------------------------+-- convert a stream of arrays to a single array by buffering arrays first+-------------------------------------------------------------------------------++{-# INLINE arrayStreamKLength #-}+arrayStreamKLength :: (Monad m, Unbox a) => StreamK m (MutArray a) -> m Int+arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)++-- | Convert an array stream to an array. Note that this requires peak memory+-- that is double the size of the array stream.+--+{-# INLINE fromChunkskAs #-}+fromChunkskAs :: (Unbox a, MonadIO m) =>+    PinnedState -> StreamK m (MutArray a) -> m (MutArray a)+fromChunkskAs ps as = do+    len <- arrayStreamKLength as+    arr <- newAs ps len+    -- XXX is StreamK fold faster or StreamD fold?+    K.foldlM' spliceUnsafe (pure arr) as+    -- fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as++-- XXX Need to compare this with fromChunks and fromChunkList and keep the+-- fastest or simplest one if all are equally fast.++-- | Convert an array stream to an array. Note that this requires peak memory+-- that is double the size of the array stream.+--+-- Also see 'fromChunksRealloced'.+--+{-# INLINE fromChunksK #-}+fromChunksK :: (Unbox a, MonadIO m) =>+    StreamK m (MutArray a) -> m (MutArray a)+fromChunksK = fromChunkskAs Unpinned++{-# DEPRECATED fromArrayStreamK "Please use fromChunksK instead." #-}+{-# INLINE fromArrayStreamK #-}+fromArrayStreamK :: (Unbox a, MonadIO m) =>+    StreamK m (MutArray a) -> m (MutArray a)+fromArrayStreamK = fromChunksK++{-# INLINE fromStreamDAs #-}+fromStreamDAs ::+       (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)+fromStreamDAs ps m =+    arrayStreamKFromStreamDAs Unpinned m >>= fromChunkskAs ps++-- | Create an 'Array' from a stream. This is useful when we want to create a+-- single array from a stream of unknown size. 'createOf' is at least twice+-- as efficient when the size is already known.+--+-- Note that if the input stream is too large memory allocation for the array+-- may fail.  When the stream size is not known, `chunksOf` followed by+-- processing of indvidual arrays in the resulting stream should be preferred.+--+-- /Pre-release/+{-# INLINE fromStream #-}+fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)+fromStream = fromStreamDAs Unpinned++-- fromStream (Stream m) = P.fold create m+-- CAUTION: a very large number (millions) of arrays can degrade performance+-- due to GC overhead because we need to buffer the arrays before we flatten+-- all the arrays.+--+-- XXX Compare if this is faster or "fold create".+--+-- | We could take the approach of doubling the memory allocation on each+-- overflow. This would result in more or less the same amount of copying as in+-- the chunking approach. However, if we have to shrink in the end then it may+-- result in an extra copy of the entire data.+--+-- >>> fromStreamD = StreamD.fold MutArray.create+--+{-# INLINE fromStreamD #-}+{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}+fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)+fromStreamD = fromStream++-- | Create a 'MutArray' from a list. The list must be of finite size.+--+{-# INLINE fromList #-}+fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+fromList xs = fromStreamD $ D.fromList xs++-- | Like 'fromList' but creates a pinned array.+{-# INLINE pinnedFromList #-}+pinnedFromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+pinnedFromList xs = fromStreamDAs Pinned $ D.fromList xs++-- XXX We are materializing the whole list first for getting the length. Check+-- if the 'fromList' like chunked implementation would fare better.++-- | Like 'fromList' but writes the contents of the list in reverse order.+{-# INLINE fromListRev #-}+fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+fromListRev xs = fromListRevN (Prelude.length xs) xs++-------------------------------------------------------------------------------+-- Cloning+-------------------------------------------------------------------------------++-- Arrays are aligned on 64-bit boundaries. The fastest way to copy an array is+-- to unsafeCast it to Word64, read it, write it to Word64 array and unsafeCast+-- it again. We can use SIMD read/write as well.++{-# INLINE cloneAs #-}+cloneAs ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => PinnedState -> MutArray a -> m (MutArray a)+cloneAs ps src =+    do+        let startSrc = arrStart src+            srcLen = arrEnd src - startSrc+        newArrContents <-+            Unboxed.cloneSliceUnsafeAs ps startSrc srcLen (arrContents src)+        return $ MutArray newArrContents 0 srcLen srcLen++{-# INLINE clone #-}+clone ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => MutArray a -> m (MutArray a)+clone = cloneAs Unpinned++{-# INLINE pinnedClone #-}+pinnedClone ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => MutArray a -> m (MutArray a)+pinnedClone = cloneAs Pinned++-------------------------------------------------------------------------------+-- Combining+-------------------------------------------------------------------------------++-- | Copy two arrays into a newly allocated array. If the first array is pinned+-- the spliced array is also pinned.+{-# INLINE spliceCopy #-}+spliceCopy :: forall m a. MonadIO m =>+#ifdef DEVBUILD+    Unbox a =>+#endif+    MutArray a -> MutArray a -> m (MutArray a)+spliceCopy arr1 arr2 = do+    let start1 = arrStart arr1+        start2 = arrStart arr2+        len1 = arrEnd arr1 - start1+        len2 = arrEnd arr2 - start2+    let len = len1 + len2+    newArrContents <-+        if Unboxed.isPinned (arrContents arr1)+        then liftIO $ Unboxed.pinnedNew len+        else liftIO $ Unboxed.new len+    putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1+    putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2+    return $ MutArray newArrContents 0 len len++-- | Really really unsafe, appends the second array into the first array. If+-- the first array does not have enough space it may cause silent data+-- corruption or if you are lucky a segfault.+{-# INLINE spliceUnsafe #-}+spliceUnsafe :: MonadIO m =>+    MutArray a -> MutArray a -> m (MutArray a)+spliceUnsafe dst src =+    do+         let startSrc = arrStart src+             srcLen = arrEnd src - startSrc+             endDst = arrEnd dst+         assertM(endDst + srcLen <= arrBound dst)+         putSliceUnsafe+             (arrContents src) startSrc (arrContents dst) endDst srcLen+         return $ dst {arrEnd = endDst + srcLen}++-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no+-- reserved space available in @dst@ it is reallocated to a size determined by+-- the @sizer dstBytes srcBytes@ function, where @dstBytes@ is the size of the+-- first array and @srcBytes@ is the size of the second array, in bytes.+--+-- Note that the returned array may be a mutated version of first array.+--+-- /Pre-release/+{-# INLINE spliceWith #-}+spliceWith :: forall m a. (MonadIO m, Unbox a) =>+    (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)+spliceWith sizer dst@(MutArray _ start end bound) src = do+{-+    let f = appendWith (`sizer` byteLength src) (return dst)+     in D.fold f (toStreamD src)+-}+    assert (end <= bound) (return ())+    let srcBytes = arrEnd src - arrStart src++    dst1 <-+        if end + srcBytes >= bound+        then do+            let dstBytes = end - start+                newSizeInBytes = sizer dstBytes srcBytes+            when (newSizeInBytes < dstBytes + srcBytes)+                $ error+                    $ "splice: newSize is less than the total size "+                    ++ "of arrays being appended. Please check the "+                    ++ "sizer function passed."+            realloc newSizeInBytes dst+        else return dst+    spliceUnsafe dst1 src++-- | The first array is mutated to append the second array. If there is no+-- reserved space available in the first array a new allocation of exact+-- required size is done.+--+-- Note that the returned array may be a mutated version of first array.+--+-- >>> splice = MutArray.spliceWith (+)+--+-- If the original array is pinned the spliced array is also pinned.+--+-- /Pre-release/+{-# INLINE splice #-}+splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)+splice = spliceWith (+)++-- | Like 'append' but the growth of the array is exponential. Whenever a new+-- allocation is required the previous array size is at least doubled.+--+-- This is useful to reduce allocations when folding many arrays together.+--+-- Note that the returned array may be a mutated version of first array.+--+-- >>> spliceExp = MutArray.spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))+--+-- /Pre-release/+{-# INLINE spliceExp #-}+spliceExp :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)+spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))++-------------------------------------------------------------------------------+-- Splitting+-------------------------------------------------------------------------------++-- | Generate a stream of array slices using a predicate. The array element+-- matching the predicate is dropped.+--+-- /Pre-release/+{-# INLINE splitOn #-}+splitOn :: (MonadIO m, Unbox a) =>+    (a -> Bool) -> MutArray a -> Stream m (MutArray a)+splitOn predicate arr =+    fmap (\(i, len) -> getSliceUnsafe i len arr)+        $ D.indexOnSuffix predicate (read arr)++-- | Drops the separator byte+{-# INLINE breakOn #-}+breakOn :: MonadIO m+    => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))+breakOn sep arr@MutArray{..} = unsafeAsPtr arr $ \p -> liftIO $ do+    -- XXX We do not need memchr here, we can use a Haskell equivalent.+    -- Need efficient stream based primitives that work on Word64.+    loc <- c_memchr p sep (fromIntegral $ byteLength arr)+    let sepIndex = loc `minusPtr` p+    return $+        if loc == nullPtr+        then (arr, Nothing)+        else+            ( MutArray+                { arrContents = arrContents+                , arrStart = arrStart+                , arrEnd = arrStart + sepIndex -- exclude the separator+                , arrBound = arrStart + sepIndex+                }+            , Just $ MutArray+                    { arrContents = arrContents+                    , arrStart = arrStart + (sepIndex + 1)+                    , arrEnd = arrEnd+                    , arrBound = arrBound+                    }+            )++-- | Like 'splitAt' but does not check whether the index is valid.+--+{-# INLINE unsafeSplitAt #-}+unsafeSplitAt :: forall a. Unbox a =>+    Int -> MutArray a -> (MutArray a, MutArray a)+unsafeSplitAt i MutArray{..} =+    let off = i * SIZE_OF(a)+        p = arrStart + off+     in ( MutArray+         { arrContents = arrContents+         , arrStart = arrStart+         , arrEnd = p+         , arrBound = p+         }+        , MutArray+          { arrContents = arrContents+          , arrStart = p+          , arrEnd = arrEnd+          , arrBound = arrBound+          }+        )++-- | Create two slices of an array without copying the original array. The+-- specified index @i@ is the first index of the second slice.+--+{-# INLINE splitAt #-}+splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)+splitAt i arr =+    let maxIndex = length arr - 1+    in  if i < 0+        then error "sliceAt: negative array index"+        else if i > maxIndex+             then error $ "sliceAt: specified array index " ++ show i+                        ++ " is beyond the maximum index " ++ show maxIndex+             else unsafeSplitAt i arr++-------------------------------------------------------------------------------+-- Casting+-------------------------------------------------------------------------------++-- | Cast an array having elements of type @a@ into an array having elements of+-- type @b@. The array size must be a multiple of the size of type @b@+-- otherwise accessing the last element of the array may result into a crash or+-- a random value.+--+-- /Pre-release/+--+castUnsafe ::+#ifdef DEVBUILD+    Unbox b =>+#endif+    MutArray a -> MutArray b+castUnsafe (MutArray contents start end bound) =+    MutArray contents start end bound++-- | Cast an @MutArray a@ into an @MutArray Word8@.+--+asBytes :: MutArray a -> MutArray Word8+asBytes = castUnsafe++-- | Cast an array having elements of type @a@ into an array having elements of+-- type @b@. The length of the array should be a multiple of the size of the+-- target element otherwise 'Nothing' is returned.+--+cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)+cast arr =+    let len = byteLength arr+        r = len `mod` SIZE_OF(b)+     in if r /= 0+        then Nothing+        else Just $ castUnsafe arr++-- XXX We can provide another API for "unsafe" FFI calls passing an unlifted+-- pointer to the FFI call. For unsafe calls we do not need to pin the array.+-- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in+-- before the pointer is wrapped.+--+-- From the GHC manual:+--+-- GHC, since version 8.4, guarantees that garbage collection will never occur+-- during an unsafe call, even in the bytecode interpreter, and further+-- guarantees that unsafe calls will be performed in the calling thread. Making+-- it safe to pass heap-allocated objects to unsafe functions.++-- XXX Should we just name it asPtr, the unsafety is implicit for any pointer+-- operations. And we are safe from Haskell perspective because we will be+-- pinning the memory.+--+-- XXX we cannot pass the length of the ptr here as in some cases it may not be+-- available e.g. a null terminated C string. However, we can create another+-- flavor of the API e.g. asPtrN.++-- | Use a @MutArray a@ as @Ptr a@. This is useful when we want to pass an+-- array as a pointer to some operating system call or to a "safe" FFI call.+--+-- If the array is not pinned it is copied to pinned memory before passing it+-- to the monadic action.+--+-- /Performance Notes:/ Forces a copy if the array is not pinned. It is advised+-- that the programmer keeps this in mind and creates a pinned array+-- opportunistically before this operation occurs, to avoid the cost of a copy+-- if possible.+--+-- /Unsafe/ because of direct pointer operations. The user must ensure that+-- they are writing within the legal bounds of the array.+--+-- /Pre-release/+--+{-# INLINE unsafePinnedAsPtr #-}+unsafePinnedAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+unsafePinnedAsPtr arr f =+    Unboxed.unsafePinnedAsPtr+        (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))++{-# DEPRECATED asPtrUnsafe "Please use unsafePinnedAsPtr instead." #-}+{-# INLINE asPtrUnsafe #-}+asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+asPtrUnsafe = unsafePinnedAsPtr++{-# INLINE unsafeAsPtr #-}+unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+unsafeAsPtr arr f =+    Unboxed.unsafeAsPtr+        (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))++-------------------------------------------------------------------------------+-- Equality+-------------------------------------------------------------------------------++-- | Byte compare two arrays. Compare the length of the arrays. If the length+-- is equal, compare the lexicographical ordering of two underlying byte arrays+-- otherwise return the result of length comparison.+--+-- /Unsafe/: Note that the 'Unbox' instance of sum types with constructors of+-- different sizes may leave some memory uninitialized which can make byte+-- comparison unreliable.+--+-- /Pre-release/+{-# INLINE byteCmp #-}+byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+byteCmp arr1 arr2 = do+    let marr1 = getMutableByteArray# (arrContents arr1)+        marr2 = getMutableByteArray# (arrContents arr2)+        !(I# st1#) = arrStart arr1+        !(I# st2#) = arrStart arr2+        !(I# len#) = byteLength arr1+    case compare (byteLength arr1) (byteLength arr2) of+        EQ -> do+            r <- liftIO $ IO $ \s# ->+                     let res =+                             I#+                                 (compareByteArrays#+                                      (unsafeCoerce# marr1)+                                      st1#+                                      (unsafeCoerce# marr2)+                                      st2#+                                      len#)+                      in (# s#, res #)+            return $ compare r 0+        x -> return x++{-# INLINE cmp #-}+{-# DEPRECATED cmp "Please use byteCmp instead." #-}+cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+cmp = byteCmp++-- | Byte equality of two arrays.+--+-- >>> byteEq arr1 arr2 = (==) EQ $ MArray.byteCmp arr1 arr2+--+-- /Unsafe/: See 'byteCmp'.+{-# INLINE byteEq #-}+byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool+byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2++-------------------------------------------------------------------------------+-- Compact+-------------------------------------------------------------------------------++-- Note: LE versions avoid an extra copy compared to GE. LE parser trades+-- backtracking one array in lieu of avoiding a copy. However, LE and GE both+-- can leave some memory unused. They can split the last array to fit it+-- exactly in the space.++{-# INLINE_NORMAL pCompactLeAs #-}+pCompactLeAs ::+       forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Parser (MutArray a) m (MutArray a)+pCompactLeAs ps maxElems = Parser step initial extract++    where++    maxBytes = maxElems * SIZE_OF(a)++    functionName = "Streamly.Internal.Data.MutArray.pCompactLE"++    initial =+        return+            $ if maxElems <= 0+              then error+                       $ functionName+                       ++ ": the size of arrays ["+                       ++ show maxElems ++ "] must be a natural number"+              else Parser.IPartial Nothing++    step Nothing arr =+        return+            $ let len = byteLength arr+               in if len >= maxBytes+                  then Parser.Done 0 arr+                  else Parser.Partial 0 (Just arr)+    -- XXX Split the last array to use the space more compactly.+    step (Just buf) arr =+        let len = byteLength buf + byteLength arr+         in if len > maxBytes+            then return $ Parser.Done 1 buf+            else do+                buf1 <-+                    if byteCapacity buf < maxBytes+                    then liftIO $ reallocExplicitAs+                            ps (SIZE_OF(a)) maxBytes buf+                    else return buf+                buf2 <- spliceUnsafe buf1 arr+                return $ Parser.Partial 0 (Just buf2)++    extract Nothing = return $ Parser.Done 0 nil+    extract (Just buf) = return $ Parser.Done 0 buf++-- | Parser @pCompactLE maxElems@ coalesces adjacent arrays in the input stream+-- only if the combined size would be less than or equal to @maxElems@+-- elements. Note that it won't split an array if the original array is already+-- larger than maxElems.+--+-- @maxElems@ must be greater than 0.+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+--+-- /Internal/+{-# INLINE pCompactLE #-}+pCompactLE ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> Parser (MutArray a) m (MutArray a)+pCompactLE = pCompactLeAs Unpinned++-- | Pinned version of 'pCompactLE'.+{-# INLINE pPinnedCompactLE #-}+pPinnedCompactLE ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> Parser (MutArray a) m (MutArray a)+pPinnedCompactLE = pCompactLeAs Pinned++data SpliceState s arr+    = SpliceInitial s+    | SpliceBuffering s arr+    | SpliceYielding arr (SpliceState s arr)+    | SpliceFinish++-- This mutates the first array (if it has space) to append values from the+-- second one. This would work for immutable arrays as well because an+-- immutable array never has additional space so a new array is allocated+-- instead of mutating it.++{-# INLINE_NORMAL compactLeAs #-}+compactLeAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)+compactLeAs ps maxElems (D.Stream step state) =+    D.Stream step' (SpliceInitial state)++    where++    maxBytes = maxElems * SIZE_OF(a)++    functionName = "Streamly.Internal.Data.MutArray.rCompactLE"++    {-# INLINE_LATE step' #-}+    step' gst (SpliceInitial st) = do+        when (maxElems <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ functionName ++ ": the size of arrays [" ++ show maxElems+                ++ "] must be a natural number"+        r <- step gst st+        case r of+            D.Yield arr s -> return $+                let len = byteLength arr+                 in if len >= maxBytes+                    then D.Skip (SpliceYielding arr (SpliceInitial s))+                    else D.Skip (SpliceBuffering s arr)+            D.Skip s -> return $ D.Skip (SpliceInitial s)+            D.Stop -> return D.Stop++    -- XXX Split the last array to use the space more compactly.+    step' gst (SpliceBuffering st buf) = do+        r <- step gst st+        case r of+            D.Yield arr s -> do+                let len = byteLength buf + byteLength arr+                if len > maxBytes+                then return $+                    D.Skip (SpliceYielding buf (SpliceBuffering s arr))+                else do+                    buf1 <- if byteCapacity buf < maxBytes+                            then liftIO $ reallocExplicitAs+                                    ps (SIZE_OF(a)) maxBytes buf+                            else return buf+                    buf2 <- spliceUnsafe buf1 arr+                    return $ D.Skip (SpliceBuffering s buf2)+            D.Skip s -> return $ D.Skip (SpliceBuffering s buf)+            D.Stop -> return $ D.Skip (SpliceYielding buf SpliceFinish)++    step' _ SpliceFinish = return D.Stop++    step' _ (SpliceYielding arr next) = return $ D.Yield arr next+++{-# INLINE_NORMAL fCompactGeAs #-}+fCompactGeAs ::+       forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> FL.Fold m (MutArray a) (MutArray a)+fCompactGeAs ps minElems = Fold step initial extract extract++    where++    minBytes = minElems * SIZE_OF(a)++    functionName = "Streamly.Internal.Data.MutArray.fCompactGE"++    initial =+        return+            $ if minElems < 0+              then error+                       $ functionName+                       ++ ": the size of arrays ["+                       ++ show minElems ++ "] must be a natural number"+              else FL.Partial Nothing++    step Nothing arr =+        return+            $ let len = byteLength arr+               in if len >= minBytes+                  then FL.Done arr+                  else FL.Partial (Just arr)+    -- XXX Buffer arrays as a list to avoid copy and reallocations+    step (Just buf) arr = do+        let len = byteLength buf + byteLength arr+        buf1 <-+            if byteCapacity buf < len+            then liftIO $ reallocExplicitAs+                    ps (SIZE_OF(a)) (max minBytes len) buf+            else return buf+        buf2 <- spliceUnsafe buf1 arr+        if len >= minBytes+        then return $ FL.Done buf2+        else return $ FL.Partial (Just buf2)++    extract Nothing = return nil+    extract (Just buf) = return buf++-- | Fold @fCompactGE minElems@ coalesces adjacent arrays in the input stream+-- until the size becomes greater than or equal to @minElems@.+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# INLINE fCompactGE #-}+fCompactGE ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> FL.Fold m (MutArray a) (MutArray a)+fCompactGE = fCompactGeAs Unpinned++-- | Pinned version of 'fCompactGE'.+{-# INLINE fPinnedCompactGE #-}+fPinnedCompactGE ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> FL.Fold m (MutArray a) (MutArray a)+fPinnedCompactGE = fCompactGeAs Pinned++{-# INLINE_NORMAL lCompactGeAs #-}+lCompactGeAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+-- The fold version turns out to be a little bit slower.+-- lCompactGeAs ps n = FL.many (fCompactGeAs ps n)+lCompactGeAs ps minElems (Fold step1 initial1 _ final1) =+    Fold step initial extract final++    where++    minBytes = minElems * SIZE_OF(a)++    functionName = "Streamly.Internal.Data.MutArray.lCompactGE"++    initial = do+        when (minElems <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ functionName ++ ": the size of arrays ["+                ++ show minElems ++ "] must be a natural number"++        r <- initial1+        return $ first (Tuple' Nothing) r++    {-# INLINE runInner #-}+    runInner len acc buf =+            if len >= minBytes+            then do+                r <- step1 acc buf+                case r of+                    FL.Done _ -> return $ FL.Done ()+                    FL.Partial s -> do+                        _ <- final1 s+                        res <- initial1+                        return $ first (Tuple' Nothing) res+            else return $ FL.Partial $ Tuple' (Just buf) acc++    step (Tuple' Nothing r1) arr =+         runInner (byteLength arr) r1 arr++    -- XXX Buffer arrays as a list to avoid copy and reallocations+    step (Tuple' (Just buf) r1) arr = do+        let len = byteLength buf + byteLength arr+        buf1 <- if byteCapacity buf < len+                then liftIO $ reallocExplicitAs+                        ps (SIZE_OF(a)) (max minBytes len) buf+                else return buf+        buf2 <- spliceUnsafe buf1 arr+        runInner len r1 buf2++    -- XXX Several folds do extract >=> final, therefore, we need to make final+    -- return "m b" rather than using extract post it if we want extract to be+    -- partial.+    --+    -- extract forces the pending buffer to be sent to the fold which is not+    -- what we want.+    extract _ = error "lCompactGE: not designed for scanning"++    final (Tuple' Nothing r1) = final1 r1+    final (Tuple' (Just buf) r1) = do+        r <- step1 r1 buf+        case r of+            FL.Partial rr -> final1 rr+            FL.Done _ -> return ()++-- | Like 'compactGE' but for transforming folds instead of stream.+--+-- >>> lCompactGE n = Fold.many (MutArray.fCompactGE n)+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# INLINE lCompactGE #-}+lCompactGE :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+lCompactGE = lCompactGeAs Unpinned++-- | Pinned version of 'lCompactGE'.+{-# INLINE lPinnedCompactGE #-}+lPinnedCompactGE :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+lPinnedCompactGE = lCompactGeAs Pinned++-- | @compactGE n stream@ coalesces adjacent arrays in the @stream@ until+-- the size becomes greater than or equal to @n@.+--+-- >>> compactGE n = Stream.foldMany (MutArray.fCompactGE n)+--+{-# INLINE compactGE #-}+compactGE ::+       (MonadIO m, Unbox a)+    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compactGE n = D.foldMany (fCompactGE n)++-- | 'compactEQ n' coalesces adajacent arrays in the input stream to+-- arrays of exact size @n@.+--+-- /Unimplemented/+{-# INLINE compactEQ #-}+compactEQ :: -- (MonadIO m, Unbox a) =>+    Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compactEQ _n = undefined -- D.parseManyD (pCompactEQ n)++-------------------------------------------------------------------------------+-- In-place mutation algorithms -------------------------------------------------------------------------------  -- | Strip elements which match with predicate from both ends.
src/Streamly/Internal/Data/MutByteArray/Type.hs view
@@ -13,7 +13,7 @@     -- ** MutByteArray       MutByteArray(..)     , MutableByteArray-    , getMutableByteArray#+    , getMutableByteArray# -- XXX getMutByteArray#      -- ** Pinning     , PinnedState(..)@@ -22,19 +22,24 @@     , unpin      -- ** Allocation-    , nil-    , newBytesAs+    , empty+    , newBytesAs -- XXX should be removed     , new     , pinnedNew-    , pinnedNewAlignedBytes+    , pinnedNewAlignedBytes -- XXX should be removed      -- ** Access-    , sizeOfMutableByteArray+    , sizeOfMutableByteArray -- XXX length     , putSliceUnsafe     , cloneSliceUnsafeAs     , cloneSliceUnsafe     , pinnedCloneSliceUnsafe+    , unsafePinnedAsPtr+    , unsafeAsPtr++    -- ** Deprecated     , asPtrUnsafe+    , nil     ) where  import Control.Monad.IO.Class (MonadIO(..))@@ -53,7 +58,7 @@  data PinnedState     = Pinned-    | Unpinned+    | Unpinned deriving (Show, Eq)  -- XXX can use UnliftedNewtypes @@ -82,6 +87,9 @@ touch (MutByteArray contents) =     IO $ \s -> case touch# contents s of s' -> (# s', () #) +-- XXX Some functions in this module are "IO" and others are "m", we need to+-- make it consistent.+ -- XXX We can provide another API for "unsafe" FFI calls passing an unlifted -- pointer to the FFI call. For unsafe calls we do not need to pin the array. -- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in@@ -110,9 +118,9 @@ -- -- /Pre-release/ ---{-# INLINE asPtrUnsafe #-}-asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b-asPtrUnsafe arr f = do+{-# INLINE unsafePinnedAsPtr #-}+unsafePinnedAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+unsafePinnedAsPtr arr f = do   contents <- liftIO $ pin arr   let !ptr = Ptr (byteArrayContents#                      (unsafeCoerce# (getMutableByteArray# contents)))@@ -120,14 +128,35 @@   liftIO $ touch contents   return r +{-# DEPRECATED asPtrUnsafe "Please use unsafePinnedAsPtr instead." #-}+{-# INLINE asPtrUnsafe #-}+asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+asPtrUnsafe = unsafePinnedAsPtr++-- | For use with unsafe FFI functions. Does not force pin the array memory.+{-# INLINE unsafeAsPtr #-}+unsafeAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+unsafeAsPtr arr f = do+  let !ptr = Ptr (byteArrayContents#+                     (unsafeCoerce# (getMutableByteArray# arr)))+  r <- f ptr+  liftIO $ touch arr+  return r+ -------------------------------------------------------------------------------- -- Creation -------------------------------------------------------------------------------- -{-# NOINLINE nil #-}+{-# NOINLINE empty #-}+empty :: MutByteArray+empty = unsafePerformIO $ new 0++{-# DEPRECATED nil "Please use empty instead" #-} nil :: MutByteArray-nil = unsafePerformIO $ new 0+nil = empty +-- XXX add "newRounded" to round up the large size to the next page boundary+-- and return the allocated size. {-# INLINE new #-} new :: Int -> IO MutByteArray new nbytes | nbytes < 0 =@@ -141,7 +170,7 @@ {-# INLINE pinnedNew #-} pinnedNew :: Int -> IO MutByteArray pinnedNew nbytes | nbytes < 0 =-  errorWithoutStackTrace "pinnedNewByteArray: size must be >= 0"+  errorWithoutStackTrace "pinnedNew: size must be >= 0" pinnedNew (I# nbytes) = IO $ \s ->     case newPinnedByteArray# nbytes s of         (# s', mbarr# #) ->
src/Streamly/Internal/Data/Stream/Generate.hs view
@@ -154,6 +154,8 @@ nil :: Applicative m => Stream m a nil = Stream (\_ _ -> pure Stop) () +infixr 5 `cons`+ -- XXX implement in terms of consM? -- cons x = consM (return x) -- From an implementation perspective, StreamK.cons translates into a
src/Streamly/Internal/Data/Stream/Nesting.hs view
@@ -149,7 +149,6 @@     , wordsBy     , splitOnSeq     , splitOnSuffixSeq-    , sliceOnSuffix      -- XXX Implement these as folds or parsers instead.     , splitOnSuffixSeqAny@@ -182,12 +181,9 @@ import GHC.Types (SPEC(..))  import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Fold.Step (Step(..)) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.Refold.Type (Refold(..)) import Streamly.Internal.Data.SVar.Type (adaptState)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) import Streamly.Internal.Data.Unbox (Unbox, sizeOf) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) @@ -1294,77 +1290,6 @@     stepOuter _ (FIterYield a next) = return $ Yield a next     stepOuter _ FIterStop = return Stop -{-# ANN type CIterState Fuse #-}-data CIterState s f fs b-    = CIterInit s f-    | CIterConsume s fs-    | CIterYield b (CIterState s f fs b)-    | CIterStop---- | Like 'foldIterateM' but using the 'Refold' type instead. This could be--- much more efficient due to stream fusion.------ /Internal/-{-# INLINE_NORMAL refoldIterateM #-}-refoldIterateM ::-       Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b-refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =-    Stream stepOuter (CIterInit state initial)--    where--    {-# INLINE iterStep #-}-    iterStep st action = do-        res <- action-        return-            $ Skip-            $ case res of-                  FL.Partial fs -> CIterConsume st fs-                  FL.Done fb -> CIterYield fb $ CIterInit st (return fb)--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (CIterInit st action) = do-        iterStep st (action >>= finject)-    stepOuter gst (CIterConsume st fs) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> iterStep s (fstep fs x)-            Skip s -> return $ Skip $ CIterConsume s fs-            Stop -> do-                b <- fextract fs-                return $ Skip $ CIterYield b CIterStop-    stepOuter _ (CIterYield a next) = return $ Yield a next-    stepOuter _ CIterStop = return Stop---- "n" elements at the end are dropped by the fold.-{-# INLINE sliceBy #-}-sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)-sliceBy (Fold step1 initial1 extract1 _final) n = Refold step inject extract--    where--    inject (i, len) = do-        r <- initial1-        return $ case r of-            Partial s -> Partial $ Tuple' (i + len + n) s-            Done l -> Done (i, l)--    step (Tuple' i s) x = do-        r <- step1 s x-        return $ case r of-            Partial s1 -> Partial $ Tuple' i s1-            Done len -> Done (i, len)--    extract (Tuple' i s) = (i,) <$> extract1 s--{-# INLINE sliceOnSuffix #-}-sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)-sliceOnSuffix predicate =-    -- Scan the stream with the given refold-    refoldIterateM-        (sliceBy (FL.takeEndBy_ predicate FL.length) 1)-        (return (-1, 0))- ------------------------------------------------------------------------------ -- Parsing ------------------------------------------------------------------------------@@ -3065,12 +2990,13 @@ -- | Performs infix separator style splitting. {-# INLINE_NORMAL splitInnerBySuffix #-} splitInnerBySuffix-    :: (Monad m, Eq (f a), Monoid (f a))-    => (f a -> m (f a, Maybe (f a)))  -- splitter+    :: Monad m+    => (f a -> Bool)                  -- isEmpty?+    -> (f a -> m (f a, Maybe (f a)))  -- splitter     -> (f a -> f a -> m (f a))        -- joiner     -> Stream m (f a)     -> Stream m (f a)-splitInnerBySuffix splitter joiner (Stream step1 state1) =+splitInnerBySuffix isEmpty splitter joiner (Stream step1 state1) =     Stream step (SplitInitial state1)      where@@ -3097,10 +3023,11 @@                     Nothing -> Skip (SplitBuffering s buf')                     Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))             Skip s -> return $ Skip (SplitBuffering s buf)-            Stop -> return $-                if buf == mempty-                then Stop-                else Skip (SplitYielding buf SplitFinishing)+            Stop ->+                return $+                    if isEmpty buf+                    then Stop+                    else Skip (SplitYielding buf SplitFinishing)      step _ (SplitSplitting st buf) = do         (x1, mx2) <- splitter buf
src/Streamly/Internal/Data/Stream/Transform.hs view
@@ -1537,7 +1537,7 @@ {-# INLINE reverseUnbox #-} reverseUnbox :: (MonadIO m, Unbox a) => Stream m a -> Stream m a reverseUnbox =-    A.flattenArraysRev -- unfoldMany A.readRev+    A.concatRev -- unfoldMany A.readerRev         . fromStreamK         . K.reverse         . toStreamK
src/Streamly/Internal/Data/Stream/Type.hs view
@@ -123,14 +123,21 @@     , foldManyPost     , groupsOf     , refoldMany+    , refoldIterateM      -- * Fold Iterate     , reduceIterateBfs     , foldIterateBfs +    -- * Splitting+    , indexOnSuffix+     -- * Multi-stream folds     , eqBy     , cmpBy++    -- * Deprecated+    , sliceOnSuffix     ) where @@ -162,6 +169,7 @@ import Streamly.Internal.Data.Refold.Type (Refold(..)) import Streamly.Internal.Data.Stream.Step (Step (..)) import Streamly.Internal.Data.SVar.Type (State, adaptState, defState)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..))  import qualified Streamly.Internal.Data.Fold.Type as FL hiding (foldr)@@ -212,6 +220,9 @@ nilM :: Applicative m => m b -> Stream m a nilM m = Stream (\_ _ -> m $> Stop) () ++infixr 5 `consM`+ -- | Like 'cons' but fuses an effect instead of a pure value. {-# INLINE_NORMAL consM #-} consM :: Applicative m => m a -> Stream m a -> Stream m a@@ -1970,6 +1981,90 @@                 return $ Skip (FoldManyYield b FoldManyDone)     step' _ (FoldManyYield b next) = return $ Yield b next     step' _ FoldManyDone = return Stop++{-# ANN type CIterState Fuse #-}+data CIterState s f fs b+    = CIterInit s f+    | CIterConsume s fs+    | CIterYield b (CIterState s f fs b)+    | CIterStop++-- | Like 'foldIterateM' but using the 'Refold' type instead. This could be+-- much more efficient due to stream fusion.+--+-- /Internal/+{-# INLINE_NORMAL refoldIterateM #-}+refoldIterateM ::+       Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b+refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =+    Stream stepOuter (CIterInit state initial)++    where++    {-# INLINE iterStep #-}+    iterStep st action = do+        res <- action+        return+            $ Skip+            $ case res of+                  FL.Partial fs -> CIterConsume st fs+                  FL.Done fb -> CIterYield fb $ CIterInit st (return fb)++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ (CIterInit st action) = do+        iterStep st (action >>= finject)+    stepOuter gst (CIterConsume st fs) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> iterStep s (fstep fs x)+            Skip s -> return $ Skip $ CIterConsume s fs+            Stop -> do+                b <- fextract fs+                return $ Skip $ CIterYield b CIterStop+    stepOuter _ (CIterYield a next) = return $ Yield a next+    stepOuter _ CIterStop = return Stop++-- | The refold @indexerBy f n@ takes an (index, len) tuple as initial input,+-- and returns @(index + len + n, b)@ as output where @b@ is the output of the+-- fold.+{-# INLINE indexerBy #-}+indexerBy :: Monad m =>+    Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)+indexerBy (Fold step1 initial1 extract1 _final) n =+    Refold step inject extract++    where++    inject (i, len) = do+        r <- initial1+        return $ case r of+            FL.Partial s -> FL.Partial $ Tuple' (i + len + n) s+            FL.Done l -> FL.Done (i, l)++    step (Tuple' i s) x = do+        r <- step1 s x+        return $ case r of+            FL.Partial s1 -> FL.Partial $ Tuple' i s1+            FL.Done len -> FL.Done (i, len)++    extract (Tuple' i s) = (i,) <$> extract1 s++-- | Like 'splitOnSuffix' but generates a stream of (index, len) tuples marking+-- the places where the predicate matches in the stream.+--+-- /Pre-release/+{-# INLINE indexOnSuffix #-}+indexOnSuffix :: Monad m =>+    (a -> Bool) -> Stream m a -> Stream m (Int, Int)+indexOnSuffix predicate =+    -- Scan the stream with the given refold+    refoldIterateM+        (indexerBy (FL.takeEndBy_ predicate FL.length) 1)+        (return (-1, 0))++{-# DEPRECATED sliceOnSuffix "Please use indexOnSuffix instead." #-}+sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+sliceOnSuffix = indexOnSuffix  ------------------------------------------------------------------------------ -- Stream with a cross product style monad instance
src/Streamly/Internal/Data/StreamK.hs view
@@ -37,8 +37,6 @@     -- * Elimination     -- ** General Folds     , foldr1-    , foldlM'-    , foldlMx'     , fold     , foldBreak     , foldEither@@ -306,19 +304,6 @@             yieldk a r = fmap (step p) (go a r)          in foldStream defState yieldk single stp m1 --- XXX replace the recursive "go" with explicit continuations.--- | Like 'foldx', but with a monadic step function.-{-# INLINABLE foldlMx' #-}-foldlMx' :: Monad m-    => (x -> a -> m x) -> m x -> (x -> m b) -> StreamK m a -> m b-foldlMx' step begin done = go begin-    where-    go !acc m1 =-        let stop = acc >>= done-            single a = acc >>= \b -> step b a >>= done-            yieldk a r = acc >>= \b -> step b a >>= \x -> go (return x) r-         in foldStream defState yieldk single stop m1- -- | Fold a stream using the supplied left 'Fold' and reducing the resulting -- expression strictly at each step. The behavior is similar to 'foldl''. A -- 'Fold' can terminate early without consuming the full stream. See the@@ -469,11 +454,6 @@                     FL.Partial fs1 -> go1 SPEC fs1 s             Stream.Skip s -> go1 SPEC fs s             Stream.Stop -> return $ Left fs---- | Like 'foldl'' but with a monadic step function.-{-# INLINE foldlM' #-}-foldlM' :: Monad m => (b -> a -> m b) -> m b -> StreamK m a -> m b-foldlM' step begin = foldlMx' step begin return  ------------------------------------------------------------------------------ -- Specialized folds
src/Streamly/Internal/Data/StreamK/Type.hs view
@@ -84,6 +84,8 @@     -- ** Strict Left Folds     , Streamly.Internal.Data.StreamK.Type.foldl'     , foldlx'+    , foldlMx'+    , foldlM'      -- ** Lazy Right Folds     , Streamly.Internal.Data.StreamK.Type.foldr@@ -816,6 +818,24 @@ {-# INLINE foldl' #-} foldl' :: Monad m => (b -> a -> b) -> b -> StreamK m a -> m b foldl' step begin = foldlx' step begin id++-- XXX replace the recursive "go" with explicit continuations.+-- | Like 'foldx', but with a monadic step function.+{-# INLINABLE foldlMx' #-}+foldlMx' :: Monad m+    => (x -> a -> m x) -> m x -> (x -> m b) -> StreamK m a -> m b+foldlMx' step begin done = go begin+    where+    go !acc m1 =+        let stop = acc >>= done+            single a = acc >>= \b -> step b a >>= done+            yieldk a r = acc >>= \b -> step b a >>= \x -> go (return x) r+         in foldStream defState yieldk single stop m1++-- | Like 'foldl'' but with a monadic step function.+{-# INLINE foldlM' #-}+foldlM' :: Monad m => (b -> a -> m b) -> m b -> StreamK m a -> m b+foldlM' step begin = foldlMx' step begin return  ------------------------------------------------------------------------------ -- Specialized folds
src/Streamly/Internal/FileSystem/File.hs view
@@ -103,15 +103,14 @@ import qualified System.IO as SIO  import Streamly.Data.Fold (groupsOf, drain)-import Streamly.Internal.Data.Array.Type (Array(..), pinnedWriteNUnsafe)+import Streamly.Internal.Data.Array.Type (Array(..)) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Data.Stream (Stream)-import Streamly.Internal.Data.Unbox (Unbox) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) import Streamly.Internal.System.IO (defaultChunkSize) -import qualified Streamly.Data.Array as A+import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Data.Stream as S import qualified Streamly.Data.Unfold as UF import qualified Streamly.Internal.Data.Array.Type as IA (pinnedChunksOf)@@ -339,10 +338,6 @@ reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath Word8 reader = UF.many A.reader (usingFile FH.chunkReader) -{-# INLINE concatChunks #-}-concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a-concatChunks = S.unfoldMany A.reader- -- | Generate a stream of bytes from a file specified by path. The stream ends -- when EOF is encountered. File is locked using multiple reader and single -- writer locking mode.@@ -351,7 +346,7 @@ -- {-# INLINE read #-} read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8-read file = concatChunks $ withFile file ReadMode FH.readChunks+read file = A.concat $ withFile file ReadMode FH.readChunks  {-# DEPRECATED toBytes "Please use 'read' instead"  #-} {-# INLINE toBytes #-}@@ -467,7 +462,7 @@ writeWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Fold m Word8 () writeWith n path =-    groupsOf n (pinnedWriteNUnsafe n) (writeChunks path)+    groupsOf n (A.unsafePinnedCreateOf n) (writeChunks path)  {-# DEPRECATED writeWithBufferOf "Please use 'writeWith' instead"  #-} {-# INLINE writeWithBufferOf #-}
src/Streamly/Internal/FileSystem/Handle.hs view
@@ -40,8 +40,8 @@      -- * Streams     , read-    , readWith-    , readChunksWith+    , readWith       -- readConcatChunksOf+    , readChunksWith -- readChunksOf     , readChunks      -- * Unfolds@@ -59,10 +59,10 @@     -- , writeUtf8ByLines     -- , writeByFrames     -- , writeLines-    , writeWith+    , writeWith -- writeChunksOf     , writeChunks-    , writeChunksWith-    , writeMaybesWith+    , writeChunksWith -- writeCompactChunksOf+    , writeMaybesWith -- writeCompactJustsOf      -- * Refolds     , writer@@ -131,16 +131,13 @@ import Streamly.Internal.Data.Refold.Type (Refold(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.Data.Array.Type-       (Array(..), pinnedWriteNUnsafe, unsafeFreezeWithShrink, byteLength)+       (Array(..), unsafeFreezeWithShrink, byteLength) import Streamly.Internal.Data.Stream.Type (Stream)-import Streamly.Internal.Data.Array.Stream (lpackArraysChunksOf) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) import Streamly.Internal.System.IO (defaultChunkSize)  import qualified Streamly.Data.Fold as FL-import qualified Streamly.Data.Array as A-import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Array.Stream as AS+import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.MutArray.Type as MArray import qualified Streamly.Internal.Data.Refold.Type as Refold import qualified Streamly.Internal.Data.Fold.Type as FL(refoldMany)@@ -169,6 +166,8 @@ -- Array IO (Input) ------------------------------------------------------------------------------- +-- XXX add an API that compacts the arrays to an exact size.+ -- | Read a 'ByteArray' consisting of one or more bytes from a file handle. If -- no data is available on the handle it blocks until at least one byte becomes -- available. If any data is available then it immediately returns that data@@ -178,9 +177,9 @@ {-# INLINABLE getChunk #-} getChunk :: MonadIO m => Int -> Handle -> m (Array Word8) getChunk size h = liftIO $ do-    arr <- MArray.pinnedNewBytes size+    arr :: MArray.MutArray Word8 <- MArray.pinnedEmptyOf size     -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))-    MArray.asPtrUnsafe arr $ \p -> do+    MArray.unsafePinnedAsPtr arr $ \p -> do         n <- hGetBufSome h p size         -- XXX shrink only if the diff is significant         return $@@ -338,10 +337,6 @@ readWithBufferOf :: MonadIO m => Unfold m (Int, Handle) Word8 readWithBufferOf = readerWith -{-# INLINE concatChunks #-}-concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a-concatChunks = S.unfoldMany A.reader- -- | @readWith bufsize handle@ reads a byte stream from a file -- handle, reads are performed in chunks of up to @bufsize@. --@@ -350,7 +345,7 @@ -- /Pre-release/ {-# INLINE readWith #-} readWith :: MonadIO m => Int -> Handle -> Stream m Word8-readWith size h = concatChunks $ readChunksWith size h+readWith size h = A.concat $ readChunksWith size h  -- | Unfolds a file handle into a byte stream. IO requests to the device are -- performed in sizes of@@ -369,7 +364,7 @@ -- /Pre-release/ {-# INLINE read #-} read :: MonadIO m => Handle -> Stream m Word8-read = concatChunks . readChunks+read = A.concat . readChunks  ------------------------------------------------------------------------------- -- Writing@@ -384,12 +379,12 @@ {-# INLINABLE putChunk #-} putChunk :: MonadIO m => Handle -> Array a -> m () putChunk _ arr | byteLength arr == 0 = return ()-putChunk h arr = A.asPtrUnsafe arr $ \ptr ->+putChunk h arr = A.unsafePinnedAsPtr arr $ \ptr ->     liftIO $ hPutBuf h ptr aLen      where -    -- XXX We should have the length passed by asPtrUnsafe itself.+    -- XXX We should have the length passed by unsafePinnedAsPtr itself.     aLen = A.byteLength arr  -------------------------------------------------------------------------------@@ -421,7 +416,7 @@ {-# INLINE putChunksWith #-} putChunksWith :: (MonadIO m, Unbox a)     => Int -> Handle -> Stream m (Array a) -> m ()-putChunksWith n h xs = putChunks h $ AS.compact n xs+putChunksWith n h xs = putChunks h $ A.compactLE n xs  -- > putBytesWith n h m = Handle.putChunks h $ A.pinnedChunksOf n m @@ -461,8 +456,6 @@ chunkWriter :: MonadIO m => Refold m Handle (Array a) () chunkWriter = Refold.drainBy putChunk --- XXX lpackArraysChunksOf should be written idiomatically- -- | @writeChunksWith bufsize handle@ writes a stream of arrays -- to @handle@ after coalescing the adjacent arrays in chunks of @bufsize@. -- We never split an array, if a single array is bigger than the specified size@@ -472,7 +465,7 @@ {-# INLINE writeChunksWith #-} writeChunksWith :: (MonadIO m, Unbox a)     => Int -> Handle -> Fold m (Array a) ()-writeChunksWith n h = lpackArraysChunksOf n (writeChunks h)+writeChunksWith n h = A.lCompactGE n (writeChunks h)  -- | Same as 'writeChunksWith' --@@ -496,11 +489,11 @@ -- Bytes in the input stream are collected into a buffer until we have a chunk -- of @reqSize@ and then written to the IO device. ----- >>> writeWith n h = Fold.groupsOf n (Array.writeNUnsafe n) (Handle.writeChunks h)+-- >>> writeWith n h = Fold.groupsOf n (Array.unsafeCreateOf n) (Handle.writeChunks h) -- {-# INLINE writeWith #-} writeWith :: MonadIO m => Int -> Handle -> Fold m Word8 ()-writeWith n h = FL.groupsOf n (pinnedWriteNUnsafe n) (writeChunks h)+writeWith n h = FL.groupsOf n (A.unsafePinnedCreateOf n) (writeChunks h)  -- | Same as 'writeWith' --@@ -518,7 +511,7 @@ writeMaybesWith :: (MonadIO m )     => Int -> Handle -> Fold m (Maybe Word8) () writeMaybesWith n h =-    let writeNJusts = FL.lmap fromJust $ A.pinnedWriteN n+    let writeNJusts = FL.lmap fromJust $ A.pinnedCreateOf n         writeOnNothing = FL.takeEndBy_ isNothing writeNJusts     in FL.many writeOnNothing (writeChunks h) @@ -528,7 +521,7 @@ {-# INLINE writerWith #-} writerWith :: MonadIO m => Int -> Refold m Handle Word8 () writerWith n =-    FL.refoldMany (FL.take n $ pinnedWriteNUnsafe n) chunkWriter+    FL.refoldMany (FL.take n $ A.unsafePinnedCreateOf n) chunkWriter  -- | Write a byte stream to a file handle. Accumulates the input in chunks of -- up to 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing
+ src/Streamly/Internal/FileSystem/Path.hs view
@@ -0,0 +1,515 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.FileSystem.Path+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Well typed and flexible file systems paths, preserving the OS and filesystem+-- encoding.+--+-- You can choose the level of type safety you want. 'Path' is the basic path+-- type which can represent a file, directory, absolute or relative path with+-- no restrictions. Depending on how much type safety you want you can choose+-- appropriate type wrappers to wrap 'Path'. @File Path@ mandates the path to+-- be a file whereas @Abs (File Path)@ mandates it to be an absolute path+-- representing a file.+--+-- You can upgrade or downgrade the safety. Whenever a less restrictive path+-- type is converted to a more restrctive path type the conversion involves+-- checks and it may fail. However, a more restrictive path type can be freely+-- converted to a less restrictive one.+--+-- See the @streamly-filepath@ package for interworking with the 'OsPath' type.+-- The 'Path' type can be  converted to and from 'OsPath' type at zero cost+-- since the underlying representation of both is the same.++-- Conventions: A trailing separator on a path indicates that it is a directory.+-- However, the absence of a trailing separator does not convey any+-- information, it could either be a directory or a file.++-- You may also find the 'str' quasiquoter from "Streamly.Unicode.String" to be+-- useful in creating paths.+--+module Streamly.Internal.FileSystem.Path+    (+    -- * Path Types+      Path (..)+    , File+    , Dir+    , Abs+    , Rel++    -- * Conversions+    , IsPath (..)+    , adaptPath++    -- * Construction+    , fromChunk+    , fromChunkUnsafe+    , fromString+    , fromChars++    -- * Statically Verified Literals+    -- quasiquoters+    , path+    , abs+    , rel+    , dir+    , file+    , absdir+    , reldir+    , absfile+    , relfile++    -- * Statically Verified Strings+    -- TH macros+    , mkPath+    , mkAbs+    , mkRel+    , mkDir+    , mkFile+    , mkAbsDir+    , mkRelDir+    , mkAbsFile+    , mkRelFile++    -- * Elimination+    , toChunk+    , toString+    , toChars++    -- * Operations+    -- Do we need to export the separator functions? They are not essential if+    -- operations to split and combine paths are provided. If someone wants to+    -- work on paths at low level then they know what they are.+    , primarySeparator+    , isSeparator+    , extendPath+    , extendDir+    )+where++import Control.Exception (Exception)+import Control.Monad.Catch (MonadThrow(..))+import Data.Char (chr)+import Data.Functor.Identity (Identity(..))+import Data.Word (Word8)+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+import Data.Word (Word16)+#endif+import Language.Haskell.TH (Q, Exp)+import Language.Haskell.TH.Quote (QuasiQuoter)+import Streamly.Internal.Data.Array (Array)+import Streamly.Internal.Data.Stream (Stream)+import System.IO.Unsafe (unsafePerformIO)++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Unicode.Stream as Unicode++import Prelude hiding (abs)++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+#define WORD_TYPE Word16+#define SEPARATOR 92+#else+#define WORD_TYPE Word8+#define SEPARATOR 47+#endif++------------------------------------------------------------------------------+-- Exceptions+------------------------------------------------------------------------------++-- | Exceptions thrown by path operations.+data PathException =+    InvalidPath String+  | InvalidAbsPath String+  | InvalidRelPath String+  | InvalidFilePath String+  | InvalidDirPath String+    deriving (Show,Eq)++instance Exception PathException++-- XXX Path must not contain null char on Posix. System calls consider the path+-- as null terminated.+-- XXX Maintain the Array with null termination because Unix system calls+-- require a null terminated string, also they return null terminated strings+-- as paths. Implementation of path append will have to handle the null+-- termination. Or we can choose to always copy the array when using it in+-- system calls.++-- XXX The eq instance needs to make sure that the paths are equivalent. If we+-- normalize the paths we can do a byte comparison. However, on windows paths+-- are case insensitive but the case is preserved, therefore, we cannot+-- normalize and need to do case insensitive comparison.++------------------------------------------------------------------------------+-- Types+------------------------------------------------------------------------------++-- | A type representing file system paths for directories or files.+newtype Path = Path (Array WORD_TYPE) -- deriving Eq++-- Show instance prints raw bytes without any decoding for rountdtripping.+-- Should we print this as a string instead, may be useful for ascii chars but+-- utf8 encoded chars may be unprintable. Better use toString if you want to+-- pretty print the path.+{-+instance Show Path where+    show (Path x) = show x+-}++-- XXX Do we need a type for file or dir Name as names cannot have the+-- separator char and there may be other restrictions on names? For example,+-- length restriction.  A file name cannot be "." or "..". We can use the types+-- "File Name" and "Dir Name" to represent names. Also, file systems may put+-- limits on names. Can have an IsName type class with members Name, (File+-- Name), (Dir Name).++-- | A type representing a file path.+newtype File a = File a++-- | A type representing a directory path.+newtype Dir a = Dir a++-- | A type representing absolute paths.+newtype Abs a = Abs a++-- | A type representing relative paths.+newtype Rel a = Rel a++------------------------------------------------------------------------------+-- Conversions+------------------------------------------------------------------------------++-- | A member of 'IsPath' knows how to convert to and from the 'Path' type.+class IsPath a where+    -- | Like 'fromPath' but does not check the properties of 'Path'. Provides+    -- performance and simplicity when we know that the properties of the path+    -- are already verified, for example, when we get the path from the file+    -- system or the OS APIs.+    fromPathUnsafe :: Path -> a++    -- | Convert a raw 'Path' to other forms of well-typed paths. It may fail+    -- if the path does not satisfy the properties of the target type.+    --+    -- Path components may have limits.+    -- Total path length may have a limit.+    fromPath :: MonadThrow m => Path -> m a++    -- | Convert a well-typed path to a raw 'Path'. Never fails.+    toPath :: a -> Path++instance IsPath Path where+    fromPathUnsafe = id+    fromPath = pure+    toPath = id++instance IsPath (File Path) where+    fromPathUnsafe p = File p+    fromPath p = pure (File p)+    toPath (File p) = p++instance IsPath (Dir Path) where+    fromPathUnsafe p = Dir p+    fromPath p = pure (Dir p)+    toPath (Dir p) = p++instance IsPath (Abs Path) where+    fromPathUnsafe p = Abs p+    fromPath p = pure (Abs p)+    toPath (Abs p) = p++instance IsPath (Rel Path) where+    fromPathUnsafe p = Rel p+    fromPath p = pure (Rel p)+    toPath (Rel p) = p++instance IsPath (Abs (File Path)) where+    fromPathUnsafe p = Abs (File p)+    fromPath p = pure (Abs (File p))+    toPath (Abs (File p)) = p++instance IsPath (Abs (Dir Path)) where+    fromPathUnsafe p = Abs (Dir p)+    fromPath p = pure (Abs (Dir p))+    toPath (Abs (Dir p)) = p++instance IsPath (Rel (File Path)) where+    fromPathUnsafe p = Rel (File p)+    fromPath p = pure (Rel (File p))+    toPath (Rel (File p)) = p++instance IsPath (Rel (Dir Path)) where+    fromPathUnsafe p = Rel (Dir p)+    fromPath p = pure (Rel (Dir p))+    toPath (Rel (Dir p)) = p++-- XXX Use rewrite rules to eliminate intermediate conversions for better+-- efficiency.++-- | Convert a path type to another path type. This operation may fail with a+-- 'PathException' when converting a less restrictive path type to a more+-- restrictive one.+adaptPath :: (MonadThrow m, IsPath a, IsPath b) => a -> m b+adaptPath p = fromPath $ toPath p++------------------------------------------------------------------------------+-- Construction+------------------------------------------------------------------------------++-- A chunk is essentially an untyped Array i.e. Array Word8.  We can either use+-- the term ByteArray for that or just Chunk. The latter is shorter and we have+-- been using it consistently in streamly.++-- | /Unsafe/: On Posix, a path cannot contain null characters. On Windows, the+-- array passed must be a multiple of 2 bytes as the underlying representation+-- uses 'Word16'.+{-# INLINE fromChunkUnsafe #-}+fromChunkUnsafe :: Array Word8 -> Path+fromChunkUnsafe arr = Path (Array.castUnsafe arr)++-- | On Posix it may fail if the byte array contains null characters. On+-- Windows the array passed must be a multiple of 2 bytes as the underlying+-- representation uses 'Word16'.+--+-- Throws 'InvalidPath'.+fromChunk :: MonadThrow m => Array Word8 -> m Path+fromChunk arr =+    case Array.cast arr of+        Nothing ->+            -- XXX Windows only message.+            throwM+                $ InvalidPath+                $ "Encoded path length " ++ show (Array.byteLength arr)+                    ++ " is not a multiple of 16-bit."+        Just x -> pure (Path x)++-- | Convert 'Path' to an array of bytes.+toChunk :: Path -> Array Word8+toChunk (Path arr) = Array.asBytes arr++-- | Encode a Unicode char stream to 'Path' using strict UTF-8 encoding on+-- Posix. On Posix it may fail if the stream contains null characters.+-- TBD: Use UTF16LE on Windows.+fromChars :: MonadThrow m => Stream Identity Char -> m Path+fromChars s =+    let n = runIdentity $ Stream.fold Fold.length s+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+     in pure $ Path (Array.fromPureStreamN n (Unicode.encodeUtf16le' s))+#else+     in pure $ Path (Array.fromPureStreamN n (Unicode.encodeUtf8' s))+#endif++-- | Decode the path to a stream of Unicode chars using strict UTF-8 decoding+-- on Posix.+-- TBD: Use UTF16LE on Windows.+toChars :: Monad m => Path -> Stream m Char+toChars (Path arr) =+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+    Unicode.decodeUtf16le' $ Array.read arr+#else+    Unicode.decodeUtf8' $ Array.read arr+#endif++-- | Encode a Unicode string to 'Path' using strict UTF-8 encoding on Posix.+-- On Posix it may fail if the stream contains null characters.+-- TBD: Use UTF16LE on Windows.+fromString :: MonadThrow m => [Char] -> m Path+fromString = fromChars . Stream.fromList++-- | Decode the path to a Unicode string using strict UTF-8 decoding on Posix.+-- TBD: Use UTF16LE on Windows.+toString :: Path -> [Char]+toString = runIdentity . Stream.toList . toChars++------------------------------------------------------------------------------+-- Statically Verified Literals+------------------------------------------------------------------------------++-- XXX Build these on top of the str quasiquoter so that we get the+-- interpolation for free.++-- | Generates a 'Path' type from an interpolated string literal.+--+-- /Unimplemented/+path :: QuasiQuoter+path = undefined++-- | Generates an @Abs Path@ type from an interpolated string literal.+--+-- /Unimplemented/+abs :: QuasiQuoter+abs = undefined++-- | Generates an @Rel Path@ type from an interpolated string literal.+--+-- /Unimplemented/+rel :: QuasiQuoter+rel = undefined++-- | Generates an @Dir Path@ type from an interpolated string literal.+--+-- /Unimplemented/+dir :: QuasiQuoter+dir = undefined++-- | Generates an @File Path@ type from an interpolated string literal.+--+-- /Unimplemented/+file :: QuasiQuoter+file = undefined++-- | Generates an @Abs (Dir Path)@ type from an interpolated string literal.+--+-- /Unimplemented/+absdir :: QuasiQuoter+absdir = undefined++-- | Generates an @Rel (Dir Path)@ type from an interpolated string literal.+--+-- /Unimplemented/+reldir :: QuasiQuoter+reldir = undefined++-- | Generates an @Abs (File Path)@ type from an interpolated string literal.+--+-- /Unimplemented/+absfile :: QuasiQuoter+absfile = undefined++-- | Generates an @Rel (File Path)@ type from an interpolated string literal.+--+-- /Unimplemented/+relfile :: QuasiQuoter+relfile = undefined++------------------------------------------------------------------------------+-- Statically Verified Strings+------------------------------------------------------------------------------++-- | Generates a 'Path' type.+--+-- /Unimplemented/+mkPath :: String -> Q Exp+mkPath = undefined++-- | Generates an @Abs Path@ type.+--+-- /Unimplemented/+mkAbs :: String -> Q Exp+mkAbs = undefined++-- | Generates an @Rel Path@ type.+--+-- /Unimplemented/+mkRel :: String -> Q Exp+mkRel = undefined++-- | Generates an @Dir Path@ type.+--+-- /Unimplemented/+mkDir :: String -> Q Exp+mkDir = undefined++-- | Generates an @File Path@ type.+--+-- /Unimplemented/+mkFile :: String -> Q Exp+mkFile = undefined++-- | Generates an @Abs (Dir Path)@ type.+--+-- /Unimplemented/+mkAbsDir :: String -> Q Exp+mkAbsDir = undefined++-- | Generates an @Rel (Dir Path)@ type.+--+-- /Unimplemented/+mkRelDir :: String -> Q Exp+mkRelDir = undefined++-- | Generates an @Abs (File Path)@ type.+--+-- /Unimplemented/+mkAbsFile :: String -> Q Exp+mkAbsFile = undefined++-- | Generates an @Rel (File Path)@ type.+--+-- /Unimplemented/+mkRelFile :: String -> Q Exp+mkRelFile = undefined++------------------------------------------------------------------------------+-- Operations+------------------------------------------------------------------------------++separatorWord :: WORD_TYPE+separatorWord = SEPARATOR++-- Portable definition for exporting.++-- | Primary path separator character, @/@ on Posix and @\\@ on Windows.+-- Windows supports @/@ too as a separator. Please use 'isSeparator' for+-- testing if a char is a separator char.+primarySeparator :: Char+primarySeparator = chr (SEPARATOR)++-- | On Posix only @/@ is a path separator but in windows it could be either+-- @/@ or @\\@.+isSeparator :: Char -> Bool+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+isSeparator c = (c == '/') || (c == '\\')+#else+isSeparator = (== '/')+#endif++-- If we append an absolute path it may fail with an error if the 'Path'+-- implementation stores absolute path information (a leading separator char).+-- However, the implementation may choose to store the path as a list of+-- components in which case we cannot distinguish an absolute path from+-- relative.++-- | Like 'extendDir' but for the less restrictive 'Path' type which will always+-- create a syntactically valid 'Path' type but it may not be semantically valid+-- because we may append an absolute path or we may append to a file path.+-- The onus lies on the user to ensure that the first path is not a file and+-- the second path is not absolute.+extendPath :: Path -> Path -> Path+extendPath (Path a) (Path b) =+    let len = Array.byteLength a + 1 + Array.byteLength b+        -- XXX Check the leading separator or drive identifier. However,+        -- checking the drive letter may add an additional overhead (can it be+        -- arbitrarily long?), if it is significant we may want to have a+        -- separate combinePathChecked API for that.+        --+        -- Also, do not add a separator char if the first path has a trailing+        -- separator.+        newArr = unsafePerformIO $ do+            arr <- MutArray.new len+            arr1 <- MutArray.spliceUnsafe arr (Array.unsafeThaw a)+            arr2 <- MutArray.snocUnsafe arr1 separatorWord+            arr3 <- MutArray.spliceUnsafe arr2 (Array.unsafeThaw b)+            return (Array.unsafeFreeze arr3)+        in Path newArr++-- The only safety we need for paths is: (1) The first path can only be a Dir+-- type path, and (2) second path can only be a Rel path.+-- Can this be coerced to create unsafe versions?++-- | Extend a directory path by appending a relative path to it. This is the+-- equivalent to the @</>@ operator from the @filepath@ package.+{-# INLINE extendDir #-}+extendDir :: (IsPath (a (Dir Path)), IsPath b, IsPath (a b)) =>+    (a (Dir Path)) -> Rel b -> a b+extendDir a (Rel b) =+    fromPathUnsafe $ extendPath (toPath a) (toPath b)
src/Streamly/Internal/Unicode/Stream.hs view
@@ -28,6 +28,7 @@     , decodeUtf8     , decodeUtf8'     , decodeUtf8_+    , decodeUtf16le'      -- ** Resumable UTF-8 Decoding     , DecodeError(..)@@ -55,6 +56,7 @@     , encodeUtf8'     , encodeUtf8_     , encodeStrings+    , encodeUtf16le'     {-     -- * Operations on character strings     , strip -- (dropAround isSpace)@@ -97,7 +99,7 @@ #if MIN_VERSION_base(4,17,0) import Data.Char (generalCategory, GeneralCategory(Space)) #endif-import Data.Word (Word8)+import Data.Word (Word8, Word16) import Foreign.Marshal.Alloc (mallocBytes) import Foreign.Storable (Storable(..)) #ifndef __GHCJS__@@ -109,7 +111,7 @@ import GHC.Ptr (Ptr (..), plusPtr) import System.IO.Unsafe (unsafePerformIO) import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.MutArray.Type (MutByteArray)+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray) import Streamly.Internal.Data.Fold (Fold) import Streamly.Internal.Data.Parser (Parser) import Streamly.Internal.Data.Stream (Stream)@@ -677,6 +679,19 @@ decodeUtf8Lax = decodeUtf8  -------------------------------------------------------------------------------+-- Decoding Utf16+-------------------------------------------------------------------------------++-- | Decode a UTF-16 little endian encoded bytestream to a stream of Unicode+-- characters. The function throws an error if an invalid codepoint is+-- encountered.+--+-- /Unimplemented/+{-# INLINE decodeUtf16le' #-}+decodeUtf16le' :: Stream m Word16 -> Stream m Char+decodeUtf16le' = undefined++------------------------------------------------------------------------------- -- Decoding Array Streams ------------------------------------------------------------------------------- @@ -945,6 +960,18 @@ {-# INLINE encodeUtf8Lax #-} encodeUtf8Lax :: Monad m => Stream m Char -> Stream m Word8 encodeUtf8Lax = encodeUtf8++-------------------------------------------------------------------------------+-- Encoding to Utf16+-------------------------------------------------------------------------------++-- | Encode a stream of Unicode characters to a UTF-16 little endian encoded+-- bytestream.+--+-- /Unimplemented/+{-# INLINE encodeUtf16le' #-}+encodeUtf16le' :: Stream m Char -> Stream m Word16+encodeUtf16le' = undefined  ------------------------------------------------------------------------------- -- Decoding string literals
streamly-core.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               streamly-core-version:            0.2.1+version:            0.2.2 synopsis:           Streaming, parsers, arrays, serialization and more description:   For upgrading to streamly-0.9.0+ please read the@@ -116,6 +116,7 @@     docs/*.md     docs/ApiChangelogs/0.1.0.txt     docs/ApiChangelogs/0.1.0-0.2.0.txt+    docs/ApiChangelogs/0.2.0-0.2.2.txt  source-repository head     type: git@@ -372,6 +373,7 @@                      , Streamly.Internal.Unicode.Array                       -- Filesystem/IO+                     , Streamly.Internal.FileSystem.Path                      , Streamly.Internal.FileSystem.Handle                      , Streamly.Internal.FileSystem.File                      , Streamly.Internal.FileSystem.Dir