@@ -5,2712 +5,12 @@
5-- License : MIT
5-- License : MIT
6-- Maintainer : streamly@composewell.com
6-- Maintainer : streamly@composewell.com
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE DeriveAnyClass #-}
12−{-# LANGUAGE DeriveGeneric #-}
13−{-# LANGUAGE RankNTypes #-}
14−{-# LANGUAGE TupleSections #-}
16−#ifdef __HADDOCK_VERSION__
21−{-# LANGUAGE TemplateHaskell #-}
22−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
25module Streamly.Benchmark.Prelude
8module Streamly.Benchmark.Prelude
26− -- TODO: export a single bench group for o_1_space_serial
9+ ( module Streamly.Benchmark.Prelude.Generation
27− ( o_1_space_serial_pure
10+ , module Streamly.Benchmark.Prelude.Elimination
28− , o_1_space_serial_foldable
11+ , module Streamly.Benchmark.Prelude.Transformation
29− , o_1_space_serial_generation
30− , o_1_space_serial_elimination
31− , o_1_space_serial_foldMultiStream
32− , o_1_space_serial_pipes
33− , o_1_space_serial_pipesX4
34− , o_1_space_serial_transformer
35− , o_1_space_serial_transformation
36− , o_1_space_serial_transformationX4
37− , o_1_space_serial_filtering
38− , o_1_space_serial_filteringX4
39− , o_1_space_serial_joining
40− , o_1_space_serial_concatFoldable
41− , o_1_space_serial_concatSerial
42− , o_1_space_serial_outerProductStreams
43− , o_1_space_serial_mixed
44− , o_1_space_serial_mixedX4
46− , o_1_space_wSerial_transformation
47− , o_1_space_wSerial_concatMap
48− , o_1_space_wSerial_outerProduct
50− , o_1_space_zipSerial_transformation
52− , o_n_space_serial_toContainers
53− , o_n_space_serial_outerProductStreams
55− , o_n_space_wSerial_outerProductStreams
57− , o_n_space_serial_traversable
58− , o_n_space_serial_foldr
60− , o_n_heap_serial_foldl
61− , o_n_heap_serial_buffering
63− , o_n_stack_serial_iterated
65− , o_1_space_async_generation
66− , o_1_space_async_concatFoldable
67− , o_1_space_async_concatMap
68− , o_1_space_async_transformation
70− , o_1_space_wAsync_generation
71− , o_1_space_wAsync_concatFoldable
72− , o_1_space_wAsync_concatMap
73− , o_1_space_wAsync_transformation
75− , o_1_space_ahead_generation
76− , o_1_space_ahead_concatFoldable
77− , o_1_space_ahead_concatMap
78− , o_1_space_ahead_transformation
80− , o_1_space_async_zip
82− , o_n_space_parallel_generation
83− , o_n_space_parallel_concatFoldable
84− , o_n_space_parallel_concatMap
85− , o_n_space_parallel_transformation
86− , o_n_space_parallel_outerProductStreams
87− , o_n_space_parallel_outerProductStreams2
89− , o_1_space_async_avgRate
91− , o_1_space_ahead_avgRate
94−import Control.DeepSeq (NFData(..))
14+import Streamly.Benchmark.Prelude.Generation
95−import Control.Monad (when)
15+import Streamly.Benchmark.Prelude.Elimination
96−import Control.Monad.IO.Class (MonadIO(..))
16+import Streamly.Benchmark.Prelude.Transformation
97−import Control.Monad.State.Strict (StateT, get, put)
98−import Data.Functor.Identity (Identity, runIdentity)
99−import Data.IORef (newIORef, modifyIORef')
100−import GHC.Generics (Generic)
101−import System.Random (randomRIO)
103− (Monad, String, Int, (+), ($), (.), return, even, (>), (<=), (==), (>=),
104− subtract, undefined, Maybe(..), Bool(..), not, (>>=), curry,
105− maxBound, div, IO, compare, Double, fromIntegral, Integer, (<$>),
106− (<*>), flip, sqrt, round, (*), seq, const, Either(..))
107−import qualified Prelude as P
108−import qualified Data.Foldable as F
109−import qualified GHC.Exts as GHC
112−import GHC.Types (SPEC(..))
113−import Test.Inspection
115−import qualified Streamly.Internal.Data.Stream.StreamD as D
118−import qualified Streamly as S hiding (runStream)
119−import qualified Streamly.Prelude as S
120−import qualified Streamly.Internal.Prelude as Internal
121−import qualified Streamly.Internal.Data.Fold as FL
122−import qualified Streamly.Internal.Data.Unfold as UF
123−import qualified Streamly.Internal.Data.Pipe as Pipe
124−import qualified Streamly.Internal.Data.Stream.Parallel as Par
125−import Streamly.Internal.Data.Time.Units
127−import qualified Streamly.Internal.Prelude as IP
129−import qualified Streamly.Benchmark.Prelude.NestedOps as Nested
132−import Streamly hiding (runStream)
133−import Streamly.Benchmark.Common
135−type Stream m a = S.SerialT m a
137−-------------------------------------------------------------------------------
139−-------------------------------------------------------------------------------
143−{-# INLINE sourceIntFromTo #-}
144−sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
145−sourceIntFromTo value n = S.enumerateFromTo n (n + value)
147−{-# INLINE sourceIntFromThenTo #-}
148−sourceIntFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
149−sourceIntFromThenTo value n = S.enumerateFromThenTo n (n + 1) (n + value)
151−{-# INLINE sourceFracFromTo #-}
152−sourceFracFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Double
153−sourceFracFromTo value n =
154− S.enumerateFromTo (fromIntegral n) (fromIntegral (n + value))
156−{-# INLINE sourceFracFromThenTo #-}
157−sourceFracFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Double
158−sourceFracFromThenTo value n = S.enumerateFromThenTo (fromIntegral n)
159− (fromIntegral n + 1.0001) (fromIntegral (n + value))
161−{-# INLINE sourceIntegerFromStep #-}
162−sourceIntegerFromStep :: (Monad m, S.IsStream t) => Int -> Int -> t m Integer
163−sourceIntegerFromStep value n =
164− S.take value $ S.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)
168−{-# INLINE sourceUnfoldr #-}
169−sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
170−sourceUnfoldr value n = S.unfoldr step n
175− else Just (cnt, cnt + 1)
177−{-# INLINE sourceUnfoldrN #-}
178−sourceUnfoldrN :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
179−sourceUnfoldrN upto start = S.unfoldr step start
182− if cnt > start + upto
184− else Just (cnt, cnt + 1)
186−{-# INLINE sourceUnfoldrM #-}
187−sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
188−sourceUnfoldrM value n = S.unfoldrM step n
193− else return (Just (cnt, cnt + 1))
195−{-# INLINE source #-}
196−source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
197−source = sourceUnfoldrM
199−{-# INLINE sourceUnfoldrMN #-}
200−sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
201−sourceUnfoldrMN upto start = S.unfoldrM step start
204− if cnt > start + upto
206− else return (Just (cnt, cnt + 1))
208−{-# INLINE sourceUnfoldrMAction #-}
209−sourceUnfoldrMAction :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (m Int)
210−sourceUnfoldrMAction value n = S.serially $ S.unfoldrM step n
215− else return (Just (return cnt, cnt + 1))
217−{-# INLINE sourceUnfoldrAction #-}
218−sourceUnfoldrAction :: (S.IsStream t, Monad m, Monad m1)
219− => Int -> Int -> t m (m1 Int)
220−sourceUnfoldrAction value n = S.serially $ S.unfoldr step n
225− else (Just (return cnt, cnt + 1))
229−{-# INLINE _sourceFromIndices #-}
230−_sourceFromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
231−_sourceFromIndices value n = S.take value $ S.fromIndices (+ n)
233−{-# INLINE _sourceFromIndicesM #-}
234−_sourceFromIndicesM :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
235−_sourceFromIndicesM value n = S.take value $ S.fromIndicesM (P.fmap return (+ n))
239−{-# INLINE sourceFromList #-}
240−sourceFromList :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
241−sourceFromList value n = S.fromList [n..n+value]
243−{-# INLINE sourceFromListM #-}
244−sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
245−sourceFromListM value n = S.fromListM (P.fmap return [n..n+value])
247−{-# INLINE sourceIsList #-}
248−sourceIsList :: Int -> Int -> S.SerialT Identity Int
249−sourceIsList value n = GHC.fromList [n..n+value]
251−{-# INLINE sourceIsString #-}
252−sourceIsString :: Int -> Int -> S.SerialT Identity P.Char
253−sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
257−{-# INLINE sourceFromFoldable #-}
258−sourceFromFoldable :: S.IsStream t => Int -> Int -> t m Int
259−sourceFromFoldable value n = S.fromFoldable [n..n+value]
261−{-# INLINE sourceFromFoldableM #-}
262−sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
263−sourceFromFoldableM value n = S.fromFoldableM (P.fmap return [n..n+value])
265−{-# INLINE absTimes #-}
266−absTimes :: (S.IsStream t, S.MonadAsync m, P.Functor (t m))
267− => Int -> Int -> t m AbsTime
268−absTimes value _ = S.take value $ Internal.absTimes
270−-------------------------------------------------------------------------------
272−-------------------------------------------------------------------------------
274−{-# INLINE runStream #-}
275−runStream :: Monad m => Stream m a -> m ()
278−{-# INLINE toNull #-}
279−toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
280−toNull t = runStream . t
282−{-# INLINE uncons #-}
283−uncons :: Monad m => Stream m Int -> m ()
287− Nothing -> return ()
288− Just (_, t) -> uncons t
291−init :: Monad m => Stream m a -> m ()
292−init s = S.init s >>= P.mapM_ S.drain
295−tail :: Monad m => Stream m a -> m ()
296−tail s = S.tail s >>= P.mapM_ tail
298−{-# INLINE nullHeadTail #-}
299−nullHeadTail :: Monad m => Stream m Int -> m ()
304− S.tail s >>= P.mapM_ nullHeadTail
307−mapM_ :: Monad m => Stream m Int -> m ()
308−mapM_ = S.mapM_ (\_ -> return ())
310−{-# INLINE toList #-}
311−toList :: Monad m => Stream m Int -> m [Int]
314−{-# INLINE toListRev #-}
315−toListRev :: Monad m => Stream m Int -> m [Int]
316−toListRev = Internal.toListRev
318−{-# INLINE foldrMElem #-}
319−foldrMElem :: Monad m => Int -> Stream m Int -> m Bool
329−{-# INLINE foldrMToStream #-}
330−foldrMToStream :: Monad m => Stream m Int -> m (Stream Identity Int)
331−foldrMToStream = S.foldr S.cons S.nil
333−{-# INLINE foldrMBuild #-}
334−foldrMBuild :: Monad m => Stream m Int -> m [Int]
335−foldrMBuild = S.foldrM (\x xs -> xs >>= return . (x :)) (return [])
337−{-# INLINE foldl'Build #-}
338−foldl'Build :: Monad m => Stream m Int -> m [Int]
339−foldl'Build = S.foldl' (flip (:)) []
341−{-# INLINE foldlM'Build #-}
342−foldlM'Build :: Monad m => Stream m Int -> m [Int]
343−foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []
345−{-# INLINE foldrMReduce #-}
346−foldrMReduce :: Monad m => Stream m Int -> m Int
347−foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)
349−{-# INLINE foldl'Reduce #-}
350−foldl'Reduce :: Monad m => Stream m Int -> m Int
351−foldl'Reduce = S.foldl' (+) 0
353−{-# INLINE foldl'ReduceMap #-}
354−foldl'ReduceMap :: Monad m => Stream m Int -> m Int
355−foldl'ReduceMap = P.fmap (+ 1) . S.foldl' (+) 0
357−{-# INLINE foldl1'Reduce #-}
358−foldl1'Reduce :: Monad m => Stream m Int -> m (Maybe Int)
359−foldl1'Reduce = S.foldl1' (+)
361−{-# INLINE foldlM'Reduce #-}
362−foldlM'Reduce :: Monad m => Stream m Int -> m Int
363−foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0
366−last :: Monad m => Stream m Int -> m (Maybe Int)
370−_null :: Monad m => Stream m Int -> m Bool
374−_head :: Monad m => Stream m Int -> m (Maybe Int)
378−elem :: Monad m => Int -> Stream m Int -> m Bool
379−elem value = S.elem (value + 1)
381−{-# INLINE notElem #-}
382−notElem :: Monad m => Int -> Stream m Int -> m Bool
383−notElem value = S.notElem (value + 1)
385−{-# INLINE length #-}
386−length :: Monad m => Stream m Int -> m Int
390−all :: Monad m => Int -> Stream m Int -> m Bool
391−all value = S.all (<= (value + 1))
394−any :: Monad m => Int -> Stream m Int -> m Bool
395−any value = S.any (> (value + 1))
398−and :: Monad m => Int -> Stream m Int -> m Bool
399−and value = S.and . S.map (<= (value + 1))
402−or :: Monad m => Int -> Stream m Int -> m Bool
403−or value = S.or . S.map (> (value + 1))
406−find :: Monad m => Int -> Stream m Int -> m (Maybe Int)
407−find value = S.find (== (value + 1))
409−{-# INLINE findIndex #-}
410−findIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
411−findIndex value = S.findIndex (== (value + 1))
413−{-# INLINE elemIndex #-}
414−elemIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
415−elemIndex value = S.elemIndex (value + 1)
417−{-# INLINE maximum #-}
418−maximum :: Monad m => Stream m Int -> m (Maybe Int)
421−{-# INLINE minimum #-}
422−minimum :: Monad m => Stream m Int -> m (Maybe Int)
426−sum :: Monad m => Stream m Int -> m Int
429−{-# INLINE product #-}
430−product :: Monad m => Stream m Int -> m Int
433−{-# INLINE minimumBy #-}
434−minimumBy :: Monad m => Stream m Int -> m (Maybe Int)
435−minimumBy = S.minimumBy compare
437−{-# INLINE maximumBy #-}
438−maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
439−maximumBy = S.maximumBy compare
441−-------------------------------------------------------------------------------
443−-------------------------------------------------------------------------------
445−{-# INLINE transform #-}
446−transform :: Monad m => Stream m a -> m ()
447−transform = runStream
449−{-# INLINE composeN #-}
453− -> (Stream m Int -> Stream m Int)
459− 2 -> transform . f . f
460− 3 -> transform . f . f . f
461− 4 -> transform . f . f . f . f
464−-- polymorphic stream version of composeN
465−{-# INLINE composeN' #-}
467− (S.IsStream t, Monad m)
469− -> (t m Int -> Stream m Int)
475− 2 -> transform . f . S.adapt . f
476− 3 -> transform . f . S.adapt . f . S.adapt . f
477− 4 -> transform . f . S.adapt . f . S.adapt . f . S.adapt . f
481−scan :: MonadIO m => Int -> Stream m Int -> m ()
482−scan n = composeN n $ S.scanl' (+) 0
484−{-# INLINE scanl1' #-}
485−scanl1' :: MonadIO m => Int -> Stream m Int -> m ()
486−scanl1' n = composeN n $ S.scanl1' (+)
489−fmap :: MonadIO m => Int -> Stream m Int -> m ()
490−fmap n = composeN n $ P.fmap (+ 1)
494− (S.IsStream t, S.MonadAsync m, P.Functor (t m))
495− => (t m Int -> S.SerialT m Int)
499−fmap' t n = composeN' n $ t . P.fmap (+ 1)
502−map :: MonadIO m => Int -> Stream m Int -> m ()
503−map n = composeN n $ S.map (+ 1)
507− (S.IsStream t, S.MonadAsync m)
508− => (t m Int -> S.SerialT m Int)
512−map' t n = composeN' n $ t . S.map (+ 1)
516− (S.IsStream t, S.MonadAsync m)
517− => (t m Int -> S.SerialT m Int)
521−mapM t n = composeN' n $ t . S.mapM return
524−tap :: MonadIO m => Int -> Stream m Int -> m ()
525−tap n = composeN n $ S.tap FL.sum
527−{-# INLINE tapRate #-}
528−tapRate :: Int -> Stream IO Int -> IO ()
531− composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str
533−{-# INLINE pollCounts #-}
534−pollCounts :: Int -> Stream IO Int -> IO ()
535−pollCounts n str = do
536− composeN n (Internal.pollCounts (P.const P.True) f FL.drain) str
538− f = Internal.rollingMap (P.-) . Internal.delayPost 1
540−{-# INLINE tapAsyncS #-}
541−tapAsyncS :: S.MonadAsync m => Int -> Stream m Int -> m ()
542−tapAsyncS n = composeN n $ Par.tapAsync S.sum
544−{-# INLINE tapAsync #-}
545−tapAsync :: S.MonadAsync m => Int -> Stream m Int -> m ()
546−tapAsync n = composeN n $ Internal.tapAsync FL.sum
548−{-# INLINE timestamped #-}
549−timestamped :: (S.MonadAsync m) => Stream m Int -> m ()
550−timestamped = transform . Internal.timestamped
552−{-# INLINE classifySessionsOf #-}
553−classifySessionsOf :: (S.MonadAsync m) => Stream m Int -> m ()
556− . IP.classifySessionsOf 3 (const (return False)) (P.fmap Right FL.drain)
557− . S.map (\(ts,(k,a)) -> (k, a, ts))
559− . S.concatMap (\x -> S.map (x,) (S.enumerateFromTo 1 (10 :: Int)))
561−{-# INLINE mapMaybe #-}
562−mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()
571−{-# INLINE mapMaybeM #-}
572−mapMaybeM :: S.MonadAsync m => Int -> Stream m Int -> m ()
579− else return $ Just x)
581−{-# INLINE sequence #-}
583− (S.IsStream t, S.MonadAsync m)
584− => (t m Int -> S.SerialT m Int)
587−sequence t = transform . t . S.sequence
589−{-# INLINE filterEven #-}
590−filterEven :: MonadIO m => Int -> Stream m Int -> m ()
591−filterEven n = composeN n $ S.filter even
593−{-# INLINE filterAllOut #-}
594−filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
595−filterAllOut value n = composeN n $ S.filter (> (value + 1))
597−{-# INLINE filterAllIn #-}
598−filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
599−filterAllIn value n = composeN n $ S.filter (<= (value + 1))
601−{-# INLINE _takeOne #-}
602−_takeOne :: MonadIO m => Int -> Stream m Int -> m ()
603−_takeOne n = composeN n $ S.take 1
605−{-# INLINE takeAll #-}
606−takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
607−takeAll value n = composeN n $ S.take (value + 1)
609−{-# INLINE takeWhileTrue #-}
610−takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
611−takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
613−{-# INLINE _takeWhileMTrue #-}
614−_takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
615−_takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
617−{-# INLINE dropOne #-}
618−dropOne :: MonadIO m => Int -> Stream m Int -> m ()
619−dropOne n = composeN n $ S.drop 1
621−{-# INLINE dropAll #-}
622−dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
623−dropAll value n = composeN n $ S.drop (value + 1)
625−{-# INLINE dropWhileTrue #-}
626−dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
627−dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
629−{-# INLINE _dropWhileMTrue #-}
630−_dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
631−_dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
633−{-# INLINE dropWhileFalse #-}
634−dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()
635−dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
637−{-# INLINE findIndices #-}
638−findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
639−findIndices value n = composeN n $ S.findIndices (== (value + 1))
641−{-# INLINE elemIndices #-}
642−elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
643−elemIndices value n = composeN n $ S.elemIndices (value + 1)
645−{-# INLINE intersperse #-}
646−intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
647−intersperse value n = composeN n $ S.intersperse (value + 1)
649−{-# INLINE insertBy #-}
650−insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
651−insertBy value n = composeN n $ S.insertBy compare (value + 1)
653−{-# INLINE deleteBy #-}
654−deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
655−deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
657−{-# INLINE reverse #-}
658−reverse :: MonadIO m => Int -> Stream m Int -> m ()
659−reverse n = composeN n $ S.reverse
661−{-# INLINE reverse' #-}
662−reverse' :: MonadIO m => Int -> Stream m Int -> m ()
663−reverse' n = composeN n $ Internal.reverse'
665−{-# INLINE foldrS #-}
666−foldrS :: MonadIO m => Int -> Stream m Int -> m ()
667−foldrS n = composeN n $ Internal.foldrS S.cons S.nil
669−{-# INLINE foldrSMap #-}
670−foldrSMap :: MonadIO m => Int -> Stream m Int -> m ()
671−foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
673−{-# INLINE foldrT #-}
674−foldrT :: MonadIO m => Int -> Stream m Int -> m ()
675−foldrT n = composeN n $ Internal.foldrT S.cons S.nil
677−{-# INLINE foldrTMap #-}
678−foldrTMap :: MonadIO m => Int -> Stream m Int -> m ()
679−foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
681−{-# INLINE takeByTime #-}
682−takeByTime :: NanoSecond64 -> Int -> Stream IO Int -> IO ()
683−takeByTime i n = composeN n (Internal.takeByTime i)
686−-- inspect $ hasNoType 'takeByTime ''SPEC
687−inspect $ hasNoTypeClasses 'takeByTime
688−-- inspect $ 'takeByTime `hasNoType` ''D.Step
691−{-# INLINE dropByTime #-}
692−dropByTime :: NanoSecond64 -> Int -> Stream IO Int -> IO ()
693−dropByTime i n = composeN n (Internal.dropByTime i)
696−inspect $ hasNoTypeClasses 'dropByTime
697−-- inspect $ 'dropByTime `hasNoType` ''D.Step
700−-------------------------------------------------------------------------------
702−-------------------------------------------------------------------------------
704−{-# INLINE transformMapM #-}
706− (S.IsStream t, S.MonadAsync m)
707− => (t m Int -> S.SerialT m Int)
711−transformMapM t n = composeN' n $ t . Internal.transform (Pipe.mapM return)
713−{-# INLINE transformComposeMapM #-}
714−transformComposeMapM ::
715− (S.IsStream t, S.MonadAsync m)
716− => (t m Int -> S.SerialT m Int)
720−transformComposeMapM t n =
724− (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`
725− Pipe.mapM (\x -> return (x + 2)))
727−{-# INLINE transformTeeMapM #-}
729− (S.IsStream t, S.MonadAsync m)
730− => (t m Int -> S.SerialT m Int)
734−transformTeeMapM t n =
738− (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`
739− Pipe.mapM (\x -> return (x + 2)))
741−{-# INLINE transformZipMapM #-}
743− (S.IsStream t, S.MonadAsync m)
744− => (t m Int -> S.SerialT m Int)
748−transformZipMapM t n =
754− (Pipe.mapM (\x -> return (x + 1)))
755− (Pipe.mapM (\x -> return (x + 2))))
757−-------------------------------------------------------------------------------
758−-- Mixed Transformation
759−-------------------------------------------------------------------------------
761−{-# INLINE scanMap #-}
762−scanMap :: MonadIO m => Int -> Stream m Int -> m ()
763−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
765−{-# INLINE dropMap #-}
766−dropMap :: MonadIO m => Int -> Stream m Int -> m ()
767−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
769−{-# INLINE dropScan #-}
770−dropScan :: MonadIO m => Int -> Stream m Int -> m ()
771−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
773−{-# INLINE takeDrop #-}
774−takeDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()
775−takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
777−{-# INLINE takeScan #-}
778−takeScan :: MonadIO m => Int -> Int -> Stream m Int -> m ()
779−takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)
781−{-# INLINE takeMap #-}
782−takeMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()
783−takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)
785−{-# INLINE filterDrop #-}
786−filterDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()
787−filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
789−{-# INLINE filterTake #-}
790−filterTake :: MonadIO m => Int -> Int -> Stream m Int -> m ()
791−filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
793−{-# INLINE filterScan #-}
794−filterScan :: MonadIO m => Int -> Stream m Int -> m ()
795−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
797−{-# INLINE filterScanl1 #-}
798−filterScanl1 :: MonadIO m => Int -> Stream m Int -> m ()
799−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
801−{-# INLINE filterMap #-}
802−filterMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()
803−filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))
805−-------------------------------------------------------------------------------
807−-------------------------------------------------------------------------------
811− deriving (Generic, NFData)
813−{-# INLINE sumProductFold #-}
814−sumProductFold :: Monad m => Stream m Int -> m (Int, Int)
815−sumProductFold = S.foldl' (\(s, p) x -> (s + x, p P.* x)) (0, 1)
817−{-# INLINE sumProductScan #-}
818−sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
820− S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p P.* x)) (Pair 0 1) .
821− S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
823−-------------------------------------------------------------------------------
825−-------------------------------------------------------------------------------
827−{-# INLINE iterStreamLen #-}
831−{-# INLINE maxIters #-}
835−{-# INLINE iterateSource #-}
838− => (Stream m Int -> Stream m Int)
842−iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
844− f (0 :: Int) m = g m
845− f x m = g (f (x P.- 1) m)
848−{-# INLINE iterateScan #-}
849−iterateScan :: S.MonadAsync m => Int -> Stream m Int
850−iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
853−{-# INLINE iterateScanl1 #-}
854−iterateScanl1 :: S.MonadAsync m => Int -> Stream m Int
855−iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)
857−{-# INLINE iterateMapM #-}
858−iterateMapM :: S.MonadAsync m => Int -> Stream m Int
859−iterateMapM = iterateSource (S.mapM return) maxIters
861−{-# INLINE iterateFilterEven #-}
862−iterateFilterEven :: S.MonadAsync m => Int -> Stream m Int
863−iterateFilterEven = iterateSource (S.filter even) maxIters
865−{-# INLINE iterateTakeAll #-}
866−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Stream m Int
867−iterateTakeAll value = iterateSource (S.take (value + 1)) maxIters
869−{-# INLINE iterateDropOne #-}
870−iterateDropOne :: S.MonadAsync m => Int -> Stream m Int
871−iterateDropOne = iterateSource (S.drop 1) maxIters
873−{-# INLINE iterateDropWhileFalse #-}
874−iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Stream m Int
875−iterateDropWhileFalse value =
876− iterateSource (S.dropWhile (> (value + 1))) maxIters
878−{-# INLINE iterateDropWhileTrue #-}
879−iterateDropWhileTrue :: S.MonadAsync m => Int -> Int -> Stream m Int
880−iterateDropWhileTrue value =
881− iterateSource (S.dropWhile (<= (value + 1))) maxIters
883−-------------------------------------------------------------------------------
885−-------------------------------------------------------------------------------
887−-------------------------------------------------------------------------------
889−-------------------------------------------------------------------------------
891−{-# INLINE serial2 #-}
892−serial2 :: Int -> Int -> IO ()
894− S.drain $ S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
896−{-# INLINE serial4 #-}
897−serial4 :: Int -> Int -> IO ()
901− ((S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))))
903− (sourceUnfoldrMN count (n + 2))
904− (sourceUnfoldrMN count (n + 3))))
906−{-# INLINE append2 #-}
907−append2 :: Int -> Int -> IO ()
910− Internal.append (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
912−{-# INLINE append4 #-}
913−append4 :: Int -> Int -> IO ()
918− (sourceUnfoldrMN count n)
919− (sourceUnfoldrMN count (n + 1))))
921− (sourceUnfoldrMN count (n + 2))
922− (sourceUnfoldrMN count (n + 3))))
925−inspect $ hasNoTypeClasses 'append2
926−inspect $ 'append2 `hasNoType` ''SPEC
927−inspect $ 'append2 `hasNoType` ''D.AppendState
930−-------------------------------------------------------------------------------
932−-------------------------------------------------------------------------------
934−{-# INLINE wSerial2 #-}
935−wSerial2 :: Int -> Int -> IO ()
939− (sourceUnfoldrMN (value `div` 2) n)
940− (sourceUnfoldrMN (value `div` 2) (n + 1))
942−{-# INLINE interleave2 #-}
943−interleave2 :: Int -> Int -> IO ()
944−interleave2 value n =
947− (sourceUnfoldrMN (value `div` 2) n)
948− (sourceUnfoldrMN (value `div` 2) (n + 1))
951−inspect $ hasNoTypeClasses 'interleave2
952−inspect $ 'interleave2 `hasNoType` ''SPEC
953−inspect $ 'interleave2 `hasNoType` ''D.InterleaveState
956−{-# INLINE roundRobin2 #-}
957−roundRobin2 :: Int -> Int -> IO ()
958−roundRobin2 value n =
961− (sourceUnfoldrMN (value `div` 2) n)
962− (sourceUnfoldrMN (value `div` 2) (n + 1))
965−inspect $ hasNoTypeClasses 'roundRobin2
966−inspect $ 'roundRobin2 `hasNoType` ''SPEC
967−inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
970−-------------------------------------------------------------------------------
972−-------------------------------------------------------------------------------
974−{-# INLINE mergeBy #-}
975−mergeBy :: Int -> Int -> IO ()
980− (sourceUnfoldrMN count n)
981− (sourceUnfoldrMN count (n + 1))
984−inspect $ hasNoTypeClasses 'mergeBy
985−inspect $ 'mergeBy `hasNoType` ''SPEC
986−inspect $ 'mergeBy `hasNoType` ''D.Step
989−-------------------------------------------------------------------------------
991−-------------------------------------------------------------------------------
994−zip :: Int -> Int -> IO ()
997− S.zipWith (,) (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
1000−inspect $ hasNoTypeClasses 'zip
1001−inspect $ 'zip `hasNoType` ''SPEC
1002−inspect $ 'zip `hasNoType` ''D.Step
1006−zipM :: Int -> Int -> IO ()
1011− (sourceUnfoldrMN count n)
1012− (sourceUnfoldrMN count (n + 1))
1015−inspect $ hasNoTypeClasses 'zipM
1016−inspect $ 'zipM `hasNoType` ''SPEC
1017−inspect $ 'zipM `hasNoType` ''D.Step
1020−{-# INLINE zipAsync #-}
1021−zipAsync :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
1022−zipAsync count n = do
1023− S.zipAsyncWith (,) (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
1025−{-# INLINE zipAsyncM #-}
1026−zipAsyncM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
1027−zipAsyncM count n = do
1030− (sourceUnfoldrMN count n)
1031− (sourceUnfoldrMN count (n + 1))
1033−{-# INLINE zipAsyncAp #-}
1034−zipAsyncAp :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
1035−zipAsyncAp count n = do
1037− (,) <$> (sourceUnfoldrMN count n) <*> (sourceUnfoldrMN count (n + 1))
1039−{-# INLINE mergeAsyncByM #-}
1040−mergeAsyncByM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
1041−mergeAsyncByM count n = do
1043− (\a b -> return (a `compare` b))
1044− (sourceUnfoldrMN count n)
1045− (sourceUnfoldrMN count (n + 1))
1047−{-# INLINE mergeAsyncBy #-}
1048−mergeAsyncBy :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
1049−mergeAsyncBy count n = do
1052− (sourceUnfoldrMN count n)
1053− (sourceUnfoldrMN count (n + 1))
1055−-------------------------------------------------------------------------------
1056−-- Multi-stream folds
1057−-------------------------------------------------------------------------------
1059−{-# INLINE isPrefixOf #-}
1060−isPrefixOf :: Monad m => Stream m Int -> m Bool
1061−isPrefixOf src = S.isPrefixOf src src
1063−{-# INLINE isSubsequenceOf #-}
1064−isSubsequenceOf :: Monad m => Stream m Int -> m Bool
1065−isSubsequenceOf src = S.isSubsequenceOf src src
1067−{-# INLINE stripPrefix #-}
1068−stripPrefix :: Monad m => Stream m Int -> m ()
1069−stripPrefix src = do
1070− _ <- S.stripPrefix src src
1073−{-# INLINE eqBy' #-}
1074−eqBy' :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
1075−eqBy' src = S.eqBy (==) src src
1078−eqBy :: Int -> Int -> IO Bool
1079−eqBy value n = eqBy' (source value n)
1082−inspect $ hasNoTypeClasses 'eqBy
1083−inspect $ 'eqBy `hasNoType` ''SPEC
1084−inspect $ 'eqBy `hasNoType` ''D.Step
1088−{-# INLINE eqByPure #-}
1089−eqByPure :: Int -> Int -> Identity Bool
1090−eqByPure value n = eqBy' (sourceUnfoldr value n)
1093−inspect $ hasNoTypeClasses 'eqByPure
1094−inspect $ 'eqByPure `hasNoType` ''SPEC
1095−inspect $ 'eqByPure `hasNoType` ''D.Step
1098−{-# INLINE cmpBy' #-}
1099−cmpBy' :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering
1100−cmpBy' src = S.cmpBy P.compare src src
1102−{-# INLINE cmpBy #-}
1103−cmpBy :: Int -> Int -> IO P.Ordering
1104−cmpBy value n = cmpBy' (source value n)
1107−inspect $ hasNoTypeClasses 'cmpBy
1108−inspect $ 'cmpBy `hasNoType` ''SPEC
1109−inspect $ 'cmpBy `hasNoType` ''D.Step
1112−{-# INLINE cmpByPure #-}
1113−cmpByPure :: Int -> Int -> Identity P.Ordering
1114−cmpByPure value n = cmpBy' (sourceUnfoldr value n)
1117−inspect $ hasNoTypeClasses 'cmpByPure
1118−inspect $ 'cmpByPure `hasNoType` ''SPEC
1119−inspect $ 'cmpByPure `hasNoType` ''D.Step
1122−-------------------------------------------------------------------------------
1123−-- Streams of streams
1124−-------------------------------------------------------------------------------
1126−-- Special cases of concatMap
1128−{-# INLINE sourceFoldMapWith #-}
1129−sourceFoldMapWith :: (S.IsStream t, S.Semigroup (t m Int))
1130− => Int -> Int -> t m Int
1131−sourceFoldMapWith value n = S.foldMapWith (S.<>) S.yield [n..n+value]
1133−{-# INLINE sourceFoldMapWithM #-}
1134−sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
1135− => Int -> Int -> t m Int
1136−sourceFoldMapWithM value n = S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value]
1138−{-# INLINE sourceFoldMapM #-}
1139−sourceFoldMapM :: (S.IsStream t, Monad m, P.Monoid (t m Int))
1140− => Int -> Int -> t m Int
1141−sourceFoldMapM value n = F.foldMap (S.yieldM . return) [n..n+value]
1143−{-# INLINE sourceConcatMapId #-}
1144−sourceConcatMapId :: (S.IsStream t, Monad m)
1145− => Int -> Int -> t m Int
1146−sourceConcatMapId value n =
1147− S.concatMap P.id $ S.fromFoldable $ P.map (S.yieldM . return) [n..n+value]
1149−-- concatMap unfoldrM/unfoldrM
1151−{-# INLINE concatMap #-}
1152−concatMap :: Int -> Int -> Int -> IO ()
1153−concatMap outer inner n =
1154− S.drain $ S.concatMap
1155− (\_ -> sourceUnfoldrMN inner n)
1156− (sourceUnfoldrMN outer n)
1159−inspect $ hasNoTypeClasses 'concatMap
1160−inspect $ 'concatMap `hasNoType` ''SPEC
1163−-- concatMap unfoldr/unfoldr
1165−{-# INLINE concatMapPure #-}
1166−concatMapPure :: Int -> Int -> Int -> IO ()
1167−concatMapPure outer inner n =
1168− S.drain $ S.concatMap
1169− (\_ -> sourceUnfoldrN inner n)
1170− (sourceUnfoldrN outer n)
1173−inspect $ hasNoTypeClasses 'concatMapPure
1174−inspect $ 'concatMapPure `hasNoType` ''SPEC
1177−-- concatMap replicate/unfoldrM
1179−{-# INLINE concatMapRepl4xN #-}
1180−concatMapRepl4xN :: Int -> Int -> IO ()
1181−concatMapRepl4xN value n = S.drain $ S.concatMap (S.replicate 4)
1182− (sourceUnfoldrMN (value `div` 4) n)
1185−inspect $ hasNoTypeClasses 'concatMapRepl4xN
1186−inspect $ 'concatMapRepl4xN `hasNoType` ''SPEC
1191−{-# INLINE concatStreamsWith #-}
1193− :: (forall c. S.SerialT IO c -> S.SerialT IO c -> S.SerialT IO c)
1198−concatStreamsWith op outer inner n =
1199− S.drain $ S.concatMapWith op
1200− (\i -> sourceUnfoldrMN inner i)
1201− (sourceUnfoldrMN outer n)
1203−{-# INLINE concatMapWithSerial #-}
1204−concatMapWithSerial :: Int -> Int -> Int -> IO ()
1205−concatMapWithSerial = concatStreamsWith S.serial
1208−inspect $ hasNoTypeClasses 'concatMapWithSerial
1209−inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
1212−{-# INLINE concatMapWithAppend #-}
1213−concatMapWithAppend :: Int -> Int -> Int -> IO ()
1214−concatMapWithAppend = concatStreamsWith Internal.append
1217−inspect $ hasNoTypeClasses 'concatMapWithAppend
1218−inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
1221−{-# INLINE concatMapWithWSerial #-}
1222−concatMapWithWSerial :: Int -> Int -> Int -> IO ()
1223−concatMapWithWSerial = concatStreamsWith S.wSerial
1226−inspect $ hasNoTypeClasses 'concatMapWithWSerial
1227−inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
1232−-- concatUnfold replicate/unfoldrM
1234−{-# INLINE concatUnfoldRepl4xN #-}
1235−concatUnfoldRepl4xN :: Int -> Int -> IO ()
1236−concatUnfoldRepl4xN value n =
1237− S.drain $ S.concatUnfold
1239− (sourceUnfoldrMN (value `div` 4) n)
1242−inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN
1243−inspect $ 'concatUnfoldRepl4xN `hasNoType` ''D.ConcatMapUState
1244−inspect $ 'concatUnfoldRepl4xN `hasNoType` ''SPEC
1247−{-# INLINE concatUnfoldInterleaveRepl4xN #-}
1248−concatUnfoldInterleaveRepl4xN :: Int -> Int -> IO ()
1249−concatUnfoldInterleaveRepl4xN value n =
1250− S.drain $ Internal.concatUnfoldInterleave
1252− (sourceUnfoldrMN (value `div` 4) n)
1255−inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN
1256−-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''SPEC
1257−-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState
1260−{-# INLINE concatUnfoldRoundrobinRepl4xN #-}
1261−concatUnfoldRoundrobinRepl4xN :: Int -> Int -> IO ()
1262−concatUnfoldRoundrobinRepl4xN value n =
1263− S.drain $ Internal.concatUnfoldRoundrobin
1265− (sourceUnfoldrMN (value `div` 4) n)
1268−inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN
1269−-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''SPEC
1270−-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState
1273−-------------------------------------------------------------------------------
1274−-- Monad transformation (hoisting etc.)
1275−-------------------------------------------------------------------------------
1277−{-# INLINE sourceUnfoldrState #-}
1278−sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
1279− => Int -> Int -> t (StateT Int m) Int
1280−sourceUnfoldrState value n = S.unfoldrM step n
1284− then return Nothing
1288− return (Just (s, cnt + 1))
1290−{-# INLINE evalStateT #-}
1291−evalStateT :: S.MonadAsync m => Int -> Int -> Stream m Int
1292−evalStateT value n = Internal.evalStateT 0 (sourceUnfoldrState value n)
1294−{-# INLINE withState #-}
1295−withState :: S.MonadAsync m => Int -> Int -> Stream m Int
1297− Internal.evalStateT (0 :: Int) (Internal.liftInner (sourceUnfoldrM value n))
1299−-------------------------------------------------------------------------------
1300−-- Concurrent application/fold
1301−-------------------------------------------------------------------------------
1303−{-# INLINE parAppMap #-}
1304−parAppMap :: S.MonadAsync m => Stream m Int -> m ()
1305−parAppMap src = S.drain $ S.map (+1) S.|$ src
1307−{-# INLINE parAppSum #-}
1308−parAppSum :: S.MonadAsync m => Stream m Int -> m ()
1309−parAppSum src = (S.sum S.|$. src) >>= \x -> P.seq x (return ())
1311−-------------------------------------------------------------------------------
1312−-- Type class instances
1313−-------------------------------------------------------------------------------
1315−{-# INLINE eqInstance #-}
1316−eqInstance :: Stream Identity Int -> Bool
1317−eqInstance src = src == src
1319−{-# INLINE eqInstanceNotEq #-}
1320−eqInstanceNotEq :: Stream Identity Int -> Bool
1321−eqInstanceNotEq src = src P./= src
1323−{-# INLINE ordInstance #-}
1324−ordInstance :: Stream Identity Int -> Bool
1325−ordInstance src = src P.< src
1327−{-# INLINE ordInstanceMin #-}
1328−ordInstanceMin :: Stream Identity Int -> Stream Identity Int
1329−ordInstanceMin src = P.min src src
1331−{-# INLINE showInstance #-}
1332−showInstance :: Stream Identity Int -> P.String
1333−showInstance src = P.show src
1335−{-# INLINE showInstanceList #-}
1336−showInstanceList :: [Int] -> P.String
1337−showInstanceList src = P.show src
1339−{-# INLINE readInstance #-}
1340−readInstance :: P.String -> Stream Identity Int
1342− let r = P.reads str
1345− _ -> P.error "readInstance: no parse"
1347−{-# INLINE readInstanceList #-}
1348−readInstanceList :: P.String -> [Int]
1349−readInstanceList str =
1350− let r = P.reads str
1353− _ -> P.error "readInstance: no parse"
1355−-------------------------------------------------------------------------------
1356−-- Pure (Identity) streams
1357−-------------------------------------------------------------------------------
1359−{-# INLINE pureFoldl' #-}
1360−pureFoldl' :: Stream Identity Int -> Int
1361−pureFoldl' = runIdentity . S.foldl' (+) 0
1363−-------------------------------------------------------------------------------
1364−-- Foldable Instance
1365−-------------------------------------------------------------------------------
1367−{-# INLINE foldableFoldl' #-}
1368−foldableFoldl' :: Int -> Int -> Int
1369−foldableFoldl' value n =
1370− F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
1372−{-# INLINE foldableFoldrElem #-}
1373−foldableFoldrElem :: Int -> Int -> Bool
1374−foldableFoldrElem value n =
1375− F.foldr (\x xs -> if x == value then P.True else xs)
1377− (sourceUnfoldr value n :: S.SerialT Identity Int)
1379−{-# INLINE foldableSum #-}
1380−foldableSum :: Int -> Int -> Int
1381−foldableSum value n =
1382− P.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
1384−{-# INLINE foldableProduct #-}
1385−foldableProduct :: Int -> Int -> Int
1386−foldableProduct value n =
1387− P.product (sourceUnfoldr value n :: S.SerialT Identity Int)
1389−{-# INLINE _foldableNull #-}
1390−_foldableNull :: Int -> Int -> Bool
1391−_foldableNull value n =
1392− P.null (sourceUnfoldr value n :: S.SerialT Identity Int)
1394−{-# INLINE foldableElem #-}
1395−foldableElem :: Int -> Int -> Bool
1396−foldableElem value n =
1397− P.elem value (sourceUnfoldr value n :: S.SerialT Identity Int)
1399−{-# INLINE foldableNotElem #-}
1400−foldableNotElem :: Int -> Int -> Bool
1401−foldableNotElem value n =
1402− P.notElem value (sourceUnfoldr value n :: S.SerialT Identity Int)
1404−{-# INLINE foldableFind #-}
1405−foldableFind :: Int -> Int -> Maybe Int
1406−foldableFind value n =
1407− F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
1409−{-# INLINE foldableAll #-}
1410−foldableAll :: Int -> Int -> Bool
1411−foldableAll value n =
1412− P.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
1414−{-# INLINE foldableAny #-}
1415−foldableAny :: Int -> Int -> Bool
1416−foldableAny value n =
1417− P.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
1419−{-# INLINE foldableAnd #-}
1420−foldableAnd :: Int -> Int -> Bool
1421−foldableAnd value n =
1422− P.and $ S.map (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
1424−{-# INLINE foldableOr #-}
1425−foldableOr :: Int -> Int -> Bool
1426−foldableOr value n =
1427− P.or $ S.map (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
1429−{-# INLINE foldableLength #-}
1430−foldableLength :: Int -> Int -> Int
1431−foldableLength value n =
1432− P.length (sourceUnfoldr value n :: S.SerialT Identity Int)
1434−{-# INLINE foldableMin #-}
1435−foldableMin :: Int -> Int -> Int
1436−foldableMin value n =
1437− P.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
1439−{-# INLINE foldableMax #-}
1440−foldableMax :: Int -> Int -> Int
1441−foldableMax value n =
1442− P.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
1444−{-# INLINE foldableMinBy #-}
1445−foldableMinBy :: Int -> Int -> Int
1446−foldableMinBy value n =
1447− F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
1449−{-# INLINE foldableListMinBy #-}
1450−foldableListMinBy :: Int -> Int -> Int
1451−foldableListMinBy value n = F.minimumBy compare [1..value+n]
1453−{-# INLINE foldableMaxBy #-}
1454−foldableMaxBy :: Int -> Int -> Int
1455−foldableMaxBy value n =
1456− F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
1458−{-# INLINE foldableToList #-}
1459−foldableToList :: Int -> Int -> [Int]
1460−foldableToList value n =
1461− F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
1463−{-# INLINE foldableMapM_ #-}
1464−foldableMapM_ :: Monad m => Int -> Int -> m ()
1465−foldableMapM_ value n =
1466− F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)
1468−{-# INLINE foldableSequence_ #-}
1469−foldableSequence_ :: Int -> Int -> IO ()
1470−foldableSequence_ value n =
1471− F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
1473−{-# INLINE _foldableMsum #-}
1474−_foldableMsum :: Int -> Int -> IO Int
1475−_foldableMsum value n =
1476− F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
1478−-------------------------------------------------------------------------------
1479−-- Traversable Instance
1480−-------------------------------------------------------------------------------
1482−{-# INLINE traversableTraverse #-}
1483−traversableTraverse :: Stream Identity Int -> IO (Stream Identity Int)
1484−traversableTraverse = P.traverse return
1486−{-# INLINE traversableSequenceA #-}
1487−traversableSequenceA :: Stream Identity Int -> IO (Stream Identity Int)
1488−traversableSequenceA = P.sequenceA . P.fmap return
1490−{-# INLINE traversableMapM #-}
1491−traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)
1492−traversableMapM = P.mapM return
1494−{-# INLINE traversableSequence #-}
1495−traversableSequence :: Stream Identity Int -> IO (Stream Identity Int)
1496−traversableSequence = P.sequence . P.fmap return
1498−-------------------------------------------------------------------------------
1500−-------------------------------------------------------------------------------
1502−-- We need a monadic bind here to make sure that the function f does not get
1503−-- completely optimized out by the compiler in some cases.
1505−-- | Takes a fold method, and uses it with a default source.
1506−{-# INLINE benchIOSink #-}
1508− :: (IsStream t, NFData b)
1509− => Int -> String -> (t IO Int -> IO b) -> Benchmark
1510−benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
1512−{-# INLINE benchHoistSink #-}
1514− :: (IsStream t, NFData b)
1515− => Int -> String -> (t Identity Int -> IO b) -> Benchmark
1516−benchHoistSink value name f =
1517− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
1519−-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but
1520−-- we can't use it as it requires MonadAsync constraint.
1521−{-# INLINE benchIdentitySink #-}
1523− :: (IsStream t, NFData b)
1524− => Int -> String -> (t Identity Int -> Identity b) -> Benchmark
1525−benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
1527−-- | Takes a source, and uses it with a default drain/fold method.
1528−{-# INLINE benchIOSrc #-}
1530− :: (t IO a -> SerialT IO a)
1534−benchIOSrc t name f =
1535− bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
1537−{-# INLINE benchPureSink #-}
1538−benchPureSink :: NFData b => Int -> String -> (SerialT Identity Int -> b) -> Benchmark
1539−benchPureSink value name f = benchPure name (sourceUnfoldr value) f
1541−{-# INLINE benchPureSinkIO #-}
1544− => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
1545−benchPureSinkIO value name f =
1546− bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
1548−{-# INLINE benchIO #-}
1549−benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
1550−benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
1552−-- | Takes a source, and uses it with a default drain/fold method.
1553−{-# INLINE benchSrcIO #-}
1555− :: (t IO a -> SerialT IO a)
1560− = bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
1562−{-# INLINE benchMonadicSrcIO #-}
1563−benchMonadicSrcIO :: String -> (Int -> IO ()) -> Benchmark
1564−benchMonadicSrcIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
1567−-------------------------------------------------------------------------------
1568−-- Serial : O(1) Space
1569−-------------------------------------------------------------------------------
1571−o_1_space_serial_pure :: Int -> [Benchmark]
1572−o_1_space_serial_pure value =
1577− [ benchPureSink value "id" P.id
1578− , benchPureSink1 "eqBy" (eqByPure value)
1579− , benchPureSink value "==" eqInstance
1580− , benchPureSink value "/=" eqInstanceNotEq
1581− , benchPureSink1 "cmpBy" (cmpByPure value)
1582− , benchPureSink value "<" ordInstance
1583− , benchPureSink value "min" ordInstanceMin
1584− , benchPureSrc "IsList.fromList" (sourceIsList value)
1585− -- length is used to check for foldr/build fusion
1588− "length . IsList.toList"
1589− (P.length . GHC.toList)
1590− , benchPureSrc "IsString.fromString" (sourceIsString value)
1591− , benchPureSink value "showsPrec pure streams" showInstance
1592− , benchPureSink value "foldl'" pureFoldl'
1597−o_1_space_serial_foldable :: Int -> [Benchmark]
1598−o_1_space_serial_foldable value =
1603− -- Foldable instance
1604− -- type class operations
1605− [ bench "foldl'" $ nf (foldableFoldl' value) 1
1606− , bench "foldrElem" $ nf (foldableFoldrElem value) 1
1607− -- , bench "null" $ nf (_foldableNull value) 1
1608− , bench "elem" $ nf (foldableElem value) 1
1609− , bench "length" $ nf (foldableLength value) 1
1610− , bench "sum" $ nf (foldableSum value) 1
1611− , bench "product" $ nf (foldableProduct value) 1
1612− , bench "minimum" $ nf (foldableMin value) 1
1613− , bench "maximum" $ nf (foldableMax value) 1
1614− , bench "length . toList" $
1615− nf (P.length . foldableToList value) 1
1617− , bench "notElem" $ nf (foldableNotElem value) 1
1618− , bench "find" $ nf (foldableFind value) 1
1619− , bench "all" $ nf (foldableAll value) 1
1620− , bench "any" $ nf (foldableAny value) 1
1621− , bench "and" $ nf (foldableAnd value) 1
1622− , bench "or" $ nf (foldableOr value) 1
1623− -- Note: minimumBy/maximumBy do not work in constant memory they are in
1624− -- the O(n) group of benchmarks down below in this file.
1625− -- Applicative and Traversable operations
1627− , benchIOSink1 "mapM_" (foldableMapM_ value)
1630− , benchIOSink1 "sequence_" (foldableSequence_ value)
1633− -- , benchIOSink1 "msum" (_foldableMsum value)
1638−o_1_space_serial_generation :: Int -> [Benchmark]
1639−o_1_space_serial_generation value =
1644− -- Most basic, barely stream continuations running
1645− [ benchIOSrc serially "unfoldr" (sourceUnfoldr value)
1646− , benchIOSrc serially "unfoldrM" (sourceUnfoldrM value)
1647− , benchIOSrc serially "intFromTo" (sourceIntFromTo value)
1651− (sourceIntFromThenTo value)
1655− (sourceIntegerFromStep value)
1659− (sourceFracFromThenTo value)
1660− , benchIOSrc serially "fracFromTo" (sourceFracFromTo value)
1661− , benchIOSrc serially "fromList" (sourceFromList value)
1662− , benchIOSrc serially "fromListM" (sourceFromListM value)
1663− -- These are essentially cons and consM
1667− (sourceFromFoldable value)
1671− (sourceFromFoldableM value)
1672− , benchIOSrc serially "absTimes" $
1678−o_1_space_serial_elimination :: Int -> [Benchmark]
1679−o_1_space_serial_elimination value =
1688− [ benchIOSink value "foldl'" foldl'Reduce
1689− , benchIOSink value "foldl1'" foldl1'Reduce
1690− , benchIOSink value "foldlM'" foldlM'Reduce
1694− [ benchIdentitySink value "foldl'" foldl'Reduce
1695− , benchIdentitySink
1699− , benchIdentitySink
1716− [ benchIdentitySink
1720− , benchIdentitySink
1722− "foldrMToStreamLength"
1723− (S.length . runIdentity . foldrMToStream)
1726− "foldrMToListLength"
1727− (P.length . runIdentity . foldrMBuild)
1730− , benchIOSink value "uncons" uncons
1731− , benchIOSink value "toNull" $ toNull serially
1732− , benchIOSink value "mapM_" mapM_
1733− , benchIOSink value "init" init
1734− -- this is too low and causes all benchmarks reported in ns
1735− -- , benchIOSink value "head" head
1736− , benchIOSink value "last" last
1737− -- , benchIOSink value "lookup" lookup
1738− , benchIOSink value "find" (find value)
1739− , benchIOSink value "findIndex" (findIndex value)
1740− , benchIOSink value "elemIndex" (elemIndex value)
1741− -- this is too low and causes all benchmarks reported in ns
1742− -- , benchIOSink value "null" null
1743− , benchIOSink value "elem" (elem value)
1744− , benchIOSink value "notElem" (notElem value)
1745− , benchIOSink value "all" (all value)
1746− , benchIOSink value "any" (any value)
1747− , benchIOSink value "and" (and value)
1748− , benchIOSink value "or" (or value)
1749− , benchIOSink value "length" length
1752− "length . generally"
1753− (length . IP.generally)
1754− , benchIOSink value "sum" sum
1755− , benchIOSink value "product" product
1756− , benchIOSink value "maximumBy" maximumBy
1757− , benchIOSink value "maximum" maximum
1758− , benchIOSink value "minimumBy" minimumBy
1759− , benchIOSink value "minimum" minimum
1764−o_1_space_serial_foldMultiStream :: Int -> [Benchmark]
1765−o_1_space_serial_foldMultiStream value =
1769− "fold-multi-stream"
1770− [ benchIOSink1 "eqBy" (eqBy value)
1771− , benchIOSink1 "cmpBy" (cmpBy value)
1772− , benchIOSink value "isPrefixOf" isPrefixOf
1773− , benchIOSink value "isSubsequenceOf" isSubsequenceOf
1774− , benchIOSink value "stripPrefix" stripPrefix
1779−o_1_space_serial_pipes :: Int -> [Benchmark]
1780−o_1_space_serial_pipes value =
1785− [ benchIOSink value "mapM" (transformMapM serially 1)
1789− (transformComposeMapM serially 1)
1790− , benchIOSink value "tee" (transformTeeMapM serially 1)
1791− , benchIOSink value "zip" (transformZipMapM serially 1)
1796−o_1_space_serial_pipesX4 :: Int -> [Benchmark]
1797−o_1_space_serial_pipesX4 value =
1802− [ benchIOSink value "mapM" (transformMapM serially 4)
1806− (transformComposeMapM serially 4)
1807− , benchIOSink value "tee" (transformTeeMapM serially 4)
1808− , benchIOSink value "zip" (transformZipMapM serially 4)
1814−o_1_space_serial_transformer :: Int -> [Benchmark]
1815−o_1_space_serial_transformer value =
1820− [ benchIOSrc serially "evalState" (evalStateT value)
1821− , benchIOSrc serially "withState" (withState value)
1826−o_1_space_serial_transformation :: Int -> [Benchmark]
1827−o_1_space_serial_transformation value =
1832− [ benchIOSink value "scanl" (scan 1)
1833− , benchIOSink value "scanl1'" (scanl1' 1)
1834− , benchIOSink value "map" (map 1)
1835− , benchIOSink value "fmap" (fmap 1)
1836− , benchIOSink value "mapM" (mapM serially 1)
1837− , benchIOSink value "mapMaybe" (mapMaybe 1)
1838− , benchIOSink value "mapMaybeM" (mapMaybeM 1)
1839− , bench "sequence" $
1841− randomRIO (1, 1000) >>= \n ->
1842− sequence serially (sourceUnfoldrMAction value n)
1843− , benchIOSink value "findIndices" (findIndices value 1)
1844− , benchIOSink value "elemIndices" (elemIndices value 1)
1845− , benchIOSink value "foldrS" (foldrS 1)
1846− , benchIOSink value "foldrSMap" (foldrSMap 1)
1847− , benchIOSink value "foldrT" (foldrT 1)
1848− , benchIOSink value "foldrTMap" (foldrTMap 1)
1849− , benchIOSink value "tap" (tap 1)
1850− , benchIOSink value "tapRate 1 second" (tapRate 1)
1851− , benchIOSink value "pollCounts 1 second" (pollCounts 1)
1852− , benchIOSink value "tapAsync" (tapAsync 1)
1853− , benchIOSink value "tapAsyncS" (tapAsyncS 1)
1854− , benchIOSink value "timestamped" timestamped
1859−o_1_space_serial_transformationX4 :: Int -> [Benchmark]
1860−o_1_space_serial_transformationX4 value =
1865− [ benchIOSink value "scan" (scan 4)
1866− , benchIOSink value "scanl1'" (scanl1' 4)
1867− , benchIOSink value "map" (map 4)
1868− , benchIOSink value "fmap" (fmap 4)
1869− , benchIOSink value "mapM" (mapM serially 4)
1870− , benchIOSink value "mapMaybe" (mapMaybe 4)
1871− , benchIOSink value "mapMaybeM" (mapMaybeM 4)
1872− -- , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
1873− -- sequence serially (sourceUnfoldrMAction n)
1874− , benchIOSink value "findIndices" (findIndices value 4)
1875− , benchIOSink value "elemIndices" (elemIndices value 4)
1880−o_1_space_serial_filtering :: Int -> [Benchmark]
1881−o_1_space_serial_filtering value =
1886− [ benchIOSink value "filter-even" (filterEven 1)
1887− , benchIOSink value "filter-all-out" (filterAllOut value 1)
1888− , benchIOSink value "filter-all-in" (filterAllIn value 1)
1889− , benchIOSink value "take-all" (takeAll value 1)
1893− (takeByTime (NanoSecond64 maxBound) 1)
1894− , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
1895− --, benchIOSink value "takeWhileM-true" (_takeWhileMTrue 1)
1896− -- "drop-one" is dual to "last"
1897− , benchIOSink value "drop-one" (dropOne 1)
1898− , benchIOSink value "drop-all" (dropAll value 1)
1902− (dropByTime (NanoSecond64 maxBound) 1)
1903− , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
1904− --, benchIOSink value "dropWhileM-true" (_dropWhileMTrue 1)
1908− (dropWhileFalse value 1)
1909− , benchIOSink value "deleteBy" (deleteBy value 1)
1910− , benchIOSink value "intersperse" (intersperse value 1)
1911− , benchIOSink value "insertBy" (insertBy value 1)
1916−o_1_space_serial_filteringX4 :: Int -> [Benchmark]
1917−o_1_space_serial_filteringX4 value =
1922− [ benchIOSink value "filter-even" (filterEven 4)
1923− , benchIOSink value "filter-all-out" (filterAllOut value 4)
1924− , benchIOSink value "filter-all-in" (filterAllIn value 4)
1925− , benchIOSink value "take-all" (takeAll value 4)
1926− , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
1927− --, benchIOSink value "takeWhileM-true" (_takeWhileMTrue 4)
1928− , benchIOSink value "drop-one" (dropOne 4)
1929− , benchIOSink value "drop-all" (dropAll value 4)
1930− , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)
1931− --, benchIOSink value "dropWhileM-true" (_dropWhileMTrue 4)
1935− (dropWhileFalse value 4)
1936− , benchIOSink value "deleteBy" (deleteBy value 4)
1937− , benchIOSink value "intersperse" (intersperse value 4)
1938− , benchIOSink value "insertBy" (insertBy value 4)
1943−o_1_space_serial_joining :: Int -> [Benchmark]
1944−o_1_space_serial_joining value =
1949− [ benchIOSrc1 "zip (2,x/2)" (zip (value `div` 2))
1950− , benchIOSrc1 "zipM (2,x/2)" (zipM (value `div` 2))
1951− , benchIOSrc1 "mergeBy (2,x/2)" (mergeBy (value `div` 2))
1952− , benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
1953− , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))
1954− , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
1955− , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
1956− , benchIOSrc1 "wSerial (2,x/2)" (wSerial2 value) -- XXX Move this elsewhere?
1957− , benchIOSrc1 "interleave (2,x/2)" (interleave2 value)
1958− , benchIOSrc1 "roundRobin (2,x/2)" (roundRobin2 value)
1963−o_1_space_serial_concatFoldable :: Int -> [Benchmark]
1964−o_1_space_serial_concatFoldable value =
1972− (sourceFoldMapWith value)
1976− (sourceFoldMapWithM value)
1977− , benchIOSrc serially "foldMapM" (sourceFoldMapM value)
1980− "foldWithConcatMapId"
1981− (sourceConcatMapId value)
1986−o_1_space_serial_concatSerial :: Int -> [Benchmark]
1987−o_1_space_serial_concatSerial value =
1993− "concatMapPure (2,x/2)"
1994− (concatMapPure 2 (value `div` 2))
1996− "concatMap (2,x/2)"
1997− (concatMap 2 (value `div` 2))
1999− "concatMap (x/2,2)"
2000− (concatMap (value `div` 2) 2)
2002− "concatMapRepl (x/4,4)"
2003− (concatMapRepl4xN value)
2005− "concatUnfoldRepl (x/4,4)"
2006− (concatUnfoldRepl4xN value)
2008− "concatMapWithSerial (2,x/2)"
2009− (concatMapWithSerial 2 (value `div` 2))
2011− "concatMapWithSerial (x/2,2)"
2012− (concatMapWithSerial (value `div` 2) 2)
2014− "concatMapWithAppend (2,x/2)"
2015− (concatMapWithAppend 2 (value `div` 2))
2020−o_1_space_serial_outerProductStreams :: Int -> [Benchmark]
2021−o_1_space_serial_outerProductStreams value =
2025− "outer-product-streams"
2026− [ benchIO "toNullAp" $ Nested.toNullAp value serially
2027− , benchIO "toNull" $ Nested.toNull value serially
2028− , benchIO "toNull3" $ Nested.toNull3 value serially
2029− , benchIO "filterAllOut" $ Nested.filterAllOut value serially
2030− , benchIO "filterAllIn" $ Nested.filterAllIn value serially
2031− , benchIO "filterSome" $ Nested.filterSome value serially
2032− , benchIO "breakAfterSome" $
2033− Nested.breakAfterSome value serially
2038−o_1_space_serial_mixed :: Int -> [Benchmark]
2039−o_1_space_serial_mixed value =
2042− -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
2043− -- library. If scan/fold followed by a map is efficient enough we may not
2044− -- need monolithic implementations of these.
2047− [ benchIOSink value "scanl-map" (scanMap 1)
2048− , benchIOSink value "foldl-map" foldl'ReduceMap
2049− , benchIOSink value "sum-product-fold" sumProductFold
2050− , benchIOSink value "sum-product-scan" sumProductScan
2055−o_1_space_serial_mixedX4 :: Int -> [Benchmark]
2056−o_1_space_serial_mixedX4 value =
2061− [ benchIOSink value "scan-map" (scanMap 4)
2062− , benchIOSink value "drop-map" (dropMap 4)
2063− , benchIOSink value "drop-scan" (dropScan 4)
2064− , benchIOSink value "take-drop" (takeDrop value 4)
2065− , benchIOSink value "take-scan" (takeScan value 4)
2066− , benchIOSink value "take-map" (takeMap value 4)
2067− , benchIOSink value "filter-drop" (filterDrop value 4)
2068− , benchIOSink value "filter-take" (filterTake value 4)
2069− , benchIOSink value "filter-scan" (filterScan 4)
2070− , benchIOSink value "filter-scanl1" (filterScanl1 4)
2071− , benchIOSink value "filter-map" (filterMap value 4)
2076−o_1_space_wSerial_transformation :: Int -> [Benchmark]
2077−o_1_space_wSerial_transformation value =
2082− [benchIOSink value "fmap" $ fmap' wSerially 1]
2086−o_1_space_wSerial_concatMap :: Int -> [Benchmark]
2087−o_1_space_wSerial_concatMap value =
2093− "concatMapWithWSerial (2,x/2)"
2094− (concatMapWithWSerial 2 (value `div` 2))
2096− "concatMapWithWSerial (x/2,2)"
2097− (concatMapWithWSerial (value `div` 2) 2)
2102−o_1_space_wSerial_outerProduct :: Int -> [Benchmark]
2103−o_1_space_wSerial_outerProduct value =
2108− [ benchIO "toNullAp" $ Nested.toNullAp value wSerially
2109− , benchIO "toNull" $ Nested.toNull value wSerially
2110− , benchIO "toNull3" $ Nested.toNull3 value wSerially
2111− , benchIO "filterAllOut" $ Nested.filterAllOut value wSerially
2112− , benchIO "filterAllIn" $ Nested.filterAllIn value wSerially
2113− , benchIO "filterSome" $ Nested.filterSome value wSerially
2114− , benchIO "breakAfterSome" $
2115− Nested.breakAfterSome value wSerially
2120−o_1_space_zipSerial_transformation :: Int -> [Benchmark]
2121−o_1_space_zipSerial_transformation value =
2126− [benchIOSink value "fmap" $ fmap' zipSerially 1]
2127− -- XXX needs fixing
2129− , bgroup "outer-product"
2130− [ benchIO "toNullAp" $ Nested.toNullAp value zipSerially
2136−-------------------------------------------------------------------------------
2137−-- Serial : O(n) Space
2138−-------------------------------------------------------------------------------
2140−o_n_space_serial_toContainers :: Int -> [Benchmark]
2141−o_n_space_serial_toContainers value =
2146− -- Converting the stream to a list or pure stream in a strict monad
2147− [ benchIOSink value "foldrMToList" foldrMBuild
2148− , benchIOSink value "toList" toList
2149− , benchIOSink value "toListRev" toListRev
2150− -- , benchIOSink value "toPure" toPure
2151− -- , benchIOSink value "toPureRev" toPureRev
2153− , benchIOSink (value `div` 10) "classifySessionsOf"
2158−o_n_space_serial_outerProductStreams :: Int -> [Benchmark]
2159−o_n_space_serial_outerProductStreams value =
2163− "outer-product-streams"
2164− [ benchIO "toList" $ Nested.toList value serially
2165− , benchIO "toListSome" $ Nested.toListSome value serially
2170−o_n_space_wSerial_outerProductStreams :: Int -> [Benchmark]
2171−o_n_space_wSerial_outerProductStreams value =
2175− "outer-product-streams"
2176− [ benchIO "toList" $ Nested.toList value wSerially
2177− , benchIO "toListSome" $ Nested.toListSome value wSerially
2182−o_n_space_serial_traversable :: Int -> [Benchmark]
2183−o_n_space_serial_traversable value =
2186− -- Buffering operations using heap proportional to number of elements.
2188− "traversable" -- < 2MB
2189− -- Traversable instance
2190− [ benchPureSinkIO value "traverse" traversableTraverse
2191− , benchPureSinkIO value "sequenceA" traversableSequenceA
2192− , benchPureSinkIO value "mapM" traversableMapM
2193− , benchPureSinkIO value "sequence" traversableSequence
2198−o_n_space_serial_foldr :: Int -> [Benchmark]
2199−o_n_space_serial_foldr value =
2202− -- Head recursive strict right folds.
2206− -- accumulation due to strictness of IO monad
2207− [ benchIOSink value "foldrM/build/IO" foldrMBuild
2208− -- Right folds for reducing are inherently non-streaming as the
2209− -- expression needs to be fully built before it can be reduced.
2210− , benchIdentitySink
2212− "foldrM/reduce/Identity"
2215− , benchIOSink value "foldrM/reduce/IO" foldrMReduce
2216− -- XXX the definitions of minimumBy and maximumBy in Data.Foldable use
2217− -- foldl1 which does not work in constant memory for our implementation.
2218− -- It works in constant memory for lists but even for lists it takes 15x
2219− -- more time compared to our foldl' based implementation.
2220− -- XXX these take < 16M stack space
2221− , bench "minimumBy" $ nf (flip foldableMinBy 1) value
2222− , bench "maximumBy" $ nf (flip foldableMaxBy 1) value
2223− , bench "minimumByList" $ nf (flip foldableListMinBy 1) value
2229−o_n_heap_serial_foldl :: Int -> [Benchmark]
2230−o_n_heap_serial_foldl value =
2235− -- Left folds for building a structure are inherently non-streaming
2236− -- as the structure cannot be lazily consumed until fully built.
2237− [ benchIOSink value "foldl'/build/IO" foldl'Build
2238− , benchIdentitySink value "foldl'/build/Identity" foldl'Build
2239− , benchIOSink value "foldlM'/build/IO" foldlM'Build
2240− , benchIdentitySink
2242− "foldlM'/build/Identity"
2244− -- Reversing/sorting a stream
2245− , benchIOSink value "reverse" (reverse 1)
2246− , benchIOSink value "reverse'" (reverse' 1)
2251−o_n_heap_serial_buffering :: Int -> [Benchmark]
2252−o_n_heap_serial_buffering value =
2257− -- Buffers the output of show/read.
2258− -- XXX can the outputs be streaming? Can we have special read/show
2259− -- style type classes, readM/showM supporting streaming effects?
2260− [ bench "readsPrec pure streams" $
2261− nf readInstance (mkString value)
2262− , bench "readsPrec Haskell lists" $
2263− nf readInstanceList (mkListString value)
2264− , bench "showPrec Haskell lists" $
2265− nf showInstanceList (mkList value)
2266− -- interleave x/4 streams of 4 elements each. Needs to buffer
2267− -- proportional to x/4. This is different from WSerial because
2268− -- WSerial expands slowly because of binary interleave behavior and
2269− -- this expands immediately because of Nary interleave behavior.
2271− "concatUnfoldInterleaveRepl (x/4,4)"
2272− (concatUnfoldInterleaveRepl4xN value)
2274− "concatUnfoldRoundrobinRepl (x/4,4)"
2275− (concatUnfoldRoundrobinRepl4xN value)
2280−-- Head recursive operations.
2281−o_n_stack_serial_iterated :: Int -> [Benchmark]
2282−o_n_stack_serial_iterated value =
2287− [ benchIOSrc serially "mapMx10K" iterateMapM
2288− , benchIOSrc serially "scanx100" iterateScan
2289− , benchIOSrc serially "scanl1x100" iterateScanl1
2290− , benchIOSrc serially "filterEvenx10K" iterateFilterEven
2291− , benchIOSrc serially "takeAllx10K" (iterateTakeAll value)
2292− , benchIOSrc serially "dropOnex10K" iterateDropOne
2295− "dropWhileFalsex10K"
2296− (iterateDropWhileFalse value)
2299− "dropWhileTruex10K"
2300− (iterateDropWhileTrue value)
2301− , benchIOSink value "tail" tail
2302− , benchIOSink value "nullHeadTail" nullHeadTail
2307−o_1_space_async_generation :: Int -> [Benchmark]
2308−o_1_space_async_generation value =
2313− [ benchSrcIO asyncly "unfoldr" (sourceUnfoldr value)
2314− , benchSrcIO asyncly "unfoldrM" (sourceUnfoldrM value)
2315− , benchSrcIO asyncly "fromFoldable" (sourceFromFoldable value)
2316− , benchSrcIO asyncly "fromFoldableM" (sourceFromFoldableM value)
2319− "unfoldrM maxThreads 1"
2320− (maxThreads 1 . sourceUnfoldrM value)
2323− "unfoldrM maxBuffer 1 (x/10 ops)"
2324− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2329−o_1_space_async_concatFoldable :: Int -> [Benchmark]
2330−o_1_space_async_concatFoldable value =
2335− [ benchSrcIO asyncly "foldMapWith" (sourceFoldMapWith value)
2339− (sourceFoldMapWithM value)
2340− , benchSrcIO asyncly "foldMapM" (sourceFoldMapM value)
2345−o_1_space_async_concatMap :: Int -> [Benchmark]
2346−o_1_space_async_concatMap value =
2352− [ benchMonadicSrcIO
2353− "concatMapWith (2,x/2)"
2354− (concatStreamsWith async 2 (value `div` 2))
2355− , benchMonadicSrcIO
2356− "concatMapWith (sqrt x,sqrt x)"
2357− (concatStreamsWith async value2 value2)
2358− , benchMonadicSrcIO
2359− "concatMapWith (sqrt x * 2,sqrt x / 2)"
2360− (concatStreamsWith async (value2 * 2) (value2 `div` 2))
2365− value2 = round $ sqrt $ (fromIntegral value :: Double)
2367−o_1_space_async_transformation :: Int -> [Benchmark]
2368−o_1_space_async_transformation value =
2373− [ benchIOSink value "map" $ map' asyncly 1
2374− , benchIOSink value "fmap" $ fmap' asyncly 1
2375− , benchIOSink value "mapM" $ mapM asyncly 1
2380−o_1_space_wAsync_generation :: Int -> [Benchmark]
2381−o_1_space_wAsync_generation value =
2386− [ benchSrcIO wAsyncly "unfoldr" (sourceUnfoldr value)
2387− , benchSrcIO wAsyncly "unfoldrM" (sourceUnfoldrM value)
2388− , benchSrcIO wAsyncly "fromFoldable" (sourceFromFoldable value)
2392− (sourceFromFoldableM value)
2395− "unfoldrM maxThreads 1"
2396− (maxThreads 1 . sourceUnfoldrM value)
2399− "unfoldrM maxBuffer 1 (x/10 ops)"
2400− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2405−o_1_space_wAsync_concatFoldable :: Int -> [Benchmark]
2406−o_1_space_wAsync_concatFoldable value =
2411− [ benchSrcIO wAsyncly "foldMapWith" (sourceFoldMapWith value)
2412− , benchSrcIO wAsyncly "foldMapWithM" (sourceFoldMapWithM value)
2413− , benchSrcIO wAsyncly "foldMapM" (sourceFoldMapM value)
2418−-- When we merge streams using wAsync the size of the queue increases
2419−-- slowly because of the binary composition adding just one more item
2420−-- to the work queue only after every scheduling pass through the
2423−-- We should see the memory consumption increasing slowly if these
2424−-- benchmarks are left to run on infinite number of streams of infinite
2426−o_1_space_wAsync_concatMap :: Int -> [Benchmark]
2427−o_1_space_wAsync_concatMap value =
2431− [ benchMonadicSrcIO
2432− "concatMapWith (2,x/2)"
2433− (concatStreamsWith wAsync 2 (value `div` 2))
2434− , benchMonadicSrcIO
2435− "concatMapWith (sqrt x,sqrt x)"
2436− (concatStreamsWith wAsync value2 value2)
2437− , benchMonadicSrcIO
2438− "concatMapWith (sqrt x * 2,sqrt x / 2)"
2439− (concatStreamsWith wAsync (value2 * 2) (value2 `div` 2))
2443− value2 = round $ sqrt $ (fromIntegral value :: Double)
2445−o_1_space_wAsync_transformation :: Int -> [Benchmark]
2446−o_1_space_wAsync_transformation value =
2451− [ benchIOSink value "map" $ map' wAsyncly 1
2452− , benchIOSink value "fmap" $ fmap' wAsyncly 1
2453− , benchIOSink value "mapM" $ mapM wAsyncly 1
2458−-- unfoldr and fromFoldable are always serial and therefore the same for
2459−-- all stream types. They can be removed to reduce the number of benchmarks.
2460−o_1_space_ahead_generation :: Int -> [Benchmark]
2461−o_1_space_ahead_generation value =
2466− [ benchSrcIO aheadly "unfoldr" (sourceUnfoldr value)
2467− , benchSrcIO aheadly "unfoldrM" (sourceUnfoldrM value)
2468−-- , benchSrcIO aheadly "fromFoldable" (sourceFromFoldable value)
2472− (sourceFromFoldableM value)
2475− "unfoldrM maxThreads 1"
2476− (maxThreads 1 . sourceUnfoldrM value)
2479− "unfoldrM maxBuffer 1 (x/10 ops)"
2480− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2485−o_1_space_ahead_concatFoldable :: Int -> [Benchmark]
2486−o_1_space_ahead_concatFoldable value =
2491− [ benchSrcIO aheadly "foldMapWith" (sourceFoldMapWith value)
2492− , benchSrcIO aheadly "foldMapWithM" (sourceFoldMapWithM value)
2493− , benchSrcIO aheadly "foldMapM" (sourceFoldMapM value)
2498−o_1_space_ahead_concatMap :: Int -> [Benchmark]
2499−o_1_space_ahead_concatMap value =
2503− [ benchMonadicSrcIO
2504− "concatMapWith (2,x/2)"
2505− (concatStreamsWith ahead 2 (value `div` 2))
2506− , benchMonadicSrcIO
2507− "concatMapWith (sqrt x,sqrt x)"
2508− (concatStreamsWith ahead value2 value2)
2509− , benchMonadicSrcIO
2510− "concatMapWith (sqrt x * 2,sqrt x / 2)"
2511− (concatStreamsWith ahead (value2 * 2) (value2 `div` 2))
2515− value2 = round $ sqrt $ (fromIntegral value :: Double)
2518−o_1_space_ahead_transformation :: Int -> [Benchmark]
2519−o_1_space_ahead_transformation value =
2524− [ benchIOSink value "map" $ map' aheadly 1
2525− , benchIOSink value "fmap" $ fmap' aheadly 1
2526− , benchIOSink value "mapM" $ mapM aheadly 1
2531−o_1_space_async_zip :: Int -> [Benchmark]
2532−o_1_space_async_zip value =
2540− (zipAsync (value `div` 2))
2543− "zipAsyncM (2,x/2)"
2544− (zipAsyncM (value `div` 2))
2547− "zipAsyncAp (2,x/2)"
2548− (zipAsyncAp (value `div` 2))
2549− , benchIOSink value "fmap zipAsyncly" $ fmap' S.zipAsyncly 1
2552− "mergeAsyncBy (2,x/2)"
2553− (mergeAsyncBy (value `div` 2))
2556− "mergeAsyncByM (2,x/2)"
2557− (mergeAsyncByM (value `div` 2))
2558− -- Parallel stages in a pipeline
2559− , benchIOSink value "parAppMap" parAppMap
2560− , benchIOSink value "parAppSum" parAppSum
2565−o_n_space_parallel_generation :: Int -> [Benchmark]
2566−o_n_space_parallel_generation value =
2571− [ benchSrcIO parallely "unfoldr" (sourceUnfoldr value)
2572− , benchSrcIO parallely "unfoldrM" (sourceUnfoldrM value)
2573−-- , benchSrcIO parallely "fromFoldable" (sourceFromFoldable value)
2577− (sourceFromFoldableM value)
2580− "unfoldrM maxThreads 1"
2581− (maxThreads 1 . sourceUnfoldrM value)
2584− "unfoldrM maxBuffer 1 (x/10 ops)"
2585− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2590−o_n_space_parallel_concatFoldable :: Int -> [Benchmark]
2591−o_n_space_parallel_concatFoldable value =
2596− [ benchSrcIO parallely "foldMapWith" (sourceFoldMapWith value)
2597− , benchSrcIO parallely "foldMapWithM" (sourceFoldMapWithM value)
2598− , benchSrcIO parallely "foldMapM" (sourceFoldMapM value)
2603−o_n_space_parallel_concatMap :: Int -> [Benchmark]
2604−o_n_space_parallel_concatMap value =
2608− [ benchMonadicSrcIO
2609− "concatMapWith (2,x/2)"
2610− (concatStreamsWith parallel 2 (value `div` 2))
2611− , benchMonadicSrcIO
2612− "concatMapWith (sqrt x,sqrt x)"
2613− (concatStreamsWith parallel value2 value2)
2614− , benchMonadicSrcIO
2615− "concatMapWith (sqrt x * 2,sqrt x / 2)"
2616− (concatStreamsWith parallel (value2 * 2) (value2 `div` 2))
2620− value2 = round $ sqrt $ (fromIntegral value :: Double)
2623−o_n_space_parallel_transformation :: Int -> [Benchmark]
2624−o_n_space_parallel_transformation value =
2629− [ benchIOSink value "map" $ map' parallely 1
2630− , benchIOSink value "fmap" $ fmap' parallely 1
2631− , benchIOSink value "mapM" $ mapM parallely 1
2636−o_n_space_parallel_outerProductStreams :: Int -> [Benchmark]
2637−o_n_space_parallel_outerProductStreams value =
2641− "outer-product-streams"
2642− [ benchIO "toNullAp" $ Nested.toNullAp value parallely
2643− , benchIO "toNull" $ Nested.toNull value parallely
2644− , benchIO "toNull3" $ Nested.toNull3 value parallely
2645− , benchIO "filterAllOut" $ Nested.filterAllOut value parallely
2646− , benchIO "filterAllIn" $ Nested.filterAllIn value parallely
2647− , benchIO "filterSome" $ Nested.filterSome value parallely
2648− , benchIO "breakAfterSome" $
2649− Nested.breakAfterSome value parallely
2654−o_n_space_parallel_outerProductStreams2 :: Int -> [Benchmark]
2655−o_n_space_parallel_outerProductStreams2 value =
2659− "outer-product-streams"
2660− [ benchIO "toList" $ Nested.toList value parallely
2661− , benchIO "toListSome" $ Nested.toListSome value parallely
2666−-- XXX arbitrarily large rate should be the same as rate Nothing
2667−o_1_space_async_avgRate :: Int -> [Benchmark]
2668−o_1_space_async_avgRate value =
2673− -- benchIO "unfoldr" $ toNull asyncly
2674− -- benchSrcIO asyncly "unfoldrM" (sourceUnfoldrM value)
2678− (S.rate Nothing . sourceUnfoldrM value)
2681− "unfoldrM/1,000,000"
2682− (S.avgRate 1000000 . sourceUnfoldrM value)
2685− "unfoldrM/3,000,000"
2686− (S.avgRate 3000000 . sourceUnfoldrM value)
2689− "unfoldrM/10,000,000/maxThreads1"
2691− S.avgRate 10000000 . sourceUnfoldrM value)
2694− "unfoldrM/10,000,000"
2695− (S.avgRate 10000000 . sourceUnfoldrM value)
2698− "unfoldrM/20,000,000"
2699− (S.avgRate 20000000 . sourceUnfoldrM value)
2704−o_1_space_ahead_avgRate :: Int -> [Benchmark]
2705−o_1_space_ahead_avgRate value =
2712− "unfoldrM/1,000,000"
2713− (S.avgRate 1000000 . sourceUnfoldrM value)