@@ -5,2712 +5,12 @@
55-- License : MIT
66-- Maintainer : streamly@composewell.com
77
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE DeriveAnyClass #-}
12−{-# LANGUAGE DeriveGeneric #-}
13−{-# LANGUAGE RankNTypes #-}
14−{-# LANGUAGE TupleSections #-}
15−
16−#ifdef __HADDOCK_VERSION__
17−#undef INSPECTION
18−#endif
19−
20−#ifdef INSPECTION
21−{-# LANGUAGE TemplateHaskell #-}
22−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
23−#endif
24−
258module Streamly.Benchmark.Prelude
26− -- TODO: export a single bench group for o_1_space_serial
27− ( o_1_space_serial_pure
28− , o_1_space_serial_foldable
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
45−
46− , o_1_space_wSerial_transformation
47− , o_1_space_wSerial_concatMap
48− , o_1_space_wSerial_outerProduct
49−
50− , o_1_space_zipSerial_transformation
51−
52− , o_n_space_serial_toContainers
53− , o_n_space_serial_outerProductStreams
54−
55− , o_n_space_wSerial_outerProductStreams
56−
57− , o_n_space_serial_traversable
58− , o_n_space_serial_foldr
59−
60− , o_n_heap_serial_foldl
61− , o_n_heap_serial_buffering
62−
63− , o_n_stack_serial_iterated
64−
65− , o_1_space_async_generation
66− , o_1_space_async_concatFoldable
67− , o_1_space_async_concatMap
68− , o_1_space_async_transformation
69−
70− , o_1_space_wAsync_generation
71− , o_1_space_wAsync_concatFoldable
72− , o_1_space_wAsync_concatMap
73− , o_1_space_wAsync_transformation
74−
75− , o_1_space_ahead_generation
76− , o_1_space_ahead_concatFoldable
77− , o_1_space_ahead_concatMap
78− , o_1_space_ahead_transformation
79−
80− , o_1_space_async_zip
81−
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
88−
89− , o_1_space_async_avgRate
90−
91− , o_1_space_ahead_avgRate
9+ ( module Streamly.Benchmark.Prelude.Generation
10+ , module Streamly.Benchmark.Prelude.Elimination
11+ , module Streamly.Benchmark.Prelude.Transformation
9212 ) where
9313
94−import Control.DeepSeq (NFData(..))
95−import Control.Monad (when)
96−import Control.Monad.IO.Class (MonadIO(..))
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)
102−import Prelude
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
110−
111−#ifdef INSPECTION
112−import GHC.Types (SPEC(..))
113−import Test.Inspection
114−
115−import qualified Streamly.Internal.Data.Stream.StreamD as D
116−#endif
117−
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
126−
127−import qualified Streamly.Internal.Prelude as IP
128−
129−import qualified Streamly.Benchmark.Prelude.NestedOps as Nested
130−
131−import Gauge
132−import Streamly hiding (runStream)
133−import Streamly.Benchmark.Common
134−
135−type Stream m a = S.SerialT m a
136−
137−-------------------------------------------------------------------------------
138−-- Stream generation
139−-------------------------------------------------------------------------------
140−
141−-- enumerate
142−
143−{-# INLINE sourceIntFromTo #-}
144−sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
145−sourceIntFromTo value n = S.enumerateFromTo n (n + value)
146−
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)
150−
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))
155−
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))
160−
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)
165−
166−-- unfoldr
167−
168−{-# INLINE sourceUnfoldr #-}
169−sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
170−sourceUnfoldr value n = S.unfoldr step n
171− where
172− step cnt =
173− if cnt > n + value
174− then Nothing
175− else Just (cnt, cnt + 1)
176−
177−{-# INLINE sourceUnfoldrN #-}
178−sourceUnfoldrN :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
179−sourceUnfoldrN upto start = S.unfoldr step start
180− where
181− step cnt =
182− if cnt > start + upto
183− then Nothing
184− else Just (cnt, cnt + 1)
185−
186−{-# INLINE sourceUnfoldrM #-}
187−sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
188−sourceUnfoldrM value n = S.unfoldrM step n
189− where
190− step cnt =
191− if cnt > n + value
192− then return Nothing
193− else return (Just (cnt, cnt + 1))
194−
195−{-# INLINE source #-}
196−source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
197−source = sourceUnfoldrM
198−
199−{-# INLINE sourceUnfoldrMN #-}
200−sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
201−sourceUnfoldrMN upto start = S.unfoldrM step start
202− where
203− step cnt =
204− if cnt > start + upto
205− then return Nothing
206− else return (Just (cnt, cnt + 1))
207−
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
211− where
212− step cnt =
213− if cnt > n + value
214− then return Nothing
215− else return (Just (return cnt, cnt + 1))
216−
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
221− where
222− step cnt =
223− if cnt > n + value
224− then Nothing
225− else (Just (return cnt, cnt + 1))
226−
227−-- fromIndices
228−
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)
232−
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))
236−
237−-- fromList
238−
239−{-# INLINE sourceFromList #-}
240−sourceFromList :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
241−sourceFromList value n = S.fromList [n..n+value]
242−
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])
246−
247−{-# INLINE sourceIsList #-}
248−sourceIsList :: Int -> Int -> S.SerialT Identity Int
249−sourceIsList value n = GHC.fromList [n..n+value]
250−
251−{-# INLINE sourceIsString #-}
252−sourceIsString :: Int -> Int -> S.SerialT Identity P.Char
253−sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
254−
255−-- fromFoldable
256−
257−{-# INLINE sourceFromFoldable #-}
258−sourceFromFoldable :: S.IsStream t => Int -> Int -> t m Int
259−sourceFromFoldable value n = S.fromFoldable [n..n+value]
260−
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])
264−
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
269−
270−-------------------------------------------------------------------------------
271−-- Elimination
272−-------------------------------------------------------------------------------
273−
274−{-# INLINE runStream #-}
275−runStream :: Monad m => Stream m a -> m ()
276−runStream = S.drain
277−
278−{-# INLINE toNull #-}
279−toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
280−toNull t = runStream . t
281−
282−{-# INLINE uncons #-}
283−uncons :: Monad m => Stream m Int -> m ()
284−uncons s = do
285− r <- S.uncons s
286− case r of
287− Nothing -> return ()
288− Just (_, t) -> uncons t
289−
290−{-# INLINE init #-}
291−init :: Monad m => Stream m a -> m ()
292−init s = S.init s >>= P.mapM_ S.drain
293−
294−{-# INLINE tail #-}
295−tail :: Monad m => Stream m a -> m ()
296−tail s = S.tail s >>= P.mapM_ tail
297−
298−{-# INLINE nullHeadTail #-}
299−nullHeadTail :: Monad m => Stream m Int -> m ()
300−nullHeadTail s = do
301− r <- S.null s
302− when (not r) $ do
303− _ <- S.head s
304− S.tail s >>= P.mapM_ nullHeadTail
305−
306−{-# INLINE mapM_ #-}
307−mapM_ :: Monad m => Stream m Int -> m ()
308−mapM_ = S.mapM_ (\_ -> return ())
309−
310−{-# INLINE toList #-}
311−toList :: Monad m => Stream m Int -> m [Int]
312−toList = S.toList
313−
314−{-# INLINE toListRev #-}
315−toListRev :: Monad m => Stream m Int -> m [Int]
316−toListRev = Internal.toListRev
317−
318−{-# INLINE foldrMElem #-}
319−foldrMElem :: Monad m => Int -> Stream m Int -> m Bool
320−foldrMElem e m =
321− S.foldrM
322− (\x xs ->
323− if x == e
324− then return P.True
325− else xs)
326− (return P.False)
327− m
328−
329−{-# INLINE foldrMToStream #-}
330−foldrMToStream :: Monad m => Stream m Int -> m (Stream Identity Int)
331−foldrMToStream = S.foldr S.cons S.nil
332−
333−{-# INLINE foldrMBuild #-}
334−foldrMBuild :: Monad m => Stream m Int -> m [Int]
335−foldrMBuild = S.foldrM (\x xs -> xs >>= return . (x :)) (return [])
336−
337−{-# INLINE foldl'Build #-}
338−foldl'Build :: Monad m => Stream m Int -> m [Int]
339−foldl'Build = S.foldl' (flip (:)) []
340−
341−{-# INLINE foldlM'Build #-}
342−foldlM'Build :: Monad m => Stream m Int -> m [Int]
343−foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []
344−
345−{-# INLINE foldrMReduce #-}
346−foldrMReduce :: Monad m => Stream m Int -> m Int
347−foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)
348−
349−{-# INLINE foldl'Reduce #-}
350−foldl'Reduce :: Monad m => Stream m Int -> m Int
351−foldl'Reduce = S.foldl' (+) 0
352−
353−{-# INLINE foldl'ReduceMap #-}
354−foldl'ReduceMap :: Monad m => Stream m Int -> m Int
355−foldl'ReduceMap = P.fmap (+ 1) . S.foldl' (+) 0
356−
357−{-# INLINE foldl1'Reduce #-}
358−foldl1'Reduce :: Monad m => Stream m Int -> m (Maybe Int)
359−foldl1'Reduce = S.foldl1' (+)
360−
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
364−
365−{-# INLINE last #-}
366−last :: Monad m => Stream m Int -> m (Maybe Int)
367−last = S.last
368−
369−{-# INLINE _null #-}
370−_null :: Monad m => Stream m Int -> m Bool
371−_null = S.null
372−
373−{-# INLINE _head #-}
374−_head :: Monad m => Stream m Int -> m (Maybe Int)
375−_head = S.head
376−
377−{-# INLINE elem #-}
378−elem :: Monad m => Int -> Stream m Int -> m Bool
379−elem value = S.elem (value + 1)
380−
381−{-# INLINE notElem #-}
382−notElem :: Monad m => Int -> Stream m Int -> m Bool
383−notElem value = S.notElem (value + 1)
384−
385−{-# INLINE length #-}
386−length :: Monad m => Stream m Int -> m Int
387−length = S.length
388−
389−{-# INLINE all #-}
390−all :: Monad m => Int -> Stream m Int -> m Bool
391−all value = S.all (<= (value + 1))
392−
393−{-# INLINE any #-}
394−any :: Monad m => Int -> Stream m Int -> m Bool
395−any value = S.any (> (value + 1))
396−
397−{-# INLINE and #-}
398−and :: Monad m => Int -> Stream m Int -> m Bool
399−and value = S.and . S.map (<= (value + 1))
400−
401−{-# INLINE or #-}
402−or :: Monad m => Int -> Stream m Int -> m Bool
403−or value = S.or . S.map (> (value + 1))
404−
405−{-# INLINE find #-}
406−find :: Monad m => Int -> Stream m Int -> m (Maybe Int)
407−find value = S.find (== (value + 1))
408−
409−{-# INLINE findIndex #-}
410−findIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
411−findIndex value = S.findIndex (== (value + 1))
412−
413−{-# INLINE elemIndex #-}
414−elemIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
415−elemIndex value = S.elemIndex (value + 1)
416−
417−{-# INLINE maximum #-}
418−maximum :: Monad m => Stream m Int -> m (Maybe Int)
419−maximum = S.maximum
420−
421−{-# INLINE minimum #-}
422−minimum :: Monad m => Stream m Int -> m (Maybe Int)
423−minimum = S.minimum
424−
425−{-# INLINE sum #-}
426−sum :: Monad m => Stream m Int -> m Int
427−sum = S.sum
428−
429−{-# INLINE product #-}
430−product :: Monad m => Stream m Int -> m Int
431−product = S.product
432−
433−{-# INLINE minimumBy #-}
434−minimumBy :: Monad m => Stream m Int -> m (Maybe Int)
435−minimumBy = S.minimumBy compare
436−
437−{-# INLINE maximumBy #-}
438−maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
439−maximumBy = S.maximumBy compare
440−
441−-------------------------------------------------------------------------------
442−-- Transformation
443−-------------------------------------------------------------------------------
444−
445−{-# INLINE transform #-}
446−transform :: Monad m => Stream m a -> m ()
447−transform = runStream
448−
449−{-# INLINE composeN #-}
450−composeN ::
451− MonadIO m
452− => Int
453− -> (Stream m Int -> Stream m Int)
454− -> Stream m Int
455− -> m ()
456−composeN n f =
457− case n of
458− 1 -> transform . f
459− 2 -> transform . f . f
460− 3 -> transform . f . f . f
461− 4 -> transform . f . f . f . f
462− _ -> undefined
463−
464−-- polymorphic stream version of composeN
465−{-# INLINE composeN' #-}
466−composeN' ::
467− (S.IsStream t, Monad m)
468− => Int
469− -> (t m Int -> Stream m Int)
470− -> t m Int
471− -> m ()
472−composeN' n f =
473− case n of
474− 1 -> transform . f
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
478− _ -> undefined
479−
480−{-# INLINE scan #-}
481−scan :: MonadIO m => Int -> Stream m Int -> m ()
482−scan n = composeN n $ S.scanl' (+) 0
483−
484−{-# INLINE scanl1' #-}
485−scanl1' :: MonadIO m => Int -> Stream m Int -> m ()
486−scanl1' n = composeN n $ S.scanl1' (+)
487−
488−{-# INLINE fmap #-}
489−fmap :: MonadIO m => Int -> Stream m Int -> m ()
490−fmap n = composeN n $ P.fmap (+ 1)
491−
492−{-# INLINE fmap' #-}
493−fmap' ::
494− (S.IsStream t, S.MonadAsync m, P.Functor (t m))
495− => (t m Int -> S.SerialT m Int)
496− -> Int
497− -> t m Int
498− -> m ()
499−fmap' t n = composeN' n $ t . P.fmap (+ 1)
500−
501−{-# INLINE map #-}
502−map :: MonadIO m => Int -> Stream m Int -> m ()
503−map n = composeN n $ S.map (+ 1)
504−
505−{-# INLINE map' #-}
506−map' ::
507− (S.IsStream t, S.MonadAsync m)
508− => (t m Int -> S.SerialT m Int)
509− -> Int
510− -> t m Int
511− -> m ()
512−map' t n = composeN' n $ t . S.map (+ 1)
513−
514−{-# INLINE mapM #-}
515−mapM ::
516− (S.IsStream t, S.MonadAsync m)
517− => (t m Int -> S.SerialT m Int)
518− -> Int
519− -> t m Int
520− -> m ()
521−mapM t n = composeN' n $ t . S.mapM return
522−
523−{-# INLINE tap #-}
524−tap :: MonadIO m => Int -> Stream m Int -> m ()
525−tap n = composeN n $ S.tap FL.sum
526−
527−{-# INLINE tapRate #-}
528−tapRate :: Int -> Stream IO Int -> IO ()
529−tapRate n str = do
530− cref <- newIORef 0
531− composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str
532−
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
537− where
538− f = Internal.rollingMap (P.-) . Internal.delayPost 1
539−
540−{-# INLINE tapAsyncS #-}
541−tapAsyncS :: S.MonadAsync m => Int -> Stream m Int -> m ()
542−tapAsyncS n = composeN n $ Par.tapAsync S.sum
543−
544−{-# INLINE tapAsync #-}
545−tapAsync :: S.MonadAsync m => Int -> Stream m Int -> m ()
546−tapAsync n = composeN n $ Internal.tapAsync FL.sum
547−
548−{-# INLINE timestamped #-}
549−timestamped :: (S.MonadAsync m) => Stream m Int -> m ()
550−timestamped = transform . Internal.timestamped
551−
552−{-# INLINE classifySessionsOf #-}
553−classifySessionsOf :: (S.MonadAsync m) => Stream m Int -> m ()
554−classifySessionsOf =
555− transform
556− . IP.classifySessionsOf 3 (const (return False)) (P.fmap Right FL.drain)
557− . S.map (\(ts,(k,a)) -> (k, a, ts))
558− . IP.timestamped
559− . S.concatMap (\x -> S.map (x,) (S.enumerateFromTo 1 (10 :: Int)))
560−
561−{-# INLINE mapMaybe #-}
562−mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()
563−mapMaybe n =
564− composeN n $
565− S.mapMaybe
566− (\x ->
567− if P.odd x
568− then Nothing
569− else Just x)
570−
571−{-# INLINE mapMaybeM #-}
572−mapMaybeM :: S.MonadAsync m => Int -> Stream m Int -> m ()
573−mapMaybeM n =
574− composeN n $
575− S.mapMaybeM
576− (\x ->
577− if P.odd x
578− then return Nothing
579− else return $ Just x)
580−
581−{-# INLINE sequence #-}
582−sequence ::
583− (S.IsStream t, S.MonadAsync m)
584− => (t m Int -> S.SerialT m Int)
585− -> t m (m Int)
586− -> m ()
587−sequence t = transform . t . S.sequence
588−
589−{-# INLINE filterEven #-}
590−filterEven :: MonadIO m => Int -> Stream m Int -> m ()
591−filterEven n = composeN n $ S.filter even
592−
593−{-# INLINE filterAllOut #-}
594−filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
595−filterAllOut value n = composeN n $ S.filter (> (value + 1))
596−
597−{-# INLINE filterAllIn #-}
598−filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
599−filterAllIn value n = composeN n $ S.filter (<= (value + 1))
600−
601−{-# INLINE _takeOne #-}
602−_takeOne :: MonadIO m => Int -> Stream m Int -> m ()
603−_takeOne n = composeN n $ S.take 1
604−
605−{-# INLINE takeAll #-}
606−takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
607−takeAll value n = composeN n $ S.take (value + 1)
608−
609−{-# INLINE takeWhileTrue #-}
610−takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
611−takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
612−
613−{-# INLINE _takeWhileMTrue #-}
614−_takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
615−_takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
616−
617−{-# INLINE dropOne #-}
618−dropOne :: MonadIO m => Int -> Stream m Int -> m ()
619−dropOne n = composeN n $ S.drop 1
620−
621−{-# INLINE dropAll #-}
622−dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
623−dropAll value n = composeN n $ S.drop (value + 1)
624−
625−{-# INLINE dropWhileTrue #-}
626−dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
627−dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
628−
629−{-# INLINE _dropWhileMTrue #-}
630−_dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
631−_dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
632−
633−{-# INLINE dropWhileFalse #-}
634−dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()
635−dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
636−
637−{-# INLINE findIndices #-}
638−findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
639−findIndices value n = composeN n $ S.findIndices (== (value + 1))
640−
641−{-# INLINE elemIndices #-}
642−elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
643−elemIndices value n = composeN n $ S.elemIndices (value + 1)
644−
645−{-# INLINE intersperse #-}
646−intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
647−intersperse value n = composeN n $ S.intersperse (value + 1)
648−
649−{-# INLINE insertBy #-}
650−insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
651−insertBy value n = composeN n $ S.insertBy compare (value + 1)
652−
653−{-# INLINE deleteBy #-}
654−deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
655−deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
656−
657−{-# INLINE reverse #-}
658−reverse :: MonadIO m => Int -> Stream m Int -> m ()
659−reverse n = composeN n $ S.reverse
660−
661−{-# INLINE reverse' #-}
662−reverse' :: MonadIO m => Int -> Stream m Int -> m ()
663−reverse' n = composeN n $ Internal.reverse'
664−
665−{-# INLINE foldrS #-}
666−foldrS :: MonadIO m => Int -> Stream m Int -> m ()
667−foldrS n = composeN n $ Internal.foldrS S.cons S.nil
668−
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
672−
673−{-# INLINE foldrT #-}
674−foldrT :: MonadIO m => Int -> Stream m Int -> m ()
675−foldrT n = composeN n $ Internal.foldrT S.cons S.nil
676−
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
680−
681−{-# INLINE takeByTime #-}
682−takeByTime :: NanoSecond64 -> Int -> Stream IO Int -> IO ()
683−takeByTime i n = composeN n (Internal.takeByTime i)
684−
685−#ifdef INSPECTION
686−-- inspect $ hasNoType 'takeByTime ''SPEC
687−inspect $ hasNoTypeClasses 'takeByTime
688−-- inspect $ 'takeByTime `hasNoType` ''D.Step
689−#endif
690−
691−{-# INLINE dropByTime #-}
692−dropByTime :: NanoSecond64 -> Int -> Stream IO Int -> IO ()
693−dropByTime i n = composeN n (Internal.dropByTime i)
694−
695−#ifdef INSPECTION
696−inspect $ hasNoTypeClasses 'dropByTime
697−-- inspect $ 'dropByTime `hasNoType` ''D.Step
698−#endif
699−
700−-------------------------------------------------------------------------------
701−-- Pipes
702−-------------------------------------------------------------------------------
703−
704−{-# INLINE transformMapM #-}
705−transformMapM ::
706− (S.IsStream t, S.MonadAsync m)
707− => (t m Int -> S.SerialT m Int)
708− -> Int
709− -> t m Int
710− -> m ()
711−transformMapM t n = composeN' n $ t . Internal.transform (Pipe.mapM return)
712−
713−{-# INLINE transformComposeMapM #-}
714−transformComposeMapM ::
715− (S.IsStream t, S.MonadAsync m)
716− => (t m Int -> S.SerialT m Int)
717− -> Int
718− -> t m Int
719− -> m ()
720−transformComposeMapM t n =
721− composeN' n $
722− t .
723− Internal.transform
724− (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`
725− Pipe.mapM (\x -> return (x + 2)))
726−
727−{-# INLINE transformTeeMapM #-}
728−transformTeeMapM ::
729− (S.IsStream t, S.MonadAsync m)
730− => (t m Int -> S.SerialT m Int)
731− -> Int
732− -> t m Int
733− -> m ()
734−transformTeeMapM t n =
735− composeN' n $
736− t .
737− Internal.transform
738− (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`
739− Pipe.mapM (\x -> return (x + 2)))
740−
741−{-# INLINE transformZipMapM #-}
742−transformZipMapM ::
743− (S.IsStream t, S.MonadAsync m)
744− => (t m Int -> S.SerialT m Int)
745− -> Int
746− -> t m Int
747− -> m ()
748−transformZipMapM t n =
749− composeN' n $
750− t .
751− Internal.transform
752− (Pipe.zipWith
753− (+)
754− (Pipe.mapM (\x -> return (x + 1)))
755− (Pipe.mapM (\x -> return (x + 2))))
756−
757−-------------------------------------------------------------------------------
758−-- Mixed Transformation
759−-------------------------------------------------------------------------------
760−
761−{-# INLINE scanMap #-}
762−scanMap :: MonadIO m => Int -> Stream m Int -> m ()
763−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
764−
765−{-# INLINE dropMap #-}
766−dropMap :: MonadIO m => Int -> Stream m Int -> m ()
767−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
768−
769−{-# INLINE dropScan #-}
770−dropScan :: MonadIO m => Int -> Stream m Int -> m ()
771−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
772−
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)
776−
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)
780−
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)
784−
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))
788−
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))
792−
793−{-# INLINE filterScan #-}
794−filterScan :: MonadIO m => Int -> Stream m Int -> m ()
795−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
796−
797−{-# INLINE filterScanl1 #-}
798−filterScanl1 :: MonadIO m => Int -> Stream m Int -> m ()
799−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
800−
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))
804−
805−-------------------------------------------------------------------------------
806−-- Scan and fold
807−-------------------------------------------------------------------------------
808−
809−data Pair a b =
810− Pair !a !b
811− deriving (Generic, NFData)
812−
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)
816−
817−{-# INLINE sumProductScan #-}
818−sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
819−sumProductScan =
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)
822−
823−-------------------------------------------------------------------------------
824−-- Iteration
825−-------------------------------------------------------------------------------
826−
827−{-# INLINE iterStreamLen #-}
828−iterStreamLen :: Int
829−iterStreamLen = 10
830−
831−{-# INLINE maxIters #-}
832−maxIters :: Int
833−maxIters = 10000
834−
835−{-# INLINE iterateSource #-}
836−iterateSource ::
837− S.MonadAsync m
838− => (Stream m Int -> Stream m Int)
839− -> Int
840− -> Int
841− -> Stream m Int
842−iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
843− where
844− f (0 :: Int) m = g m
845− f x m = g (f (x P.- 1) m)
846−
847−-- this is quadratic
848−{-# INLINE iterateScan #-}
849−iterateScan :: S.MonadAsync m => Int -> Stream m Int
850−iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
851−
852−-- this is quadratic
853−{-# INLINE iterateScanl1 #-}
854−iterateScanl1 :: S.MonadAsync m => Int -> Stream m Int
855−iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)
856−
857−{-# INLINE iterateMapM #-}
858−iterateMapM :: S.MonadAsync m => Int -> Stream m Int
859−iterateMapM = iterateSource (S.mapM return) maxIters
860−
861−{-# INLINE iterateFilterEven #-}
862−iterateFilterEven :: S.MonadAsync m => Int -> Stream m Int
863−iterateFilterEven = iterateSource (S.filter even) maxIters
864−
865−{-# INLINE iterateTakeAll #-}
866−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Stream m Int
867−iterateTakeAll value = iterateSource (S.take (value + 1)) maxIters
868−
869−{-# INLINE iterateDropOne #-}
870−iterateDropOne :: S.MonadAsync m => Int -> Stream m Int
871−iterateDropOne = iterateSource (S.drop 1) maxIters
872−
873−{-# INLINE iterateDropWhileFalse #-}
874−iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Stream m Int
875−iterateDropWhileFalse value =
876− iterateSource (S.dropWhile (> (value + 1))) maxIters
877−
878−{-# INLINE iterateDropWhileTrue #-}
879−iterateDropWhileTrue :: S.MonadAsync m => Int -> Int -> Stream m Int
880−iterateDropWhileTrue value =
881− iterateSource (S.dropWhile (<= (value + 1))) maxIters
882−
883−-------------------------------------------------------------------------------
884−-- Combining streams
885−-------------------------------------------------------------------------------
886−
887−-------------------------------------------------------------------------------
888−-- Appending
889−-------------------------------------------------------------------------------
890−
891−{-# INLINE serial2 #-}
892−serial2 :: Int -> Int -> IO ()
893−serial2 count n =
894− S.drain $ S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
895−
896−{-# INLINE serial4 #-}
897−serial4 :: Int -> Int -> IO ()
898−serial4 count n =
899− S.drain $
900− S.serial
901− ((S.serial (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))))
902− ((S.serial
903− (sourceUnfoldrMN count (n + 2))
904− (sourceUnfoldrMN count (n + 3))))
905−
906−{-# INLINE append2 #-}
907−append2 :: Int -> Int -> IO ()
908−append2 count n =
909− S.drain $
910− Internal.append (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
911−
912−{-# INLINE append4 #-}
913−append4 :: Int -> Int -> IO ()
914−append4 count n =
915− S.drain $
916− Internal.append
917− ((Internal.append
918− (sourceUnfoldrMN count n)
919− (sourceUnfoldrMN count (n + 1))))
920− ((Internal.append
921− (sourceUnfoldrMN count (n + 2))
922− (sourceUnfoldrMN count (n + 3))))
923−
924−#ifdef INSPECTION
925−inspect $ hasNoTypeClasses 'append2
926−inspect $ 'append2 `hasNoType` ''SPEC
927−inspect $ 'append2 `hasNoType` ''D.AppendState
928−#endif
929−
930−-------------------------------------------------------------------------------
931−-- Interleaving
932−-------------------------------------------------------------------------------
933−
934−{-# INLINE wSerial2 #-}
935−wSerial2 :: Int -> Int -> IO ()
936−wSerial2 value n =
937− S.drain $
938− S.wSerial
939− (sourceUnfoldrMN (value `div` 2) n)
940− (sourceUnfoldrMN (value `div` 2) (n + 1))
941−
942−{-# INLINE interleave2 #-}
943−interleave2 :: Int -> Int -> IO ()
944−interleave2 value n =
945− S.drain $
946− Internal.interleave
947− (sourceUnfoldrMN (value `div` 2) n)
948− (sourceUnfoldrMN (value `div` 2) (n + 1))
949−
950−#ifdef INSPECTION
951−inspect $ hasNoTypeClasses 'interleave2
952−inspect $ 'interleave2 `hasNoType` ''SPEC
953−inspect $ 'interleave2 `hasNoType` ''D.InterleaveState
954−#endif
955−
956−{-# INLINE roundRobin2 #-}
957−roundRobin2 :: Int -> Int -> IO ()
958−roundRobin2 value n =
959− S.drain $
960− Internal.roundrobin
961− (sourceUnfoldrMN (value `div` 2) n)
962− (sourceUnfoldrMN (value `div` 2) (n + 1))
963−
964−#ifdef INSPECTION
965−inspect $ hasNoTypeClasses 'roundRobin2
966−inspect $ 'roundRobin2 `hasNoType` ''SPEC
967−inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
968−#endif
969−
970−-------------------------------------------------------------------------------
971−-- Merging
972−-------------------------------------------------------------------------------
973−
974−{-# INLINE mergeBy #-}
975−mergeBy :: Int -> Int -> IO ()
976−mergeBy count n =
977− S.drain $
978− S.mergeBy
979− P.compare
980− (sourceUnfoldrMN count n)
981− (sourceUnfoldrMN count (n + 1))
982−
983−#ifdef INSPECTION
984−inspect $ hasNoTypeClasses 'mergeBy
985−inspect $ 'mergeBy `hasNoType` ''SPEC
986−inspect $ 'mergeBy `hasNoType` ''D.Step
987−#endif
988−
989−-------------------------------------------------------------------------------
990−-- Zipping
991−-------------------------------------------------------------------------------
992−
993−{-# INLINE zip #-}
994−zip :: Int -> Int -> IO ()
995−zip count n =
996− S.drain $
997− S.zipWith (,) (sourceUnfoldrMN count n) (sourceUnfoldrMN count (n + 1))
998−
999−#ifdef INSPECTION
1000−inspect $ hasNoTypeClasses 'zip
1001−inspect $ 'zip `hasNoType` ''SPEC
1002−inspect $ 'zip `hasNoType` ''D.Step
1003−#endif
1004−
1005−{-# INLINE zipM #-}
1006−zipM :: Int -> Int -> IO ()
1007−zipM count n =
1008− S.drain $
1009− S.zipWithM
1010− (curry return)
1011− (sourceUnfoldrMN count n)
1012− (sourceUnfoldrMN count (n + 1))
1013−
1014−#ifdef INSPECTION
1015−inspect $ hasNoTypeClasses 'zipM
1016−inspect $ 'zipM `hasNoType` ''SPEC
1017−inspect $ 'zipM `hasNoType` ''D.Step
1018−#endif
1019−
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))
1024−
1025−{-# INLINE zipAsyncM #-}
1026−zipAsyncM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
1027−zipAsyncM count n = do
1028− S.zipAsyncWithM
1029− (curry return)
1030− (sourceUnfoldrMN count n)
1031− (sourceUnfoldrMN count (n + 1))
1032−
1033−{-# INLINE zipAsyncAp #-}
1034−zipAsyncAp :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
1035−zipAsyncAp count n = do
1036− S.zipAsyncly $
1037− (,) <$> (sourceUnfoldrMN count n) <*> (sourceUnfoldrMN count (n + 1))
1038−
1039−{-# INLINE mergeAsyncByM #-}
1040−mergeAsyncByM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
1041−mergeAsyncByM count n = do
1042− S.mergeAsyncByM
1043− (\a b -> return (a `compare` b))
1044− (sourceUnfoldrMN count n)
1045− (sourceUnfoldrMN count (n + 1))
1046−
1047−{-# INLINE mergeAsyncBy #-}
1048−mergeAsyncBy :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
1049−mergeAsyncBy count n = do
1050− S.mergeAsyncBy
1051− compare
1052− (sourceUnfoldrMN count n)
1053− (sourceUnfoldrMN count (n + 1))
1054−
1055−-------------------------------------------------------------------------------
1056−-- Multi-stream folds
1057−-------------------------------------------------------------------------------
1058−
1059−{-# INLINE isPrefixOf #-}
1060−isPrefixOf :: Monad m => Stream m Int -> m Bool
1061−isPrefixOf src = S.isPrefixOf src src
1062−
1063−{-# INLINE isSubsequenceOf #-}
1064−isSubsequenceOf :: Monad m => Stream m Int -> m Bool
1065−isSubsequenceOf src = S.isSubsequenceOf src src
1066−
1067−{-# INLINE stripPrefix #-}
1068−stripPrefix :: Monad m => Stream m Int -> m ()
1069−stripPrefix src = do
1070− _ <- S.stripPrefix src src
1071− return ()
1072−
1073−{-# INLINE eqBy' #-}
1074−eqBy' :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
1075−eqBy' src = S.eqBy (==) src src
1076−
1077−{-# INLINE eqBy #-}
1078−eqBy :: Int -> Int -> IO Bool
1079−eqBy value n = eqBy' (source value n)
1080−
1081−#ifdef INSPECTION
1082−inspect $ hasNoTypeClasses 'eqBy
1083−inspect $ 'eqBy `hasNoType` ''SPEC
1084−inspect $ 'eqBy `hasNoType` ''D.Step
1085−#endif
1086−
1087−
1088−{-# INLINE eqByPure #-}
1089−eqByPure :: Int -> Int -> Identity Bool
1090−eqByPure value n = eqBy' (sourceUnfoldr value n)
1091−
1092−#ifdef INSPECTION
1093−inspect $ hasNoTypeClasses 'eqByPure
1094−inspect $ 'eqByPure `hasNoType` ''SPEC
1095−inspect $ 'eqByPure `hasNoType` ''D.Step
1096−#endif
1097−
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
1101−
1102−{-# INLINE cmpBy #-}
1103−cmpBy :: Int -> Int -> IO P.Ordering
1104−cmpBy value n = cmpBy' (source value n)
1105−
1106−#ifdef INSPECTION
1107−inspect $ hasNoTypeClasses 'cmpBy
1108−inspect $ 'cmpBy `hasNoType` ''SPEC
1109−inspect $ 'cmpBy `hasNoType` ''D.Step
1110−#endif
1111−
1112−{-# INLINE cmpByPure #-}
1113−cmpByPure :: Int -> Int -> Identity P.Ordering
1114−cmpByPure value n = cmpBy' (sourceUnfoldr value n)
1115−
1116−#ifdef INSPECTION
1117−inspect $ hasNoTypeClasses 'cmpByPure
1118−inspect $ 'cmpByPure `hasNoType` ''SPEC
1119−inspect $ 'cmpByPure `hasNoType` ''D.Step
1120−#endif
1121−
1122−-------------------------------------------------------------------------------
1123−-- Streams of streams
1124−-------------------------------------------------------------------------------
1125−
1126−-- Special cases of concatMap
1127−
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]
1132−
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]
1137−
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]
1142−
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]
1148−
1149−-- concatMap unfoldrM/unfoldrM
1150−
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)
1157−
1158−#ifdef INSPECTION
1159−inspect $ hasNoTypeClasses 'concatMap
1160−inspect $ 'concatMap `hasNoType` ''SPEC
1161−#endif
1162−
1163−-- concatMap unfoldr/unfoldr
1164−
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)
1171−
1172−#ifdef INSPECTION
1173−inspect $ hasNoTypeClasses 'concatMapPure
1174−inspect $ 'concatMapPure `hasNoType` ''SPEC
1175−#endif
1176−
1177−-- concatMap replicate/unfoldrM
1178−
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)
1183−
1184−#ifdef INSPECTION
1185−inspect $ hasNoTypeClasses 'concatMapRepl4xN
1186−inspect $ 'concatMapRepl4xN `hasNoType` ''SPEC
1187−#endif
1188−
1189−-- concatMapWith
1190−
1191−{-# INLINE concatStreamsWith #-}
1192−concatStreamsWith
1193− :: (forall c. S.SerialT IO c -> S.SerialT IO c -> S.SerialT IO c)
1194− -> Int
1195− -> Int
1196− -> Int
1197− -> IO ()
1198−concatStreamsWith op outer inner n =
1199− S.drain $ S.concatMapWith op
1200− (\i -> sourceUnfoldrMN inner i)
1201− (sourceUnfoldrMN outer n)
1202−
1203−{-# INLINE concatMapWithSerial #-}
1204−concatMapWithSerial :: Int -> Int -> Int -> IO ()
1205−concatMapWithSerial = concatStreamsWith S.serial
1206−
1207−#ifdef INSPECTION
1208−inspect $ hasNoTypeClasses 'concatMapWithSerial
1209−inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
1210−#endif
1211−
1212−{-# INLINE concatMapWithAppend #-}
1213−concatMapWithAppend :: Int -> Int -> Int -> IO ()
1214−concatMapWithAppend = concatStreamsWith Internal.append
1215−
1216−#ifdef INSPECTION
1217−inspect $ hasNoTypeClasses 'concatMapWithAppend
1218−inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
1219−#endif
1220−
1221−{-# INLINE concatMapWithWSerial #-}
1222−concatMapWithWSerial :: Int -> Int -> Int -> IO ()
1223−concatMapWithWSerial = concatStreamsWith S.wSerial
1224−
1225−#ifdef INSPECTION
1226−inspect $ hasNoTypeClasses 'concatMapWithWSerial
1227−inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
1228−#endif
1229−
1230−-- concatUnfold
1231−
1232−-- concatUnfold replicate/unfoldrM
1233−
1234−{-# INLINE concatUnfoldRepl4xN #-}
1235−concatUnfoldRepl4xN :: Int -> Int -> IO ()
1236−concatUnfoldRepl4xN value n =
1237− S.drain $ S.concatUnfold
1238− (UF.replicateM 4)
1239− (sourceUnfoldrMN (value `div` 4) n)
1240−
1241−#ifdef INSPECTION
1242−inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN
1243−inspect $ 'concatUnfoldRepl4xN `hasNoType` ''D.ConcatMapUState
1244−inspect $ 'concatUnfoldRepl4xN `hasNoType` ''SPEC
1245−#endif
1246−
1247−{-# INLINE concatUnfoldInterleaveRepl4xN #-}
1248−concatUnfoldInterleaveRepl4xN :: Int -> Int -> IO ()
1249−concatUnfoldInterleaveRepl4xN value n =
1250− S.drain $ Internal.concatUnfoldInterleave
1251− (UF.replicateM 4)
1252− (sourceUnfoldrMN (value `div` 4) n)
1253−
1254−#ifdef INSPECTION
1255−inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN
1256−-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''SPEC
1257−-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState
1258−#endif
1259−
1260−{-# INLINE concatUnfoldRoundrobinRepl4xN #-}
1261−concatUnfoldRoundrobinRepl4xN :: Int -> Int -> IO ()
1262−concatUnfoldRoundrobinRepl4xN value n =
1263− S.drain $ Internal.concatUnfoldRoundrobin
1264− (UF.replicateM 4)
1265− (sourceUnfoldrMN (value `div` 4) n)
1266−
1267−#ifdef INSPECTION
1268−inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN
1269−-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''SPEC
1270−-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState
1271−#endif
1272−
1273−-------------------------------------------------------------------------------
1274−-- Monad transformation (hoisting etc.)
1275−-------------------------------------------------------------------------------
1276−
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
1281− where
1282− step cnt =
1283− if cnt > n + value
1284− then return Nothing
1285− else do
1286− s <- get
1287− put (s + 1)
1288− return (Just (s, cnt + 1))
1289−
1290−{-# INLINE evalStateT #-}
1291−evalStateT :: S.MonadAsync m => Int -> Int -> Stream m Int
1292−evalStateT value n = Internal.evalStateT 0 (sourceUnfoldrState value n)
1293−
1294−{-# INLINE withState #-}
1295−withState :: S.MonadAsync m => Int -> Int -> Stream m Int
1296−withState value n =
1297− Internal.evalStateT (0 :: Int) (Internal.liftInner (sourceUnfoldrM value n))
1298−
1299−-------------------------------------------------------------------------------
1300−-- Concurrent application/fold
1301−-------------------------------------------------------------------------------
1302−
1303−{-# INLINE parAppMap #-}
1304−parAppMap :: S.MonadAsync m => Stream m Int -> m ()
1305−parAppMap src = S.drain $ S.map (+1) S.|$ src
1306−
1307−{-# INLINE parAppSum #-}
1308−parAppSum :: S.MonadAsync m => Stream m Int -> m ()
1309−parAppSum src = (S.sum S.|$. src) >>= \x -> P.seq x (return ())
1310−
1311−-------------------------------------------------------------------------------
1312−-- Type class instances
1313−-------------------------------------------------------------------------------
1314−
1315−{-# INLINE eqInstance #-}
1316−eqInstance :: Stream Identity Int -> Bool
1317−eqInstance src = src == src
1318−
1319−{-# INLINE eqInstanceNotEq #-}
1320−eqInstanceNotEq :: Stream Identity Int -> Bool
1321−eqInstanceNotEq src = src P./= src
1322−
1323−{-# INLINE ordInstance #-}
1324−ordInstance :: Stream Identity Int -> Bool
1325−ordInstance src = src P.< src
1326−
1327−{-# INLINE ordInstanceMin #-}
1328−ordInstanceMin :: Stream Identity Int -> Stream Identity Int
1329−ordInstanceMin src = P.min src src
1330−
1331−{-# INLINE showInstance #-}
1332−showInstance :: Stream Identity Int -> P.String
1333−showInstance src = P.show src
1334−
1335−{-# INLINE showInstanceList #-}
1336−showInstanceList :: [Int] -> P.String
1337−showInstanceList src = P.show src
1338−
1339−{-# INLINE readInstance #-}
1340−readInstance :: P.String -> Stream Identity Int
1341−readInstance str =
1342− let r = P.reads str
1343− in case r of
1344− [(x,"")] -> x
1345− _ -> P.error "readInstance: no parse"
1346−
1347−{-# INLINE readInstanceList #-}
1348−readInstanceList :: P.String -> [Int]
1349−readInstanceList str =
1350− let r = P.reads str
1351− in case r of
1352− [(x,"")] -> x
1353− _ -> P.error "readInstance: no parse"
1354−
1355−-------------------------------------------------------------------------------
1356−-- Pure (Identity) streams
1357−-------------------------------------------------------------------------------
1358−
1359−{-# INLINE pureFoldl' #-}
1360−pureFoldl' :: Stream Identity Int -> Int
1361−pureFoldl' = runIdentity . S.foldl' (+) 0
1362−
1363−-------------------------------------------------------------------------------
1364−-- Foldable Instance
1365−-------------------------------------------------------------------------------
1366−
1367−{-# INLINE foldableFoldl' #-}
1368−foldableFoldl' :: Int -> Int -> Int
1369−foldableFoldl' value n =
1370− F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
1371−
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)
1376− (P.False)
1377− (sourceUnfoldr value n :: S.SerialT Identity Int)
1378−
1379−{-# INLINE foldableSum #-}
1380−foldableSum :: Int -> Int -> Int
1381−foldableSum value n =
1382− P.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
1383−
1384−{-# INLINE foldableProduct #-}
1385−foldableProduct :: Int -> Int -> Int
1386−foldableProduct value n =
1387− P.product (sourceUnfoldr value n :: S.SerialT Identity Int)
1388−
1389−{-# INLINE _foldableNull #-}
1390−_foldableNull :: Int -> Int -> Bool
1391−_foldableNull value n =
1392− P.null (sourceUnfoldr value n :: S.SerialT Identity Int)
1393−
1394−{-# INLINE foldableElem #-}
1395−foldableElem :: Int -> Int -> Bool
1396−foldableElem value n =
1397− P.elem value (sourceUnfoldr value n :: S.SerialT Identity Int)
1398−
1399−{-# INLINE foldableNotElem #-}
1400−foldableNotElem :: Int -> Int -> Bool
1401−foldableNotElem value n =
1402− P.notElem value (sourceUnfoldr value n :: S.SerialT Identity Int)
1403−
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)
1408−
1409−{-# INLINE foldableAll #-}
1410−foldableAll :: Int -> Int -> Bool
1411−foldableAll value n =
1412− P.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
1413−
1414−{-# INLINE foldableAny #-}
1415−foldableAny :: Int -> Int -> Bool
1416−foldableAny value n =
1417− P.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
1418−
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)
1423−
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)
1428−
1429−{-# INLINE foldableLength #-}
1430−foldableLength :: Int -> Int -> Int
1431−foldableLength value n =
1432− P.length (sourceUnfoldr value n :: S.SerialT Identity Int)
1433−
1434−{-# INLINE foldableMin #-}
1435−foldableMin :: Int -> Int -> Int
1436−foldableMin value n =
1437− P.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
1438−
1439−{-# INLINE foldableMax #-}
1440−foldableMax :: Int -> Int -> Int
1441−foldableMax value n =
1442− P.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
1443−
1444−{-# INLINE foldableMinBy #-}
1445−foldableMinBy :: Int -> Int -> Int
1446−foldableMinBy value n =
1447− F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
1448−
1449−{-# INLINE foldableListMinBy #-}
1450−foldableListMinBy :: Int -> Int -> Int
1451−foldableListMinBy value n = F.minimumBy compare [1..value+n]
1452−
1453−{-# INLINE foldableMaxBy #-}
1454−foldableMaxBy :: Int -> Int -> Int
1455−foldableMaxBy value n =
1456− F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
1457−
1458−{-# INLINE foldableToList #-}
1459−foldableToList :: Int -> Int -> [Int]
1460−foldableToList value n =
1461− F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
1462−
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)
1467−
1468−{-# INLINE foldableSequence_ #-}
1469−foldableSequence_ :: Int -> Int -> IO ()
1470−foldableSequence_ value n =
1471− F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
1472−
1473−{-# INLINE _foldableMsum #-}
1474−_foldableMsum :: Int -> Int -> IO Int
1475−_foldableMsum value n =
1476− F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
1477−
1478−-------------------------------------------------------------------------------
1479−-- Traversable Instance
1480−-------------------------------------------------------------------------------
1481−
1482−{-# INLINE traversableTraverse #-}
1483−traversableTraverse :: Stream Identity Int -> IO (Stream Identity Int)
1484−traversableTraverse = P.traverse return
1485−
1486−{-# INLINE traversableSequenceA #-}
1487−traversableSequenceA :: Stream Identity Int -> IO (Stream Identity Int)
1488−traversableSequenceA = P.sequenceA . P.fmap return
1489−
1490−{-# INLINE traversableMapM #-}
1491−traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)
1492−traversableMapM = P.mapM return
1493−
1494−{-# INLINE traversableSequence #-}
1495−traversableSequence :: Stream Identity Int -> IO (Stream Identity Int)
1496−traversableSequence = P.sequence . P.fmap return
1497−
1498−-------------------------------------------------------------------------------
1499−-- Benchmark groups
1500−-------------------------------------------------------------------------------
1501−
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.
1504−
1505−-- | Takes a fold method, and uses it with a default source.
1506−{-# INLINE benchIOSink #-}
1507−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
1511−
1512−{-# INLINE benchHoistSink #-}
1513−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
1518−
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 #-}
1522−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
1526−
1527−-- | Takes a source, and uses it with a default drain/fold method.
1528−{-# INLINE benchIOSrc #-}
1529−benchIOSrc
1530− :: (t IO a -> SerialT IO a)
1531− -> String
1532− -> (Int -> t IO a)
1533− -> Benchmark
1534−benchIOSrc t name f =
1535− bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
1536−
1537−{-# INLINE benchPureSink #-}
1538−benchPureSink :: NFData b => Int -> String -> (SerialT Identity Int -> b) -> Benchmark
1539−benchPureSink value name f = benchPure name (sourceUnfoldr value) f
1540−
1541−{-# INLINE benchPureSinkIO #-}
1542−benchPureSinkIO
1543− :: NFData b
1544− => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
1545−benchPureSinkIO value name f =
1546− bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
1547−
1548−{-# INLINE benchIO #-}
1549−benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
1550−benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
1551−
1552−-- | Takes a source, and uses it with a default drain/fold method.
1553−{-# INLINE benchSrcIO #-}
1554−benchSrcIO
1555− :: (t IO a -> SerialT IO a)
1556− -> String
1557− -> (Int -> t IO a)
1558− -> Benchmark
1559−benchSrcIO t name f
1560− = bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
1561−
1562−{-# INLINE benchMonadicSrcIO #-}
1563−benchMonadicSrcIO :: String -> (Int -> IO ()) -> Benchmark
1564−benchMonadicSrcIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
1565−
1566−
1567−-------------------------------------------------------------------------------
1568−-- Serial : O(1) Space
1569−-------------------------------------------------------------------------------
1570−
1571−o_1_space_serial_pure :: Int -> [Benchmark]
1572−o_1_space_serial_pure value =
1573− [ bgroup
1574− "serially"
1575− [ bgroup
1576− "pure"
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
1586− , benchPureSink
1587− value
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'
1593− ]
1594− ]
1595− ]
1596−
1597−o_1_space_serial_foldable :: Int -> [Benchmark]
1598−o_1_space_serial_foldable value =
1599− [ bgroup
1600− "serially"
1601− [ bgroup
1602− "foldable"
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
1616− -- folds
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
1626− -- TBD: traverse_
1627− , benchIOSink1 "mapM_" (foldableMapM_ value)
1628− -- TBD: for_
1629− -- TBD: forM_
1630− , benchIOSink1 "sequence_" (foldableSequence_ value)
1631− -- TBD: sequenceA_
1632− -- TBD: asum
1633− -- , benchIOSink1 "msum" (_foldableMsum value)
1634− ]
1635− ]
1636− ]
1637−
1638−o_1_space_serial_generation :: Int -> [Benchmark]
1639−o_1_space_serial_generation value =
1640− [ bgroup
1641− "serially"
1642− [ bgroup
1643− "generation"
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)
1648− , benchIOSrc
1649− serially
1650− "intFromThenTo"
1651− (sourceIntFromThenTo value)
1652− , benchIOSrc
1653− serially
1654− "integerFromStep"
1655− (sourceIntegerFromStep value)
1656− , benchIOSrc
1657− serially
1658− "fracFromThenTo"
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
1664− , benchIOSrc
1665− serially
1666− "fromFoldable"
1667− (sourceFromFoldable value)
1668− , benchIOSrc
1669− serially
1670− "fromFoldableM"
1671− (sourceFromFoldableM value)
1672− , benchIOSrc serially "absTimes" $
1673− absTimes value
1674− ]
1675− ]
1676− ]
1677−
1678−o_1_space_serial_elimination :: Int -> [Benchmark]
1679−o_1_space_serial_elimination value =
1680− [ bgroup
1681− "serially"
1682− [ bgroup
1683− "elimination"
1684− [ bgroup
1685− "reduce"
1686− [ bgroup
1687− "IO"
1688− [ benchIOSink value "foldl'" foldl'Reduce
1689− , benchIOSink value "foldl1'" foldl1'Reduce
1690− , benchIOSink value "foldlM'" foldlM'Reduce
1691− ]
1692− , bgroup
1693− "Identity"
1694− [ benchIdentitySink value "foldl'" foldl'Reduce
1695− , benchIdentitySink
1696− value
1697− "foldl1'"
1698− foldl1'Reduce
1699− , benchIdentitySink
1700− value
1701− "foldlM'"
1702− foldlM'Reduce
1703− ]
1704− ]
1705− , bgroup
1706− "build"
1707− [ bgroup
1708− "IO"
1709− [ benchIOSink
1710− value
1711− "foldrMElem"
1712− (foldrMElem value)
1713− ]
1714− , bgroup
1715− "Identity"
1716− [ benchIdentitySink
1717− value
1718− "foldrMElem"
1719− (foldrMElem value)
1720− , benchIdentitySink
1721− value
1722− "foldrMToStreamLength"
1723− (S.length . runIdentity . foldrMToStream)
1724− , benchPureSink
1725− value
1726− "foldrMToListLength"
1727− (P.length . runIdentity . foldrMBuild)
1728− ]
1729− ]
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
1750− , benchHoistSink
1751− value
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
1760− ]
1761− ]
1762− ]
1763−
1764−o_1_space_serial_foldMultiStream :: Int -> [Benchmark]
1765−o_1_space_serial_foldMultiStream value =
1766− [ bgroup
1767− "serially"
1768− [ bgroup
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
1775− ]
1776− ]
1777− ]
1778−
1779−o_1_space_serial_pipes :: Int -> [Benchmark]
1780−o_1_space_serial_pipes value =
1781− [ bgroup
1782− "serially"
1783− [ bgroup
1784− "pipes"
1785− [ benchIOSink value "mapM" (transformMapM serially 1)
1786− , benchIOSink
1787− value
1788− "compose"
1789− (transformComposeMapM serially 1)
1790− , benchIOSink value "tee" (transformTeeMapM serially 1)
1791− , benchIOSink value "zip" (transformZipMapM serially 1)
1792− ]
1793− ]
1794− ]
1795−
1796−o_1_space_serial_pipesX4 :: Int -> [Benchmark]
1797−o_1_space_serial_pipesX4 value =
1798− [ bgroup
1799− "serially"
1800− [ bgroup
1801− "pipesX4"
1802− [ benchIOSink value "mapM" (transformMapM serially 4)
1803− , benchIOSink
1804− value
1805− "compose"
1806− (transformComposeMapM serially 4)
1807− , benchIOSink value "tee" (transformTeeMapM serially 4)
1808− , benchIOSink value "zip" (transformZipMapM serially 4)
1809− ]
1810− ]
1811− ]
1812−
1813−
1814−o_1_space_serial_transformer :: Int -> [Benchmark]
1815−o_1_space_serial_transformer value =
1816− [ bgroup
1817− "serially"
1818− [ bgroup
1819− "transformer"
1820− [ benchIOSrc serially "evalState" (evalStateT value)
1821− , benchIOSrc serially "withState" (withState value)
1822− ]
1823− ]
1824− ]
1825−
1826−o_1_space_serial_transformation :: Int -> [Benchmark]
1827−o_1_space_serial_transformation value =
1828− [ bgroup
1829− "serially"
1830− [ bgroup
1831− "transformation"
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" $
1840− nfIO $
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
1855− ]
1856− ]
1857− ]
1858−
1859−o_1_space_serial_transformationX4 :: Int -> [Benchmark]
1860−o_1_space_serial_transformationX4 value =
1861− [ bgroup
1862− "serially"
1863− [ bgroup
1864− "transformationX4"
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)
1876− ]
1877− ]
1878− ]
1879−
1880−o_1_space_serial_filtering :: Int -> [Benchmark]
1881−o_1_space_serial_filtering value =
1882− [ bgroup
1883− "serially"
1884− [ bgroup
1885− "filtering"
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)
1890− , benchIOSink
1891− value
1892− "takeByTime-all"
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)
1899− , benchIOSink
1900− value
1901− "dropByTime-all"
1902− (dropByTime (NanoSecond64 maxBound) 1)
1903− , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
1904− --, benchIOSink value "dropWhileM-true" (_dropWhileMTrue 1)
1905− , benchIOSink
1906− value
1907− "dropWhile-false"
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)
1912− ]
1913− ]
1914− ]
1915−
1916−o_1_space_serial_filteringX4 :: Int -> [Benchmark]
1917−o_1_space_serial_filteringX4 value =
1918− [ bgroup
1919− "serially"
1920− [ bgroup
1921− "filteringX4"
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)
1932− , benchIOSink
1933− value
1934− "dropWhile-false"
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)
1939− ]
1940− ]
1941− ]
1942−
1943−o_1_space_serial_joining :: Int -> [Benchmark]
1944−o_1_space_serial_joining value =
1945− [ bgroup
1946− "serially"
1947− [ bgroup
1948− "joining"
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)
1959− ]
1960− ]
1961− ]
1962−
1963−o_1_space_serial_concatFoldable :: Int -> [Benchmark]
1964−o_1_space_serial_concatFoldable value =
1965− [ bgroup
1966− "serially"
1967− [ bgroup
1968− "concat-foldable"
1969− [ benchIOSrc
1970− serially
1971− "foldMapWith"
1972− (sourceFoldMapWith value)
1973− , benchIOSrc
1974− serially
1975− "foldMapWithM"
1976− (sourceFoldMapWithM value)
1977− , benchIOSrc serially "foldMapM" (sourceFoldMapM value)
1978− , benchIOSrc
1979− serially
1980− "foldWithConcatMapId"
1981− (sourceConcatMapId value)
1982− ]
1983− ]
1984− ]
1985−
1986−o_1_space_serial_concatSerial :: Int -> [Benchmark]
1987−o_1_space_serial_concatSerial value =
1988− [ bgroup
1989− "serially"
1990− [ bgroup
1991− "concat-serial"
1992− [ benchIOSrc1
1993− "concatMapPure (2,x/2)"
1994− (concatMapPure 2 (value `div` 2))
1995− , benchIOSrc1
1996− "concatMap (2,x/2)"
1997− (concatMap 2 (value `div` 2))
1998− , benchIOSrc1
1999− "concatMap (x/2,2)"
2000− (concatMap (value `div` 2) 2)
2001− , benchIOSrc1
2002− "concatMapRepl (x/4,4)"
2003− (concatMapRepl4xN value)
2004− , benchIOSrc1
2005− "concatUnfoldRepl (x/4,4)"
2006− (concatUnfoldRepl4xN value)
2007− , benchIOSrc1
2008− "concatMapWithSerial (2,x/2)"
2009− (concatMapWithSerial 2 (value `div` 2))
2010− , benchIOSrc1
2011− "concatMapWithSerial (x/2,2)"
2012− (concatMapWithSerial (value `div` 2) 2)
2013− , benchIOSrc1
2014− "concatMapWithAppend (2,x/2)"
2015− (concatMapWithAppend 2 (value `div` 2))
2016− ]
2017− ]
2018− ]
2019−
2020−o_1_space_serial_outerProductStreams :: Int -> [Benchmark]
2021−o_1_space_serial_outerProductStreams value =
2022− [ bgroup
2023− "serially"
2024− [ bgroup
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
2034− ]
2035− ]
2036− ]
2037−
2038−o_1_space_serial_mixed :: Int -> [Benchmark]
2039−o_1_space_serial_mixed value =
2040− [ bgroup
2041− "serially"
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.
2045− [ bgroup
2046− "mixed"
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
2051− ]
2052− ]
2053− ]
2054−
2055−o_1_space_serial_mixedX4 :: Int -> [Benchmark]
2056−o_1_space_serial_mixedX4 value =
2057− [ bgroup
2058− "serially"
2059− [ bgroup
2060− "mixedX4"
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)
2072− ]
2073− ]
2074− ]
2075−
2076−o_1_space_wSerial_transformation :: Int -> [Benchmark]
2077−o_1_space_wSerial_transformation value =
2078− [ bgroup
2079− "wSerially"
2080− [ bgroup
2081− "transformation"
2082− [benchIOSink value "fmap" $ fmap' wSerially 1]
2083− ]
2084− ]
2085−
2086−o_1_space_wSerial_concatMap :: Int -> [Benchmark]
2087−o_1_space_wSerial_concatMap value =
2088− [ bgroup
2089− "wSerially"
2090− [ bgroup
2091− "concatMap"
2092− [ benchIOSrc1
2093− "concatMapWithWSerial (2,x/2)"
2094− (concatMapWithWSerial 2 (value `div` 2))
2095− , benchIOSrc1
2096− "concatMapWithWSerial (x/2,2)"
2097− (concatMapWithWSerial (value `div` 2) 2)
2098− ]
2099− ]
2100− ]
2101−
2102−o_1_space_wSerial_outerProduct :: Int -> [Benchmark]
2103−o_1_space_wSerial_outerProduct value =
2104− [ bgroup
2105− "wSerially"
2106− [ bgroup
2107− "outer-product"
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
2116− ]
2117− ]
2118− ]
2119−
2120−o_1_space_zipSerial_transformation :: Int -> [Benchmark]
2121−o_1_space_zipSerial_transformation value =
2122− [ bgroup
2123− "zipSerially"
2124− [ bgroup
2125− "transformation"
2126− [benchIOSink value "fmap" $ fmap' zipSerially 1]
2127− -- XXX needs fixing
2128− {-
2129− , bgroup "outer-product"
2130− [ benchIO "toNullAp" $ Nested.toNullAp value zipSerially
2131− ]
2132− -}
2133− ]
2134− ]
2135−
2136−-------------------------------------------------------------------------------
2137−-- Serial : O(n) Space
2138−-------------------------------------------------------------------------------
2139−
2140−o_n_space_serial_toContainers :: Int -> [Benchmark]
2141−o_n_space_serial_toContainers value =
2142− [ bgroup
2143− "serially"
2144− [ bgroup
2145− "toList" -- < 2MB
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
2152− ]
2153− , benchIOSink (value `div` 10) "classifySessionsOf"
2154− classifySessionsOf
2155− ]
2156− ]
2157−
2158−o_n_space_serial_outerProductStreams :: Int -> [Benchmark]
2159−o_n_space_serial_outerProductStreams value =
2160− [ bgroup
2161− "serially"
2162− [ bgroup
2163− "outer-product-streams"
2164− [ benchIO "toList" $ Nested.toList value serially
2165− , benchIO "toListSome" $ Nested.toListSome value serially
2166− ]
2167− ]
2168− ]
2169−
2170−o_n_space_wSerial_outerProductStreams :: Int -> [Benchmark]
2171−o_n_space_wSerial_outerProductStreams value =
2172− [ bgroup
2173− "wSerially"
2174− [ bgroup
2175− "outer-product-streams"
2176− [ benchIO "toList" $ Nested.toList value wSerially
2177− , benchIO "toListSome" $ Nested.toListSome value wSerially
2178− ]
2179− ]
2180− ]
2181−
2182−o_n_space_serial_traversable :: Int -> [Benchmark]
2183−o_n_space_serial_traversable value =
2184− [ bgroup
2185− "serially"
2186− -- Buffering operations using heap proportional to number of elements.
2187− [ bgroup
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
2194− ]
2195− ]
2196− ]
2197−
2198−o_n_space_serial_foldr :: Int -> [Benchmark]
2199−o_n_space_serial_foldr value =
2200− [ bgroup
2201− "serially"
2202− -- Head recursive strict right folds.
2203− [ bgroup
2204− "foldr"
2205− -- < 2MB
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
2211− value
2212− "foldrM/reduce/Identity"
2213− foldrMReduce
2214− -- takes < 4MB
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
2224− ]
2225− ]
2226− ]
2227−
2228−
2229−o_n_heap_serial_foldl :: Int -> [Benchmark]
2230−o_n_heap_serial_foldl value =
2231− [ bgroup
2232− "serially"
2233− [ bgroup
2234− "foldl"
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
2241− value
2242− "foldlM'/build/Identity"
2243− foldlM'Build
2244− -- Reversing/sorting a stream
2245− , benchIOSink value "reverse" (reverse 1)
2246− , benchIOSink value "reverse'" (reverse' 1)
2247− ]
2248− ]
2249− ]
2250−
2251−o_n_heap_serial_buffering :: Int -> [Benchmark]
2252−o_n_heap_serial_buffering value =
2253− [ bgroup
2254− "serially"
2255− [ bgroup
2256− "buffering"
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.
2270− , benchIOSrc1
2271− "concatUnfoldInterleaveRepl (x/4,4)"
2272− (concatUnfoldInterleaveRepl4xN value)
2273− , benchIOSrc1
2274− "concatUnfoldRoundrobinRepl (x/4,4)"
2275− (concatUnfoldRoundrobinRepl4xN value)
2276− ]
2277− ]
2278− ]
2279−
2280−-- Head recursive operations.
2281−o_n_stack_serial_iterated :: Int -> [Benchmark]
2282−o_n_stack_serial_iterated value =
2283− [ bgroup
2284− "serially"
2285− [ bgroup
2286− "iterated"
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
2293− , benchIOSrc
2294− serially
2295− "dropWhileFalsex10K"
2296− (iterateDropWhileFalse value)
2297− , benchIOSrc
2298− serially
2299− "dropWhileTruex10K"
2300− (iterateDropWhileTrue value)
2301− , benchIOSink value "tail" tail
2302− , benchIOSink value "nullHeadTail" nullHeadTail
2303− ]
2304− ]
2305− ]
2306−
2307−o_1_space_async_generation :: Int -> [Benchmark]
2308−o_1_space_async_generation value =
2309− [ bgroup
2310− "asyncly"
2311− [ bgroup
2312− "generation"
2313− [ benchSrcIO asyncly "unfoldr" (sourceUnfoldr value)
2314− , benchSrcIO asyncly "unfoldrM" (sourceUnfoldrM value)
2315− , benchSrcIO asyncly "fromFoldable" (sourceFromFoldable value)
2316− , benchSrcIO asyncly "fromFoldableM" (sourceFromFoldableM value)
2317− , benchSrcIO
2318− asyncly
2319− "unfoldrM maxThreads 1"
2320− (maxThreads 1 . sourceUnfoldrM value)
2321− , benchSrcIO
2322− asyncly
2323− "unfoldrM maxBuffer 1 (x/10 ops)"
2324− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2325− ]
2326− ]
2327− ]
2328−
2329−o_1_space_async_concatFoldable :: Int -> [Benchmark]
2330−o_1_space_async_concatFoldable value =
2331− [ bgroup
2332− "asyncly"
2333− [ bgroup
2334− "concat-foldable"
2335− [ benchSrcIO asyncly "foldMapWith" (sourceFoldMapWith value)
2336− , benchSrcIO
2337− asyncly
2338− "foldMapWithM"
2339− (sourceFoldMapWithM value)
2340− , benchSrcIO asyncly "foldMapM" (sourceFoldMapM value)
2341− ]
2342− ]
2343− ]
2344−
2345−o_1_space_async_concatMap :: Int -> [Benchmark]
2346−o_1_space_async_concatMap value =
2347− value2 `seq`
2348− [ bgroup
2349− "asyncly"
2350− [ bgroup
2351− "concatMap"
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))
2361− ]
2362− ]
2363− ]
2364− where
2365− value2 = round $ sqrt $ (fromIntegral value :: Double)
2366−
2367−o_1_space_async_transformation :: Int -> [Benchmark]
2368−o_1_space_async_transformation value =
2369− [ bgroup
2370− "asyncly"
2371− [ bgroup
2372− "transformation"
2373− [ benchIOSink value "map" $ map' asyncly 1
2374− , benchIOSink value "fmap" $ fmap' asyncly 1
2375− , benchIOSink value "mapM" $ mapM asyncly 1
2376− ]
2377− ]
2378− ]
2379−
2380−o_1_space_wAsync_generation :: Int -> [Benchmark]
2381−o_1_space_wAsync_generation value =
2382− [ bgroup
2383− "wAsyncly"
2384− [ bgroup
2385− "generation"
2386− [ benchSrcIO wAsyncly "unfoldr" (sourceUnfoldr value)
2387− , benchSrcIO wAsyncly "unfoldrM" (sourceUnfoldrM value)
2388− , benchSrcIO wAsyncly "fromFoldable" (sourceFromFoldable value)
2389− , benchSrcIO
2390− wAsyncly
2391− "fromFoldableM"
2392− (sourceFromFoldableM value)
2393− , benchSrcIO
2394− wAsyncly
2395− "unfoldrM maxThreads 1"
2396− (maxThreads 1 . sourceUnfoldrM value)
2397− , benchSrcIO
2398− wAsyncly
2399− "unfoldrM maxBuffer 1 (x/10 ops)"
2400− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2401− ]
2402− ]
2403− ]
2404−
2405−o_1_space_wAsync_concatFoldable :: Int -> [Benchmark]
2406−o_1_space_wAsync_concatFoldable value =
2407− [ bgroup
2408− "wAsyncly"
2409− [ bgroup
2410− "concat-foldable"
2411− [ benchSrcIO wAsyncly "foldMapWith" (sourceFoldMapWith value)
2412− , benchSrcIO wAsyncly "foldMapWithM" (sourceFoldMapWithM value)
2413− , benchSrcIO wAsyncly "foldMapM" (sourceFoldMapM value)
2414− ]
2415− ]
2416− ]
2417−
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
2421−-- work queue.
2422−--
2423−-- We should see the memory consumption increasing slowly if these
2424−-- benchmarks are left to run on infinite number of streams of infinite
2425−-- sizes.
2426−o_1_space_wAsync_concatMap :: Int -> [Benchmark]
2427−o_1_space_wAsync_concatMap value =
2428− value2 `seq`
2429− [ bgroup
2430− "wAsyncly"
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))
2440− ]
2441− ]
2442− where
2443− value2 = round $ sqrt $ (fromIntegral value :: Double)
2444−
2445−o_1_space_wAsync_transformation :: Int -> [Benchmark]
2446−o_1_space_wAsync_transformation value =
2447− [ bgroup
2448− "wAsyncly"
2449− [ bgroup
2450− "transformation"
2451− [ benchIOSink value "map" $ map' wAsyncly 1
2452− , benchIOSink value "fmap" $ fmap' wAsyncly 1
2453− , benchIOSink value "mapM" $ mapM wAsyncly 1
2454− ]
2455− ]
2456− ]
2457−
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 =
2462− [ bgroup
2463− "aheadly"
2464− [ bgroup
2465− "generation"
2466− [ benchSrcIO aheadly "unfoldr" (sourceUnfoldr value)
2467− , benchSrcIO aheadly "unfoldrM" (sourceUnfoldrM value)
2468−-- , benchSrcIO aheadly "fromFoldable" (sourceFromFoldable value)
2469− , benchSrcIO
2470− aheadly
2471− "fromFoldableM"
2472− (sourceFromFoldableM value)
2473− , benchSrcIO
2474− aheadly
2475− "unfoldrM maxThreads 1"
2476− (maxThreads 1 . sourceUnfoldrM value)
2477− , benchSrcIO
2478− aheadly
2479− "unfoldrM maxBuffer 1 (x/10 ops)"
2480− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2481− ]
2482− ]
2483− ]
2484−
2485−o_1_space_ahead_concatFoldable :: Int -> [Benchmark]
2486−o_1_space_ahead_concatFoldable value =
2487− [ bgroup
2488− "aheadly"
2489− [ bgroup
2490− "concat-foldable"
2491− [ benchSrcIO aheadly "foldMapWith" (sourceFoldMapWith value)
2492− , benchSrcIO aheadly "foldMapWithM" (sourceFoldMapWithM value)
2493− , benchSrcIO aheadly "foldMapM" (sourceFoldMapM value)
2494− ]
2495− ]
2496− ]
2497−
2498−o_1_space_ahead_concatMap :: Int -> [Benchmark]
2499−o_1_space_ahead_concatMap value =
2500− value2 `seq`
2501− [ bgroup
2502− "aheadly"
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))
2512− ]
2513− ]
2514− where
2515− value2 = round $ sqrt $ (fromIntegral value :: Double)
2516−
2517−
2518−o_1_space_ahead_transformation :: Int -> [Benchmark]
2519−o_1_space_ahead_transformation value =
2520− [ bgroup
2521− "aheadly"
2522− [ bgroup
2523− "transformation"
2524− [ benchIOSink value "map" $ map' aheadly 1
2525− , benchIOSink value "fmap" $ fmap' aheadly 1
2526− , benchIOSink value "mapM" $ mapM aheadly 1
2527− ]
2528− ]
2529− ]
2530−
2531−o_1_space_async_zip :: Int -> [Benchmark]
2532−o_1_space_async_zip value =
2533− [ bgroup
2534− "asyncly"
2535− [ bgroup
2536− "zip"
2537− [ benchSrcIO
2538− serially
2539− "zipAsync (2,x/2)"
2540− (zipAsync (value `div` 2))
2541− , benchSrcIO
2542− serially
2543− "zipAsyncM (2,x/2)"
2544− (zipAsyncM (value `div` 2))
2545− , benchSrcIO
2546− serially
2547− "zipAsyncAp (2,x/2)"
2548− (zipAsyncAp (value `div` 2))
2549− , benchIOSink value "fmap zipAsyncly" $ fmap' S.zipAsyncly 1
2550− , benchSrcIO
2551− serially
2552− "mergeAsyncBy (2,x/2)"
2553− (mergeAsyncBy (value `div` 2))
2554− , benchSrcIO
2555− serially
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
2561− ]
2562− ]
2563− ]
2564−
2565−o_n_space_parallel_generation :: Int -> [Benchmark]
2566−o_n_space_parallel_generation value =
2567− [ bgroup
2568− "parallely"
2569− [ bgroup
2570− "generation"
2571− [ benchSrcIO parallely "unfoldr" (sourceUnfoldr value)
2572− , benchSrcIO parallely "unfoldrM" (sourceUnfoldrM value)
2573−-- , benchSrcIO parallely "fromFoldable" (sourceFromFoldable value)
2574− , benchSrcIO
2575− parallely
2576− "fromFoldableM"
2577− (sourceFromFoldableM value)
2578− , benchSrcIO
2579− parallely
2580− "unfoldrM maxThreads 1"
2581− (maxThreads 1 . sourceUnfoldrM value)
2582− , benchSrcIO
2583− parallely
2584− "unfoldrM maxBuffer 1 (x/10 ops)"
2585− (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2586− ]
2587− ]
2588− ]
2589−
2590−o_n_space_parallel_concatFoldable :: Int -> [Benchmark]
2591−o_n_space_parallel_concatFoldable value =
2592− [ bgroup
2593− "parallely"
2594− [ bgroup
2595− "concat-foldable"
2596− [ benchSrcIO parallely "foldMapWith" (sourceFoldMapWith value)
2597− , benchSrcIO parallely "foldMapWithM" (sourceFoldMapWithM value)
2598− , benchSrcIO parallely "foldMapM" (sourceFoldMapM value)
2599− ]
2600− ]
2601− ]
2602−
2603−o_n_space_parallel_concatMap :: Int -> [Benchmark]
2604−o_n_space_parallel_concatMap value =
2605− value2 `seq`
2606− [ bgroup
2607− "parallely"
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))
2617− ]
2618− ]
2619− where
2620− value2 = round $ sqrt $ (fromIntegral value :: Double)
2621−
2622−
2623−o_n_space_parallel_transformation :: Int -> [Benchmark]
2624−o_n_space_parallel_transformation value =
2625− [ bgroup
2626− "parallely"
2627− [ bgroup
2628− "transformation"
2629− [ benchIOSink value "map" $ map' parallely 1
2630− , benchIOSink value "fmap" $ fmap' parallely 1
2631− , benchIOSink value "mapM" $ mapM parallely 1
2632− ]
2633− ]
2634− ]
2635−
2636−o_n_space_parallel_outerProductStreams :: Int -> [Benchmark]
2637−o_n_space_parallel_outerProductStreams value =
2638− [ bgroup
2639− "parallely"
2640− [ bgroup
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
2650− ]
2651− ]
2652− ]
2653−
2654−o_n_space_parallel_outerProductStreams2 :: Int -> [Benchmark]
2655−o_n_space_parallel_outerProductStreams2 value =
2656− [ bgroup
2657− "parallely"
2658− [ bgroup
2659− "outer-product-streams"
2660− [ benchIO "toList" $ Nested.toList value parallely
2661− , benchIO "toListSome" $ Nested.toListSome value parallely
2662− ]
2663− ]
2664− ]
2665−
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 =
2669− [ bgroup
2670− "asyncly"
2671− [ bgroup
2672− "avgRate"
2673− -- benchIO "unfoldr" $ toNull asyncly
2674− -- benchSrcIO asyncly "unfoldrM" (sourceUnfoldrM value)
2675− [ benchSrcIO
2676− asyncly
2677− "unfoldrM/Nothing"
2678− (S.rate Nothing . sourceUnfoldrM value)
2679− , benchSrcIO
2680− asyncly
2681− "unfoldrM/1,000,000"
2682− (S.avgRate 1000000 . sourceUnfoldrM value)
2683− , benchSrcIO
2684− asyncly
2685− "unfoldrM/3,000,000"
2686− (S.avgRate 3000000 . sourceUnfoldrM value)
2687− , benchSrcIO
2688− asyncly
2689− "unfoldrM/10,000,000/maxThreads1"
2690− (maxThreads 1 .
2691− S.avgRate 10000000 . sourceUnfoldrM value)
2692− , benchSrcIO
2693− asyncly
2694− "unfoldrM/10,000,000"
2695− (S.avgRate 10000000 . sourceUnfoldrM value)
2696− , benchSrcIO
2697− asyncly
2698− "unfoldrM/20,000,000"
2699− (S.avgRate 20000000 . sourceUnfoldrM value)
2700− ]
2701− ]
2702− ]
2703−
2704−o_1_space_ahead_avgRate :: Int -> [Benchmark]
2705−o_1_space_ahead_avgRate value =
2706− [ bgroup
2707− "aheadly"
2708− [ bgroup
2709− "avgRate"
2710− [ benchSrcIO
2711− aheadly
2712− "unfoldrM/1,000,000"
2713− (S.avgRate 1000000 . sourceUnfoldrM value)
2714− ]
2715− ]
2716− ]
14+import Streamly.Benchmark.Prelude.Generation
15+import Streamly.Benchmark.Prelude.Elimination
16+import Streamly.Benchmark.Prelude.Transformation