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.
This commit is contained in:
Harendra Kumar 2023-01-21 19:05:34 +05:30
parent 108af63566
commit e249c4da2d
117 changed files with 7163 additions and 2112 deletions

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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)
]
-------------------------------------------------------------------------------

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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 #-}

View File

@ -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

View File

@ -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))

View File

@ -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
]

View File

@ -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
]
]

View File

@ -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
-}
]

View File

@ -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 =

View File

@ -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
]

View File

@ -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)
]

View File

@ -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 =

View File

@ -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)"

View File

@ -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"

View File

@ -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
]
]

View File

@ -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

View File

@ -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 =

View File

@ -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

View File

@ -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
--------------------------------------------------------------------------------

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 <https://github.com/composewell/streamly-examples>
-- 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,

View File

@ -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 <https://github.com/composewell/streamly-examples>
-- 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)

View File

@ -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)

View File

@ -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

View File

@ -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.
--

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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'
--

View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -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'.

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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))

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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)

File diff suppressed because it is too large Load Diff

View File

@ -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))

View File

@ -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!"

View File

@ -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.
--

File diff suppressed because it is too large Load Diff

View File

@ -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

File diff suppressed because it is too large Load Diff

View File

@ -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

View File

@ -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

View File

@ -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 ()
-}

File diff suppressed because it is too large Load Diff

View File

@ -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.

View File

@ -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:

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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

View File

@ -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"

View File

@ -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

View File

@ -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:
--
-- >>> :{

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
------------------------------------------------------------------------------

View File

@ -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

View File

@ -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)

View File

@ -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
------------------------------------------------------------------------------

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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 #-}

View File

@ -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
]

Some files were not shown because too many files have changed in this diff Show More