diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -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. diff --git a/configure b/configure --- a/configure +++ b/configure @@ -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 . # @@ -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\\" diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -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]) diff --git a/docs/ApiChangelogs/0.2.0-0.2.2.txt b/docs/ApiChangelogs/0.2.0-0.2.2.txt new file mode 100644 --- /dev/null +++ b/docs/ApiChangelogs/0.2.0-0.2.2.txt @@ -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 diff --git a/docs/Changelog.md b/docs/Changelog.md --- a/docs/Changelog.md +++ b/docs/Changelog.md @@ -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. diff --git a/src/DocTestDataArray.hs b/src/DocTestDataArray.hs --- a/src/DocTestDataArray.hs +++ b/src/DocTestDataArray.hs @@ -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 -} diff --git a/src/DocTestFileSystemHandle.hs b/src/DocTestFileSystemHandle.hs --- a/src/DocTestFileSystemHandle.hs +++ b/src/DocTestFileSystemHandle.hs @@ -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) diff --git a/src/Streamly/Data/Array.hs b/src/Streamly/Data/Array.hs --- a/src/Streamly/Data/Array.hs +++ b/src/Streamly/Data/Array.hs @@ -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 diff --git a/src/Streamly/Data/Array/Generic.hs b/src/Streamly/Data/Array/Generic.hs --- a/src/Streamly/Data/Array/Generic.hs +++ b/src/Streamly/Data/Array/Generic.hs @@ -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) diff --git a/src/Streamly/Data/MutArray.hs b/src/Streamly/Data/MutArray.hs --- a/src/Streamly/Data/MutArray.hs +++ b/src/Streamly/Data/MutArray.hs @@ -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 diff --git a/src/Streamly/Data/MutArray/Generic.hs b/src/Streamly/Data/MutArray/Generic.hs --- a/src/Streamly/Data/MutArray/Generic.hs +++ b/src/Streamly/Data/MutArray/Generic.hs @@ -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 diff --git a/src/Streamly/Internal/Data/Array.hs b/src/Streamly/Internal/Data/Array.hs --- a/src/Streamly/Internal/Data/Array.hs +++ b/src/Streamly/Internal/Data/Array.hs @@ -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) diff --git a/src/Streamly/Internal/Data/Array/Generic.hs b/src/Streamly/Internal/Data/Array/Generic.hs --- a/src/Streamly/Internal/Data/Array/Generic.hs +++ b/src/Streamly/Internal/Data/Array/Generic.hs @@ -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 = diff --git a/src/Streamly/Internal/Data/Array/Stream.hs b/src/Streamly/Internal/Data/Array/Stream.hs --- a/src/Streamly/Internal/Data/Array/Stream.hs +++ b/src/Streamly/Internal/Data/Array/Stream.hs @@ -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 diff --git a/src/Streamly/Internal/Data/Array/Type.hs b/src/Streamly/Internal/Data/Array/Type.hs --- a/src/Streamly/Internal/Data/Array/Type.hs +++ b/src/Streamly/Internal/Data/Array/Type.hs @@ -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 diff --git a/src/Streamly/Internal/Data/Fold/Combinators.hs b/src/Streamly/Internal/Data/Fold/Combinators.hs --- a/src/Streamly/Internal/Data/Fold/Combinators.hs +++ b/src/Streamly/Internal/Data/Fold/Combinators.hs @@ -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 diff --git a/src/Streamly/Internal/Data/Fold/Type.hs b/src/Streamly/Internal/Data/Fold/Type.hs --- a/src/Streamly/Internal/Data/Fold/Type.hs +++ b/src/Streamly/Internal/Data/Fold/Type.hs @@ -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 diff --git a/src/Streamly/Internal/Data/MutArray.hs b/src/Streamly/Internal/Data/MutArray.hs --- a/src/Streamly/Internal/Data/MutArray.hs +++ b/src/Streamly/Internal/Data/MutArray.hs @@ -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 diff --git a/src/Streamly/Internal/Data/MutArray/Generic.hs b/src/Streamly/Internal/Data/MutArray/Generic.hs --- a/src/Streamly/Internal/Data/MutArray/Generic.hs +++ b/src/Streamly/Internal/Data/MutArray/Generic.hs @@ -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 diff --git a/src/Streamly/Internal/Data/MutArray/Stream.hs b/src/Streamly/Internal/Data/MutArray/Stream.hs --- a/src/Streamly/Internal/Data/MutArray/Stream.hs +++ b/src/Streamly/Internal/Data/MutArray/Stream.hs @@ -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. diff --git a/src/Streamly/Internal/Data/MutArray/Type.hs b/src/Streamly/Internal/Data/MutArray/Type.hs --- a/src/Streamly/Internal/Data/MutArray/Type.hs +++ b/src/Streamly/Internal/Data/MutArray/Type.hs @@ -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. diff --git a/src/Streamly/Internal/Data/MutByteArray/Type.hs b/src/Streamly/Internal/Data/MutByteArray/Type.hs --- a/src/Streamly/Internal/Data/MutByteArray/Type.hs +++ b/src/Streamly/Internal/Data/MutByteArray/Type.hs @@ -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# #) -> diff --git a/src/Streamly/Internal/Data/Stream/Generate.hs b/src/Streamly/Internal/Data/Stream/Generate.hs --- a/src/Streamly/Internal/Data/Stream/Generate.hs +++ b/src/Streamly/Internal/Data/Stream/Generate.hs @@ -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 diff --git a/src/Streamly/Internal/Data/Stream/Nesting.hs b/src/Streamly/Internal/Data/Stream/Nesting.hs --- a/src/Streamly/Internal/Data/Stream/Nesting.hs +++ b/src/Streamly/Internal/Data/Stream/Nesting.hs @@ -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 diff --git a/src/Streamly/Internal/Data/Stream/Transform.hs b/src/Streamly/Internal/Data/Stream/Transform.hs --- a/src/Streamly/Internal/Data/Stream/Transform.hs +++ b/src/Streamly/Internal/Data/Stream/Transform.hs @@ -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 diff --git a/src/Streamly/Internal/Data/Stream/Type.hs b/src/Streamly/Internal/Data/Stream/Type.hs --- a/src/Streamly/Internal/Data/Stream/Type.hs +++ b/src/Streamly/Internal/Data/Stream/Type.hs @@ -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 diff --git a/src/Streamly/Internal/Data/StreamK.hs b/src/Streamly/Internal/Data/StreamK.hs --- a/src/Streamly/Internal/Data/StreamK.hs +++ b/src/Streamly/Internal/Data/StreamK.hs @@ -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 diff --git a/src/Streamly/Internal/Data/StreamK/Type.hs b/src/Streamly/Internal/Data/StreamK/Type.hs --- a/src/Streamly/Internal/Data/StreamK/Type.hs +++ b/src/Streamly/Internal/Data/StreamK/Type.hs @@ -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 diff --git a/src/Streamly/Internal/FileSystem/File.hs b/src/Streamly/Internal/FileSystem/File.hs --- a/src/Streamly/Internal/FileSystem/File.hs +++ b/src/Streamly/Internal/FileSystem/File.hs @@ -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 #-} diff --git a/src/Streamly/Internal/FileSystem/Handle.hs b/src/Streamly/Internal/FileSystem/Handle.hs --- a/src/Streamly/Internal/FileSystem/Handle.hs +++ b/src/Streamly/Internal/FileSystem/Handle.hs @@ -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 diff --git a/src/Streamly/Internal/FileSystem/Path.hs b/src/Streamly/Internal/FileSystem/Path.hs new file mode 100644 --- /dev/null +++ b/src/Streamly/Internal/FileSystem/Path.hs @@ -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) diff --git a/src/Streamly/Internal/Unicode/Stream.hs b/src/Streamly/Internal/Unicode/Stream.hs --- a/src/Streamly/Internal/Unicode/Stream.hs +++ b/src/Streamly/Internal/Unicode/Stream.hs @@ -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 diff --git a/streamly-core.cabal b/streamly-core.cabal --- a/streamly-core.cabal +++ b/streamly-core.cabal @@ -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