From e249c4da2dd301ef0a2abb1db8ff3c717eddee0c Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sat, 21 Jan 2023 19:05:34 +0530 Subject: [PATCH] Use StreamD by default, expose StreamK as separate module Basically remove depdency on GHC rewrite rules. The reason for separating StreamD and StreamK instead of using rewrite rules: * Separate types provide better reasoning for the programmer about performance. Each type has its own pros and cons and the programmer can choose the best one based on the use case. * rewrite rules are fragile, led to broken performance in the past dues to change in GHC. * Rewrite rules lead to optimization problems, blocking fusion in some cases, specifically when combining multiple operations e.g. (filter . drop). * Rewrite rules lead to problems when calling a function recursively. For example, the StreamD version of foldBreak cannot be used recursively when wrapped in rewrite rules because each recursive call adds a roundtrip conversion from D to K and back to D. We can use the StreamK versions of these though because the rewrite rule gets eliminated in that case. * If we have a unified module, we need two different versions of several operations e.g. appendK and appendD, both are useful in different cases. --- .../Streamly/Benchmark/Data/Array/Common.hs | 12 +- .../Benchmark/Data/Array/CommonImports.hs | 7 +- .../Streamly/Benchmark/Data/Array/Mut.hs | 10 +- .../Streamly/Benchmark/Data/Array/Stream.hs | 50 +- benchmark/Streamly/Benchmark/Data/Fold.hs | 4 +- .../Streamly/Benchmark/Data/Fold/Window.hs | 19 +- benchmark/Streamly/Benchmark/Data/Parser.hs | 19 +- .../Streamly/Benchmark/Data/Parser/ParserD.hs | 17 +- .../Streamly/Benchmark/Data/Parser/ParserK.hs | 6 +- benchmark/Streamly/Benchmark/Data/Stream.hs | 8 + .../Streamly/Benchmark/Data/Stream/Common.hs | 190 ++-- .../Benchmark/Data/Stream/Eliminate.hs | 94 +- .../Benchmark/Data/Stream/Exceptions.hs | 66 +- .../Streamly/Benchmark/Data/Stream/Expand.hs | 184 ++-- .../Benchmark/Data/Stream/Generate.hs | 68 +- .../Streamly/Benchmark/Data/Stream/Lift.hs | 56 +- .../Streamly/Benchmark/Data/Stream/Reduce.hs | 237 ++--- .../Streamly/Benchmark/Data/Stream/Split.hs | 5 +- .../Streamly/Benchmark/Data/Stream/StreamK.hs | 47 +- .../Benchmark/Data/Stream/ToStreamK.hs | 24 +- .../Benchmark/Data/Stream/Transform.hs | 167 +++- benchmark/Streamly/Benchmark/Data/Unfold.hs | 3 +- .../Benchmark/FileSystem/Handle/Read.hs | 39 +- .../Benchmark/FileSystem/Handle/ReadWrite.hs | 2 +- benchmark/Streamly/Benchmark/Unicode/Char.hs | 2 +- .../Streamly/Benchmark/Unicode/Stream.hs | 16 +- benchmark/bench-runner/Main.hs | 84 +- benchmark/lib/Streamly/Benchmark/Common.hs | 2 +- benchmark/streamly-benchmarks.cabal | 301 ++++--- cabal.project.doctest | 2 +- core/src/Streamly/Data/Stream.hs | 85 +- core/src/Streamly/Data/Stream/StreamDK.hs | 505 +++++++++++ core/src/Streamly/Data/Stream/StreamK.hs | 93 ++ core/src/Streamly/Internal/Console/Stdio.hs | 5 +- core/src/Streamly/Internal/Data/Array.hs | 18 +- .../Streamly/Internal/Data/Array/Generic.hs | 14 +- .../Internal/Data/Array/Generic/Mut/Type.hs | 5 +- core/src/Streamly/Internal/Data/Array/Mut.hs | 9 +- .../Internal/Data/Array/Mut/Stream.hs | 15 +- .../Streamly/Internal/Data/Array/Mut/Type.hs | 5 +- core/src/Streamly/Internal/Data/Array/Type.hs | 18 +- core/src/Streamly/Internal/Data/Fold.hs | 29 +- .../Streamly/Internal/Data/Fold/Chunked.hs | 18 +- core/src/Streamly/Internal/Data/Fold/Type.hs | 2 +- core/src/Streamly/Internal/Data/Parser.hs | 14 +- .../Streamly/Internal/Data/Parser/Chunked.hs | 19 +- .../Streamly/Internal/Data/Ring/Unboxed.hs | 2 +- core/src/Streamly/Internal/Data/Stream.hs | 35 +- .../Streamly/Internal/Data/Stream/Bottom.hs | 14 +- .../Streamly/Internal/Data/Stream/Chunked.hs | 126 +-- .../Streamly/Internal/Data/Stream/Cross.hs | 2 +- .../Internal/Data/Stream/Eliminate.hs | 6 +- .../Internal/Data/Stream/Exception.hs | 12 +- .../Streamly/Internal/Data/Stream/Expand.hs | 18 +- .../Streamly/Internal/Data/Stream/Reduce.hs | 6 +- .../Streamly/Internal/Data/Stream/StreamD.hs | 4 + .../Data/Stream/{ => StreamD}/Container.hs | 57 +- .../Internal/Data/Stream/StreamD/Eliminate.hs | 177 +++- .../Internal/Data/Stream/StreamD/Exception.hs | 182 +++- .../Internal/Data/Stream/StreamD/Generate.hs | 817 ++++++++++++++++- .../Internal/Data/Stream/StreamD/Lift.hs | 44 +- .../Internal/Data/Stream/StreamD/Nesting.hs | 635 +++++++++++-- .../Internal/Data/Stream/{ => StreamD}/Top.hs | 53 +- .../Internal/Data/Stream/StreamD/Transform.hs | 839 ++++++++++++++++-- .../Data/Stream/StreamD/Transformer.hs | 70 +- .../Internal/Data/Stream/StreamD/Type.hs | 808 +++++++++++++++-- .../Streamly/Internal/Data/Stream/StreamDK.hs | 182 +--- .../Streamly/Internal/Data/Stream/StreamK.hs | 228 ++++- .../{StreamDK/Type.hs => StreamK/Alt.hs} | 146 ++- .../Internal/Data/Stream/StreamK/Type.hs | 827 +++++++++++++++-- .../Internal/Data/Stream/Transform.hs | 2 +- .../src/Streamly/Internal/Data/Stream/Type.hs | 49 +- core/src/Streamly/Internal/Data/Unfold.hs | 5 +- core/src/Streamly/Internal/FileSystem/File.hs | 14 +- .../Streamly/Internal/FileSystem/Handle.hs | 16 +- .../Streamly/Internal/Serialize/ToBytes.hs | 34 +- core/src/Streamly/Internal/Unicode/Stream.hs | 31 +- core/streamly-core.cabal | 42 +- hie.yaml | 10 + src/Streamly/Data/Array/Foreign.hs | 6 +- src/Streamly/Data/Stream/MkType.hs | 7 - src/Streamly/Internal/Data/SmallArray.hs | 7 +- src/Streamly/Internal/Data/Stream/Ahead.hs | 3 +- src/Streamly/Internal/Data/Stream/Async.hs | 3 +- .../Internal/Data/Stream/Concurrent.hs | 19 +- .../Data/Stream/Concurrent/Channel.hs | 8 +- .../Stream/Concurrent/Channel/Operations.hs | 4 +- .../Internal/Data/Stream/Exception/Lifted.hs | 10 +- src/Streamly/Internal/Data/Stream/IsStream.hs | 22 +- .../Internal/Data/Stream/IsStream/Common.hs | 42 +- .../Data/Stream/IsStream/Eliminate.hs | 147 ++- .../Data/Stream/IsStream/Exception.hs | 12 +- .../Internal/Data/Stream/IsStream/Expand.hs | 24 +- .../Internal/Data/Stream/IsStream/Generate.hs | 5 +- .../Internal/Data/Stream/IsStream/Lift.hs | 6 +- .../Internal/Data/Stream/IsStream/Reduce.hs | 18 +- .../Internal/Data/Stream/IsStream/Top.hs | 8 +- .../Data/Stream/IsStream/Transform.hs | 8 +- .../Internal/Data/Stream/IsStream/Type.hs | 26 +- src/Streamly/Internal/Data/Stream/MkType.hs | 19 +- src/Streamly/Internal/Data/Stream/Parallel.hs | 102 +-- .../Internal/Data/Stream/SVar/Eliminate.hs | 9 +- .../Internal/Data/Stream/SVar/Generate.hs | 9 +- src/Streamly/Internal/Data/Stream/Serial.hs | 297 ++++--- src/Streamly/Internal/Data/Stream/Time.hs | 6 +- src/Streamly/Internal/Data/Stream/Zip.hs | 135 +++ .../Internal/Data/Stream/Zip/Concurrent.hs | 4 +- src/Streamly/Internal/Data/Stream/ZipAsync.hs | 2 +- src/Streamly/Internal/FileSystem/Event.hs | 2 +- .../Internal/FileSystem/Event/Linux.hs | 4 +- src/Streamly/Internal/FileSystem/FD.hs | 8 +- src/Streamly/Internal/Network/Inet/TCP.hs | 13 +- src/Streamly/Internal/Network/Socket.hs | 17 +- src/Streamly/Internal/Unicode/Char.hs | 5 +- src/Streamly/Prelude.hs | 6 + streamly.cabal | 1 + targets/Targets.hs | 163 ++-- 117 files changed, 7163 insertions(+), 2112 deletions(-) create mode 100644 core/src/Streamly/Data/Stream/StreamDK.hs create mode 100644 core/src/Streamly/Data/Stream/StreamK.hs rename core/src/Streamly/Internal/Data/Stream/{ => StreamD}/Container.hs (85%) rename core/src/Streamly/Internal/Data/Stream/{ => StreamD}/Top.hs (87%) rename core/src/Streamly/Internal/Data/Stream/{StreamDK/Type.hs => StreamK/Alt.hs} (56%) create mode 100644 src/Streamly/Internal/Data/Stream/Zip.hs diff --git a/benchmark/Streamly/Benchmark/Data/Array/Common.hs b/benchmark/Streamly/Benchmark/Data/Array/Common.hs index 59869757b..18c7f620c 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Common.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Common.hs @@ -71,9 +71,9 @@ onArray -> m (Stream Int) onArray value f arr = S.fold (A.writeN value) $ f $ S.unfold A.reader arr -scanl' value n = composeN n $ onArray value $ S.scanl' (+) 0 -scanl1' value n = composeN n $ onArray value $ S.scanl1' (+) -map value n = composeN n $ onArray value $ S.map (+1) +scanl' value n = composeN n $ onArray value $ S.scan (Fold.foldl' (+) 0) +scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+) +map value n = composeN n $ onArray value $ fmap (+1) -- map n = composeN n $ A.map (+1) {-# INLINE eqInstance #-} @@ -98,7 +98,7 @@ showInstance = P.show {-# INLINE pureFoldl' #-} pureFoldl' :: MonadIO m => Stream Int -> m Int -pureFoldl' = S.foldl' (+) 0 . S.unfold A.reader +pureFoldl' = S.fold (Fold.foldl' (+) 0) . S.unfold A.reader ------------------------------------------------------------------------------- -- Elimination @@ -106,11 +106,11 @@ pureFoldl' = S.foldl' (+) 0 . S.unfold A.reader {-# INLINE unfoldReadDrain #-} unfoldReadDrain :: MonadIO m => Stream Int -> m () -unfoldReadDrain = S.drain . S.unfold A.reader +unfoldReadDrain = S.fold Fold.drain . S.unfold A.reader {-# INLINE toStreamRevDrain #-} toStreamRevDrain :: MonadIO m => Stream Int -> m () -toStreamRevDrain = S.drain . A.readRev +toStreamRevDrain = S.fold Fold.drain . A.readRev ------------------------------------------------------------------------------- -- Bench groups diff --git a/benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs b/benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs index 97cc10d21..8e2a10fd6 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs @@ -5,11 +5,12 @@ import Control.Monad.IO.Class (MonadIO) import Data.Functor ((<&>)) import System.Random (randomRIO) -import qualified Streamly.Prelude as S -import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Data.Fold as Fold +import qualified Streamly.Data.Stream as S +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import Gauge import Streamly.Benchmark.Common hiding (benchPureSrc) -import qualified Streamly.Benchmark.Prelude as P +import qualified Stream.Common as P import Prelude as P hiding (map) diff --git a/benchmark/Streamly/Benchmark/Data/Array/Mut.hs b/benchmark/Streamly/Benchmark/Data/Array/Mut.hs index 1e3f20d80..26da3e0f3 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Mut.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Mut.hs @@ -46,8 +46,7 @@ import Prelude import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.Array.Mut as MArray import qualified Streamly.Internal.Data.Fold as Fold -import qualified Streamly.Internal.Data.Stream as Stream -import qualified Streamly.Prelude as IsStream (scanl1') +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import Gauge import Streamly.Benchmark.Common hiding (benchPureSrc) @@ -153,7 +152,7 @@ scanl' value n = composeN n $ onArray value $ Stream.scan (Fold.foldl' (+) 0) {-# INLINE scanl1' #-} scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int) -scanl1' value n = composeN n $ onArray value $ IsStream.scanl1' (+) +scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+) {-# INLINE map #-} map :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int) @@ -181,12 +180,11 @@ unfoldReadRevDrain = drain . Stream.unfold MArray.readerRev {-# INLINE toStreamDRevDrain #-} toStreamDRevDrain :: MonadIO m => Stream Int -> m () -toStreamDRevDrain = - drain . Stream.fromStreamD . MArray.toStreamDRev +toStreamDRevDrain = drain . MArray.toStreamDRev {-# INLINE toStreamDDrain #-} toStreamDDrain :: MonadIO m => Stream Int -> m () -toStreamDDrain = drain . Stream.fromStreamD . MArray.toStreamD +toStreamDDrain = drain . MArray.toStreamD {-# INLINE unfoldFold #-} unfoldFold :: MonadIO m => Stream Int -> m Int diff --git a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs index af33fc281..137188c73 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs @@ -27,21 +27,23 @@ module Main import Control.DeepSeq (NFData(..)) import Control.Monad (void, when) -import Control.Monad.Catch (MonadCatch, try, SomeException) +import Control.Monad.Catch (MonadCatch) import Data.Functor.Identity (runIdentity) import Data.Maybe (isJust) import Data.Word (Word8) -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) +import Streamly.Internal.Data.Stream.StreamK (StreamK) import System.IO (Handle) import System.Random (randomRIO) import Prelude hiding () +import qualified Streamly.Data.Stream as Stream import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.Stream.Chunked as ArrayStream import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as Parser -import qualified Streamly.Internal.Data.Stream as S -import qualified Streamly.Internal.Data.Stream.IsStream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream +import qualified Streamly.Internal.Data.Stream.StreamK as StreamK import qualified Streamly.Internal.FileSystem.Handle as Handle import qualified Streamly.Internal.Unicode.Stream as Unicode @@ -63,8 +65,8 @@ import Test.Inspection -- XXX these can be moved to the common module {-# INLINE sourceUnfoldrM #-} -sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream m Int -sourceUnfoldrM value n = S.unfoldrM step n +sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream.Stream m Int +sourceUnfoldrM value n = Stream.unfoldrM step n where step cnt = if cnt > n + value @@ -100,7 +102,7 @@ inspect $ 'toChunksLast `hasNoType` ''Step toChunksSumLengths :: Handle -> IO Int toChunksSumLengths inh = let s = Handle.readChunks inh - in Stream.sum (Stream.map Array.length s) + in Stream.fold Fold.sum (Stream.map Array.length s) #ifdef INSPECTION inspect $ hasNoTypeClasses 'toChunksSumLengths @@ -135,7 +137,9 @@ inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays -- | Count the number of lines in a file. toChunksSplitOnSuffix :: Handle -> IO Int toChunksSplitOnSuffix = - Stream.length . ArrayStream.splitOnSuffix 10 . Handle.readChunks + Stream.fold Fold.length + . ArrayStream.splitOnSuffix 10 + . Handle.readChunks #ifdef INSPECTION inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix @@ -145,7 +149,10 @@ inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step -- XXX use a word splitting combinator instead of splitOn and test it. -- | Count the number of words in a file. toChunksSplitOn :: Handle -> IO Int -toChunksSplitOn = Stream.length . ArrayStream.splitOn 32 . Handle.readChunks +toChunksSplitOn = + Stream.fold Fold.length + . ArrayStream.splitOn 32 + . Handle.readChunks #ifdef INSPECTION inspect $ hasNoTypeClasses 'toChunksSplitOn @@ -183,8 +190,7 @@ o_1_space_read_chunked env = copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO () copyChunksSplitInterposeSuffix inh outh = Stream.fold (Handle.write outh) - $ ArrayStream.interposeSuffix 10 - $ ArrayStream.splitOnSuffix 10 + $ ArrayStream.interposeSuffix 10 . ArrayStream.splitOnSuffix 10 $ Handle.readChunks inh #ifdef INSPECTION @@ -197,9 +203,8 @@ inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step copyChunksSplitInterpose :: Handle -> Handle -> IO () copyChunksSplitInterpose inh outh = Stream.fold (Handle.write outh) - $ ArrayStream.interpose 32 -- XXX this is not correct word splitting combinator - $ ArrayStream.splitOn 32 + $ ArrayStream.interpose 32 . ArrayStream.splitOn 32 $ Handle.readChunks inh #ifdef INSPECTION @@ -231,25 +236,26 @@ drainWhile p = Parser.takeWhile p Fold.drain {-# INLINE fold #-} fold :: Stream IO (Array.Array Int) -> IO () -fold s = void $ ArrayStream.foldBreak Fold.drain s +fold s = void $ ArrayStream.foldBreak Fold.drain $ StreamK.fromStream s {-# INLINE parse #-} parse :: Int -> Stream IO (Array.Array Int) -> IO () -parse value s = void $ ArrayStream.parseBreak (drainWhile (< value)) s +parse value s = + void $ ArrayStream.parseBreak (drainWhile (< value)) $ StreamK.fromStream s {-# INLINE foldBreak #-} -foldBreak :: Stream IO (Array.Array Int) -> IO () +foldBreak :: StreamK IO (Array.Array Int) -> IO () foldBreak s = do (r, s1) <- ArrayStream.foldBreak Fold.one s when (isJust r) $ foldBreak s1 {-# INLINE parseBreak #-} -parseBreak :: Stream IO (Array.Array Int) -> IO () +parseBreak :: StreamK IO (Array.Array Int) -> IO () parseBreak s = do - r <- try $ ArrayStream.parseBreak Parser.one s + r <- ArrayStream.parseBreak Parser.one s case r of - Left (_ :: SomeException) -> return () - Right (_, s1) -> parseBreak s1 + (Left _, _) -> return () + (Right _, s1) -> parseBreak s1 o_1_space_serial_array :: Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark] @@ -259,7 +265,7 @@ o_1_space_serial_array bound arraysSmall arraysBig = , benchIO "foldBreak (recursive, small arrays)" (\_ -> Stream.fromList arraysSmall) - foldBreak + (foldBreak . StreamK.fromStream) , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall) $ parse bound , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig) @@ -267,7 +273,7 @@ o_1_space_serial_array bound arraysSmall arraysBig = , benchIO "parseBreak (recursive, small arrays)" (\_ -> Stream.fromList arraysSmall) - parseBreak + (parseBreak . StreamK.fromStream) ] ------------------------------------------------------------------------------- diff --git a/benchmark/Streamly/Benchmark/Data/Fold.hs b/benchmark/Streamly/Benchmark/Data/Fold.hs index c27b725a0..c1963054b 100644 --- a/benchmark/Streamly/Benchmark/Data/Fold.hs +++ b/benchmark/Streamly/Benchmark/Data/Fold.hs @@ -25,7 +25,7 @@ import Data.IntMap.Strict (IntMap) import Data.Monoid (Last(..), Sum(..)) import System.Random (randomRIO) -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Streamly.Internal.Data.Fold (Fold(..)) import Streamly.Internal.Data.IsMap.HashMap () @@ -34,7 +34,7 @@ import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Fold.Container as FL import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.Data.Pipe as Pipe -import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import Gauge import Streamly.Benchmark.Common diff --git a/benchmark/Streamly/Benchmark/Data/Fold/Window.hs b/benchmark/Streamly/Benchmark/Data/Fold/Window.hs index 4195d2b27..6ca3477ec 100644 --- a/benchmark/Streamly/Benchmark/Data/Fold/Window.hs +++ b/benchmark/Streamly/Benchmark/Data/Fold/Window.hs @@ -4,25 +4,25 @@ module Main (main) where import Control.DeepSeq (NFData) import Streamly.Data.Fold (Fold) -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) import System.Random (randomRIO) import qualified Streamly.Data.Fold as Fold import qualified Streamly.Internal.Data.Ring.Unboxed as Ring -import qualified Streamly.Prelude as Stream import qualified Streamly.Internal.Data.Fold.Window as Window +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import Gauge {-# INLINE source #-} -source :: (Monad m, Stream.IsStream t, Num a, Stream.Enumerable a) => - Int -> a -> t m a +source :: (Monad m, Num a, Stream.Enumerable a) => + Int -> a -> Stream m a source len from = Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len) {-# INLINE sourceDescending #-} -sourceDescending :: (Monad m, Stream.IsStream t, Num a, Stream.Enumerable a) => - Int -> a -> t m a +sourceDescending :: (Monad m, Num a, Stream.Enumerable a) => + Int -> a -> Stream m a sourceDescending len from = Stream.enumerateFromThenTo (from + fromIntegral len) @@ -30,7 +30,7 @@ sourceDescending len from = from {-# INLINE sourceDescendingInt #-} -sourceDescendingInt :: (Monad m, Stream.IsStream t) => Int -> Int -> t m Int +sourceDescendingInt :: Monad m => Int -> Int -> Stream m Int sourceDescendingInt = sourceDescending {-# INLINE benchWith #-} @@ -56,7 +56,10 @@ benchScanWith src len name f = bench name $ nfIO $ randomRIO (1, 1 :: Int) - >>= Stream.drain . Stream.postscan f . src len . fromIntegral + >>= Stream.fold Fold.drain + . Stream.postscan f + . src len + . fromIntegral {-# INLINE benchWithPostscan #-} benchWithPostscan :: Int -> String -> Fold IO Double a -> Benchmark diff --git a/benchmark/Streamly/Benchmark/Data/Parser.hs b/benchmark/Streamly/Benchmark/Data/Parser.hs index 369624b02..e30371402 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser.hs @@ -20,13 +20,13 @@ module Main import Control.DeepSeq (NFData(..)) import Data.Foldable (asum) import Data.Functor (($>)) -import Data.Maybe (fromMaybe) import Data.Monoid (Sum(..)) import GHC.Magic (inline) import GHC.Magic (noinline) import System.IO (Handle) import System.Random (randomRIO) import Streamly.Internal.Data.Parser (ParseError(..)) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Prelude hiding (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile) @@ -37,13 +37,12 @@ import qualified Streamly.FileSystem.Handle as Handle import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as PR -import qualified Streamly.Internal.Data.Stream as Stream -import qualified Streamly.Internal.Data.Stream.IsStream as IsStream (tail) +import qualified Streamly.Data.Stream as Stream import qualified Streamly.Internal.Data.Producer as Producer import qualified Streamly.Internal.Data.Producer.Source as Source +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import Gauge hiding (env) -import Streamly.Internal.Data.Stream (Stream) import Streamly.Benchmark.Common import Streamly.Benchmark.Common.Handle @@ -141,8 +140,7 @@ dropWhile value = Stream.parse (PR.dropWhile (<= value)) {-# INLINE takeStartBy #-} takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ()) takeStartBy value stream = do - stream1 <- return . fromMaybe (Stream.fromPure (value + 1)) =<< IsStream.tail stream - let stream2 = value `Stream.cons` stream1 + let stream2 = value `Stream.cons` stream Stream.parse (PR.takeStartBy (== value) Fold.drain) stream2 takeFramedByEsc_ :: Monad m => Int -> Stream m Char -> m (Either ParseError ()) @@ -429,14 +427,6 @@ parseIterate n = (Sum 0) . fmap Sum -{-# INLINE parseBreak #-} -parseBreak :: Monad m => Stream m Int -> m () -parseBreak s = do - r <- Stream.parseBreak PR.one s - case r of - (Left _, _) -> return () - (Right _, s1) -> parseBreak s1 - {-# INLINE concatSequence #-} concatSequence :: Monad m => Stream m Int -> m (Either ParseError ()) concatSequence = Stream.parse $ PR.concatSequence Fold.drain $ Stream.repeat PR.one @@ -490,7 +480,6 @@ o_1_space_serial value = , benchIOSink value "shortest" $ shortestAllAny value , benchIOSink value "longest" $ longestAllAny value -} - , benchIOSink value "parseBreak (recursive)" parseBreak , benchIOSink value "parseMany (take 1)" (parseMany 1) , benchIOSink value "parseMany (take all)" (parseMany value) , benchIOSink value "parseIterate (take 1)" (parseIterate 1) diff --git a/benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs b/benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs index 12545b86a..6e698d065 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs @@ -21,9 +21,8 @@ import Control.DeepSeq (NFData(..)) import Data.Foldable (asum) import Data.Function ((&)) import Data.Functor (($>)) -import Data.Maybe (fromMaybe) -import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Parser (ParseError(..)) +import Streamly.Internal.Data.Stream.StreamD (Stream) import System.Random (randomRIO) import Prelude hiding (any, all, take, sequence, sequenceA, sequence_, takeWhile, span) @@ -35,9 +34,8 @@ import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser.ParserD as PR import qualified Streamly.Internal.Data.Producer as Producer import qualified Streamly.Internal.Data.Producer.Source as Source -import qualified Streamly.Internal.Data.Stream as Stream -import qualified Streamly.Internal.Data.Stream.IsStream as IsStream (tail) -import qualified Streamly.Internal.Data.Stream.StreamD as D +import qualified Streamly.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import Gauge import Streamly.Benchmark.Common @@ -75,7 +73,7 @@ listEqBy len = Stream.parseD (PR.listEqBy (==) [1 .. len]) {-# INLINE streamEqBy #-} streamEqBy :: Int -> Stream IO Int -> IO (Either ParseError ()) -streamEqBy len = Stream.parseD (PR.streamEqBy (==) (D.enumerateFromToIntegral 1 len)) +streamEqBy len = Stream.parseD (PR.streamEqBy (==) (Stream.enumerateFromToIntegral 1 len)) {-# INLINE drainWhile #-} drainWhile :: Monad m => (a -> Bool) -> PR.Parser a m () @@ -84,8 +82,7 @@ drainWhile p = PR.takeWhile p Fold.drain {-# INLINE takeStartBy #-} takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ()) takeStartBy value stream = do - stream1 <- return . fromMaybe (Stream.fromPure (value + 1)) =<< IsStream.tail stream - let stream2 = value `Stream.cons` stream1 + let stream2 = value `Stream.cons` stream Stream.parseD (PR.takeStartBy (== value) Fold.drain) stream2 {-# INLINE takeWhile #-} @@ -202,7 +199,9 @@ longestAllAny value = {-# INLINE sequenceParser #-} sequenceParser :: Monad m => Stream m Int -> m (Either ParseError ()) -sequenceParser = Stream.parseD (PR.sequence (D.repeat (PR.satisfy $ const True)) Fold.drain) +sequenceParser = + Stream.parseD + (PR.sequence (Stream.repeat (PR.satisfy $ const True)) Fold.drain) ------------------------------------------------------------------------------- -- Spanning diff --git a/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs b/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs index 7f78e9993..e47204a6e 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs @@ -17,7 +17,7 @@ module Main import Control.DeepSeq (NFData(..)) import Data.Foldable (asum) import Streamly.Internal.Data.Parser (ParseError(..)) -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) import System.Random (randomRIO) import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile) @@ -27,7 +27,7 @@ import qualified Data.Traversable as TR import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Parser.ParserK.Type as PR import qualified Streamly.Internal.Data.Parser.ParserD as PRD -import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import Gauge import Streamly.Benchmark.Common @@ -62,7 +62,7 @@ benchIOSink value name f = #ifdef FROM_PARSERK #define PARSE_OP (Stream.parseD . PRD.fromParserK) #else -#define PARSE_OP Stream.parseK +#define PARSE_OP Stream.parse #endif {-# INLINE satisfy #-} diff --git a/benchmark/Streamly/Benchmark/Data/Stream.hs b/benchmark/Streamly/Benchmark/Data/Stream.hs index 66d8b1098..300623290 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream.hs @@ -14,7 +14,9 @@ module Main (main) where import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv) import qualified Stream.Eliminate as Elimination +#ifndef USE_STREAMLY_CORE import qualified Stream.Exceptions as Exceptions +#endif import qualified Stream.Expand as NestedStream import qualified Stream.Generate as Generation import qualified Stream.Lift as Lift @@ -27,7 +29,11 @@ import qualified Stream.Transform as Transformation import Streamly.Benchmark.Common moduleName :: String +#ifdef USE_STREAMK +moduleName = "Data.Stream.StreamDK" +#else moduleName = "Data.Stream" +#endif ------------------------------------------------------------------------------- -- Main @@ -46,7 +52,9 @@ main = do allBenchmarks env size = Prelude.concat [ Generation.benchmarks moduleName size , Elimination.benchmarks moduleName size +#ifndef USE_STREAMLY_CORE , Exceptions.benchmarks moduleName env size +#endif #ifdef USE_PRELUDE , Split.benchmarks moduleName env #endif diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Common.hs b/benchmark/Streamly/Benchmark/Data/Stream/Common.hs index 8f819ca93..3018714e2 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Common.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Common.hs @@ -16,6 +16,9 @@ module Stream.Common ( MonadAsync + , fromStream + , toStream + -- Generation , fromListM , fromFoldableM @@ -41,8 +44,10 @@ module Stream.Common , benchIO -- Benchmarking functions +#ifdef USE_STREAMK , concatStreamsWith , mergeMapWith +#endif , apDiscardFst , apDiscardSnd , apLiftA2 @@ -70,8 +75,6 @@ import Control.Applicative (liftA2) import Control.DeepSeq (NFData) import Control.Exception (try) import GHC.Exception (ErrorCall) -import Streamly.Internal.Data.Stream (Stream) -import Streamly.Internal.Data.Stream.Cross (CrossStream(..)) import System.Random (randomRIO) import qualified Streamly.Internal.Data.Fold as Fold @@ -81,42 +84,97 @@ import qualified Streamly.Internal.Data.Pipe as Pipe import Streamly.Prelude (foldl', scanl') import qualified Streamly.Internal.Data.Stream.IsStream as Stream import qualified Streamly.Prelude as Stream +import qualified Streamly.Prelude as StreamK import Streamly.Benchmark.Prelude ( composeN, sourceConcatMapId, benchIOSink - , concatStreamsWith, mergeMapWith + , concatStreamsWith ) #else -import qualified Streamly.Internal.Data.Stream as Stream +import Streamly.Internal.Data.Stream.StreamD (Stream) +import qualified Streamly.Internal.Data.Stream.StreamD as D +#ifdef USE_STREAMK +import Streamly.Internal.Data.Stream.StreamK (StreamK) +import qualified Streamly.Internal.Data.Stream.StreamD as Stream +import qualified Streamly.Internal.Data.Stream.StreamK as StreamK +#else +import qualified Streamly.Internal.Data.Stream.StreamD as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as StreamK +#endif #endif import Gauge import Prelude hiding (mapM, replicate) -#ifdef USE_PRELUDE -type MonadAsync m = Stream.MonadAsync m +#ifdef USE_STREAMK +toStream :: Applicative m => StreamK m a -> Stream m a +toStream = StreamK.toStream + +fromStream :: Monad m => Stream m a -> StreamK m a +fromStream = StreamK.fromStream #else -type MonadAsync = Monad +fromStream :: a -> a +fromStream = id + +toStream :: a -> a +toStream = id #endif -{-# INLINE append #-} -append :: Stream m a -> Stream m a -> Stream m a #ifdef USE_PRELUDE +type Stream = Stream.SerialT +type MonadAsync m = Stream.MonadAsync m +mkCross = id +unCross = id +#else +type MonadAsync = Monad + +#ifdef USE_STREAMK +mkCross :: StreamK.Stream m a -> StreamK.CrossStreamK m a +mkCross = StreamK.mkCross + +unCross :: StreamK.CrossStreamK m a -> StreamK.Stream m a +unCross = StreamK.unCross +#else +mkCross :: Stream m a -> Stream.CrossStream m a +mkCross = Stream.mkCross + +unCross :: Stream.CrossStream m a -> Stream m a +unCross = Stream.unCross +#endif +#endif + +#ifdef USE_PRELUDE +{-# INLINE append #-} +append :: Monad m => Stream m a -> Stream m a -> Stream m a append = Stream.serial #else +#ifdef USE_STREAMK +append :: StreamK m a -> StreamK m a -> StreamK m a +append = StreamK.append +#else +append :: Monad m => Stream m a -> Stream m a -> Stream m a append = Stream.append #endif +#endif {-# INLINE append2 #-} append2 :: Monad m => Stream m a -> Stream m a -> Stream m a #ifdef USE_PRELUDE append2 = Stream.append #else -append2 = Stream.append2 +append2 = D.append #endif {-# INLINE drain #-} drain :: Monad m => Stream m a -> m () +{-# INLINE toList #-} +toList :: Monad m => Stream m a -> m [a] +#ifdef USE_PRELUDE +drain = Stream.drain +toList = Stream.toList +#else drain = Stream.fold Fold.drain +toList = Stream.fold Fold.toList +#endif {-# INLINE fromListM #-} fromListM :: MonadAsync m => [m a] -> Stream m a @@ -131,7 +189,7 @@ fromFoldableM :: MonadAsync m => [m a] -> Stream m a #ifdef USE_PRELUDE fromFoldableM = Stream.fromFoldableM #else -fromFoldableM = Stream.sequence . Stream.fromFoldable +fromFoldableM = Stream.sequence . toStream . StreamK.fromFoldable #endif {-# INLINE sourceUnfoldrM #-} @@ -168,8 +226,8 @@ sourceUnfoldrAction value n = Stream.unfoldr step n else Just (return cnt, cnt + 1) {-# INLINE sourceFromFoldable #-} -sourceFromFoldable :: Int -> Int -> Stream m Int -sourceFromFoldable value n = Stream.fromFoldable [n..n+value] +sourceFromFoldable :: Monad m => Int -> Int -> Stream m Int +sourceFromFoldable value n = toStream $ StreamK.fromFoldable [n..n+value] #ifndef USE_PRELUDE {-# INLINE benchIOSink #-} @@ -194,43 +252,45 @@ benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f #ifndef USE_PRELUDE +#ifdef USE_STREAMK {-# INLINE concatStreamsWith #-} concatStreamsWith - :: (Stream IO Int -> Stream IO Int -> Stream IO Int) + :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int) -> Int -> Int -> Int -> IO () concatStreamsWith op outer inner n = - drain $ Stream.concatMapWith op - (sourceUnfoldrM inner) - (sourceUnfoldrM outer n) + drain $ toStream $ StreamK.concatMapWith op + (fromStream . sourceUnfoldrM inner) + (fromStream $ sourceUnfoldrM outer n) {-# INLINE mergeMapWith #-} mergeMapWith - :: (Stream IO Int -> Stream IO Int -> Stream IO Int) + :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int) -> Int -> Int -> Int -> IO () mergeMapWith op outer inner n = - drain $ Stream.mergeMapWith op - (sourceUnfoldrM inner) - (sourceUnfoldrM outer n) + drain $ toStream $ StreamK.mergeMapWith op + (fromStream . sourceUnfoldrM inner) + (fromStream $ sourceUnfoldrM outer n) +#endif {-# INLINE sourceConcatMapId #-} sourceConcatMapId :: (Monad m) => Int -> Int -> Stream m (Stream m Int) sourceConcatMapId value n = - Stream.fromFoldable $ fmap (Stream.fromEffect . return) [n..n+value] + Stream.fromList $ fmap (D.fromEffect . return) [n..n+value] #endif {-# INLINE apDiscardFst #-} apDiscardFst :: MonadAsync m => Int -> Int -> m () -apDiscardFst linearCount start = drain $ unCrossStream $ - CrossStream (sourceUnfoldrM nestedCount2 start) - *> CrossStream (sourceUnfoldrM nestedCount2 start) +apDiscardFst linearCount start = drain $ toStream $ unCross $ + mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + *> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) where @@ -238,9 +298,9 @@ apDiscardFst linearCount start = drain $ unCrossStream $ {-# INLINE apDiscardSnd #-} apDiscardSnd :: MonadAsync m => Int -> Int -> m () -apDiscardSnd linearCount start = drain $ unCrossStream $ - CrossStream (sourceUnfoldrM nestedCount2 start) - <* CrossStream (sourceUnfoldrM nestedCount2 start) +apDiscardSnd linearCount start = drain $ toStream $ unCross $ + mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + <* mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) where @@ -248,9 +308,9 @@ apDiscardSnd linearCount start = drain $ unCrossStream $ {-# INLINE apLiftA2 #-} apLiftA2 :: MonadAsync m => Int -> Int -> m () -apLiftA2 linearCount start = drain $ unCrossStream $ - liftA2 (+) (CrossStream (sourceUnfoldrM nestedCount2 start)) - (CrossStream (sourceUnfoldrM nestedCount2 start)) +apLiftA2 linearCount start = drain $ toStream $ unCross $ + liftA2 (+) (mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)) + (mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)) where @@ -258,9 +318,9 @@ apLiftA2 linearCount start = drain $ unCrossStream $ {-# INLINE toNullAp #-} toNullAp :: MonadAsync m => Int -> Int -> m () -toNullAp linearCount start = drain $ unCrossStream $ - (+) <$> CrossStream (sourceUnfoldrM nestedCount2 start) - <*> CrossStream (sourceUnfoldrM nestedCount2 start) +toNullAp linearCount start = drain $ toStream $ unCross $ + (+) <$> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + <*> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) where @@ -268,9 +328,9 @@ toNullAp linearCount start = drain $ unCrossStream $ {-# INLINE monadThen #-} monadThen :: MonadAsync m => Int -> Int -> m () -monadThen linearCount start = drain $ unCrossStream $ do - CrossStream (sourceUnfoldrM nestedCount2 start) >> - CrossStream (sourceUnfoldrM nestedCount2 start) +monadThen linearCount start = drain $ toStream $ unCross $ do + mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) >> + mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) where @@ -278,9 +338,9 @@ monadThen linearCount start = drain $ unCrossStream $ do {-# INLINE toNullM #-} toNullM :: MonadAsync m => Int -> Int -> m () -toNullM linearCount start = drain $ unCrossStream $ do - x <- CrossStream (sourceUnfoldrM nestedCount2 start) - y <- CrossStream (sourceUnfoldrM nestedCount2 start) +toNullM linearCount start = drain $ toStream $ unCross $ do + x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) return $ x + y where @@ -289,56 +349,56 @@ toNullM linearCount start = drain $ unCrossStream $ do {-# INLINE toNullM3 #-} toNullM3 :: MonadAsync m => Int -> Int -> m () -toNullM3 linearCount start = drain $ unCrossStream $ do - x <- CrossStream (sourceUnfoldrM nestedCount3 start) - y <- CrossStream (sourceUnfoldrM nestedCount3 start) - z <- CrossStream (sourceUnfoldrM nestedCount3 start) +toNullM3 linearCount start = drain $ toStream $ unCross $ do + x <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start) + y <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start) + z <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start) return $ x + y + z where nestedCount3 = round (fromIntegral linearCount**(1/3::Double)) {-# INLINE filterAllOutM #-} filterAllOutM :: MonadAsync m => Int -> Int -> m () -filterAllOutM linearCount start = drain $ unCrossStream $ do - x <- CrossStream (sourceUnfoldrM nestedCount2 start) - y <- CrossStream (sourceUnfoldrM nestedCount2 start) +filterAllOutM linearCount start = drain $ toStream $ unCross $ do + x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) let s = x + y if s < 0 then return s - else CrossStream Stream.nil + else mkCross StreamK.nil where nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) {-# INLINE filterAllInM #-} filterAllInM :: MonadAsync m => Int -> Int -> m () -filterAllInM linearCount start = drain $ unCrossStream $ do - x <- CrossStream (sourceUnfoldrM nestedCount2 start) - y <- CrossStream (sourceUnfoldrM nestedCount2 start) +filterAllInM linearCount start = drain $ toStream $ unCross $ do + x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) let s = x + y if s > 0 then return s - else CrossStream Stream.nil + else mkCross StreamK.nil where nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) {-# INLINE filterSome #-} filterSome :: MonadAsync m => Int -> Int -> m () -filterSome linearCount start = drain $ unCrossStream $ do - x <- CrossStream (sourceUnfoldrM nestedCount2 start) - y <- CrossStream (sourceUnfoldrM nestedCount2 start) +filterSome linearCount start = drain $ toStream $ unCross $ do + x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) let s = x + y if s > 1100000 then return s - else CrossStream Stream.nil + else mkCross StreamK.nil where nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) {-# INLINE breakAfterSome #-} breakAfterSome :: Int -> Int -> IO () breakAfterSome linearCount start = do - (_ :: Either ErrorCall ()) <- try $ drain $ unCrossStream $ do - x <- CrossStream (sourceUnfoldrM nestedCount2 start) - y <- CrossStream (sourceUnfoldrM nestedCount2 start) + (_ :: Either ErrorCall ()) <- try $ drain $ toStream $ unCross $ do + x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) let s = x + y if s > 1100000 then error "break" @@ -349,9 +409,9 @@ breakAfterSome linearCount start = do {-# INLINE toListM #-} toListM :: MonadAsync m => Int -> Int -> m [Int] -toListM linearCount start = Stream.fold Fold.toList $ unCrossStream $ do - x <- CrossStream (sourceUnfoldrM nestedCount2 start) - y <- CrossStream (sourceUnfoldrM nestedCount2 start) +toListM linearCount start = toList $ toStream $ unCross $ do + x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) return $ x + y where nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) @@ -361,9 +421,9 @@ toListM linearCount start = Stream.fold Fold.toList $ unCrossStream $ do {-# INLINE toListSome #-} toListSome :: MonadAsync m => Int -> Int -> m [Int] toListSome linearCount start = - Stream.fold Fold.toList $ Stream.take 10000 $ unCrossStream $ do - x <- CrossStream (sourceUnfoldrM nestedCount2 start) - y <- CrossStream (sourceUnfoldrM nestedCount2 start) + toList $ Stream.take 10000 $ toStream $ unCross $ do + x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) + y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) return $ x + y where nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs index c2d4e76c3..eccfefb68 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs @@ -32,39 +32,41 @@ import System.Random (randomRIO) import qualified Data.Foldable as F import qualified GHC.Exts as GHC +import qualified Streamly.Internal.Data.Fold as Fold #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection - import qualified Streamly.Internal.Data.Stream.StreamD as D #endif -import qualified Streamly.Internal.Data.Fold as Fold -#ifdef USE_PRELUDE -import qualified Streamly.Internal.Data.Stream.IsStream as S -#else -import qualified Streamly.Internal.Data.Stream as S -#endif -import Gauge -import Streamly.Internal.Data.Stream (Stream) #ifdef USE_PRELUDE import Streamly.Prelude (fromSerial) import Streamly.Benchmark.Prelude +import qualified Streamly.Internal.Data.Stream.IsStream as S +import qualified Streamly.Internal.Data.Stream.IsStream as StreamK #else import Stream.Common - ( sourceUnfoldr - , sourceUnfoldrM - , sourceUnfoldrAction - , benchIOSink - ) +import Streamly.Internal.Data.Stream.StreamD (Stream) +import qualified Streamly.Internal.Data.Stream.StreamD as S +#ifdef USE_STREAMK +import Streamly.Internal.Data.Stream.StreamK (StreamK) +import qualified Streamly.Data.Stream.StreamK as StreamK +#else +import qualified Streamly.Internal.Data.Stream.StreamD as StreamK #endif +#endif + +import Gauge import Streamly.Benchmark.Common import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!), lookup, repeat, minimum, maximum, product, last, mapM_, init) import qualified Prelude #ifdef USE_PRELUDE +type Stream = S.SerialT +fromStream = id + {-# INLINE repeat #-} repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int repeat count = S.take count . S.repeat @@ -213,6 +215,9 @@ o_1_space_elimination_foldable value = , bench "minimum" $ nf (foldableMin value) 1 , benchPureSink value "min (ord)" ordInstanceMin , bench "maximum" $ nf (foldableMax value) 1 + , bench "minimumBy" $ nf (`foldableMinBy` 1) value + , bench "maximumBy" $ nf (`foldableMaxBy` 1) value + , bench "minimumByList" $ nf (`foldableListMinBy` 1) value , bench "length . toList" $ nf (Prelude.length . foldableToList value) 1 , bench "notElem" $ nf (foldableNotElem value) 1 @@ -235,28 +240,15 @@ o_1_space_elimination_foldable value = ] ] -o_n_space_elimination_foldable :: Int -> [Benchmark] -o_n_space_elimination_foldable value = - -- Head recursive strict right folds. - [ bgroup "foldl" - -- XXX the definitions of minimumBy and maximumBy in Data.Foldable use - -- foldl1 which does not work in constant memory for our - -- implementation. It works in constant memory for lists but even for - -- lists it takes 15x more time compared to our foldl' based - -- implementation. - [ bench "minimumBy" $ nf (`foldableMinBy` 1) value - , bench "maximumBy" $ nf (`foldableMaxBy` 1) value - , bench "minimumByList" $ nf (`foldableListMinBy` 1) value - ] - ] - ------------------------------------------------------------------------------- -- Stream folds ------------------------------------------------------------------------------- +#ifndef USE_PRELUDE instance NFData a => NFData (Stream Identity a) where {-# INLINE rnf #-} rnf xs = runIdentity $ S.fold (Fold.foldl' (\_ x -> rnf x) ()) xs +#endif {-# INLINE benchPureSink #-} benchPureSink :: NFData b @@ -283,9 +275,13 @@ benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1 ------------------------------------------------------------------------------- {-# INLINE uncons #-} +#ifdef USE_STREAMK +uncons :: Monad m => StreamK m Int -> m () +#else uncons :: Monad m => Stream m Int -> m () +#endif uncons s = do - r <- S.uncons s + r <- StreamK.uncons s case r of Nothing -> return () Just (_, t) -> uncons t @@ -310,9 +306,15 @@ foldrMElem e = else xs) (return False) +#ifdef USE_STREAMK {-# INLINE foldrToStream #-} -foldrToStream :: Monad m => Stream m Int -> m (Stream Identity Int) -foldrToStream = S.foldr S.cons S.nil +foldrToStream :: Monad m => Stream m Int -> m (StreamK Identity Int) +foldrToStream = S.foldr StreamK.cons StreamK.nil +#else +-- {-# INLINE foldrToStream #-} +-- foldrToStream :: Monad m => Stream m Int -> m (Stream Identity Int) +-- foldrToStream = S.foldr S.cons S.nil +#endif {-# INLINE foldrMBuild #-} foldrMBuild :: Monad m => Stream m Int -> m [Int] @@ -456,17 +458,34 @@ o_1_space_elimination_folds value = ] , bgroup "Identity" [ benchIdentitySink value "foldrMElem" (foldrMElem value) +#ifdef USE_STREAMK , benchIdentitySink value "foldrToStreamLength" + (S.fold Fold.length . toStream . runIdentity . foldrToStream) + {- + , benchIdentitySink 16 "foldrToStreamLength (16)" + (S.fold Fold.length . toStream . runIdentity . foldrToStream) + -} +#else + {- + , benchIdentitySink 16 "foldrToStreamLength (16)" (S.fold Fold.length . runIdentity . foldrToStream) + -} +#endif + {- + , benchPureSink 16 "foldrMToListLength (16)" + (Prelude.length . runIdentity . foldrMBuild) + -} , benchPureSink value "foldrMToListLength" (Prelude.length . runIdentity . foldrMBuild) ] ] -- deconstruction - , benchIOSink value "uncons" uncons + , benchIOSink value "uncons" (uncons . fromStream) +#ifndef USE_PRELUDE , benchHoistSink value "length . generalizeInner" (S.fold Fold.length . S.generalizeInner) +#endif #ifdef USE_PRELUDE , benchIOSink value "init" init @@ -587,8 +606,10 @@ o_n_space_elimination_toList value = [ bgroup "toList" -- Converting the stream to a list or pure stream in a strict monad [ benchIOSink value "toList" S.toList +#ifndef USE_PRELUDE , benchIOSink value "toStream" (S.toStream :: (Stream IO Int -> IO (Stream Identity Int))) +#endif ] ] #endif @@ -718,11 +739,8 @@ benchmarks moduleName size = #ifdef USE_PRELUDE ++ o_n_heap_elimination_foldl size ++ o_n_heap_elimination_toList size -#endif - , bgroup (o_n_space_prefix moduleName) $ - o_n_space_elimination_foldable size -#ifdef USE_PRELUDE ++ o_n_space_elimination_toList size #endif - ++ o_n_space_elimination_foldr size + , bgroup (o_n_space_prefix moduleName) $ + o_n_space_elimination_foldr size ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs index 9f50fbea2..604ab83db 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs @@ -27,25 +27,21 @@ module Stream.Exceptions (benchmarks) where import Control.Exception (Exception, throwIO) import Stream.Common (drain) -import Streamly.Internal.Data.Stream (Stream) import qualified Data.IORef as Ref import qualified Data.Map.Strict as Map -import qualified Stream.Common as Common -#ifndef USE_STREAMLY_CORE import Control.Exception (SomeException) import System.IO (Handle, hClose, hPutChar) import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.FileSystem.Handle as IFH import qualified Streamly.Internal.Data.Unfold as IUF import qualified Streamly.Internal.Data.Unfold.Exception as IUF -#endif #ifdef USE_PRELUDE import qualified Streamly.Internal.Data.Stream.IsStream as Stream #else -import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import qualified Streamly.Internal.Data.Stream.Exception.Lifted as Stream #endif @@ -60,18 +56,35 @@ import Test.Inspection import qualified Streamly.Internal.Data.Stream.StreamD as D #endif +#ifdef USE_PRELUDE +type Stream = Stream.SerialT +toStreamD = Stream.toStream +fromStreamD = Stream.fromStream +#else +type Stream = Stream.Stream +toStreamD :: a -> a +toStreamD = id +fromStreamD :: a -> a +fromStreamD = id +#endif + +afterUnsafe :: IO b -> Stream IO a -> Stream IO a +finallyUnsafe :: IO b -> Stream IO a -> Stream IO a +bracketUnsafe :: IO b -> (b -> IO c) -> (b -> Stream IO a) -> Stream IO a +#ifdef USE_PRELUDE +afterUnsafe = Stream.after_ +finallyUnsafe = Stream.finally_ +bracketUnsafe = Stream.bracket_ +#else +afterUnsafe = Stream.afterUnsafe +finallyUnsafe = Stream.finallyUnsafe +bracketUnsafe = Stream.bracketUnsafe +#endif + ------------------------------------------------------------------------------- -- stream exceptions ------------------------------------------------------------------------------- -{-# INLINE replicateM #-} -replicateM :: Common.MonadAsync m => Int -> m a -> Stream m a -#ifdef USE_PRELUDE -replicateM = Stream.replicateM -#else -replicateM n = Stream.sequence . Stream.replicate n -#endif - data BenchException = BenchException1 | BenchException2 @@ -101,7 +114,7 @@ retryNone length from = do where source ref = - replicateM (from + length) + Stream.replicateM (from + length) $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref retryAll :: Int -> Int -> IO () @@ -146,7 +159,6 @@ o_1_space_serial_exceptions length = ] -- XXX Move these to FileSystem.Handle benchmarks -#ifndef USE_STREAMLY_CORE ------------------------------------------------------------------------------- -- copy stream exceptions @@ -177,7 +189,7 @@ inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream readWriteFinally_Stream :: Handle -> Handle -> IO () readWriteFinally_Stream inh devNull = let readEx = - Stream.finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh) + finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh) in Stream.fold (FH.write devNull) readEx #ifdef INSPECTION @@ -192,9 +204,9 @@ readWriteFinallyStream inh devNull = -- | Send the file contents to /dev/null with exception handling fromToBytesBracket_Stream :: Handle -> Handle -> IO () fromToBytesBracket_Stream inh devNull = - let readEx = Stream.bracketUnsafe (return ()) (\_ -> hClose inh) - (\_ -> IFH.read inh) - in IFH.putBytes devNull readEx + let readEx = bracketUnsafe (return ()) (\_ -> hClose inh) + (\_ -> fromStreamD $ IFH.read inh) + in IFH.putBytes devNull (toStreamD readEx) #ifdef INSPECTION inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream @@ -203,8 +215,8 @@ inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream fromToBytesBracketStream :: Handle -> Handle -> IO () fromToBytesBracketStream inh devNull = let readEx = Stream.bracket (return ()) (\_ -> hClose inh) - (\_ -> IFH.read inh) - in IFH.putBytes devNull readEx + (\_ -> fromStreamD $ IFH.read inh) + in IFH.putBytes devNull (toStreamD readEx) readWriteBeforeAfterStream :: Handle -> Handle -> IO () readWriteBeforeAfterStream inh devNull = @@ -228,7 +240,7 @@ inspect $ 'readWriteAfterStream `hasNoType` ''D.Step readWriteAfter_Stream :: Handle -> Handle -> IO () readWriteAfter_Stream inh devNull = - let readEx = Stream.afterUnsafe (hClose inh) (Stream.unfold FH.reader inh) + let readEx = afterUnsafe (hClose inh) (Stream.unfold FH.reader inh) in Stream.fold (FH.write devNull) readEx #ifdef INSPECTION @@ -310,10 +322,10 @@ o_1_space_copy_exceptions_readChunks env = -- | Send the file contents to /dev/null with exception handling toChunksBracket_ :: Handle -> Handle -> IO () toChunksBracket_ inh devNull = - let readEx = Stream.bracketUnsafe + let readEx = bracketUnsafe (return ()) (\_ -> hClose inh) - (\_ -> IFH.readChunks inh) + (\_ -> fromStreamD $ IFH.readChunks inh) in Stream.fold (IFH.writeChunks devNull) readEx #ifdef INSPECTION @@ -325,7 +337,7 @@ toChunksBracket inh devNull = let readEx = Stream.bracket (return ()) (\_ -> hClose inh) - (\_ -> IFH.readChunks inh) + (\_ -> fromStreamD $ IFH.readChunks inh) in Stream.fold (IFH.writeChunks devNull) readEx o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark] @@ -338,16 +350,12 @@ o_1_space_copy_exceptions_toChunks env = ] ] -#endif - benchmarks :: String -> BenchEnv -> Int -> [Benchmark] benchmarks moduleName _env size = [ bgroup (o_1_space_prefix moduleName) $ concat [ o_1_space_serial_exceptions size -#ifndef USE_STREAMLY_CORE , o_1_space_copy_exceptions_readChunks _env , o_1_space_copy_exceptions_toChunks _env , o_1_space_copy_stream_exceptions _env -#endif ] ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs b/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs index 8954dc2f8..2f8285ebd 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Expand.hs @@ -25,11 +25,6 @@ module Stream.Expand (benchmarks) where -import Streamly.Internal.Data.Stream (Stream) -import Streamly.Internal.Data.Stream.Cross (CrossStream(..)) - -import qualified Control.Applicative as AP - #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection @@ -38,19 +33,29 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D #endif import qualified Stream.Common as Common +import qualified Streamly.Internal.Data.Unfold as UF + #ifdef USE_PRELUDE import qualified Streamly.Internal.Data.Stream.IsStream as S +import qualified Streamly.Internal.Data.Stream.IsStream as StreamK import Streamly.Benchmark.Prelude ( sourceFoldMapM, sourceFoldMapWith, sourceFoldMapWithM , sourceFoldMapWithStream, concatFoldableWith, concatForFoldableWith) #else -import qualified Streamly.Internal.Data.Stream as S -#endif -import qualified Streamly.Internal.Data.Unfold as UF +import qualified Streamly.Internal.Data.Stream.StreamD as S +#ifdef USE_STREAMK +import Streamly.Internal.Data.Stream.StreamD (Stream) +import Streamly.Internal.Data.Stream.StreamK (StreamK, CrossStreamK) +import qualified Control.Applicative as AP import qualified Streamly.Internal.Data.Fold as Fold +import qualified Streamly.Internal.Data.Stream.StreamK as StreamK +#else +import qualified Streamly.Internal.Data.Stream.StreamD as StreamK +#endif +#endif import Gauge -import Stream.Common hiding (append2) +import Stream.Common import Streamly.Benchmark.Common import Prelude hiding (concatMap) @@ -58,6 +63,7 @@ import Prelude hiding (concatMap) -- Iteration/looping utilities ------------------------------------------------------------------------------- +#ifdef USE_STREAMK {-# INLINE iterateN #-} iterateN :: (Int -> a -> a) -> a -> Int -> a iterateN g initial count = f count initial @@ -69,13 +75,16 @@ iterateN g initial count = f count initial -- Iterate a transformation over a singleton stream {-# INLINE iterateSingleton #-} -iterateSingleton :: - (Int -> CrossStream m Int -> CrossStream m Int) +iterateSingleton :: Applicative m => + (Int -> CrossStreamK m Int -> CrossStreamK m Int) -> Int -> Int -> Stream m Int iterateSingleton g count n = - unCrossStream $ iterateN g (CrossStream (S.fromPure n)) count + toStream + $ StreamK.unCross + $ iterateN g (StreamK.mkCross (StreamK.fromPure n)) count +#endif {- -- XXX need to check why this is slower than the explicit recursion above, even @@ -104,50 +113,28 @@ _iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n {-# INLINE serial2 #-} serial2 :: Int -> Int -> IO () serial2 count n = - drain $ - Common.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)) + drain $ toStream $ + Common.append + (fromStream $ sourceUnfoldrM count n) + (fromStream $ sourceUnfoldrM count (n + 1)) {-# INLINE serial4 #-} serial4 :: Int -> Int -> IO () serial4 count n = - drain $ + drain $ toStream $ Common.append - (Common.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))) (Common.append - (sourceUnfoldrM count (n + 2)) - (sourceUnfoldrM count (n + 3))) - -{-# INLINE append2 #-} -append2 :: Int -> Int -> IO () -append2 count n = - drain $ - Common.append2 (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)) - -{-# INLINE append4 #-} -append4 :: Int -> Int -> IO () -append4 count n = - drain $ - Common.append2 - (Common.append2 - (sourceUnfoldrM count n) - (sourceUnfoldrM count (n + 1))) - (Common.append2 - (sourceUnfoldrM count (n + 2)) - (sourceUnfoldrM count (n + 3))) - -#ifdef INSPECTION -inspect $ hasNoTypeClasses 'append2 -inspect $ 'append2 `hasNoType` ''SPEC -inspect $ 'append2 `hasNoType` ''D.AppendState -#endif + (fromStream $ sourceUnfoldrM count n) + (fromStream $ sourceUnfoldrM count (n + 1))) + (Common.append + (fromStream $ sourceUnfoldrM count (n + 2)) + (fromStream $ sourceUnfoldrM count (n + 3))) o_1_space_joining :: Int -> [Benchmark] o_1_space_joining value = [ bgroup "joining" [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2)) - , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2)) , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4)) - , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4)) ] ] @@ -183,10 +170,11 @@ o_1_space_concatFoldable value = {-# INLINE concatMap #-} concatMap :: Int -> Int -> Int -> IO () concatMap outer inner n = - drain $ S.concatMap - (\_ -> sourceUnfoldrM inner n) - (sourceUnfoldrM outer n) + drain $ toStream $ StreamK.concatMap + (\_ -> fromStream $ sourceUnfoldrM inner n) + (fromStream $ sourceUnfoldrM outer n) +#ifndef USE_STREAMK {-# INLINE concatMapM #-} concatMapM :: Int -> Int -> Int -> IO () concatMapM outer inner n = @@ -198,15 +186,16 @@ concatMapM outer inner n = inspect $ hasNoTypeClasses 'concatMap inspect $ 'concatMap `hasNoType` ''SPEC #endif +#endif -- concatMap unfoldr/unfoldr {-# INLINE concatMapPure #-} concatMapPure :: Int -> Int -> Int -> IO () concatMapPure outer inner n = - drain $ S.concatMap - (\_ -> sourceUnfoldr inner n) - (sourceUnfoldr outer n) + drain $ toStream $ StreamK.concatMap + (\_ -> fromStream $ sourceUnfoldr inner n) + (fromStream $ sourceUnfoldr outer n) #ifdef INSPECTION inspect $ hasNoTypeClasses 'concatMapPure @@ -218,7 +207,8 @@ inspect $ 'concatMapPure `hasNoType` ''SPEC {-# INLINE concatMapRepl #-} concatMapRepl :: Int -> Int -> Int -> IO () concatMapRepl outer inner n = - drain $ S.concatMap (S.replicate inner) (sourceUnfoldrM outer n) + drain $ toStream $ StreamK.concatMap + (fromStream . S.replicate inner) (fromStream $ sourceUnfoldrM outer n) #ifdef INSPECTION inspect $ hasNoTypeClasses 'concatMapRepl @@ -227,6 +217,7 @@ inspect $ 'concatMapRepl `hasNoType` ''SPEC -- concatMapWith +#ifdef USE_STREAMK {-# INLINE concatMapWithSerial #-} concatMapWithSerial :: Int -> Int -> Int -> IO () concatMapWithSerial = concatStreamsWith Common.append @@ -236,6 +227,7 @@ inspect $ hasNoTypeClasses 'concatMapWithSerial inspect $ 'concatMapWithSerial `hasNoType` ''SPEC #endif +{- {-# INLINE concatMapWithAppend #-} concatMapWithAppend :: Int -> Int -> Int -> IO () concatMapWithAppend = concatStreamsWith Common.append2 @@ -244,6 +236,7 @@ concatMapWithAppend = concatStreamsWith Common.append2 inspect $ hasNoTypeClasses 'concatMapWithAppend inspect $ 'concatMapWithAppend `hasNoType` ''SPEC #endif +-} -- mergeMapWith @@ -251,9 +244,12 @@ inspect $ 'concatMapWithAppend `hasNoType` ''SPEC mergeMapWithSerial :: Int -> Int -> Int -> IO () mergeMapWithSerial = mergeMapWith Common.append +{- {-# INLINE mergeMapWithAppend #-} mergeMapWithAppend :: Int -> Int -> Int -> IO () mergeMapWithAppend = mergeMapWith Common.append2 +-} +#endif -- unfoldMany @@ -284,10 +280,6 @@ o_1_space_concat value = sqrtVal `seq` , benchIOSrc1 "concatMapPure (1 of n)" (concatMapPure 1 value) - -- This is for comparison with foldMapWith - , benchIOSrc "concatMapId (n of 1) (fromFoldable)" - (S.concatMap id . sourceConcatMapId value) - , benchIOSrc1 "concatMap (n of 1)" (concatMap value 1) , benchIOSrc1 "concatMap (sqrt n of sqrt n)" @@ -295,16 +287,25 @@ o_1_space_concat value = sqrtVal `seq` , benchIOSrc1 "concatMap (1 of n)" (concatMap 1 value) +#ifndef USE_STREAMK + -- This is for comparison with foldMapWith + , benchIOSrc "concatMapId (n of 1) (fromFoldable)" + (S.concatMap id . sourceConcatMapId value) + , benchIOSrc1 "concatMapM (n of 1)" (concatMapM value 1) , benchIOSrc1 "concatMapM (sqrt n of sqrt n)" (concatMapM sqrtVal sqrtVal) , benchIOSrc1 "concatMapM (1 of n)" (concatMapM 1 value) +#endif +#ifdef USE_STREAMK + {- -- This is for comparison with foldMapWith , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)" - (S.concatMapWith Common.append id . sourceConcatMapId value) + (toStream . S.concatMapWith Common.append id . sourceConcatMapId value) + -} , benchIOSrc1 "concatMapWith (n of 1)" (concatMapWithSerial value 1) @@ -313,9 +314,12 @@ o_1_space_concat value = sqrtVal `seq` , benchIOSrc1 "concatMapWith (1 of n)" (concatMapWithSerial 1 value) + {- -- quadratic with number of outer streams , benchIOSrc1 "concatMapWithAppend (2 of n/2)" (concatMapWithAppend 2 (value `div` 2)) + -} +#endif -- concatMap vs unfoldMany , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)" @@ -329,8 +333,9 @@ o_1_space_concat value = sqrtVal `seq` sqrtVal = round $ sqrt (fromIntegral value :: Double) -o_n_space_concat :: Int -> [Benchmark] -o_n_space_concat value = sqrtVal `seq` +#ifdef USE_STREAMK +o_n_space_merge :: Int -> [Benchmark] +o_n_space_merge value = sqrtVal `seq` [ bgroup "concat" [ -------------------mergeMapWith----------------- @@ -344,16 +349,19 @@ o_n_space_concat value = sqrtVal `seq` , benchIOSrc1 "mergeMapWithSerial (2 of n/2)" (mergeMapWithSerial 2 (value `div` 2)) + {- , benchIOSrc1 "mergeMapWithAppend (n of 1)" (mergeMapWithAppend value 1) , benchIOSrc1 "mergeMapWithAppend (sqrtVal of sqrtVal)" (mergeMapWithAppend sqrtVal sqrtVal) + -} ] ] where sqrtVal = round $ sqrt (fromIntegral value :: Double) +#endif ------------------------------------------------------------------------------- -- Applicative @@ -369,9 +377,10 @@ o_1_space_applicative value = ] ] +#ifdef USE_STREAMK o_n_space_applicative :: Int -> [Benchmark] o_n_space_applicative value = - [ bgroup "Applicative" + [ bgroup "iterated" [ benchIOSrc "(*>) (n times)" $ iterateSingleton ((*>) . pure) value , benchIOSrc "(<*) (n times)" $ @@ -382,6 +391,7 @@ o_n_space_applicative value = iterateSingleton (AP.liftA2 (+) . pure) value ] ] +#endif ------------------------------------------------------------------------------- -- Monad @@ -405,30 +415,46 @@ o_1_space_monad value = ] ] +#ifdef USE_STREAMK -- This is a good benchmark but inefficient way to compute primes. As we see a -- new prime we keep appending a division filter for all the future numbers. {-# INLINE sieve #-} -sieve :: Monad m => Stream m Int -> Stream m Int -sieve s = S.concatEffect $ do - r <- S.uncons s +sieve :: Monad m => StreamK m Int -> StreamK m Int +sieve s = StreamK.concatEffect $ do + r <- StreamK.uncons s case r of Just (prime, rest) -> - pure $ prime `S.cons` sieve (S.filter (\n -> n `mod` prime /= 0) rest) - Nothing -> pure S.nil + -- XXX Use K.filter or rewrite to K.filter + let f = S.filter (\n -> n `mod` prime /= 0) + in pure $ prime `StreamK.cons` sieve (fromStream $ f $ toStream rest) + Nothing -> pure StreamK.nil + +o_n_space_iterated :: Int -> [Benchmark] +o_n_space_iterated value = + [ bgroup "iterated" + [ + benchIO "concatEffect prime sieve (n/4)" + (\n -> + S.fold Fold.sum + $ toStream + $ sieve + $ fromStream + $ S.enumerateFromTo 2 (value `div` 4 + n)) + , benchIOSrc "(>>) (n times)" $ + iterateSingleton ((>>) . pure) value + , benchIOSrc "(>>=) (n times)" $ + iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value + ] + ] +#endif o_n_space_monad :: Int -> [Benchmark] o_n_space_monad value = [ bgroup "Monad" - [ benchIOSrc "(>>) (n times)" $ - iterateSingleton ((>>) . pure) value - , benchIOSrc "(>>=) (n times)" $ - iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value - , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $ + [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $ toListM value , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $ toListSome value - , benchIO "naive prime sieve (n/4)" - (\n -> S.fold Fold.sum $ sieve $ S.enumerateFromTo 2 (value `div` 4 + n)) ] ] @@ -436,6 +462,7 @@ o_n_space_monad value = -- Joining ------------------------------------------------------------------------------- +{- toKv :: Int -> (Int, Int) toKv p = (p, p) @@ -487,6 +514,7 @@ o_n_heap_buffering value = halfVal = value `div` 2 sqrtVal = round $ sqrt (fromIntegral value :: Double) +-} ------------------------------------------------------------------------------- -- Main @@ -495,6 +523,7 @@ o_n_heap_buffering value = -- In addition to gauge options, the number of elements in the stream can be -- passed using the --stream-size option. -- +{-# ANN benchmarks "HLint: ignore" #-} benchmarks :: String -> Int -> [Benchmark] benchmarks moduleName size = [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat @@ -505,19 +534,22 @@ benchmarks moduleName size = , o_1_space_concatFoldable size #endif , o_1_space_concat size - , o_1_space_applicative size , o_1_space_monad size - ] , bgroup (o_n_space_prefix moduleName) $ Prelude.concat [ -- multi-stream - o_n_space_applicative size - , o_n_space_monad size - , o_n_space_concat size + o_n_space_monad size +#ifdef USE_STREAMK + , o_n_space_merge size + , o_n_space_iterated size + , o_n_space_applicative size +#endif ] + {- , bgroup (o_n_heap_prefix moduleName) $ -- multi-stream o_n_heap_buffering size + -} ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs index cbd814157..4eba670ff 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Generate.hs @@ -21,29 +21,28 @@ import Control.DeepSeq (NFData(..)) import Data.Functor.Identity (Identity(..)) import qualified GHC.Exts as GHC -import qualified Stream.Common as Common import qualified Streamly.Internal.Data.Fold as Fold + #ifdef USE_PRELUDE +import Streamly.Prelude (MonadAsync) +import Stream.Common hiding (MonadAsync) import Streamly.Benchmark.Prelude (sourceFromFoldableM, absTimes) import qualified Streamly.Prelude as S import qualified Streamly.Internal.Data.Stream.IsStream as Stream #else -import qualified Streamly.Internal.Data.Stream as Stream +import Stream.Common +import Streamly.Internal.Data.Stream.StreamD (Stream) +import qualified Streamly.Internal.Data.Stream.StreamD as Stream +#ifdef USE_STREAMK +import System.IO.Unsafe (unsafeInterleaveIO) +import qualified Streamly.Internal.Data.Stream.StreamK as StreamK +import qualified Stream.Common as Common +#endif #endif -import qualified Prelude import Gauge import Streamly.Benchmark.Common -import Streamly.Internal.Data.Stream (Stream) -import Streamly.Internal.Data.Stream.Cross (CrossStream(..)) -#ifdef USE_PRELUDE -import Streamly.Prelude (MonadAsync) -import Stream.Common hiding (MonadAsync) -#else -import Stream.Common -#endif - -import System.IO.Unsafe (unsafeInterleaveIO) +import qualified Prelude import Prelude hiding (repeat, replicate, iterate) @@ -51,6 +50,14 @@ import Prelude hiding (repeat, replicate, iterate) -- Generation ------------------------------------------------------------------------------- +#ifdef USE_PRELUDE +type Stream = Stream.SerialT +toStreamD = Stream.toStream +#else +toStreamD :: a -> a +toStreamD = id +#endif + ------------------------------------------------------------------------------- -- fromList ------------------------------------------------------------------------------- @@ -157,15 +164,15 @@ iterate count = Stream.take count . Stream.iterate (+1) iterateM :: MonadAsync m => Int -> Int -> Stream m Int iterateM count = Stream.take count . Stream.iterateM (return . (+1)) . return -#ifdef USE_PRELUDE {-# INLINE repeatM #-} -repeatM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int -repeatM count = S.take count . S.repeatM . return +repeatM :: MonadAsync m => Int -> Int -> Stream m Int +repeatM count = Stream.take count . Stream.repeatM . return {-# INLINE replicateM #-} -replicateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int -replicateM count = S.replicateM count . return +replicateM :: MonadAsync m => Int -> Int -> Stream m Int +replicateM count = Stream.replicateM count . return +#ifdef USE_PRELUDE {-# INLINE fromIndices #-} fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int fromIndices value n = S.take value $ S.fromIndices (+ n) @@ -175,15 +182,17 @@ fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n)) #endif +#ifdef USE_STREAMK {-# INLINE mfixUnfold #-} mfixUnfold :: Int -> Int -> Stream IO (Int, Int) -mfixUnfold count start = Stream.mfix f +mfixUnfold count start = toStream $ StreamK.mfix f where - f action = unCrossStream $ do + f action = StreamK.unCross $ do let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act - x <- CrossStream (Common.fromListM [incr 1 action, incr 2 action]) - y <- CrossStream (Common.sourceUnfoldr count start) + x <- StreamK.mkCross (fromStream $ Common.fromListM [incr 1 action, incr 2 action]) + y <- StreamK.mkCross (fromStream $ Common.sourceUnfoldr count start) return (x, y) +#endif o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value = @@ -201,37 +210,46 @@ o_1_space_generation value = , benchIOSrc "fracFromTo" (sourceFracFromTo value) , benchIOSrc "fromList" (sourceFromList value) , benchIOSrc "fromListM" (sourceFromListM value) - , benchPureSrc "IsList.fromList" (sourceIsList value) - , benchPureSrc "IsString.fromString" (sourceIsString value) + , benchPureSrc "IsList.fromList" (toStreamD . sourceIsList value) + , benchPureSrc "IsString.fromString" (toStreamD . sourceIsString value) , benchIOSrc "enumerateFrom" (enumerateFrom value) , benchIOSrc "enumerateFromTo" (enumerateFromTo value) , benchIOSrc "enumerateFromThen" (enumerateFromThen value) , benchIOSrc "enumerateFromThenTo" (enumerateFromThenTo value) , benchIOSrc "enumerate" (enumerate value) , benchIOSrc "enumerateTo" (enumerateTo value) -#ifdef USE_PRELUDE , benchIOSrc "repeatM" (repeatM value) , benchIOSrc "replicateM" (replicateM value) +#ifdef USE_PRELUDE , benchIOSrc "fromIndices" (fromIndices value) , benchIOSrc "fromIndicesM" (fromIndicesM value) #endif -- These essentially test cons and consM +#ifdef USE_STREAMK , benchIOSrc "fromFoldable" (sourceFromFoldable value) + -- , benchIOSrc "fromFoldable 16" (sourceFromFoldable 16) +#else + -- , benchIOSrc "fromFoldable 16" (sourceFromFoldable 16) +#endif #ifdef USE_PRELUDE , benchIOSrc "fromFoldableM" (sourceFromFoldableM value) , benchIOSrc "absTimes" $ absTimes value #endif +#ifdef USE_STREAMK , Common.benchIOSrc "mfix_10" (mfixUnfold 10) , Common.benchIOSrc "mfix_100" (mfixUnfold 100) , Common.benchIOSrc "mfix_1000" (mfixUnfold 1000) +#endif ] ] +#ifndef USE_PRELUDE instance NFData a => NFData (Stream Identity a) where {-# INLINE rnf #-} rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs +#endif o_n_heap_generation :: Int -> [Benchmark] o_n_heap_generation value = diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs index 18b1da7f6..21295921d 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs @@ -18,24 +18,33 @@ module Stream.Lift (benchmarks) where import Control.DeepSeq (NFData(..)) import Control.Monad.State.Strict (StateT, get, put) import Data.Functor.Identity (Identity) -import Stream.Common - (benchIO, sourceUnfoldr, sourceUnfoldrM, benchIOSrc, drain) +import Stream.Common (sourceUnfoldr, sourceUnfoldrM, benchIOSrc) import System.Random (randomRIO) + +import qualified Stream.Common as Common +import qualified Streamly.Internal.Data.Fold as Fold + #ifdef USE_PRELUDE import qualified Streamly.Internal.Data.Stream.IsStream as Stream #else -import qualified Streamly.Internal.Data.Stream as Stream -#endif -import qualified Streamly.Internal.Data.Fold as Fold -import qualified Stream.Common as Common +import Streamly.Internal.Data.Stream.StreamD (Stream) +import qualified Streamly.Internal.Data.Stream.StreamD as Stream +#ifdef USE_STREAMK +import Stream.Common (benchIO, drain) +import Streamly.Internal.Data.Stream.StreamK (StreamK) +import qualified Streamly.Internal.Data.Stream.StreamK as StreamK import qualified Control.Monad.State.Strict as State +#endif +#endif import Gauge -import Streamly.Internal.Data.Stream (Stream) import Streamly.Benchmark.Common - import Prelude hiding (reverse, tail) +#ifdef USE_PRELUDE +type Stream = Stream.SerialT +#endif + ------------------------------------------------------------------------------- -- Monad transformation (hoisting etc.) ------------------------------------------------------------------------------- @@ -76,12 +85,15 @@ o_1_space_hoisting value = [ bgroup "hoisting" [ benchIOSrc "evalState" (evalStateT value) , benchIOSrc "withState" (withState value) +#ifndef USE_PRELUDE , benchHoistSink value "generalizeInner" ((\xs -> Stream.fold Fold.length xs :: IO Int) . Stream.generalizeInner) +#endif ] ] +#ifdef USE_STREAMK {-# INLINE iterateStateIO #-} iterateStateIO :: Monad m @@ -95,28 +107,17 @@ iterateStateIO n = do iterateStateIO n else return x +-- XXX This is basically testing the perf of concatEffect, change it to just +-- use concatEffect and move it along with other concatMap benchmarks. {-# INLINE iterateStateT #-} -iterateStateT :: Int -> Stream (StateT Int IO) Int -iterateStateT n = Stream.concatEffect $ do +iterateStateT :: Int -> StreamK (StateT Int IO) Int +iterateStateT n = StreamK.concatEffect $ do x <- get if x > n then do put (x - 1) return $ iterateStateT n - else return $ Stream.fromPure x - -{-# INLINE iterateState #-} -{-# SPECIALIZE iterateState :: Int -> Stream (StateT Int IO) Int #-} -iterateState :: Monad m => - Int - -> Stream (StateT Int m) Int -iterateState n = Stream.concatEffect $ do - x <- get - if x > n - then do - put (x - 1) - return $ iterateState n - else return $ Stream.fromPure x + else return $ StreamK.fromPure x o_n_heap_transformer :: Int -> [Benchmark] o_n_heap_transformer value = @@ -124,11 +125,10 @@ o_n_heap_transformer value = [ benchIO "StateT Int IO (n times) (baseline)" $ \n -> State.evalStateT (iterateStateIO n) value , benchIO "Stream (StateT Int IO) (n times)" $ \n -> - State.evalStateT (drain (iterateStateT n)) value - , benchIO "MonadState Int m => Stream m Int" $ \n -> - State.evalStateT (drain (iterateState n)) value + State.evalStateT (drain $ Common.toStream (iterateStateT n)) value ] ] +#endif ------------------------------------------------------------------------------- -- Main @@ -140,5 +140,7 @@ o_n_heap_transformer value = benchmarks :: String -> Int -> [Benchmark] benchmarks moduleName size = [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size) +#ifdef USE_STREAMK , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size) +#endif ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs b/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs index 7b949b8bc..e7faa8e1a 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs @@ -21,17 +21,21 @@ import Control.DeepSeq (NFData(..)) import Control.Monad.IO.Class (MonadIO(..)) import Data.Monoid (Sum(..)) import GHC.Generics (Generic) -import Streamly.Internal.Data.Stream (Stream) import qualified Streamly.Internal.Data.Refold.Type as Refold import qualified Streamly.Internal.Data.Fold as FL import qualified Stream.Common as Common + +#ifndef USE_STREAMLY_CORE +import Data.HashMap.Strict (HashMap) +import Data.Proxy (Proxy(..)) +import Streamly.Internal.Data.IsMap.HashMap () +#endif + #ifdef USE_PRELUDE import Control.Monad (when) -import Data.Proxy (Proxy(..)) -import Data.HashMap.Strict (HashMap) -import Streamly.Internal.Data.IsMap.HashMap () import qualified Streamly.Internal.Data.Stream.IsStream as S +import qualified Streamly.Prelude as S import Streamly.Prelude (fromSerial) import Streamly.Benchmark.Prelude hiding ( benchIO, benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2 @@ -39,7 +43,22 @@ import Streamly.Benchmark.Prelude hiding , filterSome, breakAfterSome, toListM, toListSome, transformMapM , transformComposeMapM, transformTeeMapM, transformZipMapM) #else -import qualified Streamly.Internal.Data.Stream as S + +import Streamly.Internal.Data.Stream.StreamD (Stream) +import qualified Streamly.Internal.Data.Stream.StreamD as S +#ifndef USE_STREAMLY_CORE +import qualified Streamly.Data.Stream.Prelude as S +import qualified Streamly.Internal.Data.Stream.Time as S +#endif + +#ifdef USE_STREAMK +import Streamly.Internal.Data.Stream.StreamK (StreamK) +import qualified Streamly.Internal.Data.Parser as PR +import qualified Streamly.Internal.Data.Stream.StreamK as K +#else +import qualified Streamly.Internal.Data.Stream.StreamD as K +#endif + #endif import Gauge @@ -47,45 +66,27 @@ import Streamly.Benchmark.Common import Stream.Common import Prelude hiding (reverse, tail) -------------------------------------------------------------------------------- --- Iteration/looping utilities -------------------------------------------------------------------------------- +#ifdef USE_PRELUDE +type Stream = S.SerialT +#endif -{-# INLINE iterateN #-} -iterateN :: (Int -> a -> a) -> a -> Int -> a -iterateN g initial count = f count initial +-- Apply transformation g count times on a stream of length len +#ifdef USE_STREAMK +{-# INLINE iterateSource #-} +iterateSource :: + MonadAsync m + => (StreamK m Int -> StreamK m Int) + -> Int + -> Int + -> Int + -> StreamK m Int +iterateSource g count len n = f count (fromStream $ sourceUnfoldrM len n) where - f (0 :: Int) x = x - f i x = f (i - 1) (g i x) - --- Iterate a transformation over a singleton stream -{-# INLINE iterateSingleton #-} -iterateSingleton :: - (Int -> Stream m Int -> Stream m Int) - -> Int - -> Int - -> Stream m Int -iterateSingleton g count n = iterateN g (S.fromPure n) count - -{- --- XXX need to check why this is slower than the explicit recursion above, even --- if the above code is written in a foldr like head recursive way. We also --- need to try this with foldlM' once #150 is fixed. --- However, it is perhaps best to keep the iteration benchmarks independent of --- foldrM and any related fusion issues. -{-# INLINE _iterateSingleton #-} -_iterateSingleton :: - Monad m - => (Int -> Stream m Int -> Stream m Int) - -> Int - -> Int - -> Stream m Int -_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n --} - --- Apply transformation g count times on a stream of length len + f (0 :: Int) stream = stream + f i stream = f (i - 1) (g stream) +#else {-# INLINE iterateSource #-} iterateSource :: MonadAsync m @@ -100,28 +101,7 @@ iterateSource g count len n = f count (sourceUnfoldrM len n) f (0 :: Int) stream = stream f i stream = f (i - 1) (g stream) - -------------------------------------------------------------------------------- --- Functor -------------------------------------------------------------------------------- - -o_n_space_functor :: Int -> [Benchmark] -o_n_space_functor value = - [ bgroup "Functor" - [ benchIO "(+) (n times) (baseline)" $ \i0 -> - iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value - , benchIOSrc "(<$) (n times)" $ - iterateSingleton (<$) value - , benchIOSrc "fmap (n times)" $ - iterateSingleton (fmap . (+)) value - {- - , benchIOSrc fromSerial "_(<$) (n times)" $ - _iterateSingleton (<$) value - , benchIOSrc fromSerial "_fmap (n times)" $ - _iterateSingleton (fmap . (+)) value - -} - ] - ] +#endif ------------------------------------------------------------------------------- -- Grouping transformations @@ -195,6 +175,16 @@ refoldIterateM = (Refold.take 2 Refold.sconcat) (return (Sum 0)) . fmap Sum +#ifdef USE_STREAMK +{-# INLINE parseBreak #-} +parseBreak :: Monad m => StreamK m Int -> m () +parseBreak s = do + r <- K.parseBreak PR.one s + case r of + (Left _, _) -> return () + (Right _, s1) -> parseBreak s1 +#endif + o_1_space_grouping :: Int -> [Benchmark] o_1_space_grouping value = -- Buffering operations using heap proportional to group/window sizes. @@ -216,31 +206,54 @@ o_1_space_grouping value = , benchIOSink value "refoldMany" refoldMany , benchIOSink value "foldIterateM" foldIterateM , benchIOSink value "refoldIterateM" refoldIterateM +#ifdef USE_STREAMK + , benchIOSink value "parseBreak (recursive)" (parseBreak . fromStream) +#endif + +#ifndef USE_STREAMLY_CORE + , benchIOSink value "classifySessionsOf (10000 buckets)" + (classifySessionsOf (getKey 10000)) + , benchIOSink value "classifySessionsOf (64 buckets)" + (classifySessionsOf (getKey 64)) + , benchIOSink value "classifySessionsOfHash (10000 buckets)" + (classifySessionsOfHash (getKey 10000)) + , benchIOSink value "classifySessionsOfHash (64 buckets)" + (classifySessionsOfHash (getKey 64)) +#endif ] ] +#ifndef USE_STREAMLY_CORE + where + + getKey :: Int -> Int -> Int + getKey n = (`mod` n) +#endif + ------------------------------------------------------------------------------- -- Size conserving transformations (reordering, buffering, etc.) ------------------------------------------------------------------------------- +#ifndef USE_PRELUDE {-# INLINE reverse #-} reverse :: MonadIO m => Int -> Stream m Int -> m () -reverse n = composeN n S.reverse +reverse n = composeN n (toStream . K.reverse . fromStream) {-# INLINE reverse' #-} reverse' :: MonadIO m => Int -> Stream m Int -> m () -reverse' n = composeN n S.reverse' +reverse' n = composeN n S.reverseUnbox +#endif o_n_heap_buffering :: Int -> [Benchmark] o_n_heap_buffering value = [ bgroup "buffered" [ +#ifndef USE_PRELUDE -- Reversing a stream benchIOSink value "reverse" (reverse 1) , benchIOSink value "reverse'" (reverse' 1) - -#ifdef USE_PRELUDE - , benchIOSink value "mkAsync" (mkAsync fromSerial) +#else + benchIOSink value "mkAsync" (mkAsync fromSerial) #endif ] ] @@ -249,9 +262,9 @@ o_n_heap_buffering value = -- Grouping/Splitting ------------------------------------------------------------------------------- -#ifdef USE_PRELUDE +#ifndef USE_STREAMLY_CORE {-# INLINE classifySessionsOf #-} -classifySessionsOf :: MonadAsync m => (Int -> Int) -> Stream m Int -> m () +classifySessionsOf :: S.MonadAsync m => (Int -> Int) -> Stream m Int -> m () classifySessionsOf getKey = Common.drain . S.classifySessionsOf @@ -260,7 +273,7 @@ classifySessionsOf getKey = . fmap (\x -> (getKey x, x)) {-# INLINE classifySessionsOfHash #-} -classifySessionsOfHash :: MonadAsync m => +classifySessionsOfHash :: S.MonadAsync m => (Int -> Int) -> Stream m Int -> m () classifySessionsOfHash getKey = Common.drain @@ -269,25 +282,6 @@ classifySessionsOfHash getKey = 1 False (const (return False)) 3 (FL.take 10 FL.sum) . S.timestamped . fmap (\x -> (getKey x, x)) - -o_n_space_grouping :: Int -> [Benchmark] -o_n_space_grouping value = - -- Buffering operations using heap proportional to group/window sizes. - [ bgroup "grouping" - [ benchIOSink value "classifySessionsOf (10000 buckets)" - (classifySessionsOf (getKey 10000)) - , benchIOSink value "classifySessionsOf (64 buckets)" - (classifySessionsOf (getKey 64)) - , benchIOSink value "classifySessionsOfHash (10000 buckets)" - (classifySessionsOfHash (getKey 10000)) - , benchIOSink value "classifySessionsOfHash (64 buckets)" - (classifySessionsOfHash (getKey 64)) - ] - ] - - where - - getKey n = (`mod` n) #endif ------------------------------------------------------------------------------- @@ -349,8 +343,9 @@ data Pair a b = deriving (Generic, NFData) {-# INLINE sumProductFold #-} -sumProductFold :: Monad m => Stream m Int -> m (Int, Int) -sumProductFold = Common.foldl' (\(s, p) x -> (s + x, p * x)) (0, 1) +sumProductFold :: Monad m => Stream m Int -> m (Pair Int Int) +sumProductFold = + Common.foldl' (\(Pair s p) x -> Pair (s + x) (p * x)) (Pair 0 1) {-# INLINE sumProductScan #-} sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int) @@ -398,6 +393,46 @@ o_1_space_transformations_mixedX4 value = -- Iterating a transformation over and over again ------------------------------------------------------------------------------- +#ifdef USE_STREAMK +{- +-- this is quadratic +{-# INLINE iterateScan #-} +iterateScan :: MonadAsync m => Int -> Int -> Int -> Stream m Int +iterateScan count len = toStream . iterateSource (K.scanl' (+) 0) count len +-} + +{-# INLINE iterateMapM #-} +iterateMapM :: MonadAsync m => Int -> Int -> Int -> Stream m Int +iterateMapM count len = toStream . iterateSource (K.mapM return) count len + +{-# INLINE iterateFilterEven #-} +iterateFilterEven :: MonadAsync m => Int -> Int -> Int -> Stream m Int +iterateFilterEven count len = + toStream . iterateSource (K.filter even) count len + +{-# INLINE iterateTakeAll #-} +iterateTakeAll :: MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int +iterateTakeAll value count len = + toStream . iterateSource (K.take (value + 1)) count len + +{-# INLINE iterateDropOne #-} +iterateDropOne :: MonadAsync m => Int -> Int -> Int -> Stream m Int +iterateDropOne count len = toStream . iterateSource (K.drop 1) count len + +{-# INLINE iterateDropWhileTrue #-} +iterateDropWhileTrue :: MonadAsync m + => Int -> Int -> Int -> Int -> Stream m Int +iterateDropWhileTrue value count len = + toStream . iterateSource (K.dropWhile (<= (value + 1))) count len + +{-# INLINE iterateDropWhileFalse #-} +iterateDropWhileFalse :: MonadAsync m + => Int -> Int -> Int -> Int -> Stream m Int +iterateDropWhileFalse value count len = + toStream . iterateSource (K.dropWhile (> (value + 1))) count len + +#else + -- this is quadratic {-# INLINE iterateScan #-} iterateScan :: MonadAsync m => Int -> Int -> Int -> Stream m Int @@ -426,15 +461,11 @@ iterateTakeAll value = iterateSource (S.take (value + 1)) iterateDropOne :: MonadAsync m => Int -> Int -> Int -> Stream m Int iterateDropOne = iterateSource (S.drop 1) -{-# INLINE iterateDropWhileFalse #-} -iterateDropWhileFalse :: MonadAsync m - => Int -> Int -> Int -> Int -> Stream m Int -iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1))) - {-# INLINE iterateDropWhileTrue #-} iterateDropWhileTrue :: MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1))) +#endif #ifdef USE_PRELUDE {-# INLINE tail #-} @@ -455,8 +486,10 @@ o_n_stack_iterated :: Int -> [Benchmark] o_n_stack_iterated value = by10 `seq` by100 `seq` [ bgroup "iterated" [ benchIOSrc "mapM (n/10 x 10)" $ iterateMapM by10 10 +#ifndef USE_STREAMK , benchIOSrc "scanl' (quadratic) (n/100 x 100)" $ iterateScan by100 100 +#endif #ifdef USE_PRELUDE , benchIOSrc "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10 #endif @@ -465,8 +498,10 @@ o_n_stack_iterated value = by10 `seq` by100 `seq` , benchIOSrc "takeAll (n/10 x 10)" $ iterateTakeAll value by10 10 , benchIOSrc "dropOne (n/10 x 10)" $ iterateDropOne by10 10 +#ifdef USE_STREAMK , benchIOSrc "dropWhileFalse (n/10 x 10)" $ iterateDropWhileFalse value by10 10 +#endif , benchIOSrc "dropWhileTrue (n/10 x 10)" $ iterateDropWhileTrue value by10 10 #ifdef USE_PRELUDE @@ -530,13 +565,5 @@ benchmarks moduleName size = , o_1_space_pipesX4 size ] , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size) - , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat - [ -#ifdef USE_PRELUDE - o_n_space_grouping size - , -#endif - o_n_space_functor size - , o_n_heap_buffering size - ] + , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering size) ] diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Split.hs b/benchmark/Streamly/Benchmark/Data/Stream/Split.hs index 35a7b072a..002de9855 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Split.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Split.hs @@ -143,7 +143,7 @@ splitOnSeq str inh = -- | Split on a word8 sequence. splitOnSeq100k :: Handle -> IO Int splitOnSeq100k inh = do - arr <- A.fromStream $ S.replicate 100000 123 + arr <- A.fromStream $ IP.toStream $ S.fromSerial $ S.replicate 100000 123 (S.length $ IP.splitOnSeq arr FL.drain $ S.unfold FH.read inh) -- >>= print @@ -220,8 +220,9 @@ o_1_space_reduce_read_split env = splitOnSeqUtf8 :: String -> Handle -> IO Int splitOnSeqUtf8 str inh = (S.length $ IP.splitOnSeq (A.fromList str) FL.drain + $ IP.fromStream $ IUS.decodeUtf8Arrays - $ IFH.getChunks inh) -- >>= print + $ IFH.readChunks inh) -- >>= print o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark] o_1_space_reduce_toChunks_split env = diff --git a/benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs b/benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs index 0a58285f8..8b9b3a24f 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs @@ -33,7 +33,6 @@ import Prelude hiding import qualified Prelude as P import qualified Data.List as List -import qualified Streamly.Internal.Control.Concurrent as S import qualified Streamly.Internal.Data.Stream.StreamK.Type as S import qualified Streamly.Internal.Data.Stream.StreamK as S @@ -129,7 +128,7 @@ unfoldr streamLen n = S.unfoldr step n else Just (cnt, cnt + 1) {-# INLINE unfoldrM #-} -unfoldrM :: S.MonadAsync m => Int -> Int -> Stream m Int +unfoldrM :: Monad m => Int -> Int -> Stream m Int unfoldrM streamLen n = S.unfoldrMWith S.consM step n where step cnt = @@ -142,7 +141,7 @@ repeat :: Int -> Int -> Stream m Int repeat streamLen = S.take streamLen . S.repeat {-# INLINE repeatM #-} -repeatM :: S.MonadAsync m => Int -> Int -> Stream m Int +repeatM :: Monad m => Int -> Int -> Stream m Int repeatM streamLen = S.take streamLen . S.repeatM . return {-# INLINE replicate #-} @@ -150,7 +149,7 @@ replicate :: Int -> Int -> Stream m Int replicate = S.replicate {-# INLINE replicateM #-} -replicateM :: S.MonadAsync m => Int -> Int -> Stream m Int +replicateM :: Monad m => Int -> Int -> Stream m Int replicateM streamLen = S.replicateMWith S.consM streamLen . return {-# INLINE iterate #-} @@ -158,7 +157,7 @@ iterate :: Int -> Int -> Stream m Int iterate streamLen = S.take streamLen . S.iterate (+1) {-# INLINE iterateM #-} -iterateM :: S.MonadAsync m => Int -> Int -> Stream m Int +iterateM :: Monad m => Int -> Int -> Stream m Int iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return {-# INLINE fromFoldable #-} @@ -166,7 +165,7 @@ fromFoldable :: Int -> Int -> Stream m Int fromFoldable streamLen n = S.fromFoldable [n..n+streamLen] {-# INLINE fromFoldableM #-} -fromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int +fromFoldableM :: Monad m => Int -> Int -> Stream m Int fromFoldableM streamLen n = Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen]) @@ -180,12 +179,13 @@ concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil {-# INLINE concatMapFoldableSerial #-} concatMapFoldableSerial :: Int -> Int -> Stream m Int -concatMapFoldableSerial streamLen n = concatMapFoldableWith S.serial S.fromPure [n..n+streamLen] +concatMapFoldableSerial streamLen n = + concatMapFoldableWith S.append S.fromPure [n..n+streamLen] {-# INLINE concatMapFoldableSerialM #-} concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int concatMapFoldableSerialM streamLen n = - concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen] + concatMapFoldableWith S.append (S.fromEffect . return) [n..n+streamLen] ------------------------------------------------------------------------------- -- Elimination @@ -270,11 +270,11 @@ fmapK :: Monad m => Int -> Stream m Int -> m () fmapK n = composeN n $ P.fmap (+ 1) {-# INLINE mapM #-} -mapM :: S.MonadAsync m => Int -> Stream m Int -> m () +mapM :: Monad m => Int -> Stream m Int -> m () mapM n = composeN n $ S.mapMWith S.consM return {-# INLINE mapMSerial #-} -mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m () +mapMSerial :: Monad m => Int -> Stream m Int -> m () mapMSerial n = composeN n $ S.mapMSerial return {-# INLINE filterEven #-} @@ -326,7 +326,7 @@ foldlS :: Monad m => Int -> Stream m Int -> m () foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil {-# INLINE intersperse #-} -intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m () +intersperse :: Monad m => Int -> Int -> Stream m Int -> m () intersperse streamLen n = composeN n $ S.intersperse streamLen ------------------------------------------------------------------------------- @@ -335,8 +335,7 @@ intersperse streamLen n = composeN n $ S.intersperse streamLen {-# INLINE iterateSource #-} iterateSource - :: S.MonadAsync m - => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int + :: Monad m => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n) where f (0 :: Int) m = g m @@ -344,37 +343,37 @@ iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n) -- this is quadratic {-# INLINE iterateScan #-} -iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int +iterateScan :: Monad m => Int -> Int -> Int -> Stream m Int iterateScan iterStreamLen maxIters = iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10) -- this is quadratic {-# INLINE iterateDropWhileFalse #-} -iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int +iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> Stream m Int iterateDropWhileFalse streamLen iterStreamLen maxIters = iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10) {-# INLINE iterateMapM #-} -iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int +iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int iterateMapM iterStreamLen = iterateSource iterStreamLen (S.mapMWith S.consM return) {-# INLINE iterateFilterEven #-} -iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int +iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even) {-# INLINE iterateTakeAll #-} -iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int +iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int iterateTakeAll streamLen iterStreamLen = iterateSource iterStreamLen (S.take streamLen) {-# INLINE iterateDropOne #-} -iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int +iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1) {-# INLINE iterateDropWhileTrue #-} -iterateDropWhileTrue :: S.MonadAsync m => - Int -> Int -> Int -> Int -> Stream m Int +iterateDropWhileTrue :: + Monad m => Int -> Int -> Int -> Int -> Stream m Int iterateDropWhileTrue streamLen iterStreamLen = iterateSource iterStreamLen (S.dropWhile (<= streamLen)) @@ -392,7 +391,7 @@ zipWithM src = drain $ S.zipWithM (curry return) src src {-# INLINE sortByK #-} sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a -sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure +sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure {-# INLINE sortBy #-} sortBy :: Monad m => Stream m Int -> m () @@ -494,7 +493,7 @@ sourceConcatMapId val n = {-# INLINE concatMapBySerial #-} concatMapBySerial :: Int -> Int -> Int -> IO () concatMapBySerial outer inner n = - S.drain $ S.concatMapWith S.serial + S.drain $ S.concatMapWith S.append (unfoldrM inner) (unfoldrM outer n) @@ -731,7 +730,7 @@ o_1_space_concat streamLen = -- This is for comparison with concatMapFoldableWith , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)" (S.drain - . S.concatMapWith S.serial id + . S.concatMapWith S.append id . sourceConcatMapId streamLen) , benchIOSrc1 "concatMapBy serial (n of 1)" diff --git a/benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs b/benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs index 68eeb7206..69494c112 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs @@ -33,11 +33,9 @@ import Prelude hiding import qualified Prelude as P -- import qualified Data.List as List -import qualified Streamly.Internal.Control.Concurrent as S import qualified Streamly.Internal.Data.Stream.StreamK.Type as S import qualified Streamly.Internal.Data.Stream.StreamK as S import qualified Streamly.Internal.Data.Stream.StreamD as D --- import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.Fold as Fold import Gauge (bgroup, Benchmark, defaultMain) @@ -64,7 +62,7 @@ unfoldrD streamLen n = D.toStreamK (D.unfoldr step n) else Just (cnt, cnt + 1) {-# INLINE unfoldrMD #-} -unfoldrMD :: S.MonadAsync m => Int -> Int -> Stream m Int +unfoldrMD :: Monad m => Int -> Int -> Stream m Int unfoldrMD streamLen n = D.toStreamK (D.unfoldrM step n) where step cnt = @@ -84,7 +82,7 @@ unfoldrK streamLen n = S.unfoldr step n -} {-# INLINE unfoldrMK #-} -unfoldrMK :: S.MonadAsync m => Int -> Int -> Stream m Int +unfoldrMK :: Monad m => Int -> Int -> Stream m Int unfoldrMK streamLen n = S.unfoldrMWith S.consM step n where step cnt = @@ -97,7 +95,7 @@ repeat :: Monad m => Int -> Int -> Stream m Int repeat streamLen = S.take streamLen . D.toStreamK . D.repeat {-# INLINE repeatM #-} -repeatM :: S.MonadAsync m => Int -> Int -> Stream m Int +repeatM :: Monad m => Int -> Int -> Stream m Int repeatM streamLen = S.take streamLen . D.toStreamK . D.repeatM . return {-# INLINE replicate #-} @@ -105,7 +103,7 @@ replicate :: Monad m => Int -> Int -> Stream m Int replicate x y = D.toStreamK $ D.replicate x y {-# INLINE replicateM #-} -replicateM :: S.MonadAsync m => Int -> Int -> Stream m Int +replicateM :: Monad m => Int -> Int -> Stream m Int replicateM streamLen = D.toStreamK . D.replicateM streamLen . return {-# INLINE iterate #-} @@ -113,7 +111,7 @@ iterate :: Monad m => Int -> Int -> Stream m Int iterate streamLen = S.take streamLen . D.toStreamK . D.iterate (+1) {-# INLINE iterateM #-} -iterateM :: S.MonadAsync m => Int -> Int -> Stream m Int +iterateM :: Monad m => Int -> Int -> Stream m Int iterateM streamLen = S.take streamLen . D.toStreamK . D.iterateM (return . (+1)) . return {-# INLINE fromFoldable #-} @@ -121,7 +119,7 @@ fromFoldable :: Int -> Int -> Stream m Int fromFoldable streamLen n = S.fromFoldable [n..n+streamLen] {-# INLINE fromFoldableM #-} -fromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int +fromFoldableM :: Monad m => Int -> Int -> Stream m Int fromFoldableM streamLen n = Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen]) @@ -225,7 +223,7 @@ composeN n f = {-# INLINE scanl' #-} scanl' :: Monad m => Int -> Stream m Int -> m () scanl' n = - composeN n (D.toStreamK . D.scanOnce (Fold.foldl' (+) 0) . D.fromStreamK) + composeN n (D.toStreamK . D.scan (Fold.foldl' (+) 0) . D.fromStreamK) {-# INLINE map #-} map :: Monad m => Int -> Stream m Int -> m () @@ -238,7 +236,7 @@ fmapK n = composeN n $ P.fmap (+ 1) -} {-# INLINE mapM #-} -mapM :: S.MonadAsync m => Int -> Stream m Int -> m () +mapM :: Monad m => Int -> Stream m Int -> m () mapM n = composeN n (D.toStreamK . D.mapM return . D.fromStreamK) {- @@ -620,6 +618,8 @@ filterAllInNestedList str = do moduleName :: String moduleName = "Data.Stream.ToStreamK" +-- Generation of StreamK using StreamD generation functions and eleminating +-- using StreamK drain. o_1_space_generation :: Int -> Benchmark o_1_space_generation streamLen = bgroup "generation" @@ -640,6 +640,7 @@ o_1_space_generation streamLen = , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen) ] +-- Generating using StreamK and eliminating using StreamD folds. o_1_space_elimination :: Int -> Benchmark o_1_space_elimination streamLen = bgroup "elimination" @@ -671,6 +672,8 @@ o_1_space_nested streamLen = streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop -} +-- Generate using StreamK and transform using StreamD transformation functions +-- and then drain using StreamK. o_1_space_transformation :: Int -> Benchmark o_1_space_transformation streamLen = bgroup "transformation" @@ -694,6 +697,7 @@ o_1_space_transformationX4 streamLen = -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16) ] +-- Generate using K, fold using K, concat using D.concatMap o_1_space_concat :: Int -> Benchmark o_1_space_concat streamLen = bgroup "concat" diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs b/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs index f33f522d6..789e9430f 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs @@ -26,32 +26,47 @@ module Stream.Transform (benchmarks) where -import Control.DeepSeq (NFData(..)) import Control.Monad.IO.Class (MonadIO(..)) -import Data.Functor.Identity (Identity(..)) import System.Random (randomRIO) import qualified Streamly.Internal.Data.Fold as FL -import qualified Prelude import qualified Stream.Common as Common -import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Unfold as Unfold + #ifdef USE_PRELUDE +import Control.DeepSeq (NFData(..)) +import Data.Functor.Identity (Identity(..)) +import qualified Prelude +import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Stream.IsStream as Stream import Streamly.Internal.Data.Time.Units #else +import Streamly.Internal.Data.Stream.StreamD (Stream) +import qualified Streamly.Internal.Data.Stream.StreamD as Stream +#ifndef USE_STREAMLY_CORE import qualified Streamly.Internal.Data.Stream.Time as Stream -import qualified Streamly.Internal.Data.Stream as Stream +#endif +#ifdef USE_STREAMK +import Control.DeepSeq (NFData(..)) +import Data.Functor.Identity (Identity(..)) +import qualified Prelude +import qualified Streamly.Internal.Data.Fold as Fold +import Streamly.Internal.Data.Stream.StreamK (StreamK) +import qualified Streamly.Internal.Data.Stream.StreamK as StreamK +#endif #endif import Gauge -import Streamly.Internal.Data.Stream (Stream) import Stream.Common hiding (scanl') import Streamly.Benchmark.Common import Prelude hiding (sequence, mapM) +#ifdef USE_PRELUDE +type Stream = Stream.SerialT +#endif + ------------------------------------------------------------------------------- -- Pipelines (stream-to-stream transformations) ------------------------------------------------------------------------------- @@ -64,32 +79,36 @@ import Prelude hiding (sequence, mapM) -- Traversable Instance ------------------------------------------------------------------------------- +#ifdef USE_STREAMK {-# INLINE traversableTraverse #-} -traversableTraverse :: Stream Identity Int -> IO (Stream Identity Int) +traversableTraverse :: StreamK Identity Int -> IO (StreamK Identity Int) traversableTraverse = traverse return {-# INLINE traversableSequenceA #-} -traversableSequenceA :: Stream Identity Int -> IO (Stream Identity Int) +traversableSequenceA :: StreamK Identity Int -> IO (StreamK Identity Int) traversableSequenceA = sequenceA . Prelude.fmap return {-# INLINE traversableMapM #-} -traversableMapM :: Stream Identity Int -> IO (Stream Identity Int) +traversableMapM :: StreamK Identity Int -> IO (StreamK Identity Int) traversableMapM = Prelude.mapM return {-# INLINE traversableSequence #-} -traversableSequence :: Stream Identity Int -> IO (Stream Identity Int) +traversableSequence :: StreamK Identity Int -> IO (StreamK Identity Int) traversableSequence = Prelude.sequence . Prelude.fmap return {-# INLINE benchPureSinkIO #-} benchPureSinkIO :: NFData b - => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark + => Int -> String -> (StreamK Identity Int -> IO b) -> Benchmark benchPureSinkIO value name f = - bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value + bench name + $ nfIO $ randomRIO (1, 1) >>= f . fromStream . sourceUnfoldr value -instance NFData a => NFData (Stream Identity a) where +instance NFData a => NFData (StreamK Identity a) where {-# INLINE rnf #-} - rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs + rnf xs = + runIdentity + $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) (toStream xs) o_n_space_traversable :: Int -> [Benchmark] o_n_space_traversable value = @@ -102,6 +121,7 @@ o_n_space_traversable value = , benchPureSinkIO value "sequence" traversableSequence ] ] +#endif ------------------------------------------------------------------------------- -- maps and scans @@ -166,13 +186,21 @@ timestamped :: (MonadAsync m) => Stream m Int -> m () timestamped = Stream.drain . Stream.timestamped #endif +#ifdef USE_STREAMK {-# INLINE foldrS #-} foldrS :: MonadIO m => Int -> Stream m Int -> m () -foldrS n = composeN n $ Stream.foldrS Stream.cons Stream.nil +foldrS n = + composeN n (toStream . StreamK.foldrS StreamK.cons StreamK.nil . fromStream) {-# INLINE foldrSMap #-} foldrSMap :: MonadIO m => Int -> Stream m Int -> m () -foldrSMap n = composeN n $ Stream.foldrS (\x xs -> x + 1 `Stream.cons` xs) Stream.nil +foldrSMap n = + composeN n + ( toStream + . StreamK.foldrS (\x xs -> x + 1 `StreamK.cons` xs) StreamK.nil + . fromStream + ) +#endif {- {-# INLINE foldrT #-} @@ -195,14 +223,17 @@ o_1_space_mapping value = [ bgroup "mapping" [ +#ifdef USE_STREAMK -- Right folds benchIOSink value "foldrS" (foldrS 1) , benchIOSink value "foldrSMap" (foldrSMap 1) + , +#endif -- , benchIOSink value "foldrT" (foldrT 1) -- , benchIOSink value "foldrTMap" (foldrTMap 1) -- Mapping - , benchIOSink value "map" (mapN 1) + benchIOSink value "map" (mapN 1) , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n -> sequence (sourceUnfoldrAction value n) , benchIOSink value "mapM" (mapM 1) @@ -273,6 +304,73 @@ o_1_space_functor value = ] ] +------------------------------------------------------------------------------- +-- Iteration/looping utilities +------------------------------------------------------------------------------- + +{-# INLINE iterateN #-} +iterateN :: (Int -> a -> a) -> a -> Int -> a +iterateN g initial count = f count initial + + where + + f (0 :: Int) x = x + f i x = f (i - 1) (g i x) + +#ifdef USE_STREAMK +-- Iterate a transformation over a singleton stream +{-# INLINE iterateSingleton #-} +iterateSingleton :: Applicative m => + (Int -> StreamK m Int -> StreamK m Int) + -> Int + -> Int + -> Stream m Int +iterateSingleton g count n = toStream $ iterateN g (StreamK.fromPure n) count +#else +-- Iterate a transformation over a singleton stream +{-# INLINE iterateSingleton #-} +iterateSingleton :: Applicative m => + (Int -> Stream m Int -> Stream m Int) + -> Int + -> Int + -> Stream m Int +iterateSingleton g count n = iterateN g (Stream.fromPure n) count +#endif + +{- +-- XXX need to check why this is slower than the explicit recursion above, even +-- if the above code is written in a foldr like head recursive way. We also +-- need to try this with foldlM' once #150 is fixed. +-- However, it is perhaps best to keep the iteration benchmarks independent of +-- foldrM and any related fusion issues. +{-# INLINE _iterateSingleton #-} +_iterateSingleton :: + Monad m + => (Int -> Stream m Int -> Stream m Int) + -> Int + -> Int + -> Stream m Int +_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n +-} + +o_n_space_iterated :: Int -> [Benchmark] +o_n_space_iterated value = + [ bgroup "iterated" + [ benchIO "(+) (n times) (baseline)" $ \i0 -> + iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value + , benchIOSrc "(<$) (n times)" $ + iterateSingleton (<$) value + , benchIOSrc "fmap (n times)" $ + iterateSingleton (fmap . (+)) value + {- + , benchIOSrc fromSerial "_(<$) (n times)" $ + _iterateSingleton (<$) value + , benchIOSrc fromSerial "_fmap (n times)" $ + _iterateSingleton (fmap . (+)) value + -} + ] + ] + ------------------------------------------------------------------------------- -- Size reducing transformations (filtering) ------------------------------------------------------------------------------- @@ -317,6 +415,7 @@ takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1)) takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m () takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1))) +#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE) {-# INLINE takeInterval #-} takeInterval :: Double -> Int -> Stream IO Int -> IO () takeInterval i n = composeN n (Stream.takeInterval i) @@ -329,6 +428,18 @@ takeInterval i n = composeN n (Stream.takeInterval i) -- inspect $ 'takeInterval `hasNoType` ''D.Step #endif +{-# INLINE dropInterval #-} +dropInterval :: Double -> Int -> Stream IO Int -> IO () +dropInterval i n = composeN n (Stream.dropInterval i) + +-- Inspection testing is disabled for dropInterval +-- Enable it when looking at it throughly +#ifdef INSPECTION +-- inspect $ hasNoTypeClasses 'dropInterval +-- inspect $ 'dropInterval `hasNoType` ''D.Step +#endif +#endif + {-# INLINE dropOne #-} dropOne :: MonadIO m => Int -> Stream m Int -> m () dropOne n = composeN n $ Stream.drop 1 @@ -356,17 +467,6 @@ _intervalsOfSum :: MonadAsync m => Double -> Int -> Stream m Int -> m () _intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum) #endif -{-# INLINE dropInterval #-} -dropInterval :: Double -> Int -> Stream IO Int -> IO () -dropInterval i n = composeN n (Stream.dropInterval i) - --- Inspection testing is disabled for dropInterval --- Enable it when looking at it throughly -#ifdef INSPECTION --- inspect $ hasNoTypeClasses 'dropInterval --- inspect $ 'dropInterval `hasNoType` ''D.Step -#endif - {-# INLINE findIndices #-} findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m () findIndices value n = composeN n $ Stream.findIndices (== (value + 1)) @@ -421,8 +521,10 @@ o_1_space_filtering value = -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1) , benchIOSink value "drop-one" (dropOne 1) , benchIOSink value "drop-all" (dropAll value 1) +#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE) , benchIOSink value "takeInterval-all" (takeInterval 10000 1) , benchIOSink value "dropInterval-all" (dropInterval 10000 1) +#endif , benchIOSink value "dropWhile-true" (dropWhileTrue value 1) -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1) , benchIOSink @@ -574,7 +676,12 @@ benchmarks moduleName size = , o_1_space_indexingX4 size ] , bgroup (o_n_space_prefix moduleName) $ Prelude.concat - [ o_n_space_traversable size - , o_n_space_mapping size + [ +#ifdef USE_STREAMK + o_n_space_traversable size + , +#endif + o_n_space_mapping size + , o_n_space_iterated size ] ] diff --git a/benchmark/Streamly/Benchmark/Data/Unfold.hs b/benchmark/Streamly/Benchmark/Data/Unfold.hs index 8b26e2b05..1f7f216d3 100644 --- a/benchmark/Streamly/Benchmark/Data/Unfold.hs +++ b/benchmark/Streamly/Benchmark/Data/Unfold.hs @@ -32,11 +32,10 @@ import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Unfold as UF import qualified Streamly.Internal.Data.Unfold.Exception as UF -import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream.StreamD as S import qualified Streamly.Internal.Data.Stream.StreamD as D import qualified Streamly.Internal.Data.Stream.StreamK as K - import Gauge hiding (env) import Prelude hiding (take, filter, zipWith, map, mapM, takeWhile) import Streamly.Benchmark.Common diff --git a/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs b/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs index 52841e2fd..6942174f4 100644 --- a/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs +++ b/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs @@ -29,14 +29,16 @@ import GHC.Magic (inline) import GHC.Magic (noinline) import System.IO (Handle) +import qualified Streamly.Data.Stream as Stream +import qualified Streamly.Data.Fold as Fold import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.Array.Type as AT import qualified Streamly.Internal.Data.Fold as FL -import qualified Streamly.Internal.Data.Stream.IsStream as IP +import qualified Streamly.Internal.Data.Stream.StreamD as IP import qualified Streamly.Internal.FileSystem.Handle as IFH import qualified Streamly.Internal.Unicode.Stream as IUS -import qualified Streamly.Prelude as S +import qualified Streamly.Data.Stream.Prelude as S import qualified Streamly.Unicode.Stream as SS import Gauge hiding (env) @@ -61,7 +63,7 @@ import Test.Inspection -- | Get the last byte from a file bytestream. readLast :: Handle -> IO (Maybe Word8) -readLast = S.last . S.unfold FH.reader +readLast = S.fold Fold.last . S.unfold FH.reader #ifdef INSPECTION inspect $ hasNoTypeClasses 'readLast @@ -73,7 +75,7 @@ inspect $ 'readLast `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read -- assert that flattenArrays constructors are not present -- | Count the number of bytes in a file. readCountBytes :: Handle -> IO Int -readCountBytes = S.length . S.unfold FH.reader +readCountBytes = S.fold Fold.length . S.unfold FH.reader #ifdef INSPECTION inspect $ hasNoTypeClasses 'readCountBytes @@ -85,7 +87,7 @@ inspect $ 'readCountBytes `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read -- | Count the number of lines in a file. readCountLines :: Handle -> IO Int readCountLines = - S.length + S.fold Fold.length . IUS.lines FL.drain . SS.decodeLatin1 . S.unfold FH.reader @@ -100,7 +102,7 @@ inspect $ 'readCountLines `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read -- | Count the number of words in a file. readCountWords :: Handle -> IO Int readCountWords = - S.length + S.fold Fold.length . IUS.words FL.drain . SS.decodeLatin1 . S.unfold FH.reader @@ -112,7 +114,7 @@ inspect $ hasNoTypeClasses 'readCountWords -- | Sum the bytes in a file. readSumBytes :: Handle -> IO Word8 -readSumBytes = S.sum . S.unfold FH.reader +readSumBytes = S.fold Fold.sum . S.unfold FH.reader #ifdef INSPECTION inspect $ hasNoTypeClasses 'readSumBytes @@ -132,19 +134,19 @@ inspect $ 'readSumBytes `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read -- fusion-plugin to propagate INLINE phase information such that this problem -- does not occur. readDrain :: Handle -> IO () -readDrain inh = S.drain $ S.unfold FH.reader inh +readDrain inh = S.fold Fold.drain $ S.unfold FH.reader inh -- XXX investigate why we need an INLINE in this case (GHC) {-# INLINE readDecodeLatin1 #-} readDecodeLatin1 :: Handle -> IO () readDecodeLatin1 inh = - S.drain + S.fold Fold.drain $ SS.decodeLatin1 $ S.unfold FH.reader inh readDecodeUtf8 :: Handle -> IO () readDecodeUtf8 inh = - S.drain + S.fold Fold.drain $ SS.decodeUtf8 $ S.unfold FH.reader inh @@ -187,7 +189,7 @@ o_1_space_reduce_read env = -- | Count the number of lines in a file. getChunksConcatUnfoldCountLines :: Handle -> IO Int getChunksConcatUnfoldCountLines inh = - S.length + S.fold Fold.length $ IUS.lines FL.drain $ SS.decodeLatin1 -- XXX replace with toBytes @@ -212,15 +214,18 @@ o_1_space_reduce_toBytes env = ------------------------------------------------------------------------------- chunksOfSum :: Int -> Handle -> IO Int -chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.reader inh) +chunksOfSum n inh = + S.fold Fold.length $ IP.chunksOf n FL.sum (S.unfold FH.reader inh) foldManyPostChunksOfSum :: Int -> Handle -> IO Int foldManyPostChunksOfSum n inh = - S.length $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.reader inh) + S.fold Fold.length + $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.reader inh) foldManyChunksOfSum :: Int -> Handle -> IO Int foldManyChunksOfSum n inh = - S.length $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.reader inh) + S.fold Fold.length + $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.reader inh) -- XXX investigate why we need an INLINE in this case (GHC) -- Even though allocations remain the same in both cases inlining improves time @@ -230,7 +235,8 @@ foldManyChunksOfSum n inh = chunksOf :: Int -> Handle -> IO Int chunksOf n inh = -- writeNUnsafe gives 2.5x boost here over writeN. - S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.reader inh) + S.fold Fold.length + $ IP.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.reader inh) #ifdef INSPECTION inspect $ hasNoTypeClasses 'chunksOf @@ -243,7 +249,8 @@ inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many {-# INLINE arraysOf #-} arraysOf :: Int -> Handle -> IO Int -arraysOf n inh = S.length $ IP.arraysOf n (S.unfold FH.reader inh) +arraysOf n inh = + S.fold Fold.length $ Stream.arraysOf n (S.unfold FH.reader inh) o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark] o_1_space_reduce_read_grouped env = diff --git a/benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs b/benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs index 6230dc1b7..7fb97a4ab 100644 --- a/benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs +++ b/benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs @@ -32,7 +32,7 @@ import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.Data.Unfold as IUF import qualified Streamly.Internal.FileSystem.Handle as IFH import qualified Streamly.Data.Array as A -import qualified Streamly.Prelude as S +import qualified Streamly.Data.Stream.Prelude as S import Gauge hiding (env) import Streamly.Benchmark.Common.Handle diff --git a/benchmark/Streamly/Benchmark/Unicode/Char.hs b/benchmark/Streamly/Benchmark/Unicode/Char.hs index fea8724d3..c362f7743 100644 --- a/benchmark/Streamly/Benchmark/Unicode/Char.hs +++ b/benchmark/Streamly/Benchmark/Unicode/Char.hs @@ -24,7 +24,7 @@ import Streamly.Internal.Unicode.Char import Streamly.Benchmark.Common (o_1_space_prefix) import qualified Streamly.Internal.Data.Array as Array -import qualified Streamly.Internal.Data.Stream.IsStream as IsStream +import qualified Streamly.Internal.Data.Stream.StreamD as IsStream import qualified System.Directory as Dir -------------------------------------------------------------------------------- diff --git a/benchmark/Streamly/Benchmark/Unicode/Stream.hs b/benchmark/Streamly/Benchmark/Unicode/Stream.hs index b162a3eca..011213dcd 100644 --- a/benchmark/Streamly/Benchmark/Unicode/Stream.hs +++ b/benchmark/Streamly/Benchmark/Unicode/Stream.hs @@ -20,12 +20,14 @@ {-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} #endif +import Streamly.Data.Stream (Stream) +import Streamly.Data.Fold (Fold) import Prelude hiding (last, length) import System.IO (Handle) import qualified Streamly.Data.Array as Array import qualified Streamly.Data.Fold as Fold -import qualified Streamly.Internal.Data.Stream.IsStream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.FileSystem.Handle as Handle import qualified Streamly.Internal.Unicode.Array as UnicodeArr @@ -75,13 +77,19 @@ o_1_space_decode_encode_chunked env = -- copy with group/ungroup transformations ------------------------------------------------------------------------------- +{-# INLINE splitOnSuffix #-} +splitOnSuffix + :: (Monad m) + => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b +splitOnSuffix predicate f = Stream.foldMany (Fold.takeEndBy_ predicate f) + {-# NOINLINE linesUnlinesCopy #-} linesUnlinesCopy :: Handle -> Handle -> IO () linesUnlinesCopy inh outh = Stream.fold (Handle.write outh) $ Unicode.encodeLatin1' $ Unicode.unlines Unfold.fromList - $ Stream.splitOnSuffix (== '\n') Fold.toList + $ splitOnSuffix (== '\n') Fold.toList $ Unicode.decodeLatin1 $ Stream.unfold Handle.reader inh @@ -90,7 +98,7 @@ linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO () linesUnlinesArrayWord8Copy inh outh = Stream.fold (Handle.write outh) $ Stream.interposeSuffix 10 Array.reader - $ Stream.splitOnSuffix (== 10) Array.write + $ splitOnSuffix (== 10) Array.write $ Stream.unfold Handle.reader inh -- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion @@ -280,7 +288,7 @@ _copyStreamUtf8Parser :: Handle -> Handle -> IO () _copyStreamUtf8Parser inh outh = Stream.fold (Handle.write outh) $ Unicode.encodeUtf8 - $ Stream.rights $ Stream.parseMany + $ Stream.catRights $ Stream.parseMany (Unicode.parseCharUtf8With Unicode.TransliterateCodingFailure) $ Stream.unfold Handle.reader inh diff --git a/benchmark/bench-runner/Main.hs b/benchmark/bench-runner/Main.hs index d8a672d5f..f90c32894 100644 --- a/benchmark/bench-runner/Main.hs +++ b/benchmark/bench-runner/Main.hs @@ -14,20 +14,19 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific] -- Drop All. benchName = drop 4 benchName0 + general | "o-1-sp" `isInfixOf` benchName = "-K36K -M16M" | "o-n-h" `isInfixOf` benchName = "-K36K -M32M" | "o-n-st" `isInfixOf` benchName = "-K1M -M16M" | "o-n-sp" `isInfixOf` benchName = "-K1M -M32M" | otherwise = "" + exeSpecific | "Prelude.Concurrent" `isSuffixOf` exeName = "-K512K -M384M" | otherwise = "" + benchSpecific - | "Data.Stream.StreamD/o-n-space.elimination.toList" == benchName = - "-K2M" - | "Data.Stream.StreamK/o-n-space.elimination.toList" == benchName = - "-K2M" | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName = "-M256M" | "Prelude.Parallel/o-n-heap.monad-outer-product." `isPrefixOf` benchName = "-M256M" @@ -35,25 +34,6 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific] `isPrefixOf` benchName = "-K2M -M256M" | "Prelude.Rate/o-1-space." `isPrefixOf` benchName = "-K128K" | "Prelude.Rate/o-1-space.asyncly." `isPrefixOf` benchName = "-K128K" - | "Data.Stream/o-1-space.mixed.sum-product-fold" == benchName = - "-K64M" - | "Data.Stream/o-n-heap.grouping.classifySessionsOf" - `isPrefixOf` benchName = "-K1M -M32M" - | "Data.Stream/o-n-heap.Functor." `isPrefixOf` benchName = - "-K4M -M32M" - | "Data.Stream/o-n-heap.transformer." `isPrefixOf` benchName = - "-K8M -M64M" - | "Data.Stream/o-n-space.Functor." `isPrefixOf` benchName = - "-K4M -M64M" - | "Data.Stream/o-n-space.Applicative." `isPrefixOf` benchName = - "-K8M -M128M" - | "Data.Stream/o-n-space.Monad." `isPrefixOf` benchName = - "-K8M -M64M" - | "Data.Stream/o-n-space.grouping." `isPrefixOf` benchName = "" - | "Data.Stream/o-n-space." `isPrefixOf` benchName = "-K4M" - | "Data.Stream.ConcurrentInterleaved/o-1-space.monad-outer-product.toNullAp" `isPrefixOf` benchName = "-M32M" - | "Data.Stream.ConcurrentEager/o-1-space.monad-outer-product.toNullAp" `isPrefixOf` benchName = "-M2048M -K4M" - | "Data.Stream.ConcurrentEager/o-1-space." `isPrefixOf` benchName = "-M512M -K4M" | "Prelude.WSerial/o-n-space." `isPrefixOf` benchName = "-K4M" | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName = "-K4M" @@ -66,27 +46,53 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific] "-M64M" | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName = "-K4M" - | "Data.Parser.ParserD/o-1-space.some" == benchName = "-K8M" - | "Data.Parser/o-1-space.some" == benchName = "-K8M" - | "Data.Parser.ParserD/o-1-space.manyTill" == benchName = "-K4M" - | "Data.Parser/o-1-space.manyTill" == benchName = "-K4M" - | "Data.Parser/o-n-heap.manyAlt" == benchName = "-K4M -M128M" - | "Data.Parser/o-n-heap.someAlt" == benchName = "-K4M -M128M" - | "Data.Parser/o-n-heap.choice" == benchName = "-K16M -M32M" - | "Data.Parser.ParserK/o-n-heap.manyAlt" == benchName = "-K4M -M128M" - | "Data.Parser.ParserK/o-n-heap.someAlt" == benchName = "-K4M -M128M" - | "Data.Parser.ParserK/o-n-heap.sequence" == benchName = "-M64M" - | "Data.Parser.ParserK/o-n-heap.sequenceA" == benchName = "-M64M" + + ----------------------------------------------------------------------- + + | "Data.Stream.StreamD/o-n-space.elimination.toList" == benchName = + "-K2M" + | "Data.Stream.StreamK/o-n-space.elimination.toList" == benchName = + "-K2M" + + ----------------------------------------------------------------------- + + | "Data.Stream/o-1-space.grouping.classifySessionsOf" + `isPrefixOf` benchName = "-K512K" + | "Data.Stream/o-n-space.foldr.foldrM/" + `isPrefixOf` benchName = "-K4M" + | "Data.Stream/o-n-space.iterated." + `isPrefixOf` benchName = "-K4M" + + | "Data.Stream.StreamDK/o-1-space.grouping.classifySessionsOf" + `isPrefixOf` benchName = "-K512K" + | "Data.Stream.StreamDK/o-n-space.foldr.foldrM/" + `isPrefixOf` benchName = "-K4M" + | "Data.Stream.StreamDK/o-n-space.iterated." + `isPrefixOf` benchName = "-K4M -M64M" + | "Data.Stream.StreamDK/o-n-space.traversable." + `isPrefixOf` benchName = "-K2M" + + | "Data.Stream.ConcurrentInterleaved/o-1-space.monad-outer-product.toNullAp" + `isPrefixOf` benchName = "-M32M" + + | "Data.Stream.ConcurrentEager/o-1-space.monad-outer-product.toNullAp" + `isPrefixOf` benchName = "-M512M" + | "Data.Stream.ConcurrentEager/o-1-space." + `isPrefixOf` benchName = "-M128M" + + ---------------------------------------------------------------------- + | "Data.Array" `isPrefixOf` benchName && "/o-1-space.generation.read" `isSuffixOf` benchName = "-M32M" | "Data.Array" `isPrefixOf` benchName && "/o-1-space.generation.show" `isSuffixOf` benchName = "-M32M" - | "Data.Array.Generic/o-1-space.transformationX4.map" == benchName = "-M32M" - | "Data.Array/o-1-space.elimination.foldable.foldl" - `isPrefixOf` benchName = "-K8M" - | "Data.Array/o-1-space.elimination.foldable.sum" == benchName = - "-K8M" + | "Data.Array.Generic/o-1-space.transformationX4.map" + `isPrefixOf` benchName = "-M32M" + + ----------------------------------------------------------------------- + | "Unicode.Char/o-1-space." `isPrefixOf` benchName = "-M32M" + | otherwise = "" speedOpts :: String -> String -> Maybe Quickness diff --git a/benchmark/lib/Streamly/Benchmark/Common.hs b/benchmark/lib/Streamly/Benchmark/Common.hs index 3225d8a8e..7ab161cd7 100644 --- a/benchmark/lib/Streamly/Benchmark/Common.hs +++ b/benchmark/lib/Streamly/Benchmark/Common.hs @@ -54,7 +54,7 @@ import Data.Functor.Identity (Identity, runIdentity) import System.Random (randomRIO) import qualified Streamly.Internal.Data.Fold as Fold -import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream.StreamD as S import Gauge diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 4bab46f1e..058342366 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -73,15 +73,49 @@ flag use-prelude -- Common stanzas ------------------------------------------------------------------------------- +common default-extensions + default-extensions: + BangPatterns + CApiFFI + CPP + ConstraintKinds + DeriveDataTypeable + DeriveGeneric + DeriveTraversable + ExistentialQuantification + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + InstanceSigs + KindSignatures + LambdaCase + MagicHash + MultiParamTypeClasses + PatternSynonyms + RankNTypes + RecordWildCards + ScopedTypeVariables + TupleSections + TypeApplications + TypeFamilies + TypeOperators + ViewPatterns + + -- MonoLocalBinds, enabled by TypeFamilies, causes performance + -- regressions. Disable it. This must come after TypeFamilies, + -- otherwise TypeFamilies will enable it again. + NoMonoLocalBinds + + -- UndecidableInstances -- Does not show any perf impact + -- UnboxedTuples -- interferes with (#.) + common compile-options + import: default-extensions default-language: Haskell2010 if flag(use-streamly-core) cpp-options: -DUSE_STREAMLY_CORE - if flag(use-prelude) - cpp-options: -DUSE_PRELUDE - if flag(dev) cpp-options: -DDEVBUILD @@ -191,7 +225,7 @@ library hs-source-dirs: lib exposed-modules: Streamly.Benchmark.Common , Streamly.Benchmark.Common.Handle - if !flag(use-streamly-core) + if flag(use-prelude) exposed-modules: Streamly.Benchmark.Prelude @@ -232,12 +266,37 @@ benchmark Data.Stream Stream.Transform Stream.Reduce Stream.Expand - Stream.Exceptions Stream.Lift Stream.Common - if flag(use-prelude) + if !flag(use-streamly-core) other-modules: - Stream.Split + Stream.Exceptions + if flag(limit-build-mem) + if flag(dev) + ghc-options: +RTS -M3500M -RTS + else + ghc-options: +RTS -M2500M -RTS + +benchmark Data.Stream.StreamDK + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Data + main-is: Stream.hs + other-modules: + Stream.Generate + Stream.Eliminate + Stream.Transform + Stream.Reduce + Stream.Expand + Stream.Lift + Stream.Common + if !flag(use-streamly-core) + other-modules: + Stream.Exceptions + -- Cannot use USE_STREAMK and USE_PRELUDE together + if flag(use-prelude) + buildable: False + cpp-options: -DUSE_STREAMK if flag(limit-build-mem) if flag(dev) ghc-options: +RTS -M3500M -RTS @@ -296,92 +355,6 @@ benchmark Data.Stream.ConcurrentOrdered else buildable: True -benchmark Prelude.WSerial - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Prelude - main-is: WSerial.hs - if flag(use-streamly-core) || impl(ghcjs) - buildable: False - else - buildable: True - if flag(limit-build-mem) - ghc-options: +RTS -M750M -RTS - -benchmark Prelude.Merge - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Prelude - main-is: Merge.hs - if flag(use-streamly-core) || impl(ghcjs) - buildable: False - else - buildable: True - -benchmark Prelude.ZipSerial - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Prelude - main-is: ZipSerial.hs - if flag(use-streamly-core) || impl(ghcjs) - buildable: False - else - buildable: True - -benchmark Prelude.ZipAsync - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Prelude - main-is: ZipAsync.hs - if flag(use-streamly-core) || impl(ghcjs) - buildable: False - else - buildable: True - if flag(limit-build-mem) - ghc-options: +RTS -M1000M -RTS - -benchmark Prelude.Ahead - import: bench-options-threaded - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Prelude - main-is: Ahead.hs - if flag(use-streamly-core) || impl(ghcjs) - buildable: False - else - buildable: True - -benchmark Prelude.Async - import: bench-options-threaded - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Prelude - main-is: Async.hs - if flag(use-streamly-core) || impl(ghcjs) - buildable: False - else - buildable: True - -benchmark Prelude.WAsync - import: bench-options-threaded - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Prelude - main-is: WAsync.hs - if flag(use-streamly-core) || impl(ghcjs) - buildable: False - else - buildable: True - -benchmark Prelude.Parallel - import: bench-options-threaded - type: exitcode-stdio-1.0 - hs-source-dirs: Streamly/Benchmark/Prelude - main-is: Parallel.hs - if flag(use-streamly-core) || impl(ghcjs) - buildable: False - else - buildable: True - if flag(limit-build-mem) - ghc-options: +RTS -M2000M -RTS - benchmark Data.Unfold import: bench-options @@ -483,8 +456,6 @@ benchmark Data.Stream.StreamD main-is: StreamD.hs if impl(ghcjs) buildable: False - else - buildable: True benchmark Data.Stream.StreamK import: bench-options @@ -493,20 +464,16 @@ benchmark Data.Stream.StreamK main-is: StreamK.hs if impl(ghcjs) buildable: False - else - buildable: True benchmark Data.Stream.ToStreamK import: bench-options type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Data/Stream main-is: ToStreamK.hs - if impl(ghcjs) + if !flag(dev) || impl(ghcjs) buildable: False - else - buildable: True -benchmark Data.Stream.StreamDK +benchmark Data.Stream.StreamK.Alt import: bench-options type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Data/Stream @@ -518,11 +485,115 @@ executable nano-bench import: bench-options hs-source-dirs: . main-is: NanoBenchmarks.hs - if flag(dev) - buildable: True - else + if !flag(dev) buildable: False +------------------------------------------------------------------------------- +-- Streamly.Prelude +------------------------------------------------------------------------------- + +benchmark Prelude + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Data + main-is: Stream.hs + other-modules: + Stream.Generate + Stream.Eliminate + Stream.Transform + Stream.Reduce + Stream.Expand + Stream.Lift + Stream.Common + Stream.Split + Stream.Exceptions + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) + buildable: False + if flag(limit-build-mem) + if flag(dev) + ghc-options: +RTS -M3500M -RTS + else + ghc-options: +RTS -M2500M -RTS + +benchmark Prelude.WSerial + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Prelude + main-is: WSerial.hs + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) + buildable: False + if flag(limit-build-mem) + ghc-options: +RTS -M750M -RTS + +benchmark Prelude.Merge + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Prelude + main-is: Merge.hs + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) + buildable: False + +benchmark Prelude.ZipSerial + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Prelude + main-is: ZipSerial.hs + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) + buildable: False + +benchmark Prelude.ZipAsync + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Prelude + main-is: ZipAsync.hs + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) + buildable: False + if flag(limit-build-mem) + ghc-options: +RTS -M1000M -RTS + +benchmark Prelude.Ahead + import: bench-options-threaded + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Prelude + main-is: Ahead.hs + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) + buildable: False + +benchmark Prelude.Async + import: bench-options-threaded + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Prelude + main-is: Async.hs + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) + buildable: False + +benchmark Prelude.WAsync + import: bench-options-threaded + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Prelude + main-is: WAsync.hs + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) + buildable: False + +benchmark Prelude.Parallel + import: bench-options-threaded + type: exitcode-stdio-1.0 + hs-source-dirs: Streamly/Benchmark/Prelude + main-is: Parallel.hs + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) + buildable: False + if flag(limit-build-mem) + ghc-options: +RTS -M2000M -RTS + ------------------------------------------------------------------------------- -- Concurrent Streams ------------------------------------------------------------------------------- @@ -532,30 +603,27 @@ benchmark Prelude.Concurrent type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Prelude main-is: Concurrent.hs - if flag(use-streamly-core) + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) buildable: False - else - buildable: True benchmark Prelude.Adaptive import: bench-options-threaded type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Prelude main-is: Adaptive.hs - if flag(use-streamly-core) || impl(ghcjs) + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) buildable: False - else - buildable: True benchmark Prelude.Rate import: bench-options-threaded type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Prelude main-is: Rate.hs - if flag(use-streamly-core) || impl(ghcjs) + cpp-options: -DUSE_PRELUDE + if !flag(use-prelude) buildable: False - else - buildable: True ------------------------------------------------------------------------------- -- Array Benchmarks @@ -564,8 +632,10 @@ benchmark Prelude.Rate benchmark Data.Array.Generic import: bench-options type: exitcode-stdio-1.0 - hs-source-dirs: . + hs-source-dirs: ., Streamly/Benchmark/Data main-is: Streamly/Benchmark/Data/Array/Generic.hs + other-modules: + Stream.Common if flag(use-streamly-core) buildable: False else @@ -585,7 +655,10 @@ benchmark Data.SmallArray benchmark Data.Array import: bench-options type: exitcode-stdio-1.0 + hs-source-dirs: ., Streamly/Benchmark/Data main-is: Streamly/Benchmark/Data/Array.hs + other-modules: + Stream.Common if flag(use-streamly-core) buildable: False else diff --git a/cabal.project.doctest b/cabal.project.doctest index faef5dac6..abe5f8cab 100644 --- a/cabal.project.doctest +++ b/cabal.project.doctest @@ -1,6 +1,6 @@ packages: streamly.cabal , core/streamly-core.cabal - , docs/streamly-docs.cabal + -- , docs/streamly-docs.cabal -- for QuickCheck in property doctests , test/streamly-tests.cabal diff --git a/core/src/Streamly/Data/Stream.hs b/core/src/Streamly/Data/Stream.hs index 5ec29897f..357423d77 100644 --- a/core/src/Streamly/Data/Stream.hs +++ b/core/src/Streamly/Data/Stream.hs @@ -25,24 +25,6 @@ -- allows high performance combinatorial programming even when using byte level -- streams. Streamly API is similar to Haskell lists. -- --- Streams can be constructed like lists, except that they use 'nil' instead of --- '[]' and 'cons' instead of ':'. --- --- `cons` adds a pure value at the head of the stream: --- --- >>> import Streamly.Data.Stream (Stream, cons, consM, nil) --- >>> stream = 1 `cons` 2 `cons` nil :: Stream IO Int --- >>> Stream.fold Fold.toList stream -- IO [Int] --- [1,2] --- --- `consM` adds an effect at the head of the stream: --- --- >>> stream = effect 1 `consM` effect 2 `consM` nil --- >>> Stream.fold Fold.toList stream --- 1 --- 2 --- [1,2] --- -- == Console Echo Example -- -- In the following example, 'repeatM' generates an infinite stream of 'String' @@ -69,25 +51,40 @@ -- "Data.List" like functions and many more powerful combinators to perform -- common programming tasks. -- +-- == Performance Notes +-- +-- The 'Stream' type represents a stream by composing state as data which +-- enables stream fusion. Stream fusion generates a tight loop without any +-- constructor allocations between the stages, providing C like performance for +-- the loop. Stream fusion works when multiple functions are combined in a +-- pipeline statically. Therefore, the operations in this module must be +-- inlined and must not be used recursively to allow for stream fusion. +-- +-- Using the 'Stream' type binary stream construction operations like 'cons', +-- 'append' etc. degrade quadratically (O(n^2)) when combined many times. If +-- you need to combine these operations, say more than 50 times in a single +-- loop, then you should use the continuation style stream type 'StreamK' +-- instead. Also, if you need to use these operations in a recursive loop you +-- should use 'StreamK' instead. +-- +-- The 'StreamK' type represents a stream by composing function calls, +-- therefore, a function call overhead is incurred at each composition. It is +-- quite fast in general but may be a few times slower than a fused stream. +-- However, it allows for scalable dynamic composition and control flow +-- manipulation. Using the 'StreamK' type binary operations like 'cons' and +-- 'append' provide linear (O(n)) performance. +-- +-- 'Stream' and 'StreamK' types can be interconverted. +-- -- == Useful Idioms -- -- >>> fromListM = Stream.sequence . Stream.fromList --- >>> fromFoldableM = Stream.sequence . Stream.fromFoldable -- >>> fromIndices f = fmap f $ Stream.enumerateFrom 0 -- -- Also see "Streamly.Internal.Data.Stream" module for many more @Pre-release@ -- combinators. See the -- repository for many more real world examples of stream programming. -- --- == Performance Notes --- --- Operations annotated as /CPS/ force the use of continuation passing style --- streams. Therefore, such operations are not subjected to stream fusion. --- However, for some of these operations you can find fusible alternatives in --- the internal modules, which are perfectly fine to use but you need to --- understand the implications especially the O(n^2) nature of those --- operations.. --- module Streamly.Data.Stream ( Stream @@ -107,8 +104,6 @@ module Streamly.Data.Stream , nilM , cons , consM - -- , cons2 -- fused version - -- , consM2 -- fused version -- ** Unfolding -- | 'unfoldrM' is the most general way of generating a stream efficiently. @@ -152,7 +147,6 @@ module Streamly.Data.Stream -- | Convert an input structure, container or source into a stream. All of -- these can be expressed in terms of primitives. , fromList - , fromFoldable -- ** From Unfolds -- | Most of the above stream generation operations can also be expressed @@ -366,28 +360,31 @@ module Streamly.Data.Stream , append -- ** Interleaving + -- | When interleaving more than two streams you may want to interleave + -- them pairwise creating a balanced binary merge tree. , interleave - -- , interleave2 -- ** Merging - -- | Merging of @n@ streams can be performed by combining the streams pair + -- | When merging more than two streams you may want to merging them + -- pairwise creating a balanced binary merge tree. + -- + -- Merging of @n@ streams can be performed by combining the streams pair -- wise using 'mergeMapWith' to give O(n * log n) time complexity. If used -- with 'concatMapWith' it will have O(n^2) performance. , mergeBy , mergeByM - -- , mergeBy2 - -- , mergeByM2 -- ** Zipping - -- | Zipping of @n@ streams can be performed by combining the streams pair + -- | When zipping more than two streams you may want to zip them + -- pairwise creating a balanced binary tree. + -- + -- Zipping of @n@ streams can be performed by combining the streams pair -- wise using 'mergeMapWith' with O(n * log n) time complexity. If used -- with 'concatMapWith' it will have O(n^2) performance. , zipWith , zipWithM - -- , zipWith2 - -- , zipWithM2 - , ZipStream (..) + -- , ZipStream (..) -- ** Cross Product -- XXX The argument order in this operation is such that it seems we are @@ -399,7 +396,7 @@ module Streamly.Data.Stream , crossWith -- , cross -- , joinInner - , CrossStream (..) + -- , CrossStream (..) -- * Unfold Each , unfoldMany @@ -428,21 +425,18 @@ module Streamly.Data.Stream -- , concatEffect - , concatMapWith , concatMap , concatMapM - , mergeMapWith -- * Repeated Fold , foldMany -- XXX Rename to foldRepeat , parseMany - , arraysOf + , Array.arraysOf -- * Buffered Operations -- | Operations that require buffering of the stream. -- Reverse is essentially a left fold followed by an unfold. , reverse - , sortBy -- * Multi-Stream folds -- | Operations that consume multiple streams at the same time. @@ -496,7 +490,8 @@ module Streamly.Data.Stream ) where -import Streamly.Internal.Data.Stream +import qualified Streamly.Internal.Data.Array.Type as Array +import Streamly.Internal.Data.Stream.StreamD import Prelude hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr, foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem, diff --git a/core/src/Streamly/Data/Stream/StreamDK.hs b/core/src/Streamly/Data/Stream/StreamDK.hs new file mode 100644 index 000000000..7626ea094 --- /dev/null +++ b/core/src/Streamly/Data/Stream/StreamDK.hs @@ -0,0 +1,505 @@ +-- | +-- Module : Streamly.Data.Stream.StreamDK +-- Copyright : (c) 2017 Composewell Technologies +-- +-- License : BSD3 +-- Maintainer : streamly@composewell.com +-- Stability : released +-- Portability : GHC +-- +-- To run examples in this module: +-- +-- >>> import qualified Streamly.Data.Fold as Fold +-- >>> import qualified Streamly.Data.Stream.StreamDK as Stream +-- +-- We will add some more imports in the examples as needed. +-- +-- For effectful streams we will use the following IO action: +-- +-- >>> effect n = print n >> return n +-- +-- = Overview +-- +-- Streamly is a framework for modular data flow based programming and +-- declarative concurrency. Powerful stream fusion framework in streamly +-- allows high performance combinatorial programming even when using byte level +-- streams. Streamly API is similar to Haskell lists. +-- +-- Streams can be constructed like lists, except that they use 'nil' instead of +-- '[]' and 'cons' instead of ':'. +-- +-- `cons` adds a pure value at the head of the stream: +-- +-- >>> import Streamly.Data.Stream.StreamDK (Stream, cons, consM, nil) +-- >>> stream = 1 `cons` 2 `cons` nil :: Stream IO Int +-- >>> Stream.fold Fold.toList stream -- IO [Int] +-- [1,2] +-- +-- `consM` adds an effect at the head of the stream: +-- +-- >>> stream = effect 1 `consM` effect 2 `consM` nil +-- >>> Stream.fold Fold.toList stream +-- 1 +-- 2 +-- [1,2] +-- +-- == Console Echo Example +-- +-- In the following example, 'repeatM' generates an infinite stream of 'String' +-- by repeatedly performing the 'getLine' IO action. 'mapM' then applies +-- 'putStrLn' on each element in the stream converting it to stream of '()'. +-- Finally, 'drain' folds the stream to IO discarding the () values, thus +-- producing only effects. +-- +-- >>> import Data.Function ((&)) +-- +-- >>> :{ +-- echo = +-- Stream.repeatM getLine -- Stream IO String +-- & Stream.mapM putStrLn -- Stream IO () +-- & Stream.fold Fold.drain -- IO () +-- :} +-- +-- This is a console echo program. It is an example of a declarative loop +-- written using streaming combinators. Compare it with an imperative @while@ +-- loop. +-- +-- Hopefully, this gives you an idea how we can program declaratively by +-- representing loops using streams. In this module, you can find all +-- "Data.List" like functions and many more powerful combinators to perform +-- common programming tasks. +-- +-- == Useful Idioms +-- +-- >>> fromListM = Stream.sequence . Stream.fromList +-- >>> fromFoldableM = Stream.sequence . Stream.fromFoldable +-- >>> fromIndices f = fmap f $ Stream.enumerateFrom 0 +-- +-- Also see "Streamly.Internal.Data.Stream.StreamDK" module for many more @Pre-release@ +-- combinators. See the +-- repository for many more real world examples of stream programming. +-- +-- == Performance Notes +-- +-- Operations annotated as /CPS/ force the use of continuation passing style +-- streams. Therefore, such operations are not subjected to stream fusion. +-- However, for some of these operations you can find fusible alternatives in +-- the internal modules, which are perfectly fine to use but you need to +-- understand the implications especially the O(n^2) nature of those +-- operations.. +-- +module Streamly.Data.Stream.StreamDK + ( + Stream + -- * Construction + -- | Functions ending in the general shape @b -> Stream m a@. + -- + -- See also: "Streamly.Internal.Data.Stream.Generate" for + -- @Pre-release@ functions. + + -- ** Primitives + -- | Primitives to construct a stream from pure values or monadic actions. + -- All other stream construction and generation combinators described later + -- can be expressed in terms of these primitives. However, the special + -- versions provided in this module can be much more efficient in most + -- cases. Users can create custom combinators using these primitives. + , nil + , nilM + , cons + , consM + -- , cons2 -- fused version + -- , consM2 -- fused version + + -- ** Unfolding + -- | 'unfoldrM' is the most general way of generating a stream efficiently. + -- All other generation operations can be expressed using it. + , unfoldr + , unfoldrM + + -- ** From Values + -- | Generate a monadic stream from a seed value or values. + , fromPure + , fromEffect + , repeat + , repeatM + , replicate + , replicateM + + -- Note: Using enumeration functions e.g. 'Prelude.enumFromThen' turns out + -- to be slightly faster than the idioms like @[from, then..]@. + -- + -- ** Enumeration + -- | We can use the 'Enum' type class to enumerate a type producing a list + -- and then convert it to a stream: + -- + -- @ + -- 'fromList' $ 'Prelude.enumFromThen' from then + -- @ + -- + -- However, this is not particularly efficient. + -- The 'Enumerable' type class provides corresponding functions that + -- generate a stream instead of a list, efficiently. + + , Enumerable (..) + , enumerate + , enumerateTo + + -- ** Iteration + , iterate + , iterateM + + -- ** From Containers + -- | Convert an input structure, container or source into a stream. All of + -- these can be expressed in terms of primitives. + , fromList + , fromFoldable + + -- ** From Unfolds + -- | Most of the above stream generation operations can also be expressed + -- using the corresponding unfolds in the "Streamly.Data.Unfold" module. + , unfold -- XXX rename to fromUnfold? + + -- * Elimination + -- | Functions ending in the general shape @Stream m a -> m b@ or @Stream m + -- a -> m (b, Stream m a)@ + -- + -- See also: "Streamly.Internal.Data.Stream.Eliminate" for @Pre-release@ + -- functions. + +-- EXPLANATION: In imperative terms a fold can be considered as a loop over the stream +-- that reduces the stream to a single value. +-- Left and right folds both use a fold function @f@ and an identity element +-- @z@ (@zero@) to deconstruct a recursive data structure and reconstruct a +-- new data structure. The new structure may be a recursive construction (a +-- container) or a non-recursive single value reduction of the original +-- structure. +-- +-- Both right and left folds are mathematical duals of each other, they are +-- functionally equivalent. Operationally, a left fold on a left associated +-- structure behaves exactly in the same way as a right fold on a right +-- associated structure. Similarly, a left fold on a right associated structure +-- behaves in the same way as a right fold on a left associated structure. +-- However, the behavior of a right fold on a right associated structure is +-- operationally different (even though functionally equivalent) than a left +-- fold on the same structure. +-- +-- On right associated structures like Haskell @cons@ lists or Streamly +-- streams, a lazy right fold is naturally suitable for lazy recursive +-- reconstruction of a new structure, while a strict left fold is naturally +-- suitable for efficient reduction. In right folds control is in the hand of +-- the @puller@ whereas in left folds the control is in the hand of the +-- @pusher@. +-- +-- The behavior of right and left folds are described in detail in the +-- individual fold's documentation. To illustrate the two folds for right +-- associated @cons@ lists: +-- +-- > foldr :: (a -> b -> b) -> b -> [a] -> b +-- > foldr f z [] = z +-- > foldr f z (x:xs) = x `f` foldr f z xs +-- > +-- > foldl :: (b -> a -> b) -> b -> [a] -> b +-- > foldl f z [] = z +-- > foldl f z (x:xs) = foldl f (z `f` x) xs +-- +-- @foldr@ is conceptually equivalent to: +-- +-- > foldr f z [] = z +-- > foldr f z [x] = f x z +-- > foldr f z xs = foldr f (foldr f z (tail xs)) [head xs] +-- +-- @foldl@ is conceptually equivalent to: +-- +-- > foldl f z [] = z +-- > foldl f z [x] = f z x +-- > foldl f z xs = foldl f (foldl f z (init xs)) [last xs] +-- +-- Left and right folds are duals of each other. +-- +-- @ +-- foldr f z xs = foldl (flip f) z (reverse xs) +-- foldl f z xs = foldr (flip f) z (reverse xs) +-- @ +-- +-- More generally: +-- +-- @ +-- foldr f z xs = foldl g id xs z where g k x = k . f x +-- foldl f z xs = foldr g id xs z where g x k = k . flip f x +-- @ +-- + +-- NOTE: Folds are inherently serial as each step needs to use the result of +-- the previous step. However, it is possible to fold parts of the stream in +-- parallel and then combine the results using a monoid. + + -- ** Primitives + -- Consuming a part of the stream and returning the rest. Functions + -- ending in the general shape @Stream m a -> m (b, Stream m a)@ + , uncons + + -- ** Folding + -- XXX Need to have a general parse operation here which can be used to + -- express all others. + , fold -- XXX rename to run? We can have a Stream.run and Fold.run. + -- XXX fold1 can be achieved using Monoids or Refolds. + -- XXX We can call this just "break" and parseBreak as "munch" + , foldBreak + + -- XXX should we have a Fold returning function in stream module? + -- , foldAdd + -- , buildl + + -- ** Parsing + , parse + , parseBreak + + -- -- ** Lazy Right Folds + -- Consuming a stream to build a right associated expression, suitable + -- for lazy evaluation. Evaluation of the input happens when the output of + -- the fold is evaluated, the fold output is a lazy thunk. + -- + -- This is suitable for stream transformation operations, for example, + -- operations like mapping a function over the stream. + -- , foldrM + -- , foldr + + -- * Mapping + -- | Stateless one-to-one transformations. Use 'fmap' for mapping a pure + -- function on a stream. + + -- EXPLANATION: + -- In imperative terms a map operation can be considered as a loop over + -- the stream that transforms the stream into another stream by performing + -- an operation on each element of the stream. + -- + -- 'map' is the least powerful transformation operation with strictest + -- guarantees. A map, (1) is a stateless loop which means that no state is + -- allowed to be carried from one iteration to another, therefore, + -- operations on different elements are guaranteed to not affect each + -- other, (2) is a strictly one-to-one transformation of stream elements + -- which means it guarantees that no elements can be added or removed from + -- the stream, it can merely transform them. + , sequence + , mapM + -- , trace -- XXX Use "tracing" map instead? + , tap + , delay + + -- * Scanning + -- | Stateful one-to-one transformations. + -- + -- See also: "Streamly.Internal.Data.Stream.Transform" for + -- @Pre-release@ functions. + , scan + , postscan + -- XXX postscan1 can be implemented using Monoids or Refolds. + -- Indexing can be considered as a special type of zipping where we zip a + -- stream with an index stream. + , indexed + + -- * Insertion + -- | Add elements to the stream. + + -- Inserting elements is a special case of interleaving/merging streams. + , insertBy + , intersperseM + , intersperseM_ + , intersperse + + -- * Filtering + -- | Remove elements from the stream. + + -- ** Stateless Filters + -- | 'mapMaybeM' is the most general stateless filtering operation. All + -- other filtering operations can be expressed using it. + + -- EXPLANATION: + -- In imperative terms a filter over a stream corresponds to a loop with a + -- @continue@ clause for the cases when the predicate fails. + + , mapMaybe + , mapMaybeM + , filter + , filterM + + -- Filter and concat + , catMaybes + , catLefts + , catRights + , catEithers + + -- ** Stateful Filters + -- | 'scanMaybe' is the most general stateful filtering operation. The + -- filtering folds (folds returning a 'Maybe' type) in + -- "Streamly.Internal.Data.Fold" can be used along with 'scanMaybe' to + -- perform stateful filtering operations in general. + , scanMaybe + , take + , takeWhile + , takeWhileM + , drop + , dropWhile + , dropWhileM + + -- XXX These are available as scans in folds. We need to check the + -- performance though. If these are common and we need convenient stream + -- ops then we can expose these. + + -- , deleteBy + -- , uniq + -- , uniqBy + + -- -- ** Sampling + -- , strideFromThen + + -- -- ** Searching + -- Finding the presence or location of an element, a sequence of elements + -- or another stream within a stream. + + -- -- ** Searching Elements + -- , findIndices + -- , elemIndices + + -- * Combining Two Streams + -- ** Appending + , append + + -- ** Interleaving + , interleave + -- , interleave2 + + -- ** Merging + -- | Merging of @n@ streams can be performed by combining the streams pair + -- wise using 'mergeMapWith' to give O(n * log n) time complexity. If used + -- with 'concatMapWith' it will have O(n^2) performance. + + , mergeBy + , mergeByM + -- , mergeBy2 + -- , mergeByM2 + + -- ** Zipping + -- | Zipping of @n@ streams can be performed by combining the streams pair + -- wise using 'mergeMapWith' with O(n * log n) time complexity. If used + -- with 'concatMapWith' it will have O(n^2) performance. + , zipWith + , zipWithM + -- , zipWith2 + -- , zipWithM2 + , ZipStream (..) + + -- ** Cross Product + -- XXX The argument order in this operation is such that it seems we are + -- transforming the first stream using the second stream because the second + -- stream is evaluated many times or buffered and better be finite, first + -- stream could potentially be infinite. In the tradition of using the + -- transformed stream at the end we can have a flipped version called + -- "crossMap" or "nestWith". + , crossWith + -- , cross + -- , joinInner + , CrossStream (..) + + -- * Unfold Each + , unfoldMany + , intercalate + , intercalateSuffix + + -- * Stream of streams + -- | Stream operations like map and filter represent loop processing in + -- imperative programming terms. Similarly, the imperative concept of + -- nested loops are represented by streams of streams. The 'concatMap' + -- operation represents nested looping. + -- A 'concatMap' operation loops over the input stream and then for each + -- element of the input stream generates another stream and then loops over + -- that inner stream as well producing effects and generating a single + -- output stream. + -- + -- One dimension loops are just a special case of nested loops. For + -- example, 'concatMap' can degenerate to a simple map operation: + -- + -- > map f m = S.concatMap (\x -> S.fromPure (f x)) m + -- + -- Similarly, 'concatMap' can perform filtering by mapping an element to a + -- 'nil' stream: + -- + -- > filter p m = S.concatMap (\x -> if p x then S.fromPure x else S.nil) m + -- + + , concatEffect + , concatMapWith + , concatMap + , concatMapM + , mergeMapWith + + -- * Repeated Fold + , foldMany -- XXX Rename to foldRepeat + , parseMany + , arraysOf + + -- * Buffered Operations + -- | Operations that require buffering of the stream. + -- Reverse is essentially a left fold followed by an unfold. + , reverse + , sortBy + + -- * Multi-Stream folds + -- | Operations that consume multiple streams at the same time. + , eqBy + , cmpBy + , isPrefixOf + , isSubsequenceOf + + -- trimming sequences + , stripPrefix + + -- Exceptions and resource management depend on the "exceptions" package + -- XXX We can have IO Stream operations not depending on "exceptions" + -- in Exception.Base + + -- * Exceptions + -- | Most of these combinators inhibit stream fusion, therefore, when + -- possible, they should be called in an outer loop to mitigate the cost. + -- For example, instead of calling them on a stream of chars call them on a + -- stream of arrays before flattening it to a stream of chars. + -- + -- See also: "Streamly.Internal.Data.Stream.Exception" for + -- @Pre-release@ functions. + + , onException + , handle + + -- * Resource Management + -- | 'bracket' is the most general resource management operation, all other + -- operations can be expressed using it. These functions have IO suffix + -- because the allocation and cleanup functions are IO actions. For + -- generalized allocation and cleanup functions see the functions without + -- the IO suffix in the "streamly" package. + , before + , afterIO + , finallyIO + , bracketIO + , bracketIO3 + + -- * Transforming Inner Monad + + , morphInner + , liftInner + , runReaderT + , runStateT + + -- -- * Stream Types + -- $serial + -- , Interleave + -- , Zip + ) +where + +import Streamly.Internal.Data.Stream.StreamDK +import Prelude + hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr, + foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem, + notElem, maximum, minimum, head, last, tail, length, null, + reverse, iterate, init, and, or, lookup, foldr1, (!!), + scanl, scanl1, repeat, replicate, concatMap, span) diff --git a/core/src/Streamly/Data/Stream/StreamK.hs b/core/src/Streamly/Data/Stream/StreamK.hs new file mode 100644 index 000000000..f9a327aa8 --- /dev/null +++ b/core/src/Streamly/Data/Stream/StreamK.hs @@ -0,0 +1,93 @@ +-- | +-- Module : Streamly.Data.Stream.StreamK +-- Copyright : (c) 2017 Composewell Technologies +-- +-- License : BSD3 +-- Maintainer : streamly@composewell.com +-- Stability : released +-- Portability : GHC +-- +-- Streams using Continuation Passing Style (CPS). See notes in "Data.Stream" +-- module to know when to use this module. + +-- primitive/open loop operations that can be used recursively e.g. uncons, +-- foldBreak, parseBreak should not be converted from StreamD for use in +-- StreamK, instead native StreamK impl should be used. +-- +-- Closed loop operations like repeat, replicate, iterate etc can be converted +-- from StreamD. +-- +-- In the last phase any operation like (toStreamK . f . toStreamD) should be +-- rewritten to a K version of f. +-- XXX Need to add rewrite rules for all missing StreamD operations. +-- +module Streamly.Data.Stream.StreamK + ( + StreamK + + -- * Construction + -- ** Primitives + , nil + , nilM + , cons + , consM + + -- ** From Values + , fromPure + , fromEffect + + -- ** From Stream + , fromStream + , toStream + + -- ** From Containers + , fromFoldable + + -- * Elimination + + -- ** Primitives + , uncons + + -- -- ** Folding + -- , foldBreak + + -- ** Parsing + , parseBreak + + -- * Combining Two Streams + -- ** Appending + , append + + -- ** Interleaving + , interleave + + -- ** Merging + , mergeBy + , mergeByM + + -- ** Zipping + , zipWith + , zipWithM + + -- ** Cross Product + -- XXX is "bind/concatFor" better to have than crossWith? + -- crossWith f xs1 xs2 = concatFor xs1 (\x -> fmap (f x) xs2) + , crossWith + -- , cross + -- , joinInner + -- , CrossStreamK (..) + + -- * Stream of streams + , concatEffect + -- , concatMap + , concatMapWith + , mergeMapWith + + -- * Buffered Operations + , reverse + , sortBy + ) +where + +import Streamly.Internal.Data.Stream.StreamK +import Prelude hiding (reverse, zipWith) diff --git a/core/src/Streamly/Internal/Console/Stdio.hs b/core/src/Streamly/Internal/Console/Stdio.hs index 2b03621f5..4dd13a5c6 100644 --- a/core/src/Streamly/Internal/Console/Stdio.hs +++ b/core/src/Streamly/Internal/Console/Stdio.hs @@ -47,12 +47,13 @@ import System.IO (stdin, stdout, stderr) import Prelude hiding (read) import Streamly.Internal.Data.Array.Type (Array(..)) -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Streamly.Internal.Data.Unfold (Unfold) import Streamly.Internal.Data.Fold (Fold) import qualified Streamly.Internal.Data.Array as Array -import qualified Streamly.Internal.Data.Stream as Stream (intersperseMSuffix) +import qualified Streamly.Internal.Data.Stream.StreamD as Stream + (intersperseMSuffix) import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.FileSystem.Handle as Handle import qualified Streamly.Internal.Unicode.Stream as Unicode diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index 084bb3500..fbef8faaf 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -139,7 +139,7 @@ import Streamly.Internal.Data.Array.Type (Array(..), length, asPtrUnsafe) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Internal.Data.Producer.Type (Producer(..)) -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple3Fused'(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (unsafeInlineIO) @@ -151,9 +151,8 @@ 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.Unboxed as RB -import qualified Streamly.Internal.Data.Stream.Common as P import qualified Streamly.Internal.Data.Stream.StreamD as D -import qualified Streamly.Internal.Data.Stream.Type as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import qualified Streamly.Internal.Data.Unfold as Unfold ------------------------------------------------------------------------------- @@ -169,7 +168,7 @@ import qualified Streamly.Internal.Data.Unfold as Unfold 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 $ Stream.toStreamD m + 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 @@ -182,7 +181,7 @@ fromStreamN n m = do -- /Pre-release/ {-# INLINE fromStream #-} fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (Array a) -fromStream m = P.fold A.write $ Stream.toStreamK m +fromStream = Stream.fold A.write -- write m = A.fromStreamD $ D.fromStreamK m ------------------------------------------------------------------------------- @@ -373,8 +372,7 @@ getSliceUnsafe index len (Array contents start e) = splitOn :: (Monad m, Unbox a) => (a -> Bool) -> Array a -> Stream m (Array a) splitOn predicate arr = - Stream.fromStreamD - $ fmap (\(i, len) -> getSliceUnsafe i len arr) + fmap (\(i, len) -> getSliceUnsafe i len arr) $ D.sliceOnSuffix predicate (A.toStreamD arr) {-# INLINE genSlicesFromLen #-} @@ -438,7 +436,7 @@ getIndex i arr = {-# INLINE getIndices #-} getIndices :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a getIndices m = - let unf = MA.getIndicesD (return . unsafeInlineIO) $ D.fromStreamK $ Stream.toStreamK m + let unf = MA.getIndicesD (return . unsafeInlineIO) m in Unfold.lmap A.unsafeThaw unf -- | Unfolds @(from, then, to, array)@ generating a finite stream whose first @@ -488,7 +486,7 @@ runPipe f arr = P.runPipe (toArrayMinChunk (length arr)) $ f (A.read arr) 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 = - P.fold (A.writeWith (length arr)) $ Stream.toStreamK $ f (A.read arr) + Stream.fold (A.writeWith (length arr)) $ f (A.read arr) ------------------------------------------------------------------------------- -- Casts @@ -553,7 +551,7 @@ asCStringUnsafe arr act = do -- /Pre-release/ {-# INLINE fold #-} fold :: forall m a b. (Monad m, Unbox a) => Fold m a b -> Array a -> m b -fold f arr = P.fold f (Stream.toStreamK (A.read arr)) +fold f arr = Stream.fold f (A.read arr) -- | Fold an array using a stream fold operation. -- diff --git a/core/src/Streamly/Internal/Data/Array/Generic.hs b/core/src/Streamly/Internal/Data/Array/Generic.hs index 8ff151eea..bdc39edd4 100644 --- a/core/src/Streamly/Internal/Data/Array/Generic.hs +++ b/core/src/Streamly/Internal/Data/Array/Generic.hs @@ -55,7 +55,7 @@ import GHC.IO (unsafePerformIO) import Text.Read (readPrec) import Streamly.Internal.Data.Fold.Type (Fold(..)) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (unsafeInlineIO) @@ -65,8 +65,8 @@ import qualified Streamly.Internal.Data.Fold.Type 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.Stream.StreamD as D -import qualified Streamly.Internal.Data.Stream.Type as Stream +import qualified Streamly.Internal.Data.Stream.StreamD.Type as D +import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D import qualified Text.ParserCombinators.ReadPrec as ReadPrec import Data.IORef @@ -150,11 +150,11 @@ fromStreamD = D.fold write fromStreamN :: MonadIO m => Int -> Stream m a -> m (Array a) fromStreamN n m = do when (n < 0) $ error "fromStreamN: negative write count specified" - fromStreamDN n $ Stream.toStreamD m + fromStreamDN n m {-# INLINE fromStream #-} fromStream :: MonadIO m => Stream m a -> m (Array a) -fromStream = fromStreamD . Stream.toStreamD +fromStream = fromStreamD {-# INLINABLE fromListN #-} fromListN :: Int -> [a] -> Array a @@ -205,11 +205,11 @@ readRevStreamD arr@Array{..} = {-# INLINE_EARLY read #-} read :: MonadIO m => Array a -> Stream m a -read = Stream.fromStreamD . readStreamD +read = readStreamD {-# INLINE_EARLY readRev #-} readRev :: Monad m => Array a -> Stream m a -readRev = Stream.fromStreamD . readRevStreamD +readRev = readRevStreamD ------------------------------------------------------------------------------- -- Elimination - using Folds diff --git a/core/src/Streamly/Internal/Data/Array/Generic/Mut/Type.hs b/core/src/Streamly/Internal/Data/Array/Generic/Mut/Type.hs index 43c105032..d99119c48 100644 --- a/core/src/Streamly/Internal/Data/Array/Generic/Mut/Type.hs +++ b/core/src/Streamly/Internal/Data/Array/Generic/Mut/Type.hs @@ -176,8 +176,9 @@ import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import qualified Streamly.Internal.Data.Fold.Type as FL import qualified Streamly.Internal.Data.Producer as Producer -import qualified Streamly.Internal.Data.Stream.StreamD as D -import qualified Streamly.Internal.Data.Stream.StreamK as K +import qualified Streamly.Internal.Data.Stream.StreamD.Type as D +import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D +import qualified Streamly.Internal.Data.Stream.StreamK.Type as K import Prelude hiding (read) diff --git a/core/src/Streamly/Internal/Data/Array/Mut.hs b/core/src/Streamly/Internal/Data/Array/Mut.hs index 965aee7e3..b5aa39d9f 100644 --- a/core/src/Streamly/Internal/Data/Array/Mut.hs +++ b/core/src/Streamly/Internal/Data/Array/Mut.hs @@ -34,13 +34,11 @@ where import Control.Monad.IO.Class (MonadIO(..)) import Streamly.Internal.Data.Unboxed (Unbox) -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import qualified Streamly.Internal.Data.Stream.StreamD as D -import qualified Streamly.Internal.Data.Stream.Type as Stream import qualified Streamly.Internal.Data.Unfold as Unfold --- import qualified Streamly.Internal.Data.Stream.Common as P import Prelude hiding (foldr, length, read, splitAt) import Streamly.Internal.Data.Array.Mut.Type @@ -53,8 +51,7 @@ import Streamly.Internal.Data.Array.Mut.Type splitOn :: (MonadIO m, Unbox a) => (a -> Bool) -> Array a -> Stream m (Array a) splitOn predicate arr = - Stream.fromStreamD - $ fmap (\(i, len) -> getSliceUnsafe i len arr) + fmap (\(i, len) -> getSliceUnsafe i len arr) $ D.sliceOnSuffix predicate (toStreamD arr) -- | Generate a stream of array slice descriptors ((index, len)) of specified @@ -99,5 +96,5 @@ getSlicesFromLen from len = -- /Pre-release/ {-# INLINE fromStream #-} fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (Array a) -fromStream = fromStreamD . Stream.toStreamD +fromStream = fromStreamD -- fromStream (Stream m) = P.fold write m diff --git a/core/src/Streamly/Internal/Data/Array/Mut/Stream.hs b/core/src/Streamly/Internal/Data/Array/Mut/Stream.hs index 29543c47c..abb463800 100644 --- a/core/src/Streamly/Internal/Data/Array/Mut/Stream.hs +++ b/core/src/Streamly/Internal/Data/Array/Mut/Stream.hs @@ -35,14 +35,13 @@ import Streamly.Internal.Data.Unboxed (Unbox, sizeOf) import Streamly.Internal.Data.Array.Mut.Type (Array(..)) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Internal.Data.Parser (ParseError) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) import qualified Streamly.Internal.Data.Array.Mut.Type as MArray import qualified Streamly.Internal.Data.Fold.Type as FL import qualified Streamly.Internal.Data.Stream.StreamD as D import qualified Streamly.Internal.Data.Parser.ParserD as ParserD -import qualified Streamly.Internal.Data.Stream.Type as Stream -- | @arraysOf n stream@ groups the elements in the input stream into arrays of -- @n@ elements each. @@ -55,7 +54,7 @@ import qualified Streamly.Internal.Data.Stream.Type as Stream {-# INLINE arraysOf #-} arraysOf :: (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a) -arraysOf n = Stream.fromStreamD . MArray.arraysOf n . Stream.toStreamD +arraysOf = MArray.arraysOf ------------------------------------------------------------------------------- -- Compact @@ -194,7 +193,7 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) = {-# INLINE compact #-} compact :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a) -compact n = Stream.fromStreamD . packArraysChunksOf n . Stream.toStreamD +compact = packArraysChunksOf -- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a -- maximum specified size. Note that if a single array is bigger than the @@ -299,10 +298,9 @@ compactGEFold n = Fold step initial extract -- maximum specified size in bytes. -- -- /Internal/ -compactLE :: (Monad m, MonadIO m, Unbox a) => +compactLE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Either ParseError (Array a)) -compactLE n = - Stream.fromStreamD . D.parseMany (compactLEParserD n) . Stream.toStreamD +compactLE n = D.parseManyD (compactLEParserD n) -- | Like 'compactLE' but generates arrays of exactly equal to the size -- specified except for the last array in the stream which could be shorter. @@ -322,5 +320,4 @@ compactEQ _n _xs = undefined compactGE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a) -compactGE n = - Stream.fromStreamD . D.foldMany (compactGEFold n) . Stream.toStreamD +compactGE n = D.foldMany (compactGEFold n) diff --git a/core/src/Streamly/Internal/Data/Array/Mut/Type.hs b/core/src/Streamly/Internal/Data/Array/Mut/Type.hs index 9374da9c7..f9c7d777c 100644 --- a/core/src/Streamly/Internal/Data/Array/Mut/Type.hs +++ b/core/src/Streamly/Internal/Data/Array/Mut/Type.hs @@ -243,7 +243,7 @@ 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.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.SVar.Type (adaptState, defState) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize) @@ -252,7 +252,6 @@ import qualified Streamly.Internal.Data.Fold.Type as FL import qualified Streamly.Internal.Data.Producer as Producer import qualified Streamly.Internal.Data.Stream.StreamD.Type as D import qualified Streamly.Internal.Data.Stream.StreamK.Type as K -import qualified Streamly.Internal.Data.Stream.Type as Stream import qualified Streamly.Internal.Data.Unboxed as Unboxed import qualified Prelude @@ -1036,7 +1035,7 @@ getIndicesD liftio (D.Stream stepi sti) = Unfold step inject {-# INLINE getIndices #-} getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (Array a) a -getIndices = getIndicesD liftIO . Stream.toStreamD +getIndices = getIndicesD liftIO ------------------------------------------------------------------------------- -- Subarrays diff --git a/core/src/Streamly/Internal/Data/Array/Type.hs b/core/src/Streamly/Internal/Data/Array/Type.hs index 177b9d327..d506f1181 100644 --- a/core/src/Streamly/Internal/Data/Array/Type.hs +++ b/core/src/Streamly/Internal/Data/Array/Type.hs @@ -90,7 +90,7 @@ import GHC.IO (unsafePerformIO) import GHC.Ptr (Ptr(..)) import Streamly.Internal.Data.Array.Mut.Type (MutableByteArray) import Streamly.Internal.Data.Fold.Type (Fold(..)) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.Unboxed (Unbox, peekWith, sizeOf) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Text.Read (readPrec) @@ -101,7 +101,6 @@ import qualified GHC.Exts as Exts import qualified Streamly.Internal.Data.Array.Mut.Type as MA import qualified Streamly.Internal.Data.Stream.StreamD.Type as D import qualified Streamly.Internal.Data.Stream.StreamK.Type as K -import qualified Streamly.Internal.Data.Stream.Type as Stream import qualified Streamly.Internal.Data.Unboxed as Unboxed import qualified Streamly.Internal.Data.Unfold.Type as Unfold import qualified Text.ParserCombinators.ReadPrec as ReadPrec @@ -113,6 +112,7 @@ import Streamly.Internal.System.IO (unsafeInlineIO, defaultChunkSize) -- >>> :m -- >>> :set -XMagicHash -- >>> import Prelude hiding (length, foldr, read, unlines, splitAt) +-- >>> import Streamly.Data.Stream as Stream -- >>> import Streamly.Internal.Data.Array as Array ------------------------------------------------------------------------------- @@ -265,8 +265,14 @@ bufferChunks :: (MonadIO m, Unbox a) => D.Stream m a -> m (K.Stream m (Array a)) bufferChunks m = D.foldr K.cons K.nil $ arraysOf defaultChunkSize m --- | @arraysOf n stream@ groups the input stream into a stream of --- arrays of size n. +-- | @arraysOf n stream@ groups the elements in the input stream into arrays of +-- @n@ elements each. +-- +-- Same as the following but may be more efficient: +-- +-- >>> arraysOf n = Stream.foldMany (Array.writeN n) +-- +-- /Pre-release/ {-# INLINE_NORMAL arraysOf #-} arraysOf :: forall m a. (MonadIO m, Unbox a) => Int -> D.Stream m a -> D.Stream m (Array a) @@ -360,7 +366,7 @@ toStreamKRev arr = -- /Pre-release/ {-# INLINE_EARLY read #-} read :: (Monad m, Unbox a) => Array a -> Stream m a -read = Stream.fromStreamD . toStreamD +read = toStreamD -- | Same as 'read' -- @@ -377,7 +383,7 @@ toStream = read -- /Pre-release/ {-# INLINE_EARLY readRev #-} readRev :: (Monad m, Unbox a) => Array a -> Stream m a -readRev = Stream.fromStreamD . toStreamDRev +readRev = toStreamDRev -- | Same as 'readRev' -- diff --git a/core/src/Streamly/Internal/Data/Fold.hs b/core/src/Streamly/Internal/Data/Fold.hs index e39325189..38c01580f 100644 --- a/core/src/Streamly/Internal/Data/Fold.hs +++ b/core/src/Streamly/Internal/Data/Fold.hs @@ -160,7 +160,7 @@ module Streamly.Internal.Data.Fold -- * Running A Fold , drive - , breakStream + -- , breakStream -- * Building Incrementally , extractM @@ -325,7 +325,7 @@ import Streamly.Internal.Data.Pipe.Type (Pipe (..), PipeState(..)) import Streamly.Internal.Data.Unboxed (Unbox, sizeOf) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..)) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import qualified Prelude import qualified Streamly.Internal.Data.Array.Mut.Type as MA @@ -334,8 +334,6 @@ import qualified Streamly.Internal.Data.Fold.Window as FoldW import qualified Streamly.Internal.Data.Pipe.Type as Pipe import qualified Streamly.Internal.Data.Ring.Unboxed as Ring import qualified Streamly.Internal.Data.Stream.StreamD.Type as StreamD -import qualified Streamly.Internal.Data.Stream.StreamK as K -import qualified Streamly.Internal.Data.Stream.Type as Stream import Prelude hiding ( filter, foldl1, drop, dropWhile, take, takeWhile, zipWith @@ -366,7 +364,6 @@ import Streamly.Internal.Data.Fold.Tee -- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold -- >>> import qualified Streamly.Internal.Data.Fold.Window as FoldW -- >>> import qualified Streamly.Internal.Data.Parser as Parser --- >>> import qualified Streamly.Internal.Data.Stream.Type as Stream -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold -- >>> import Prelude hiding (break, map, span, splitAt) @@ -388,8 +385,9 @@ import Streamly.Internal.Data.Fold.Tee -- {-# INLINE drive #-} drive :: Monad m => Stream m a -> Fold m a b -> m b -drive strm fl = StreamD.fold fl $ StreamD.fromStreamK $ Stream.toStreamK strm +drive = flip StreamD.fold +{- -- | Like 'drive' but also returns the remaining stream. The resulting stream -- would be 'Stream.nil' if the stream finished before the fold. -- @@ -399,13 +397,14 @@ drive strm fl = StreamD.fold fl $ StreamD.fromStreamK $ Stream.toStreamK strm -- -- /CPS/ -- -{-# INLINE breakStream #-} -breakStream :: Monad m => Stream m a -> Fold m a b -> m (b, Stream m a) -breakStream strm fl = fmap f $ K.foldBreak fl (Stream.toStreamK strm) +{-# INLINE breakStreamK #-} +breakStreamK :: Monad m => StreamK m a -> Fold m a b -> m (b, StreamK m a) +breakStreamK strm fl = fmap f $ K.foldBreak fl (Stream.toStreamK strm) where f (b, str) = (b, Stream.fromStreamK str) +-} -- | Append a stream to a fold to build the fold accumulator incrementally. We -- can repeatedly call 'addStream' on the same fold to continue building the @@ -2386,12 +2385,12 @@ chunksBetween _low _high _f1 _f2 = undefined -- /Warning!/ working on large streams accumulated as buffers in memory could -- be very inefficient, consider using "Streamly.Data.Array" instead. -- --- >>> toStream = fmap Stream.fromStreamK Fold.toStreamK +-- >>> toStream = fmap Stream.fromList Fold.toList -- -- /Pre-release/ {-# INLINE toStream #-} -toStream :: Monad m => Fold m a (Stream n a) -toStream = fmap Stream.fromStreamK toStreamK +toStream :: (Monad m, Monad n) => Fold m a (Stream n a) +toStream = fmap StreamD.fromList toList -- This is more efficient than 'toStream'. toStream is exactly the same as -- reversing the stream after toStreamRev. @@ -2399,7 +2398,7 @@ toStream = fmap Stream.fromStreamK toStreamK -- | Buffers the input stream to a pure stream in the reverse order of the -- input. -- --- >>> toStreamRev = fmap Stream.fromStreamK Fold.toStreamKRev +-- >>> toStreamRev = fmap Stream.fromList Fold.toListRev -- -- /Warning!/ working on large streams accumulated as buffers in memory could -- be very inefficient, consider using "Streamly.Data.Array" instead. @@ -2408,8 +2407,8 @@ toStream = fmap Stream.fromStreamK toStreamK -- xn : ... : x2 : x1 : [] {-# INLINE toStreamRev #-} -toStreamRev :: Monad m => Fold m a (Stream n a) -toStreamRev = fmap Stream.fromStreamK toStreamKRev +toStreamRev :: (Monad m, Monad n) => Fold m a (Stream n a) +toStreamRev = fmap StreamD.fromList toListRev -- XXX This does not fuse. It contains a recursive step function. We will need -- a Skip input constructor in the fold type to make it fuse. diff --git a/core/src/Streamly/Internal/Data/Fold/Chunked.hs b/core/src/Streamly/Internal/Data/Fold/Chunked.hs index 380c86877..079bfa0d3 100644 --- a/core/src/Streamly/Internal/Data/Fold/Chunked.hs +++ b/core/src/Streamly/Internal/Data/Fold/Chunked.hs @@ -6,6 +6,8 @@ -- Stability : experimental -- Portability : GHC -- +-- Use "Streamly.Data.Parser.Chunked" instead. +-- -- Fold a stream of foreign arrays. @Fold m a b@ in this module works -- on a stream of "Array a" and produces an output of type @b@. -- @@ -20,12 +22,12 @@ -- >>> import qualified Streamly.Data.Fold as Fold -- >>> import qualified Streamly.Internal.Data.Stream.Chunked as ArrayStream -- >>> import qualified Streamly.Internal.Data.Fold.Chunked as ChunkFold --- >>> import qualified Streamly.Internal.Data.Stream as Stream (arraysOf) -- >>> import qualified Streamly.Data.Stream as Stream +-- >>> import qualified Streamly.Data.Stream.StreamK as StreamK -- -- >>> f = ChunkFold.fromFold (Fold.take 7 Fold.toList) -- >>> s = Stream.arraysOf 5 $ Stream.fromList "hello world" --- >>> ArrayStream.runArrayFold f s +-- >>> ArrayStream.runArrayFold f (StreamK.fromStream s) -- Right "hello w" -- module Streamly.Internal.Data.Fold.Chunked @@ -98,11 +100,7 @@ newtype ChunkFold m a b = ChunkFold (ParserD.Parser (Array a) m b) -- -- /Pre-release/ {-# INLINE fromFold #-} -#ifdef DEVBUILD -fromFold :: forall m a b. (MonadIO m) => -#else fromFold :: forall m a b. (MonadIO m, Unbox a) => -#endif Fold.Fold m a b -> ChunkFold m a b fromFold (Fold.Fold fstep finitial fextract) = ChunkFold (ParserD.Parser step initial (fmap (Done 0) . fextract)) @@ -140,11 +138,7 @@ fromFold (Fold.Fold fstep finitial fextract) = -- -- /Pre-release/ {-# INLINE fromParserD #-} -#ifdef DEVBUILD -fromParserD :: forall m a b. (MonadIO m) => -#else fromParserD :: forall m a b. (MonadIO m, Unbox a) => -#endif ParserD.Parser a m b -> ChunkFold m a b fromParserD (ParserD.Parser step1 initial1 extract1) = ChunkFold (ParserD.Parser step initial1 extract1) @@ -186,11 +180,7 @@ fromParserD (ParserD.Parser step1 initial1 extract1) = -- -- /Pre-release/ {-# INLINE fromParser #-} -#ifdef DEVBUILD -fromParser :: forall m a b. (MonadIO m) => -#else fromParser :: forall m a b. (MonadIO m, Unbox a) => -#endif Parser.Parser a m b -> ChunkFold m a b fromParser = fromParserD . ParserD.fromParserK diff --git a/core/src/Streamly/Internal/Data/Fold/Type.hs b/core/src/Streamly/Internal/Data/Fold/Type.hs index 624b88faf..403659752 100644 --- a/core/src/Streamly/Internal/Data/Fold/Type.hs +++ b/core/src/Streamly/Internal/Data/Fold/Type.hs @@ -445,7 +445,7 @@ import Prelude hiding (concatMap, filter, foldr, map, take) -- >>> import Data.Maybe (fromJust, isJust) -- >>> import Data.Monoid (Endo(..)) -- >>> import Streamly.Data.Fold (Fold) --- >>> import Streamly.Internal.Data.Stream.Type (Stream) +-- >>> import Streamly.Data.Stream (Stream) -- >>> import qualified Data.Foldable as Foldable -- >>> import qualified Streamly.Data.Fold as Fold -- >>> import qualified Streamly.Internal.Data.Fold as Fold diff --git a/core/src/Streamly/Internal/Data/Parser.hs b/core/src/Streamly/Internal/Data/Parser.hs index 3fc1ba3f9..2847f8661 100644 --- a/core/src/Streamly/Internal/Data/Parser.hs +++ b/core/src/Streamly/Internal/Data/Parser.hs @@ -251,13 +251,19 @@ where import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Internal.Data.Parser.ParserK.Type (Parser) -import Streamly.Internal.Data.Stream.Type (Stream) import qualified Data.Foldable as Foldable import qualified Streamly.Internal.Data.Fold.Type as FL import qualified Streamly.Internal.Data.Parser.ParserD as D import qualified Streamly.Internal.Data.Parser.ParserK.Type as K -import qualified Streamly.Internal.Data.Stream.Type as Stream + +#ifdef USE_STREAMK +import Streamly.Internal.Data.StreamK (Stream) +import qualified Streamly.Internal.Data.StreamK as Stream +#else +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) +import qualified Streamly.Internal.Data.Stream.StreamD.Type as Stream +#endif import Prelude hiding ( any, all, dropWhile, take, takeWhile, sequence, concatMap, maybe, either @@ -1007,7 +1013,7 @@ groupByRollingEither eq f1 = D.toParserK . D.groupByRollingEither eq f1 -- {-# INLINE streamEqBy #-} streamEqBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Parser a m () -streamEqBy cmp = D.toParserK . D.streamEqBy cmp . Stream.toStreamD +streamEqBy cmp = D.toParserK . D.streamEqBy cmp -- | Match the given sequence of elements using the given comparison function. -- Returns the original sequence if successful. @@ -1259,7 +1265,7 @@ concatSequence :: Monad m => Fold m b c -> Stream m (Parser a m b) -> Parser a m c concatSequence f p = - let sp = fmap D.fromParserK $ Stream.toStreamD p + let sp = fmap D.fromParserK p in D.toParserK $ D.sequence sp f -- | Map a 'Parser' returning function on the result of a 'Parser'. diff --git a/core/src/Streamly/Internal/Data/Parser/Chunked.hs b/core/src/Streamly/Internal/Data/Parser/Chunked.hs index de56c67f9..3da4421cd 100644 --- a/core/src/Streamly/Internal/Data/Parser/Chunked.hs +++ b/core/src/Streamly/Internal/Data/Parser/Chunked.hs @@ -42,7 +42,7 @@ import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Array.Type (Array(..)) import Streamly.Internal.Data.Parser.Chunked.Type (ChunkParser (..)) import Streamly.Internal.Data.Parser.ParserD.Type (Initial(..), Step(..)) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamK.Type (StreamK) import Streamly.Internal.Data.SVar.Type (defState) import Streamly.Internal.Data.Unboxed (peekWith, sizeOf, Unbox) @@ -51,7 +51,6 @@ import qualified Streamly.Internal.Data.Parser.Chunked.Type as K import qualified Streamly.Internal.Data.Parser.ParserD as D hiding (fromParserK, toParserK) import qualified Streamly.Internal.Data.Stream.StreamK as StreamK -import qualified Streamly.Internal.Data.Stream.Type as Stream import Streamly.Internal.Data.Parser.ParserD (ParseError(..)) ------------------------------------------------------------------------------- @@ -97,11 +96,11 @@ parserDone (K.Failure n e) _ _ = return $ K.Error n e parseBreak :: (Monad m, Unbox a) => ChunkParser a m b - -> Stream m (Array a) - -> m (Either ParseError b, Stream m (Array a)) + -> StreamK m (Array a) + -> m (Either ParseError b, StreamK m (Array a)) parseBreak parser input = do let parserk = \arr -> K.runParser parser 0 0 arr parserDone - in go [] parserk (Stream.toStreamK input) + in go [] parserk input where @@ -127,13 +126,13 @@ parseBreak parser input = do let (s1, backBuf1) = backTrack n1 backBuf StreamK.nil in go backBuf1 cont1 s1 K.Done 0 b -> - return (Right b, Stream.nil) + return (Right b, StreamK.nil) K.Done n b -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (map Array.length backBuf)) let (s1, _) = backTrack n1 backBuf StreamK.nil - in return (Right b, Stream.fromStreamK s1) - K.Error _ err -> return (Left (ParseError err), Stream.nil) + in return (Right b, s1) + K.Error _ err -> return (Left (ParseError err), StreamK.nil) seekErr n len = error $ "parseBreak: Partial: forward seek not implemented n = " @@ -175,8 +174,8 @@ parseBreak parser input = do let n1 = len - n assertM(n1 <= sum (map Array.length (arr:backBuf))) let (s1, _) = backTrack n1 (arr:backBuf) stream - in return (Right b, Stream.fromStreamK s1) - K.Error _ err -> return (Left (ParseError err), Stream.nil) + in return (Right b, s1) + K.Error _ err -> return (Left (ParseError err), StreamK.nil) go backBuf parserk stream = do let stop = goStop backBuf parserk diff --git a/core/src/Streamly/Internal/Data/Ring/Unboxed.hs b/core/src/Streamly/Internal/Data/Ring/Unboxed.hs index 253ee5ab6..da1ea4a1e 100644 --- a/core/src/Streamly/Internal/Data/Ring/Unboxed.hs +++ b/core/src/Streamly/Internal/Data/Ring/Unboxed.hs @@ -84,7 +84,7 @@ import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes) import GHC.Ptr (Ptr(..)) import Streamly.Internal.Data.Array.Mut.Type (Array) import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..), lmap) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.Stream.StreamD.Step (Step(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (unsafeInlineIO) diff --git a/core/src/Streamly/Internal/Data/Stream.hs b/core/src/Streamly/Internal/Data/Stream.hs index a2b2a71bf..b84650157 100644 --- a/core/src/Streamly/Internal/Data/Stream.hs +++ b/core/src/Streamly/Internal/Data/Stream.hs @@ -1,43 +1,14 @@ -- | -- Module : Streamly.Internal.Data.Stream --- Copyright : (c) 2017 Composewell Technologies +-- Copyright : (c) 2019 Composewell Technologies -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com -- Stability : experimental -- Portability : GHC -- module Streamly.Internal.Data.Stream - ( module Streamly.Internal.Data.Stream.Type - , module Streamly.Internal.Data.Stream.Bottom - , module Streamly.Internal.Data.Stream.Eliminate - , module Streamly.Internal.Data.Stream.Exception - , module Streamly.Internal.Data.Stream.Expand - , module Streamly.Internal.Data.Stream.Generate - , module Streamly.Internal.Data.Stream.Lift - , module Streamly.Internal.Data.Stream.Reduce - , module Streamly.Internal.Data.Stream.Transform - , module Streamly.Internal.Data.Stream.Top - , module Streamly.Internal.Data.Stream.Cross - , module Streamly.Internal.Data.Stream.Zip - - -- modules having dependencies on libraries other than base - , module Streamly.Internal.Data.Stream.Transformer - , module Streamly.Internal.Data.Stream.Container + ( module Streamly.Internal.Data.Stream.StreamD ) where -import Streamly.Internal.Data.Stream.Bottom -import Streamly.Internal.Data.Stream.Cross -import Streamly.Internal.Data.Stream.Eliminate -import Streamly.Internal.Data.Stream.Exception -import Streamly.Internal.Data.Stream.Expand -import Streamly.Internal.Data.Stream.Generate -import Streamly.Internal.Data.Stream.Lift -import Streamly.Internal.Data.Stream.Reduce -import Streamly.Internal.Data.Stream.Top -import Streamly.Internal.Data.Stream.Transform -import Streamly.Internal.Data.Stream.Type -import Streamly.Internal.Data.Stream.Zip - -import Streamly.Internal.Data.Stream.Container -import Streamly.Internal.Data.Stream.Transformer +import Streamly.Internal.Data.Stream.StreamD diff --git a/core/src/Streamly/Internal/Data/Stream/Bottom.hs b/core/src/Streamly/Internal/Data/Stream/Bottom.hs index 304f383f8..aae897f28 100644 --- a/core/src/Streamly/Internal/Data/Stream/Bottom.hs +++ b/core/src/Streamly/Internal/Data/Stream/Bottom.hs @@ -131,7 +131,7 @@ import Streamly.Internal.Data.Stream.Type -- {-# INLINE timesWith #-} timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64) -timesWith g = fromStreamD $ D.times g +timesWith g = fromStreamD $ D.timesWith g -- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of -- granularity @g@ specified in seconds. A low granularity clock is more @@ -186,7 +186,7 @@ relTimesWith = fmap snd . timesWith -- {-# INLINE foldAddLazy #-} foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b -foldAddLazy f s = D.foldContinue f $ toStreamD s +foldAddLazy f s = D.foldAddLazy f $ toStreamD s -- >>> foldAdd f = Stream.foldAddLazy f >=> Fold.reduce @@ -385,7 +385,7 @@ map f = fromStreamD . D.map f . toStreamD -- {-# INLINE postscan #-} postscan :: Monad m => Fold m a b -> Stream m a -> Stream m b -postscan fld = fromStreamD . D.postscanOnce fld . toStreamD +postscan fld = fromStreamD . D.postscan fld . toStreamD -- $smapM_Notes -- @@ -531,8 +531,8 @@ intersperseM m = fromStreamD . D.intersperseM m . toStreamD -- >>> reverse = Stream.foldlT (flip Stream.cons) Stream.nil -- {-# INLINE reverse #-} -reverse :: Monad m => Stream m a -> Stream m a -reverse s = fromStreamD $ D.reverse $ toStreamD s +reverse :: Stream m a -> Stream m a +reverse s = fromStreamK $ K.reverse $ toStreamK s -- | Like 'reverse' but several times faster, requires a 'Storable' instance. -- @@ -651,7 +651,7 @@ foldManyPost f m = fromStreamD $ D.foldManyPost f (toStreamD m) {-# INLINE zipWithM #-} zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c -zipWithM f m1 m2 = fromStreamD $ D.zipWithM f (toStreamD m1) (toStreamD m2) +zipWithM f m1 m2 = fromStreamK $ K.zipWithM f (toStreamK m1) (toStreamK m2) -- | Stream @a@ is evaluated first, followed by stream @b@, the resulting -- elements @a@ and @b@ are then zipped using the supplied zip function and the @@ -667,4 +667,4 @@ zipWithM f m1 m2 = fromStreamD $ D.zipWithM f (toStreamD m1) (toStreamD m2) -- {-# INLINE zipWith #-} zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c -zipWith f m1 m2 = fromStreamD $ D.zipWith f (toStreamD m1) (toStreamD m2) +zipWith f m1 m2 = fromStreamK $ K.zipWith f (toStreamK m1) (toStreamK m2) diff --git a/core/src/Streamly/Internal/Data/Stream/Chunked.hs b/core/src/Streamly/Internal/Data/Stream/Chunked.hs index c3ed36e63..42e6f5096 100644 --- a/core/src/Streamly/Internal/Data/Stream/Chunked.hs +++ b/core/src/Streamly/Internal/Data/Stream/Chunked.hs @@ -23,27 +23,42 @@ module Streamly.Internal.Data.Stream.Chunked -- * Elimination -- ** Element Folds - , foldBreak + -- The byte level foldBreak can work as efficiently as the chunk level. We + -- can flatten the stream to byte stream and use that. But if we want the + -- remaining stream to be a chunk stream then this could be handy. But it + -- could also be implemented using parseBreak. + , foldBreak -- StreamK.foldBreakChunks , foldBreakD - , parseBreak + -- 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 -- , parseBreakD + -- , foldManyChunks + -- , parseManyChunks -- ** Array Folds + -- XXX Use Parser.Chunked instead, need only chunkedParseBreak, + -- foldBreak can be implemented using parseBreak. Use StreamK. , runArrayFold , runArrayFoldBreak -- , parseArr - , runArrayParserDBreak - , runArrayFoldMany + , runArrayParserDBreak -- StreamK.chunkedParseBreak + , runArrayFoldMany -- StreamK.chunkedParseMany , toArray -- * Compaction - , lpackArraysChunksOf - , compact + -- We can use something like foldManyChunks, parseManyChunks with a take + -- fold. + , lpackArraysChunksOf -- Fold.compactChunks + , compact -- rechunk, compactChunks -- * Splitting - , splitOn - , splitOnSuffix + -- We can use something like foldManyChunks, parseManyChunks with an + -- appropriate splitting fold. + , splitOn -- Stream.rechunkOn + , splitOnSuffix -- Stream.rechunkOnSuffix ) where @@ -62,12 +77,11 @@ import GHC.Types (SPEC(..)) import Prelude hiding (null, last, (!!), read, concat, unlines) import Streamly.Data.Fold (Fold) -import Streamly.Data.Stream (Stream) import Streamly.Internal.Data.Array.Type (Array(..)) import Streamly.Internal.Data.Fold.Chunked (ChunkFold(..)) import Streamly.Internal.Data.Parser (ParseError(..)) -import Streamly.Internal.Data.Stream - (fromStreamD, fromStreamK, toStreamD, toStreamK) +import Streamly.Internal.Data.Stream.StreamD (Stream) +import Streamly.Internal.Data.Stream.StreamK (StreamK, fromStream, toStream) import Streamly.Internal.Data.SVar.Type (adaptState, defState) import Streamly.Internal.Data.Array.Mut.Type (allocBytesToElemCount) @@ -83,15 +97,8 @@ 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.ParserD as PRD (Parser(..), Initial(..), fromParserK) -import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Stream.StreamD as D - ( fromList, nil, cons, map - , unfoldMany, append, splitInnerBy, splitInnerBySuffix, foldlM' - ) -import qualified Streamly.Internal.Data.Stream.StreamD.Type as D - (Step(Yield, Stop, Skip), Stream(Stream)) -import qualified Streamly.Internal.Data.Stream.StreamK.Type as K - (Stream, cons, nil, fromPure, foldStream) +import qualified Streamly.Internal.Data.Stream.StreamK as K -- XXX Since these are immutable arrays MonadIO constraint can be removed from -- most places. @@ -109,7 +116,7 @@ import qualified Streamly.Internal.Data.Stream.StreamK.Type as K {-# INLINE arraysOf #-} arraysOf :: (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a) -arraysOf n str = fromStreamD $ A.arraysOf n (toStreamD str) +arraysOf = A.arraysOf ------------------------------------------------------------------------------- -- Append @@ -130,7 +137,7 @@ arraysOf n str = fromStreamD $ A.arraysOf n (toStreamD str) 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 m = fromStreamD $ D.unfoldMany A.reader (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. @@ -141,7 +148,7 @@ concat m = fromStreamD $ D.unfoldMany A.reader (toStreamD m) {-# INLINE concatRev #-} concatRev :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a -- concatRev m = fromStreamD $ A.flattenArraysRev (toStreamD m) -concatRev m = fromStreamD $ D.unfoldMany A.readerRev (toStreamD m) +concatRev = D.unfoldMany A.readerRev ------------------------------------------------------------------------------- -- Intersperse and append @@ -153,12 +160,12 @@ concatRev m = fromStreamD $ D.unfoldMany A.readerRev (toStreamD m) -- /Pre-release/ {-# INLINE interpose #-} interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a -interpose x = S.interpose x A.reader +interpose x = D.interpose x A.reader {-# INLINE intercalateSuffix #-} intercalateSuffix :: (Monad m, Unbox a) => Array a -> Stream m (Array a) -> Stream m a -intercalateSuffix = S.intercalateSuffix A.reader +intercalateSuffix = D.intercalateSuffix A.reader -- | Flatten a stream of arrays appending the given element after each -- array. @@ -168,12 +175,13 @@ intercalateSuffix = S.intercalateSuffix A.reader interposeSuffix :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a -- interposeSuffix x = fromStreamD . A.unlines x . toStreamD -interposeSuffix x = S.interposeSuffix x A.reader +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) @@ -203,6 +211,11 @@ unlines sep (D.Stream step state) = D.Stream step' (OuterLoop state) -- XXX These would not be needed once we implement compactLEFold, see -- module Streamly.Internal.Data.Array.Mut.Stream -- +-- 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) @@ -211,6 +224,8 @@ packArraysChunksOf n str = -- XXX instead of writing two different versions of this operation, we should -- write it as a pipe. +-- +-- XXX Confirm that immutable arrays won't be modified. {-# INLINE_NORMAL lpackArraysChunksOf #-} lpackArraysChunksOf :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) () -> Fold m (Array a) () @@ -224,7 +239,7 @@ lpackArraysChunksOf n fld = {-# INLINE compact #-} compact :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a) -compact n xs = fromStreamD $ packArraysChunksOf n (toStreamD xs) +compact = packArraysChunksOf ------------------------------------------------------------------------------- -- Split @@ -298,8 +313,7 @@ splitOn => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8) -splitOn byte s = - fromStreamD $ D.splitInnerBy (A.breakOn byte) A.splice $ toStreamD s +splitOn byte = D.splitInnerBy (A.breakOn byte) A.splice {-# INLINE splitOnSuffix #-} splitOnSuffix @@ -308,8 +322,7 @@ splitOnSuffix -> Stream m (Array Word8) -> Stream m (Array Word8) -- splitOn byte s = fromStreamD $ A.splitOn byte $ toStreamD s -splitOnSuffix byte s = - fromStreamD $ D.splitInnerBySuffix (A.breakOn byte) A.splice $ toStreamD s +splitOnSuffix byte = D.splitInnerBySuffix (A.breakOn byte) A.splice ------------------------------------------------------------------------------- -- Elimination - Running folds @@ -395,13 +408,10 @@ foldBreakK (FL.Fold fstep initial extract) stream = do foldBreak :: (MonadIO m, Unbox a) => Fold m a b - -> Stream m (A.Array a) - -> m (b, Stream m (A.Array a)) + -> StreamK m (A.Array a) + -> m (b, StreamK m (A.Array a)) -- foldBreak f s = fmap fromStreamD <$> foldBreakD f (toStreamD s) -foldBreak f = - fmap (fmap fromStreamK) - . foldBreakK f - . toStreamK +foldBreak = foldBreakK -- If foldBreak performs better than runArrayFoldBreak we can use a rewrite -- rule to rewrite runArrayFoldBreak to fold. -- foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f) @@ -457,10 +467,6 @@ splitAtArrayListRev n ls -- Fold to a single Array ------------------------------------------------------------------------------- -{-# INLINE foldlM' #-} -foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b -foldlM' step begin = D.foldlM' step begin . S.toStreamD - -- XXX Both of these implementations of splicing seem to perform equally well. -- We need to perform benchmarks over a range of sizes though. @@ -471,16 +477,16 @@ spliceArraysLenUnsafe :: (MonadIO m, Unbox a) => Int -> Stream m (MA.Array a) -> m (MA.Array a) spliceArraysLenUnsafe len buffered = do arr <- liftIO $ MA.newPinned len - foldlM' MA.spliceUnsafe (return arr) buffered + 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 <- S.foldr S.cons S.nil s - len <- S.fold FL.sum (fmap Array.length buffered) + buffered <- D.foldr K.cons K.nil s + len <- K.fold FL.sum (fmap Array.length buffered) arr <- liftIO $ MA.newPinned len - final <- foldlM' writeArr (return arr) s + final <- D.foldlM' writeArr (return arr) (toStream buffered) return $ A.unsafeFreeze final where @@ -491,9 +497,10 @@ _spliceArrays s = do _spliceArraysBuffered :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a) _spliceArraysBuffered s = do - buffered <- S.foldr S.cons S.nil s - len <- S.fold FL.sum (fmap Array.length buffered) - A.unsafeFreeze <$> spliceArraysLenUnsafe len (fmap A.unsafeThaw s) + 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) @@ -502,7 +509,7 @@ spliceArraysRealloced s = do let n = allocBytesToElemCount (undefined :: a) (4 * 1024) idst = liftIO $ MA.newPinned n - arr <- foldlM' MA.spliceExp idst (fmap A.unsafeThaw s) + arr <- D.foldlM' MA.spliceExp idst (fmap A.unsafeThaw s) liftIO $ A.unsafeFreeze <$> MA.rightSize arr -- XXX This should just be "fold A.write" @@ -776,16 +783,13 @@ parseBreakK (PRD.Parser pstep initial extract) stream = do parseBreak :: (MonadIO m, Unbox a) => PR.Parser a m b - -> Stream m (A.Array a) - -> m (Either ParseError b, Stream m (A.Array a)) + -> StreamK m (A.Array a) + -> m (Either ParseError b, StreamK m (A.Array a)) {- parseBreak p s = fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s) -} -parseBreak p = - fmap (fmap fromStreamK) - . parseBreakK (PRD.fromParserK p) - . toStreamK +parseBreak p = parseBreakK (PRD.fromParserK p) ------------------------------------------------------------------------------- -- Elimination - Running Array Folds and parsers @@ -947,8 +951,8 @@ parseArr p s = fmap fromStreamD <$> parseBreakD p (toStreamD s) -- {-# INLINE runArrayFold #-} runArrayFold :: (MonadIO m, Unbox a) => - ChunkFold m a b -> Stream m (A.Array a) -> m (Either ParseError b) -runArrayFold (ChunkFold p) s = fst <$> runArrayParserDBreak p (toStreamD s) + ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b) +runArrayFold (ChunkFold p) s = fst <$> runArrayParserDBreak p (toStream s) -- | Like 'fold' but also returns the remaining stream. -- @@ -956,9 +960,9 @@ runArrayFold (ChunkFold p) s = fst <$> runArrayParserDBreak p (toStreamD s) -- {-# INLINE runArrayFoldBreak #-} runArrayFoldBreak :: (MonadIO m, Unbox a) => - ChunkFold m a b -> Stream m (A.Array a) -> m (Either ParseError b, Stream m (A.Array a)) + ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b, StreamK m (A.Array a)) runArrayFoldBreak (ChunkFold p) s = - second fromStreamD <$> runArrayParserDBreak p (toStreamD s) + second fromStream <$> runArrayParserDBreak p (toStream s) {-# ANN type ParseChunksState Fuse #-} data ParseChunksState x inpBuf st pst = @@ -1205,6 +1209,6 @@ runArrayFoldManyD runArrayFoldMany :: (Monad m, Unbox a) => ChunkFold m a b - -> Stream m (Array a) - -> Stream m (Either ParseError b) -runArrayFoldMany p m = fromStreamD $ runArrayFoldManyD p (toStreamD m) + -> StreamK m (Array a) + -> StreamK m (Either ParseError b) +runArrayFoldMany p m = fromStream $ runArrayFoldManyD p (toStream m) diff --git a/core/src/Streamly/Internal/Data/Stream/Cross.hs b/core/src/Streamly/Internal/Data/Stream/Cross.hs index 83a678a8d..673d48be5 100644 --- a/core/src/Streamly/Internal/Data/Stream/Cross.hs +++ b/core/src/Streamly/Internal/Data/Stream/Cross.hs @@ -121,7 +121,7 @@ instance Monad m => Monad (CrossStream m) where CrossStream (Stream.fromStreamK $ K.bindWith - K.serial + K.append (Stream.toStreamK m) (Stream.toStreamK . unCrossStream . f)) diff --git a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs index d34cd5f2d..1653dcb9b 100644 --- a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs +++ b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs @@ -217,7 +217,7 @@ foldlS f z = -- {-# INLINE_NORMAL parseD #-} parseD :: Monad m => PRD.Parser a m b -> Stream m a -> m (Either ParseError b) -parseD p = D.parse p . toStreamD +parseD p = D.parseD p . toStreamD -- XXX Drive directly as parserK rather than converting to parserD first. @@ -248,7 +248,7 @@ parse = parseD . PRD.fromParserK parseBreakD :: Monad m => PRD.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a) parseBreakD parser strm = do - (b, strmD) <- D.parseBreak parser (toStreamD strm) + (b, strmD) <- D.parseBreakD parser (toStreamD strm) return $! (b, fromStreamD strmD) -- | Parse a stream using the supplied 'Parser'. @@ -257,7 +257,7 @@ parseBreakD parser strm = do -- {-# INLINE parseBreak #-} parseBreak :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a) -parseBreak p strm = fmap f $ K.parseBreak (PRD.fromParserK p) (toStreamK strm) +parseBreak p strm = fmap f $ K.parseBreak p (toStreamK strm) where diff --git a/core/src/Streamly/Internal/Data/Stream/Exception.hs b/core/src/Streamly/Internal/Data/Stream/Exception.hs index 02855ffb5..f58269a3f 100644 --- a/core/src/Streamly/Internal/Data/Stream/Exception.hs +++ b/core/src/Streamly/Internal/Data/Stream/Exception.hs @@ -63,7 +63,7 @@ before action xs = fromStreamD $ D.before action $ toStreamD xs -- {-# INLINE afterUnsafe #-} afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a -afterUnsafe action xs = fromStreamD $ D.after_ action $ toStreamD xs +afterUnsafe action xs = fromStreamD $ D.afterUnsafe action $ toStreamD xs -- | Run the action @IO b@ whenever the stream is evaluated to completion, or -- if it is garbage collected after a partial lazy evaluation. @@ -75,7 +75,7 @@ afterUnsafe action xs = fromStreamD $ D.after_ action $ toStreamD xs -- {-# INLINE afterIO #-} afterIO :: MonadIO m => IO b -> Stream m a -> Stream m a -afterIO action xs = fromStreamD $ D.after action $ toStreamD xs +afterIO action xs = fromStreamD $ D.afterIO action $ toStreamD xs -- | Run the action @m b@ if the stream evaluation is aborted due to an -- exception. The exception is not caught, simply rethrown. @@ -98,7 +98,7 @@ onException action xs = fromStreamD $ D.onException action $ toStreamD xs -- {-# INLINE finallyUnsafe #-} finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a -finallyUnsafe action xs = fromStreamD $ D.finally_ action $ toStreamD xs +finallyUnsafe action xs = fromStreamD $ D.finallyUnsafe action $ toStreamD xs -- | Run the action @IO b@ whenever the stream stream stops normally, aborts -- due to an exception or if it is garbage collected after a partial lazy @@ -116,7 +116,7 @@ finallyUnsafe action xs = fromStreamD $ D.finally_ action $ toStreamD xs {-# INLINE finallyIO #-} finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a -finallyIO action xs = fromStreamD $ D.finally action $ toStreamD xs +finallyIO action xs = fromStreamD $ D.finallyIO action $ toStreamD xs -- | Like 'bracket' but with following differences: -- @@ -132,7 +132,7 @@ finallyIO action xs = fromStreamD $ D.finally action $ toStreamD xs {-# INLINE bracketUnsafe #-} bracketUnsafe :: MonadCatch m => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a -bracketUnsafe bef aft bet = fromStreamD $ D.bracket_ bef aft (toStreamD . bet) +bracketUnsafe bef aft bet = fromStreamD $ D.bracketUnsafe bef aft (toStreamD . bet) -- | Run the alloc action @IO b@ with async exceptions disabled but keeping -- blocking operations interruptible (see 'Control.Exception.mask'). Use the @@ -188,7 +188,7 @@ bracketIO3 :: (MonadIO m, MonadCatch m) -> (b -> Stream m a) -> Stream m a bracketIO3 bef aft gc exc bet = fromStreamD $ - D.bracket' bef aft exc gc (toStreamD . bet) + D.bracketIO3 bef aft exc gc (toStreamD . bet) -- | Like 'handle' but the exception handler is also provided with the stream -- that generated the exception as input. The exception handler can thus diff --git a/core/src/Streamly/Internal/Data/Stream/Expand.hs b/core/src/Streamly/Internal/Data/Stream/Expand.hs index bf0d5808e..1dd9d6d05 100644 --- a/core/src/Streamly/Internal/Data/Stream/Expand.hs +++ b/core/src/Streamly/Internal/Data/Stream/Expand.hs @@ -281,7 +281,7 @@ interleaveMin2 s1 s2 = {-# INLINE interleaveFstSuffix2 #-} interleaveFstSuffix2 :: Monad m => Stream m b -> Stream m b -> Stream m b interleaveFstSuffix2 m1 m2 = - fromStreamD $ D.interleaveSuffix (toStreamD m1) (toStreamD m2) + fromStreamD $ D.interleaveFstSuffix (toStreamD m1) (toStreamD m2) -- | Interleaves the outputs of two streams, yielding elements from each stream -- alternately, starting from the first stream and ending at the first stream. @@ -305,7 +305,7 @@ interleaveFstSuffix2 m1 m2 = {-# INLINE interleaveFst2 #-} interleaveFst2 :: Monad m => Stream m b -> Stream m b -> Stream m b interleaveFst2 m1 m2 = - fromStreamD $ D.interleaveInfix (toStreamD m1) (toStreamD m2) + fromStreamD $ D.interleaveFst (toStreamD m1) (toStreamD m2) ------------------------------------------------------------------------------ -- Scheduling @@ -449,7 +449,7 @@ unfoldMany u m = fromStreamD $ D.unfoldMany u (toStreamD m) {-# INLINE unfoldInterleave #-} unfoldInterleave ::Monad m => Unfold m a b -> Stream m a -> Stream m b unfoldInterleave u m = - fromStreamD $ D.unfoldManyInterleave u (toStreamD m) + fromStreamD $ D.unfoldInterleave u (toStreamD m) -- | 'unfoldInterleave' switches to the next stream whenever a value from a -- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps @@ -460,7 +460,7 @@ unfoldInterleave u m = {-# INLINE unfoldRoundRobin #-} unfoldRoundRobin ::Monad m => Unfold m a b -> Stream m a -> Stream m b unfoldRoundRobin u m = - fromStreamD $ D.unfoldManyRoundRobin u (toStreamD m) + fromStreamD $ D.unfoldRoundRobin u (toStreamD m) ------------------------------------------------------------------------------ -- Combine N Streams - interpose @@ -478,7 +478,7 @@ unfoldRoundRobin u m = interpose :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c interpose x unf str = - fromStreamD $ D.interpose (return x) unf (toStreamD str) + fromStreamD $ D.interpose x unf (toStreamD str) -- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x) @@ -492,7 +492,7 @@ interpose x unf str = interposeSuffix :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c interposeSuffix x unf str = - fromStreamD $ D.interposeSuffix (return x) unf (toStreamD str) + fromStreamD $ D.interposeSuffix x unf (toStreamD str) ------------------------------------------------------------------------------ -- Combine N Streams - intercalate @@ -563,8 +563,8 @@ gintercalateSuffix unf1 str1 unf2 str2 = {-# INLINE intercalateSuffix #-} intercalateSuffix :: Monad m => Unfold m b c -> b -> Stream m b -> Stream m c -intercalateSuffix unf seed str = fromStreamD $ D.unfoldMany unf - $ D.intersperseMSuffix (return seed) (toStreamD str) +intercalateSuffix unf seed = + fromStreamD . D.intercalateSuffix unf seed . toStreamD ------------------------------------------------------------------------------ -- Combine N Streams - concatMap @@ -633,7 +633,7 @@ mergeMapWith :: -> Stream m b mergeMapWith par f m = fromStreamK - $ K.concatPairsWith + $ K.mergeMapWith (\s1 s2 -> toStreamK $ fromStreamK s1 `par` fromStreamK s2) (toStreamK . f) (toStreamK m) diff --git a/core/src/Streamly/Internal/Data/Stream/Reduce.hs b/core/src/Streamly/Internal/Data/Stream/Reduce.hs index e5c4bf773..fdf79dc2a 100644 --- a/core/src/Streamly/Internal/Data/Stream/Reduce.hs +++ b/core/src/Streamly/Internal/Data/Stream/Reduce.hs @@ -355,7 +355,7 @@ parseMany -> Stream m a -> Stream m (Either ParseError b) parseMany p m = - fromStreamD $ D.parseMany (ParserD.fromParserK p) (toStreamD m) + fromStreamD $ D.parseManyD (ParserD.fromParserK p) (toStreamD m) -- | Same as parseMany but for StreamD streams. -- @@ -368,7 +368,7 @@ parseManyD -> Stream m a -> Stream m (Either ParseError b) parseManyD p m = - fromStreamD $ D.parseMany p (toStreamD m) + fromStreamD $ D.parseManyD p (toStreamD m) -- | Apply a stream of parsers to an input stream and emit the results in the -- output stream. @@ -424,7 +424,7 @@ parseIterate -> Stream m a -> Stream m (Either ParseError b) parseIterate f i m = fromStreamD $ - D.parseIterate (ParserD.fromParserK . f) i (toStreamD m) + D.parseIterateD (ParserD.fromParserK . f) i (toStreamD m) ------------------------------------------------------------------------------ -- Chunking diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD.hs b/core/src/Streamly/Internal/Data/Stream/StreamD.hs index 854ba7ed3..ae313e6bc 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamD.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD.hs @@ -25,6 +25,8 @@ module Streamly.Internal.Data.Stream.StreamD , module Streamly.Internal.Data.Stream.StreamD.Transformer , module Streamly.Internal.Data.Stream.StreamD.Nesting , module Streamly.Internal.Data.Stream.StreamD.Transform + , module Streamly.Internal.Data.Stream.StreamD.Top + , module Streamly.Internal.Data.Stream.StreamD.Container ) where @@ -36,3 +38,5 @@ import Streamly.Internal.Data.Stream.StreamD.Lift import Streamly.Internal.Data.Stream.StreamD.Transformer import Streamly.Internal.Data.Stream.StreamD.Nesting import Streamly.Internal.Data.Stream.StreamD.Transform +import Streamly.Internal.Data.Stream.StreamD.Top +import Streamly.Internal.Data.Stream.StreamD.Container diff --git a/core/src/Streamly/Internal/Data/Stream/Container.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Container.hs similarity index 85% rename from core/src/Streamly/Internal/Data/Stream/Container.hs rename to core/src/Streamly/Internal/Data/Stream/StreamD/Container.hs index cabd2b74d..3297a6f59 100644 --- a/core/src/Streamly/Internal/Data/Stream/Container.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Container.hs @@ -1,5 +1,5 @@ -- | --- Module : Streamly.Internal.Data.Stream.Container +-- Module : Streamly.Internal.Data.Stream.StreamD.Container -- Copyright : (c) 2019 Composewell Technologies -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com @@ -8,9 +8,7 @@ -- -- Stream operations that require transformers or containers like Set or Map. --- Rename this to Stream.Container? - -module Streamly.Internal.Data.Stream.Container +module Streamly.Internal.Data.Stream.StreamD.Container ( nub @@ -32,20 +30,19 @@ import Control.Monad.Trans.State.Strict (get, put) import Data.Function ((&)) import Data.Maybe (isJust) import Streamly.Internal.Data.Stream.StreamD.Step (Step(..)) -import Streamly.Internal.Data.Stream.Type (Stream) -import Streamly.Internal.Data.Stream.Cross (CrossStream(..)) +import Streamly.Internal.Data.Stream.StreamD.Type + (Stream(..), mkCross, unCross) import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Streamly.Data.Fold as Fold import qualified Streamly.Internal.Data.Array.Generic as Array import qualified Streamly.Internal.Data.Array.Mut.Type as MA -import qualified Streamly.Internal.Data.Stream.Bottom as Stream -import qualified Streamly.Internal.Data.Stream.Expand as Stream -import qualified Streamly.Internal.Data.Stream.Generate as Stream -import qualified Streamly.Internal.Data.Stream.Transform as Stream -import qualified Streamly.Internal.Data.Stream.StreamD as D -import qualified Streamly.Internal.Data.Stream.Transformer as Stream +import qualified Streamly.Internal.Data.Stream.StreamD.Type as Stream +import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Stream +import qualified Streamly.Internal.Data.Stream.StreamD.Generate as Stream +import qualified Streamly.Internal.Data.Stream.StreamD.Transform as Stream +import qualified Streamly.Internal.Data.Stream.StreamD.Transformer as Stream -- $setup -- >>> :m @@ -55,8 +52,8 @@ import qualified Streamly.Internal.Data.Stream.Transformer as Stream -- stream. If we want to limit the memory we can just use "take" to limit the -- uniq elements in the stream. {-# INLINE_NORMAL nub #-} -nub :: (Monad m, Ord a) => D.Stream m a -> D.Stream m a -nub (D.Stream step1 state1) = D.Stream step (Set.empty, state1) +nub :: (Monad m, Ord a) => Stream m a -> Stream m a +nub (Stream step1 state1) = Stream step (Set.empty, state1) where @@ -115,6 +112,8 @@ joinInner s1 s2 = -- Ordering returning function. The time complexity would then become (m x log -- n). +-- XXX Check performance of StreamD vs StreamK + -- | Like 'joinInner' but emit @(a, Just b)@, and additionally, for those @a@'s -- that are not equal to any @b@ emit @(a, Nothing)@. -- @@ -133,25 +132,25 @@ joinInner s1 s2 = {-# INLINE joinLeftGeneric #-} joinLeftGeneric :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, Maybe b) -joinLeftGeneric eq s1 s2 = Stream.evalStateT (return False) $ unCrossStream $ do - a <- CrossStream (Stream.liftInner s1) +joinLeftGeneric eq s1 s2 = Stream.evalStateT (return False) $ unCross $ do + a <- mkCross (Stream.liftInner s1) -- XXX should we use StreamD monad here? -- XXX Is there a better way to perform some action at the end of a loop -- iteration? - CrossStream (Stream.fromEffect $ put False) + mkCross (Stream.fromEffect $ put False) let final = Stream.concatEffect $ do r <- get if r then pure Stream.nil else pure (Stream.fromPure Nothing) - b <- CrossStream (fmap Just (Stream.liftInner s2) <> final) + b <- mkCross (fmap Just (Stream.liftInner s2) `Stream.append` final) case b of Just b1 -> if a `eq` b1 then do - CrossStream (Stream.fromEffect $ put True) + mkCross (Stream.fromEffect $ put True) return (a, Just b1) - else CrossStream Stream.nil + else mkCross Stream.nil Nothing -> return (a, Nothing) -- XXX rename to joinLeftOrd? @@ -180,6 +179,8 @@ joinLeft s1 s2 = -- XXX We can do this concurrently. +-- XXX Check performance of StreamD vs StreamK + -- | Like 'joinLeft' but emits a @(Just a, Just b)@. Like 'joinLeft', for those -- @a@'s that are not equal to any @b@ emit @(Just a, Nothing)@, but -- additionally, for those @b@'s that are not equal to any @a@ emit @(Nothing, @@ -206,7 +207,7 @@ joinOuterGeneric eq s1 s = Stream.fold (MA.writeN len) (Stream.fromList (Prelude.replicate len False)) - return $ go inputArr foundArr <> leftOver inputArr foundArr + return $ go inputArr foundArr `Stream.append` leftOver inputArr foundArr where @@ -222,14 +223,14 @@ joinOuterGeneric eq s1 s = ) stream1 stream2 ) & Stream.catMaybes - evalState = Stream.evalStateT (return False) . unCrossStream + evalState = Stream.evalStateT (return False) . unCross go inputArr foundArr = evalState $ do - a <- CrossStream (Stream.liftInner s1) + a <- mkCross (Stream.liftInner s1) -- XXX should we use StreamD monad here? -- XXX Is there a better way to perform some action at the end of a loop -- iteration? - CrossStream (Stream.fromEffect $ put False) + mkCross (Stream.fromEffect $ put False) let final = Stream.concatEffect $ do r <- get if r @@ -237,17 +238,17 @@ joinOuterGeneric eq s1 s = else pure (Stream.fromPure Nothing) (i, b) <- let stream = Array.read inputArr - in CrossStream - (Stream.indexed $ fmap Just (Stream.liftInner stream) <> final) + in mkCross + (Stream.indexed $ fmap Just (Stream.liftInner stream) `Stream.append` final) case b of Just b1 -> if a `eq` b1 then do - CrossStream (Stream.fromEffect $ put True) + mkCross (Stream.fromEffect $ put True) MA.putIndex i foundArr True return (Just a, Just b1) - else CrossStream Stream.nil + else mkCross Stream.nil Nothing -> return (Just a, Nothing) -- Put the b's that have been paired, in another hash or mutate the hash to set diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs index 8315e0c1b..c32a3523e 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs @@ -17,7 +17,9 @@ module Streamly.Internal.Data.Stream.StreamD.Eliminate -- -- * Running a 'Parser' , parse + , parseD , parseBreak + , parseBreakD -- * Stream Deconstruction , uncons @@ -69,33 +71,50 @@ module Streamly.Internal.Data.Stream.StreamD.Eliminate -- ** Substreams -- | These should probably be expressed using parsers. , isPrefixOf + , isInfixOf + , isSuffixOf + , isSuffixOfUnbox , isSubsequenceOf , stripPrefix + , stripSuffix + , stripSuffixUnbox ) where #include "inline.hs" import Control.Exception (assert) +import Control.Monad.IO.Class (MonadIO(..)) +import Foreign.Storable (Storable) import GHC.Exts (SpecConstrAnnotation(..)) import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Parser (ParseError(..)) import Streamly.Internal.Data.SVar.Type (defState) +import Streamly.Internal.Data.Unboxed (Unbox) import Streamly.Internal.Data.Maybe.Strict (Maybe'(..)) -#ifdef USE_FOLDS_EVERYWHERE + +import qualified Streamly.Internal.Data.Array.Type as Array import qualified Streamly.Internal.Data.Fold as Fold -#endif import qualified Streamly.Internal.Data.Parser as PR import qualified Streamly.Internal.Data.Parser.ParserD as PRD import qualified Streamly.Internal.Data.Stream.StreamD.Generate as StreamD import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Nesting +import qualified Streamly.Internal.Data.Stream.StreamD.Transform as StreamD import Prelude hiding ( all, any, elem, foldr, foldr1, head, last, lookup, mapM, mapM_ , maximum, minimum, notElem, null, splitAt, tail, (!!)) import Streamly.Internal.Data.Stream.StreamD.Type +-- $setup +-- >>> :m +-- >>> import Streamly.Internal.Data.Stream (Stream) +-- >>> import qualified Streamly.Internal.Data.Stream as Stream +-- >>> import qualified Streamly.Internal.Data.Parser as Parser +-- >>> import qualified Streamly.Internal.Data.Fold as Fold +-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold + ------------------------------------------------------------------------------ -- Elimination by Folds ------------------------------------------------------------------------------ @@ -138,24 +157,40 @@ splitAt n ls newtype List a = List {getList :: [a]} -- | Run a 'Parse' over a stream. -{-# INLINE_NORMAL parse #-} -parse +{-# INLINE_NORMAL parseD #-} +parseD :: Monad m => PRD.Parser a m b -> Stream m a -> m (Either ParseError b) -parse parser strm = do - (b, _) <- parseBreak parser strm +parseD parser strm = do + (b, _) <- parseBreakD parser strm return b +-- | Parse a stream using the supplied 'Parser'. +-- +-- Parsers (See "Streamly.Internal.Data.Parser") are more powerful folds that +-- add backtracking and error functionality to terminating folds. Unlike folds, +-- parsers may not always result in a valid output, they may result in an +-- error. For example: +-- +-- >>> Stream.parse (Parser.takeEQ 1 Fold.drain) Stream.nil +-- Left (ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0") +-- +-- Note: @parse p@ is not the same as @head . parseMany p@ on an empty stream. +-- +{-# INLINE [3] parse #-} +parse :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b) +parse = parseD . PRD.fromParserK + -- | Run a 'Parse' over a stream and return rest of the Stream. -{-# INLINE_NORMAL parseBreak #-} -parseBreak +{-# INLINE_NORMAL parseBreakD #-} +parseBreakD :: Monad m => PRD.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a) -parseBreak (PRD.Parser pstep initial extract) stream@(Stream step state) = do +parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do res <- initial case res of PRD.IPartial s -> go SPEC state (List []) s @@ -308,6 +343,12 @@ parseBreak (PRD.Parser pstep initial extract) stream@(Stream step state) = do PR.Error err -> return (Left (ParseError err), StreamD.nil) +-- | Parse a stream using the supplied 'Parser'. +-- +{-# INLINE parseBreak #-} +parseBreak :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a) +parseBreak p = parseBreakD (PRD.fromParserK p) + ------------------------------------------------------------------------------ -- Specialized Folds ------------------------------------------------------------------------------ @@ -601,8 +642,14 @@ mapM_ m = drain . mapM m -- Multi-stream folds ------------------------------------------------------------------------------ +-- | Returns 'True' if the first stream is the same as or a prefix of the +-- second. A stream is a prefix of itself. +-- +-- >>> Stream.isPrefixOf (Stream.fromList "hello") (Stream.fromList "hello" :: Stream IO Char) +-- True +-- {-# INLINE_NORMAL isPrefixOf #-} -isPrefixOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool +isPrefixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool isPrefixOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb where @@ -624,8 +671,15 @@ isPrefixOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb Skip sb' -> go SPEC (Just' x) sa sb' Stop -> return False +-- | Returns 'True' if all the elements of the first stream occur, in order, in +-- the second stream. The elements do not have to occur consecutively. A stream +-- is a subsequence of itself. +-- +-- >>> Stream.isSubsequenceOf (Stream.fromList "hlo") (Stream.fromList "hello" :: Stream IO Char) +-- True +-- {-# INLINE_NORMAL isSubsequenceOf #-} -isSubsequenceOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool +isSubsequenceOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb where @@ -647,9 +701,16 @@ isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb Skip sb' -> go SPEC (Just' x) sa sb' Stop -> return False +-- | @stripPrefix prefix input@ strips the @prefix@ stream from the @input@ +-- stream if it is a prefix of input. Returns 'Nothing' if the input does not +-- start with the given prefix, stripped input otherwise. Returns @Just nil@ +-- when the prefix is the same as the input stream. +-- +-- Space: @O(1)@ +-- {-# INLINE_NORMAL stripPrefix #-} stripPrefix - :: (Eq a, Monad m) + :: (Monad m, Eq a) => Stream m a -> Stream m a -> m (Maybe (Stream m a)) stripPrefix (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb @@ -671,3 +732,95 @@ stripPrefix (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb else return Nothing Skip sb' -> go SPEC (Just' x) sa sb' Stop -> return Nothing + +-- | Returns 'True' if the first stream is an infix of the second. A stream is +-- considered an infix of itself. +-- +-- >>> s = Stream.fromList "hello" :: Stream IO Char +-- >>> Stream.isInfixOf s s +-- True +-- +-- Space: @O(n)@ worst case where @n@ is the length of the infix. +-- +-- /Pre-release/ +-- +-- /Requires 'Storable' constraint/ +-- +{-# INLINE isInfixOf #-} +isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a) + => Stream m a -> Stream m a -> m Bool +isInfixOf infx stream = do + arr <- fold Array.write infx + -- XXX can use breakOnSeq instead (when available) + r <- null $ StreamD.drop 1 $ Nesting.splitOnSeq arr Fold.drain stream + return (not r) + +-- Note: isPrefixOf uses the prefix stream only once. In contrast, isSuffixOf +-- may use the suffix stream many times. To run in optimal memory we do not +-- want to buffer the suffix stream in memory therefore we need an ability to +-- clone (or consume it multiple times) the suffix stream without any side +-- effects so that multiple potential suffix matches can proceed in parallel +-- without buffering the suffix stream. For example, we may create the suffix +-- stream from a file handle, however, if we evaluate the stream multiple +-- times, once for each match, we will need a different file handle each time +-- which may exhaust the file descriptors. Instead, we want to share the same +-- underlying file descriptor, use pread on it to generate the stream and clone +-- the stream for each match. Therefore the suffix stream should be built in +-- such a way that it can be consumed multiple times without any problems. + +-- XXX Can be implemented with better space/time complexity. +-- Space: @O(n)@ worst case where @n@ is the length of the suffix. + +-- | Returns 'True' if the first stream is a suffix of the second. A stream is +-- considered a suffix of itself. +-- +-- >>> Stream.isSuffixOf (Stream.fromList "hello") (Stream.fromList "hello" :: Stream IO Char) +-- True +-- +-- Space: @O(n)@, buffers entire input stream and the suffix. +-- +-- /Pre-release/ +-- +-- /Suboptimal/ - Help wanted. +-- +{-# INLINE isSuffixOf #-} +isSuffixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool +isSuffixOf suffix stream = + StreamD.reverse suffix `isPrefixOf` StreamD.reverse stream + +-- | Much faster than 'isSuffixOf'. +{-# INLINE isSuffixOfUnbox #-} +isSuffixOfUnbox :: (MonadIO m, Eq a, Unbox a) => + Stream m a -> Stream m a -> m Bool +isSuffixOfUnbox suffix stream = + StreamD.reverseUnbox suffix `isPrefixOf` StreamD.reverseUnbox stream + +-- | Drops the given suffix from a stream. Returns 'Nothing' if the stream does +-- not end with the given suffix. Returns @Just nil@ when the suffix is the +-- same as the stream. +-- +-- It may be more efficient to convert the stream to an Array and use +-- stripSuffix on that especially if the elements have a Storable or Prim +-- instance. +-- +-- See also "Streamly.Internal.Data.Stream.Reduce.dropSuffix". +-- +-- Space: @O(n)@, buffers the entire input stream as well as the suffix +-- +-- /Pre-release/ +{-# INLINE stripSuffix #-} +stripSuffix + :: (Monad m, Eq a) + => Stream m a -> Stream m a -> m (Maybe (Stream m a)) +stripSuffix m1 m2 = + fmap StreamD.reverse + <$> stripPrefix (StreamD.reverse m1) (StreamD.reverse m2) + +-- | Much faster than 'stripSuffix'. +{-# INLINE stripSuffixUnbox #-} +stripSuffixUnbox + :: (MonadIO m, Eq a, Unbox a) + => Stream m a -> Stream m a -> m (Maybe (Stream m a)) +stripSuffixUnbox m1 m2 = + fmap StreamD.reverseUnbox + <$> stripPrefix (StreamD.reverseUnbox m1) (StreamD.reverseUnbox m2) diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD/Exception.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Exception.hs index 87a2573b5..da0088120 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamD/Exception.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Exception.hs @@ -11,13 +11,14 @@ module Streamly.Internal.Data.Stream.StreamD.Exception gbracket_ , gbracket , before - , after_ - , after - , bracket_ - , bracket' + , afterUnsafe + , afterIO + , bracketUnsafe + , bracketIO3 + , bracketIO , onException - , finally_ - , finally + , finallyUnsafe + , finallyIO , ghandle , handle ) @@ -36,6 +37,10 @@ import qualified Control.Monad.Catch as MC import Streamly.Internal.Data.Stream.StreamD.Type +-- $setup +-- >>> :m +-- >>> import qualified Streamly.Internal.Data.Stream as Stream + data GbracketState s1 s2 v = GBracketInit | GBracketNormal s1 v @@ -169,7 +174,12 @@ gbracket bef aft onExc onGC ftry action = Skip s -> return $ Skip (GBracketIOException (Stream step1 s)) Stop -> return Stop --- | See 'Streamly.Internal.Data.Stream.before'. +-- | Run the action @m b@ before the stream yields its first element. +-- +-- Same as the following but more efficient due to fusion: +-- +-- >>> before action xs = Stream.nilM action <> xs +-- >>> before action xs = Stream.concatMap (const xs) (Stream.fromEffect action) -- {-# INLINE_NORMAL before #-} before :: Monad m => m b -> Stream m a -> Stream m a @@ -187,11 +197,22 @@ before action (Stream step state) = Stream step' Nothing Skip s -> return $ Skip (Just s) Stop -> return Stop --- | See 'Streamly.Internal.Data.Stream.after_'. +-- | Like 'after', with following differences: -- -{-# INLINE_NORMAL after_ #-} -after_ :: Monad m => m b -> Stream m a -> Stream m a -after_ action (Stream step state) = Stream step' state +-- * action @m b@ won't run if the stream is garbage collected +-- after partial evaluation. +-- * Monad @m@ does not require any other constraints. +-- * has slightly better performance than 'after'. +-- +-- Same as the following, but with stream fusion: +-- +-- >>> afterUnsafe action xs = xs <> Stream.nilM action +-- +-- /Pre-release/ +-- +{-# INLINE_NORMAL afterUnsafe #-} +afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a +afterUnsafe action (Stream step state) = Stream step' state where @@ -203,12 +224,18 @@ after_ action (Stream step state) = Stream step' state Skip s -> return $ Skip s Stop -> action >> return Stop --- | See 'Streamly.Internal.Data.Stream.after'. +-- | Run the action @IO b@ whenever the stream is evaluated to completion, or +-- if it is garbage collected after a partial lazy evaluation. -- -{-# INLINE_NORMAL after #-} -after :: MonadIO m +-- The semantics of the action @IO b@ are similar to the semantics of cleanup +-- action in 'bracketIO'. +-- +-- /See also 'afterUnsafe'/ +-- +{-# INLINE_NORMAL afterIO #-} +afterIO :: MonadIO m => IO b -> Stream m a -> Stream m a -after action (Stream step state) = Stream step' Nothing +afterIO action (Stream step state) = Stream step' Nothing where @@ -227,8 +254,11 @@ after action (Stream step state) = Stream step' Nothing -- XXX For high performance error checks in busy streams we may need another -- Error constructor in step. + +-- | Run the action @m b@ if the stream evaluation is aborted due to an +-- exception. The exception is not caught, simply rethrown. -- --- | See 'Streamly.Internal.Data.Stream.onException'. +-- /Inhibits stream fusion/ -- {-# INLINE_NORMAL onException #-} onException :: MonadCatch m => m b -> Stream m a -> Stream m a @@ -254,29 +284,55 @@ _onException action (Stream step state) = Stream step' state Skip s -> return $ Skip s Stop -> return Stop --- | See 'Streamly.Internal.Data.Stream.bracket_'. +-- | Like 'bracket' but with following differences: -- -{-# INLINE_NORMAL bracket_ #-} -bracket_ :: MonadCatch m +-- * alloc action @m b@ runs with async exceptions enabled +-- * cleanup action @b -> m c@ won't run if the stream is garbage collected +-- after partial evaluation. +-- * has slightly better performance than 'bracketIO'. +-- +-- /Inhibits stream fusion/ +-- +-- /Pre-release/ +-- +{-# INLINE_NORMAL bracketUnsafe #-} +bracketUnsafe :: MonadCatch m => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a -bracket_ bef aft = +bracketUnsafe bef aft = gbracket_ bef aft (\a (e :: SomeException) _ -> nilM (aft a >> MC.throwM e)) (inline MC.try) --- | See 'Streamly.Internal.Data.Stream.bracket'. +-- For a use case of this see the "streamly-process" package. It needs to kill +-- the process in case of exception or garbage collection, but waits for the +-- process to terminate in normal cases. + +-- | Like 'bracketIO' but can use 3 separate cleanup actions depending on the +-- mode of termination: -- -{-# INLINE_NORMAL bracket' #-} -bracket' :: (MonadIO m, MonadCatch m) => +-- 1. When the stream stops normally +-- 2. When the stream is garbage collected +-- 3. When the stream encounters an exception +-- +-- @bracketIO3 before onStop onGC onException action@ runs @action@ using the +-- result of @before@. If the stream stops, @onStop@ action is executed, if the +-- stream is abandoned @onGC@ is executed, if the stream encounters an +-- exception @onException@ is executed. +-- +-- /Inhibits stream fusion/ +-- +-- /Pre-release/ +{-# INLINE_NORMAL bracketIO3 #-} +bracketIO3 :: (MonadIO m, MonadCatch m) => IO b -> (b -> IO c) -> (b -> IO d) -> (b -> IO e) -> (b -> Stream m a) -> Stream m a -bracket' bef aft onExc onGC = +bracketIO3 bef aft onExc onGC = gbracket bef aft @@ -284,6 +340,32 @@ bracket' bef aft onExc onGC = onGC (inline MC.try) +-- | Run the alloc action @IO b@ with async exceptions disabled but keeping +-- blocking operations interruptible (see 'Control.Exception.mask'). Use the +-- output @b@ as input to @b -> Stream m a@ to generate an output stream. +-- +-- @b@ is usually a resource under the IO monad, e.g. a file handle, that +-- requires a cleanup after use. The cleanup action @b -> IO c@, runs whenever +-- the stream ends normally, due to a sync or async exception or if it gets +-- garbage collected after a partial lazy evaluation. +-- +-- 'bracketIO' only guarantees that the cleanup action runs, and it runs with +-- async exceptions enabled. The action must ensure that it can successfully +-- cleanup the resource in the face of sync or async exceptions. +-- +-- When the stream ends normally or on a sync exception, cleanup action runs +-- immediately in the current thread context, whereas in other cases it runs in +-- the GC context, therefore, cleanup may be delayed until the GC gets to run. +-- +-- /See also: 'bracketUnsafe'/ +-- +-- /Inhibits stream fusion/ +-- +{-# INLINE bracketIO #-} +bracketIO :: (MonadIO m, MonadCatch m) + => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a +bracketIO bef aft = bracketIO3 bef aft aft aft + data BracketState s v = BracketInit | BracketRun s v -- | Alternate (custom) implementation of 'bracket'. @@ -310,22 +392,49 @@ _bracket bef aft bet = Stream step' BracketInit Skip s -> return $ Skip (BracketRun (Stream step s) v) Stop -> aft v >> return Stop --- | See 'Streamly.Internal.Data.Stream.finally_'. +-- | Like 'finally' with following differences: -- -{-# INLINE finally_ #-} -finally_ :: MonadCatch m => m b -> Stream m a -> Stream m a -finally_ action xs = bracket_ (return ()) (const action) (const xs) +-- * action @m b@ won't run if the stream is garbage collected +-- after partial evaluation. +-- * has slightly better performance than 'finallyIO'. +-- +-- /Inhibits stream fusion/ +-- +-- /Pre-release/ +-- +{-# INLINE finallyUnsafe #-} +finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a +finallyUnsafe action xs = bracketUnsafe (return ()) (const action) (const xs) --- | See 'Streamly.Internal.Data.Stream.finally'. +-- | Run the action @IO b@ whenever the stream stream stops normally, aborts +-- due to an exception or if it is garbage collected after a partial lazy +-- evaluation. -- --- finally action xs = after action $ onException action xs +-- The semantics of running the action @IO b@ are similar to the cleanup action +-- semantics described in 'bracketIO'. -- -{-# INLINE finally #-} -finally :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a -finally action xs = bracket' (return ()) act act act (const xs) +-- >>> finallyIO release = Stream.bracketIO (return ()) (const release) +-- +-- /See also 'finallyUnsafe'/ +-- +-- /Inhibits stream fusion/ +-- +{-# INLINE finallyIO #-} +finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a +finallyIO action xs = bracketIO3 (return ()) act act act (const xs) where act _ = action --- | See 'Streamly.Internal.Data.Stream.ghandle'. +-- | Like 'handle' but the exception handler is also provided with the stream +-- that generated the exception as input. The exception handler can thus +-- re-evaluate the stream to retry the action that failed. The exception +-- handler can again call 'ghandle' on it to retry the action multiple times. +-- +-- This is highly experimental. In a stream of actions we can map the stream +-- with a retry combinator to retry each action on failure. +-- +-- /Inhibits stream fusion/ +-- +-- /Pre-release/ -- {-# INLINE_NORMAL ghandle #-} ghandle :: (MonadCatch m, Exception e) @@ -333,7 +442,10 @@ ghandle :: (MonadCatch m, Exception e) ghandle f stream = gbracket_ (return ()) return (const f) (inline MC.try) (const stream) --- | See 'Streamly.Internal.Data.Stream.handle'. +-- | When evaluating a stream if an exception occurs, stream evaluation aborts +-- and the specified exception handler is run with the exception as argument. +-- +-- /Inhibits stream fusion/ -- {-# INLINE_NORMAL handle #-} handle :: (MonadCatch m, Exception e) diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD/Generate.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Generate.hs index 82b020bfb..b85e4575b 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamD/Generate.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Generate.hs @@ -7,17 +7,6 @@ -- Stability : experimental -- Portability : GHC -- --- Prefer unfolds ("Streamly.Internal.Data.Unfold") over the combinators in --- this module. They are more powerful and efficient as they can be transformed --- and composed on the input side efficiently and they can fuse in nested --- operations (e.g. unfoldMany). All the combinators in this module can be --- expressed using unfolds with the same efficiency. --- --- Operations in this module that are not in "Streamly.Internal.Data.Unfold": --- generate, times, fromPrimIORef. --- --- We should plan to replace this module with "Streamly.Internal.Data.Unfold" --- in future. -- A few combinators in this module have been adapted from the vector package -- (c) Roman Leshchinskiy. See the notes in specific combinators. @@ -46,20 +35,50 @@ module Streamly.Internal.Data.Stream.StreamD.Generate , replicateM -- * Enumeration - , enumerateFromStepIntegral - , enumerateFromIntegral - , enumerateFromThenIntegral - , enumerateFromToIntegral - , enumerateFromThenToIntegral - + -- ** Enumerating 'Num' Types , enumerateFromStepNum , enumerateFromNum , enumerateFromThenNum + + -- ** Enumerating 'Bounded' 'Enum' Types + , enumerate + , enumerateTo + , enumerateFromBounded + + -- ** Enumerating 'Enum' Types not larger than 'Int' + , enumerateFromToSmall + , enumerateFromThenToSmall + , enumerateFromThenSmallBounded + + -- ** Enumerating 'Bounded' 'Integral' Types + , enumerateFromIntegral + , enumerateFromThenIntegral + + -- ** Enumerating 'Integral' Types + , enumerateFromToIntegral + , enumerateFromThenToIntegral + + -- ** Enumerating unbounded 'Integral' Types + , enumerateFromStepIntegral + + -- ** Enumerating 'Fractional' Types + , enumerateFromFractional , enumerateFromToFractional + , enumerateFromThenFractional , enumerateFromThenToFractional + -- ** Enumerable Type Class + , Enumerable(..) + -- * Time Enumeration , times + , timesWith + , absTimes + , absTimesWith + , relTimes + , relTimesWith + , durations + , timeout -- * From Generators -- | Generate a monadic stream from a seed. @@ -75,12 +94,15 @@ module Streamly.Internal.Data.Stream.StreamD.Generate -- * From Containers -- | Transform an input structure into a stream. - -- Note: Direct style stream does not support @fromFoldable@. , fromList , fromListM + , fromFoldable + , fromFoldableM -- * From Pointers , fromPtr + , fromPtrN + , fromByteStr# -- * Conversions , fromStreamK @@ -92,53 +114,108 @@ where #include "ArrayMacros.h" import Control.Monad.IO.Class (MonadIO(..)) +import Data.Functor.Identity (Identity(..)) import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (Storable (peek), sizeOf) +import GHC.Exts (Addr#, Ptr (Ptr)) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), asyncClock, readClock) import Streamly.Internal.Data.Time.Units - (toAbsTime, AbsTime, toRelTime64, RelTime64) + (toAbsTime, AbsTime, toRelTime64, RelTime64, addToAbsTime64) #ifdef USE_UNFOLDS_EVERYWHERE import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.Data.Unfold.Enumeration as Unfold #endif -import Prelude hiding (iterate, repeat, replicate, takeWhile) +import Data.Fixed +import Data.Int +import Data.Ratio +import Data.Word +import Numeric.Natural +import Prelude hiding (iterate, repeat, replicate, take, takeWhile) import Streamly.Internal.Data.Stream.StreamD.Type +-- $setup +-- >>> :m +-- >>> import Control.Concurrent (threadDelay) +-- >>> import Data.Function (fix, (&)) +-- >>> import Data.Semigroup (cycle1) +-- >>> import qualified Streamly.Data.Fold as Fold +-- >>> import qualified Streamly.Data.Unfold as Unfold +-- >>> import qualified Streamly.Internal.Data.Stream as Stream +-- >>> import GHC.Exts (Ptr (Ptr)) + ------------------------------------------------------------------------------ -- Primitives ------------------------------------------------------------------------------ --- | An empty 'Stream'. +-- XXX implement in terms of nilM? + +-- | A stream that terminates without producing any output or side effect. +-- +-- >>> Stream.fold Fold.toList Stream.nil +-- [] +-- {-# INLINE_NORMAL nil #-} -nil :: Monad m => Stream m a -nil = Stream (\_ _ -> return Stop) () +nil :: Applicative m => Stream m a +nil = Stream (\_ _ -> pure Stop) () -- XXX implement in terms of consM? -- cons x = consM (return x) + +-- | Fuse a pure value at the head of an existing stream:: +-- +-- >>> s = 1 `Stream.cons` Stream.fromList [2,3] +-- >>> Stream.fold Fold.toList s +-- [1,2,3] +-- +-- This function should not be used to dynamically construct a stream. If a +-- stream is constructed by successive use of this function it would take +-- O(n^2) time to consume the stream. +-- +-- This function should only be used to statically fuse an element with a +-- stream. Do not use this recursively or where it cannot be inlined. +-- +-- See "Streamly.Data.Stream.StreamK" for a 'cons' that can be used to +-- construct a stream recursively. +-- +-- Definition: +-- +-- >>> cons x xs = return x `Stream.consM` xs -- --- | Can fuse but has O(n^2) complexity. {-# INLINE_NORMAL cons #-} -cons :: Monad m => a -> Stream m a -> Stream m a +cons :: Applicative m => a -> Stream m a -> Stream m a cons x (Stream step state) = Stream step1 Nothing where {-# INLINE_LATE step1 #-} - step1 _ Nothing = return $ Yield x (Just state) + step1 _ Nothing = pure $ Yield x (Just state) step1 gst (Just st) = do - r <- step gst st - return $ - case r of + (\case Yield a s -> Yield a (Just s) Skip s -> Skip (Just s) - Stop -> Stop + Stop -> Stop) <$> step gst st ------------------------------------------------------------------------------ -- Unfolding ------------------------------------------------------------------------------ -- Adapted from vector package + +-- | Build a stream by unfolding a /monadic/ step function starting from a +-- seed. The step function returns the next element in the stream and the next +-- seed value. When it is done it returns 'Nothing' and the stream ends. For +-- example, +-- +-- >>> :{ +-- let f b = +-- if b > 2 +-- then return Nothing +-- else return (Just (b, b + 1)) +-- in Stream.fold Fold.toList $ Stream.unfoldrM f 0 +-- :} +-- [0,1,2] +-- {-# INLINE_NORMAL unfoldrM #-} unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a #ifdef USE_UNFOLDS_EVERYWHERE @@ -154,6 +231,28 @@ unfoldrM next = Stream step Nothing -> Stop #endif +-- | +-- >>> :{ +-- unfoldr step s = +-- case step s of +-- Nothing -> Stream.nil +-- Just (a, b) -> a `Stream.cons` unfoldr step b +-- :} +-- +-- Build a stream by unfolding a /pure/ step function @step@ starting from a +-- seed @s@. The step function returns the next element in the stream and the +-- next seed value. When it is done it returns 'Nothing' and the stream ends. +-- For example, +-- +-- >>> :{ +-- let f b = +-- if b > 2 +-- then Nothing +-- else Just (b, b + 1) +-- in Stream.fold Fold.toList $ Stream.unfoldr f 0 +-- :} +-- [0,1,2] +-- {-# INLINE_LATE unfoldr #-} unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a unfoldr f = unfoldrM (return . f) @@ -162,6 +261,20 @@ unfoldr f = unfoldrM (return . f) -- From values ------------------------------------------------------------------------------ +-- | +-- >>> repeatM = Stream.sequence . Stream.repeat +-- >>> repeatM = fix . Stream.consM +-- >>> repeatM = cycle1 . Stream.fromEffect +-- +-- Generate a stream by repeatedly executing a monadic action forever. +-- +-- >>> :{ +-- repeatAction = +-- Stream.repeatM (threadDelay 1000000 >> print 1) +-- & Stream.take 10 +-- & Stream.fold Fold.drain +-- :} +-- {-# INLINE_NORMAL repeatM #-} repeatM :: Monad m => m a -> Stream m a #ifdef USE_UNFOLDS_EVERYWHERE @@ -170,6 +283,11 @@ repeatM = unfold Unfold.repeatM repeatM x = Stream (\_ _ -> x >>= \r -> return $ Yield r ()) () #endif +-- | +-- Generate an infinite stream by repeating a pure value. +-- +-- >>> repeat x = Stream.repeatM (pure x) +-- {-# INLINE_NORMAL repeat #-} repeat :: Monad m => a -> Stream m a #ifdef USE_UNFOLDS_EVERYWHERE @@ -179,8 +297,13 @@ repeat x = Stream (\_ _ -> return $ Yield x ()) () #endif -- Adapted from the vector package + +-- | +-- >>> replicateM n = Stream.sequence . Stream.replicate n +-- +-- Generate a stream by performing a monadic action @n@ times. {-# INLINE_NORMAL replicateM #-} -replicateM :: forall m a. Monad m => Int -> m a -> Stream m a +replicateM :: Monad m => Int -> m a -> Stream m a #ifdef USE_UNFOLDS_EVERYWHERE replicateM n p = unfold Unfold.replicateM (n, p) #else @@ -194,6 +317,12 @@ replicateM n p = Stream step n return $ Yield x (i - 1) #endif +-- | +-- >>> replicate n = Stream.take n . Stream.repeat +-- >>> replicate n x = Stream.replicateM n (pure x) +-- +-- Generate a stream of length @n@ by repeating a value @n@ times. +-- {-# INLINE_NORMAL replicate #-} replicate :: Monad m => Int -> a -> Stream m a replicate n x = replicateM n (return x) @@ -291,8 +420,19 @@ enumerateFromThenToIntegralDn from next to = Stream step EnumInit #endif -- XXX This can perhaps be simplified and written in terms of --- enumeratFromStepIntegral as we have done in unfolds. But anyway we should be --- replacing the stream generation module with unfolds. +-- enumeratFromStepIntegral as we have done in unfolds. + +-- | Enumerate an 'Integral' type in steps up to a given limit. +-- @enumerateFromThenToIntegral from then to@ generates a finite stream whose +-- first element is @from@, the second element is @then@ and the successive +-- elements are in increments of @then - from@ up to @to@. +-- +-- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 2 6 +-- [0,2,4,6] +-- +-- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 (-2) (-6) +-- [0,-2,-4,-6] +-- {-# INLINE_NORMAL enumerateFromThenToIntegral #-} enumerateFromThenToIntegral :: (Monad m, Integral a) @@ -306,6 +446,17 @@ enumerateFromThenToIntegral from next to | otherwise = enumerateFromThenToIntegralDn from next to #endif +-- | Enumerate an 'Integral' type in steps. @enumerateFromThenIntegral from +-- then@ generates a stream whose first element is @from@, the second element +-- is @then@ and the successive elements are in increments of @then - from@. +-- The stream is bounded by the size of the 'Integral' type. +-- +-- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) 2 +-- [0,2,4,6] +-- +-- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) (-2) +-- [0,-2,-4,-6] +-- {-# INLINE_NORMAL enumerateFromThenIntegral #-} enumerateFromThenIntegral :: (Monad m, Integral a, Bounded a) @@ -320,8 +471,18 @@ enumerateFromThenIntegral from next = else enumerateFromThenToIntegralDn from next minBound #endif --- | Can be used to enumerate unbounded integrals. This does not check for --- overflow or underflow for bounded integrals. +-- | @enumerateFromStepIntegral from step@ generates an infinite stream whose +-- first element is @from@ and the successive elements are in increments of +-- @step@. +-- +-- CAUTION: This function is not safe for finite integral types. It does not +-- check for overflow, underflow or bounds. +-- +-- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromStepIntegral 0 2 +-- [0,2,4,6] +-- +-- >>> Stream.fold Fold.toList $ Stream.take 3 $ Stream.enumerateFromStepIntegral 0 (-2) +-- [0,-2,-4] -- {-# INLINE_NORMAL enumerateFromStepIntegral #-} enumerateFromStepIntegral :: (Integral a, Monad m) => a -> a -> Stream m a @@ -336,13 +497,26 @@ enumerateFromStepIntegral from stride = step _ !x = return $ Yield x $! (x + stride) #endif --- | Enumerate upwards from @from@ to @to@. We are assuming that "to" is --- constrained by the type to be within max/min bounds. +-- | Enumerate an 'Integral' type up to a given limit. +-- @enumerateFromToIntegral from to@ generates a finite stream whose first +-- element is @from@ and successive elements are in increments of @1@ up to +-- @to@. +-- +-- >>> Stream.fold Fold.toList $ Stream.enumerateFromToIntegral 0 4 +-- [0,1,2,3,4] +-- {-# INLINE enumerateFromToIntegral #-} enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a enumerateFromToIntegral from to = takeWhile (<= to) $ enumerateFromStepIntegral from 1 +-- | Enumerate an 'Integral' type. @enumerateFromIntegral from@ generates a +-- stream whose first element is @from@ and the successive elements are in +-- increments of @1@. The stream is bounded by the size of the 'Integral' type. +-- +-- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromIntegral (0 :: Int) +-- [0,1,2,3] +-- {-# INLINE enumerateFromIntegral #-} enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => a -> Stream m a enumerateFromIntegral from = enumerateFromToIntegral from maxBound @@ -351,9 +525,67 @@ enumerateFromIntegral from = enumerateFromToIntegral from maxBound -- Enumeration of Fractionals ------------------------------------------------------------------------------ --- | We cannot write a general function for Num. The only way to write code +-- We cannot write a general function for Num. The only way to write code -- portable between the two is to use a 'Real' constraint and convert between -- Fractional and Integral using fromRational which is horribly slow. + +-- Even though the underlying implementation of enumerateFromFractional and +-- enumerateFromThenFractional works for any 'Num' we have restricted these to +-- 'Fractional' because these do not perform any bounds check, in contrast to +-- integral versions and are therefore not equivalent substitutes for those. + +-- | Numerically stable enumeration from a 'Fractional' number in steps of size +-- @1@. @enumerateFromFractional from@ generates a stream whose first element +-- is @from@ and the successive elements are in increments of @1@. No overflow +-- or underflow checks are performed. +-- +-- This is the equivalent to 'enumFrom' for 'Fractional' types. For example: +-- +-- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromFractional 1.1 +-- [1.1,2.1,3.1,4.1] +-- +{-# INLINE enumerateFromFractional #-} +enumerateFromFractional :: (Monad m, Fractional a) => a -> Stream m a +enumerateFromFractional = enumerateFromNum + +-- | Numerically stable enumeration from a 'Fractional' number in steps. +-- @enumerateFromThenFractional from then@ generates a stream whose first +-- element is @from@, the second element is @then@ and the successive elements +-- are in increments of @then - from@. No overflow or underflow checks are +-- performed. +-- +-- This is the equivalent of 'enumFromThen' for 'Fractional' types. For +-- example: +-- +-- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 2.1 +-- [1.1,2.1,3.1,4.1] +-- +-- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 (-2.1) +-- [1.1,-2.1,-5.300000000000001,-8.500000000000002] +-- +{-# INLINE enumerateFromThenFractional #-} +enumerateFromThenFractional + :: (Monad m, Fractional a) + => a -> a -> Stream m a +enumerateFromThenFractional = enumerateFromThenNum + +-- | Numerically stable enumeration from a 'Fractional' number to a given +-- limit. @enumerateFromToFractional from to@ generates a finite stream whose +-- first element is @from@ and successive elements are in increments of @1@ up +-- to @to@. +-- +-- This is the equivalent of 'enumFromTo' for 'Fractional' types. For +-- example: +-- +-- >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4 +-- [1.1,2.1,3.1,4.1] +-- +-- >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4.6 +-- [1.1,2.1,3.1,4.1,5.1] +-- +-- Notice that the last element is equal to the specified @to@ value after +-- rounding to the nearest integer. +-- {-# INLINE_NORMAL enumerateFromToFractional #-} enumerateFromToFractional :: (Monad m, Fractional a, Ord a) @@ -361,24 +593,320 @@ enumerateFromToFractional enumerateFromToFractional from to = takeWhile (<= to + 1 / 2) $ enumerateFromStepNum from 1 +-- | Numerically stable enumeration from a 'Fractional' number in steps up to a +-- given limit. @enumerateFromThenToFractional from then to@ generates a +-- finite stream whose first element is @from@, the second element is @then@ +-- and the successive elements are in increments of @then - from@ up to @to@. +-- +-- This is the equivalent of 'enumFromThenTo' for 'Fractional' types. For +-- example: +-- +-- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 2 6 +-- [0.1,2.0,3.9,5.799999999999999] +-- +-- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 (-2) (-6) +-- [0.1,-2.0,-4.1000000000000005,-6.200000000000001] +-- {-# INLINE_NORMAL enumerateFromThenToFractional #-} enumerateFromThenToFractional :: (Monad m, Fractional a, Ord a) => a -> a -> a -> Stream m a enumerateFromThenToFractional from next to = - takeWhile predicate $ enumerateFromThenNum from next + takeWhile predicate $ enumerateFromThenFractional from next where mid = (next - from) / 2 predicate | next >= from = (<= to + mid) | otherwise = (>= to + mid) +------------------------------------------------------------------------------- +-- Enumeration of Enum types not larger than Int +------------------------------------------------------------------------------- +-- +-- | 'enumerateFromTo' for 'Enum' types not larger than 'Int'. +-- +{-# INLINE enumerateFromToSmall #-} +enumerateFromToSmall :: (Monad m, Enum a) => a -> a -> Stream m a +enumerateFromToSmall from to = + fmap toEnum + $ enumerateFromToIntegral (fromEnum from) (fromEnum to) + +-- | 'enumerateFromThenTo' for 'Enum' types not larger than 'Int'. +-- +{-# INLINE enumerateFromThenToSmall #-} +enumerateFromThenToSmall :: (Monad m, Enum a) + => a -> a -> a -> Stream m a +enumerateFromThenToSmall from next to = + fmap toEnum + $ enumerateFromThenToIntegral + (fromEnum from) (fromEnum next) (fromEnum to) + +-- | 'enumerateFromThen' for 'Enum' types not larger than 'Int'. +-- +-- Note: We convert the 'Enum' to 'Int' and enumerate the 'Int'. If a +-- type is bounded but does not have a 'Bounded' instance then we can go on +-- enumerating it beyond the legal values of the type, resulting in the failure +-- of 'toEnum' when converting back to 'Enum'. Therefore we require a 'Bounded' +-- instance for this function to be safely used. +-- +{-# INLINE enumerateFromThenSmallBounded #-} +enumerateFromThenSmallBounded :: (Monad m, Enumerable a, Bounded a) + => a -> a -> Stream m a +enumerateFromThenSmallBounded from next = + if fromEnum next >= fromEnum from + then enumerateFromThenTo from next maxBound + else enumerateFromThenTo from next minBound + +------------------------------------------------------------------------------- +-- Enumerable type class +------------------------------------------------------------------------------- +-- +-- NOTE: We would like to rewrite calls to fromList [1..] etc. to stream +-- enumerations like this: +-- +-- {-# RULES "fromList enumFrom" [1] +-- forall (a :: Int). D.fromList (enumFrom a) = D.enumerateFromIntegral a #-} +-- +-- But this does not work because enumFrom is a class method and GHC rewrites +-- it quickly, so we do not get a chance to have our rule fired. + +-- | Types that can be enumerated as a stream. The operations in this type +-- class are equivalent to those in the 'Enum' type class, except that these +-- generate a stream instead of a list. Use the functions in +-- "Streamly.Internal.Data.Stream.Enumeration" module to define new instances. +-- +class Enum a => Enumerable a where + -- | @enumerateFrom from@ generates a stream starting with the element + -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or + -- generating an infinite stream when the type is not 'Bounded'. + -- + -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom (0 :: Int) + -- [0,1,2,3] + -- + -- For 'Fractional' types, enumeration is numerically stable. However, no + -- overflow or underflow checks are performed. + -- + -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom 1.1 + -- [1.1,2.1,3.1,4.1] + -- + enumerateFrom :: (Monad m) => a -> Stream m a + + -- | Generate a finite stream starting with the element @from@, enumerating + -- the type up to the value @to@. If @to@ is smaller than @from@ then an + -- empty stream is returned. + -- + -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 0 4 + -- [0,1,2,3,4] + -- + -- For 'Fractional' types, the last element is equal to the specified @to@ + -- value after rounding to the nearest integral value. + -- + -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4 + -- [1.1,2.1,3.1,4.1] + -- + -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4.6 + -- [1.1,2.1,3.1,4.1,5.1] + -- + enumerateFromTo :: (Monad m) => a -> a -> Stream m a + + -- | @enumerateFromThen from then@ generates a stream whose first element + -- is @from@, the second element is @then@ and the successive elements are + -- in increments of @then - from@. Enumeration can occur downwards or + -- upwards depending on whether @then@ comes before or after @from@. For + -- 'Bounded' types the stream ends when 'maxBound' is reached, for + -- unbounded types it keeps enumerating infinitely. + -- + -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 2 + -- [0,2,4,6] + -- + -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 (-2) + -- [0,-2,-4,-6] + -- + enumerateFromThen :: (Monad m) => a -> a -> Stream m a + + -- | @enumerateFromThenTo from then to@ generates a finite stream whose + -- first element is @from@, the second element is @then@ and the successive + -- elements are in increments of @then - from@ up to @to@. Enumeration can + -- occur downwards or upwards depending on whether @then@ comes before or + -- after @from@. + -- + -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 2 6 + -- [0,2,4,6] + -- + -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 (-2) (-6) + -- [0,-2,-4,-6] + -- + enumerateFromThenTo :: (Monad m) => a -> a -> a -> Stream m a + +-- MAYBE: Sometimes it is more convenient to know the count rather then the +-- ending or starting element. For those cases we can define the folllowing +-- APIs. All of these will work only for bounded types if we represent the +-- count by Int. +-- +-- enumerateN +-- enumerateFromN +-- enumerateToN +-- enumerateFromStep +-- enumerateFromStepN + +------------------------------------------------------------------------------- +-- Convenient functions for bounded types +------------------------------------------------------------------------------- +-- +-- | +-- > enumerate = enumerateFrom minBound +-- +-- Enumerate a 'Bounded' type from its 'minBound' to 'maxBound' +-- +{-# INLINE enumerate #-} +enumerate :: (Monad m, Bounded a, Enumerable a) => Stream m a +enumerate = enumerateFrom minBound + +-- | +-- >>> enumerateTo = Stream.enumerateFromTo minBound +-- +-- Enumerate a 'Bounded' type from its 'minBound' to specified value. +-- +{-# INLINE enumerateTo #-} +enumerateTo :: (Monad m, Bounded a, Enumerable a) => a -> Stream m a +enumerateTo = enumerateFromTo minBound + +-- | +-- >>> enumerateFromBounded from = Stream.enumerateFromTo from maxBound +-- +-- 'enumerateFrom' for 'Bounded' 'Enum' types. +-- +{-# INLINE enumerateFromBounded #-} +enumerateFromBounded :: (Monad m, Enumerable a, Bounded a) + => a -> Stream m a +enumerateFromBounded from = enumerateFromTo from maxBound + +------------------------------------------------------------------------------- +-- Enumerable Instances +------------------------------------------------------------------------------- +-- +-- For Enum types smaller than or equal to Int size. +#define ENUMERABLE_BOUNDED_SMALL(SMALL_TYPE) \ +instance Enumerable SMALL_TYPE where { \ + {-# INLINE enumerateFrom #-}; \ + enumerateFrom = enumerateFromBounded; \ + {-# INLINE enumerateFromThen #-}; \ + enumerateFromThen = enumerateFromThenSmallBounded; \ + {-# INLINE enumerateFromTo #-}; \ + enumerateFromTo = enumerateFromToSmall; \ + {-# INLINE enumerateFromThenTo #-}; \ + enumerateFromThenTo = enumerateFromThenToSmall } + +ENUMERABLE_BOUNDED_SMALL(()) +ENUMERABLE_BOUNDED_SMALL(Bool) +ENUMERABLE_BOUNDED_SMALL(Ordering) +ENUMERABLE_BOUNDED_SMALL(Char) + +-- For bounded Integral Enum types, may be larger than Int. +#define ENUMERABLE_BOUNDED_INTEGRAL(INTEGRAL_TYPE) \ +instance Enumerable INTEGRAL_TYPE where { \ + {-# INLINE enumerateFrom #-}; \ + enumerateFrom = enumerateFromIntegral; \ + {-# INLINE enumerateFromThen #-}; \ + enumerateFromThen = enumerateFromThenIntegral; \ + {-# INLINE enumerateFromTo #-}; \ + enumerateFromTo = enumerateFromToIntegral; \ + {-# INLINE enumerateFromThenTo #-}; \ + enumerateFromThenTo = enumerateFromThenToIntegral } + +ENUMERABLE_BOUNDED_INTEGRAL(Int) +ENUMERABLE_BOUNDED_INTEGRAL(Int8) +ENUMERABLE_BOUNDED_INTEGRAL(Int16) +ENUMERABLE_BOUNDED_INTEGRAL(Int32) +ENUMERABLE_BOUNDED_INTEGRAL(Int64) +ENUMERABLE_BOUNDED_INTEGRAL(Word) +ENUMERABLE_BOUNDED_INTEGRAL(Word8) +ENUMERABLE_BOUNDED_INTEGRAL(Word16) +ENUMERABLE_BOUNDED_INTEGRAL(Word32) +ENUMERABLE_BOUNDED_INTEGRAL(Word64) + +-- For unbounded Integral Enum types. +#define ENUMERABLE_UNBOUNDED_INTEGRAL(INTEGRAL_TYPE) \ +instance Enumerable INTEGRAL_TYPE where { \ + {-# INLINE enumerateFrom #-}; \ + enumerateFrom from = enumerateFromStepIntegral from 1; \ + {-# INLINE enumerateFromThen #-}; \ + enumerateFromThen from next = \ + enumerateFromStepIntegral from (next - from); \ + {-# INLINE enumerateFromTo #-}; \ + enumerateFromTo = enumerateFromToIntegral; \ + {-# INLINE enumerateFromThenTo #-}; \ + enumerateFromThenTo = enumerateFromThenToIntegral } + +ENUMERABLE_UNBOUNDED_INTEGRAL(Integer) +ENUMERABLE_UNBOUNDED_INTEGRAL(Natural) + +#define ENUMERABLE_FRACTIONAL(FRACTIONAL_TYPE,CONSTRAINT) \ +instance (CONSTRAINT) => Enumerable FRACTIONAL_TYPE where { \ + {-# INLINE enumerateFrom #-}; \ + enumerateFrom = enumerateFromFractional; \ + {-# INLINE enumerateFromThen #-}; \ + enumerateFromThen = enumerateFromThenFractional; \ + {-# INLINE enumerateFromTo #-}; \ + enumerateFromTo = enumerateFromToFractional; \ + {-# INLINE enumerateFromThenTo #-}; \ + enumerateFromThenTo = enumerateFromThenToFractional } + +ENUMERABLE_FRACTIONAL(Float,) +ENUMERABLE_FRACTIONAL(Double,) +ENUMERABLE_FRACTIONAL((Fixed a),HasResolution a) +ENUMERABLE_FRACTIONAL((Ratio a),Integral a) + +instance Enumerable a => Enumerable (Identity a) where + {-# INLINE enumerateFrom #-} + enumerateFrom (Identity from) = + fmap Identity $ enumerateFrom from + {-# INLINE enumerateFromThen #-} + enumerateFromThen (Identity from) (Identity next) = + fmap Identity $ enumerateFromThen from next + {-# INLINE enumerateFromTo #-} + enumerateFromTo (Identity from) (Identity to) = + fmap Identity $ enumerateFromTo from to + {-# INLINE enumerateFromThenTo #-} + enumerateFromThenTo (Identity from) (Identity next) (Identity to) = + fmap Identity + $ enumerateFromThenTo from next to + +-- TODO +{- +instance Enumerable a => Enumerable (Last a) +instance Enumerable a => Enumerable (First a) +instance Enumerable a => Enumerable (Max a) +instance Enumerable a => Enumerable (Min a) +instance Enumerable a => Enumerable (Const a b) +instance Enumerable (f a) => Enumerable (Alt f a) +instance Enumerable (f a) => Enumerable (Ap f a) +-} ------------------------------------------------------------------------------ -- Time Enumeration ------------------------------------------------------------------------------ -{-# INLINE_NORMAL times #-} -times :: MonadIO m => Double -> Stream m (AbsTime, RelTime64) -times g = Stream step Nothing +-- | @timesWith g@ returns a stream of time value tuples. The first component +-- of the tuple is an absolute time reference (epoch) denoting the start of the +-- stream and the second component is a time relative to the reference. +-- +-- The argument @g@ specifies the granularity of the relative time in seconds. +-- A lower granularity clock gives higher precision but is more expensive in +-- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms. +-- +-- >>> import Control.Concurrent (threadDelay) +-- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000) +-- >>> Stream.fold f $ Stream.take 3 $ Stream.timesWith 0.01 +-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...)) +-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...)) +-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...)) +-- +-- Note: This API is not safe on 32-bit machines. +-- +-- /Pre-release/ +-- +{-# INLINE_NORMAL timesWith #-} +timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64) +timesWith g = Stream step Nothing where @@ -395,6 +923,125 @@ times g = Stream step Nothing -- floating precision time return $ Yield (toAbsTime t0, toRelTime64 (a - t0)) s +-- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of +-- granularity @g@ specified in seconds. A low granularity clock is more +-- expensive in terms of CPU usage. Any granularity lower than 1 ms is treated +-- as 1 ms. +-- +-- >>> f = Fold.drainMapM print +-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimesWith 0.01 +-- AbsTime (TimeSpec {sec = ..., nsec = ...}) +-- AbsTime (TimeSpec {sec = ..., nsec = ...}) +-- AbsTime (TimeSpec {sec = ..., nsec = ...}) +-- +-- Note: This API is not safe on 32-bit machines. +-- +-- /Pre-release/ +-- +{-# INLINE absTimesWith #-} +absTimesWith :: MonadIO m => Double -> Stream m AbsTime +absTimesWith = fmap (uncurry addToAbsTime64) . timesWith + +-- | @relTimesWith g@ returns a stream of relative time values starting from 0, +-- using a clock of granularity @g@ specified in seconds. A low granularity +-- clock is more expensive in terms of CPU usage. Any granularity lower than 1 +-- ms is treated as 1 ms. +-- +-- >>> f = Fold.drainMapM print +-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimesWith 0.01 +-- RelTime64 (NanoSecond64 ...) +-- RelTime64 (NanoSecond64 ...) +-- RelTime64 (NanoSecond64 ...) +-- +-- Note: This API is not safe on 32-bit machines. +-- +-- /Pre-release/ +-- +{-# INLINE relTimesWith #-} +relTimesWith :: MonadIO m => Double -> Stream m RelTime64 +relTimesWith = fmap snd . timesWith + +-- | @times@ returns a stream of time value tuples with clock of 10 ms +-- granularity. The first component of the tuple is an absolute time reference +-- (epoch) denoting the start of the stream and the second component is a time +-- relative to the reference. +-- +-- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000) +-- >>> Stream.fold f $ Stream.take 3 $ Stream.times +-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...)) +-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...)) +-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...)) +-- +-- Note: This API is not safe on 32-bit machines. +-- +-- /Pre-release/ +-- +{-# INLINE times #-} +times :: MonadIO m => Stream m (AbsTime, RelTime64) +times = timesWith 0.01 + +-- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms +-- granularity. +-- +-- >>> f = Fold.drainMapM print +-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimes +-- AbsTime (TimeSpec {sec = ..., nsec = ...}) +-- AbsTime (TimeSpec {sec = ..., nsec = ...}) +-- AbsTime (TimeSpec {sec = ..., nsec = ...}) +-- +-- Note: This API is not safe on 32-bit machines. +-- +-- /Pre-release/ +-- +{-# INLINE absTimes #-} +absTimes :: MonadIO m => Stream m AbsTime +absTimes = fmap (uncurry addToAbsTime64) times + +-- | @relTimes@ returns a stream of relative time values starting from 0, +-- using a clock of granularity 10 ms. +-- +-- >>> f = Fold.drainMapM print +-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimes +-- RelTime64 (NanoSecond64 ...) +-- RelTime64 (NanoSecond64 ...) +-- RelTime64 (NanoSecond64 ...) +-- +-- Note: This API is not safe on 32-bit machines. +-- +-- /Pre-release/ +-- +{-# INLINE relTimes #-} +relTimes :: MonadIO m => Stream m RelTime64 +relTimes = fmap snd times + +-- | @durations g@ returns a stream of relative time values measuring the time +-- elapsed since the immediate predecessor element of the stream was generated. +-- The first element of the stream is always 0. @durations@ uses a clock of +-- granularity @g@ specified in seconds. A low granularity clock is more +-- expensive in terms of CPU usage. The minimum granularity is 1 millisecond. +-- Durations lower than 1 ms will be 0. +-- +-- Note: This API is not safe on 32-bit machines. +-- +-- /Unimplemented/ +-- +{-# INLINE durations #-} +durations :: -- Monad m => + Double -> t m RelTime64 +durations = undefined + +-- | Generate a singleton event at or after the specified absolute time. Note +-- that this is different from a threadDelay, a threadDelay starts from the +-- time when the action is evaluated, whereas if we use AbsTime based timeout +-- it will immediately expire if the action is evaluated too late. +-- +-- /Unimplemented/ +-- +{-# INLINE timeout #-} +timeout :: -- Monad m => + AbsTime -> t m () +timeout = undefined + ------------------------------------------------------------------------------- -- From Generators ------------------------------------------------------------------------------- @@ -435,6 +1082,22 @@ generate n gen = generateM n (return . gen) -- Iteration ------------------------------------------------------------------------------- +-- | +-- >>> iterateM f m = m >>= \a -> return a `Stream.consM` iterateM f (f a) +-- +-- Generate an infinite stream with the first element generated by the action +-- @m@ and each successive element derived by applying the monadic function +-- @f@ on the previous element. +-- +-- >>> :{ +-- Stream.iterateM (\x -> print x >> return (x + 1)) (return 0) +-- & Stream.take 3 +-- & Stream.fold Fold.toList +-- :} +-- 0 +-- 1 +-- [0,1,2] +-- {-# INLINE_NORMAL iterateM #-} iterateM :: Monad m => (a -> m a) -> m a -> Stream m a #ifdef USE_UNFOLDS_EVERYWHERE @@ -443,6 +1106,16 @@ iterateM step = unfold (Unfold.iterateM step) iterateM step = Stream (\_ st -> st >>= \(!x) -> return $ Yield x (step x)) #endif +-- | +-- >>> iterate f x = x `Stream.cons` iterate f x +-- +-- Generate an infinite stream with @x@ as the first element and each +-- successive element derived by applying the function @f@ on the previous +-- element. +-- +-- >>> Stream.fold Fold.toList $ Stream.take 5 $ Stream.iterate (+1) 1 +-- [1,2,3,4,5] +-- {-# INLINE_NORMAL iterate #-} iterate :: Monad m => (a -> a) -> a -> Stream m a iterate step st = iterateM (return . step) (return st) @@ -464,12 +1137,39 @@ fromListM = Stream step step _ [] = return Stop #endif +-- | +-- >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil +-- +-- Construct a stream from a 'Foldable' containing pure values: +-- +-- /WARNING: O(n^2), suitable only for a small number of +-- elements in the stream/ +-- +{-# INLINE fromFoldable #-} +fromFoldable :: (Monad m, Foldable f) => f a -> Stream m a +fromFoldable = Prelude.foldr cons nil + +-- | +-- >>> fromFoldableM = Prelude.foldr Stream.consM Stream.nil +-- +-- Construct a stream from a 'Foldable' containing pure values: +-- +-- /WARNING: O(n^2), suitable only for a small number of +-- elements in the stream/ +-- +{-# INLINE fromFoldableM #-} +fromFoldableM :: (Monad m, Foldable f) => f (m a) -> Stream m a +fromFoldableM = Prelude.foldr consM nil + ------------------------------------------------------------------------------- -- From pointers ------------------------------------------------------------------------------- --- | Read an infinite stream from a pointer, advancing the pointer as needed. --- The caller is responsible to end the stream safely. +-- | Keep reading 'Storable' elements from 'Ptr' onwards. +-- +-- /Unsafe:/ The caller is responsible for safe addressing. +-- +-- /Pre-release/ {-# INLINE fromPtr #-} fromPtr :: forall m a. (MonadIO m, Storable a) => Ptr a -> Stream m a fromPtr = Stream step @@ -480,3 +1180,32 @@ fromPtr = Stream step step _ p = do x <- liftIO $ peek p return $ Yield x (PTR_NEXT(p, a)) + +-- | Take @n@ 'Storable' elements starting from 'Ptr' onwards. +-- +-- >>> fromPtrN n = Stream.take n . Stream.fromPtr +-- +-- /Unsafe:/ The caller is responsible for safe addressing. +-- +-- /Pre-release/ +{-# INLINE fromPtrN #-} +fromPtrN :: (MonadIO m, Storable a) => Int -> Ptr a -> Stream m a +fromPtrN n = take n . fromPtr + +-- | Read bytes from an 'Addr#' until a 0 byte is encountered, the 0 byte is +-- not included in the stream. +-- +-- >>> fromByteStr# addr = Stream.takeWhile (/= 0) $ Stream.fromPtr $ Ptr addr +-- +-- /Unsafe:/ The caller is responsible for safe addressing. +-- +-- Note that this is completely safe when reading from Haskell string +-- literals because they are guaranteed to be NULL terminated: +-- +-- >>> Stream.fold Fold.toList $ Stream.fromByteStr# "\1\2\3\0"# +-- [1,2,3] +-- +{-# INLINE fromByteStr# #-} +fromByteStr# :: MonadIO m => Addr# -> Stream m Word8 +fromByteStr# addr = + takeWhile (/= 0) $ fromPtr $ Ptr addr diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD/Lift.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Lift.hs index af61a5108..c098a7b3e 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamD/Lift.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Lift.hs @@ -11,8 +11,8 @@ module Streamly.Internal.Data.Stream.StreamD.Lift ( -- * Generalize Inner Monad - hoist - , generally -- XXX generalize + morphInner + , generalizeInner -- * Transform Inner Monad , liftInnerWith @@ -28,13 +28,26 @@ import Streamly.Internal.Data.SVar.Type (adaptState) import Streamly.Internal.Data.Stream.StreamD.Type +-- $setup +-- >>> :m +-- >>> import Data.Functor.Identity (runIdentity) +-- >>> import Streamly.Internal.Data.Stream as Stream + ------------------------------------------------------------------------------- -- Generalize Inner Monad ------------------------------------------------------------------------------- -{-# INLINE_NORMAL hoist #-} -hoist :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a -hoist f (Stream step state) = Stream step' state +-- | Transform the inner monad of a stream using a natural transformation. +-- +-- Example, generalize the inner monad from Identity to any other: +-- +-- >>> generalizeInner = Stream.morphInner (return . runIdentity) +-- +-- Also known as hoist. +-- +{-# INLINE_NORMAL morphInner #-} +morphInner :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a +morphInner f (Stream step state) = Stream step' state where {-# INLINE_LATE step' #-} step' gst st = do @@ -44,14 +57,23 @@ hoist f (Stream step state) = Stream step' state Skip s -> Skip s Stop -> Stop -{-# INLINE generally #-} -generally :: Monad m => Stream Identity a -> Stream m a -generally = hoist (return . runIdentity) +-- | Generalize the inner monad of the stream from 'Identity' to any monad. +-- +-- Definition: +-- +-- >>> generalizeInner = Stream.morphInner (return . runIdentity) +-- +{-# INLINE generalizeInner #-} +generalizeInner :: Monad m => Stream Identity a -> Stream m a +generalizeInner = morphInner (return . runIdentity) ------------------------------------------------------------------------------- -- Transform Inner Monad ------------------------------------------------------------------------------- +-- | Lift the inner monad @m@ of a stream @Stream m a@ to @t m@ using the +-- supplied lift function. +-- {-# INLINE_NORMAL liftInnerWith #-} liftInnerWith :: (Monad (t m)) => (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a @@ -67,6 +89,8 @@ liftInnerWith lift (Stream step state) = Stream step1 state Skip s -> Skip s Stop -> Stop +-- | Evaluate the inner monad of a stream using the supplied runner function. +-- {-# INLINE_NORMAL runInnerWith #-} runInnerWith :: Monad m => (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a @@ -82,6 +106,10 @@ runInnerWith run (Stream step state) = Stream step1 state Skip s -> Skip s Stop -> Stop +-- | Evaluate the inner monad of a stream using the supplied stateful runner +-- function and the initial state. The state returned by an invocation of the +-- runner is supplied as input state to the next invocation. +-- {-# INLINE_NORMAL runInnerWithState #-} runInnerWithState :: Monad m => (forall b. s -> t m b -> m (b, s)) diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs index f00b90307..bc57264c9 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs @@ -41,17 +41,17 @@ module Streamly.Internal.Data.Stream.StreamD.Nesting -- *** Interleaving -- | Interleave elements from two streams alternately. A special case of - -- unfoldManyInterleave. + -- unfoldInterleave. , InterleaveState(..) , interleave , interleaveMin - , interleaveSuffix - , interleaveInfix + , interleaveFst + , interleaveFstSuffix -- *** Scheduling -- | Execute streams alternately irrespective of whether they generate -- elements or not. Note 'interleave' would execute a stream until it - -- yields an element. A special case of unfoldManyRoundRobin. + -- yields an element. A special case of unfoldRoundRobin. , roundRobin -- interleaveFair?/ParallelFair -- *** Zipping @@ -63,6 +63,8 @@ module Streamly.Internal.Data.Stream.StreamD.Nesting -- | Interleave elements from two streams based on a condition. , mergeBy , mergeByM + , mergeMinBy + , mergeFstBy -- ** Combine N Streams -- | Functions generally ending in these shapes: @@ -85,20 +87,24 @@ module Streamly.Internal.Data.Stream.StreamD.Nesting -- gintercalate. , unfoldMany , ConcatUnfoldInterleaveState (..) - , unfoldManyInterleave - , unfoldManyRoundRobin + , unfoldInterleave + , unfoldRoundRobin -- *** Interpose -- | Like unfoldMany but intersperses an effect between the streams. A -- special case of gintercalate. , interpose + , interposeM , interposeSuffix + , interposeSuffixM -- *** Intercalate -- | Like unfoldMany but intersperses streams from another source between -- the streams from the first source. , gintercalate , gintercalateSuffix + , intercalate + , intercalateSuffix -- * Eliminate -- | Folding and Parsing chunks of streams to eliminate nested streams. @@ -113,6 +119,7 @@ module Streamly.Internal.Data.Stream.StreamD.Nesting -- | Apply folds on a stream. , foldMany , refoldMany + , foldSequence , foldIterateM , refoldIterateM @@ -123,7 +130,11 @@ module Streamly.Internal.Data.Stream.StreamD.Nesting -- splitting the stream and then folds each such split to single value in -- the output stream. , parseMany + , parseManyD + , parseSequence + , parseManyTill , parseIterate + , parseIterateD -- ** Grouping -- | Group segments of a stream and fold. Special case of parsing. @@ -138,11 +149,21 @@ module Streamly.Internal.Data.Stream.StreamD.Nesting , splitOnSuffixSeq , sliceOnSuffix + -- XXX Implement these as folds or parsers instead. + , splitOnSuffixSeqAny + , splitOnPrefix + , splitOnAny + -- * Transform (Nested Containers) -- | Opposite to compact in ArrayStream , splitInnerBy , splitInnerBySuffix , intersectBySorted + + -- * Reduce By Streams + , dropPrefix + , dropInfix + , dropSuffix ) where @@ -152,7 +173,6 @@ where import Control.Exception (assert) import Control.Monad.IO.Class (MonadIO(..)) import Data.Bits (shiftR, shiftL, (.|.), (.&.)) -import Data.Functor.Identity ( Identity ) import Data.Proxy (Proxy(..)) import Data.Word (Word32) import Foreign.Storable (Storable, peek) @@ -175,19 +195,49 @@ import qualified Streamly.Internal.Data.Parser as PR import qualified Streamly.Internal.Data.Parser.ParserD as PRD import qualified Streamly.Internal.Data.Ring.Unboxed as RB +import Streamly.Internal.Data.Stream.StreamD.Transform + (intersperse, intersperseMSuffix) import Streamly.Internal.Data.Stream.StreamD.Type import Prelude hiding (concatMap, mapM, zipWith) +-- $setup +-- >>> :m +-- >>> import Data.Either (either) +-- >>> import Data.IORef +-- >>> import Streamly.Internal.Data.Stream (Stream) +-- >>> import Prelude hiding (zipWith, concatMap, concat) +-- >>> import qualified Streamly.Data.Array as Array +-- >>> import qualified Streamly.Internal.Data.Fold as Fold +-- >>> import qualified Streamly.Internal.Data.Stream as Stream +-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold +-- >>> import qualified Streamly.Internal.Data.Parser as Parser +-- >>> import qualified Streamly.Internal.FileSystem.Dir as Dir +-- + ------------------------------------------------------------------------------ -- Appending ------------------------------------------------------------------------------ data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2 --- Note that this could be much faster compared to the CPS stream. However, as --- the number of streams being composed increases this may become expensive. --- Need to see where the breaking point is between the two. +-- | Fuses two streams sequentially, yielding all elements from the first +-- stream, and then all elements from the second stream. +-- +-- >>> s1 = Stream.fromList [1,2] +-- >>> s2 = Stream.fromList [3,4] +-- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2 +-- [1,2,3,4] +-- +-- This function should not be used to dynamically construct a stream. If a +-- stream is constructed by successive use of this function it would take +-- quadratic time complexity to consume the stream. +-- +-- This function should only be used to statically fuse a stream with another +-- stream. Do not use this recursively or where it cannot be inlined. +-- +-- See "Streamly.Data.Stream.StreamK" for an 'append' that can be used to +-- construct a stream recursively. -- {-# INLINE_NORMAL append #-} append :: Monad m => Stream m a -> Stream m a -> Stream m a @@ -218,6 +268,15 @@ append (Stream step1 state1) (Stream step2 state2) = data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2 | InterleaveSecondOnly s2 | InterleaveFirstOnly s1 +-- | Interleaves two streams, yielding one element from each stream +-- alternately. When one stream stops the rest of the other stream is used in +-- the output stream. +-- +-- When joining many streams in a left associative manner earlier streams will +-- get exponential priority than the ones joining later. Because of exponential +-- weighting it can be used with 'concatMapWith' even on a large number of +-- streams. +-- {-# INLINE_NORMAL interleave #-} interleave :: Monad m => Stream m a -> Stream m a -> Stream m a interleave (Stream step1 state1) (Stream step2 state2) = @@ -254,6 +313,9 @@ interleave (Stream step1 state1) (Stream step2 state2) = Skip s -> Skip (InterleaveSecondOnly s) Stop -> Stop +-- | Like `interleave` but stops interleaving as soon as any of the two streams +-- stops. +-- {-# INLINE_NORMAL interleaveMin #-} interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a interleaveMin (Stream step1 state1) (Stream step2 state2) = @@ -279,9 +341,28 @@ interleaveMin (Stream step1 state1) (Stream step2 state2) = step _ (InterleaveFirstOnly _) = undefined step _ (InterleaveSecondOnly _) = undefined -{-# INLINE_NORMAL interleaveSuffix #-} -interleaveSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a -interleaveSuffix (Stream step1 state1) (Stream step2 state2) = +-- | Interleaves the outputs of two streams, yielding elements from each stream +-- alternately, starting from the first stream. As soon as the first stream +-- finishes, the output stops, discarding the remaining part of the second +-- stream. In this case, the last element in the resulting stream would be from +-- the second stream. If the second stream finishes early then the first stream +-- still continues to yield elements until it finishes. +-- +-- >>> :set -XOverloadedStrings +-- >>> import Data.Functor.Identity (Identity) +-- >>> Stream.interleaveFstSuffix "abc" ",,,," :: Stream Identity Char +-- fromList "a,b,c," +-- >>> Stream.interleaveFstSuffix "abc" "," :: Stream Identity Char +-- fromList "a,bc" +-- +-- 'interleaveFstSuffix' is a dual of 'interleaveFst'. +-- +-- Do not use dynamically. +-- +-- /Pre-release/ +{-# INLINE_NORMAL interleaveFstSuffix #-} +interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a +interleaveFstSuffix (Stream step1 state1) (Stream step2 state2) = Stream step (InterleaveFirst state1 state2) where @@ -317,9 +398,28 @@ data InterleaveInfixState s1 s2 a | InterleaveInfixFirstYield s1 s2 a | InterleaveInfixFirstOnly s1 -{-# INLINE_NORMAL interleaveInfix #-} -interleaveInfix :: Monad m => Stream m a -> Stream m a -> Stream m a -interleaveInfix (Stream step1 state1) (Stream step2 state2) = +-- | Interleaves the outputs of two streams, yielding elements from each stream +-- alternately, starting from the first stream and ending at the first stream. +-- If the second stream is longer than the first, elements from the second +-- stream are infixed with elements from the first stream. If the first stream +-- is longer then it continues yielding elements even after the second stream +-- has finished. +-- +-- >>> :set -XOverloadedStrings +-- >>> import Data.Functor.Identity (Identity) +-- >>> Stream.interleaveFst "abc" ",,,," :: Stream Identity Char +-- fromList "a,b,c" +-- >>> Stream.interleaveFst "abc" "," :: Stream Identity Char +-- fromList "a,bc" +-- +-- 'interleaveFst' is a dual of 'interleaveFstSuffix'. +-- +-- Do not use dynamically. +-- +-- /Pre-release/ +{-# INLINE_NORMAL interleaveFst #-} +interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a +interleaveFst (Stream step1 state1) (Stream step2 state2) = Stream step (InterleaveInfixFirst state1 state2) where @@ -360,6 +460,18 @@ interleaveInfix (Stream step1 state1) (Stream step2 state2) = -- Scheduling ------------------------------------------------------------------------------ +-- | Schedule the execution of two streams in a fair round-robin manner, +-- executing each stream once, alternately. Execution of a stream may not +-- necessarily result in an output, a stream may choose to @Skip@ producing an +-- element until later giving the other stream a chance to run. Therefore, this +-- combinator fairly interleaves the execution of two streams rather than +-- fairly interleaving the output of the two streams. This can be useful in +-- co-operative multitasking without using explicit threads. This can be used +-- as an alternative to `async`. +-- +-- Do not use dynamically. +-- +-- /Pre-release/ {-# INLINE_NORMAL roundRobin #-} roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a roundRobin (Stream step1 state1) (Stream step2 state2) = @@ -396,44 +508,38 @@ roundRobin (Stream step1 state1) (Stream step2 state2) = Skip s -> Skip (InterleaveFirstOnly s) Stop -> Stop ------------------------------------------------------------------------------- --- Zipping ------------------------------------------------------------------------------- - -{-# INLINE_NORMAL zipWithM #-} -zipWithM :: Monad m - => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c -zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing) - where - {-# INLINE_LATE step #-} - step gst (sa, sb, Nothing) = do - r <- stepa (adaptState gst) sa - return $ - case r of - Yield x sa' -> Skip (sa', sb, Just x) - Skip sa' -> Skip (sa', sb, Nothing) - Stop -> Stop - - step gst (sa, sb, Just x) = do - r <- stepb (adaptState gst) sb - case r of - Yield y sb' -> do - z <- f x y - return $ Yield z (sa, sb', Nothing) - Skip sb' -> return $ Skip (sa, sb', Just x) - Stop -> return Stop - -{-# RULES "zipWithM xs xs" - forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-} - -{-# INLINE zipWith #-} -zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c -zipWith f = zipWithM (\a b -> return (f a b)) - ------------------------------------------------------------------------------ -- Merging ------------------------------------------------------------------------------ +-- | Like 'mergeBy' but with a monadic comparison function. +-- +-- Merge two streams randomly: +-- +-- @ +-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT +-- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2]) +-- [2,1,2,2,2,1,1,1] +-- @ +-- +-- Merge two streams in a proportion of 2:1: +-- +-- >>> :{ +-- do +-- let s1 = Stream.fromList [1,1,1,1,1,1] +-- s2 = Stream.fromList [2,2,2] +-- let proportionately m n = do +-- ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT] +-- return $ \_ _ -> do +-- r <- readIORef ref +-- writeIORef ref $ Prelude.tail r +-- return $ Prelude.head r +-- f <- proportionately 2 1 +-- xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2 +-- print xs +-- :} +-- [1,1,2,1,1,2,1,1,2] +-- {-# INLINE_NORMAL mergeByM #-} mergeByM :: (Monad m) @@ -474,12 +580,43 @@ mergeByM cmp (Stream stepa ta) (Stream stepb tb) = step _ (Nothing, Nothing, Nothing, Nothing) = return Stop +-- | Merge two streams using a comparison function. The head elements of both +-- the streams are compared and the smaller of the two elements is emitted, if +-- both elements are equal then the element from the first stream is used +-- first. +-- +-- If the streams are sorted in ascending order, the resulting stream would +-- also remain sorted in ascending order. +-- +-- >>> s1 = Stream.fromList [1,3,5] +-- >>> s2 = Stream.fromList [2,4,6,8] +-- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2 +-- [1,2,3,4,5,6,8] +-- {-# INLINE mergeBy #-} mergeBy :: (Monad m) => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a mergeBy cmp = mergeByM (\a b -> return $ cmp a b) +-- | Like 'mergeByM' but stops merging as soon as any of the two streams stops. +-- +-- /Unimplemented/ +{-# INLINABLE mergeMinBy #-} +mergeMinBy :: -- Monad m => + (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a +mergeMinBy _f _m1 _m2 = undefined + -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2) + +-- | Like 'mergeByM' but stops merging as soon as the first stream stops. +-- +-- /Unimplemented/ +{-# INLINABLE mergeFstBy #-} +mergeFstBy :: -- Monad m => + (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a +mergeFstBy _f _m1 _m2 = undefined + -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2) + ------------------------------------------------------------------------------- -- Intersection of sorted streams ------------------------------------------------------------------------------- @@ -551,17 +688,28 @@ data ConcatUnfoldInterleaveState o i = -- Maybe we can configure the behavior. -- -- XXX Instead of using "concatPairsWith wSerial" we can implement an N-way --- interleaving CPS combinator which behaves like unfoldManyInterleave. Instead +-- interleaving CPS combinator which behaves like unfoldInterleave. Instead -- of pairing up the streams we just need to go yielding one element from each -- stream and storing the remaining streams and then keep doing rounds through -- those in a round robin fashion. This would be much like wAsync. + +-- | This does not pair streams like mergeMapWith, instead, it goes through +-- each stream one by one and yields one element from each stream. After it +-- goes to the last stream it reverses the traversal to come back to the first +-- stream yielding elements from each stream on its way back to the first +-- stream and so on. -- --- See 'Streamly.Internal.Data.Stream.unfoldInterleave' documentation for more --- details. +-- >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]] +-- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists +-- >>> Stream.fold Fold.toList interleaved +-- [1,2,3,4,5,5,4,3,2,1] -- -{-# INLINE_NORMAL unfoldManyInterleave #-} -unfoldManyInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b -unfoldManyInterleave (Unfold istep inject) (Stream ostep ost) = +-- Note that this is order of magnitude more efficient than "mergeMapWith +-- interleave" because of fusion. +-- +{-# INLINE_NORMAL unfoldInterleave #-} +unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b +unfoldInterleave (Unfold istep inject) (Stream ostep ost) = Stream step (ConcatUnfoldInterleaveOuter ost []) where @@ -612,11 +760,17 @@ unfoldManyInterleave (Unfold istep inject) (Stream ostep ost) = -- -- This could be inefficient if the tasks are too small. -- --- Compared to unfoldManyInterleave this one switches streams on Skips. +-- Compared to unfoldInterleave this one switches streams on Skips. + +-- | 'unfoldInterleave' switches to the next stream whenever a value from a +-- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps +-- skipping for long time other streams won't get a chance to run. +-- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each +-- stream fairly irrespective of whether it produces a value or not. -- -{-# INLINE_NORMAL unfoldManyRoundRobin #-} -unfoldManyRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b -unfoldManyRoundRobin (Unfold istep inject) (Stream ostep ost) = +{-# INLINE_NORMAL unfoldRoundRobin #-} +unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b +unfoldRoundRobin (Unfold istep inject) (Stream ostep ost) = Stream step (ConcatUnfoldInterleaveOuter ost []) where {-# INLINE_LATE step #-} @@ -677,11 +831,11 @@ data InterposeSuffixState s1 i1 = -- effect only if at least one element has been yielded by the unfolding. -- However, that becomes a bit complicated, so we have chosen the former -- behvaior for now. -{-# INLINE_NORMAL interposeSuffix #-} -interposeSuffix +{-# INLINE_NORMAL interposeSuffixM #-} +interposeSuffixM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c -interposeSuffix +interposeSuffixM action (Unfold istep1 inject1) (Stream step1 state1) = Stream step (InterposeSuffixFirst state1) @@ -719,6 +873,19 @@ interposeSuffix r <- action return $ Yield r (InterposeSuffixFirst s1) +-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x) + +-- | Unfold the elements of a stream, append the given element after each +-- unfolded stream and then concat them into a single stream. +-- +-- >>> unlines = Stream.interposeSuffix '\n' +-- +-- /Pre-release/ +{-# INLINE interposeSuffix #-} +interposeSuffix :: Monad m + => c -> Unfold m b c -> Stream m b -> Stream m c +interposeSuffix x = interposeSuffixM (return x) + {-# ANN type InterposeState Fuse #-} data InterposeState s1 i1 a = InterposeFirst s1 @@ -732,9 +899,9 @@ data InterposeState s1 i1 a = -- Note that this only interposes the pure values, we may run many effects to -- generate those values as some effects may not generate anything (Skip). -{-# INLINE_NORMAL interpose #-} -interpose :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c -interpose +{-# INLINE_NORMAL interposeM #-} +interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c +interposeM action (Unfold istep1 inject1) (Stream step1 state1) = Stream step (InterposeFirst state1) @@ -801,6 +968,19 @@ interpose return $ Yield v (InterposeFirstInner s1 i1) -} +-- > interpose x unf str = gintercalate unf str UF.identity (repeat x) + +-- | Unfold the elements of a stream, intersperse the given element between the +-- unfolded streams and then concat them into a single stream. +-- +-- >>> unwords = Stream.interpose ' ' +-- +-- /Pre-release/ +{-# INLINE interpose #-} +interpose :: Monad m + => c -> Unfold m b c -> Stream m b -> Stream m c +interpose x = interposeM (return x) + ------------------------------------------------------------------------------ -- Combine N Streams - intercalate ------------------------------------------------------------------------------ @@ -815,16 +995,9 @@ data ICUState s1 s2 i1 i2 = | ICUFirstOnlyInner s1 i1 | ICUSecondOnlyInner s2 i2 --- | Interleave streams (full streams, not the elements) unfolded from two --- input streams and concat. Stop when the first stream stops. If the second --- stream ends before the first one then first stream still keeps running alone --- without any interleaving with the second stream. --- --- [a1, a2, ... an] [b1, b2 ...] --- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...] --- => [streamA1, streamB1, streamA2...StreamAn, streamBn] --- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...] +-- | 'interleaveFstSuffix' followed by unfold and concat. -- +-- /Pre-release/ {-# INLINE_NORMAL gintercalateSuffix #-} gintercalateSuffix :: Monad m @@ -901,16 +1074,17 @@ data ICALState s1 s2 i1 i2 a = -- -- | ICALSecondInner s1 s2 i1 i2 a -- -- | ICALFirstResume s1 s2 i1 i2 a --- | Interleave streams (full streams, not the elements) unfolded from two --- input streams and concat. Stop when the first stream stops. If the second --- stream ends before the first one then first stream still keeps running alone --- without any interleaving with the second stream. +-- XXX we can swap the order of arguments to gintercalate so that the +-- definition of unfoldMany becomes simpler? The first stream should be +-- infixed inside the second one. However, if we change the order in +-- "interleave" as well similarly, then that will make it a bit unintuitive. -- --- [a1, a2, ... an] [b1, b2 ...] --- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...] --- => [streamA1, streamB1, streamA2...StreamAn, streamBn] --- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...] +-- > unfoldMany unf str = +-- > gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ()) + +-- | 'interleaveFst' followed by unfold and concat. -- +-- /Pre-release/ {-# INLINE_NORMAL gintercalate #-} gintercalate :: Monad m @@ -1017,10 +1191,57 @@ gintercalate return $ Yield x (ICALFirstInner s1 s2 i1 i2) -} +-- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed) + +-- | 'intersperseMSuffix' followed by unfold and concat. +-- +-- >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a +-- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity +-- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n" +-- +-- >>> input = Stream.fromList ["abc", "def", "ghi"] +-- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input +-- "abc\ndef\nghi\n" +-- +{-# INLINE intercalateSuffix #-} +intercalateSuffix :: Monad m + => Unfold m b c -> b -> Stream m b -> Stream m c +intercalateSuffix unf seed = unfoldMany unf . intersperseMSuffix (return seed) + +-- > intercalate unf seed str = gintercalate unf str unf (repeatM seed) + +-- | 'intersperse' followed by unfold and concat. +-- +-- >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a +-- >>> intersperse = Stream.intercalate Unfold.identity +-- >>> unwords = Stream.intercalate Unfold.fromList " " +-- +-- >>> input = Stream.fromList ["abc", "def", "ghi"] +-- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input +-- "abc def ghi" +-- +{-# INLINE intercalate #-} +intercalate :: Monad m + => Unfold m b c -> b -> Stream m b -> Stream m c +intercalate unf seed str = unfoldMany unf $ intersperse seed str + ------------------------------------------------------------------------------ -- Folding ------------------------------------------------------------------------------ +-- | Apply a stream of folds to an input stream and emit the results in the +-- output stream. +-- +-- /Unimplemented/ +-- +{-# INLINE foldSequence #-} +foldSequence + :: -- Monad m => + Stream m (Fold m a b) + -> Stream m a + -> Stream m b +foldSequence _f _m = undefined + {-# ANN type FIterState Fuse #-} data FIterState s f m a b = FIterInit s f @@ -1028,6 +1249,21 @@ data FIterState s f m a b | FIterYield b (FIterState s f m a b) | FIterStop +-- | Iterate a fold generator on a stream. The initial value @b@ is used to +-- generate the first fold, the fold is applied on the stream and the result of +-- the fold is used to generate the next fold and so on. +-- +-- >>> import Data.Monoid (Sum(..)) +-- >>> f x = return (Fold.take 2 (Fold.sconcat x)) +-- >>> s = fmap Sum $ Stream.fromList [1..10] +-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s +-- [3,10,21,36,55,55] +-- +-- This is the streaming equivalent of monad like sequenced application of +-- folds where next fold is dependent on the previous fold. +-- +-- /Pre-release/ +-- {-# INLINE_NORMAL foldIterateM #-} foldIterateM :: Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b @@ -1150,13 +1386,13 @@ data ParseChunksState x inpBuf st pst = -- XXX return the remaining stream as part of the error. -- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as -- well? -{-# INLINE_NORMAL parseMany #-} -parseMany +{-# INLINE_NORMAL parseManyD #-} +parseManyD :: Monad m => PRD.Parser a m b -> Stream m a -> Stream m (Either ParseError b) -parseMany (PRD.Parser pstep initial extract) (Stream step state) = +parseManyD (PRD.Parser pstep initial extract) (Stream step state) = Stream stepOuter (ParseChunksInit [] state) where @@ -1362,6 +1598,62 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) = stepOuter _ (ParseChunksYield a next) = return $ Yield a next +-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the +-- output stream. +-- +-- Example: +-- +-- >>> s = Stream.fromList [1..10] +-- >>> parser = Parser.takeBetween 0 2 Fold.sum +-- >>> Stream.fold Fold.toList $ Stream.parseMany parser s +-- [Right 3,Right 7,Right 11,Right 15,Right 19] +-- +-- This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse +-- combinator. +-- +-- Known Issues: When the parser fails there is no way to get the remaining +-- stream. +-- +{-# INLINE parseMany #-} +parseMany + :: Monad m + => PR.Parser a m b + -> Stream m a + -> Stream m (Either ParseError b) +parseMany p = parseManyD (PRD.fromParserK p) + +-- | Apply a stream of parsers to an input stream and emit the results in the +-- output stream. +-- +-- /Unimplemented/ +-- +{-# INLINE parseSequence #-} +parseSequence + :: -- Monad m => + Stream m (PR.Parser a m b) + -> Stream m a + -> Stream m b +parseSequence _f _m = undefined + +-- XXX Change the parser arguments' order + +-- | @parseManyTill collect test stream@ tries the parser @test@ on the input, +-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds +-- @test@ is tried again and so on. The parser stops when @test@ succeeds. The +-- output of @test@ is discarded and the output of @collect@ is emitted in the +-- output stream. The parser fails if @collect@ fails. +-- +-- /Unimplemented/ +-- +{-# INLINE parseManyTill #-} +parseManyTill :: + -- MonadThrow m => + PR.Parser a m b + -> PR.Parser a m x + -> Stream m a + -> Stream m b +parseManyTill = undefined + {-# ANN type ConcatParseState Fuse #-} data ConcatParseState c b inpBuf st p m a = ConcatParseInit inpBuf st p @@ -1378,14 +1670,14 @@ data ConcatParseState c b inpBuf st p m a = | ConcatParseYield c (ConcatParseState c b inpBuf st p m a) -- XXX Review the changes -{-# INLINE_NORMAL parseIterate #-} -parseIterate +{-# INLINE_NORMAL parseIterateD #-} +parseIterateD :: Monad m => (b -> PRD.Parser a m b) -> b -> Stream m a -> Stream m (Either ParseError b) -parseIterate func seed (Stream step state) = +parseIterateD func seed (Stream step state) = Stream stepOuter (ConcatParseInit [] state (func seed)) where @@ -1577,6 +1869,29 @@ parseIterate func seed (Stream step state) = stepOuter _ (ConcatParseYield a next) = return $ Yield a next +-- | Iterate a parser generating function on a stream. The initial value @b@ is +-- used to generate the first parser, the parser is applied on the stream and +-- the result is used to generate the next parser and so on. +-- +-- >>> import Data.Monoid (Sum(..)) +-- >>> s = Stream.fromList [1..10] +-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s +-- [3,10,21,36,55,55] +-- +-- This is the streaming equivalent of monad like sequenced application of +-- parsers where next parser is dependent on the previous parser. +-- +-- /Pre-release/ +-- +{-# INLINE parseIterate #-} +parseIterate + :: Monad m + => (b -> PR.Parser a m b) + -> b + -> Stream m a + -> Stream m (Either ParseError b) +parseIterate f = parseIterateD (PRD.fromParserK . f) + ------------------------------------------------------------------------------ -- Grouping ------------------------------------------------------------------------------ @@ -2551,6 +2866,109 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) = let jump c = SplitOnSuffixSeqKRDone (n - 1) c rb rh1 yieldProceed jump b +-- Implement this as a fold or a parser instead. +-- This can be implemented easily using Rabin Karp +-- | Split post any one of the given patterns. +-- +-- /Unimplemented/ +{-# INLINE splitOnSuffixSeqAny #-} +splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) => + [Array a] -> Fold m a b -> Stream m a -> Stream m b +splitOnSuffixSeqAny _subseq _f _m = undefined + -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m) + +-- | Split on a prefixed separator element, dropping the separator. The +-- supplied 'Fold' is applied on the split segments. +-- +-- @ +-- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs) +-- > splitOnPrefix' (== '.') ".a.b" +-- ["a","b"] +-- @ +-- +-- An empty stream results in an empty output stream: +-- @ +-- > splitOnPrefix' (== '.') "" +-- [] +-- @ +-- +-- An empty segment consisting of only a prefix is folded to the default output +-- of the fold: +-- +-- @ +-- > splitOnPrefix' (== '.') "." +-- [""] +-- +-- > splitOnPrefix' (== '.') ".a.b." +-- ["a","b",""] +-- +-- > splitOnPrefix' (== '.') ".a..b" +-- ["a","","b"] +-- +-- @ +-- +-- A prefix is optional at the beginning of the stream: +-- +-- @ +-- > splitOnPrefix' (== '.') "a" +-- ["a"] +-- +-- > splitOnPrefix' (== '.') "a.b" +-- ["a","b"] +-- @ +-- +-- 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element: +-- +-- > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id +-- +-- Assuming the input stream does not contain the separator: +-- +-- > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id +-- +-- /Unimplemented/ +{-# INLINE splitOnPrefix #-} +splitOnPrefix :: -- (IsStream t, MonadCatch m) => + (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b +splitOnPrefix _predicate _f = undefined + -- parseMany (Parser.sliceBeginBy predicate f) + +-- Int list examples for splitOn: +-- +-- >>> splitList [] [1,2,3,3,4] +-- > [[1],[2],[3],[3],[4]] +-- +-- >>> splitList [5] [1,2,3,3,4] +-- > [[1,2,3,3,4]] +-- +-- >>> splitList [1] [1,2,3,3,4] +-- > [[],[2,3,3,4]] +-- +-- >>> splitList [4] [1,2,3,3,4] +-- > [[1,2,3,3],[]] +-- +-- >>> splitList [2] [1,2,3,3,4] +-- > [[1],[3,3,4]] +-- +-- >>> splitList [3] [1,2,3,3,4] +-- > [[1,2],[],[4]] +-- +-- >>> splitList [3,3] [1,2,3,3,4] +-- > [[1,2],[4]] +-- +-- >>> splitList [1,2,3,3,4] [1,2,3,3,4] +-- > [[],[]] + +-- This can be implemented easily using Rabin Karp +-- | Split on any one of the given patterns. +-- +-- /Unimplemented/ +-- +{-# INLINE splitOnAny #-} +splitOnAny :: -- (Monad m, Unboxed a, Integral a) => + [Array a] -> Fold m a b -> Stream m a -> Stream m b +splitOnAny _subseq _f _m = + undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m) + ------------------------------------------------------------------------------ -- Nested Container Transformation ------------------------------------------------------------------------------ @@ -2663,3 +3081,42 @@ splitInnerBySuffix splitter joiner (Stream step1 state1) = step _ (SplitYielding x next) = return $ Yield x next step _ SplitFinishing = return Stop + +------------------------------------------------------------------------------ +-- Trimming +------------------------------------------------------------------------------ + +-- | Drop prefix from the input stream if present. +-- +-- Space: @O(1)@ +-- +-- /Unimplemented/ +{-# INLINE dropPrefix #-} +dropPrefix :: + -- (Monad m, Eq a) => + Stream m a -> Stream m a -> Stream m a +dropPrefix = error "Not implemented yet!" + +-- | Drop all matching infix from the input stream if present. Infix stream +-- may be consumed multiple times. +-- +-- Space: @O(n)@ where n is the length of the infix. +-- +-- /Unimplemented/ +{-# INLINE dropInfix #-} +dropInfix :: + -- (Monad m, Eq a) => + Stream m a -> Stream m a -> Stream m a +dropInfix = error "Not implemented yet!" + +-- | Drop suffix from the input stream if present. Suffix stream may be +-- consumed multiple times. +-- +-- Space: @O(n)@ where n is the length of the suffix. +-- +-- /Unimplemented/ +{-# INLINE dropSuffix #-} +dropSuffix :: + -- (Monad m, Eq a) => + Stream m a -> Stream m a -> Stream m a +dropSuffix = error "Not implemented yet!" diff --git a/core/src/Streamly/Internal/Data/Stream/Top.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Top.hs similarity index 87% rename from core/src/Streamly/Internal/Data/Stream/Top.hs rename to core/src/Streamly/Internal/Data/Stream/StreamD/Top.hs index 17ca677a6..f74f44483 100644 --- a/core/src/Streamly/Internal/Data/Stream/Top.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Top.hs @@ -1,5 +1,5 @@ -- | --- Module : Streamly.Internal.Data.Stream.Top +-- Module : Streamly.Internal.Data.Stream.StreamD.Top -- Copyright : (c) 2020 Composewell Technologies -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com @@ -8,16 +8,13 @@ -- -- Top level module that can depend on all other lower level Stream modules. -module Streamly.Internal.Data.Stream.Top +module Streamly.Internal.Data.Stream.StreamD.Top ( -- * Transformation -- ** Sampling -- | Value agnostic filtering. strideFromThen - -- ** Reordering - , sortBy - -- * Nesting -- ** Set like operations -- | These are not exactly set operations because streams are not @@ -51,18 +48,13 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.IORef (newIORef, readIORef, modifyIORef') import Streamly.Internal.Data.Fold.Type (Fold) import Streamly.Internal.Data.Stream.Common () -import Streamly.Internal.Data.Stream.Type - (Stream, fromStreamD, toStreamD, cross) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream, cross) import qualified Data.List as List import qualified Streamly.Internal.Data.Fold as Fold -import qualified Streamly.Internal.Data.Parser as Parser -import qualified Streamly.Internal.Data.Stream.Eliminate as Stream -import qualified Streamly.Internal.Data.Stream.Generate as Stream -import qualified Streamly.Internal.Data.Stream.Expand as Stream -import qualified Streamly.Internal.Data.Stream.Reduce as Stream -import qualified Streamly.Internal.Data.Stream.Transform as Stream -import qualified Streamly.Internal.Data.Stream.StreamD as StreamD +import qualified Streamly.Internal.Data.Stream.StreamD.Type as Stream +import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Stream +import qualified Streamly.Internal.Data.Stream.StreamD.Transform as Stream import Prelude hiding (filter, zipWith, concatMap, concat) @@ -91,32 +83,6 @@ strideFromThen offset stride = Stream.with Stream.indexed Stream.filter (\(i, _) -> i >= offset && (i - offset) `mod` stride == 0) ------------------------------------------------------------------------------- --- Reordering ------------------------------------------------------------------------------- --- --- Note: this is not the fastest possible implementation as of now. --- --- We could possibly choose different algorithms depending on whether the --- input stream is almost sorted (ascending/descending) or random. We could --- serialize the stream to an array and use quicksort. - --- | Sort the input stream using a supplied comparison function. --- --- /O(n) space/ --- -{-# INLINE sortBy #-} -sortBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a --- sortBy f = Stream.concatPairsWith (Stream.mergeBy f) Stream.fromPure -sortBy cmp = - let p = - Parser.groupByRollingEither - (\x -> (< GT) . cmp x) - Fold.toStreamRev - Fold.toStream - in Stream.mergeMapWith (Stream.mergeBy cmp) id - . Stream.catRights . Stream.parseMany (fmap (either id id) p) - ------------------------------------------------------------------------------ -- SQL Joins ------------------------------------------------------------------------------ @@ -290,10 +256,7 @@ filterInStreamGenericBy eq = {-# INLINE filterInStreamAscBy #-} filterInStreamAscBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a -filterInStreamAscBy eq s1 s2 = - fromStreamD - $ StreamD.intersectBySorted eq (toStreamD s2) - $ toStreamD s1 +filterInStreamAscBy eq s1 s2 = Stream.intersectBySorted eq s2 s1 -- | Delete all elements of the first stream from the seconds stream. If an -- element occurs multiple times in the first stream as many occurrences of it @@ -380,7 +343,7 @@ unionWithStreamGenericBy eq s1 s2 = $ do xs1 <- liftIO $ readIORef ref return $ Stream.fromList xs1 - return $ Stream.mapM f s2 <> s3 + return $ Stream.mapM f s2 `Stream.append` s3 -- | A more efficient 'unionWithStreamGenericBy' for sorted streams. -- diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD/Transform.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Transform.hs index ea022ae03..92a319d95 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamD/Transform.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Transform.hs @@ -27,14 +27,16 @@ module Streamly.Internal.Data.Stream.StreamD.Transform -- * Mapping Effects , tap , tapOffsetEvery + , trace + , trace_ -- * Folding , foldrS , foldlS -- * Scanning By 'Fold' - , postscanOnce -- XXX rename to postscan - , scanOnce -- XXX rename to scan + , postscan + , scan , scanMany -- * Scanning @@ -65,44 +67,67 @@ module Streamly.Internal.Data.Stream.StreamD.Transform -- * Filtering -- | Produce a subset of the stream. + , with , scanMaybe , filter , filterM , deleteBy + , uniqBy , uniq + , prune + , repeated -- * Trimming -- | Produce a subset of the stream trimmed at ends. , take , takeWhile , takeWhileM + , takeWhileLast + , takeWhileAround , drop , dropWhile , dropWhileM + , dropLast + , dropWhileLast + , dropWhileAround -- * Inserting Elements -- | Produce a superset of the stream. , insertBy , intersperse , intersperseM + , intersperseMWith , intersperseMSuffix , intersperseMSuffixWith -- * Inserting Side Effects , intersperseM_ , intersperseMSuffix_ + , intersperseMPrefix_ + + , delay + , delayPre + , delayPost -- * Reordering -- | Produce strictly the same set but reordered. , reverse - -- , reverse' + , reverseUnbox + , reassembleBy -- * Position Indexing , indexed , indexedR + -- * Time Indexing + , timestampWith + , timestamped + , timeIndexWith + , timeIndexed + -- * Searching , findIndices + , elemIndices , slicesBy -- * Rolling map @@ -115,32 +140,73 @@ module Streamly.Internal.Data.Stream.StreamD.Transform , mapMaybe , mapMaybeM , catMaybes + + -- * Either Streams + , catLefts + , catRights + , catEithers ) where #include "inline.hs" +import Control.Concurrent (threadDelay) import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Data.Either (fromLeft, isLeft, isRight, fromRight) +import Data.Functor ((<&>)) import Data.Maybe (fromJust, isJust) import Fusion.Plugin.Types (Fuse(..)) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Internal.Data.Pipe.Type (Pipe(..), PipeState(..)) import Streamly.Internal.Data.SVar.Type (adaptState) +import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64) +import Streamly.Internal.Data.Unboxed (Unbox) +import Streamly.Internal.System.IO (defaultChunkSize) -import qualified Streamly.Internal.Data.Fold.Type as FL +-- import qualified Data.List as List +import qualified Streamly.Internal.Data.Array.Type as A +import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Pipe.Type as Pipe +import qualified Streamly.Internal.Data.Stream.StreamK.Type as K import Prelude hiding ( drop, dropWhile, filter, map, mapM, reverse - , scanl, scanl1, sequence, take, takeWhile) + , scanl, scanl1, sequence, take, takeWhile, zipWith) +import Streamly.Internal.Data.Stream.StreamD.Generate + (absTimesWith, relTimesWith) import Streamly.Internal.Data.Stream.StreamD.Type +-- +-- $setup +-- >>> :m +-- >>> import Control.Concurrent (threadDelay) +-- >>> import Control.Monad (void) +-- >>> import Control.Monad.IO.Class (MonadIO (liftIO)) +-- >>> import Data.Either (fromLeft, fromRight, isLeft, isRight, either) +-- >>> import Data.Function ((&)) +-- >>> import Data.Maybe (fromJust, isJust) +-- >>> import Prelude hiding (filter, drop, dropWhile, take, takeWhile, foldr, map, mapM, sequence, reverse, foldr1 , scanl, scanl1) +-- >>> import Streamly.Internal.Data.Stream (Stream) +-- >>> import qualified Streamly.Data.Fold as Fold +-- >>> import qualified Streamly.Data.Unfold as Unfold +-- >>> import qualified Streamly.Internal.Data.Fold as Fold (filtering) +-- >>> import qualified Streamly.Internal.Data.Fold.Window as Window +-- >>> import qualified Streamly.Internal.Data.Stream as Stream +-- >>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering)) +-- +-- >>> hSetBuffering stdout LineBuffering + ------------------------------------------------------------------------------ -- Piping ------------------------------------------------------------------------------ +-- | Use a 'Pipe' to transform a stream. +-- +-- /Pre-release/ +-- {-# INLINE_NORMAL transform #-} transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b transform (Pipe pstep1 pstep2 pstate) (Stream step state) = @@ -197,6 +263,16 @@ foldlS fstep begin (Stream step state) = Stream step' (Left (state, begin)) -- Transformation by Mapping ------------------------------------------------------------------------------ +-- | +-- >>> sequence = Stream.mapM id +-- +-- Replace the elements of a stream of monadic actions with the outputs of +-- those actions. +-- +-- >>> s = Stream.fromList [putStr "a", putStr "b", putStrLn "c"] +-- >>> Stream.fold Fold.drain $ Stream.sequence s +-- abc +-- {-# INLINE_NORMAL sequence #-} sequence :: Monad m => Stream m (m a) -> Stream m a sequence (Stream step state) = Stream step' state @@ -217,6 +293,25 @@ data TapState fs st a = TapInit | Tapping !fs st | TapDone st -- XXX Multiple yield points + +-- | Tap the data flowing through a stream into a 'Fold'. For example, you may +-- add a tap to log the contents flowing through the stream. The fold is used +-- only for effects, its result is discarded. +-- +-- @ +-- Fold m a b +-- | +-- -----stream m a ---------------stream m a----- +-- +-- @ +-- +-- >>> s = Stream.enumerateFromTo 1 2 +-- >>> Stream.fold Fold.drain $ Stream.tap (Fold.drainMapM print) s +-- 1 +-- 2 +-- +-- Compare with 'trace'. +-- {-# INLINE tap #-} tap :: Monad m => Fold m a b -> Stream m a -> Stream m a tap (Fold fstep initial extract) (Stream step state) = Stream step' TapInit @@ -301,15 +396,62 @@ tapOffsetEvery offset n (Fold fstep initial extract) (Stream step state) = Skip s -> Skip (TapOffDone s) Stop -> Stop +-- | Apply a monadic function to each element flowing through the stream and +-- discard the results. +-- +-- >>> s = Stream.enumerateFromTo 1 2 +-- >>> Stream.fold Fold.drain $ Stream.trace print s +-- 1 +-- 2 +-- +-- Compare with 'tap'. +-- +{-# INLINE trace #-} +trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a +trace f = mapM (\x -> void (f x) >> return x) + +-- | Perform a side effect before yielding each element of the stream and +-- discard the results. +-- +-- >>> s = Stream.enumerateFromTo 1 2 +-- >>> Stream.fold Fold.drain $ Stream.trace_ (print "got here") s +-- "got here" +-- "got here" +-- +-- Same as 'intersperseMPrefix_' but always serial. +-- +-- See also: 'trace' +-- +-- /Pre-release/ +{-# INLINE trace_ #-} +trace_ :: Monad m => m b -> Stream m a -> Stream m a +trace_ eff = mapM (\x -> eff >> return x) + ------------------------------------------------------------------------------ -- Scanning with a Fold ------------------------------------------------------------------------------ data ScanState s f = ScanInit s | ScanDo s !f | ScanDone -{-# INLINE_NORMAL postscanOnce #-} -postscanOnce :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b -postscanOnce (FL.Fold fstep initial extract) (Stream sstep state) = +-- | Postscan a stream using the given monadic fold. +-- +-- The following example extracts the input stream up to a point where the +-- running average of elements is no more than 10: +-- +-- >>> import Data.Maybe (fromJust) +-- >>> let avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length) +-- >>> s = Stream.enumerateFromTo 1.0 100.0 +-- >>> :{ +-- Stream.fold Fold.toList +-- $ fmap (fromJust . fst) +-- $ Stream.takeWhile (\(_,x) -> x <= 10) +-- $ Stream.postscan (Fold.tee Fold.latest avg) s +-- :} +-- [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0] +-- +{-# INLINE_NORMAL postscan #-} +postscan :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b +postscan (FL.Fold fstep initial extract) (Stream sstep state) = Stream step (ScanInit state) where @@ -364,11 +506,75 @@ scanWith restart (Fold fstep initial extract) (Stream sstep state) = Stop -> return Stop step _ ScanDone = return Stop -{-# INLINE scanOnce #-} -scanOnce :: Monad m - => FL.Fold m a b -> Stream m a -> Stream m b -scanOnce = scanWith False +-- XXX It may be useful to have a version of scan where we can keep the +-- accumulator independent of the value emitted. So that we do not necessarily +-- have to keep a value in the accumulator which we are not using. We can pass +-- an extraction function that will take the accumulator and the current value +-- of the element and emit the next value in the stream. That will also make it +-- possible to modify the accumulator after using it. In fact, the step function +-- can return new accumulator and the value to be emitted. The signature would +-- be more like mapAccumL. +-- | Strict left scan. Scan a stream using the given monadic fold. +-- +-- >>> s = Stream.fromList [1..10] +-- >>> Stream.fold Fold.toList $ Stream.takeWhile (< 10) $ Stream.scan Fold.sum s +-- [0,1,3,6] +-- +-- See also: 'usingStateT' +-- + +-- EXPLANATION: +-- >>> scanl' step z = Stream.scan (Fold.foldl' step z) +-- +-- Like 'map', 'scanl'' too is a one to one transformation, +-- however it adds an extra element. +-- +-- >>> s = Stream.fromList [1,2,3,4] +-- >>> Stream.fold Fold.toList $ scanl' (+) 0 s +-- [0,1,3,6,10] +-- +-- >>> Stream.fold Fold.toList $ scanl' (flip (:)) [] s +-- [[],[1],[2,1],[3,2,1],[4,3,2,1]] +-- +-- The output of 'scanl'' is the initial value of the accumulator followed by +-- all the intermediate steps and the final result of 'foldl''. +-- +-- By streaming the accumulated state after each fold step, we can share the +-- state across multiple stages of stream composition. Each stage can modify or +-- extend the state, do some processing with it and emit it for the next stage, +-- thus modularizing the stream processing. This can be useful in +-- stateful or event-driven programming. +-- +-- Consider the following monolithic example, computing the sum and the product +-- of the elements in a stream in one go using a @foldl'@: +-- +-- >>> foldl' step z = Stream.fold (Fold.foldl' step z) +-- >>> foldl' (\(s, p) x -> (s + x, p * x)) (0,1) s +-- (10,24) +-- +-- Using @scanl'@ we can make it modular by computing the sum in the first +-- stage and passing it down to the next stage for computing the product: +-- +-- >>> :{ +-- foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1) +-- $ scanl' (\(s, _) x -> (s + x, x)) (0,1) +-- $ Stream.fromList [1,2,3,4] +-- :} +-- (10,24) +-- +-- IMPORTANT: 'scanl'' evaluates the accumulator to WHNF. To avoid building +-- lazy expressions inside the accumulator, it is recommended that a strict +-- data structure is used for accumulator. +-- +{-# INLINE scan #-} +scan :: Monad m + => FL.Fold m a b -> Stream m a -> Stream m b +scan = scanWith False + +-- | Like 'scan' but restarts scanning afresh when the scanning fold +-- terminates. +-- {-# INLINE scanMany #-} scanMany :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b @@ -557,6 +763,17 @@ scanlM' fstep begin (Stream step state) = Stream step' Nothing Skip s -> return $ Skip (Just (s, acc)) Stop -> return Stop +-- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except +-- that it provides an additional @done@ function to be applied on the +-- accumulator when the stream stops. The result of @done@ is also emitted in +-- the stream. +-- +-- This function can be used to allocate a resource in the beginning of the +-- scan and release it when the stream ends or to flush the internal state of +-- the scan at the end. +-- +-- /Pre-release/ +-- {-# INLINE scanlMAfter' #-} scanlMAfter' :: Monad m => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b @@ -644,7 +861,28 @@ scanl1' f = scanl1M' (\x y -> return (f x y)) -- Filtering ------------------------------------------------------------------------------- +-- | Modify a @Stream m a -> Stream m a@ stream transformation that accepts a +-- predicate @(a -> b)@ to accept @((s, a) -> b)@ instead, provided a +-- transformation @Stream m a -> Stream m (s, a)@. Convenient to filter with +-- index or time. +-- +-- >>> filterWithIndex = Stream.with Stream.indexed Stream.filter +-- +-- /Pre-release/ +{-# INLINE with #-} +with :: Monad m => + (Stream m a -> Stream m (s, a)) + -> (((s, a) -> b) -> Stream m (s, a) -> Stream m (s, a)) + -> (((s, a) -> b) -> Stream m a -> Stream m a) +with f comb g = fmap snd . comb g . f + -- Adapted from the vector package + +-- | Same as 'filter' but with a monadic predicate. +-- +-- >>> f p x = p x >>= \r -> return $ if r then Just x else Nothing +-- >>> filterM p = Stream.mapMaybeM (f p) +-- {-# INLINE_NORMAL filterM #-} filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a filterM f (Stream step state) = Stream step' state @@ -661,13 +899,55 @@ filterM f (Stream step state) = Stream step' state Skip s -> return $ Skip s Stop -> return Stop +-- | Include only those elements that pass a predicate. +-- +-- >>> filter p = Stream.filterM (return . p) +-- >>> filter p = Stream.mapMaybe (\x -> if p x then Just x else Nothing) +-- >>> filter p = Stream.scanMaybe (Fold.filtering p) +-- {-# INLINE filter #-} filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a filter f = filterM (return . f) +-- filter p = scanMaybe (FL.filtering p) + +-- | Drop repeated elements that are adjacent to each other using the supplied +-- comparison function. +-- +-- >>> uniq = Stream.uniqBy (==) +-- +-- To strip duplicate path separators: +-- +-- >>> input = Stream.fromList "//a//b" +-- >>> f x y = x == '/' && y == '/' +-- >>> Stream.fold Fold.toList $ Stream.uniqBy f input +-- "/a/b" +-- +-- Space: @O(1)@ +-- +-- /Pre-release/ +-- +{-# INLINE uniqBy #-} +uniqBy :: Monad m => + (a -> a -> Bool) -> Stream m a -> Stream m a +-- uniqBy eq = scanMaybe (FL.uniqBy eq) +uniqBy eq = catMaybes . rollingMap f + + where + + f pre curr = + case pre of + Nothing -> Just curr + Just x -> if x `eq` curr then Nothing else Just curr -- Adapted from the vector package + +-- | Drop repeated elements that are adjacent to each other. +-- +-- >>> uniq = Stream.uniqBy (==) +-- {-# INLINE_NORMAL uniq #-} uniq :: (Eq a, Monad m) => Stream m a -> Stream m a +-- uniq = scanMaybe FL.uniq uniq (Stream step state) = Stream step' (Nothing, state) where {-# INLINE_LATE step' #-} @@ -685,8 +965,16 @@ uniq (Stream step state) = Stream step' (Nothing, state) Skip s -> return $ Skip (Just x, s) Stop -> return Stop +-- | Deletes the first occurrence of the element in the stream that satisfies +-- the given equality predicate. +-- +-- >>> input = Stream.fromList [1,3,3,5] +-- >>> Stream.fold Fold.toList $ Stream.deleteBy (==) 3 input +-- [1,3,5] +-- {-# INLINE_NORMAL deleteBy #-} deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a +-- deleteBy cmp x = scanMaybe (FL.deleteBy cmp x) deleteBy eq x (Stream step state) = Stream step' (state, False) where {-# INLINE_LATE step' #-} @@ -705,11 +993,69 @@ deleteBy eq x (Stream step state) = Stream step' (state, False) Skip s -> return $ Skip (s, True) Stop -> return Stop +-- | Strip all leading and trailing occurrences of an element passing a +-- predicate and make all other consecutive occurrences uniq. +-- +-- >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y) +-- +-- @ +-- > Stream.prune isSpace (Stream.fromList " hello world! ") +-- "hello world!" +-- +-- @ +-- +-- Space: @O(1)@ +-- +-- /Unimplemented/ +{-# INLINE prune #-} +prune :: + -- (Monad m, Eq a) => + (a -> Bool) -> Stream m a -> Stream m a +prune = error "Not implemented yet!" + +-- Possible implementation: +-- @repeated = +-- Stream.catMaybes . Stream.parseMany (Parser.groupBy (==) Fold.repeated)@ +-- +-- 'Fold.repeated' should return 'Just' when repeated, and 'Nothing' for a +-- single element. + +-- | Emit only repeated elements, once. +-- +-- /Unimplemented/ +repeated :: -- (Monad m, Eq a) => + Stream m a -> Stream m a +repeated = undefined + ------------------------------------------------------------------------------ -- Trimming ------------------------------------------------------------------------------ +-- | Take all consecutive elements at the end of the stream for which the +-- predicate is true. +-- +-- O(n) space, where n is the number elements taken. +-- +-- /Unimplemented/ +{-# INLINE takeWhileLast #-} +takeWhileLast :: -- Monad m => + (a -> Bool) -> Stream m a -> Stream m a +takeWhileLast = undefined -- fromStreamD $ D.takeWhileLast n $ toStreamD m + +-- | Like 'takeWhile' and 'takeWhileLast' combined. +-- +-- O(n) space, where n is the number elements taken from the end. +-- +-- /Unimplemented/ +{-# INLINE takeWhileAround #-} +takeWhileAround :: -- Monad m => + (a -> Bool) -> Stream m a -> Stream m a +takeWhileAround = undefined -- fromStreamD $ D.takeWhileAround n $ toStreamD m + -- Adapted from the vector package + +-- | Discard first 'n' elements from the stream and take the rest. +-- {-# INLINE_NORMAL drop #-} drop :: Monad m => Int -> Stream m a -> Stream m a drop n (Stream step state) = Stream step' (state, Just n) @@ -739,8 +1085,11 @@ data DropWhileState s a | DropWhileYield a s | DropWhileNext s +-- | Same as 'dropWhile' but with a monadic predicate. +-- {-# INLINE_NORMAL dropWhileM #-} dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a +-- dropWhileM p = scanMaybe (FL.droppingWhileM p) dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state) where {-# INLINE_LATE step' #-} @@ -764,14 +1113,58 @@ dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state) step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st) +-- | Drop elements in the stream as long as the predicate succeeds and then +-- take the rest of the stream. +-- {-# INLINE dropWhile #-} dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a +-- dropWhile p = scanMaybe (FL.droppingWhile p) dropWhile f = dropWhileM (return . f) +-- | Drop @n@ elements at the end of the stream. +-- +-- O(n) space, where n is the number elements dropped. +-- +-- /Unimplemented/ +{-# INLINE dropLast #-} +dropLast :: -- Monad m => + Int -> Stream m a -> Stream m a +dropLast = undefined -- fromStreamD $ D.dropLast n $ toStreamD m + +-- | Drop all consecutive elements at the end of the stream for which the +-- predicate is true. +-- +-- O(n) space, where n is the number elements dropped. +-- +-- /Unimplemented/ +{-# INLINE dropWhileLast #-} +dropWhileLast :: -- Monad m => + (a -> Bool) -> Stream m a -> Stream m a +dropWhileLast = undefined -- fromStreamD $ D.dropWhileLast n $ toStreamD m + +-- | Like 'dropWhile' and 'dropWhileLast' combined. +-- +-- O(n) space, where n is the number elements dropped from the end. +-- +-- /Unimplemented/ +{-# INLINE dropWhileAround #-} +dropWhileAround :: -- Monad m => + (a -> Bool) -> Stream m a -> Stream m a +dropWhileAround = undefined -- fromStreamD $ D.dropWhileAround n $ toStreamD m + ------------------------------------------------------------------------------ -- Inserting Elements ------------------------------------------------------------------------------ +-- | @insertBy cmp elem stream@ inserts @elem@ before the first element in +-- @stream@ that is less than @elem@ when compared using @cmp@. +-- +-- >>> insertBy cmp x = Stream.mergeBy cmp (Stream.fromPure x) +-- +-- >>> input = Stream.fromList [1,3,5] +-- >>> Stream.fold Fold.toList $ Stream.insertBy compare 2 input +-- [1,2,3,5] +-- {-# INLINE_NORMAL insertBy #-} insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing) @@ -799,6 +1192,22 @@ data LoopState x s = FirstYield s | InterspersingYield s | YieldAndCarry x s +-- intersperseM = intersperseMWith 1 + +-- | Insert an effect and its output before consuming an element of a stream +-- except the first one. +-- +-- >>> input = Stream.fromList "hello" +-- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseM (putChar '.' >> return ',') input +-- h.,e.,l.,l.,o"h,e,l,l,o" +-- +-- Be careful about the order of effects. In the above example we used trace +-- after the intersperse, if we use it before the intersperse the output would +-- be he.l.l.o."h,e,l,l,o". +-- +-- >>> Stream.fold Fold.toList $ Stream.intersperseM (putChar '.' >> return ',') $ Stream.trace putChar input +-- he.l.l.o."h,e,l,l,o" +-- {-# INLINE_NORMAL intersperseM #-} intersperseM :: Monad m => m a -> Stream m a -> Stream m a intersperseM m (Stream step state) = Stream step' (FirstYield state) @@ -823,10 +1232,24 @@ intersperseM m (Stream step state) = Stream step' (FirstYield state) step' _ (YieldAndCarry x st) = return $ Yield x (InterspersingYield st) +-- | Insert a pure value between successive elements of a stream. +-- +-- >>> input = Stream.fromList "hello" +-- >>> Stream.fold Fold.toList $ Stream.intersperse ',' input +-- "h,e,l,l,o" +-- {-# INLINE intersperse #-} intersperse :: Monad m => a -> Stream m a -> Stream m a intersperse a = intersperseM (return a) +-- | Insert a side effect before consuming an element of a stream except the +-- first one. +-- +-- >>> input = Stream.fromList "hello" +-- >>> Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseM_ (putChar '.') input +-- h.e.l.l.o +-- +-- /Pre-release/ {-# INLINE_NORMAL intersperseM_ #-} intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a intersperseM_ m (Stream step1 state1) = Stream step (Left (pure (), state1)) @@ -841,11 +1264,31 @@ intersperseM_ m (Stream step1 state1) = Stream step (Left (pure (), state1)) step _ (Right st) = return $ Skip $ Left (void m, st) +-- | Intersperse a monadic action into the input stream after every @n@ +-- elements. +-- +-- >> input = Stream.fromList "hello" +-- >> Stream.fold Fold.toList $ Stream.intersperseMWith 2 (return ',') input +-- "he,ll,o" +-- +-- /Unimplemented/ +{-# INLINE intersperseMWith #-} +intersperseMWith :: -- Monad m => + Int -> m a -> Stream m a -> Stream m a +intersperseMWith _n _f _xs = undefined + data SuffixState s a = SuffixElem s | SuffixSuffix s | SuffixYield a (SuffixState s a) +-- | Insert an effect and its output after consuming an element of a stream. +-- +-- >>> input = Stream.fromList "hello" +-- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMSuffix (putChar '.' >> return ',') input +-- h.,e.,l.,l.,o.,"h,e,l,l,o," +-- +-- /Pre-release/ {-# INLINE_NORMAL intersperseMSuffix #-} intersperseMSuffix :: forall m a. Monad m => m a -> Stream m a -> Stream m a intersperseMSuffix action (Stream step state) = Stream step' (SuffixElem state) @@ -863,6 +1306,14 @@ intersperseMSuffix action (Stream step state) = Stream step' (SuffixElem state) step' _ (SuffixYield x next) = return $ Yield x next +-- | Insert a side effect after consuming an element of a stream. +-- +-- >>> input = Stream.fromList "hello" +-- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffix_ (threadDelay 1000000) input +-- "hello" +-- +-- /Pre-release/ +-- {-# INLINE_NORMAL intersperseMSuffix_ #-} intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a intersperseMSuffix_ m (Stream step1 state1) = Stream step (Left state1) @@ -884,7 +1335,15 @@ data SuffixSpanState s a | SuffixSpanLast | SuffixSpanStop --- | intersperse after every n items +-- | Like 'intersperseMSuffix' but intersperses an effectful action into the +-- input stream after every @n@ elements and after the last element. +-- +-- >>> input = Stream.fromList "hello" +-- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffixWith 2 (return ',') input +-- "he,ll,o," +-- +-- /Pre-release/ +-- {-# INLINE_NORMAL intersperseMSuffixWith #-} intersperseMSuffixWith :: forall m a. Monad m => Int -> m a -> Stream m a -> Stream m a @@ -910,21 +1369,113 @@ intersperseMSuffixWith n action (Stream step state) = step' _ SuffixSpanStop = return Stop +-- | Insert a side effect before consuming an element of a stream. +-- +-- Definition: +-- +-- >>> intersperseMPrefix_ m = Stream.mapM (\x -> void m >> return x) +-- +-- >>> input = Stream.fromList "hello" +-- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMPrefix_ (putChar '.' >> return ',') input +-- .h.e.l.l.o"hello" +-- +-- Same as 'trace_'. +-- +-- /Pre-release/ +-- +{-# INLINE intersperseMPrefix_ #-} +intersperseMPrefix_ :: Monad m => m b -> Stream m a -> Stream m a +intersperseMPrefix_ m = mapM (\x -> void m >> return x) + +------------------------------------------------------------------------------ +-- Inserting Time +------------------------------------------------------------------------------ + +-- XXX This should be in Prelude, should we export this as a helper function? + +-- | Block the current thread for specified number of seconds. +{-# INLINE sleep #-} +sleep :: MonadIO m => Double -> m () +sleep n = liftIO $ threadDelay $ round $ n * 1000000 + +-- | Introduce a delay of specified seconds between elements of the stream. +-- +-- Definition: +-- +-- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000 +-- >>> delay = Stream.intersperseM_ . sleep +-- +-- Example: +-- +-- >>> input = Stream.enumerateFromTo 1 3 +-- >>> Stream.fold (Fold.drainMapM print) $ Stream.delay 1 input +-- 1 +-- 2 +-- 3 +-- +{-# INLINE delay #-} +delay :: MonadIO m => Double -> Stream m a -> Stream m a +delay = intersperseM_ . sleep + +-- | Introduce a delay of specified seconds after consuming an element of a +-- stream. +-- +-- Definition: +-- +-- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000 +-- >>> delayPost = Stream.intersperseMSuffix_ . sleep +-- +-- Example: +-- +-- >>> input = Stream.enumerateFromTo 1 3 +-- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPost 1 input +-- 1 +-- 2 +-- 3 +-- +-- /Pre-release/ +-- +{-# INLINE delayPost #-} +delayPost :: MonadIO m => Double -> Stream m a -> Stream m a +delayPost n = intersperseMSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000 + +-- | Introduce a delay of specified seconds before consuming an element of a +-- stream. +-- +-- Definition: +-- +-- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000 +-- >>> delayPre = Stream.intersperseMPrefix_. sleep +-- +-- Example: +-- +-- >>> input = Stream.enumerateFromTo 1 3 +-- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPre 1 input +-- 1 +-- 2 +-- 3 +-- +-- /Pre-release/ +-- +{-# INLINE delayPre #-} +delayPre :: MonadIO m => Double -> Stream m a -> Stream m a +delayPre = intersperseMPrefix_. sleep + ------------------------------------------------------------------------------ -- Reordering ------------------------------------------------------------------------------ --- We can implement reverse as: +-- | Returns the elements of the stream in reverse order. The stream must be +-- finite. Note that this necessarily buffers the entire stream in memory. -- --- > reverse = foldlS (flip cons) nil +-- Definition: -- --- However, this implementation is unusable because of the horrible performance --- of cons. So we just convert it to a list first and then stream from the --- list. +-- >>> reverse m = Stream.concatEffect $ Stream.fold Fold.toListRev m >>= return . Stream.fromList -- --- XXX Maybe we can use an Array instead of a list here? {-# INLINE_NORMAL reverse #-} reverse :: Monad m => Stream m a -> Stream m a +reverse m = concatEffect $ fold FL.toListRev m <&> fromList +{- reverse m = Stream step Nothing where {-# INLINE_LATE step #-} @@ -933,47 +1484,57 @@ reverse m = Stream step Nothing return $ Skip (Just xs) step _ (Just (x:xs)) = return $ Yield x (Just xs) step _ (Just []) = return Stop - --- Much faster reverse for Storables -{- -{-# INLINE_NORMAL reverse' #-} -reverse' :: forall m a. (MonadIO m, Storable a) => Stream m a -> Stream m a --- This commented implementation copies the whole stream into one single array --- and then streams from that array, this has exactly the same performance as --- the chunked code in IsStream.Common.reverse' . Though this could be problematic due to --- unbounded large allocations. However, if we use an idiomatic implementation --- of arraysOf instead of the custom implementation then the chunked code --- becomes worse by 6 times. Need to investigate if that can be improved. -import Foreign.ForeignPtr (touchForeignPtr) -import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) -import Foreign.Ptr (Ptr, plusPtr) -import Streamly.Internal.Data.Array.Mut.Type (sizeOfElem) -reverse' m = Stream step Nothing - where - {-# INLINE_LATE step #-} - step _ Nothing = do - arr <- A.fromStreamD m - let p = A.arrEnd arr `plusPtr` negate (sizeOfElem (undefined :: a)) - return $ Skip $ Just (A.aStart arr, p) - - step _ (Just (start, p)) | p < unsafeForeignPtrToPtr start = return Stop - - step _ (Just (start, p)) = do - let !x = A.unsafeInlineIO $ do - r <- peek p - touchForeignPtr start - return r - next = p `plusPtr` negate (sizeOfElem (undefined :: a)) - return $ Yield x (Just (start, next)) -} +-- | Like 'reverse' but several times faster, requires an 'Unbox' instance. +-- +-- /O(n) space/ +-- +-- /Pre-release/ +{-# INLINE reverseUnbox #-} +reverseUnbox :: (MonadIO m, Unbox a) => Stream m a -> Stream m a +reverseUnbox = + A.flattenArraysRev -- unfoldMany A.readRev + . fromStreamK + . K.reverse + . toStreamK + . A.arraysOf defaultChunkSize + +-- | Buffer until the next element in sequence arrives. The function argument +-- determines the difference in sequence numbers. This could be useful in +-- implementing sequenced streams, for example, TCP reassembly. +-- +-- /Unimplemented/ +-- +{-# INLINE reassembleBy #-} +reassembleBy + :: -- Monad m => + Fold m a b + -> (a -> a -> Int) + -> Stream m a + -> Stream m b +reassembleBy = undefined + ------------------------------------------------------------------------------ -- Position Indexing ------------------------------------------------------------------------------ -- Adapted from the vector package + +-- | +-- >>> f = Fold.foldl' (\(i, _) x -> (i + 1, x)) (-1,undefined) +-- >>> indexed = Stream.postscan f +-- >>> indexed = Stream.zipWith (,) (Stream.enumerateFrom 0) +-- >>> indexedR n = fmap (\(i, a) -> (n - i, a)) . indexed +-- +-- Pair each element in a stream with its index, starting from index 0. +-- +-- >>> Stream.fold Fold.toList $ Stream.indexed $ Stream.fromList "hello" +-- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')] +-- {-# INLINE_NORMAL indexed #-} indexed :: Monad m => Stream m a -> Stream m (Int, a) +-- indexed = scanMaybe FL.indexing indexed (Stream step state) = Stream step' (state, 0) where {-# INLINE_LATE step' #-} @@ -985,8 +1546,23 @@ indexed (Stream step state) = Stream step' (state, 0) Stop -> return Stop -- Adapted from the vector package + +-- | +-- >>> f n = Fold.foldl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined) +-- >>> indexedR n = Stream.postscan (f n) +-- +-- >>> s n = Stream.enumerateFromThen n (n - 1) +-- >>> indexedR n = Stream.zipWith (,) (s n) +-- +-- Pair each element in a stream with its index, starting from the +-- given index @n@ and counting down. +-- +-- >>> Stream.fold Fold.toList $ Stream.indexedR 10 $ Stream.fromList "hello" +-- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')] +-- {-# INLINE_NORMAL indexedR #-} indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a) +-- indexedR n = scanMaybe (FL.indexingRev n) indexedR m (Stream step state) = Stream step' (state, m) where {-# INLINE_LATE step' #-} @@ -998,10 +1574,77 @@ indexedR m (Stream step state) = Stream step' (state, m) Skip s -> return $ Skip (s, i) Stop -> return Stop +------------------------------------------------------------------------------- +-- Time Indexing +------------------------------------------------------------------------------- + +-- Note: The timestamp stream must be the second stream in the zip so that the +-- timestamp is generated after generating the stream element and not before. +-- If we do not do that then the following example will generate the same +-- timestamp for first two elements: +-- +-- Stream.fold Fold.toList $ Stream.timestamped $ Stream.delay $ Stream.enumerateFromTo 1 3 + +-- | Pair each element in a stream with an absolute timestamp, using a clock of +-- specified granularity. The timestamp is generated just before the element +-- is consumed. +-- +-- >>> Stream.fold Fold.toList $ Stream.timestampWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3 +-- [(AbsTime (TimeSpec {sec = ..., nsec = ...}),1),(AbsTime (TimeSpec {sec = ..., nsec = ...}),2),(AbsTime (TimeSpec {sec = ..., nsec = ...}),3)] +-- +-- /Pre-release/ +-- +{-# INLINE timestampWith #-} +timestampWith :: (MonadIO m) + => Double -> Stream m a -> Stream m (AbsTime, a) +timestampWith g stream = zipWith (flip (,)) stream (absTimesWith g) + +-- TBD: check performance vs a custom implementation without using zipWith. +-- +-- /Pre-release/ +-- +{-# INLINE timestamped #-} +timestamped :: (MonadIO m) + => Stream m a -> Stream m (AbsTime, a) +timestamped = timestampWith 0.01 + +-- | Pair each element in a stream with relative times starting from 0, using a +-- clock with the specified granularity. The time is measured just before the +-- element is consumed. +-- +-- >>> Stream.fold Fold.toList $ Stream.timeIndexWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3 +-- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)] +-- +-- /Pre-release/ +-- +{-# INLINE timeIndexWith #-} +timeIndexWith :: (MonadIO m) + => Double -> Stream m a -> Stream m (RelTime64, a) +timeIndexWith g stream = zipWith (flip (,)) stream (relTimesWith g) + +-- | Pair each element in a stream with relative times starting from 0, using a +-- 10 ms granularity clock. The time is measured just before the element is +-- consumed. +-- +-- >>> Stream.fold Fold.toList $ Stream.timeIndexed $ Stream.delay 1 $ Stream.enumerateFromTo 1 3 +-- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)] +-- +-- /Pre-release/ +-- +{-# INLINE timeIndexed #-} +timeIndexed :: (MonadIO m) + => Stream m a -> Stream m (RelTime64, a) +timeIndexed = timeIndexWith 0.01 + ------------------------------------------------------------------------------ -- Searching ------------------------------------------------------------------------------ +-- | Find all the indices where the element in the stream satisfies the given +-- predicate. +-- +-- >>> findIndices p = Stream.scanMaybe (Fold.findIndices p) +-- {-# INLINE_NORMAL findIndices #-} findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int findIndices p (Stream step state) = Stream step' (state, 0) @@ -1014,6 +1657,15 @@ findIndices p (Stream step state) = Stream step' (state, 0) Skip s -> Skip (s, i) Stop -> Stop +-- | Find all the indices where the value of the element in the stream is equal +-- to the given value. +-- +-- >>> elemIndices a = Stream.findIndices (== a) +-- +{-# INLINE elemIndices #-} +elemIndices :: (Monad m, Eq a) => a -> Stream m a -> Stream m Int +elemIndices a = findIndices (== a) + {-# INLINE_NORMAL slicesBy #-} slicesBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int) slicesBy p (Stream step1 state1) = Stream step (Just (state1, 0, 0)) @@ -1039,8 +1691,13 @@ slicesBy p (Stream step1 state1) = Stream step (Just (state1, 0, 0)) data RollingMapState s a = RollingMapGo s a +-- | Like 'rollingMap' but with an effectful map function. +-- +-- /Pre-release/ +-- {-# INLINE rollingMapM #-} rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Stream m a -> Stream m b +-- rollingMapM f = scanMaybe (FL.slide2 $ Window.rollingMapM f) rollingMapM f (Stream step1 state1) = Stream step (RollingMapGo state1 Nothing) where @@ -1054,16 +1711,31 @@ rollingMapM f (Stream step1 state1) = Stream step (RollingMapGo state1 Nothing) Skip s -> return $ Skip $ RollingMapGo s curr Stop -> return Stop --- | rollingMap is a special case of an incremental sliding fold. It can be +-- rollingMap is a special case of an incremental sliding fold. It can be -- written as: -- -- > fld f = slidingWindow 1 (Fold.foldl' (\_ (x,y) -> f y x) -- > rollingMap f = Stream.postscan (fld f) undefined + +-- | Apply a function on every two successive elements of a stream. The first +-- argument of the map function is the previous element and the second argument +-- is the current element. When the current element is the first element, the +-- previous element is 'Nothing'. +-- +-- /Pre-release/ -- {-# INLINE rollingMap #-} rollingMap :: Monad m => (Maybe a -> a -> b) -> Stream m a -> Stream m b +-- rollingMap f = scanMaybe (FL.slide2 $ Window.rollingMap f) rollingMap f = rollingMapM (\x y -> return $ f x y) +-- | Like 'rollingMap' but requires at least two elements in the stream, +-- returns an empty stream otherwise. +-- +-- This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@. +-- +-- /Pre-release/ +-- {-# INLINE rollingMap2 #-} rollingMap2 :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b rollingMap2 f = catMaybes . rollingMap g @@ -1078,14 +1750,37 @@ rollingMap2 f = catMaybes . rollingMap g ------------------------------------------------------------------------------ -- XXX Will this always fuse properly? + +-- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing' +-- elements, and return a stream of values extracted from 'Just'. +-- +-- Equivalent to: +-- +-- >>> mapMaybe f = Stream.catMaybes . fmap f +-- {-# INLINE_NORMAL mapMaybe #-} mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b mapMaybe f = fmap fromJust . filter isJust . map f +-- | Like 'mapMaybe' but maps a monadic function. +-- +-- Equivalent to: +-- +-- >>> mapMaybeM f = Stream.catMaybes . Stream.mapM f +-- +-- >>> mapM f = Stream.mapMaybeM (\x -> Just <$> f x) +-- {-# INLINE_NORMAL mapMaybeM #-} mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b mapMaybeM f = fmap fromJust . filter isJust . mapM f +-- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's. +-- +-- >>> catMaybes = Stream.mapMaybe id +-- >>> catMaybes = fmap fromJust . Stream.filter isJust +-- +-- /Pre-release/ +-- {-# INLINE catMaybes #-} catMaybes :: Monad m => Stream m (Maybe a) -> Stream m a -- catMaybes = fmap fromJust . filter isJust @@ -1107,7 +1802,43 @@ catMaybes (Stream step state) = Stream step1 state -- | Use a filtering fold on a stream. -- --- /Pre-release/ +-- >>> scanMaybe f = Stream.catMaybes . Stream.postscan f +-- {-# INLINE scanMaybe #-} scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b -scanMaybe f = catMaybes . postscanOnce f +scanMaybe f = catMaybes . postscan f + +------------------------------------------------------------------------------ +-- Either streams +------------------------------------------------------------------------------ + +-- | Discard 'Right's and unwrap 'Left's in an 'Either' stream. +-- +-- >>> catLefts = fmap (fromLeft undefined) . Stream.filter isLeft +-- +-- /Pre-release/ +-- +{-# INLINE catLefts #-} +catLefts :: Monad m => Stream m (Either a b) -> Stream m a +catLefts = fmap (fromLeft undefined) . filter isLeft + +-- | Discard 'Left's and unwrap 'Right's in an 'Either' stream. +-- +-- >>> catRights = fmap (fromRight undefined) . Stream.filter isRight +-- +-- /Pre-release/ +-- +{-# INLINE catRights #-} +catRights :: Monad m => Stream m (Either a b) -> Stream m b +catRights = fmap (fromRight undefined) . filter isRight + +-- | Remove the either wrapper and flatten both lefts and as well as rights in +-- the output stream. +-- +-- >>> catEithers = fmap (either id id) +-- +-- /Pre-release/ +-- +{-# INLINE catEithers #-} +catEithers :: Monad m => Stream m (Either a a) -> Stream m a +catEithers = fmap (either id id) diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD/Transformer.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Transformer.hs index aec3097c7..40a64805b 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamD/Transformer.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Transformer.hs @@ -16,8 +16,10 @@ module Streamly.Internal.Data.Stream.StreamD.Transformer -- * Transform Inner Monad , liftInner , runReaderT + , usingReaderT , evalStateT , runStateT + , usingStateT ) where @@ -34,6 +36,14 @@ import qualified Control.Monad.Trans.State.Strict as State import Streamly.Internal.Data.Stream.StreamD.Type +-- $setup +-- >>> :m +-- >>> import Control.Monad.Trans.Class (lift) +-- >>> import Control.Monad.Trans.Identity (runIdentityT) +-- >>> import qualified Streamly.Internal.Data.Stream as Stream + +-- | Lazy left fold to a transformer monad. +-- {-# INLINE_NORMAL foldlT #-} foldlT :: (Monad m, Monad (s m), MonadTrans s) => (s m b -> a -> s m b) -> s m b -> Stream m a -> s m b @@ -46,9 +56,19 @@ foldlT fstep begin (Stream step state) = go SPEC begin state Skip s -> go SPEC acc s Stop -> acc --- Right fold to some transformer (T) monad. This can be useful to implement --- stateless combinators like map, filtering, insertions, takeWhile, dropWhile. +-- | Right fold to a transformer monad. This is the most general right fold +-- function. 'foldrS' is a special case of 'foldrT', however 'foldrS' +-- implementation can be more efficient: -- +-- >>> foldrS = Stream.foldrT +-- +-- >>> step f x xs = lift $ f x (runIdentityT xs) +-- >>> foldrM f z s = runIdentityT $ Stream.foldrT (step f) (lift z) s +-- +-- 'foldrT' can be used to translate streamly streams to other transformer +-- monads e.g. to a different streaming type. +-- +-- /Pre-release/ {-# INLINE_NORMAL foldrT #-} foldrT :: (Monad m, Monad (t m), MonadTrans t) => (a -> t m b -> t m b) -> t m b -> Stream m a -> t m b @@ -66,6 +86,9 @@ foldrT f final (Stream step state) = go SPEC state -- Transform Inner Monad ------------------------------------------------------------------------------- +-- | Lift the inner monad @m@ of @Stream m a@ to @t m@ where @t@ is a monad +-- transformer. +-- {-# INLINE_NORMAL liftInner #-} liftInner :: (Monad m, MonadTrans t, Monad (t m)) => Stream m a -> Stream (t m) a @@ -79,6 +102,12 @@ liftInner (Stream step state) = Stream step' state Skip s -> Skip s Stop -> Stop +------------------------------------------------------------------------------ +-- Sharing read only state in a stream +------------------------------------------------------------------------------ + +-- | Evaluate the inner monad of a stream as 'ReaderT'. +-- {-# INLINE_NORMAL runReaderT #-} runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a runReaderT env (Stream step state) = Stream step' (state, env) @@ -92,6 +121,25 @@ runReaderT env (Stream step state) = Stream step' (state, env) Skip s -> Skip (s, return sv) Stop -> Stop +-- | Run a stream transformation using a given environment. +-- +{-# INLINE usingReaderT #-} +usingReaderT + :: Monad m + => m r + -> (Stream (ReaderT r m) a -> Stream (ReaderT r m) a) + -> Stream m a + -> Stream m a +usingReaderT r f xs = runReaderT r $ f $ liftInner xs + +------------------------------------------------------------------------------ +-- Sharing read write state in a stream +------------------------------------------------------------------------------ + +-- | Evaluate the inner monad of a stream as 'StateT'. +-- +-- >>> evalStateT s = fmap snd . Stream.runStateT s +-- {-# INLINE_NORMAL evalStateT #-} evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a evalStateT initial (Stream step state) = Stream step' (state, initial) @@ -105,6 +153,9 @@ evalStateT initial (Stream step state) = Stream step' (state, initial) Skip s -> Skip (s, return sv') Stop -> Stop +-- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting +-- state and value pair after each step. +-- {-# INLINE_NORMAL runStateT #-} runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a) runStateT initial (Stream step state) = Stream step' (state, initial) @@ -117,3 +168,18 @@ runStateT initial (Stream step state) = Stream step' (state, initial) Yield x s -> Yield (sv', x) (s, return sv') Skip s -> Skip (s, return sv') Stop -> Stop + +-- | Run a stateful (StateT) stream transformation using a given state. +-- +-- >>> usingStateT s f = Stream.evalStateT s . f . Stream.liftInner +-- +-- See also: 'scan' +-- +{-# INLINE usingStateT #-} +usingStateT + :: Monad m + => m s + -> (Stream (StateT s m) a -> Stream (StateT s m) a) + -> Stream m a + -> Stream m a +usingStateT s f = evalStateT s . f . liftInner diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD/Type.hs b/core/src/Streamly/Internal/Data/Stream/StreamD/Type.hs index 3c1faf1f5..eb697b60f 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamD/Type.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamD/Type.hs @@ -1,4 +1,4 @@ -#include "inline.hs" +{-# LANGUAGE UndecidableInstances #-} -- | -- Module : Streamly.Internal.Data.Stream.StreamD.Type @@ -17,127 +17,172 @@ module Streamly.Internal.Data.Stream.StreamD.Type ( -- * The stream type Step (..) - -- XXX UnStream is exported to avoid a performance issue in concatMap if we - -- use the pattern synonym "Stream". + -- XXX UnStream is exported to avoid a performance issue in some + -- combinators if we use the pattern synonym "Stream". , Stream (Stream, UnStream) - -- * Primitives - , nilM - , consM - , uncons + -- * CrossStream type wrapper + , CrossStream + , unCross + , mkCross + + -- * Conversion to StreamK + , fromStreamK + , toStreamK -- * From Unfold , unfold - -- * From Values + -- * Construction + -- ** Primitives + , nilM + , consM + + -- ** From Values , fromPure , fromEffect - -- * From Containers - , fromList + -- ** From Containers + , Streamly.Internal.Data.Stream.StreamD.Type.fromList - -- * Conversions From/To - , fromStreamK - , toStreamK + -- * Elimination + -- ** Primitives + , uncons - -- * Running a 'Fold' - , fold + -- ** Strict Left Folds + , Streamly.Internal.Data.Stream.StreamD.Type.fold , foldBreak - , foldContinue + , foldAddLazy + , foldAdd , foldEither - -- * Right Folds - , foldrM - , foldrMx - , foldr - , foldrS - - -- * Left Folds - , foldl' + , Streamly.Internal.Data.Stream.StreamD.Type.foldl' , foldlM' , foldlx' , foldlMx' - -- * Special Folds + -- ** Lazy Right Folds + , foldrM + , foldrMx + , Streamly.Internal.Data.Stream.StreamD.Type.foldr + , foldrS + + -- ** Specific Folds , drain + , Streamly.Internal.Data.Stream.StreamD.Type.toList - -- * To Containers - , toList - - -- * Multi-stream folds - , eqBy - , cmpBy - - -- * Transformations + -- * Mapping , map , mapM + + -- * Stateful Filters , take , takeWhile , takeWhileM , takeEndBy , takeEndByM - -- * Nesting + -- * Combining Two Streams + -- ** Zipping + , zipWithM + , zipWith + + -- ** Cross Product , crossApply , crossApplyFst , crossApplySnd + , crossWith + , cross + -- * Unfold Many , ConcatMapUState (..) , unfoldMany + -- * Concat + , concatEffect , concatMap , concatMapM - , concatEffect + , concat - -- * Expanding trees top down + -- * Unfold Iterate , unfoldIterateDfs , unfoldIterateBfs , unfoldIterateBfsRev + -- * Concat Iterate , concatIterateScan , concatIterateDfs , concatIterateBfs , concatIterateBfsRev + -- * Fold Many , FoldMany (..) -- for inspection testing , FoldManyPost (..) , foldMany , foldManyPost , chunksOf - , refoldMany - -- * Folding trees bottom up + -- * Fold Iterate , reduceIterateBfs , foldIterateBfs + + -- * Multi-stream folds + , eqBy + , cmpBy ) where +#include "inline.hs" + import Control.Applicative (liftA2) +import Control.Monad.Catch (MonadThrow, throwM) +import Control.Monad.Trans.Class (MonadTrans(lift)) +import Control.Monad.IO.Class (MonadIO(..)) +import Data.Foldable (Foldable(foldl'), fold, foldr) import Data.Functor (($>)) import Data.Functor.Identity (Identity(..)) +import Data.Maybe (fromMaybe) +import Data.Semigroup (Endo(..)) import Fusion.Plugin.Types (Fuse(..)) import GHC.Base (build) +import GHC.Exts (IsList(..), IsString(..), oneShot) import GHC.Types (SPEC(..)) -import Prelude hiding (map, mapM, foldr, take, concatMap, takeWhile) +import Prelude hiding (map, mapM, take, concatMap, takeWhile, zipWith, concat) +import Text.Read + ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec + , readListPrecDefault) +import Streamly.Internal.BaseCompat ((#.)) import Streamly.Internal.Data.Fold.Type (Fold(..)) +import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe) import Streamly.Internal.Data.Refold.Type (Refold(..)) import Streamly.Internal.Data.Stream.StreamD.Step (Step (..)) import Streamly.Internal.Data.SVar.Type (State, adaptState, defState) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) -import qualified Streamly.Internal.Data.Fold.Type as FL +import qualified Streamly.Internal.Data.Fold.Type as FL hiding (foldr) import qualified Streamly.Internal.Data.Stream.StreamK.Type as K #ifdef USE_UNFOLDS_EVERYWHERE import qualified Streamly.Internal.Data.Unfold.Type as Unfold #endif +-- $setup +-- >>> import Streamly.Internal.Data.Stream (CrossStream(..)) +-- >>> import qualified Streamly.Data.Fold as Fold +-- >>> import qualified Streamly.Data.Parser as Parser +-- >>> import qualified Streamly.Data.Stream as Stream +-- >>> import qualified Streamly.Data.Unfold as Unfold +-- >>> import qualified Streamly.Internal.Data.Stream as Stream +-- >>> import qualified Streamly.Internal.FileSystem.Dir as Dir +-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold + ------------------------------------------------------------------------------ -- The direct style stream type ------------------------------------------------------------------------------ -- gst = global state + -- | A stream consists of a step function that generates the next step given a -- current state, and the current state. data Stream m a = @@ -160,11 +205,19 @@ pattern Stream step state <- (unShare -> UnStream step state) -- Primitives ------------------------------------------------------------------------------ --- | An empty 'Stream' with a side effect. +-- | A stream that terminates without producing any output, but produces a side +-- effect. +-- +-- >>> Stream.fold Fold.toList (Stream.nilM (print "nil")) +-- "nil" +-- [] +-- +-- /Pre-release/ {-# INLINE_NORMAL nilM #-} nilM :: Applicative m => m b -> Stream m a nilM m = Stream (\_ _ -> m $> Stop) () +-- | 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 consM m (Stream step state) = Stream step1 Nothing @@ -179,7 +232,35 @@ consM m (Stream step state) = Stream step1 Nothing Skip s -> Skip (Just s) Stop -> Stop) <$> step gst st --- | Does not fuse, has the same performance as the StreamK version. +-- | Decompose a stream into its head and tail. If the stream is empty, returns +-- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is +-- the head of the stream and @ma@ its tail. +-- +-- Properties: +-- +-- >>> Nothing <- Stream.uncons Stream.nil +-- >>> Just ("a", t) <- Stream.uncons (Stream.cons "a" Stream.nil) +-- +-- This can be used to consume the stream in an imperative manner one element +-- at a time, as it just breaks down the stream into individual elements and we +-- can loop over them as we deem fit. For example, this can be used to convert +-- a streamly stream into other stream types. +-- +-- All the folds in this module can be expressed in terms of 'uncons', however, +-- this is generally less efficient than specific folds because it takes apart +-- the stream one element at a time, therefore, does not take adavantage of +-- stream fusion. +-- +-- 'foldBreak' is a more general way of consuming a stream piecemeal. +-- +-- >>> :{ +-- uncons xs = do +-- r <- Stream.foldBreak Fold.one xs +-- return $ case r of +-- (Nothing, _) -> Nothing +-- (Just h, t) -> Just (h, t) +-- :} +-- {-# INLINE_NORMAL uncons #-} uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a)) uncons (UnStream step state) = go SPEC state @@ -197,7 +278,13 @@ uncons (UnStream step state) = go SPEC state data UnfoldState s = UnfoldNothing | UnfoldJust s --- | Convert an 'Unfold' into a 'Stream' by supplying it a seed. +-- | Convert an 'Unfold' into a stream by supplying it an input seed. +-- +-- >>> s = Stream.unfold Unfold.replicateM (3, putStrLn "hello") +-- >>> Stream.fold Fold.drain s +-- hello +-- hello +-- hello -- {-# INLINE_NORMAL unfold #-} unfold :: Applicative m => Unfold m a b -> a -> Stream m b @@ -217,7 +304,12 @@ unfold (Unfold ustep inject) seed = Stream step UnfoldNothing -- From Values ------------------------------------------------------------------------------ --- | Create a singleton 'Stream' from a pure value. +-- | Create a singleton stream from a pure value. +-- +-- >>> fromPure a = a `Stream.cons` Stream.nil +-- >>> fromPure = pure +-- >>> fromPure = fromEffect . pure +-- {-# INLINE_NORMAL fromPure #-} fromPure :: Applicative m => a -> Stream m a fromPure x = Stream (\_ s -> pure $ step undefined s) True @@ -226,7 +318,14 @@ fromPure x = Stream (\_ s -> pure $ step undefined s) True step _ True = Yield x False step _ False = Stop --- | Create a singleton 'Stream' from a monadic action. +-- | Create a singleton stream from a monadic action. +-- +-- >>> fromEffect m = m `consM` Stream.nil +-- >>> fromEffect = Stream.sequence . Stream.fromPure +-- +-- >>> Stream.fold Fold.drain $ Stream.fromEffect (putStrLn "hello") +-- hello +-- {-# INLINE_NORMAL fromEffect #-} fromEffect :: Applicative m => m a -> Stream m a fromEffect m = Stream step True @@ -242,7 +341,8 @@ fromEffect m = Stream step True ------------------------------------------------------------------------------ -- Adapted from the vector package. --- | Convert a list of pure values to a 'Stream' + +-- | Construct a stream from a list of pure values. {-# INLINE_LATE fromList #-} fromList :: Applicative m => [a] -> Stream m a #ifdef USE_UNFOLDS_EVERYWHERE @@ -295,12 +395,38 @@ toStreamK (Stream step state) = go state -- Running a 'Fold' ------------------------------------------------------------------------------ +-- >>> fold f = Fold.extractM . Stream.foldAddLazy f +-- >>> fold f = Stream.fold Fold.one . Stream.foldManyPost f +-- >>> fold f = Fold.extractM <=< Stream.foldAdd f + +-- | 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 +-- documentation of individual 'Fold's for termination behavior. +-- +-- Definitions: +-- +-- >>> fold f = fmap fst . Stream.foldBreak f +-- >>> fold f = Stream.parse (Parser.fromFold f) +-- +-- Example: +-- +-- >>> Stream.fold Fold.sum (Stream.enumerateFromTo 1 100) +-- 5050 +-- {-# INLINE_NORMAL fold #-} fold :: Monad m => Fold m a b -> Stream m a -> m b fold fld strm = do (b, _) <- foldBreak fld strm return b +-- | Fold resulting in either breaking the stream or continuation of the fold. +-- Instead of supplying the input stream in one go we can run the fold multiple +-- times, each time supplying the next segment of the input stream. If the fold +-- has not yet finished it returns a fold that can be run again otherwise it +-- returns the fold result and the residual stream. +-- +-- /Internal/ {-# INLINE_NORMAL foldEither #-} foldEither :: Monad m => Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a)) @@ -324,6 +450,9 @@ foldEither (Fold fstep begin done) (UnStream step state) = do Skip s -> go SPEC fs s Stop -> return $! Left (Fold fstep (return $ FL.Partial fs) done) +-- | Like 'fold' but also returns the remaining stream. The resulting stream +-- would be 'Stream.nil' if the stream finished before the fold. +-- {-# INLINE_NORMAL foldBreak #-} foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a) foldBreak fld strm = do @@ -342,9 +471,18 @@ foldBreak fld strm = do nil = Stream (\_ _ -> return Stop) () -{-# INLINE_NORMAL foldContinue #-} -foldContinue :: Monad m => Fold m a b -> Stream m a -> Fold m a b -foldContinue (Fold fstep finitial fextract) (Stream sstep state) = +-- | Append a stream to a fold lazily to build an accumulator incrementally. +-- +-- Example, to continue folding a list of streams on the same sum fold: +-- +-- >>> streams = [Stream.fromList [1..5], Stream.fromList [6..10]] +-- >>> f = Prelude.foldl Stream.foldAddLazy Fold.sum streams +-- >>> Stream.fold f Stream.nil +-- 55 +-- +{-# INLINE_NORMAL foldAddLazy #-} +foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b +foldAddLazy (Fold fstep finitial fextract) (Stream sstep state) = Fold fstep initial fextract where @@ -367,6 +505,15 @@ foldContinue (Fold fstep finitial fextract) (Stream sstep state) = Skip s -> go SPEC fs s Stop -> return $ FL.Partial fs +-- >>> foldAdd f = Stream.foldAddLazy f >=> Fold.reduce + +-- | +-- >>> foldAdd = flip Fold.addStream +-- +foldAdd :: Monad m => Fold m a b -> Stream m a -> m (Fold m a b) +foldAdd f = + Streamly.Internal.Data.Stream.StreamD.Type.fold (FL.duplicate f) + ------------------------------------------------------------------------------ -- Right Folds ------------------------------------------------------------------------------ @@ -391,6 +538,23 @@ foldContinue (Fold fstep finitial fextract) (Stream sstep state) = -- -- S.foldrM (\x t -> if x then return t else return False) (return True) -- (S.fromList [False,undefined] :: Stream IO Bool) + +-- | Right associative/lazy pull fold. @foldrM build final stream@ constructs +-- an output structure using the step function @build@. @build@ is invoked with +-- the next input element and the remaining (lazy) tail of the output +-- structure. It builds a lazy output expression using the two. When the "tail +-- structure" in the output expression is evaluated it calls @build@ again thus +-- lazily consuming the input @stream@ until either the output expression built +-- by @build@ is free of the "tail" or the input is exhausted in which case +-- @final@ is used as the terminating case for the output structure. For more +-- details see the description in the previous section. +-- +-- Example, determine if any element is 'odd' in a stream: +-- +-- >>> s = Stream.fromList (2:4:5:undefined) +-- >>> step x xs = if odd x then return True else xs +-- >>> Stream.foldrM step (return False) s +-- True -- {-# INLINE_NORMAL foldrM #-} foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b @@ -425,6 +589,18 @@ foldrMx fstep final convert (Stream step state) = convert $ go SPEC state -- monads. For example, if "any" is implemented using "foldr" instead of -- "foldrM" it performs the same with Identity monad but performs 1000x slower -- with IO monad. + +-- | Right fold, lazy for lazy monads and pure streams, and strict for strict +-- monads. +-- +-- Please avoid using this routine in strict monads like IO unless you need a +-- strict right fold. This is provided only for use in lazy monads (e.g. +-- Identity) or pure streams. Note that with this signature it is not possible +-- to implement a lazy foldr when the monad @m@ is strict. In that case it +-- would be strict in its accumulator and therefore would necessarily consume +-- all its input. +-- +-- >>> foldr f z = Stream.foldrM (\a b -> f a <$> b) (return z) -- {-# INLINE_NORMAL foldr #-} foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b @@ -520,7 +696,7 @@ drain (Stream step state) = go SPEC state {-# INLINE_NORMAL toList #-} toList :: Monad m => Stream m a -> m [a] -toList = foldr (:) [] +toList = Streamly.Internal.Data.Stream.StreamD.Type.foldr (:) [] -- Use foldr/build fusion to fuse with list consumers -- This can be useful when using the IsList instance @@ -533,7 +709,7 @@ toListFB c n (Stream step state) = go state Skip s -> go s Stop -> n -{-# RULES "toList Identity" toList = toListId #-} +{-# RULES "toList Identity" Streamly.Internal.Data.Stream.StreamD.Type.toList = toListId #-} {-# INLINE_EARLY toListId #-} toListId :: Stream Identity a -> Identity [a] toListId s = Identity $ build (\c n -> toListFB c n s) @@ -543,6 +719,8 @@ toListId s = Identity $ build (\c n -> toListFB c n s) ------------------------------------------------------------------------------ -- Adapted from the vector package. + +-- | Compare two streams for equality {-# INLINE_NORMAL eqBy #-} eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2 @@ -571,7 +749,8 @@ eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2 Stop -> return True -- Adapted from the vector package. --- | Compare two streams lexicographically + +-- | Compare two streams lexicographically. {-# INLINE_NORMAL cmpBy #-} cmpBy :: Monad m @@ -606,7 +785,17 @@ cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2 ------------------------------------------------------------------------------ -- Adapted from the vector package. --- | Map a monadic function over a 'Stream' + +-- | +-- >>> mapM f = Stream.sequence . fmap f +-- +-- Apply a monadic function to each element of the stream and replace it with +-- the output of the resulting action. +-- +-- >>> s = Stream.fromList ["a", "b", "c"] +-- >>> Stream.fold Fold.drain $ Stream.mapM putStr s +-- abc +-- {-# INLINE_NORMAL mapM #-} mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b mapM f (Stream step state) = Stream step' state @@ -633,11 +822,149 @@ instance Functor m => Functor (Stream m) where {-# INLINE (<$) #-} (<$) = fmap . const +------------------------------------------------------------------------------ +-- Lists +------------------------------------------------------------------------------ + +-- XXX Show instance is 10x slower compared to read, we can do much better. +-- The list show instance itself is really slow. + +-- XXX The default definitions of "<" in the Ord instance etc. do not perform +-- well, because they do not get inlined. Need to add INLINE in Ord class in +-- base? + +instance IsList (Stream Identity a) where + type (Item (Stream Identity a)) = a + + {-# INLINE fromList #-} + fromList = Streamly.Internal.Data.Stream.StreamD.Type.fromList + + {-# INLINE toList #-} + toList = runIdentity . Streamly.Internal.Data.Stream.StreamD.Type.toList + +instance Eq a => Eq (Stream Identity a) where + {-# INLINE (==) #-} + (==) xs ys = runIdentity $ eqBy (==) xs ys + +instance Ord a => Ord (Stream Identity a) where + {-# INLINE compare #-} + compare xs ys = runIdentity $ cmpBy compare xs ys + + {-# INLINE (<) #-} + x < y = + case compare x y of + LT -> True + _ -> False + + {-# INLINE (<=) #-} + x <= y = + case compare x y of + GT -> False + _ -> True + + {-# INLINE (>) #-} + x > y = + case compare x y of + GT -> True + _ -> False + + {-# INLINE (>=) #-} + x >= y = + case compare x y of + LT -> False + _ -> True + + {-# INLINE max #-} + max x y = if x <= y then y else x + + {-# INLINE min #-} + min x y = if x <= y then x else y + +instance Show a => Show (Stream Identity a) where + showsPrec p dl = showParen (p > 10) $ + showString "fromList " . shows (GHC.Exts.toList dl) + +instance Read a => Read (Stream Identity a) where + readPrec = parens $ prec 10 $ do + Ident "fromList" <- lexP + Streamly.Internal.Data.Stream.StreamD.Type.fromList <$> readPrec + + readListPrec = readListPrecDefault + +instance (a ~ Char) => IsString (Stream Identity a) where + {-# INLINE fromString #-} + fromString = Streamly.Internal.Data.Stream.StreamD.Type.fromList + +------------------------------------------------------------------------------- +-- Foldable +------------------------------------------------------------------------------- + +-- The default Foldable instance has several issues: +-- 1) several definitions do not have INLINE on them, so we provide +-- re-implementations with INLINE pragmas. +-- 2) the definitions of sum/product/maximum/minimum are inefficient as they +-- use right folds, they cannot run in constant memory. We provide +-- implementations using strict left folds here. + +-- There is no Traversable instance because, there is no scalable cons for +-- StreamD, use toList and fromList instead. + +instance (Foldable m, Monad m) => Foldable (Stream m) where + + {-# INLINE foldMap #-} + foldMap f = + Data.Foldable.fold + . Streamly.Internal.Data.Stream.StreamD.Type.foldr (mappend . f) mempty + + {-# INLINE foldr #-} + foldr f z t = appEndo (foldMap (Endo #. f) t) z + + {-# INLINE foldl' #-} + foldl' f z0 xs = Data.Foldable.foldr f' id xs z0 + where f' x k = oneShot $ \z -> k $! f z x + + {-# INLINE length #-} + length = Data.Foldable.foldl' (\n _ -> n + 1) 0 + + {-# INLINE elem #-} + elem = any . (==) + + {-# INLINE maximum #-} + maximum = + fromMaybe (errorWithoutStackTrace "maximum: empty stream") + . toMaybe + . Data.Foldable.foldl' getMax Nothing' + + where + + getMax Nothing' x = Just' x + getMax (Just' mx) x = Just' $! max mx x + + {-# INLINE minimum #-} + minimum = + fromMaybe (errorWithoutStackTrace "minimum: empty stream") + . toMaybe + . Data.Foldable.foldl' getMin Nothing' + + where + + getMin Nothing' x = Just' x + getMin (Just' mn) x = Just' $! min mn x + + {-# INLINE sum #-} + sum = Data.Foldable.foldl' (+) 0 + + {-# INLINE product #-} + product = Data.Foldable.foldl' (*) 1 + ------------------------------------------------------------------------------- -- Filtering ------------------------------------------------------------------------------- -- Adapted from the vector package. + +-- | Take first 'n' elements from the stream and discard the rest. +-- {-# INLINE_NORMAL take #-} take :: Applicative m => Int -> Stream m a -> Stream m a take n (Stream step state) = n `seq` Stream step' (state, 0) @@ -653,8 +980,12 @@ take n (Stream step state) = n `seq` Stream step' (state, 0) step' _ (_, _) = pure Stop -- Adapted from the vector package. + +-- | Same as 'takeWhile' but with a monadic predicate. +-- {-# INLINE_NORMAL takeWhileM #-} takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a +-- takeWhileM p = scanMaybe (FL.takingEndByM_ (\x -> not <$> p x)) takeWhileM f (Stream step state) = Stream step' state where {-# INLINE_LATE step' #-} @@ -667,6 +998,8 @@ takeWhileM f (Stream step state) = Stream step' state Skip s -> return $ Skip s Stop -> return Stop +-- | End the stream as soon as the predicate fails on an element. +-- {-# INLINE takeWhile #-} takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a takeWhile f = takeWhileM (return . f) @@ -697,10 +1030,64 @@ takeEndByM f (Stream step state) = Stream step' (Just state) takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a takeEndBy f = takeEndByM (return . f) +------------------------------------------------------------------------------ +-- Zipping +------------------------------------------------------------------------------ + +-- | Like 'zipWith' but using a monadic zipping function. +-- +{-# INLINE_NORMAL zipWithM #-} +zipWithM :: Monad m + => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c +zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing) + where + {-# INLINE_LATE step #-} + step gst (sa, sb, Nothing) = do + r <- stepa (adaptState gst) sa + return $ + case r of + Yield x sa' -> Skip (sa', sb, Just x) + Skip sa' -> Skip (sa', sb, Nothing) + Stop -> Stop + + step gst (sa, sb, Just x) = do + r <- stepb (adaptState gst) sb + case r of + Yield y sb' -> do + z <- f x y + return $ Yield z (sa, sb', Nothing) + Skip sb' -> return $ Skip (sa, sb', Just x) + Stop -> return Stop + +{-# RULES "zipWithM xs xs" + forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-} + +-- | Stream @a@ is evaluated first, followed by stream @b@, the resulting +-- elements @a@ and @b@ are then zipped using the supplied zip function and the +-- result @c@ is yielded to the consumer. +-- +-- If stream @a@ or stream @b@ ends, the zipped stream ends. If stream @b@ ends +-- first, the element @a@ from previous evaluation of stream @a@ is discarded. +-- +-- >>> s1 = Stream.fromList [1,2,3] +-- >>> s2 = Stream.fromList [4,5,6] +-- >>> Stream.fold Fold.toList $ Stream.zipWith (+) s1 s2 +-- [5,7,9] +-- +{-# INLINE zipWith #-} +zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c +zipWith f = zipWithM (\a b -> return (f a b)) + ------------------------------------------------------------------------------ -- Combine N Streams - concatAp ------------------------------------------------------------------------------ +-- | Apply a stream of functions to a stream of values and flatten the results. +-- +-- Note that the second stream is evaluated multiple times. +-- +-- >>> crossApply = Stream.crossWith id +-- {-# INLINE_NORMAL crossApply #-} crossApply :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b crossApply (Stream stepa statea) (Stream stepb stateb) = @@ -786,6 +1173,39 @@ instance Applicative f => Applicative (Stream f) where (<*) = crossApplyFst -} +-- | +-- Definition: +-- +-- >>> crossWith f m1 m2 = fmap f m1 `Stream.crossApply` m2 +-- +-- Note that the second stream is evaluated multiple times. +-- +{-# INLINE crossWith #-} +crossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c +crossWith f m1 m2 = fmap f m1 `crossApply` m2 + +-- | Given a @Stream m a@ and @Stream m b@ generate a stream with all possible +-- combinations of the tuple @(a, b)@. +-- +-- Definition: +-- +-- >>> cross = Stream.crossWith (,) +-- +-- The second stream is evaluated multiple times. If that is not desired it can +-- be cached in an 'Data.Array.Array' and then generated from the array before +-- calling this function. Caching may also improve performance if the stream is +-- expensive to evaluate. +-- +-- See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused +-- alternative. +-- +-- Time: O(m x n) +-- +-- /Pre-release/ +{-# INLINE cross #-} +cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b) +cross = crossWith (,) + ------------------------------------------------------------------------------ -- Combine N Streams - unfoldMany ------------------------------------------------------------------------------ @@ -804,6 +1224,10 @@ data ConcatMapUState o i = -- optimization via fusion. This can be many times more efficient than -- 'concatMap'. +-- | Like 'concatMap' but uses an 'Unfold' for stream generation. Unlike +-- 'concatMap' this can fuse the 'Unfold' code with the inner loop and +-- therefore provide many times better performance. +-- {-# INLINE_NORMAL unfoldMany #-} unfoldMany :: Monad m => Unfold m a b -> Stream m a -> Stream m b unfoldMany (Unfold istep inject) (Stream ostep ost) = @@ -831,6 +1255,14 @@ unfoldMany (Unfold istep inject) (Stream ostep ost) = ------------------------------------------------------------------------------ -- Adapted from the vector package. + +-- | Map a stream producing monadic function on each element of the stream +-- and then flatten the results into a single stream. Since the stream +-- generation function is monadic, unlike 'concatMap', it can produce an +-- effect at the beginning of each iteration of the inner loop. +-- +-- See 'unfoldMany' for a fusible alternative. +-- {-# INLINE_NORMAL concatMapM #-} concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b concatMapM f (Stream step state) = Stream step' (Left state) @@ -861,10 +1293,28 @@ concatMapM f (Stream step state) = Stream step' (Left state) return $ Skip (Right (Stream inner_step inner_s, st)) Stop -> return $ Skip (Left st) +-- | Map a stream producing function on each element of the stream and then +-- flatten the results into a single stream. +-- +-- >>> concatMap f = Stream.concatMapM (return . f) +-- >>> concatMap f = Stream.concat . fmap f +-- >>> concatMap f = Stream.unfoldMany (Unfold.lmap f Unfold.fromStream) +-- +-- See 'unfoldMany' for a fusible alternative. +-- {-# INLINE concatMap #-} concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b concatMap f = concatMapM (return . f) +-- | Flatten a stream of streams to a single stream. +-- +-- >>> concat = Stream.concatMap id +-- +-- /Pre-release/ +{-# INLINE concat #-} +concat :: Monad m => Stream m (Stream m a) -> Stream m a +concat = concatMap id + -- XXX The idea behind this rule is to rewrite any calls to "concatMap -- fromArray" automatically to flattenArrays which is much faster. However, we -- need an INLINE_EARLY on concatMap for this rule to fire. But if we use @@ -876,10 +1326,16 @@ concatMap f = concatMapM (return . f) -- {-# RULES "concatMap Array.toStreamD" -- concatMap Array.toStreamD = Array.flattenArray #-} --- | --- Definition: +-- >>> concatEffect = Stream.concat . lift -- requires (MonadTrans t) +-- >>> concatEffect = join . lift -- requires (MonadTrans t, Monad (Stream m)) + +-- | Given a stream value in the underlying monad, lift and join the underlying +-- monad with the stream monad. -- --- > concatEffect generator = concatMapM (\() -> generator) (fromPure ()) +-- >>> concatEffect = Stream.concat . Stream.fromEffect +-- >>> concatEffect eff = Stream.concatMapM (\() -> eff) (fromPure ()) +-- +-- See also: 'concat', 'sequence' -- {-# INLINE concatEffect #-} concatEffect :: Monad m => m (Stream m a) -> Stream m a @@ -903,6 +1359,13 @@ instance Monad m => Monad (Stream m) where -- Traversing a tree top down ------------------------------------------------------------------------------ +-- Next stream is to be generated by the return value of the previous stream. A +-- general intuitive way of doing that could be to use an appending monad +-- instance for streams where the result of the previous stream is used to +-- generate the next one. In the first pass we can just emit the values in the +-- stream and keep building a buffered list/stream, once done we can then +-- process the buffered stream. + -- | Generate a stream from an initial state, scan and concat the stream, -- generate a stream again from the final state of the previous scan and repeat -- the process. @@ -938,9 +1401,11 @@ concatIterateScan scanner generate initial = Stream step (Left initial) -- have to store any state. This makes the stored state proportional to the -- number of non-leaf nodes rather than total number of nodes. --- | This function may be slightly faster than concatIterateBfs because it --- traverses the elements on a level in reverse order, therefore, does not have --- to reverse the list stroing those. +-- | Same as 'concatIterateBfs' except that the traversal of the last +-- element on a level is emitted first and then going backwards up to the first +-- element (reversed ordering). This may be slightly faster than +-- 'concatIterateBfs'. +-- {-# INLINE_NORMAL concatIterateBfsRev #-} concatIterateBfsRev :: Monad m => (a -> Maybe (Stream m a)) @@ -966,6 +1431,17 @@ concatIterateBfsRev f stream = Stream step (stream, []) (y:ys) -> return $ Skip (y, ys) [] -> return Stop +-- | Similar to 'concatIterateDfs' except that it traverses the stream in +-- breadth first style (BFS). First, all the elements in the input stream are +-- emitted, and then their traversals are emitted. +-- +-- Example, list a directory tree using BFS: +-- +-- >>> f = either (Just . Dir.readEitherPaths) (const Nothing) +-- >>> input = Stream.fromPure (Left ".") +-- >>> ls = Stream.concatIterateBfs f input +-- +-- /Pre-release/ {-# INLINE_NORMAL concatIterateBfs #-} concatIterateBfs :: Monad m => (a -> Maybe (Stream m a)) @@ -994,6 +1470,19 @@ concatIterateBfs f stream = Stream step (stream, [], []) (x:xs1) -> return $ Skip (x, xs1, []) [] -> return Stop +-- | Traverse the stream in depth first style (DFS). Map each element in the +-- input stream to a stream and flatten, recursively map the resulting elements +-- as well to a stream and flatten until no more streams are generated. +-- +-- Example, list a directory tree using DFS: +-- +-- >>> f = either (Just . Dir.readEitherPaths) (const Nothing) +-- >>> input = Stream.fromPure (Left ".") +-- >>> ls = Stream.concatIterateDfs f input +-- +-- This is equivalent to using @concatIterateWith StreamK.append@. +-- +-- /Pre-release/ {-# INLINE_NORMAL concatIterateDfs #-} concatIterateDfs :: Monad m => (a -> Maybe (Stream m a)) @@ -1024,6 +1513,15 @@ data IterateUnfoldState o i = IterateUnfoldOuter o | IterateUnfoldInner o i [i] +-- | Same as @concatIterateDfs@ but more efficient due to stream fusion. +-- +-- Example, list a directory tree using DFS: +-- +-- >>> f = Unfold.either Dir.eitherReaderPaths Unfold.nil +-- >>> input = Stream.fromPure (Left ".") +-- >>> ls = Stream.unfoldIterateDfs f input +-- +-- /Pre-release/ {-# INLINE_NORMAL unfoldIterateDfs #-} unfoldIterateDfs :: Monad m => Unfold m a a @@ -1061,6 +1559,10 @@ data IterateUnfoldBFSRevState o i = IterateUnfoldBFSRevOuter o [i] | IterateUnfoldBFSRevInner i [i] +-- | Like 'unfoldIterateBfs' but processes the children in reverse order, +-- therefore, may be slightly faster. +-- +-- /Pre-release/ {-# INLINE_NORMAL unfoldIterateBfsRev #-} unfoldIterateBfsRev :: Monad m => Unfold m a a @@ -1101,6 +1603,9 @@ data IterateUnfoldBFSState o i = IterateUnfoldBFSOuter o [i] | IterateUnfoldBFSInner i [i] [i] +-- | Like 'unfoldIterateDfs' but uses breadth first style traversal. +-- +-- /Pre-release/ {-# INLINE_NORMAL unfoldIterateBfs #-} unfoldIterateBfs :: Monad m => Unfold m a a @@ -1143,9 +1648,10 @@ unfoldIterateBfs (Unfold istep inject) (Stream ostep ost) = -- Folding a tree bottom up ------------------------------------------------------------------------------ --- | Binary BFS style reduce, folds a level entirely, before starting to fold --- the next level. The last elements of a previously folded level are folded --- first. +-- | Binary BFS style reduce, folds a level entirely using the supplied fold +-- function, collecting the outputs as next level of the tree, then repeats the +-- same process on the next level. The last elements of a previously folded +-- level are folded first. {-# INLINE_NORMAL reduceIterateBfs #-} reduceIterateBfs :: Monad m => (a -> a -> m a) -> Stream m a -> m (Maybe a) @@ -1206,7 +1712,35 @@ data FoldManyPost s fs b a | FoldManyPostYield b (FoldManyPost s fs b a) | FoldManyPostDone --- | 'Streamly.Internal.Data.Stream.foldManyPost'. +-- XXX Need a more intuitive name, and need to reconcile the names +-- foldMany/fold/parse/parseMany/parseManyPost etc. + +-- | Like 'foldMany' but evaluates the fold before the stream, and yields its +-- output even if the stream is empty, therefore, always results in a non-empty +-- output even on an empty stream (default result of the fold). +-- +-- Example, empty stream: +-- +-- >>> f = Fold.take 2 Fold.sum +-- >>> fmany = Stream.fold Fold.toList . Stream.foldManyPost f +-- >>> fmany $ Stream.fromList [] +-- [0] +-- +-- Example, last fold empty: +-- +-- >>> fmany $ Stream.fromList [1..4] +-- [3,7,0] +-- +-- Example, last fold non-empty: +-- +-- >>> fmany $ Stream.fromList [1..5] +-- [3,7,5] +-- +-- Note that using a closed fold e.g. @Fold.take 0@, would result in an +-- infinite stream without consuming the input. +-- +-- /Pre-release/ +-- {-# INLINE_NORMAL foldManyPost #-} foldManyPost :: Monad m => Fold m a b -> Stream m a -> Stream m b foldManyPost (Fold fstep initial extract) (Stream step state) = @@ -1252,7 +1786,34 @@ data FoldMany s fs b a -- XXX Nested foldMany does not fuse. --- | 'Streamly.Internal.Data.Stream.foldMany'. +-- | Apply a 'Fold' repeatedly on a stream and emit the results in the +-- output stream. Unlike 'foldManyPost' it evaluates the fold after the stream, +-- therefore, an empty input stream results in an empty output stream. +-- +-- Definition: +-- +-- >>> foldMany f = Stream.parseMany (Parser.fromFold f) +-- +-- Example, empty stream: +-- +-- >>> f = Fold.take 2 Fold.sum +-- >>> fmany = Stream.fold Fold.toList . Stream.foldMany f +-- >>> fmany $ Stream.fromList [] +-- [] +-- +-- Example, last fold empty: +-- +-- >>> fmany $ Stream.fromList [1..4] +-- [3,7] +-- +-- Example, last fold non-empty: +-- +-- >>> fmany $ Stream.fromList [1..5] +-- [3,7,5] +-- +-- Note that using a closed fold e.g. @Fold.take 0@, would result in an +-- infinite stream on a non-empty input stream. +-- {-# INLINE_NORMAL foldMany #-} foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b foldMany (Fold fstep initial extract) (Stream step state) = @@ -1340,3 +1901,122 @@ refoldMany (Refold fstep inject extract) action (Stream step state) = return $ Skip (FoldManyYield b FoldManyDone) step' _ (FoldManyYield b next) = return $ Yield b next step' _ FoldManyDone = return Stop + +------------------------------------------------------------------------------ +-- Stream with a cross product style monad instance +------------------------------------------------------------------------------ + +-- XXX CrossStream performs better than the CrossStreamK when nesting two +-- loops, however, CrossStreamK seems to be better for more than two nestings, +-- need to do more perf investigation. + +-- | A newtype wrapper for the 'Stream' type with a cross product style monad +-- instance. +-- +-- A 'Monad' bind behaves like a @for@ loop: +-- +-- >>> :{ +-- Stream.fold Fold.toList $ Stream.unCross $ do +-- x <- Stream.mkCross $ Stream.fromList [1,2] +-- -- Perform the following actions for each x in the stream +-- return x +-- :} +-- [1,2] +-- +-- Nested monad binds behave like nested @for@ loops: +-- +-- >>> :{ +-- Stream.fold Fold.toList $ Stream.unCross $ do +-- x <- Stream.mkCross $ Stream.fromList [1,2] +-- y <- Stream.mkCross $ Stream.fromList [3,4] +-- -- Perform the following actions for each x, for each y +-- return (x, y) +-- :} +-- [(1,3),(1,4),(2,3),(2,4)] +-- +newtype CrossStream m a = CrossStream {unCrossStream :: Stream m a} + deriving (Functor, Foldable) + +{-# INLINE mkCross #-} +mkCross :: Stream m a -> CrossStream m a +mkCross = CrossStream + +{-# INLINE unCross #-} +unCross :: CrossStream m a -> Stream m a +unCross = unCrossStream + +-- Pure (Identity monad) stream instances +deriving instance IsList (CrossStream Identity a) +deriving instance (a ~ Char) => IsString (CrossStream Identity a) +deriving instance Eq a => Eq (CrossStream Identity a) +deriving instance Ord a => Ord (CrossStream Identity a) + +-- Do not use automatic derivation for this to show as "fromList" rather than +-- "fromList Identity". +instance Show a => Show (CrossStream Identity a) where + {-# INLINE show #-} + show (CrossStream xs) = show xs + +instance Read a => Read (CrossStream Identity a) where + {-# INLINE readPrec #-} + readPrec = fmap CrossStream readPrec + +------------------------------------------------------------------------------ +-- Applicative +------------------------------------------------------------------------------ + +-- Note: we need to define all the typeclass operations because we want to +-- INLINE them. +instance Monad m => Applicative (CrossStream m) where + {-# INLINE pure #-} + pure x = CrossStream (fromPure x) + + {-# INLINE (<*>) #-} + (CrossStream s1) <*> (CrossStream s2) = + CrossStream (crossApply s1 s2) + + {-# INLINE liftA2 #-} + liftA2 f x = (<*>) (fmap f x) + + {-# INLINE (*>) #-} + (CrossStream s1) *> (CrossStream s2) = + CrossStream (crossApplySnd s1 s2) + + {-# INLINE (<*) #-} + (CrossStream s1) <* (CrossStream s2) = + CrossStream (crossApplyFst s1 s2) + +------------------------------------------------------------------------------ +-- Monad +------------------------------------------------------------------------------ + +instance Monad m => Monad (CrossStream m) where + return = pure + + -- Benchmarks better with StreamD bind and pure: + -- toList, filterAllout, *>, *<, >> (~2x) + -- + + -- Benchmarks better with CPS bind and pure: + -- Prime sieve (25x) + -- n binds, breakAfterSome, filterAllIn, state transformer (~2x) + -- + {-# INLINE (>>=) #-} + (>>=) (CrossStream m) f = CrossStream (concatMap (unCrossStream . f) m) + + {-# INLINE (>>) #-} + (>>) = (*>) + +------------------------------------------------------------------------------ +-- Transformers +------------------------------------------------------------------------------ + +instance (MonadIO m) => MonadIO (CrossStream m) where + liftIO x = CrossStream (fromEffect $ liftIO x) + +instance MonadTrans CrossStream where + {-# INLINE lift #-} + lift x = CrossStream (fromEffect x) + +instance (MonadThrow m) => MonadThrow (CrossStream m) where + throwM = lift . throwM diff --git a/core/src/Streamly/Internal/Data/Stream/StreamDK.hs b/core/src/Streamly/Internal/Data/Stream/StreamDK.hs index 4e91c2a08..a7fbf4b82 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamDK.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamDK.hs @@ -1,156 +1,52 @@ -#include "inline.hs" - -- | -- Module : Streamly.Internal.Data.Stream.StreamDK -- Copyright : (c) 2019 Composewell Technologies --- License : BSD3 +-- License : BSD-3-Clause -- Maintainer : streamly@composewell.com -- Stability : experimental -- Portability : GHC -- - +-- +-- This module has the following problems due to rewrite rules: +-- +-- * Rewrite rules lead to optimization problems, blocking fusion in some +-- cases, specifically when combining multiple operations e.g. (filter . drop). +-- * Rewrite rules lead to problems when calling a function recursively. For +-- example, the StreamD version of foldBreak cannot be used recursively when +-- wrapped in rewrite rules because each recursive call adds a roundtrip +-- conversion from D to K and back to D. We can use the StreamK versions of +-- these though because the rewrite rule gets eliminated in that case. +-- * If we have a unified module, we need two different versions of several +-- operations e.g. appendK and appendD, both are useful in different cases. +-- module Streamly.Internal.Data.Stream.StreamDK - ( - -- * Stream Type + ( module Streamly.Internal.Data.Stream.Type + , module Streamly.Internal.Data.Stream.Bottom + , module Streamly.Internal.Data.Stream.Eliminate + , module Streamly.Internal.Data.Stream.Exception + , module Streamly.Internal.Data.Stream.Expand + , module Streamly.Internal.Data.Stream.Generate + , module Streamly.Internal.Data.Stream.Lift + , module Streamly.Internal.Data.Stream.Reduce + , module Streamly.Internal.Data.Stream.Transform + , module Streamly.Internal.Data.Stream.Cross + , module Streamly.Internal.Data.Stream.Zip - Stream - , Step (..) - - -- * Construction - , nil - , cons - , consM - , unfoldr - , unfoldrM - , replicateM - - -- * Folding - , uncons - , foldrS - - -- * Specific Folds - , drain + -- modules having dependencies on libraries other than base + , module Streamly.Internal.Data.Stream.Transformer ) where -import Streamly.Internal.Data.Stream.StreamDK.Type (Stream(..), Step(..)) +import Streamly.Internal.Data.Stream.Bottom +import Streamly.Internal.Data.Stream.Cross +import Streamly.Internal.Data.Stream.Eliminate +import Streamly.Internal.Data.Stream.Exception +import Streamly.Internal.Data.Stream.Expand +import Streamly.Internal.Data.Stream.Generate +import Streamly.Internal.Data.Stream.Lift +import Streamly.Internal.Data.Stream.Reduce +import Streamly.Internal.Data.Stream.Transform +import Streamly.Internal.Data.Stream.Type +import Streamly.Internal.Data.Stream.Zip -------------------------------------------------------------------------------- --- Construction -------------------------------------------------------------------------------- - -nil :: Monad m => Stream m a -nil = Stream $ return Stop - -{-# INLINE_NORMAL cons #-} -cons :: Monad m => a -> Stream m a -> Stream m a -cons x xs = Stream $ return $ Yield x xs - -consM :: Monad m => m a -> Stream m a -> Stream m a -consM eff xs = Stream $ eff >>= \x -> return $ Yield x xs - -unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a -unfoldrM next state = Stream (step' state) - where - step' st = do - r <- next st - return $ case r of - Just (x, s) -> Yield x (Stream (step' s)) - Nothing -> Stop -{- -unfoldrM next s0 = buildM $ \yld stp -> - let go s = do - r <- next s - case r of - Just (a, b) -> yld a (go b) - Nothing -> stp - in go s0 --} - -{-# INLINE unfoldr #-} -unfoldr :: Monad m => (b -> Maybe (a, b)) -> b -> Stream m a -unfoldr next s0 = build $ \yld stp -> - let go s = - case next s of - Just (a, b) -> yld a (go b) - Nothing -> stp - in go s0 - -replicateM :: Monad m => Int -> a -> Stream m a -replicateM n x = Stream (step n) - where - step i = return $ - if i <= 0 - then Stop - else Yield x (Stream (step (i - 1))) - -------------------------------------------------------------------------------- --- Folding -------------------------------------------------------------------------------- - -uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a)) -uncons (Stream step) = do - r <- step - return $ case r of - Yield x xs -> Just (x, xs) - Stop -> Nothing - --- | Lazy right associative fold to a stream. -{-# INLINE_NORMAL foldrS #-} -foldrS :: Monad m - => (a -> Stream m b -> Stream m b) - -> Stream m b - -> Stream m a - -> Stream m b -foldrS f streamb = go - where - go (Stream stepa) = Stream $ do - r <- stepa - case r of - Yield x xs -> let Stream step = f x (go xs) in step - Stop -> let Stream step = streamb in step - -{-# INLINE_LATE foldrM #-} -foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b -foldrM fstep acc = go - where - go (Stream step) = do - r <- step - case r of - Yield x xs -> fstep x (go xs) - Stop -> acc - -{-# INLINE_NORMAL build #-} -build :: Monad m - => forall a. (forall b. (a -> b -> b) -> b -> b) -> Stream m a -build g = g cons nil - -{-# RULES -"foldrM/build" forall k z (g :: forall b. (a -> b -> b) -> b -> b). - foldrM k z (build g) = g k z #-} - -{- --- To fuse foldrM with unfoldrM we need the type m1 to be polymorphic such that --- it is either Monad m or Stream m. So that we can use cons/nil as well as --- monadic construction function as its arguments. --- -{-# INLINE_NORMAL buildM #-} -buildM :: Monad m - => forall a. (forall b. (a -> m1 b -> m1 b) -> m1 b -> m1 b) -> Stream m a -buildM g = g cons nil --} - -------------------------------------------------------------------------------- --- Specific folds -------------------------------------------------------------------------------- - -{-# INLINE drain #-} -drain :: Monad m => Stream m a -> m () -drain = foldrM (\_ xs -> xs) (return ()) -{- -drain (Stream step) = do - r <- step - case r of - Yield _ next -> drain next - Stop -> return () - -} +import Streamly.Internal.Data.Stream.Transformer diff --git a/core/src/Streamly/Internal/Data/Stream/StreamK.hs b/core/src/Streamly/Internal/Data/Stream/StreamK.hs index 2a6dadf32..f721b8df0 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamK.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamK.hs @@ -7,18 +7,56 @@ -- Stability : experimental -- Portability : GHC -- +-- To run examples in this module: -- --- Continuation passing style (CPS) stream implementation. The symbol 'K' below --- denotes a function as well as a Kontinuation. +-- >>> import qualified Streamly.Data.Fold as Fold +-- >>> import qualified Streamly.Data.Stream as Stream +-- >>> import qualified Streamly.Data.Stream.StreamK as StreamK -- --- @ --- import qualified Streamly.Internal.Data.Stream.StreamK as K --- @ +-- We will add some more imports in the examples as needed. +-- +-- For effectful streams we will use the following IO action: +-- +-- >>> effect n = print n >> return n +-- +-- = Overview +-- +-- Continuation passing style (CPS) stream implementation. The 'K' in 'StreamK' +-- stands for Kontinuation. +-- +-- StreamK can be constructed like lists, except that they use 'nil' instead of +-- '[]' and 'cons' instead of ':'. +-- +-- `cons` adds a pure value at the head of the stream: +-- +-- >>> import Streamly.Data.Stream.StreamK (StreamK, cons, consM, nil) +-- >>> stream = 1 `cons` 2 `cons` nil :: StreamK IO Int +-- +-- Convert 'StreamK' to 'Stream' to use functions from the +-- "Streamly.Data.Stream" module: +-- +-- >>> Stream.fold Fold.toList $ StreamK.toStream stream -- IO [Int] +-- [1,2] +-- +-- `consM` adds an effect at the head of the stream: +-- +-- >>> stream = effect 1 `consM` effect 2 `consM` nil +-- >>> Stream.fold Fold.toList $ StreamK.toStream stream +-- 1 +-- 2 +-- [1,2] -- module Streamly.Internal.Data.Stream.StreamK ( -- * The stream type - Stream(..) + Stream(..) -- XXX stop exporting this + , StreamK + , fromStream + , toStream + + , CrossStreamK + , unCross + , mkCross -- * Construction Primitives , mkStream @@ -78,7 +116,9 @@ module Streamly.Internal.Data.Stream.StreamK , fold , foldBreak , foldEither + , foldConcat , parseBreak + , parse -- ** Specialized Folds , drain @@ -135,6 +175,7 @@ module Streamly.Internal.Data.Stream.StreamK -- ** Reordering , reverse + , sortBy -- ** Map and Filter , mapMaybe @@ -152,18 +193,25 @@ module Streamly.Internal.Data.Stream.StreamK , crossApply , crossApplySnd , crossApplyFst + , crossWith , concatMapWith , concatMap , concatEffect , bindWith - , concatPairsWith + , concatIterateWith + , concatIterateLeftsWith + , concatIterateScanWith + + , mergeMapWith + , mergeIterateWith -- ** Transformation comprehensions , the -- * Semigroup Style Composition - , serial + , append + , interleave -- * Utilities , consM @@ -175,11 +223,15 @@ where #include "assert.hs" import Control.Monad (void, join) +import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Fold.Type (Fold(..)) +import Streamly.Internal.Data.Producer.Type (Producer(..)) import Streamly.Internal.Data.SVar.Type (adaptState, defState) import qualified Streamly.Internal.Data.Fold.Type as FL +import qualified Streamly.Internal.Data.Parser as Parser import qualified Streamly.Internal.Data.Parser.ParserD.Type as PR +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import qualified Prelude import Prelude @@ -193,14 +245,25 @@ import Streamly.Internal.Data.Parser.ParserD (ParseError(..)) -- $setup -- >>> :m +-- >>> import qualified Streamly.Data.Fold as Fold +-- >>> import qualified Streamly.Data.Parser as Parser +-- >>> import qualified Streamly.Data.Stream as Stream +-- >>> import qualified Streamly.Data.Stream.StreamK as StreamK +-- >>> import qualified Streamly.Internal.Data.Stream.StreamK as StreamK +-- + +{-# INLINE fromStream #-} +fromStream :: Monad m => Stream.Stream m a -> StreamK m a +fromStream = Stream.toStreamK + +{-# INLINE toStream #-} +toStream :: Applicative m => StreamK m a -> Stream.Stream m a +toStream = Stream.fromStreamK ------------------------------------------------------------------------------- -- Generation ------------------------------------------------------------------------------- -{-# INLINE unfoldrM #-} -unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> Stream m a -unfoldrM = unfoldrMWith consM {- -- Generalization of concurrent streams/SVar via unfoldr. -- @@ -265,11 +328,6 @@ fromList = fromFoldable -- Elimination by Folding ------------------------------------------------------------------------------- --- | Lazy right associative fold. -{-# INLINE foldr #-} -foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b -foldr step acc = foldrM (\x xs -> xs >>= \b -> return (step x b)) (return acc) - {-# INLINE foldr1 #-} foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a) foldr1 step m = do @@ -297,6 +355,21 @@ foldlMx' step begin done = go begin 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 +-- documentation of individual 'Fold's for termination behavior. +-- +-- Definitions: +-- +-- >>> fold f = fmap fst . StreamK.foldBreak f +-- >>> fold f = StreamK.parse (Parser.fromFold f) +-- +-- Example: +-- +-- >>> StreamK.fold Fold.sum $ StreamK.fromStream $ Stream.enumerateFromTo 1 100 +-- 5050 +-- {-# INLINABLE fold #-} fold :: Monad m => FL.Fold m a b -> Stream m a -> m b fold (FL.Fold step begin done) m = do @@ -318,6 +391,13 @@ fold (FL.Fold step begin done) m = do FL.Done b1 -> return b1 in foldStream defState yieldk single stop m1 +-- | Fold resulting in either breaking the stream or continuation of the fold. +-- Instead of supplying the input stream in one go we can run the fold multiple +-- times, each time supplying the next segment of the input stream. If the fold +-- has not yet finished it returns a fold that can be run again otherwise it +-- returns the fold result and the residual stream. +-- +-- /Internal/ {-# INLINE foldEither #-} foldEither :: Monad m => Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a)) @@ -344,6 +424,9 @@ foldEither (FL.Fold step begin done) m = do FL.Done b1 -> return $ Right (b1, r) in foldStream defState yieldk single stop m1 +-- | Like 'fold' but also returns the remaining stream. The resulting stream +-- would be 'StreamK.nil' if the stream finished before the fold. +-- {-# INLINE foldBreak #-} foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a) foldBreak fld strm = do @@ -358,6 +441,68 @@ foldBreak fld strm = do b <- extract s return (b, nil) +-- XXX Array folds can be implemented using this. +-- foldContainers? Specialized to foldArrays. + +-- | Generate streams from individual elements of a stream and fold the +-- concatenation of those streams using the supplied fold. Return the result of +-- the fold and residual stream. +-- +-- For example, this can be used to efficiently fold an Array Word8 stream +-- using Word8 folds. +-- +-- /Internal/ +{-# INLINE foldConcat #-} +foldConcat :: Monad m => + Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a) +foldConcat + (Producer pstep pinject pextract) + (Fold fstep begin done) + stream = do + + res <- begin + case res of + FL.Partial fs -> go fs stream + FL.Done fb -> return (fb, stream) + + where + + go !acc m1 = do + let stop = do + r <- done acc + return (r, nil) + single a = do + st <- pinject a + res <- go1 SPEC acc st + case res of + Left fs -> do + r <- done fs + return (r, nil) + Right (b, s) -> do + x <- pextract s + return (b, fromPure x) + yieldk a r = do + st <- pinject a + res <- go1 SPEC acc st + case res of + Left fs -> go fs r + Right (b, s) -> do + x <- pextract s + return (b, x `cons` r) + in foldStream defState yieldk single stop m1 + + {-# INLINE go1 #-} + go1 !_ !fs st = do + r <- pstep st + case r of + Stream.Yield x s -> do + res <- fstep fs x + case res of + FL.Done b -> return $ Right (b, s) + 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 -> Stream m a -> m b @@ -993,13 +1138,13 @@ splitAt n ls (xs', xs'') = splitAt' (m - 1) xs -- | Run a 'Parser' over a stream and return rest of the Stream. -{-# INLINE_NORMAL parseBreak #-} -parseBreak +{-# INLINE_NORMAL parseBreakD #-} +parseBreakD :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a) -parseBreak (PR.Parser pstep initial extract) stream = do +parseBreakD (PR.Parser pstep initial extract) stream = do res <- initial case res of PR.IPartial s -> goStream stream [] s @@ -1052,7 +1197,7 @@ parseBreak (PR.Parser pstep initial extract) stream = do assertM(n <= length (x:buf)) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 - return (Right b, serial (fromList src) r) + return (Right b, append (fromList src) r) PR.Error err -> return (Left (ParseError err), r) in foldStream defState yieldk single stop st @@ -1076,5 +1221,46 @@ parseBreak (PR.Parser pstep initial extract) stream = do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 - return (Right b, serial (fromList src) st) + return (Right b, append (fromList src) st) PR.Error err -> return (Left (ParseError err), nil) + +-- | Parse a stream using the supplied 'Parser'. +-- +-- /CPS/ +-- +{-# INLINE parseBreak #-} +parseBreak :: Monad m => + Parser.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a) +parseBreak p = parseBreakD (PR.fromParserK p) + +{-# INLINE parse #-} +parse :: Monad m => + Parser.Parser a m b -> Stream m a -> m (Either ParseError b) +parse f = fmap fst . parseBreak f + +-- | Sort the input stream using a supplied comparison function. +-- +-- Sorting can be achieved by simply: +-- +-- >>> sortBy cmp = StreamK.mergeMapWith (StreamK.mergeBy cmp) StreamK.fromPure +-- +-- However, this combinator uses a parser to first split the input stream into +-- down and up sorted segments and then merges them to optimize sorting when +-- pre-sorted sequences exist in the input stream. +-- +-- /O(n) space/ +-- +{-# INLINE sortBy #-} +sortBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a +-- sortBy f = Stream.concatPairsWith (Stream.mergeBy f) Stream.fromPure +sortBy cmp = + let p = + Parser.groupByRollingEither + (\x -> (< GT) . cmp x) + FL.toStreamKRev + FL.toStreamK + in mergeMapWith (mergeBy cmp) id + . Stream.toStreamK + . Stream.catRights -- its a non-failing backtracking parser + . Stream.parseMany (fmap (either id id) p) + . Stream.fromStreamK diff --git a/core/src/Streamly/Internal/Data/Stream/StreamDK/Type.hs b/core/src/Streamly/Internal/Data/Stream/StreamK/Alt.hs similarity index 56% rename from core/src/Streamly/Internal/Data/Stream/StreamDK/Type.hs rename to core/src/Streamly/Internal/Data/Stream/StreamK/Alt.hs index 8fff5663f..67b22813d 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamDK/Type.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamK/Alt.hs @@ -92,13 +92,153 @@ -- a push style CPS representation should be able to be used along with StreamK -- to efficiently implement composable folds. -module Streamly.Internal.Data.Stream.StreamDK.Type - ( Step(..) - , Stream (..) +module Streamly.Internal.Data.Stream.StreamK.Alt + ( + -- * Stream Type + + Stream + , Step (..) + + -- * Construction + , nil + , cons + , consM + , unfoldr + , unfoldrM + , replicateM + + -- * Folding + , uncons + , foldrS + + -- * Specific Folds + , drain ) where +#include "inline.hs" + -- XXX Use Cons and Nil instead of Yield and Stop? data Step m a = Yield a (Stream m a) | Stop newtype Stream m a = Stream (m (Step m a)) + +------------------------------------------------------------------------------- +-- Construction +------------------------------------------------------------------------------- + +nil :: Monad m => Stream m a +nil = Stream $ return Stop + +{-# INLINE_NORMAL cons #-} +cons :: Monad m => a -> Stream m a -> Stream m a +cons x xs = Stream $ return $ Yield x xs + +consM :: Monad m => m a -> Stream m a -> Stream m a +consM eff xs = Stream $ eff >>= \x -> return $ Yield x xs + +unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a +unfoldrM next state = Stream (step' state) + where + step' st = do + r <- next st + return $ case r of + Just (x, s) -> Yield x (Stream (step' s)) + Nothing -> Stop +{- +unfoldrM next s0 = buildM $ \yld stp -> + let go s = do + r <- next s + case r of + Just (a, b) -> yld a (go b) + Nothing -> stp + in go s0 +-} + +{-# INLINE unfoldr #-} +unfoldr :: Monad m => (b -> Maybe (a, b)) -> b -> Stream m a +unfoldr next s0 = build $ \yld stp -> + let go s = + case next s of + Just (a, b) -> yld a (go b) + Nothing -> stp + in go s0 + +replicateM :: Monad m => Int -> a -> Stream m a +replicateM n x = Stream (step n) + where + step i = return $ + if i <= 0 + then Stop + else Yield x (Stream (step (i - 1))) + +------------------------------------------------------------------------------- +-- Folding +------------------------------------------------------------------------------- + +uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a)) +uncons (Stream step) = do + r <- step + return $ case r of + Yield x xs -> Just (x, xs) + Stop -> Nothing + +-- | Lazy right associative fold to a stream. +{-# INLINE_NORMAL foldrS #-} +foldrS :: Monad m + => (a -> Stream m b -> Stream m b) + -> Stream m b + -> Stream m a + -> Stream m b +foldrS f streamb = go + where + go (Stream stepa) = Stream $ do + r <- stepa + case r of + Yield x xs -> let Stream step = f x (go xs) in step + Stop -> let Stream step = streamb in step + +{-# INLINE_LATE foldrM #-} +foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b +foldrM fstep acc = go + where + go (Stream step) = do + r <- step + case r of + Yield x xs -> fstep x (go xs) + Stop -> acc + +{-# INLINE_NORMAL build #-} +build :: Monad m + => forall a. (forall b. (a -> b -> b) -> b -> b) -> Stream m a +build g = g cons nil + +{-# RULES +"foldrM/build" forall k z (g :: forall b. (a -> b -> b) -> b -> b). + foldrM k z (build g) = g k z #-} + +{- +-- To fuse foldrM with unfoldrM we need the type m1 to be polymorphic such that +-- it is either Monad m or Stream m. So that we can use cons/nil as well as +-- monadic construction function as its arguments. +-- +{-# INLINE_NORMAL buildM #-} +buildM :: Monad m + => forall a. (forall b. (a -> m1 b -> m1 b) -> m1 b -> m1 b) -> Stream m a +buildM g = g cons nil +-} + +------------------------------------------------------------------------------- +-- Specific folds +------------------------------------------------------------------------------- + +{-# INLINE drain #-} +drain :: Monad m => Stream m a -> m () +drain = foldrM (\_ xs -> xs) (return ()) +{- +drain (Stream step) = do + r <- step + case r of + Yield _ next -> drain next + Stop -> return () + -} diff --git a/core/src/Streamly/Internal/Data/Stream/StreamK/Type.hs b/core/src/Streamly/Internal/Data/Stream/StreamK/Type.hs index c334dc030..33572d4b4 100644 --- a/core/src/Streamly/Internal/Data/Stream/StreamK/Type.hs +++ b/core/src/Streamly/Internal/Data/Stream/StreamK/Type.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE UndecidableInstances #-} -- | -- Module : Streamly.Internal.Data.Stream.StreamK.Type -- Copyright : (c) 2017 Composewell Technologies @@ -13,12 +14,16 @@ -- module Streamly.Internal.Data.Stream.StreamK.Type ( - -- * The stream type - Stream (..) - , toStreamK - , fromStreamK + -- * StreamK type + Stream (..) -- XXX stop exporting this + , StreamK - -- * foldr/build + -- * CrossStreamK type wrapper + , CrossStreamK + , unCross + , mkCross + + -- * foldr/build Fusion , mkStream , foldStream , foldStreamShared @@ -32,8 +37,10 @@ module Streamly.Internal.Data.Stream.StreamK.Type , buildSM , augmentS , augmentSM + , unShare -- * Construction + -- ** Primitives , fromStopK , fromYieldK , consK @@ -44,58 +51,89 @@ module Streamly.Internal.Data.Stream.StreamK.Type , nil , nilM - -- * Generation - , fromEffect - , fromPure + -- ** Unfolding , unfoldr , unfoldrMWith + , unfoldrM + + -- ** From Values + , fromEffect + , fromPure , repeat , repeatMWith , replicateMWith + + -- ** From Indices , fromIndicesMWith + + -- ** Iteration , iterateMWith + + -- ** From Containers , fromFoldable , fromFoldableM + + -- ** Cyclic , mfix -- * Elimination + -- ** Primitives , uncons - , foldl' + + -- ** Strict Left Folds + , Streamly.Internal.Data.Stream.StreamK.Type.foldl' , foldlx' + + -- ** Lazy Right Folds + , Streamly.Internal.Data.Stream.StreamK.Type.foldr + + -- ** Specific Folds , drain , null , tail , init - -- * Transformation - , conjoin - , serial + -- * Mapping , map , mapMWith , mapMSerial - , unShare + -- * Combining Two Streams + -- ** Appending + , conjoin + , append + + -- ** Interleave + , interleave + , interleaveFst + , interleaveMin + + -- ** Cross Product , crossApplyWith , crossApply , crossApplySnd , crossApplyFst + , crossWith + , cross - , concatMapWith - , concatMap - , bindWith - , concatPairsWith - - , foldlS - , reverse - + -- * Concat , before , concatEffect , concatMapEffect + , concatMapWith + , concatMap + , bindWith + , concatIterateWith + , concatIterateLeftsWith + , concatIterateScanWith - -- * Interleave - , interleave - , interleaveFst - , interleaveMin + -- * Merge + , mergeMapWith + , mergeIterateWith + + -- * Buffered Operations + , foldlS + , reverse ) where @@ -103,21 +141,44 @@ where -- import Control.Applicative (liftA2) import Control.Monad ((>=>)) +import Control.Monad.Catch (MonadThrow, throwM) +import Control.Monad.Trans.Class (MonadTrans(lift)) +import Control.Applicative (liftA2) +import Control.Monad.IO.Class (MonadIO(..)) +import Data.Foldable (Foldable(foldl'), fold, foldr) import Data.Function (fix) +import Data.Functor.Identity (Identity(..)) +import Data.Maybe (fromMaybe) +import Data.Semigroup (Endo(..)) +import GHC.Exts (IsList(..), IsString(..), oneShot) +import Streamly.Internal.BaseCompat ((#.)) +import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe) import Streamly.Internal.Data.SVar.Type (State, adaptState, defState) +import Text.Read + ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec + , readListPrecDefault) import qualified Prelude import Prelude hiding (map, mapM, concatMap, foldr, repeat, null, reverse, tail, init) +-- $setup +-- >>> import Data.Function (fix, (&)) +-- >>> import Data.Semigroup (cycle1) +-- >>> import Streamly.Internal.Data.Stream.StreamK (CrossStreamK(..)) +-- >>> import qualified Streamly.Data.Fold as Fold +-- >>> import qualified Streamly.Data.Stream as Stream +-- >>> import qualified Streamly.Data.Stream.StreamK as StreamK +-- >>> import qualified Streamly.Internal.Data.Stream.StreamK as StreamK +-- >>> import qualified Streamly.Internal.FileSystem.Dir as Dir + ------------------------------------------------------------------------------ -- Basic stream type ------------------------------------------------------------------------------ --- | The type @Stream m a@ represents a monadic stream of values of type 'a' --- constructed using actions in monad 'm'. It uses stop, singleton and yield --- continuations equivalent to the following direct style type: +-- It uses stop, singleton and yield continuations equivalent to the following +-- direct style type: -- -- @ -- data Stream m a = Stop | Singleton a | Yield a (Stream m a) @@ -132,8 +193,17 @@ import Prelude hiding -- single element. We build singleton streams in the implementation of 'pure' -- for Applicative and Monad, and in 'lift' for MonadTrans. --- XXX remove the Stream type parameter from State as it is always constant. --- We can remove it from SVar as well +-- XXX remove the State param. + +-- | Continuation Passing Style (CPS) version of "Streamly.Data.Stream.Stream". +-- Unlike "Streamly.Data.Stream.Stream", 'StreamK' can be composed recursively +-- without affecting performance. +-- +-- Semigroup instance appends two streams: +-- +-- >>> (<>) = Stream.append +-- +type StreamK = Stream newtype Stream m a = MkStream (forall r. @@ -144,14 +214,6 @@ newtype Stream m a = -> m r ) -{-# INLINE fromStreamK #-} -fromStreamK :: Stream m a -> Stream m a -fromStreamK = id - -{-# INLINE toStreamK #-} -toStreamK :: Stream m a -> Stream m a -toStreamK = id - mkStream :: (forall r. State Stream m a -> (a -> Stream m a -> m r) @@ -195,17 +257,22 @@ consK k r = mkStream $ \_ yld _ _ -> k (`yld` r) infixr 5 `cons` -- faster than consM because there is no bind. --- | Construct a stream by adding a pure value at the head of an existing --- stream. For serial streams this is the same as @(return a) \`consM` r@ but --- more efficient. For concurrent streams this is not concurrent whereas --- 'consM' is concurrent. For example: + +-- | A right associative prepend operation to add a pure value at the head of +-- an existing stream:: -- --- @ --- > toList $ 1 \`cons` 2 \`cons` 3 \`cons` nil +-- >>> s = 1 `StreamK.cons` 2 `StreamK.cons` 3 `StreamK.cons` StreamK.nil +-- >>> Stream.fold Fold.toList (StreamK.toStream s) -- [1,2,3] --- @ -- --- @since 0.1.0 +-- It can be used efficiently with 'Prelude.foldr': +-- +-- >>> fromFoldable = Prelude.foldr StreamK.cons StreamK.nil +-- +-- Same as the following but more efficient: +-- +-- >>> cons x xs = return x `StreamK.consM` xs +-- {-# INLINE_NORMAL cons #-} cons :: a -> Stream m a -> Stream m a cons a r = mkStream $ \_ yield _ _ -> yield a r @@ -224,35 +291,44 @@ infixr 5 .: (.:) :: a -> Stream m a -> Stream m a (.:) = cons --- | An empty stream. +-- | A stream that terminates without producing any output or side effect. -- --- @ --- > toList nil +-- >>> Stream.fold Fold.toList (StreamK.toStream StreamK.nil) -- [] --- @ -- --- @since 0.1.0 {-# INLINE_NORMAL nil #-} nil :: Stream m a nil = mkStream $ \_ _ _ stp -> stp --- | An empty stream producing a side effect. +-- | A stream that terminates without producing any output, but produces a side +-- effect. -- --- @ --- > toList (nilM (print "nil")) +-- >>> Stream.fold Fold.toList (StreamK.toStream (StreamK.nilM (print "nil"))) -- "nil" -- [] --- @ -- -- /Pre-release/ {-# INLINE_NORMAL nilM #-} nilM :: Applicative m => m b -> Stream m a nilM m = mkStream $ \_ _ _ stp -> m *> stp +-- | Create a singleton stream from a pure value. +-- +-- >>> fromPure a = a `cons` StreamK.nil +-- >>> fromPure = pure +-- >>> fromPure = StreamK.fromEffect . pure +-- {-# INLINE_NORMAL fromPure #-} fromPure :: a -> Stream m a fromPure a = mkStream $ \_ _ single _ -> single a +-- | Create a singleton stream from a monadic action. +-- +-- >>> fromEffect m = m `consM` StreamK.nil +-- +-- >>> Stream.fold Fold.drain $ StreamK.toStream $ StreamK.fromEffect (putStrLn "hello") +-- hello +-- {-# INLINE_NORMAL fromEffect #-} fromEffect :: Monad m => m a -> Stream m a fromEffect m = mkStream $ \_ _ single _ -> m >>= single @@ -262,6 +338,23 @@ infixr 5 `consM` -- NOTE: specializing the function outside the instance definition seems to -- improve performance quite a bit at times, even if we have the same -- SPECIALIZE in the instance definition. + +-- | A right associative prepend operation to add an effectful value at the +-- head of an existing stream:: +-- +-- >>> s = putStrLn "hello" `consM` putStrLn "world" `consM` StreamK.nil +-- >>> Stream.fold Fold.drain (StreamK.toStream s) +-- hello +-- world +-- +-- It can be used efficiently with 'Prelude.foldr': +-- +-- >>> fromFoldableM = Prelude.foldr StreamK.consM StreamK.nil +-- +-- Same as the following but more efficient: +-- +-- >>> consM x xs = StreamK.fromEffect x `StreamK.append` xs +-- {-# INLINE consM #-} {-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-} consM :: Monad m => m a -> Stream m a -> Stream m a @@ -361,7 +454,34 @@ foldrSShared = foldrSWith foldStreamShared -- {-# RULES "foldrSShared/app" [1] -- forall ys. foldrSShared consM ys = \xs -> xs `conjoin` ys #-} --- | Lazy right associative fold to a stream. +-- | Right fold to a streaming monad. +-- +-- > foldrS StreamK.cons StreamK.nil === id +-- +-- 'foldrS' can be used to perform stateless stream to stream transformations +-- like map and filter in general. It can be coupled with a scan to perform +-- stateful transformations. However, note that the custom map and filter +-- routines can be much more efficient than this due to better stream fusion. +-- +-- >>> input = StreamK.fromStream $ Stream.fromList [1..5] +-- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS StreamK.cons StreamK.nil input +-- [1,2,3,4,5] +-- +-- Find if any element in the stream is 'True': +-- +-- >>> step x xs = if odd x then StreamK.fromPure True else xs +-- >>> input = StreamK.fromStream (Stream.fromList (2:4:5:undefined)) :: StreamK IO Int +-- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS step (StreamK.fromPure False) input +-- [True] +-- +-- Map (+2) on odd elements and filter out the even elements: +-- +-- >>> step x xs = if odd x then (x + 2) `StreamK.cons` xs else xs +-- >>> input = StreamK.fromStream (Stream.fromList [1..5]) :: Stream IO Int +-- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS step StreamK.nil input +-- [3,5,7] +-- +-- /Pre-release/ {-# INLINE_NORMAL foldrS #-} foldrS :: (a -> Stream m b -> Stream m b) @@ -741,16 +861,25 @@ null m = -- Semigroup ------------------------------------------------------------------------------ -infixr 6 `serial` +infixr 6 `append` -- | Appends two streams sequentially, yielding all elements from the first -- stream, and then all elements from the second stream. -- -{-# INLINE serial #-} -serial :: Stream m a -> Stream m a -> Stream m a +-- >>> s1 = StreamK.fromStream $ Stream.fromList [1,2] +-- >>> s2 = StreamK.fromStream $ Stream.fromList [3,4] +-- >>> Stream.fold Fold.toList $ StreamK.toStream $ s1 `StreamK.append` s2 +-- [1,2,3,4] +-- +-- This has O(n) append performance where @n@ is the number of streams. It can +-- be used to efficiently fold an infinite lazy container of streams using +-- 'concatMapWith' et. al. +-- +{-# INLINE append #-} +append :: Stream m a -> Stream m a -> Stream m a -- XXX This doubles the time of toNullAp benchmark, may not be fusing properly -- serial xs ys = augmentS (\c n -> foldrS c n xs) ys -serial m1 m2 = go m1 +append m1 m2 = go m1 where go m = mkStream $ \st yld sng stp -> let stop = foldStream st yld sng stp m2 @@ -764,7 +893,7 @@ conjoin :: Monad m => Stream m a -> Stream m a -> Stream m a conjoin xs = augmentSM (\c n -> foldrSM c n xs) instance Semigroup (Stream m a) where - (<>) = serial + (<>) = append ------------------------------------------------------------------------------ -- Monoid @@ -861,6 +990,163 @@ mapMWith cns f = go instance Monad m => Functor (Stream m) where fmap = map +------------------------------------------------------------------------------ +-- Lists +------------------------------------------------------------------------------ + +-- Serial streams can act like regular lists using the Identity monad + +-- XXX Show instance is 10x slower compared to read, we can do much better. +-- The list show instance itself is really slow. + +-- XXX The default definitions of "<" in the Ord instance etc. do not perform +-- well, because they do not get inlined. Need to add INLINE in Ord class in +-- base? + +instance IsList (Stream Identity a) where + type (Item (Stream Identity a)) = a + + {-# INLINE fromList #-} + fromList = fromFoldable + + {-# INLINE toList #-} + toList = Data.Foldable.foldr (:) [] + +-- XXX Fix these +{- +instance Eq a => Eq (Stream Identity a) where + {-# INLINE (==) #-} + (==) xs ys = runIdentity $ eqBy (==) xs ys + +instance Ord a => Ord (Stream Identity a) where + {-# INLINE compare #-} + compare xs ys = runIdentity $ cmpBy compare xs ys + + {-# INLINE (<) #-} + x < y = + case compare x y of + LT -> True + _ -> False + + {-# INLINE (<=) #-} + x <= y = + case compare x y of + GT -> False + _ -> True + + {-# INLINE (>) #-} + x > y = + case compare x y of + GT -> True + _ -> False + + {-# INLINE (>=) #-} + x >= y = + case compare x y of + LT -> False + _ -> True + + {-# INLINE max #-} + max x y = if x <= y then y else x + + {-# INLINE min #-} + min x y = if x <= y then x else y +-} + +instance Show a => Show (Stream Identity a) where + showsPrec p dl = showParen (p > 10) $ + showString "fromList " . shows (toList dl) + +instance Read a => Read (Stream Identity a) where + readPrec = parens $ prec 10 $ do + Ident "fromList" <- lexP + fromList <$> readPrec + + readListPrec = readListPrecDefault + +instance (a ~ Char) => IsString (Stream Identity a) where + {-# INLINE fromString #-} + fromString = fromList + +------------------------------------------------------------------------------- +-- Foldable +------------------------------------------------------------------------------- + +-- | Lazy right associative fold. +{-# INLINE foldr #-} +foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b +foldr step acc = foldrM (\x xs -> xs >>= \b -> return (step x b)) (return acc) + +-- The default Foldable instance has several issues: +-- 1) several definitions do not have INLINE on them, so we provide +-- re-implementations with INLINE pragmas. +-- 2) the definitions of sum/product/maximum/minimum are inefficient as they +-- use right folds, they cannot run in constant memory. We provide +-- implementations using strict left folds here. + +instance (Foldable m, Monad m) => Foldable (Stream m) where + + {-# INLINE foldMap #-} + foldMap f = + fold + . Streamly.Internal.Data.Stream.StreamK.Type.foldr (mappend . f) mempty + + {-# INLINE foldr #-} + foldr f z t = appEndo (foldMap (Endo #. f) t) z + + {-# INLINE foldl' #-} + foldl' f z0 xs = Data.Foldable.foldr f' id xs z0 + where f' x k = oneShot $ \z -> k $! f z x + + {-# INLINE length #-} + length = Data.Foldable.foldl' (\n _ -> n + 1) 0 + + {-# INLINE elem #-} + elem = any . (==) + + {-# INLINE maximum #-} + maximum = + fromMaybe (errorWithoutStackTrace "maximum: empty stream") + . toMaybe + . Data.Foldable.foldl' getMax Nothing' + + where + + getMax Nothing' x = Just' x + getMax (Just' mx) x = Just' $! max mx x + + {-# INLINE minimum #-} + minimum = + fromMaybe (errorWithoutStackTrace "minimum: empty stream") + . toMaybe + . Data.Foldable.foldl' getMin Nothing' + + where + + getMin Nothing' x = Just' x + getMin (Just' mn) x = Just' $! min mn x + + {-# INLINE sum #-} + sum = Data.Foldable.foldl' (+) 0 + + {-# INLINE product #-} + product = Data.Foldable.foldl' (*) 1 + +------------------------------------------------------------------------------- +-- Traversable +------------------------------------------------------------------------------- + +instance Traversable (Stream Identity) where + {-# INLINE traverse #-} + traverse f xs = + runIdentity + $ Streamly.Internal.Data.Stream.StreamK.Type.foldr + consA (pure mempty) xs + + where + + consA x ys = liftA2 cons (f x) ys + ------------------------------------------------------------------------------- -- Nesting ------------------------------------------------------------------------------- @@ -895,6 +1181,15 @@ crossApplyWith par fstream stream = go1 fstream yieldk a r = yld (f a) (go2 f r) in foldStream (adaptState st) yieldk single stp m +-- | Apply a stream of functions to a stream of values and flatten the results. +-- +-- Note that the second stream is evaluated multiple times. +-- +-- Definition: +-- +-- >>> crossApply = StreamK.crossApplyWith StreamK.append +-- >>> crossApply = Stream.crossWith id +-- {-# INLINE crossApply #-} crossApply :: Stream m (a -> b) @@ -979,6 +1274,39 @@ crossApplyFst fstream stream = go1 fstream yieldk _ r = yld f (go3 f r) in foldStream (adaptState st) yieldk single stp m +-- | +-- Definition: +-- +-- >>> crossWith f m1 m2 = fmap f m1 `StreamK.crossApply` m2 +-- +-- Note that the second stream is evaluated multiple times. +-- +{-# INLINE crossWith #-} +crossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c +crossWith f m1 m2 = fmap f m1 `crossApply` m2 + +-- | Given a @Stream m a@ and @Stream m b@ generate a stream with all possible +-- combinations of the tuple @(a, b)@. +-- +-- Definition: +-- +-- >>> cross = StreamK.crossWith (,) +-- +-- The second stream is evaluated multiple times. If that is not desired it can +-- be cached in an 'Data.Array.Array' and then generated from the array before +-- calling this function. Caching may also improve performance if the stream is +-- expensive to evaluate. +-- +-- See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused +-- alternative. +-- +-- Time: O(m x n) +-- +-- /Pre-release/ +{-# INLINE cross #-} +cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b) +cross = crossWith (,) + -- XXX This is just concatMapWith with arguments flipped. We need to keep this -- instead of using a concatMap style definition because the bind -- implementation in Async and WAsync streams show significant perf degradation @@ -1010,7 +1338,6 @@ bindWith par m1 f = go m1 -- argument specifies a merge or concat function that is used to merge the -- streams generated by the map function. -- --- @since 0.7.0 {-# INLINE concatMapWith #-} concatMapWith :: @@ -1022,7 +1349,7 @@ concatMapWith par f xs = bindWith par xs f {-# INLINE concatMap #-} concatMap :: (a -> Stream m b) -> Stream m a -> Stream m b -concatMap = concatMapWith serial +concatMap = concatMapWith append {- -- Fused version. @@ -1042,17 +1369,34 @@ concatMap_ f xs = buildS (\c n -> foldrSShared (\x b -> foldrSShared c b (unShare $ f x)) n xs) -} --- | See 'Streamly.Internal.Data.Stream.concatPairsWith' for --- documentation. +-- | Combine streams in pairs using a binary combinator, the resulting streams +-- are then combined again in pairs recursively until we get to a single +-- combined stream. The composition would thus form a binary tree. -- -{-# INLINE concatPairsWith #-} -concatPairsWith +-- For example, you can sort a stream using merge sort like this: +-- +-- >>> s = StreamK.fromStream $ Stream.fromList [5,1,7,9,2] +-- >>> generate = StreamK.fromPure +-- >>> combine = StreamK.mergeBy compare +-- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.mergeMapWith combine generate s +-- [1,2,5,7,9] +-- +-- Note that if the stream length is not a power of 2, the binary tree composed +-- by mergeMapWith would not be balanced, which may or may not be important +-- depending on what you are trying to achieve. +-- +-- /Caution: the stream of streams must be finite/ +-- +-- /Pre-release/ +-- +{-# INLINE mergeMapWith #-} +mergeMapWith :: (Stream m b -> Stream m b -> Stream m b) -> (a -> Stream m b) -> Stream m a -> Stream m b -concatPairsWith combine f str = go (leafPairs str) +mergeMapWith combine f str = go (leafPairs str) where @@ -1139,17 +1483,172 @@ concatUnfoldr :: IsStream t concatUnfoldr = undefined -} +------------------------------------------------------------------------------ +-- concatIterate - Map and flatten Trees of Streams +------------------------------------------------------------------------------ + +-- | Yield an input element in the output stream, map a stream generator on it +-- and repeat the process on the resulting stream. Resulting streams are +-- flattened using the 'concatMapWith' combinator. This can be used for a depth +-- first style (DFS) traversal of a tree like structure. +-- +-- Example, list a directory tree using DFS: +-- +-- >>> f = StreamK.fromStream . either Dir.readEitherPaths (const Stream.nil) +-- >>> input = StreamK.fromPure (Left ".") +-- >>> ls = StreamK.concatIterateWith StreamK.append f input +-- +-- Note that 'iterateM' is a special case of 'concatIterateWith': +-- +-- >>> iterateM f = StreamK.concatIterateWith StreamK.append (StreamK.fromEffect . f) . StreamK.fromEffect +-- +-- /Pre-release/ +-- +{-# INLINE concatIterateWith #-} +concatIterateWith :: + (Stream m a -> Stream m a -> Stream m a) + -> (a -> Stream m a) + -> Stream m a + -> Stream m a +concatIterateWith combine f = iterateStream + + where + + iterateStream = concatMapWith combine generate + + generate x = x `cons` iterateStream (f x) + +-- | Like 'concatIterateWith' but uses the pairwise flattening combinator +-- 'mergeMapWith' for flattening the resulting streams. This can be used for a +-- balanced traversal of a tree like structure. +-- +-- Example, list a directory tree using balanced traversal: +-- +-- >>> f = StreamK.fromStream . either Dir.readEitherPaths (const Stream.nil) +-- >>> input = StreamK.fromPure (Left ".") +-- >>> ls = StreamK.mergeIterateWith StreamK.interleave f input +-- +-- /Pre-release/ +-- +{-# INLINE mergeIterateWith #-} +mergeIterateWith :: + (Stream m a -> Stream m a -> Stream m a) + -> (a -> Stream m a) + -> Stream m a + -> Stream m a +mergeIterateWith combine f = iterateStream + + where + + iterateStream = mergeMapWith combine generate + + generate x = x `cons` iterateStream (f x) + +------------------------------------------------------------------------------ +-- Flattening Graphs +------------------------------------------------------------------------------ + +-- To traverse graphs we need a state to be carried around in the traversal. +-- For example, we can use a hashmap to store the visited status of nodes. + +-- | Like 'iterateMap' but carries a state in the stream generation function. +-- This can be used to traverse graph like structures, we can remember the +-- visited nodes in the state to avoid cycles. +-- +-- Note that a combination of 'iterateMap' and 'usingState' can also be used to +-- traverse graphs. However, this function provides a more localized state +-- instead of using a global state. +-- +-- See also: 'mfix' +-- +-- /Pre-release/ +-- +{-# INLINE concatIterateScanWith #-} +concatIterateScanWith + :: Monad m + => (Stream m a -> Stream m a -> Stream m a) + -> (b -> a -> m (b, Stream m a)) + -> m b + -> Stream m a + -> Stream m a +concatIterateScanWith combine f initial stream = + concatEffect $ do + b <- initial + iterateStream (b, stream) + + where + + iterateStream (b, s) = pure $ concatMapWith combine (generate b) s + + generate b a = a `cons` feedback b a + + feedback b a = concatEffect $ f b a >>= iterateStream + +------------------------------------------------------------------------------ +-- Either streams +------------------------------------------------------------------------------ + +-- Keep concating either streams as long as rights are generated, stop as soon +-- as a left is generated and concat the left stream. +-- +-- See also: 'handle' +-- +-- /Unimplemented/ +-- +{- +concatMapEitherWith + :: (forall x. t m x -> t m x -> t m x) + -> (a -> t m (Either (Stream m b) b)) + -> Stream m a + -> Stream m b +concatMapEitherWith = undefined +-} + +-- XXX We should prefer using the Maybe stream returning signatures over this. +-- This API should perhaps be removed in favor of those. + +-- | In an 'Either' stream iterate on 'Left's. This is a special case of +-- 'concatIterateWith': +-- +-- >>> concatIterateLeftsWith combine f = StreamK.concatIterateWith combine (either f (const StreamK.nil)) +-- +-- To traverse a directory tree: +-- +-- >>> input = StreamK.fromPure (Left ".") +-- >>> ls = StreamK.concatIterateLeftsWith StreamK.append (StreamK.fromStream . Dir.readEither) input +-- +-- /Pre-release/ +-- +{-# INLINE concatIterateLeftsWith #-} +concatIterateLeftsWith + :: (b ~ Either a c) + => (Stream m b -> Stream m b -> Stream m b) + -> (a -> Stream m b) + -> Stream m b + -> Stream m b +concatIterateLeftsWith combine f = + concatIterateWith combine (either f (const nil)) + ------------------------------------------------------------------------------ -- Interleaving ------------------------------------------------------------------------------ +infixr 6 `interleave` + -- Additionally we can have m elements yield from the first stream and n -- elements yielding from the second stream. We can also have time slicing -- variants of positional interleaving, e.g. run first stream for m seconds and -- run the second stream for n seconds. --- --- Similar combinators can be implemented using WAhead style. +-- | Interleaves two streams, yielding one element from each stream +-- alternately. When one stream stops the rest of the other stream is used in +-- the output stream. +-- +-- When joining many streams in a left associative manner earlier streams will +-- get exponential priority than the ones joining later. Because of exponential +-- weighting it can be used with 'concatMapWith' even on a large number of +-- streams. +-- {-# INLINE interleave #-} interleave :: Stream m a -> Stream m a -> Stream m a interleave m1 m2 = mkStream $ \st yld sng stp -> do @@ -1158,7 +1657,9 @@ interleave m1 m2 = mkStream $ \st yld sng stp -> do yieldk a r = yld a (interleave m2 r) foldStream st yieldk single stop m1 --- | Like `interleaveK` but stops interleaving as soon as the first stream stops. +infixr 6 `interleaveFst` + +-- | Like `interleave` but stops interleaving as soon as the first stream stops. -- {-# INLINE interleaveFst #-} interleaveFst :: Stream m a -> Stream m a -> Stream m a @@ -1174,6 +1675,11 @@ interleaveFst m1 m2 = mkStream $ \st yld sng stp -> do yieldk a r = yld a (interleave s1 r) in foldStream st yieldk single stop s2 +infixr 6 `interleaveMin` + +-- | Like `interleave` but stops interleaving as soon as any of the two streams +-- stops. +-- {-# INLINE interleaveMin #-} interleaveMin :: Stream m a -> Stream m a -> Stream m a interleaveMin m1 m2 = mkStream $ \st yld _ stp -> do @@ -1214,6 +1720,10 @@ unfoldrMWith cns step = go Just (a, b) -> yld a (go b) Nothing -> stp +{-# INLINE unfoldrM #-} +unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> Stream m a +unfoldrM = unfoldrMWith consM + -- | Generate an infinite stream by repeating a pure value. -- -- /Pre-release/ @@ -1274,6 +1784,56 @@ tailPartial m = mkStream $ \st yld sng stp -> yieldk _ r = foldStream st yld sng stp r in foldStream st yieldk single stop m +-- | We can define cyclic structures using @let@: +-- +-- >>> let (a, b) = ([1, b], head a) in (a, b) +-- ([1,1],1) +-- +-- The function @fix@ defined as: +-- +-- >>> fix f = let x = f x in x +-- +-- ensures that the argument of a function and its output refer to the same +-- lazy value @x@ i.e. the same location in memory. Thus @x@ can be defined +-- in terms of itself, creating structures with cyclic references. +-- +-- >>> f ~(a, b) = ([1, b], head a) +-- >>> fix f +-- ([1,1],1) +-- +-- 'Control.Monad.mfix' is essentially the same as @fix@ but for monadic +-- values. +-- +-- Using 'mfix' for streams we can construct a stream in which each element of +-- the stream is defined in a cyclic fashion. The argument of the function +-- being fixed represents the current element of the stream which is being +-- returned by the stream monad. Thus, we can use the argument to construct +-- itself. +-- +-- In the following example, the argument @action@ of the function @f@ +-- represents the tuple @(x,y)@ returned by it in a given iteration. We define +-- the first element of the tuple in terms of the second. +-- +-- >>> import System.IO.Unsafe (unsafeInterleaveIO) +-- +-- >>> :{ +-- main = Stream.fold (Fold.drainMapM print) $ StreamK.toStream $ StreamK.mfix f +-- where +-- f action = StreamK.unCross $ do +-- let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act +-- x <- StreamK.mkCross $ StreamK.fromStream $ Stream.sequence $ Stream.fromList [incr 1 action, incr 2 action] +-- y <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [4,5] +-- return (x, y) +-- :} +-- +-- Note: you cannot achieve this by just changing the order of the monad +-- statements because that would change the order in which the stream elements +-- are generated. +-- +-- Note that the function @f@ must be lazy in its argument, that's why we use +-- 'unsafeInterleaveIO' on @action@ because IO monad is strict. +-- +-- /Pre-release/ {-# INLINE mfix #-} mfix :: Monad m => (m a -> Stream m a) -> Stream m a mfix f = mkStream $ \st yld sng stp -> @@ -1329,6 +1889,11 @@ tail = yieldk _ r = pure $ Just r in foldStream defState yieldk single stop +-- | Extract all but the last element of the stream, if any. +-- +-- Note: This will end up buffering the entire stream. +-- +-- /Pre-release/ {-# INLINE init #-} init :: Applicative m => Stream m a -> m (Maybe (Stream m a)) init = go1 @@ -1386,3 +1951,123 @@ concatMapEffect :: Monad m => (b -> Stream m a) -> m b -> Stream m a concatMapEffect f action = mkStream $ \st yld sng stp -> action >>= foldStreamShared st yld sng stp . f + +------------------------------------------------------------------------------ +-- Stream with a cross product style monad instance +------------------------------------------------------------------------------ + +-- | A newtype wrapper for the 'StreamK' type adding a cross product style +-- monad instance. +-- +-- A 'Monad' bind behaves like a @for@ loop: +-- +-- >>> :{ +-- Stream.fold Fold.toList $ StreamK.toStream $ StreamK.unCross $ do +-- x <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [1,2] +-- -- Perform the following actions for each x in the stream +-- return x +-- :} +-- [1,2] +-- +-- Nested monad binds behave like nested @for@ loops: +-- +-- >>> :{ +-- Stream.fold Fold.toList $ StreamK.toStream $ StreamK.unCross $ do +-- x <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [1,2] +-- y <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [3,4] +-- -- Perform the following actions for each x, for each y +-- return (x, y) +-- :} +-- [(1,3),(1,4),(2,3),(2,4)] +-- +newtype CrossStreamK m a = CrossStreamK {unCrossStreamK :: Stream m a} + deriving (Functor, Semigroup, Monoid, Foldable) + +-- | Wrap the 'StreamK' type in a 'CrossStreamK' newtype to enable cross +-- product style applicative and monad instances. +-- +-- This is a type level operation with no runtime overhead. +{-# INLINE mkCross #-} +mkCross :: StreamK m a -> CrossStreamK m a +mkCross = CrossStreamK + +-- | Unwrap the 'StreamK' type from 'CrossStreamK' newtype. +-- +-- This is a type level operation with no runtime overhead. +{-# INLINE unCross #-} +unCross :: CrossStreamK m a -> StreamK m a +unCross = unCrossStreamK + +-- Pure (Identity monad) stream instances +deriving instance Traversable (CrossStreamK Identity) +deriving instance IsList (CrossStreamK Identity a) +deriving instance (a ~ Char) => IsString (CrossStreamK Identity a) +-- deriving instance Eq a => Eq (CrossStreamK Identity a) +-- deriving instance Ord a => Ord (CrossStreamK Identity a) + +-- Do not use automatic derivation for this to show as "fromList" rather than +-- "fromList Identity". +instance Show a => Show (CrossStreamK Identity a) where + {-# INLINE show #-} + show (CrossStreamK xs) = show xs + +instance Read a => Read (CrossStreamK Identity a) where + {-# INLINE readPrec #-} + readPrec = fmap CrossStreamK readPrec + +------------------------------------------------------------------------------ +-- Applicative +------------------------------------------------------------------------------ + +-- Note: we need to define all the typeclass operations because we want to +-- INLINE them. +instance Monad m => Applicative (CrossStreamK m) where + {-# INLINE pure #-} + pure x = CrossStreamK (fromPure x) + + {-# INLINE (<*>) #-} + (CrossStreamK s1) <*> (CrossStreamK s2) = + CrossStreamK (crossApply s1 s2) + + {-# INLINE liftA2 #-} + liftA2 f x = (<*>) (fmap f x) + + {-# INLINE (*>) #-} + (CrossStreamK s1) *> (CrossStreamK s2) = + CrossStreamK (crossApplySnd s1 s2) + + {-# INLINE (<*) #-} + (CrossStreamK s1) <* (CrossStreamK s2) = + CrossStreamK (crossApplyFst s1 s2) + +------------------------------------------------------------------------------ +-- Monad +------------------------------------------------------------------------------ + +instance Monad m => Monad (CrossStreamK m) where + return = pure + + -- Benchmarks better with CPS bind and pure: + -- Prime sieve (25x) + -- n binds, breakAfterSome, filterAllIn, state transformer (~2x) + -- + {-# INLINE (>>=) #-} + (>>=) (CrossStreamK m) f = + CrossStreamK (bindWith append m (unCrossStreamK . f)) + + {-# INLINE (>>) #-} + (>>) = (*>) + +------------------------------------------------------------------------------ +-- Transformers +------------------------------------------------------------------------------ + +instance (MonadIO m) => MonadIO (CrossStreamK m) where + liftIO x = CrossStreamK (fromEffect $ liftIO x) + +instance MonadTrans CrossStreamK where + {-# INLINE lift #-} + lift x = CrossStreamK (fromEffect x) + +instance (MonadThrow m) => MonadThrow (CrossStreamK m) where + throwM = lift . throwM diff --git a/core/src/Streamly/Internal/Data/Stream/Transform.hs b/core/src/Streamly/Internal/Data/Stream/Transform.hs index f39fae127..3ca883e40 100644 --- a/core/src/Streamly/Internal/Data/Stream/Transform.hs +++ b/core/src/Streamly/Internal/Data/Stream/Transform.hs @@ -427,7 +427,7 @@ scanlMAfter' step initial done stream = -- {-# INLINE scan #-} scan :: Monad m => Fold m a b -> Stream m a -> Stream m b -scan fld m = fromStreamD $ D.scanOnce fld $ toStreamD m +scan fld m = fromStreamD $ D.scan fld $ toStreamD m -- | Like 'scan' but restarts scanning afresh when the scanning fold -- terminates. diff --git a/core/src/Streamly/Internal/Data/Stream/Type.hs b/core/src/Streamly/Internal/Data/Stream/Type.hs index 5aeae3b98..0d65343bf 100644 --- a/core/src/Streamly/Internal/Data/Stream/Type.hs +++ b/core/src/Streamly/Internal/Data/Stream/Type.hs @@ -11,13 +11,16 @@ module Streamly.Internal.Data.Stream.Type ( -- * Stream Type - Stream + Stream -- XXX To be removed + , StreamK -- * Type Conversion , fromStreamK , toStreamK , fromStreamD , toStreamD + , fromStream + , toStream , Streamly.Internal.Data.Stream.Type.fromList -- * Construction @@ -76,21 +79,23 @@ import qualified Streamly.Internal.Data.Stream.StreamK.Type as K -- -- >>> (<>) = Stream.append -- -newtype Stream m a = Stream (K.Stream m a) +newtype StreamK m a = StreamK (K.Stream m a) -- XXX when deriving do we inherit an INLINE? deriving (Semigroup, Monoid) +type Stream = StreamK + ------------------------------------------------------------------------------ -- Conversions ------------------------------------------------------------------------------ {-# INLINE_EARLY fromStreamK #-} fromStreamK :: K.Stream m a -> Stream m a -fromStreamK = Stream +fromStreamK = StreamK {-# INLINE_EARLY toStreamK #-} toStreamK :: Stream m a -> K.Stream m a -toStreamK (Stream k) = k +toStreamK (StreamK k) = k {-# INLINE_EARLY fromStreamD #-} fromStreamD :: Monad m => D.Stream m a -> Stream m a @@ -100,6 +105,14 @@ fromStreamD = fromStreamK . D.toStreamK toStreamD :: Applicative m => Stream m a -> D.Stream m a toStreamD = D.fromStreamK . toStreamK +{-# INLINE fromStream #-} +fromStream :: Monad m => D.Stream m a -> Stream m a +fromStream = fromStreamD + +{-# INLINE toStream #-} +toStream :: Applicative m => Stream m a -> D.Stream m a +toStream = toStreamD + ------------------------------------------------------------------------------ -- Generation ------------------------------------------------------------------------------ @@ -162,18 +175,18 @@ instance IsList (Stream Identity a) where type (Item (Stream Identity a)) = a {-# INLINE fromList #-} - fromList xs = Stream $ P.fromList xs + fromList xs = StreamK $ P.fromList xs {-# INLINE toList #-} - toList (Stream xs) = runIdentity $ P.toList xs + toList (StreamK xs) = runIdentity $ P.toList xs instance Eq a => Eq (Stream Identity a) where {-# INLINE (==) #-} - (==) (Stream xs) (Stream ys) = runIdentity $ P.eqBy (==) xs ys + (==) (StreamK xs) (StreamK ys) = runIdentity $ P.eqBy (==) xs ys instance Ord a => Ord (Stream Identity a) where {-# INLINE compare #-} - compare (Stream xs) (Stream ys) = runIdentity $ P.cmpBy compare xs ys + compare (StreamK xs) (StreamK ys) = runIdentity $ P.cmpBy compare xs ys {-# INLINE (<) #-} x < y = @@ -218,7 +231,7 @@ instance Read a => Read (Stream Identity a) where instance (a ~ Char) => IsString (Stream Identity a) where {-# INLINE fromString #-} - fromString xs = Stream $ P.fromList xs + fromString xs = StreamK $ P.fromList xs ------------------------------------------------------------------------------- -- Foldable @@ -234,7 +247,7 @@ instance (a ~ Char) => IsString (Stream Identity a) where instance (Foldable m, Monad m) => Foldable (Stream m) where {-# INLINE foldMap #-} - foldMap f (Stream xs) = fold $ P.foldr (mappend . f) mempty xs + foldMap f (StreamK xs) = fold $ P.foldr (mappend . f) mempty xs {-# INLINE foldr #-} foldr f z t = appEndo (foldMap (Endo #. f) t) z @@ -283,8 +296,8 @@ instance (Foldable m, Monad m) => Foldable (Stream m) where instance Traversable (Stream Identity) where {-# INLINE traverse #-} - traverse f (Stream xs) = - fmap Stream $ runIdentity $ P.foldr consA (pure mempty) xs + traverse f (StreamK xs) = + fmap StreamK $ runIdentity $ P.foldr consA (pure mempty) xs where @@ -396,19 +409,19 @@ fromEffect = fromStreamK . K.fromEffect -- >>> crossApply = Stream.crossWith id -- {-# INLINE crossApply #-} -crossApply :: Monad m => Stream m (a -> b) -> Stream m a -> Stream m b +crossApply :: Stream m (a -> b) -> Stream m a -> Stream m b crossApply m1 m2 = - fromStreamD $ D.crossApply (toStreamD m1) (toStreamD m2) + fromStreamK $ K.crossApply (toStreamK m1) (toStreamK m2) {-# INLINE crossApplySnd #-} -crossApplySnd :: Monad m => Stream m a -> Stream m b -> Stream m b +crossApplySnd :: Stream m a -> Stream m b -> Stream m b crossApplySnd m1 m2 = - fromStreamD $ D.crossApplySnd (toStreamD m1) (toStreamD m2) + fromStreamK $ K.crossApplySnd (toStreamK m1) (toStreamK m2) {-# INLINE crossApplyFst #-} -crossApplyFst :: Monad m => Stream m a -> Stream m b -> Stream m a +crossApplyFst :: Stream m a -> Stream m b -> Stream m a crossApplyFst m1 m2 = - fromStreamD $ D.crossApplyFst (toStreamD m1) (toStreamD m2) + fromStreamK $ K.crossApplyFst (toStreamK m1) (toStreamK m2) -- | -- Definition: diff --git a/core/src/Streamly/Internal/Data/Unfold.hs b/core/src/Streamly/Internal/Data/Unfold.hs index ab732aec5..32fcd554d 100644 --- a/core/src/Streamly/Internal/Data/Unfold.hs +++ b/core/src/Streamly/Internal/Data/Unfold.hs @@ -292,7 +292,6 @@ import qualified Data.Tuple as Tuple import qualified Streamly.Internal.Data.Fold.Type as FL import qualified Streamly.Internal.Data.Stream.StreamD.Type as D import qualified Streamly.Internal.Data.Stream.StreamK.Type as K -import qualified Streamly.Internal.Data.Stream.Type as Stream import qualified Prelude import Streamly.Internal.Data.Unfold.Enumeration @@ -604,8 +603,8 @@ fromStreamK = Unfold step pure Nothing -> Stop) <$> K.uncons stream {-# INLINE fromStream #-} -fromStream :: Applicative m => Unfold m (Stream.Stream m a) a -fromStream = lmap Stream.toStreamK fromStreamK +fromStream :: Applicative m => Unfold m (Stream m a) a +fromStream = fromStreamD ------------------------------------------------------------------------------- -- Unfolds diff --git a/core/src/Streamly/Internal/FileSystem/File.hs b/core/src/Streamly/Internal/FileSystem/File.hs index 5d73a0835..96eb24180 100644 --- a/core/src/Streamly/Internal/FileSystem/File.hs +++ b/core/src/Streamly/Internal/FileSystem/File.hs @@ -107,18 +107,18 @@ import Streamly.Data.Fold (chunksOf, drain) import Streamly.Internal.Data.Array.Type (Array(..), writeNUnsafe) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Data.Stream (Stream) +import Streamly.Internal.Data.Unboxed (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.Data.Stream as S import qualified Streamly.Data.Unfold as UF import qualified Streamly.Internal.Data.Unfold as UF (bracketIO) import qualified Streamly.Internal.Data.Fold.Type as FL (Step(..), snoc, reduce) import qualified Streamly.Internal.FileSystem.Handle as FH -import qualified Streamly.Internal.Data.Stream.Chunked as AS -import qualified Streamly.Data.Stream as S (fold, bracketIO, mapM) ------------------------------------------------------------------------------- -- References @@ -339,6 +339,10 @@ readWithBufferOf = readerWith 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. @@ -347,7 +351,7 @@ reader = UF.many A.reader (usingFile FH.chunkReader) -- {-# INLINE read #-} read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -read file = AS.concat $ withFile file ReadMode FH.readChunks +read file = concatChunks $ withFile file ReadMode FH.readChunks {-# DEPRECATED toBytes "Please use 'read' instead" #-} {-# INLINE toBytes #-} @@ -401,7 +405,7 @@ fromChunks = fromChunksMode WriteMode {-# INLINE fromBytesWith #-} fromBytesWith :: (MonadIO m, MonadCatch m) => Int -> FilePath -> Stream m Word8 -> m () -fromBytesWith n file xs = fromChunks file $ AS.arraysOf n xs +fromBytesWith n file xs = fromChunks file $ S.arraysOf n xs {-# DEPRECATED fromBytesWithBufferOf "Please use 'fromBytesWith' instead" #-} {-# INLINE fromBytesWithBufferOf #-} @@ -498,7 +502,7 @@ appendChunks = fromChunksMode AppendMode {-# INLINE appendWith #-} appendWith :: (MonadIO m, MonadCatch m) => Int -> FilePath -> Stream m Word8 -> m () -appendWith n file xs = appendChunks file $ AS.arraysOf n xs +appendWith n file xs = appendChunks file $ S.arraysOf n xs -- | Append a byte stream to a file. Combines the bytes in chunks of size up to -- 'A.defaultChunkSize' before writing. If the file exists then the new data diff --git a/core/src/Streamly/Internal/FileSystem/Handle.hs b/core/src/Streamly/Internal/FileSystem/Handle.hs index 391b5dc13..22ca2260b 100644 --- a/core/src/Streamly/Internal/FileSystem/Handle.hs +++ b/core/src/Streamly/Internal/FileSystem/Handle.hs @@ -124,7 +124,7 @@ import Streamly.Internal.Data.Refold.Type (Refold(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.Data.Array.Type (Array(..), writeNUnsafe, unsafeFreezeWithShrink, byteLength) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.Stream.Chunked (lpackArraysChunksOf) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) import Streamly.Internal.System.IO (defaultChunkSize) @@ -136,7 +136,7 @@ import qualified Streamly.Internal.Data.Stream.Chunked as AS import qualified Streamly.Internal.Data.Array.Mut.Type as MArray import qualified Streamly.Internal.Data.Refold.Type as Refold import qualified Streamly.Internal.Data.Fold.Type as FL(refoldMany) -import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream.StreamD as S import qualified Streamly.Internal.Data.Stream.StreamD.Type as D (Stream(..), Step(..)) import qualified Streamly.Internal.Data.Unfold as UF @@ -228,7 +228,7 @@ _getChunksWith size h = S.fromStreamK go -- {-# INLINE_NORMAL readChunksWith #-} readChunksWith :: MonadIO m => Int -> Handle -> Stream m (Array Word8) -readChunksWith size h = S.fromStreamD (D.Stream step ()) +readChunksWith size h = D.Stream step () where {-# INLINE_LATE step #-} step _ _ = do @@ -340,6 +340,10 @@ readerWith = UF.many A.reader chunkReaderWith 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@. -- @@ -348,7 +352,7 @@ readWithBufferOf = readerWith -- /Pre-release/ {-# INLINE readWith #-} readWith :: MonadIO m => Int -> Handle -> Stream m Word8 -readWith size h = AS.concat $ readChunksWith size h +readWith size h = concatChunks $ readChunksWith size h -- | Unfolds a file handle into a byte stream. IO requests to the device are -- performed in sizes of @@ -367,7 +371,7 @@ reader = UF.many A.reader chunkReader -- /Pre-release/ {-# INLINE read #-} read :: MonadIO m => Handle -> Stream m Word8 -read = AS.concat . readChunks +read = concatChunks . readChunks ------------------------------------------------------------------------------- -- Writing @@ -429,7 +433,7 @@ putChunksWith n h xs = putChunks h $ AS.compact n xs -- {-# INLINE putBytesWith #-} putBytesWith :: MonadIO m => Int -> Handle -> Stream m Word8 -> m () -putBytesWith n h m = putChunks h $ S.arraysOf n m +putBytesWith n h m = putChunks h $ A.arraysOf n m -- putBytesWith n h m = putChunks h $ AS.arraysOf n m diff --git a/core/src/Streamly/Internal/Serialize/ToBytes.hs b/core/src/Streamly/Internal/Serialize/ToBytes.hs index cd73c9874..22029b42f 100644 --- a/core/src/Streamly/Internal/Serialize/ToBytes.hs +++ b/core/src/Streamly/Internal/Serialize/ToBytes.hs @@ -44,10 +44,10 @@ where import Data.Bits (shiftR) import Data.Word (Word8, Word16, Word32, Word64) import GHC.Float (castDoubleToWord64, castFloatToWord32) -import Streamly.Internal.Data.Stream (Stream, fromStreamD) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Streamly.Internal.Data.Stream.StreamD (Step(..)) -import qualified Streamly.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import qualified Streamly.Internal.Data.Stream.StreamD as D import Data.Int (Int8, Int16, Int32, Int64) @@ -63,7 +63,7 @@ import Data.Int (Int8, Int16, Int32, Int64) -- /Pre-release/ -- {-# INLINE unit #-} -unit :: Stream m Word8 +unit :: Applicative m => Stream m Word8 unit = Stream.fromPure 0 {-# INLINE boolToWord8 #-} @@ -81,7 +81,7 @@ boolToWord8 True = 1 -- /Pre-release/ -- {-# INLINE bool #-} -bool :: Bool -> Stream m Word8 +bool :: Applicative m => Bool -> Stream m Word8 bool = Stream.fromPure . boolToWord8 {-# INLINE orderingToWord8 #-} @@ -101,7 +101,7 @@ orderingToWord8 GT = 2 -- /Pre-release/ -- {-# INLINE ordering #-} -ordering :: Ordering -> Stream m Word8 +ordering :: Applicative m => Ordering -> Stream m Word8 ordering = Stream.fromPure . orderingToWord8 -- | Stream a 'Word8'. @@ -109,7 +109,7 @@ ordering = Stream.fromPure . orderingToWord8 -- /Pre-release/ -- {-# INLINE word8 #-} -word8 :: Word8 -> Stream m Word8 +word8 :: Applicative m => Word8 -> Stream m Word8 word8 = Stream.fromPure data W16State = W16B1 | W16B2 | W16Done @@ -131,7 +131,7 @@ word16beD w = D.Stream step W16B1 -- {-# INLINE word16be #-} word16be :: Monad m => Word16 -> Stream m Word8 -word16be = fromStreamD . word16beD +word16be = word16beD -- | Little endian (LSB first) Word16 {-# INLINE word16leD #-} @@ -151,7 +151,7 @@ word16leD w = D.Stream step W16B1 -- {-# INLINE word16le #-} word16le :: Monad m => Word16 -> Stream m Word8 -word16le = fromStreamD . word16leD +word16le = word16leD data W32State = W32B1 | W32B2 | W32B3 | W32B4 | W32Done @@ -177,7 +177,7 @@ word32beD w = D.Stream step W32B1 -- {-# INLINE word32be #-} word32be :: Monad m => Word32 -> Stream m Word8 -word32be = fromStreamD . word32beD +word32be = word32beD -- | Little endian (LSB first) Word32 {-# INLINE word32leD #-} @@ -201,7 +201,7 @@ word32leD w = D.Stream step W32B1 -- {-# INLINE word32le #-} word32le :: Monad m => Word32 -> Stream m Word8 -word32le = fromStreamD . word32leD +word32le = word32leD data W64State = W64B1 | W64B2 | W64B3 | W64B4 | W64B5 | W64B6 | W64B7 | W64B8 | W64Done @@ -232,7 +232,7 @@ word64beD w = D.Stream step W64B1 -- {-# INLINE word64be #-} word64be :: Monad m => Word64 -> Stream m Word8 -word64be = fromStreamD . word64beD +word64be = word64beD -- | Little endian (LSB first) Word64 {-# INLINE word64leD #-} @@ -260,10 +260,10 @@ word64leD w = D.Stream step W64B1 -- {-# INLINE word64le #-} word64le :: Monad m => Word64 -> Stream m Word8 -word64le = fromStreamD . word64leD +word64le = word64leD {-# INLINE int8 #-} -int8 :: Int8 -> Stream m Word8 +int8 :: Applicative m => Int8 -> Stream m Word8 int8 i = word8 (fromIntegral i :: Word8) -- | Stream a 'Int16' as two bytes, the first byte is the MSB of the Int16 @@ -318,22 +318,22 @@ int64le i = word64le (fromIntegral i :: Word64) -- | Big endian (MSB first) Float {-# INLINE float32be #-} float32be :: Monad m => Float -> Stream m Word8 -float32be = fromStreamD . word32beD . castFloatToWord32 +float32be = word32beD . castFloatToWord32 -- | Little endian (LSB first) Float {-# INLINE float32le #-} float32le :: Monad m => Float -> Stream m Word8 -float32le = fromStreamD . word32leD . castFloatToWord32 +float32le = word32leD . castFloatToWord32 -- | Big endian (MSB first) Double {-# INLINE double64be #-} double64be :: Monad m => Double -> Stream m Word8 -double64be = fromStreamD . word64beD . castDoubleToWord64 +double64be = word64beD . castDoubleToWord64 -- | Little endian (LSB first) Double {-# INLINE double64le #-} double64le :: Monad m => Double -> Stream m Word8 -double64le = fromStreamD . word64leD . castDoubleToWord64 +double64le = word64leD . castDoubleToWord64 ------------------------------------------------------------------------------- -- Host byte order diff --git a/core/src/Streamly/Internal/Unicode/Stream.hs b/core/src/Streamly/Internal/Unicode/Stream.hs index c4ad1ffd3..42de2037e 100644 --- a/core/src/Streamly/Internal/Unicode/Stream.hs +++ b/core/src/Streamly/Internal/Unicode/Stream.hs @@ -105,7 +105,7 @@ import System.IO.Unsafe (unsafePerformIO) import Streamly.Internal.Data.Array.Type (Array(..)) import Streamly.Internal.Data.Array.Mut.Type (MutableByteArray) import Streamly.Internal.Data.Fold (Fold) -import Streamly.Internal.Data.Stream (Stream, fromStreamD, toStreamD) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Streamly.Internal.Data.Stream.StreamD (Step (..)) import Streamly.Internal.Data.SVar.Type (adaptState) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) @@ -118,7 +118,7 @@ import qualified Streamly.Data.Unfold as Unfold import qualified Streamly.Internal.Data.Array.Type as Array import qualified Streamly.Internal.Data.Parser as Parser (Parser) import qualified Streamly.Internal.Data.Parser.ParserD as ParserD -import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import qualified Streamly.Internal.Data.Stream.StreamD as D import Prelude hiding (lines, words, unlines, unwords) @@ -417,7 +417,7 @@ decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0 {-# INLINE decodeUtf8Either #-} decodeUtf8Either :: Monad m => Stream m Word8 -> Stream m (Either DecodeError Char) -decodeUtf8Either = fromStreamD . decodeUtf8EitherD . toStreamD +decodeUtf8Either = decodeUtf8EitherD -- | -- @@ -429,8 +429,7 @@ resumeDecodeUtf8Either -> CodePoint -> Stream m Word8 -> Stream m (Either DecodeError Char) -resumeDecodeUtf8Either st cp = - fromStreamD . resumeDecodeUtf8EitherD st cp . toStreamD +resumeDecodeUtf8Either = resumeDecodeUtf8EitherD ------------------------------------------------------------------------------- -- One shot decoding @@ -646,7 +645,7 @@ decodeUtf8D = decodeUtf8WithD TransliterateCodingFailure -- {-# INLINE decodeUtf8 #-} decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char -decodeUtf8 = fromStreamD . decodeUtf8D . toStreamD +decodeUtf8 = decodeUtf8D {-# INLINE decodeUtf8D' #-} decodeUtf8D' :: Monad m => D.Stream m Word8 -> D.Stream m Char @@ -657,7 +656,7 @@ decodeUtf8D' = decodeUtf8WithD ErrorOnCodingFailure -- {-# INLINE decodeUtf8' #-} decodeUtf8' :: Monad m => Stream m Word8 -> Stream m Char -decodeUtf8' = fromStreamD . decodeUtf8D' . toStreamD +decodeUtf8' = decodeUtf8D' {-# INLINE decodeUtf8D_ #-} decodeUtf8D_ :: Monad m => D.Stream m Word8 -> D.Stream m Char @@ -668,7 +667,7 @@ decodeUtf8D_ = decodeUtf8WithD DropOnCodingFailure -- {-# INLINE decodeUtf8_ #-} decodeUtf8_ :: Monad m => Stream m Word8 -> Stream m Char -decodeUtf8_ = fromStreamD . decodeUtf8D_ . toStreamD +decodeUtf8_ = decodeUtf8D_ -- | Same as 'decodeUtf8' -- @@ -817,8 +816,7 @@ decodeUtf8ArraysD = decodeUtf8ArraysWithD TransliterateCodingFailure -- /Pre-release/ {-# INLINE decodeUtf8Arrays #-} decodeUtf8Arrays :: MonadIO m => Stream m (Array Word8) -> Stream m Char -decodeUtf8Arrays = - fromStreamD . decodeUtf8ArraysD . toStreamD +decodeUtf8Arrays = decodeUtf8ArraysD {-# INLINE decodeUtf8ArraysD' #-} decodeUtf8ArraysD' :: @@ -832,7 +830,7 @@ decodeUtf8ArraysD' = decodeUtf8ArraysWithD ErrorOnCodingFailure -- /Pre-release/ {-# INLINE decodeUtf8Arrays' #-} decodeUtf8Arrays' :: MonadIO m => Stream m (Array Word8) -> Stream m Char -decodeUtf8Arrays' = fromStreamD . decodeUtf8ArraysD' . toStreamD +decodeUtf8Arrays' = decodeUtf8ArraysD' {-# INLINE decodeUtf8ArraysD_ #-} decodeUtf8ArraysD_ :: @@ -847,8 +845,7 @@ decodeUtf8ArraysD_ = decodeUtf8ArraysWithD DropOnCodingFailure {-# INLINE decodeUtf8Arrays_ #-} decodeUtf8Arrays_ :: MonadIO m => Stream m (Array Word8) -> Stream m Char -decodeUtf8Arrays_ = - fromStreamD . decodeUtf8ArraysD_ . toStreamD +decodeUtf8Arrays_ = decodeUtf8ArraysD_ ------------------------------------------------------------------------------- -- Encoding Unicode (UTF-8) Characters @@ -922,7 +919,7 @@ encodeUtf8D' = D.unfoldMany readCharUtf8' -- {-# INLINE encodeUtf8' #-} encodeUtf8' :: Monad m => Stream m Char -> Stream m Word8 -encodeUtf8' = fromStreamD . encodeUtf8D' . toStreamD +encodeUtf8' = encodeUtf8D' {-# INLINE_NORMAL readCharUtf8 #-} readCharUtf8 :: Monad m => Unfold m Char Word8 @@ -941,7 +938,7 @@ encodeUtf8D = D.unfoldMany readCharUtf8 -- {-# INLINE encodeUtf8 #-} encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8 -encodeUtf8 = fromStreamD . encodeUtf8D . toStreamD +encodeUtf8 = encodeUtf8D {-# INLINE_NORMAL readCharUtf8_ #-} readCharUtf8_ :: Monad m => Unfold m Char Word8 @@ -956,7 +953,7 @@ encodeUtf8D_ = D.unfoldMany readCharUtf8_ -- {-# INLINE encodeUtf8_ #-} encodeUtf8_ :: Monad m => Stream m Char -> Stream m Word8 -encodeUtf8_ = fromStreamD . encodeUtf8D_ . toStreamD +encodeUtf8_ = encodeUtf8D_ -- | Same as 'encodeUtf8' -- @@ -1085,7 +1082,7 @@ isSpace c -- /Pre-release/ {-# INLINE words #-} words :: Monad m => Fold m Char b -> Stream m Char -> Stream m b -words f m = Stream.fromStreamD $ D.wordsBy isSpace f (Stream.toStreamD m) +words f = D.wordsBy isSpace f -- | Unfold a stream to character streams using the supplied 'Unfold' -- and concat the results suffixing a newline character @\\n@ to each stream. diff --git a/core/streamly-core.cabal b/core/streamly-core.cabal index d47b4eb7c..f819424a6 100644 --- a/core/streamly-core.cabal +++ b/core/streamly-core.cabal @@ -299,8 +299,10 @@ library , Streamly.Internal.Data.Stream.StreamD.Transform , Streamly.Internal.Data.Stream.StreamD.Exception , Streamly.Internal.Data.Stream.StreamD.Lift + , Streamly.Internal.Data.Stream.StreamD.Top , Streamly.Internal.Data.Stream.StreamD , Streamly.Internal.Data.Stream.Common + , Streamly.Internal.Data.Stream , Streamly.Internal.Data.Parser.ParserD.Tee , Streamly.Internal.Data.Parser.ParserD @@ -317,32 +319,16 @@ library , Streamly.Internal.Data.Parser.Chunked.Type , Streamly.Internal.Data.Parser.Chunked , Streamly.Internal.Data.Pipe - , Streamly.Internal.Data.Stream.Type - , Streamly.Internal.Data.Stream.Eliminate - , Streamly.Internal.Data.Stream.Enumerate - , Streamly.Internal.Data.Stream.Generate - , Streamly.Internal.Data.Stream.Transform - , Streamly.Internal.Data.Stream.Bottom - , Streamly.Internal.Data.Stream.Exception - , Streamly.Internal.Data.Stream.Expand - , Streamly.Internal.Data.Stream.Lift - , Streamly.Internal.Data.Stream.Reduce - , Streamly.Internal.Data.Stream.Top -- streamly-transformers (non-base) , Streamly.Internal.Data.Stream.StreamD.Transformer , Streamly.Internal.Data.Stream.StreamK.Transformer - , Streamly.Internal.Data.Stream.Transformer -- streamly-containers (non-base) - , Streamly.Internal.Data.Stream.Container + , Streamly.Internal.Data.Stream.StreamD.Container , Streamly.Internal.Data.Fold.Container - , Streamly.Internal.Data.Stream , Streamly.Internal.Data.Stream.Chunked - , Streamly.Internal.Data.Stream.Zip - , Streamly.Internal.Data.Stream.Cross - , Streamly.Internal.Data.List -- streamly-core-data-arrays , Streamly.Internal.Data.Array.Generic @@ -405,6 +391,7 @@ library , Streamly.Data.Fold , Streamly.Data.Parser , Streamly.Data.Stream + , Streamly.Data.Stream.StreamK , Streamly.Data.Unfold , Streamly.FileSystem.Dir , Streamly.FileSystem.File @@ -413,12 +400,25 @@ library , Streamly.Unicode.Stream , Streamly.Unicode.String - other-modules: Streamly.Data.Stream.Zip - if flag(dev) exposed-modules: - Streamly.Internal.Data.Stream.StreamDK - , Streamly.Internal.Data.Stream.StreamDK.Type + Streamly.Internal.Data.Stream.StreamK.Alt + , Streamly.Internal.Data.Stream.Type + , Streamly.Internal.Data.Stream.Eliminate + , Streamly.Internal.Data.Stream.Enumerate + , Streamly.Internal.Data.Stream.Generate + , Streamly.Internal.Data.Stream.Transform + , Streamly.Internal.Data.Stream.Bottom + , Streamly.Internal.Data.Stream.Exception + , Streamly.Internal.Data.Stream.Expand + , Streamly.Internal.Data.Stream.Lift + , Streamly.Internal.Data.Stream.Reduce + , Streamly.Internal.Data.Stream.Transformer + , Streamly.Internal.Data.Stream.StreamDK + , Streamly.Internal.Data.Stream.Zip + , Streamly.Internal.Data.Stream.Cross + , Streamly.Internal.Data.List + , Streamly.Data.Stream.Zip build-depends: -- streamly-base diff --git a/hie.yaml b/hie.yaml index a80dab829..876349e23 100644 --- a/hie.yaml +++ b/hie.yaml @@ -16,6 +16,12 @@ cradle: config: cradle: cabal: + - path: "./benchmark/Streamly/Benchmark/Data/Array.hs" + component: "bench:Data.Array" + - path: "./benchmark/Streamly/Benchmark/Data/Array/Generic.hs" + component: "bench:Data.Array.Generic" + - path: "./benchmark/Streamly/Benchmark/Data/Array/Mut.hs" + component: "bench:Data.Array.Mut" - path: "./benchmark/Streamly/Benchmark/Data/Array/Stream.hs" component: "bench:Data.Array.Stream" - path: "./benchmark/Streamly/Benchmark/Data/Fold.hs" @@ -34,12 +40,16 @@ cradle: component: "bench:Data.Stream.ToStreamK" - path: "./benchmark/Streamly/Benchmark/Data/Stream/Common.hs" component: "bench:Data.Stream" + - path: "./benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs" + component: "bench:Data.Stream" - path: "./benchmark/Streamly/Benchmark/Data/Stream/Expand.hs" component: "bench:Data.Stream" - path: "./benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs" component: "bench:Data.Stream" - path: "./benchmark/Streamly/Benchmark/Data/Stream/Generate.hs" component: "bench:Data.Stream" + - path: "./benchmark/Streamly/Benchmark/Data/Stream/Lift.hs" + component: "bench:Data.Stream" - path: "./benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs" component: "bench:Data.Stream" - path: "./benchmark/Streamly/Benchmark/Data/Stream/Transform.hs" diff --git a/src/Streamly/Data/Array/Foreign.hs b/src/Streamly/Data/Array/Foreign.hs index 8068a0bd4..77a518f98 100644 --- a/src/Streamly/Data/Array/Foreign.hs +++ b/src/Streamly/Data/Array/Foreign.hs @@ -30,8 +30,8 @@ -- it to IO monad as follows: -- -- >>> import Data.Functor.Identity (Identity, runIdentity) --- >>> s = Stream.fromList [1..10] :: Stream Identity Int --- >>> s1 = Stream.hoist (return . runIdentity) s :: Stream IO Int +-- >>> s = Stream.fromList [1..10] :: SerialT Identity Int +-- >>> s1 = Stream.hoist (return . runIdentity) s :: SerialT IO Int -- >>> Stream.fold Array.write s1 :: IO (Array Int) -- fromList [1,2,3,4,5,6,7,8,9,10] -- @@ -102,7 +102,7 @@ import Streamly.Internal.Data.Array as A -- >>> :set -fno-warn-deprecations -- >>> :set -XFlexibleContexts -- >>> :set -package streamly --- >>> import Streamly.Internal.Data.Stream (Stream) +-- >>> import Streamly.Prelude (SerialT) -- >>> import Streamly.Data.Array (Array) -- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream -- >>> import qualified Streamly.Data.Array as Array diff --git a/src/Streamly/Data/Stream/MkType.hs b/src/Streamly/Data/Stream/MkType.hs index eb3e634b2..bd77fda82 100644 --- a/src/Streamly/Data/Stream/MkType.hs +++ b/src/Streamly/Data/Stream/MkType.hs @@ -37,13 +37,6 @@ -- $(mkZipType "ParZipStream" "parApply" True) -- :} -- --- Example, create a monad type with an interleaving cross product bind: --- --- >>> :{ --- interleaveBind = flip (Stream.concatMapWith Stream.interleave) --- $(mkCrossType "InterleaveStream" "interleaveBind" False) --- :} --- -- Example, create a monad type with an eager concurrent cross product bind: -- -- >>> :{ diff --git a/src/Streamly/Internal/Data/SmallArray.hs b/src/Streamly/Internal/Data/SmallArray.hs index 54012587d..c05b9818d 100644 --- a/src/Streamly/Internal/Data/SmallArray.hs +++ b/src/Streamly/Internal/Data/SmallArray.hs @@ -56,7 +56,6 @@ import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import qualified Streamly.Internal.Data.Stream.StreamD as D import qualified Streamly.Internal.Data.Fold.Type as FL (Fold (..), Step (Done, Partial)) -import qualified Streamly.Internal.Data.Stream.Type as Stream import Streamly.Internal.Data.SmallArray.Type @@ -165,15 +164,15 @@ instance NFData a => NFData (SmallArray a) where fromStreamN :: MonadIO m => Int -> Stream m a -> m (SmallArray a) fromStreamN n m = do when (n < 0) $ error "fromStreamN: negative write count specified" - fromStreamDN n $ D.fromStreamK $ Stream.toStreamK m + fromStreamDN n m {-# INLINE_EARLY read #-} read :: Monad m => SmallArray a -> Stream m a -read = Stream.fromStreamK . D.toStreamK . toStreamD +read = toStreamD {-# INLINE_EARLY readRev #-} readRev :: Monad m => SmallArray a -> Stream m a -readRev = Stream.fromStreamK . D.toStreamK . toStreamDRev +readRev = toStreamDRev {-# INLINE fold #-} fold :: Monad m => Fold m a b -> SmallArray a -> m b diff --git a/src/Streamly/Internal/Data/Stream/Ahead.hs b/src/Streamly/Internal/Data/Stream/Ahead.hs index c47c41bb3..9546d3a9a 100644 --- a/src/Streamly/Internal/Data/Stream/Ahead.hs +++ b/src/Streamly/Internal/Data/Stream/Ahead.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} -- | -- Module : Streamly.Internal.Data.Stream.Ahead @@ -55,7 +56,7 @@ import qualified Streamly.Internal.Data.Stream.StreamK.Type as K , nil, concatMapWith, fromPure, bindWith) import qualified Streamly.Internal.Data.Stream.StreamD.Type as D (mapM, fromStreamK, toStreamK) -import qualified Streamly.Internal.Data.Stream as Stream (toStreamK) +import qualified Streamly.Internal.Data.Stream.Serial as Stream (toStreamK) import Streamly.Internal.Data.Stream.SVar.Generate import Streamly.Internal.Data.SVar diff --git a/src/Streamly/Internal/Data/Stream/Async.hs b/src/Streamly/Internal/Data/Stream/Async.hs index 476fd67e1..65414188a 100644 --- a/src/Streamly/Internal/Data/Stream/Async.hs +++ b/src/Streamly/Internal/Data/Stream/Async.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} #include "inline.hs" @@ -66,7 +67,7 @@ import qualified Streamly.Internal.Data.Stream.StreamK.Type as K , nil, concatMapWith, fromPure, bindWith) import qualified Streamly.Internal.Data.Stream.StreamD.Type as D (Stream(..), Step(..), mapM, toStreamK, fromStreamK) -import qualified Streamly.Internal.Data.Stream as Stream (toStreamK) +import qualified Streamly.Internal.Data.Stream.Serial as Stream (toStreamK) import Streamly.Internal.Data.SVar diff --git a/src/Streamly/Internal/Data/Stream/Concurrent.hs b/src/Streamly/Internal/Data/Stream/Concurrent.hs index f89f6be7c..1933c9f8a 100644 --- a/src/Streamly/Internal/Data/Stream/Concurrent.hs +++ b/src/Streamly/Internal/Data/Stream/Concurrent.hs @@ -110,11 +110,11 @@ import Streamly.Internal.Data.Stream.Channel.Types , concatMapDivK ) import Streamly.Internal.Data.Stream.Channel.Worker (sendWithDoorBell) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.Stream.StreamD (Step(..)) import qualified Streamly.Internal.Data.IORef.Unboxed as Unboxed -import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import qualified Streamly.Internal.Data.Stream.StreamD as D import qualified Streamly.Internal.Data.Stream.StreamK as K import qualified Streamly.Internal.Data.Stream.StreamK.Type as K @@ -206,10 +206,10 @@ _appendGeneric newChan modifier stream1 stream2 = K.concatEffect action toChannelK chan stream1 FirstStops -> do toChannelK chan stream2 - toChannelK chan (K.serial stream1 done) + toChannelK chan (K.append stream1 done) AnyStops -> do - toChannelK chan (K.serial stream2 done) - toChannelK chan (K.serial stream1 done) + toChannelK chan (K.append stream2 done) + toChannelK chan (K.append stream1 done) return $ Stream.toStreamK $ fromChannel chan -- | Create a new channel and add both the streams to it for async evaluation. @@ -319,7 +319,7 @@ parConcatMapChanKAny :: MonadAsync m => Channel m b -> (a -> K.Stream m b) -> K.Stream m a -> K.Stream m b parConcatMapChanKAny chan f stream = let done = K.nilM (stopChannel chan) - run q = concatMapDivK q (\x -> K.serial (f x) done) + run q = concatMapDivK q (\x -> K.append (f x) done) in K.concatMapEffect (`run` stream) (mkEnqueue chan run) {-# INLINE parConcatMapChanKFirst #-} @@ -335,7 +335,7 @@ parConcatMapChanKFirst chan f stream = Just (h, t) -> do q <- mkEnqueue chan run q t - return $ K.serial (f h) done + return $ K.append (f h) done {-# INLINE parConcatMapChanKGeneric #-} parConcatMapChanKGeneric :: MonadAsync m => @@ -771,7 +771,4 @@ tapCount :: -> (Stream m Int -> m b) -> Stream m a -> Stream m a -tapCount predicate f xs = - Stream.fromStreamD - $ tapCountD predicate (f . Stream.fromStreamD) - $ Stream.toStreamD xs +tapCount = tapCountD diff --git a/src/Streamly/Internal/Data/Stream/Concurrent/Channel.hs b/src/Streamly/Internal/Data/Stream/Concurrent/Channel.hs index cce398f28..391840767 100644 --- a/src/Streamly/Internal/Data/Stream/Concurrent/Channel.hs +++ b/src/Streamly/Internal/Data/Stream/Concurrent/Channel.hs @@ -51,7 +51,7 @@ module Streamly.Internal.Data.Stream.Concurrent.Channel where import Streamly.Internal.Control.Concurrent (MonadAsync) -import Streamly.Internal.Data.Stream (Stream, fromStreamK, toStreamK) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Streamly.Internal.Data.Stream.Concurrent.Channel.Operations (fromChannel, fromChannelK, toChannel, toChannelK) @@ -59,7 +59,7 @@ import qualified Streamly.Internal.Data.Stream.Concurrent.Channel.Append as Append import qualified Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave as Interleave -import qualified Streamly.Internal.Data.Stream.StreamK.Type as K +import qualified Streamly.Internal.Data.Stream.StreamK as K import Streamly.Internal.Data.Stream.Concurrent.Channel.Type import Streamly.Internal.Data.Stream.Channel.Types @@ -102,5 +102,5 @@ withChannel :: MonadAsync m => -> (Channel m b -> Stream m a -> Stream m b) -> Stream m b withChannel modifier input evaluator = - let f chan stream = toStreamK $ evaluator chan (fromStreamK stream) - in fromStreamK $ withChannelK modifier (toStreamK input) f + let f chan stream = K.fromStream $ evaluator chan (K.toStream stream) + in K.toStream $ withChannelK modifier (K.fromStream input) f diff --git a/src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hs b/src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hs index 47c43a369..b75a67bbb 100644 --- a/src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hs +++ b/src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hs @@ -34,11 +34,11 @@ import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef) import Data.Maybe (isNothing) import Streamly.Internal.Control.Concurrent (MonadAsync, MonadRunInIO, askRunInIO) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import System.Mem (performMajorGC) -import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import qualified Streamly.Internal.Data.Stream.StreamD.Type as D import qualified Streamly.Internal.Data.Stream.StreamK.Type as K diff --git a/src/Streamly/Internal/Data/Stream/Exception/Lifted.hs b/src/Streamly/Internal/Data/Stream/Exception/Lifted.hs index 72321c2ba..3548e0657 100644 --- a/src/Streamly/Internal/Data/Stream/Exception/Lifted.hs +++ b/src/Streamly/Internal/Data/Stream/Exception/Lifted.hs @@ -35,7 +35,7 @@ import Data.Map.Strict (Map) import GHC.Exts (inline) import Streamly.Internal.Control.Concurrent (MonadRunInIO, MonadAsync, withRunInIO) -import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.IOFinalizer.Lifted (newIOFinalizer, runIOFinalizer, clearingIOFinalizer) import Streamly.Internal.Data.Stream.StreamD (Step(..)) @@ -153,8 +153,7 @@ bracket3 :: (MonadAsync m, MonadCatch m) -> (b -> m e) -> (b -> Stream m a) -> Stream m a -bracket3 bef aft gc exc bet = fromStreamD $ - bracket3D bef aft exc gc (toStreamD . bet) +bracket3 = bracket3D -- | Run the alloc action @m b@ with async exceptions disabled but keeping -- blocking operations interruptible (see 'Control.Exception.mask'). Use the @@ -236,7 +235,7 @@ after :: (MonadIO m, MonadBaseControl IO m) #endif => m b -> Stream m a -> Stream m a -after action xs = fromStreamD $ afterD action $ toStreamD xs +after = afterD data RetryState emap s1 s2 = RetryWithMap emap s1 @@ -329,5 +328,4 @@ retry :: (MonadCatch m, Exception e, Ord e) -- ^ default handler for those exceptions that are not in the map -> Stream m a -> Stream m a -retry emap handler inp = - fromStreamD $ retryD emap (toStreamD . handler) $ toStreamD inp +retry = retryD diff --git a/src/Streamly/Internal/Data/Stream/IsStream.hs b/src/Streamly/Internal/Data/Stream/IsStream.hs index 5c23d9234..338d9082e 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream.hs @@ -1,5 +1,4 @@ {-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-} -{-# LANGUAGE StandaloneDeriving #-} -- | -- Module : Streamly.Internal.Data.Stream.IsStream @@ -23,15 +22,13 @@ module Streamly.Internal.Data.Stream.IsStream {-# DEPRECATED "Please use \"Stre , module Streamly.Internal.Data.Stream.IsStream.Exception , module Streamly.Internal.Data.Stream.IsStream.Lift , module Streamly.Internal.Data.Stream.IsStream.Top + , fromStream + , toStream ) where -import Control.DeepSeq (NFData(..), NFData1(..)) -import Data.Functor.Identity (Identity(..)) -import Streamly.Internal.Data.Stream.Zip (ZipStream(..)) - import Streamly.Internal.Data.Stream.IsStream.Top -import Streamly.Internal.Data.Stream.IsStream.Eliminate +import Streamly.Internal.Data.Stream.IsStream.Eliminate hiding (toStream) import Streamly.Internal.Data.Stream.IsStream.Exception import Streamly.Internal.Data.Stream.IsStream.Generate import Streamly.Internal.Data.Stream.IsStream.Lift @@ -40,7 +37,14 @@ import Streamly.Internal.Data.Stream.IsStream.Reduce import Streamly.Internal.Data.Stream.IsStream.Transform import Streamly.Internal.Data.Stream.IsStream.Type hiding (cmpBy, drain, eqBy, foldl', fold, toList, toStream - , fromEffect, fromPure, repeat) + , fromEffect, fromPure, repeat, fromStream) -deriving instance NFData a => NFData (ZipStream Identity a) -deriving instance NFData1 (ZipStream Identity) +import qualified Streamly.Internal.Data.Stream.StreamD as D + +{-# INLINE fromStream #-} +fromStream :: (IsStream t, Monad m) => D.Stream m a -> t m a +fromStream = fromStreamD + +{-# INLINE toStream #-} +toStream :: (IsStream t, Monad m) => t m a -> D.Stream m a +toStream = toStreamD diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Common.hs b/src/Streamly/Internal/Data/Stream/IsStream/Common.hs index 52e176203..9b30b547c 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Common.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Common.hs @@ -24,8 +24,7 @@ module Streamly.Internal.Data.Stream.IsStream.Common {-# DEPRECATED "Please use -- * Elimination , foldContinue - , Stream.fold - , Stream.foldBreak + , fold -- * Transformation , map @@ -82,7 +81,6 @@ import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64, addToAbsTime64) import Streamly.Internal.System.IO (defaultChunkSize) import Streamly.Internal.Data.Unboxed (Unbox) -import qualified Streamly.Data.Stream as Stream (fold, foldBreak) import qualified Streamly.Internal.Data.Array.Type as A import qualified Streamly.Internal.Data.Stream.Async as Async import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream @@ -90,10 +88,10 @@ import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (fromPure, fromEffect, repeatMWith, reverse) import qualified Streamly.Internal.Data.Stream.StreamD as D - (repeatM, times, foldContinue, map, scanlMAfter', postscanlMAfter' + (repeatM, timesWith, foldAddLazy, map, scanlMAfter', postscanlMAfter' , postscanlM', take, takeWhile, takeEndBy, drop, findIndices , fromStreamK, toStreamK, concatMapM, concatMap, foldManyPost, splitOnSeq - , zipWithM, zipWith, intersperseM, reverse) + , zipWithM, zipWith, intersperseM, reverse, fold) import Prelude hiding (take, takeWhile, drop, reverse, concatMap, map, zipWith) @@ -231,7 +229,7 @@ repeatMSerial = fromStreamD . D.repeatM -- {-# INLINE timesWith #-} timesWith :: (IsStream t, MonadAsync m) => Double -> t m (AbsTime, RelTime64) -timesWith g = fromStreamD $ D.times g +timesWith g = fromStreamD $ D.timesWith g -- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of -- granularity @g@ specified in seconds. A low granularity clock is more @@ -279,14 +277,40 @@ relTimesWith = fmap snd . timesWith -- number of streams to a given fold efficiently with full stream fusion. For -- example, to fold a list of streams on the same sum fold: -- --- >>> concatFold = Prelude.foldl Stream.foldContinue Fold.sum +-- > concatFold = Prelude.foldl Stream.foldContinue Fold.sum -- --- >>> fold f = Fold.extractM . Stream.foldContinue f +-- > fold f = Fold.extractM . Stream.foldContinue f -- -- /Internal/ {-# INLINE foldContinue #-} foldContinue :: Monad m => Fold m a b -> SerialT m a -> Fold m a b -foldContinue f s = D.foldContinue f $ IsStream.toStreamD s +foldContinue f s = D.foldAddLazy f $ IsStream.toStreamD s + +-- | 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 +-- documentation of individual 'Fold's for termination behavior. +-- +-- >>> Stream.fold Fold.sum (Stream.enumerateFromTo 1 100) +-- 5050 +-- +-- Folds never fail, therefore, they produce a default value even when no input +-- is provided. It means we can always fold an empty stream and get a valid +-- result. For example: +-- +-- >>> Stream.fold Fold.sum Stream.nil +-- 0 +-- +-- However, 'foldMany' on an empty stream results in an empty stream. +-- Therefore, @Stream.fold f@ is not the same as @Stream.head . Stream.foldMany +-- f@. +-- +-- @fold f = Stream.parse (Parser.fromFold f)@ +-- +-- @since 0.7.0 +{-# INLINE fold #-} +fold :: Monad m => Fold m a b -> SerialT m a -> m b +fold fl strm = D.fold fl $ IsStream.toStreamD strm ------------------------------------------------------------------------------ -- Transformation diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs b/src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs index 9654e5f7f..d3854e8a5 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs @@ -25,16 +25,12 @@ module Streamly.Internal.Data.Stream.IsStream.Eliminate {-# DEPRECATED "Please u -- * Running a 'Fold' -- See "Streamly.Internal.Data.Fold". fold - , foldBreak - , foldContinue -- * Running a 'Parser' -- "Streamly.Internal.Data.Parser". - , Stream.parse - , Stream.parseK - , Stream.parseD - , Stream.parseBreak - , Stream.parseBreakD + , parse + , parseK + , parseD -- * Stream Deconstruction -- | foldr and foldl do not provide the remaining stream. 'uncons' is more @@ -44,8 +40,8 @@ module Streamly.Internal.Data.Stream.IsStream.Eliminate {-# DEPRECATED "Please u , uncons -- * Right Folds - , Stream.foldrM - , Stream.foldr + , foldrM + , foldr -- * Left Folds -- Lazy left folds are useful only for reversing the stream @@ -141,7 +137,7 @@ module Streamly.Internal.Data.Stream.IsStream.Eliminate {-# DEPRECATED "Please u -- trimming sequences , stripPrefix -- , stripInfix - , Stream.stripSuffix + , stripSuffix -- * Deprecated , foldx @@ -160,27 +156,29 @@ import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Foreign.Storable (Storable) import Streamly.Internal.Control.Concurrent (MonadAsync) +import Streamly.Internal.Data.Parser (Parser (..)) import Streamly.Internal.Data.SVar (defState) import Streamly.Internal.Data.Stream.IsStream.Common - ( fold, foldBreak, foldContinue, drop, findIndices, reverse, splitOnSeq + ( fold, drop, findIndices, reverse, splitOnSeq , take , takeWhile, mkParallel) import Streamly.Internal.Data.Stream.IsStream.Type - (IsStream, toStreamD, fromStreamD, toStreamD) + (IsStream, fromStreamD, toStreamD) import Streamly.Internal.Data.Stream.Serial (SerialT) import Streamly.Internal.Data.Unboxed (Unbox) -import qualified Streamly.Data.Array as A -import qualified Streamly.Data.Stream as Stream +import qualified Streamly.Internal.Data.Array as A +import qualified Streamly.Internal.Data.Stream.Serial as Stream import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Parser.ParserD as PRD +import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream import qualified Streamly.Internal.Data.Stream.StreamD as D (foldr1, foldlT, foldlM', mapM_, null, head, headElse, last, elem , notElem, all, any, minimum, minimumBy, maximum, maximumBy, the, lookup - , find, findM, toListRev, isPrefixOf, isSubsequenceOf, stripPrefix, (!!)) + , find, findM, toListRev, isPrefixOf, isSubsequenceOf, stripPrefix, (!!) + , fromStreamK, foldrM, parseD) import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (uncons, foldlS, tail, init) -import qualified Streamly.Internal.Data.Stream as Stream - (foldr, toStreamK, parseK, parseD, parseBreakD, foldrM, stripSuffix) import qualified System.IO as IO import Prelude hiding @@ -216,16 +214,6 @@ import Prelude hiding -- the stream one element at a time, therefore, does not take adavantage of -- stream fusion. -- --- 'foldBreak' is a more general way of consuming a stream piecemeal. --- --- >>> :{ --- uncons xs = do --- r <- Stream.foldBreak Fold.one xs --- return $ case r of --- (Nothing, _) -> Nothing --- (Just h, t) -> Just (h, Stream.fromSerial t) --- :} --- -- @since 0.1.0 {-# INLINE uncons #-} uncons :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (a, t m a)) @@ -234,6 +222,46 @@ uncons = fmap (fmap (fmap IsStream.fromStream)) . K.uncons . Stream.toStreamK ------------------------------------------------------------------------------ -- Right Folds ------------------------------------------------------------------------------ + +-- | Right associative/lazy pull fold. @foldrM build final stream@ constructs +-- an output structure using the step function @build@. @build@ is invoked with +-- the next input element and the remaining (lazy) tail of the output +-- structure. It builds a lazy output expression using the two. When the "tail +-- structure" in the output expression is evaluated it calls @build@ again thus +-- lazily consuming the input @stream@ until either the output expression built +-- by @build@ is free of the "tail" or the input is exhausted in which case +-- @final@ is used as the terminating case for the output structure. For more +-- details see the description in the previous section. +-- +-- Example, determine if any element is 'odd' in a stream: +-- +-- >>> Stream.foldrM (\x xs -> if odd x then return True else xs) (return False) $ Stream.fromList (2:4:5:undefined) +-- True +-- +-- /Since: 0.7.0 (signature changed)/ +-- +-- /Since: 0.2.0 (signature changed)/ +-- +-- /Since: 0.1.0/ +{-# INLINE foldrM #-} +foldrM :: Monad m => (a -> m b -> m b) -> m b -> SerialT m a -> m b +foldrM step acc (Stream.SerialT m) = D.foldrM step acc $ D.fromStreamK m + +-- | Right fold, lazy for lazy monads and pure streams, and strict for strict +-- monads. +-- +-- Please avoid using this routine in strict monads like IO unless you need a +-- strict right fold. This is provided only for use in lazy monads (e.g. +-- Identity) or pure streams. Note that with this signature it is not possible +-- to implement a lazy foldr when the monad @m@ is strict. In that case it +-- would be strict in its accumulator and therefore would necessarily consume +-- all its input. +-- +-- @since 0.1.0 +{-# INLINE foldr #-} +foldr :: Monad m => (a -> b -> b) -> b -> SerialT m a -> m b +foldr f z = foldrM (\a b -> f a <$> b) (return z) + -- XXX This seems to be of limited use as it cannot be used to construct -- recursive structures and for reduction foldl1' is better. -- @@ -336,6 +364,48 @@ foldlM' step begin = D.foldlM' step begin . IsStream.toStreamD runSink :: Monad m => Sink m a -> SerialT m a -> m () runSink = fold . toFold -} + +------------------------------------------------------------------------------ +-- Running a Parser +------------------------------------------------------------------------------ + +-- | Parse a stream using the supplied ParserD 'PRD.Parser'. +-- +-- /Internal/ +-- +{-# INLINE_NORMAL parseD #-} +parseD :: Monad m => PRD.Parser a m b -> SerialT m a -> m (Either PRD.ParseError b) +parseD p = D.parseD p . toStreamD + +-- | Parse a stream using the supplied ParserK 'PRK.Parser'. +-- +-- /Internal/ +{-# INLINE parseK #-} +parseK :: Monad m => PRK.Parser a m b -> SerialT m a -> m (Either PRD.ParseError b) +parseK = parse + +-- | Parse a stream using the supplied 'Parser'. +-- +-- Unlike folds, parsers may not always result in a valid output, they may +-- result in an error. For example: +-- +-- >>> Stream.parse (Parser.takeEQ 1 Fold.drain) Stream.nil +-- Left (ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0") +-- +-- Note: +-- +-- @ +-- fold f = Stream.parse (Parser.fromFold f) +-- @ +-- +-- @parse p@ is not the same as @head . parseMany p@ on an empty stream. +-- +-- /Pre-release/ +-- +{-# INLINE [3] parse #-} +parse :: Monad m => Parser a m b -> SerialT m a -> m (Either PRD.ParseError b) +parse = parseD . PRD.fromParserK + ------------------------------------------------------------------------------ -- Specific Fold Functions ------------------------------------------------------------------------------ @@ -563,7 +633,7 @@ product = foldl' (*) 1 -- /Pre-release/ {-# INLINE mconcat #-} mconcat :: (Monad m, Monoid a) => SerialT m a -> m a -mconcat = Stream.foldr mappend mempty +mconcat = foldr mappend mempty -- | -- @ @@ -743,7 +813,7 @@ toHandle h = go -- {-# INLINE toStream #-} toStream :: Monad m => SerialT m a -> m (SerialT n a) -toStream = Stream.foldr IsStream.cons IsStream.nil +toStream = foldr IsStream.cons IsStream.nil -- | Convert a stream to a pure stream in reverse order. -- @@ -923,6 +993,25 @@ stripPrefix stripPrefix m1 m2 = fmap fromStreamD <$> D.stripPrefix (toStreamD m1) (toStreamD m2) +-- | Drops the given suffix from a stream. Returns 'Nothing' if the stream does +-- not end with the given suffix. Returns @Just nil@ when the suffix is the +-- same as the stream. +-- +-- It may be more efficient to convert the stream to an Array and use +-- stripSuffix on that especially if the elements have a Storable or Prim +-- instance. +-- +-- See also "Streamly.Internal.Data.Stream.IsStream.Nesting.dropSuffix". +-- +-- Space: @O(n)@, buffers the entire input stream as well as the suffix +-- +-- /Pre-release/ +{-# INLINE stripSuffix #-} +stripSuffix + :: (Monad m, Eq a) + => SerialT m a -> SerialT m a -> m (Maybe (SerialT m a)) +stripSuffix m1 m2 = fmap reverse <$> stripPrefix (reverse m1) (reverse m2) + ------------------------------------------------------------------------------ -- Comparison ------------------------------------------------------------------------------ diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Exception.hs b/src/Streamly/Internal/Data/Stream/IsStream/Exception.hs index b27683dfd..75dec4ab8 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Exception.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Exception.hs @@ -34,10 +34,10 @@ import Streamly.Internal.Data.Stream.IsStream.Type import qualified Streamly.Internal.Data.Stream.StreamD.Exception as D ( before - , after_ + , afterUnsafe , onException - , bracket_ - , finally_ + , bracketUnsafe + , finallyUnsafe , ghandle , handle ) @@ -86,7 +86,7 @@ before action xs = fromStreamD $ D.before action $ toStreamD xs -- {-# INLINE after_ #-} after_ :: (IsStream t, Monad m) => m b -> t m a -> t m a -after_ action xs = fromStreamD $ D.after_ action $ toStreamD xs +after_ action xs = fromStreamD $ D.afterUnsafe action $ toStreamD xs -- | Run the action @m b@ whenever the stream @t m a@ stops normally, or if it -- is garbage collected after a partial lazy evaluation. @@ -126,7 +126,7 @@ onException action xs = fromStreamD $ D.onException action $ toStreamD xs -- {-# INLINE finally_ #-} finally_ :: (IsStream t, MonadCatch m) => m b -> t m a -> t m a -finally_ action xs = fromStreamD $ D.finally_ action $ toStreamD xs +finally_ action xs = fromStreamD $ D.finallyUnsafe action $ toStreamD xs -- | Run the action @m b@ whenever the stream @t m a@ stops normally, aborts -- due to an exception or if it is garbage collected after a partial lazy @@ -161,7 +161,7 @@ finally action xs = bracket (return ()) (const action) (const xs) bracket_ :: (IsStream t, MonadCatch m) => m b -> (b -> m c) -> (b -> t m a) -> t m a bracket_ bef aft bet = fromStreamD $ - D.bracket_ bef aft (toStreamD . bet) + D.bracketUnsafe bef aft (toStreamD . bet) -- | Run the alloc action @m b@ with async exceptions disabled but keeping -- blocking operations interruptible (see 'Control.Exception.mask'). Use the diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Expand.hs b/src/Streamly/Internal/Data/Stream/IsStream/Expand.hs index ccc0bc511..87087b053 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Expand.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Expand.hs @@ -179,13 +179,13 @@ import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.Serial as Serial import qualified Streamly.Internal.Data.Stream.StreamD as D - (append, interleave, interleaveSuffix, interleaveInfix, interleaveMin - , roundRobin, mergeByM, unfoldMany, unfoldManyInterleave, intersperse - , unfoldManyRoundRobin, interpose, interposeSuffix, gintercalate + (append, interleave, interleaveFstSuffix, interleaveFst, interleaveMin + , roundRobin, mergeByM, unfoldMany, unfoldInterleave, intersperse + , unfoldRoundRobin, interpose, interposeSuffix, gintercalate , gintercalateSuffix, intersperseMSuffix) import qualified Streamly.Internal.Data.Stream.StreamK as K (mergeBy, mergeByM) import qualified Streamly.Internal.Data.Stream.StreamK.Type as K - (interleave, serial, concatPairsWith) + (interleave, append, mergeMapWith) import qualified Streamly.Internal.Data.Stream.ZipAsync as ZipAsync import Prelude hiding (concat, concatMap, zipWith) @@ -250,7 +250,7 @@ infixr 6 `serial` -- @since 0.8.0 {-# INLINE serial #-} serial :: IsStream t => t m a -> t m a -> t m a -serial m1 m2 = fromStream $ K.serial (toStream m1) (toStream m2) +serial m1 m2 = fromStream $ K.append (toStream m1) (toStream m2) ------------------------------------------------------------------------------- -- Interleaving @@ -346,7 +346,7 @@ interleave m1 m2 = fromStreamD $ D.interleave (toStreamD m1) (toStreamD m2) {-# INLINE interleaveSuffix #-} interleaveSuffix ::(IsStream t, Monad m) => t m b -> t m b -> t m b interleaveSuffix m1 m2 = - fromStreamD $ D.interleaveSuffix (toStreamD m1) (toStreamD m2) + fromStreamD $ D.interleaveFstSuffix (toStreamD m1) (toStreamD m2) -- | Interleaves the outputs of two streams, yielding elements from each stream -- alternately, starting from the first stream and ending at the first stream. @@ -370,7 +370,7 @@ interleaveSuffix m1 m2 = {-# INLINE interleaveInfix #-} interleaveInfix ::(IsStream t, Monad m) => t m b -> t m b -> t m b interleaveInfix m1 m2 = - fromStreamD $ D.interleaveInfix (toStreamD m1) (toStreamD m2) + fromStreamD $ D.interleaveFst (toStreamD m1) (toStreamD m2) -- | Interleaves the outputs of two streams, yielding elements from each stream -- alternately, starting from the first stream. The output stops as soon as any @@ -835,7 +835,7 @@ unfoldMany u m = fromStreamD $ D.unfoldMany u (toStreamD m) unfoldManyInterleave ::(IsStream t, Monad m) => Unfold m a b -> t m a -> t m b unfoldManyInterleave u m = - fromStreamD $ D.unfoldManyInterleave u (toStreamD m) + fromStreamD $ D.unfoldInterleave u (toStreamD m) -- | Like 'unfoldMany' but executes the streams in the same way as -- 'roundrobin'. @@ -845,7 +845,7 @@ unfoldManyInterleave u m = unfoldManyRoundRobin ::(IsStream t, Monad m) => Unfold m a b -> t m a -> t m b unfoldManyRoundRobin u m = - fromStreamD $ D.unfoldManyRoundRobin u (toStreamD m) + fromStreamD $ D.unfoldRoundRobin u (toStreamD m) ------------------------------------------------------------------------------ -- Combine N Streams - interpose @@ -863,7 +863,7 @@ unfoldManyRoundRobin u m = interpose :: (IsStream t, Monad m) => c -> Unfold m b c -> t m b -> t m c interpose x unf str = - fromStreamD $ D.interpose (return x) unf (toStreamD str) + fromStreamD $ D.interpose x unf (toStreamD str) -- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x) -- @@ -877,7 +877,7 @@ interpose x unf str = interposeSuffix :: (IsStream t, Monad m) => c -> Unfold m b c -> t m b -> t m c interposeSuffix x unf str = - fromStreamD $ D.interposeSuffix (return x) unf (toStreamD str) + fromStreamD $ D.interposeSuffix x unf (toStreamD str) ------------------------------------------------------------------------------ -- Combine N Streams - intercalate @@ -1013,7 +1013,7 @@ concatPairsWith :: IsStream t => -> t m b concatPairsWith par f m = fromStream - $ K.concatPairsWith + $ K.mergeMapWith (\s1 s2 -> toStream $ fromStream s1 `par` fromStream s2) (toStream . f) (toStream m) diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Generate.hs b/src/Streamly/Internal/Data/Stream/IsStream/Generate.hs index d2e2dedd8..80a0bbe16 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Generate.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Generate.hs @@ -102,7 +102,6 @@ import Streamly.Internal.Data.Stream.IsStream.Common import Streamly.Internal.Data.Stream.IsStream.Type (IsStream (..), fromSerial, consM, fromStreamD) import Streamly.Internal.Data.Stream.Serial (SerialT, WSerialT) -import Streamly.Internal.Data.Stream.Zip (ZipSerialM) import Streamly.Internal.Data.Time.Units (AbsTime , RelTime64, addToAbsTime64) import Streamly.Internal.Data.Unboxed (Unbox) @@ -118,7 +117,7 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (unfoldr, unfoldrMWith, replicateMWith, fromIndicesMWith, iterateMWith , mfix, fromFoldable, fromFoldableM) -import qualified Streamly.Internal.Data.Stream.Type as Stream (fromStreamK) +import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK) import qualified System.IO as IO import Prelude hiding (iterate, replicate, repeat) @@ -241,7 +240,7 @@ unfoldrMWSerial f = fromSerial . Serial.unfoldrM f {-# RULES "unfoldrM zipSerial" unfoldrM = unfoldrMZipSerial #-} {-# INLINE_EARLY unfoldrMZipSerial #-} unfoldrMZipSerial :: MonadAsync m => - (b -> m (Maybe (a, b))) -> b -> ZipSerialM m a + (b -> m (Maybe (a, b))) -> b -> IsStream.ZipSerialM m a unfoldrMZipSerial f = fromSerial . Serial.unfoldrM f ------------------------------------------------------------------------------ diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Lift.hs b/src/Streamly/Internal/Data/Stream/IsStream/Lift.hs index a10f46efa..12abe552d 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Lift.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Lift.hs @@ -35,7 +35,7 @@ import Streamly.Internal.Data.Stream.IsStream.Type import Streamly.Internal.Data.Stream.Serial (SerialT) import qualified Streamly.Internal.Data.Stream.StreamD as D - (hoist, liftInner, runReaderT, evalStateT, runStateT) + (morphInner, liftInner, runReaderT, evalStateT, runStateT) ------------------------------------------------------------------------------ -- Generalize the underlying monad @@ -48,7 +48,7 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D {-# INLINE hoist #-} hoist :: (Monad m, Monad n) => (forall x. m x -> n x) -> SerialT m a -> SerialT n a -hoist f xs = fromStreamD $ D.hoist f (toStreamD xs) +hoist f xs = fromStreamD $ D.morphInner f (toStreamD xs) -- | Generalize the inner monad of the stream from 'Identity' to any monad. -- @@ -56,7 +56,7 @@ hoist f xs = fromStreamD $ D.hoist f (toStreamD xs) -- {-# INLINE generally #-} generally :: (IsStream t, Monad m) => t Identity a -> t m a -generally xs = fromStreamD $ D.hoist (return . runIdentity) (toStreamD xs) +generally xs = fromStreamD $ D.morphInner (return . runIdentity) (toStreamD xs) ------------------------------------------------------------------------------ -- Add and remove a monad transformer diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs b/src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs index 92841be9d..fe64babd2 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs @@ -176,13 +176,14 @@ import Streamly.Internal.Data.Stream.IsStream.Common , fromPure) import Streamly.Internal.Data.Stream.IsStream.Type (IsStream(..), fromStreamD, toStreamD, cons) +import Streamly.Internal.Data.Stream.Serial(toStreamK) import Streamly.Internal.Data.Time.Units ( AbsTime, MilliSecond64(..), addToAbsTime, toRelTime , toAbsTime) import Streamly.Internal.Data.Unboxed (Unbox) import qualified Data.Heap as H -import qualified Streamly.Data.Unfold as Unfold +import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.Data.Array.Type as A (arraysOf, read) import qualified Streamly.Internal.Data.Fold as FL @@ -197,8 +198,8 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D , refoldMany , foldIterateM , refoldIterateM - , parseMany - , parseIterate + , parseManyD + , parseIterateD , groupsBy , groupsRollingBy , wordsBy @@ -387,7 +388,7 @@ parseMany -> t m a -> t m (Either ParseError b) parseMany p m = - fromStreamD $ D.parseMany (PRD.fromParserK p) (toStreamD m) + fromStreamD $ D.parseManyD (PRD.fromParserK p) (toStreamD m) -- | Same as parseMany but for StreamD streams. -- @@ -400,7 +401,7 @@ parseManyD -> t m a -> t m (Either ParseError b) parseManyD p m = - fromStreamD $ D.parseMany p (toStreamD m) + fromStreamD $ D.parseManyD p (toStreamD m) -- | Apply a stream of parsers to an input stream and emit the results in the -- output stream. @@ -455,7 +456,7 @@ parseIterate -> t m a -> t m (Either ParseError b) parseIterate f i m = fromStreamD $ - D.parseIterate (PRD.fromParserK . f) i (toStreamD m) + D.parseIterateD (PRD.fromParserK . f) i (toStreamD m) ------------------------------------------------------------------------------ -- Grouping @@ -846,7 +847,7 @@ splitBySeq :: (IsStream t, MonadAsync m, Storable a, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> t m a -> t m b splitBySeq patt f m = - intersperseM (fold f (A.read patt)) $ splitOnSeq patt f m + intersperseM (fold f (fromStreamD $ A.read patt)) $ splitOnSeq patt f m -- | Like 'splitSuffixBy' but the separator is a sequence of elements, instead -- of a predicate for a single element. @@ -1322,7 +1323,8 @@ classifySessionsByGeneric -> t m (Key f, b) -- ^ session key, fold result classifySessionsByGeneric _ tick reset ejectPred tmout (Fold step initial extract) input = - Expand.unfoldMany (Unfold.lmap sessionOutputStream Unfold.fromStream) + Expand.unfoldMany + (Unfold.lmap (toStreamK . sessionOutputStream) Unfold.fromStreamK) $ scanlMAfter' sstep (return szero) (flush extract) $ interjectSuffix tick (return Nothing) $ map Just input diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Top.hs b/src/Streamly/Internal/Data/Stream/IsStream/Top.hs index ab6766900..0eb7a9923 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Top.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Top.hs @@ -72,8 +72,8 @@ import qualified Data.Map.Strict as Map -- import qualified Streamly.Internal.Data.Array.Generic as Array -- (fromStream, length, read) -- import qualified Streamly.Data.Array.Mut as MA -import qualified Streamly.Internal.Data.Fold as Fold - (one, last, toStream, toStreamRev) +import qualified Streamly.Internal.Data.Fold as Fold (one, last) +import qualified Streamly.Internal.Data.Fold.Type as Fold import qualified Streamly.Internal.Data.Parser as Parser (groupByRollingEither) -- import qualified Streamly.Internal.Data.Stream.IsStream.Lift as Stream @@ -247,8 +247,8 @@ sortBy cmp = let p = Parser.groupByRollingEither (\x -> (< GT) . cmp x) - Fold.toStreamRev - Fold.toStream + (fmap fromStream Fold.toStreamKRev) + (fmap fromStream Fold.toStreamK) in Stream.concatPairsWith (Stream.mergeBy cmp) id . Stream.rights . Stream.parseMany (fmap (either id id) p) diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Transform.hs b/src/Streamly/Internal/Data/Stream/IsStream/Transform.hs index be193523f..1632c3543 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Transform.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Transform.hs @@ -257,8 +257,8 @@ import qualified Streamly.Internal.Data.Stream.Concurrent as Concur import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.Serial as Serial import qualified Streamly.Internal.Data.Stream.StreamD as D - (transform, foldrT, tap, tapOffsetEvery, mapM, scanOnce - , scanMany, postscanOnce, scanlx', scanlM', scanl', postscanl', prescanl' + (transform, foldrT, tap, tapOffsetEvery, mapM, scan + , scanMany, postscan, scanlx', scanlM', scanl', postscanl', prescanl' , prescanlM', scanl1M', scanl1', filter, filterM, uniq, deleteBy, takeWhileM , dropWhile, dropWhileM, insertBy, intersperse , intersperseM_, intersperseMSuffix, intersperseMSuffix_ @@ -631,7 +631,7 @@ trace_ eff = fromStreamD . D.mapM (\x -> eff >> return x) . toStreamD -- @since 0.7.0 {-# INLINE scan #-} scan :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b -scan fld m = fromStreamD $ D.scanOnce fld $ toStreamD m +scan fld m = fromStreamD $ D.scan fld $ toStreamD m -- | Like 'scan' but restarts scanning afresh when the scanning fold -- terminates. @@ -659,7 +659,7 @@ scanMany fld m = fromStreamD $ D.scanMany fld $ toStreamD m -- @since 0.7.0 {-# INLINE postscan #-} postscan :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b -postscan fld = fromStreamD . D.postscanOnce fld . toStreamD +postscan fld = fromStreamD . D.postscan fld . toStreamD ------------------------------------------------------------------------------ -- Scanning - Transformation by Folding diff --git a/src/Streamly/Internal/Data/Stream/IsStream/Type.hs b/src/Streamly/Internal/Data/Stream/IsStream/Type.hs index ba6ce33a5..9fdfed98c 100644 --- a/src/Streamly/Internal/Data/Stream/IsStream/Type.hs +++ b/src/Streamly/Internal/Data/Stream/IsStream/Type.hs @@ -20,6 +20,8 @@ module Streamly.Internal.Data.Stream.IsStream.Type {-# DEPRECATED "Please use \" -- * Type Conversion , fromStreamD , toStreamD + , toStreamK + , fromStreamK , adapt , toConsK @@ -124,9 +126,9 @@ import qualified Streamly.Internal.Data.Stream.StreamD.Type as D import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (Stream(..), cons, fromEffect , nil, fromPure, bindWith, drain - , fromFoldable, consM, nilM, repeat) -import qualified Streamly.Data.Stream as Stream -import qualified Streamly.Internal.Data.Stream as Stream + , fromFoldable, nilM, repeat) +import qualified Streamly.Internal.Data.Stream.StreamK as StreamK +import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK, toStreamK) import qualified Streamly.Internal.Data.Stream.Zip as Zip import qualified Streamly.Internal.Data.Stream.ZipAsync as ZipAsync @@ -201,6 +203,14 @@ class -- Type adapting combinators ------------------------------------------------------------------------------- +{-# INLINE toStreamK #-} +toStreamK :: IsStream t => t m a -> StreamK.StreamK m a +toStreamK = toStream + +{-# INLINE fromStreamK #-} +fromStreamK :: IsStream t => StreamK.StreamK m a -> t m a +fromStreamK = fromStream + -- XXX Move/reset the State here by reconstructing the stream with cleared -- state. Can we make sure we do not do that when t1 = t2? If we do this then -- we do not need to do that explicitly using svarStyle. It would act as @@ -443,7 +453,7 @@ foldStream st yld sng stp m = fromSerial :: IsStream t => SerialT m a -> t m a fromSerial = adapt -instance IsStream Stream.Stream where +instance IsStream SerialT where toStream = Stream.toStreamK fromStream = Stream.fromStreamK @@ -574,8 +584,8 @@ instance IsStream ParallelT where ------------------------------------------------------------------------------- consMZip :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a -consMZip m (Zip.ZipStream r) = - Zip.ZipStream $ Stream.fromStreamK $ K.consM m (Stream.toStreamK r) +consMZip m (Zip.ZipSerialM r) = + Zip.ZipSerialM $ StreamK.consM m r -- | Fix the type of a polymorphic stream as 'ZipSerialM'. -- @@ -585,8 +595,8 @@ consMZip m (Zip.ZipStream r) = fromZipSerial :: IsStream t => ZipSerialM m a -> t m a fromZipSerial = adapt instance IsStream ZipSerialM where - toStream = Stream.toStreamK . Zip.unZipStream - fromStream = Zip.ZipStream . Stream.fromStreamK + toStream = Zip.getZipSerialM + fromStream = Zip.ZipSerialM {-# INLINE consM #-} {-# SPECIALIZE consM :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-} diff --git a/src/Streamly/Internal/Data/Stream/MkType.hs b/src/Streamly/Internal/Data/Stream/MkType.hs index 11c5e157d..384eb9938 100644 --- a/src/Streamly/Internal/Data/Stream/MkType.hs +++ b/src/Streamly/Internal/Data/Stream/MkType.hs @@ -215,6 +215,7 @@ derivOrdIdent _Type = (singleton <$> [t|Ord $(varT _a)|]) (appT (conT _Ord) (foldl1 appT [conT _Type, conT _Identity, varT _a])) +{- derivTraversableIdent :: Name -> Q Dec derivTraversableIdent _Type = standaloneDerivD @@ -222,6 +223,7 @@ derivTraversableIdent _Type = (appT (conT _Traversable) (foldl1 appT [conT _Type, conT _Identity])) +-} showInstance :: Name -> Q Dec showInstance _Type = @@ -503,7 +505,7 @@ flattenDec (ma:mas) = do -- >>> putStrLn $ pprint expr -- newtype ZipStream m a -- = ZipStream (Stream.Stream m a) --- deriving (Semigroup, Monoid, Foldable) +-- deriving Foldable -- mkZipStream :: Stream.Stream m a -> ZipStream m a -- mkZipStream = ZipStream -- unZipStream :: ZipStream m a -> Stream.Stream m a @@ -513,7 +515,6 @@ flattenDec (ma:mas) = do -- GHC.Types.Char => IsString (ZipStream Identity a) -- deriving instance GHC.Classes.Eq a => Eq (ZipStream Identity a) -- deriving instance GHC.Classes.Ord a => Ord (ZipStream Identity a) --- deriving instance Traversable (ZipStream Identity) -- instance Show a => Show (ZipStream Identity a) -- where {-# INLINE show #-} -- show (ZipStream strm) = show strm @@ -535,17 +536,14 @@ mkZipType -> Q [Dec] mkZipType dtNameStr apOpStr isConcurrent = flattenDec - [ typeDec dtNameStr - $ if not isConcurrent - then [_Semigroup, _Monoid, _Foldable] - else [] + [ typeDec dtNameStr [_Foldable | not isConcurrent] , sequence $ if not isConcurrent then [ derivIsListIdent _Type , derivIsStringIdent _Type , derivEqIdent _Type , derivOrdIdent _Type - , derivTraversableIdent _Type + -- , derivTraversableIdent _Type , showInstance _Type , readInstance _Type ] @@ -607,17 +605,14 @@ mkCrossType -> Q [Dec] mkCrossType dtNameStr bindOpStr isConcurrent = flattenDec - [ typeDec dtNameStr - $ if not isConcurrent - then [_Semigroup, _Monoid, _Foldable] - else [] + [ typeDec dtNameStr [_Foldable | not isConcurrent] , sequence $ if not isConcurrent then [ derivIsListIdent _Type , derivIsStringIdent _Type , derivEqIdent _Type , derivOrdIdent _Type - , derivTraversableIdent _Type + -- , derivTraversableIdent _Type , showInstance _Type , readInstance _Type ] diff --git a/src/Streamly/Internal/Data/Stream/Parallel.hs b/src/Streamly/Internal/Data/Stream/Parallel.hs index 05e4189d3..38232f9b4 100644 --- a/src/Streamly/Internal/Data/Stream/Parallel.hs +++ b/src/Streamly/Internal/Data/Stream/Parallel.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} -- | -- Module : Streamly.Internal.Data.Stream.Parallel @@ -11,7 +12,7 @@ -- -- To run examples in this module: -- --- >>> import qualified Streamly.Data.Stream as Stream +-- >>> import qualified Streamly.Prelude as Stream -- >>> import Control.Concurrent (threadDelay) -- >>> :{ -- delay n = do @@ -42,15 +43,10 @@ module Streamly.Internal.Data.Stream.Parallel {-# DEPRECATED "Please use \"Strea -- * Callbacks , newCallbackStream - - -- * Combinators - , interjectSuffix - , takeInterval - , dropInterval ) where -import Control.Concurrent (myThreadId, takeMVar, threadDelay) +import Control.Concurrent (myThreadId, takeMVar) import Control.Monad (when) import Control.Monad.Base (MonadBase(..), liftBaseDefault) import Control.Monad.Catch (MonadThrow, throwM) @@ -61,12 +57,11 @@ import Control.Monad.State.Class (MonadState(..)) import Control.Monad.Trans.Class (MonadTrans(lift)) import Data.Functor (void) import Data.IORef (readIORef, writeIORef) -import Data.Maybe (fromJust, isNothing) +import Data.Maybe (fromJust) import Streamly.Data.Fold (Fold) import Streamly.Internal.Control.Concurrent (MonadAsync) import Streamly.Internal.Data.Stream.StreamD.Type (Step(..)) -import Streamly.Internal.Data.Stream.Type (Stream) import qualified Data.Set as Set import qualified Streamly.Internal.Data.Stream.StreamK.Type as K @@ -76,8 +71,7 @@ import qualified Streamly.Internal.Data.Stream.StreamD.Type as D (Stream(..), mapM, toStreamK, fromStreamK) import qualified Streamly.Internal.Data.Stream.SVar.Generate as SVar import qualified Streamly.Internal.Data.Stream.SVar.Eliminate as SVar -import qualified Streamly.Internal.Data.Stream as Stream - (catMaybes, dropWhile, fromStreamK, repeat, sequence, takeWhile, toStreamK) +import qualified Streamly.Internal.Data.Stream.Serial as Stream import Streamly.Internal.Data.SVar import Prelude hiding (map) @@ -87,7 +81,7 @@ import Prelude hiding (map) -- -- $setup --- >>> import qualified Streamly.Data.Stream as Stream +-- >>> import qualified Streamly.Prelude as Stream -- >>> import Control.Concurrent (threadDelay) -- >>> :{ -- delay n = do @@ -538,87 +532,3 @@ newCallbackStream = do -- XXX we can return an SVar and then the consumer can unfold from the -- SVar? return (callback, D.toStreamK (SVar.fromSVarD sv)) - ------------------------------------------------------------------------------- --- Combinators ------------------------------------------------------------------------------- - -{-# INLINE parallelFst #-} -parallelFst :: MonadAsync m => Stream m a -> Stream m a -> Stream m a -parallelFst m1 m2 = - Stream.fromStreamK - $ parallelFstK (Stream.toStreamK m1) (Stream.toStreamK m2) - --- | Intersperse a monadic action into the input stream after every @n@ --- seconds. --- --- >>> import qualified Streamly.Data.Fold as Fold --- >>> import qualified Streamly.Internal.Data.Stream.Parallel as Parallel --- >>> Stream.fold Fold.drain $ Parallel.interjectSuffix 1.05 (putChar ',') $ Stream.mapM (\x -> threadDelay 1000000 >> putChar x) $ Stream.fromList "hello" --- h,e,l,l,o --- --- /Pre-release/ -{-# INLINE interjectSuffix #-} -interjectSuffix :: MonadAsync m => Double -> m a -> Stream m a -> Stream m a -interjectSuffix n f xs = xs `parallelFst` repeatM timed - where timed = liftIO (threadDelay (round $ n * 1000000)) >> f - repeatM = Stream.sequence . Stream.repeat - --- XXX Notes from D.takeByTime (which was removed) --- XXX using getTime in the loop can be pretty expensive especially for --- computations where iterations are lightweight. We have the following --- options: --- --- 1) Run a timeout thread updating a flag asynchronously and check that --- flag here, that way we can have a cheap termination check. --- --- 2) Use COARSE clock to get time with lower resolution but more efficiently. --- --- 3) Use rdtscp/rdtsc to get time directly from the processor, compute the --- termination value of rdtsc in the beginning and then in each iteration just --- get rdtsc and check if we should terminate. - - --- | @takeInterval duration@ yields stream elements upto specified time --- @duration@ in seconds. The duration starts when the stream is evaluated for --- the first time, before the first element is yielded. The time duration is --- checked before generating each element, if the duration has expired the --- stream stops. --- --- The total time taken in executing the stream is guaranteed to be /at least/ --- @duration@, however, because the duration is checked before generating an --- element, the upper bound is indeterminate and depends on the time taken in --- generating and processing the last element. --- --- No element is yielded if the duration is zero. At least one element is --- yielded if the duration is non-zero. --- --- /Pre-release/ --- -{-# INLINE takeInterval #-} -takeInterval :: MonadAsync m => Double -> Stream m a -> Stream m a -takeInterval d = - Stream.catMaybes - . Stream.takeWhile isNothing - . interjectSuffix d (return Nothing) . fmap Just - --- | @dropInterval duration@ drops stream elements until specified @duration@ in --- seconds has passed. The duration begins when the stream is evaluated for the --- first time. The time duration is checked /after/ generating a stream element, --- the element is yielded if the duration has expired otherwise it is dropped. --- --- The time elapsed before starting to generate the first element is /at most/ --- @duration@, however, because the duration expiry is checked after the --- element is generated, the lower bound is indeterminate and depends on the --- time taken in generating an element. --- --- All elements are yielded if the duration is zero. --- --- /Pre-release/ --- -{-# INLINE dropInterval #-} -dropInterval :: MonadAsync m => Double -> Stream m a -> Stream m a -dropInterval d = - Stream.catMaybes - . Stream.dropWhile isNothing - . interjectSuffix d (return Nothing) . fmap Just diff --git a/src/Streamly/Internal/Data/Stream/SVar/Eliminate.hs b/src/Streamly/Internal/Data/Stream/SVar/Eliminate.hs index 7eaa7d553..3283dce8d 100644 --- a/src/Streamly/Internal/Data/Stream/SVar/Eliminate.hs +++ b/src/Streamly/Internal/Data/Stream/SVar/Eliminate.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-deprecations #-} -- | -- Module : Streamly.Internal.Data.Stream.SVar.Eliminate -- Copyright : (c) 2017 Composewell Technologies @@ -36,14 +37,14 @@ import Streamly.Internal.Control.ForkLifted (doFork) import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS_) import Streamly.Internal.Data.Fold.SVar (write, writeLimited) import Streamly.Internal.Data.Fold.Type (Fold(..)) -import Streamly.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.Serial (SerialT) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import qualified Streamly.Internal.Data.Stream.StreamD.Type as D (Stream(..), Step(..), fold) import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (Stream(..), mkStream, foldStream, foldStreamShared, nilM) -import qualified Streamly.Internal.Data.Stream.Type as Stream +import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK, toStreamK) import Streamly.Internal.Data.SVar @@ -210,7 +211,7 @@ fromProducer sv = K.mkStream $ \st yld sng stp -> do -- {-# INLINE newFoldSVar #-} newFoldSVar :: MonadAsync m - => State K.Stream m a -> (Stream m a -> m b) -> m (SVar K.Stream m a) + => State K.Stream m a -> (SerialT m a -> m b) -> m (SVar K.Stream m a) newFoldSVar stt f = do -- Buffer size for the SVar is derived from the current state sv <- newParallelVar StopAny (adaptState stt) @@ -372,7 +373,7 @@ pushToFold sv a = do -- {-# INLINE teeToSVar #-} teeToSVar :: MonadAsync m => - SVar K.Stream m a -> Stream m a -> Stream m a + SVar K.Stream m a -> SerialT m a -> SerialT m a teeToSVar svr m = Stream.fromStreamK $ K.mkStream $ \st yld sng stp -> do K.foldStreamShared st yld sng stp (go False $ Stream.toStreamK m) diff --git a/src/Streamly/Internal/Data/Stream/SVar/Generate.hs b/src/Streamly/Internal/Data/Stream/SVar/Generate.hs index 4c976a14e..c8b0ff2a3 100644 --- a/src/Streamly/Internal/Data/Stream/SVar/Generate.hs +++ b/src/Streamly/Internal/Data/Stream/SVar/Generate.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-deprecations #-} #ifdef __HADDOCK_VERSION__ #undef INSPECTION #endif @@ -38,7 +39,7 @@ import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef) import Data.Maybe (isNothing) import Streamly.Internal.Control.Concurrent (MonadAsync, askRunInIO) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.Serial (SerialT) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import System.Mem (performMajorGC) @@ -46,7 +47,7 @@ import qualified Streamly.Internal.Data.Stream.StreamD.Type as D (Stream(..), Step(..)) import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (Stream(..), foldStreamShared, mkStream, foldStream) -import qualified Streamly.Internal.Data.Stream.Type as Stream (fromStreamK) +import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK) import Streamly.Internal.Data.SVar @@ -90,7 +91,7 @@ import Test.Inspection (inspect, hasNoTypeClassesExcept) -- XXX this errors out for Parallel/Ahead SVars -- | Write a stream to an 'SVar' in a non-blocking manner. The stream can then -- be read back from the SVar using 'fromSVar'. -toSVar :: MonadAsync m => SVar Stream m a -> Stream m a -> m () +toSVar :: MonadAsync m => SVar SerialT m a -> SerialT m a -> m () toSVar sv m = do runIn <- askRunInIO liftIO $ enqueue sv (runIn, m) @@ -185,7 +186,7 @@ inspect $ hasNoTypeClassesExcept 'fromStreamVar -- combinators. -- {-# INLINE fromSVar #-} -fromSVar :: MonadAsync m => SVar K.Stream m a -> Stream m a +fromSVar :: MonadAsync m => SVar K.Stream m a -> SerialT m a fromSVar sv = Stream.fromStreamK $ K.mkStream $ \st yld sng stp -> do ref <- liftIO $ newIORef () diff --git a/src/Streamly/Internal/Data/Stream/Serial.hs b/src/Streamly/Internal/Data/Stream/Serial.hs index c2493a2b1..c2c65816c 100644 --- a/src/Streamly/Internal/Data/Stream/Serial.hs +++ b/src/Streamly/Internal/Data/Stream/Serial.hs @@ -12,13 +12,14 @@ -- -- To run examples in this module: -- --- >>> import qualified Streamly.Data.Stream as Stream --- >>> import qualified Streamly.Prelude as IsStream +-- >>> import qualified Streamly.Prelude as Stream -- module Streamly.Internal.Data.Stream.Serial {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream\" from streamly-core package instead." #-} ( -- * Serial appending stream - SerialT + SerialT(..) + , toStreamK + , fromStreamK , Serial , serial @@ -31,10 +32,10 @@ module Streamly.Internal.Data.Stream.Serial {-# DEPRECATED "Please use \"Streaml , consMWSerial -- * Construction - , Stream.cons - , Stream.consM - , Stream.repeat - , Stream.unfoldrM + , cons + , consM + , repeat + , unfoldrM , fromList -- * Elimination @@ -42,7 +43,7 @@ module Streamly.Internal.Data.Stream.Serial {-# DEPRECATED "Please use \"Streaml -- * Transformation , map - , Stream.mapM + , mapM ) where @@ -64,18 +65,13 @@ import Text.Read , readListPrecDefault) import Streamly.Internal.BaseCompat ((#.)) import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe) -import Streamly.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamK.Type (Stream) -import qualified Streamly.Data.Fold as Fold -import qualified Streamly.Data.Stream as Stream -import qualified Streamly.Internal.Data.Stream as Stream - (toStreamK, fromStreamK, crossApply, crossApplySnd, crossApplyFst) import qualified Streamly.Internal.Data.Stream.Common as P -import qualified Streamly.Internal.Data.Stream.StreamD as D - (fromStreamK, toStreamK, mapM) +import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D +import qualified Streamly.Internal.Data.Stream.StreamD.Transform as D +import qualified Streamly.Internal.Data.Stream.StreamD.Type as D import qualified Streamly.Internal.Data.Stream.StreamK.Type as K - (Stream, mkStream, foldStream, cons, consM, nil, concatMapWith, fromPure - , bindWith, interleave, interleaveFst, interleaveMin, serial, fromEffect) import Prelude hiding (map, mapM, repeat, filter) @@ -84,7 +80,6 @@ import Prelude hiding (map, mapM, repeat, filter) -- $setup -- >>> :set -fno-warn-deprecations --- >>> import qualified Streamly.Data.Stream as Stream -- >>> import qualified Streamly.Prelude as IsStream {-# INLINABLE withLocal #-} @@ -95,102 +90,42 @@ withLocal f m = yieldk a r = local f $ yld a (withLocal f r) in K.foldStream st yieldk single (local f stp) m ------------------------------------------------------------------------------- --- Applicative - orphan instances ------------------------------------------------------------------------------- - --- Note: we need to define all the typeclass operations because we want to --- INLINE them. -instance Monad m => Applicative (Stream m) where - {-# INLINE pure #-} - pure = Stream.fromStreamK . K.fromPure - - {-# INLINE (<*>) #-} - (<*>) = Stream.crossApply - -- (<*>) = K.apSerial - - {-# INLINE liftA2 #-} - liftA2 f x = (<*>) (fmap f x) - - {-# INLINE (*>) #-} - (*>) = Stream.crossApplySnd - -- (*>) = K.apSerialDiscardFst - - {-# INLINE (<*) #-} - (<*) = Stream.crossApplyFst - -- (<*) = K.apSerialDiscardSnd - ------------------------------------------------------------------------------- --- Monad - orphan instances ------------------------------------------------------------------------------- - -instance Monad m => Monad (Stream m) where - return = pure - - -- Benchmarks better with StreamD bind and pure: - -- toList, filterAllout, *>, *<, >> (~2x) - -- - -- pure = Stream . D.fromStreamD . D.fromPure - -- m >>= f = D.fromStreamD $ D.concatMap (D.toStreamD . f) (D.toStreamD m) - - -- Benchmarks better with CPS bind and pure: - -- Prime sieve (25x) - -- n binds, breakAfterSome, filterAllIn, state transformer (~2x) - -- - {-# INLINE (>>=) #-} - (>>=) m f = - Stream.fromStreamK - $ K.bindWith K.serial (Stream.toStreamK m) (Stream.toStreamK . f) - - {-# INLINE (>>) #-} - (>>) = (*>) - ------------------------------------------------------------------------------- --- Transformers - orphan instances ------------------------------------------------------------------------------- - -instance (MonadIO m) => MonadIO (Stream m) where - liftIO = lift . liftIO - -instance (MonadThrow m) => MonadThrow (Stream m) where - throwM = lift . throwM - -instance MonadTrans Stream where - {-# INLINE lift #-} - lift = Stream.fromEffect - -instance (MonadReader r m) => MonadReader r (Stream m) where - ask = lift ask - - local f m = Stream.fromStreamK $ withLocal f (Stream.toStreamK m) - -instance (MonadState s m) => MonadState s (Stream m) where - {-# INLINE get #-} - get = lift get - - {-# INLINE put #-} - put x = lift (put x) - - {-# INLINE state #-} - state k = lift (state k) - ------------------------------------------------------------------------------- --- NFData - orphan instances ------------------------------------------------------------------------------- - -instance NFData a => NFData (Stream Identity a) where - {-# INLINE rnf #-} - rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs - -instance NFData1 (Stream Identity) where - {-# INLINE liftRnf #-} - liftRnf f xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> f x) ()) xs - ------------------------------------------------------------------------------ -- SerialT ------------------------------------------------------------------------------ -type SerialT = Stream +-- | For 'SerialT' streams: +-- +-- @ +-- (<>) = 'Streamly.Prelude.serial' -- 'Semigroup' +-- (>>=) = flip . 'Streamly.Prelude.concatMapWith' 'Streamly.Prelude.serial' -- 'Monad' +-- @ +-- +-- A single 'Monad' bind behaves like a @for@ loop: +-- +-- >>> :{ +-- IsStream.toList $ do +-- x <- IsStream.fromList [1,2] -- foreach x in stream +-- return x +-- :} +-- [1,2] +-- +-- Nested monad binds behave like nested @for@ loops: +-- +-- >>> :{ +-- IsStream.toList $ do +-- x <- IsStream.fromList [1,2] -- foreach x in stream +-- y <- IsStream.fromList [3,4] -- foreach y in stream +-- return (x, y) +-- :} +-- [(1,3),(1,4),(2,3),(2,4)] +-- +-- /Since: 0.2.0 ("Streamly")/ +-- +-- @since 0.8.0 +newtype SerialT m a = SerialT {getSerialT :: Stream m a} + -- XXX when deriving do we inherit an INLINE? + deriving (Semigroup, Monoid) -- | A serial IO stream of elements of type @a@. See 'SerialT' documentation -- for more details. @@ -200,6 +135,36 @@ type SerialT = Stream -- @since 0.8.0 type Serial = SerialT IO +toStreamK :: SerialT m a -> Stream m a +toStreamK = getSerialT + +fromStreamK :: Stream m a -> SerialT m a +fromStreamK = SerialT + +------------------------------------------------------------------------------ +-- Generation +------------------------------------------------------------------------------ + +infixr 5 `cons` + +{-# INLINE cons #-} +cons :: a -> SerialT m a -> SerialT m a +cons x (SerialT ms) = SerialT $ K.cons x ms + +infixr 5 `consM` + +{-# INLINE consM #-} +{-# SPECIALIZE consM :: IO a -> SerialT IO a -> SerialT IO a #-} +consM :: Monad m => m a -> SerialT m a -> SerialT m a +consM m (SerialT ms) = SerialT $ K.consM m ms + +-- | +-- Generate an infinite stream by repeating a pure value. +-- +{-# INLINE_NORMAL repeat #-} +repeat :: Monad m => a -> SerialT m a +repeat = SerialT . D.toStreamK . D.repeat + ------------------------------------------------------------------------------ -- Combining ------------------------------------------------------------------------------ @@ -208,6 +173,41 @@ type Serial = SerialT IO serial :: SerialT m a -> SerialT m a -> SerialT m a serial = (<>) +------------------------------------------------------------------------------ +-- Monad +------------------------------------------------------------------------------ + +instance Monad m => Monad (SerialT m) where + return = pure + + -- Benchmarks better with StreamD bind and pure: + -- toList, filterAllout, *>, *<, >> (~2x) + -- + -- pure = SerialT . D.fromStreamD . D.fromPure + -- m >>= f = D.fromStreamD $ D.concatMap (D.toStreamD . f) (D.toStreamD m) + + -- Benchmarks better with CPS bind and pure: + -- Prime sieve (25x) + -- n binds, breakAfterSome, filterAllIn, state transformer (~2x) + -- + {-# INLINE (>>=) #-} + (>>=) (SerialT m) f = SerialT $ K.bindWith K.append m (getSerialT . f) + + {-# INLINE (>>) #-} + (>>) = (*>) + +instance MonadTrans SerialT where + {-# INLINE lift #-} + lift = SerialT . K.fromEffect + +------------------------------------------------------------------------------ +-- Other instances +------------------------------------------------------------------------------ + +{-# INLINE mapM #-} +mapM :: Monad m => (a -> m b) -> SerialT m a -> SerialT m b +mapM f (SerialT m) = SerialT $ D.toStreamK $ D.mapM f $ D.fromStreamK m + -- | -- @ -- map = fmap @@ -223,7 +223,49 @@ serial = (<>) -- @since 0.4.0 {-# INLINE map #-} map :: Monad m => (a -> b) -> SerialT m a -> SerialT m b -map f = Stream.mapM (return . f) +map f = mapM (return . f) + +{-# INLINE apSerial #-} +apSerial :: Monad m => SerialT m (a -> b) -> SerialT m a -> SerialT m b +apSerial (SerialT m1) (SerialT m2) = + SerialT $ D.toStreamK $ D.fromStreamK m1 `D.crossApply` D.fromStreamK m2 + +{-# INLINE apSequence #-} +apSequence :: Monad m => SerialT m a -> SerialT m b -> SerialT m b +apSequence (SerialT m1) (SerialT m2) = + SerialT $ D.toStreamK $ D.fromStreamK m1 `D.crossApplySnd` D.fromStreamK m2 + +{-# INLINE apDiscardSnd #-} +apDiscardSnd :: Monad m => SerialT m a -> SerialT m b -> SerialT m a +apDiscardSnd (SerialT m1) (SerialT m2) = + SerialT $ D.toStreamK $ D.fromStreamK m1 `D.crossApplyFst` D.fromStreamK m2 + +-- Note: we need to define all the typeclass operations because we want to +-- INLINE them. +instance Monad m => Applicative (SerialT m) where + {-# INLINE pure #-} + pure = SerialT . K.fromPure + + {-# INLINE (<*>) #-} + (<*>) = apSerial + -- (<*>) = K.apSerial + + {-# INLINE liftA2 #-} + liftA2 f x = (<*>) (fmap f x) + + {-# INLINE (*>) #-} + (*>) = apSequence + -- (*>) = K.apSerialDiscardFst + + {-# INLINE (<*) #-} + (<*) = apDiscardSnd + -- (<*) = K.apSerialDiscardSnd + +MONAD_COMMON_INSTANCES(SerialT,) +LIST_INSTANCES(SerialT) +NFDATA1_INSTANCE(SerialT) +FOLDABLE_INSTANCE(SerialT) +TRAVERSABLE_INSTANCE(SerialT) ------------------------------------------------------------------------------ -- WSerialT @@ -267,12 +309,12 @@ map f = Stream.mapM (return . f) -- [(1,3),(2,3),(1,4),(2,4)] -- -- The @W@ in the name stands for @wide@ or breadth wise scheduling in --- contrast to the depth wise scheduling behavior of 'Stream'. +-- contrast to the depth wise scheduling behavior of 'SerialT'. -- -- /Since: 0.2.0 ("Streamly")/ -- -- @since 0.8.0 -newtype WSerialT m a = WSerialT {getWSerialT :: K.Stream m a} +newtype WSerialT m a = WSerialT {getWSerialT :: Stream m a} instance MonadTrans WSerialT where {-# INLINE lift #-} @@ -370,3 +412,32 @@ LIST_INSTANCES(WSerialT) NFDATA1_INSTANCE(WSerialT) FOLDABLE_INSTANCE(WSerialT) TRAVERSABLE_INSTANCE(WSerialT) + +------------------------------------------------------------------------------ +-- Construction +------------------------------------------------------------------------------ + +-- | Build a stream by unfolding a /monadic/ step function starting from a +-- seed. The step function returns the next element in the stream and the next +-- seed value. When it is done it returns 'Nothing' and the stream ends. For +-- example, +-- +-- @ +-- let f b = +-- if b > 3 +-- then return Nothing +-- else print b >> return (Just (b, b + 1)) +-- in drain $ unfoldrM f 0 +-- @ +-- @ +-- 0 +-- 1 +-- 2 +-- 3 +-- @ +-- +-- /Pre-release/ +-- +{-# INLINE unfoldrM #-} +unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> SerialT m a +unfoldrM step seed = SerialT $ D.toStreamK (D.unfoldrM step seed) diff --git a/src/Streamly/Internal/Data/Stream/Time.hs b/src/Streamly/Internal/Data/Stream/Time.hs index 49061f832..f7b71aa6b 100644 --- a/src/Streamly/Internal/Data/Stream/Time.hs +++ b/src/Streamly/Internal/Data/Stream/Time.hs @@ -62,7 +62,7 @@ import Data.Proxy (Proxy(..)) import Streamly.Data.Fold (Fold) import Streamly.Internal.Data.Fold.Type (Fold (..)) import Streamly.Internal.Data.IsMap (IsMap(..)) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.Time.Units ( AbsTime , MilliSecond64(..) @@ -78,7 +78,7 @@ import qualified Streamly.Data.Stream as Stream import qualified Streamly.Data.Unfold as Unfold import qualified Streamly.Internal.Data.Fold as Fold (Step(..)) import qualified Streamly.Internal.Data.IsMap as IsMap -import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.StreamD as Stream ( scanlMAfter' , timeIndexed , timestamped @@ -392,7 +392,7 @@ ejectEntry :: (Monad m, IsMap f) => -> m (heap, f entry, Stream m (Key f, b), Int) ejectEntry extract hp mp out cnt acc key = do sess <- extract acc - let out1 = (key, sess) `Stream.cons` out + let out1 = Stream.cons (key, sess) out let mp1 = IsMap.mapDelete key mp return (hp, mp1, out1, cnt - 1) diff --git a/src/Streamly/Internal/Data/Stream/Zip.hs b/src/Streamly/Internal/Data/Stream/Zip.hs new file mode 100644 index 000000000..1c7cfef93 --- /dev/null +++ b/src/Streamly/Internal/Data/Stream/Zip.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-deprecations #-} + +-- | +-- Module : Streamly.Internal.Data.Stream.Zip +-- Copyright : (c) 2017 Composewell Technologies +-- +-- License : BSD3 +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC +-- +-- To run examples in this module: +-- +-- >>> import qualified Streamly.Prelude as Stream +-- +module Streamly.Internal.Data.Stream.Zip + ( + ZipSerialM (..) + , ZipSerial + , consMZip + , zipWithK + , zipWithMK + + -- * Deprecated + , ZipStream + ) +where + +import Control.Applicative (liftA2) +import Control.DeepSeq (NFData(..)) +#if MIN_VERSION_deepseq(1,4,3) +import Control.DeepSeq (NFData1(..)) +#endif +import Data.Foldable (Foldable(foldl'), fold) +import Data.Functor.Identity (Identity(..), runIdentity) +import Data.Maybe (fromMaybe) +import Data.Semigroup (Endo(..)) +#if __GLASGOW_HASKELL__ < 808 +import Data.Semigroup (Semigroup(..)) +#endif +import GHC.Exts (IsList(..), IsString(..), oneShot) +import Text.Read + ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec + , readListPrecDefault) +import Streamly.Internal.BaseCompat ((#.)) +import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe) +import Streamly.Internal.Data.Stream.Serial (SerialT(..)) +import Streamly.Internal.Data.Stream.StreamK.Type (Stream) + +import qualified Streamly.Internal.Data.Stream.Common as P +import qualified Streamly.Internal.Data.Stream.StreamK.Type as K +import qualified Streamly.Internal.Data.Stream.StreamD as D +import qualified Streamly.Internal.Data.Stream.Serial as Serial + +import Prelude hiding (map, repeat, zipWith) + +#include "Instances.hs" + +-- $setup +-- >>> import qualified Streamly.Prelude as Stream +-- >>> import Control.Concurrent (threadDelay) +-- >>> :{ +-- delay n = do +-- threadDelay (n * 1000000) -- sleep for n seconds +-- putStrLn (show n ++ " sec") -- print "n sec" +-- return n -- IO Int +-- :} + +{-# INLINE zipWithMK #-} +zipWithMK :: Monad m => + (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c +zipWithMK f m1 m2 = + D.toStreamK $ D.zipWithM f (D.fromStreamK m1) (D.fromStreamK m2) + +{-# INLINE zipWithK #-} +zipWithK :: Monad m + => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c +zipWithK f = zipWithMK (\a b -> return (f a b)) + +------------------------------------------------------------------------------ +-- Serially Zipping Streams +------------------------------------------------------------------------------ + +-- | For 'ZipSerialM' streams: +-- +-- @ +-- (<>) = 'Streamly.Prelude.serial' +-- (<*>) = 'Streamly.Prelude.serial.zipWith' id +-- @ +-- +-- Applicative evaluates the streams being zipped serially: +-- +-- >>> s1 = Stream.fromFoldable [1, 2] +-- >>> s2 = Stream.fromFoldable [3, 4] +-- >>> s3 = Stream.fromFoldable [5, 6] +-- >>> Stream.toList $ Stream.fromZipSerial $ (,,) <$> s1 <*> s2 <*> s3 +-- [(1,3,5),(2,4,6)] +-- +-- /Since: 0.2.0 ("Streamly")/ +-- +-- @since 0.8.0 +newtype ZipSerialM m a = ZipSerialM {getZipSerialM :: Stream m a} + deriving (Semigroup, Monoid) + +-- | +-- @since 0.1.0 +{-# DEPRECATED ZipStream "Please use 'ZipSerialM' instead." #-} +type ZipStream = ZipSerialM + +-- | An IO stream whose applicative instance zips streams serially. +-- +-- /Since: 0.2.0 ("Streamly")/ +-- +-- @since 0.8.0 +type ZipSerial = ZipSerialM IO + +consMZip :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a +consMZip m (ZipSerialM r) = ZipSerialM $ K.consM m r + +LIST_INSTANCES(ZipSerialM) +NFDATA1_INSTANCE(ZipSerialM) + +instance Monad m => Functor (ZipSerialM m) where + {-# INLINE fmap #-} + fmap f (ZipSerialM m) = ZipSerialM $ getSerialT $ fmap f (SerialT m) + +instance Monad m => Applicative (ZipSerialM m) where + pure = ZipSerialM . getSerialT . Serial.repeat + + {-# INLINE (<*>) #-} + ZipSerialM m1 <*> ZipSerialM m2 = ZipSerialM $ zipWithK id m1 m2 + +FOLDABLE_INSTANCE(ZipSerialM) +TRAVERSABLE_INSTANCE(ZipSerialM) diff --git a/src/Streamly/Internal/Data/Stream/Zip/Concurrent.hs b/src/Streamly/Internal/Data/Stream/Zip/Concurrent.hs index 7c65d9a73..674359e01 100644 --- a/src/Streamly/Internal/Data/Stream/Zip/Concurrent.hs +++ b/src/Streamly/Internal/Data/Stream/Zip/Concurrent.hs @@ -18,10 +18,10 @@ module Streamly.Internal.Data.Stream.Zip.Concurrent ) where -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Streamly.Internal.Data.Stream.Concurrent (MonadAsync, parZipWith) -import qualified Streamly.Internal.Data.Stream as Stream (repeat) +import qualified Streamly.Internal.Data.Stream.StreamD as Stream (repeat) import Prelude hiding (map, repeat, zipWith) -- $setup diff --git a/src/Streamly/Internal/Data/Stream/ZipAsync.hs b/src/Streamly/Internal/Data/Stream/ZipAsync.hs index f1f00bf9d..23449bfe3 100644 --- a/src/Streamly/Internal/Data/Stream/ZipAsync.hs +++ b/src/Streamly/Internal/Data/Stream/ZipAsync.hs @@ -31,7 +31,7 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D (fromStreamK) import qualified Streamly.Internal.Data.Stream.Serial as Serial import qualified Streamly.Internal.Data.Stream.SVar.Eliminate as SVar import qualified Streamly.Internal.Data.Stream.SVar.Generate as SVar -import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK, toStreamK) import Streamly.Internal.Data.SVar diff --git a/src/Streamly/Internal/FileSystem/Event.hs b/src/Streamly/Internal/FileSystem/Event.hs index bd50389e3..c90574a5d 100644 --- a/src/Streamly/Internal/FileSystem/Event.hs +++ b/src/Streamly/Internal/FileSystem/Event.hs @@ -48,7 +48,7 @@ where import Data.List.NonEmpty (NonEmpty) import Data.Word (Word8) import Streamly.Internal.Data.Array (Array) -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) #if defined(CABAL_OS_DARWIN) import Streamly.Internal.FileSystem.Event.Darwin (Event) diff --git a/src/Streamly/Internal/FileSystem/Event/Linux.hs b/src/Streamly/Internal/FileSystem/Event/Linux.hs index 894cad1ca..29d2176df 100644 --- a/src/Streamly/Internal/FileSystem/Event/Linux.hs +++ b/src/Streamly/Internal/FileSystem/Event/Linux.hs @@ -171,7 +171,7 @@ import Foreign.Storable (peek, peekByteOff, sizeOf) import GHC.IO.Device (IODeviceType(Stream)) import GHC.IO.FD (fdFD, mkFD) import GHC.IO.Handle.FD (mkHandleFromFD) -import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.Data.Stream.StreamD (Stream) import Streamly.Internal.Data.Parser (Parser) import Streamly.Internal.Data.Array.Type (Array(..), byteLength) import System.Directory (doesDirectoryExist) @@ -184,7 +184,7 @@ import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Data.Fold as FL import qualified Streamly.Internal.Data.Parser as PR (takeEQ, fromEffect, fromFold) -import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream.StreamD as S import qualified Streamly.Internal.FileSystem.Dir as Dir import qualified Streamly.Internal.FileSystem.Handle as FH import qualified Streamly.Internal.Unicode.Stream as U diff --git a/src/Streamly/Internal/FileSystem/FD.hs b/src/Streamly/Internal/FileSystem/FD.hs index a8736399d..45280a546 100644 --- a/src/Streamly/Internal/FileSystem/FD.hs +++ b/src/Streamly/Internal/FileSystem/FD.hs @@ -131,7 +131,7 @@ import qualified GHC.IO.Device as RawIO import Streamly.Internal.Data.Array.Type (Array(..), byteLength, unsafeFreeze, asPtrUnsafe) import Streamly.Internal.System.IO (defaultChunkSize) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) #if !defined(mingw32_HOST_OS) {- import Streamly.Internal.Data.Stream.IsStream.Type (toStreamD) @@ -148,7 +148,7 @@ import qualified Streamly.Data.Fold as FL import qualified Streamly.Internal.Data.Array.Mut as MArray (Array(..), newPinnedBytes, asPtrUnsafe) import qualified Streamly.Internal.Data.Stream.Chunked as AS -import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream.StreamD as S import qualified Streamly.Internal.Data.Stream.StreamD.Type as D (Stream(..), Step(..)) import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (mkStream) @@ -296,7 +296,7 @@ _readArraysOfUpto size h = S.fromStreamK go {-# INLINE_NORMAL readArraysOfUpto #-} readArraysOfUpto :: (MonadIO m) => Int -> Handle -> Stream m (Array Word8) -readArraysOfUpto size h = S.fromStreamD (D.Stream step ()) +readArraysOfUpto size h = D.Stream step () where {-# INLINE_LATE step #-} step _ _ = do @@ -357,7 +357,7 @@ read = AS.concat . readArrays -- @since 0.7.0 {-# INLINE writeArrays #-} writeArrays :: (MonadIO m, Unbox a) => Handle -> Stream m (Array a) -> m () -writeArrays h = S.fold (FL.drainBy (liftIO . writeArray h)) +writeArrays h = S.fold (FL.drainMapM (liftIO . writeArray h)) -- | Write a stream of arrays to a handle after coalescing them in chunks of -- specified size. The chunk size is only a maximum and the actual writes could diff --git a/src/Streamly/Internal/Network/Inet/TCP.hs b/src/Streamly/Internal/Network/Inet/TCP.hs index c880a0074..db57da418 100644 --- a/src/Streamly/Internal/Network/Inet/TCP.hs +++ b/src/Streamly/Internal/Network/Inet/TCP.hs @@ -110,6 +110,7 @@ import Streamly.Internal.Data.Array.Type (Array(..), writeNUnsafe) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Data.Stream (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) +import Streamly.Internal.Data.Unboxed (Unbox) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.Network.Socket (SockSpec(..), accept, acceptor) import Streamly.Internal.System.IO (defaultChunkSize) @@ -120,10 +121,10 @@ import qualified Network.Socket as Net import qualified Streamly.Data.Array as A import qualified Streamly.Data.Fold as FL import qualified Streamly.Data.Unfold as UF +import qualified Streamly.Internal.Data.Array.Type as A import qualified Streamly.Internal.Data.Unfold as UF (first, bracketIO) -import qualified Streamly.Internal.Data.Stream.Chunked as AS import qualified Streamly.Internal.Data.Fold.Type as FL (Step(..), reduce) -import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream.StreamD as S import qualified Streamly.Internal.Data.Stream.Exception.Lifted as S import qualified Streamly.Internal.Network.Socket as ISK @@ -314,13 +315,17 @@ reader :: (MonadCatch m, MonadAsync m) => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Word8 reader = UF.many A.reader (usingConnection ISK.chunkReader) +{-# INLINE concatChunks #-} +concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a +concatChunks = S.unfoldMany A.reader + -- | Read a stream from the supplied IPv4 host address and port number. -- -- /Pre-release/ {-# INLINE read #-} read :: (MonadCatch m, MonadAsync m) => (Word8, Word8, Word8, Word8) -> PortNumber -> Stream m Word8 -read addr port = AS.concat $ withConnection addr port ISK.readChunks +read addr port = concatChunks $ withConnection addr port ISK.readChunks ------------------------------------------------------------------------------- -- Writing @@ -380,7 +385,7 @@ putBytesWithBufferOf -> PortNumber -> Stream m Word8 -> m () -putBytesWithBufferOf n addr port m = putChunks addr port $ AS.arraysOf n m +putBytesWithBufferOf n addr port m = putChunks addr port $ A.arraysOf n m -- | Like 'write' but provides control over the write buffer. Output will -- be written to the IO device as soon as we collect the specified number of diff --git a/src/Streamly/Internal/Network/Socket.hs b/src/Streamly/Internal/Network/Socket.hs index 854846205..46b50fe5a 100644 --- a/src/Streamly/Internal/Network/Socket.hs +++ b/src/Streamly/Internal/Network/Socket.hs @@ -89,7 +89,7 @@ import qualified Network.Socket as Net import Streamly.Internal.Data.Array.Type (Array(..)) import Streamly.Internal.Data.Stream.Chunked (lpackArraysChunksOf) import Streamly.Internal.Data.Fold (Fold) -import Streamly.Internal.Data.Stream.Type (Stream) +import Streamly.Internal.Data.Stream.StreamD.Type (Stream) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) import Streamly.Internal.System.IO (defaultChunkSize) @@ -97,11 +97,10 @@ import Streamly.Internal.System.IO (defaultChunkSize) import qualified Streamly.Data.Array as A (reader, length, writeN) import qualified Streamly.Data.Fold as FL import qualified Streamly.Internal.Data.Array.Type as A - (unsafeFreeze, asPtrUnsafe, byteLength, writeNUnsafe) + (unsafeFreeze, asPtrUnsafe, byteLength, writeNUnsafe, arraysOf) import qualified Streamly.Internal.Data.Array.Mut as MArray (Array(..), newPinnedBytes, asPtrUnsafe) -import qualified Streamly.Internal.Data.Stream.Chunked as AS -import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream.StreamD as S import qualified Streamly.Internal.Data.Stream.StreamD.Type as D (Stream(..), Step(..)) import qualified Streamly.Data.Unfold as UF @@ -345,7 +344,7 @@ _readChunksUptoWith f size h = S.fromStreamK go {-# INLINE_NORMAL readChunksWith #-} readChunksWith :: MonadIO m => Int -> Socket -> Stream m (Array Word8) -- readChunksWith = _readChunksUptoWith readChunk -readChunksWith size h = S.fromStreamD (D.Stream step ()) +readChunksWith size h = D.Stream step () where {-# INLINE_LATE step #-} step _ _ = do @@ -403,12 +402,16 @@ chunkReader = UF.first defaultChunkSize chunkReaderWith -- Read File to Stream ------------------------------------------------------------------------------- +{-# INLINE concatChunks #-} +concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a +concatChunks = S.unfoldMany A.reader + -- | Generate a byte stream from a socket using a buffer of the given size. -- -- /Pre-release/ {-# INLINE readWith #-} readWith :: MonadIO m => Int -> Socket -> Stream m Word8 -readWith size = AS.concat . readChunksWith size +readWith size = concatChunks . readChunksWith size -- | Generate a byte stream from a socket. -- @@ -492,7 +495,7 @@ writeChunksWithBufferOf = writeChunksWith -- {-# INLINE putBytesWith #-} putBytesWith :: MonadIO m => Int -> Socket -> Stream m Word8 -> m () -putBytesWith n h m = putChunks h $ AS.arraysOf n m +putBytesWith n h m = putChunks h $ A.arraysOf n m -- | Write a byte stream to a socket. Accumulates the input in chunks of -- specified number of bytes before writing. diff --git a/src/Streamly/Internal/Unicode/Char.hs b/src/Streamly/Internal/Unicode/Char.hs index 1fc4a2ff1..64c090c50 100644 --- a/src/Streamly/Internal/Unicode/Char.hs +++ b/src/Streamly/Internal/Unicode/Char.hs @@ -35,10 +35,9 @@ where import Data.Char (isAsciiUpper, isAsciiLower, chr, ord) import Unicode.Char (DecomposeMode(..)) -import Streamly.Internal.Data.Stream (fromStreamD, toStreamD) import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..)) -import qualified Streamly.Internal.Data.Stream as Stream (Stream) +import qualified Streamly.Internal.Data.Stream.StreamD as Stream (Stream) import qualified Unicode.Char as Char @@ -324,4 +323,4 @@ normalize :: => NormalizationMode -> Stream.Stream m Char -> Stream.Stream m Char -normalize mode = fromStreamD . normalizeD mode . toStreamD +normalize = normalizeD diff --git a/src/Streamly/Prelude.hs b/src/Streamly/Prelude.hs index 9abb2bc39..7b146fcb3 100644 --- a/src/Streamly/Prelude.hs +++ b/src/Streamly/Prelude.hs @@ -905,6 +905,12 @@ module Streamly.Prelude -- * Type Synonyms , MonadAsync + -- * Converting from/to Stream/StreamK types + , fromStream + , toStream + , fromStreamK + , toStreamK + -- * Stream Type Adapters -- $adapters , IsStream () diff --git a/streamly.cabal b/streamly.cabal index 23193e288..a1db77f0f 100644 --- a/streamly.cabal +++ b/streamly.cabal @@ -419,6 +419,7 @@ library , Streamly.Internal.Data.Stream.SVar.Eliminate , Streamly.Internal.Data.Stream.Serial + , Streamly.Internal.Data.Stream.Zip , Streamly.Internal.Data.Stream.Async , Streamly.Internal.Data.Stream.Parallel , Streamly.Internal.Data.Stream.Ahead diff --git a/targets/Targets.hs b/targets/Targets.hs index bdc4dfd78..1f0c22d3a 100644 --- a/targets/Targets.hs +++ b/targets/Targets.hs @@ -3,6 +3,10 @@ module Targets ) where +-- Special tags +-- noTest +-- noBench +-- testDevOnly targets :: [(String, [String])] targets = [ -- Base streams @@ -19,10 +23,14 @@ targets = ] ) +{- + -- XXX Need devOnly flag support in BenchRunner , ("Data.Stream.ToStreamK", [ "noTest" + , "devOnly" ] ) +-} -- Streams , ("Data.Stream", @@ -33,6 +41,12 @@ targets = , "noTest" ] ) + , ("Data.Stream.StreamDK", + [ "prelude_serial_grp" + , "infinite_grp" + , "noTest" + ] + ) , ("Data.Stream.Concurrent", [ "prelude_concurrent_grp" , "infinite_grp" @@ -66,78 +80,79 @@ targets = , "infinite_grp" ] ) - , ("Prelude.Serial", - [ "prelude_serial_grp" - , "infinite_grp" - , "serial_wserial_cmp" - , "noBench" - ] - ) - , ("Prelude.Top", - [ "prelude_serial_grp" - , "infinite_grp" - , "noBench" - ] - ) - , ("Prelude.WSerial", - [ "prelude_serial_grp" - , "infinite_grp" - , "serial_wserial_cmp" - ] - ) - , ("Prelude.Merge", - [ "prelude_serial_grp" - , "infinite_grp" - , "noTest" - ] - ) - , ("Prelude.ZipSerial", - [ "prelude_serial_grp" - , "infinite_grp" - ] - ) - , ("Prelude.Async", - [ "prelude_concurrent_grp" - , "infinite_grp" - , "concurrent_cmp" - , "serial_async_cmp" - ] - ) - , ("Prelude.WAsync", - [ "prelude_concurrent_grp" - , "infinite_grp" - , "concurrent_cmp" - ] - ) - , ("Prelude.Ahead", - [ "prelude_concurrent_grp" - , "infinite_grp" - , "concurrent_cmp" - ] - ) - , ("Prelude.Parallel", - [ "prelude_concurrent_grp" - , "infinite_grp" - , "concurrent_cmp" - ] - ) - , ("Prelude.ZipAsync", - [ "prelude_concurrent_grp" - , "infinite_grp" - ] - ) - , ("Prelude.Concurrent", [ "prelude_other_grp" ]) - , ("Prelude.Rate", - [ "prelude_other_grp" - , "infinite_grp" - , "testDevOnly" - ] - ) - , ("Prelude.Adaptive", - [ "prelude_other_grp" - , "noTest" - ] - ) + -- Enabled only when use-prelude flag is set + -- , ("Prelude.Serial", + -- [ "prelude_serial_grp" + -- , "infinite_grp" + -- , "serial_wserial_cmp" + -- , "noBench" + -- ] + -- ) + -- , ("Prelude.Top", + -- [ "prelude_serial_grp" + -- , "infinite_grp" + -- , "noBench" + -- ] + -- ) + -- , ("Prelude.WSerial", + -- [ "prelude_serial_grp" + -- , "infinite_grp" + -- , "serial_wserial_cmp" + -- ] + -- ) + -- , ("Prelude.Merge", + -- [ "prelude_serial_grp" + -- , "infinite_grp" + -- , "noTest" + -- ] + -- ) + -- , ("Prelude.ZipSerial", + -- [ "prelude_serial_grp" + -- , "infinite_grp" + -- ] + -- ) + -- , ("Prelude.Async", + -- [ "prelude_concurrent_grp" + -- , "infinite_grp" + -- , "concurrent_cmp" + -- , "serial_async_cmp" + -- ] + -- ) + -- , ("Prelude.WAsync", + -- [ "prelude_concurrent_grp" + -- , "infinite_grp" + -- , "concurrent_cmp" + -- ] + -- ) + -- , ("Prelude.Ahead", + -- [ "prelude_concurrent_grp" + -- , "infinite_grp" + -- , "concurrent_cmp" + -- ] + -- ) + -- , ("Prelude.Parallel", + -- [ "prelude_concurrent_grp" + -- , "infinite_grp" + -- , "concurrent_cmp" + -- ] + -- ) + -- , ("Prelude.ZipAsync", + -- [ "prelude_concurrent_grp" + -- , "infinite_grp" + -- ] + -- ) + -- , ("Prelude.Concurrent", [ "prelude_other_grp" ]) + -- , ("Prelude.Rate", + -- [ "prelude_other_grp" + -- , "infinite_grp" + -- , "testDevOnly" + -- ] + -- ) + -- , ("Prelude.Adaptive", + -- [ "prelude_other_grp" + -- , "noTest" + -- ] + -- ) -- Arrays , ("Data.Array.Generic", @@ -185,8 +200,8 @@ targets = , ("Unicode.Char", ["testDevOnly"]) -- test only, no benchmarks - , ("Prelude", ["prelude_other_grp", "noBench"]) - , ("Prelude.Fold", ["prelude_other_grp", "noBench"]) + -- , ("Prelude", ["prelude_other_grp", "noBench"]) + -- , ("Prelude.Fold", ["prelude_other_grp", "noBench"]) , ("FileSystem.Event", ["noBench"]) , ("Network.Socket", ["noBench"]) , ("Network.Inet.TCP", ["noBench"])