@@ -1,938 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.StreamK
3−-- Copyright : (c) 2018 Composewell Technologies
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# OPTIONS_GHC -Wno-orphans #-}
12−
13−#ifdef __HADDOCK_VERSION__
14−#undef INSPECTION
15−#endif
16−
17−#ifdef INSPECTION
18−{-# LANGUAGE TemplateHaskell #-}
19−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20−#endif
21−
22−module Main (main) where
23−
24−-- import Control.Applicative (liftA2)
25−-- import Control.Monad (when)
26−-- import Data.Maybe (isJust)
27−-- import System.Random (randomRIO)
28−import Prelude hiding
29− ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate
30− , repeat, replicate
31− )
32−
33−import qualified Prelude as P
34−-- import qualified Data.List as List
35−
36−import qualified Streamly.Internal.Data.StreamK as S
37−import qualified Streamly.Internal.Data.Stream as D
38−import qualified Streamly.Internal.Data.Fold as Fold
39−
40−import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)
41−
42−import Streamly.Benchmark.Common
43−
44−#ifdef INSPECTION
45−import Test.Inspection
46−#endif
47−
48−-------------------------------------------------------------------------------
49−-- Stream generation and elimination
50−-------------------------------------------------------------------------------
51−
52−type Stream m a = S.Stream m a
53−
54−{-# INLINE unfoldrD #-}
55−unfoldrD :: Monad m => Int -> Int -> Stream m Int
56−unfoldrD streamLen n = D.toStreamK (D.unfoldr step n)
57− where
58− step cnt =
59− if cnt > n + streamLen
60− then Nothing
61− else Just (cnt, cnt + 1)
62−
63−{-# INLINE unfoldrMD #-}
64−unfoldrMD :: Monad m => Int -> Int -> Stream m Int
65−unfoldrMD streamLen n = D.toStreamK (D.unfoldrM step n)
66− where
67− step cnt =
68− if cnt > n + streamLen
69− then return Nothing
70− else return (Just (cnt, cnt + 1))
71−
72−{-
73−{-# INLINE unfoldrK #-}
74−unfoldrK :: Int -> Int -> Stream m Int
75−unfoldrK streamLen n = S.unfoldr step n
76− where
77− step cnt =
78− if cnt > n + streamLen
79− then Nothing
80− else Just (cnt, cnt + 1)
81−-}
82−
83−{-# INLINE unfoldrMK #-}
84−unfoldrMK :: Monad m => Int -> Int -> Stream m Int
85−unfoldrMK streamLen n = S.unfoldrMWith S.consM step n
86− where
87− step cnt =
88− if cnt > n + streamLen
89− then return Nothing
90− else return (Just (cnt, cnt + 1))
91−
92−{-# INLINE repeat #-}
93−repeat :: Monad m => Int -> Int -> Stream m Int
94−repeat streamLen = S.take streamLen . D.toStreamK . D.repeat
95−
96−{-# INLINE repeatM #-}
97−repeatM :: Monad m => Int -> Int -> Stream m Int
98−repeatM streamLen = S.take streamLen . D.toStreamK . D.repeatM . return
99−
100−{-# INLINE replicate #-}
101−replicate :: Monad m => Int -> Int -> Stream m Int
102−replicate x y = D.toStreamK $ D.replicate x y
103−
104−{-# INLINE replicateM #-}
105−replicateM :: Monad m => Int -> Int -> Stream m Int
106−replicateM streamLen = D.toStreamK . D.replicateM streamLen . return
107−
108−{-# INLINE iterate #-}
109−iterate :: Monad m => Int -> Int -> Stream m Int
110−iterate streamLen = S.take streamLen . D.toStreamK . D.iterate (+1)
111−
112−{-# INLINE iterateM #-}
113−iterateM :: Monad m => Int -> Int -> Stream m Int
114−iterateM streamLen = S.take streamLen . D.toStreamK . D.iterateM (return . (+1)) . return
115−
116−{-# INLINE fromFoldable #-}
117−fromFoldable :: Int -> Int -> Stream m Int
118−fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
119−
120−{-# INLINE fromFoldableM #-}
121−fromFoldableM :: Monad m => Int -> Int -> Stream m Int
122−fromFoldableM streamLen n =
123− Prelude.foldr (S.consM . return) S.nil [n .. n + streamLen]
124−
125−{-
126−{-# INLINABLE concatMapFoldableWith #-}
127−concatMapFoldableWith :: Foldable f
128− => (Stream m b -> Stream m b -> Stream m b)
129− -> (a -> Stream m b)
130− -> f a
131− -> Stream m b
132−concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
133−-}
134−
135−{-# INLINE concatMapFoldableSerial #-}
136−concatMapFoldableSerial :: Monad m => Int -> Int -> Stream m Int
137−concatMapFoldableSerial streamLen n =
138− D.toStreamK $ D.concatMap D.fromPure $ D.fromStreamK $ S.fromList [n..n+streamLen]
139−
140−{-# INLINE concatMapFoldableSerialM #-}
141−concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
142−concatMapFoldableSerialM streamLen n =
143− -- concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
144− D.toStreamK $ D.concatMap (D.fromEffect . return) $ D.fromStreamK $ S.fromList [n..n+streamLen]
145−
146−-------------------------------------------------------------------------------
147−-- Elimination
148−-------------------------------------------------------------------------------
149−
150−{-# INLINE drainD #-}
151−drainD :: Monad m => Stream m a -> m ()
152−drainD = D.drain . D.fromStreamK
153−
154−{-# INLINE drain #-}
155−drain :: Monad m => Stream m a -> m ()
156−drain = S.drain
157−
158−{-# INLINE mapM_ #-}
159−mapM_ :: Monad m => Stream m a -> m ()
160−mapM_ s = D.mapM_ (\_ -> return ()) $ D.fromStreamK s
161−
162−{-
163−{-# INLINE uncons #-}
164−uncons :: Monad m => Stream m Int -> m ()
165−uncons s = do
166− r <- D.uncons $ D.fromStreamK s
167− case r of
168− Nothing -> return ()
169− Just (_, t) -> uncons (D.toStreamK t)
170−
171−{-# INLINE init #-}
172−init :: Monad m => Stream m a -> m ()
173−init s = do
174− t <- S.init s
175− P.mapM_ S.drain t
176−
177−{-# INLINE tail #-}
178−tail :: Monad m => Stream m a -> m ()
179−tail s = S.tail s >>= P.mapM_ tail
180−
181−{-# INLINE nullTail #-}
182−nullTail :: Monad m => Stream m Int -> m ()
183−nullTail s = do
184− r <- S.null s
185− when (not r) $ S.tail s >>= P.mapM_ nullTail
186−
187−{-# INLINE headTail #-}
188−headTail :: Monad m => Stream m Int -> m ()
189−headTail s = do
190− h <- S.head s
191− when (isJust h) $ S.tail s >>= P.mapM_ headTail
192−-}
193−
194−{-# INLINE toList #-}
195−toList :: Monad m => Stream m Int -> m [Int]
196−toList = D.fold Fold.toList . D.fromStreamK
197−
198−{-# INLINE foldl' #-}
199−foldl' :: Monad m => Stream m Int -> m Int
200−foldl' = D.fold (Fold.foldl' (+) 0) . D.fromStreamK
201−
202−{-# INLINE last #-}
203−last :: Monad m => Stream m Int -> m (Maybe Int)
204−last = D.fold Fold.latest . D.fromStreamK
205−
206−-------------------------------------------------------------------------------
207−-- Transformation
208−-------------------------------------------------------------------------------
209−
210−{-# INLINE composeN #-}
211−composeN
212− :: Monad m
213− => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
214−composeN n f =
215− case n of
216− 1 -> drain . f
217− 2 -> drain . f . f
218− 3 -> drain . f . f . f
219− 4 -> drain . f . f . f . f
220− _ -> undefined
221−
222−{-# INLINE scanl' #-}
223−scanl' :: Monad m => Int -> Stream m Int -> m ()
224−scanl' n =
225− composeN n (D.toStreamK . D.scan (Fold.foldl' (+) 0) . D.fromStreamK)
226−
227−{-# INLINE map #-}
228−map :: Monad m => Int -> Stream m Int -> m ()
229−map n = composeN n (D.toStreamK . D.map (+ 1) . D.fromStreamK)
230−
231−{-
232−{-# INLINE fmapK #-}
233−fmapK :: Monad m => Int -> Stream m Int -> m ()
234−fmapK n = composeN n $ P.fmap (+ 1)
235−-}
236−
237−{-# INLINE mapM #-}
238−mapM :: Monad m => Int -> Stream m Int -> m ()
239−mapM n = composeN n (D.toStreamK . D.mapM return . D.fromStreamK)
240−
241−{-
242−{-# INLINE mapMSerial #-}
243−mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
244−mapMSerial n = composeN n $ S.mapMSerial return
245−-}
246−
247−{-# INLINE filterEven #-}
248−filterEven :: Monad m => Int -> Stream m Int -> m ()
249−filterEven n = composeN n (D.toStreamK . D.filter even . D.fromStreamK)
250−
251−{-
252−{-# INLINE filterAllOut #-}
253−filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
254−filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
255−
256−{-# INLINE filterAllIn #-}
257−filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
258−filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
259−
260−{-# INLINE _takeOne #-}
261−_takeOne :: Monad m => Int -> Stream m Int -> m ()
262−_takeOne n = composeN n $ S.take 1
263−
264−{-# INLINE takeAll #-}
265−takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
266−takeAll streamLen n = composeN n $ S.take streamLen
267−
268−{-# INLINE takeWhileTrue #-}
269−takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
270−takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
271−
272−{-# INLINE dropOne #-}
273−dropOne :: Monad m => Int -> Stream m Int -> m ()
274−dropOne n = composeN n $ S.drop 1
275−
276−{-# INLINE dropAll #-}
277−dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
278−dropAll streamLen n = composeN n $ S.drop streamLen
279−
280−{-# INLINE dropWhileTrue #-}
281−dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
282−dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
283−
284−{-# INLINE dropWhileFalse #-}
285−dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
286−dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
287−-}
288−
289−{-
290−{-# INLINE foldrS #-}
291−foldrS :: Monad m => Int -> Stream m Int -> m ()
292−foldrS n = composeN n $ S.foldrS S.cons S.nil
293−
294−{-# INLINE foldlS #-}
295−foldlS :: Monad m => Int -> Stream m Int -> m ()
296−foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
297−-}
298−
299−{-
300−{-# INLINE intersperse #-}
301−intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
302−intersperse streamLen n = composeN n $ S.intersperse streamLen
303−-}
304−
305−-------------------------------------------------------------------------------
306−-- Iteration
307−-------------------------------------------------------------------------------
308−
309−{-
310−{-# INLINE iterateSource #-}
311−iterateSource
312− :: S.MonadAsync m
313− => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
314−iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
315− where
316− f (0 :: Int) m = g m
317− f x m = g (f (x P.- 1) m)
318−
319−-- this is quadratic
320−{-# INLINE iterateScan #-}
321−iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
322−iterateScan iterStreamLen maxIters =
323− iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
324−
325−-- this is quadratic
326−{-# INLINE iterateDropWhileFalse #-}
327−iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
328−iterateDropWhileFalse streamLen iterStreamLen maxIters =
329− iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
330−
331−{-# INLINE iterateMapM #-}
332−iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
333−iterateMapM iterStreamLen =
334− iterateSource iterStreamLen (S.mapMWith S.consM return)
335−
336−{-# INLINE iterateFilterEven #-}
337−iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
338−iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
339−
340−{-# INLINE iterateTakeAll #-}
341−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
342−iterateTakeAll streamLen iterStreamLen =
343− iterateSource iterStreamLen (S.take streamLen)
344−
345−{-# INLINE iterateDropOne #-}
346−iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
347−iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
348−
349−{-# INLINE iterateDropWhileTrue #-}
350−iterateDropWhileTrue :: S.MonadAsync m =>
351− Int -> Int -> Int -> Int -> Stream m Int
352−iterateDropWhileTrue streamLen iterStreamLen =
353− iterateSource iterStreamLen (S.dropWhile (<= streamLen))
354−-}
355−
356−-------------------------------------------------------------------------------
357−-- Zipping
358−-------------------------------------------------------------------------------
359−
360−{-
361−{-# INLINE zipWith #-}
362−zipWith :: Monad m => Stream m Int -> m ()
363−zipWith src = drain $ S.zipWith (,) src src
364−
365−{-# INLINE zipWithM #-}
366−zipWithM :: Monad m => Stream m Int -> m ()
367−zipWithM src = drain $ S.zipWithM (curry return) src src
368−
369−{-# INLINE sortByK #-}
370−sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
371−sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
372−
373−{-# INLINE sortBy #-}
374−sortBy :: Monad m => Stream m Int -> m ()
375−sortBy = drain . sortByK compare
376−
377−-------------------------------------------------------------------------------
378−-- Mixed Composition
379−-------------------------------------------------------------------------------
380−
381−{-# INLINE scanMap #-}
382−scanMap :: Monad m => Int -> Stream m Int -> m ()
383−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
384−
385−{-# INLINE dropMap #-}
386−dropMap :: Monad m => Int -> Stream m Int -> m ()
387−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
388−
389−{-# INLINE dropScan #-}
390−dropScan :: Monad m => Int -> Stream m Int -> m ()
391−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
392−
393−{-# INLINE takeDrop #-}
394−takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
395−takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
396−
397−{-# INLINE takeScan #-}
398−takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
399−takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
400−
401−{-# INLINE takeMap #-}
402−takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
403−takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
404−
405−{-# INLINE filterDrop #-}
406−filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
407−filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
408−
409−{-# INLINE filterTake #-}
410−filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
411−filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
412−
413−{-# INLINE filterScan #-}
414−filterScan :: Monad m => Int -> Stream m Int -> m ()
415−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
416−
417−{-# INLINE filterMap #-}
418−filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
419−filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
420−-}
421−
422−-------------------------------------------------------------------------------
423−-- ConcatMap
424−-------------------------------------------------------------------------------
425−
426−-- concatMap unfoldrM/unfoldrM
427−
428−{-# INLINE concatMap #-}
429−concatMap :: Int -> Int -> Int -> IO ()
430−concatMap outer inner n =
431− S.drain $ D.toStreamK $ D.concatMap
432− (\_ -> D.fromStreamK $ unfoldrMK inner n)
433− (D.fromStreamK $ unfoldrMK outer n)
434−
435−#ifdef INSPECTION
436−inspect $ hasNoTypeClasses 'concatMap
437−#endif
438−
439−-- concatMap unfoldr/unfoldr
440−
441−{-
442−{-# INLINE concatMapPure #-}
443−concatMapPure :: Int -> Int -> Int -> IO ()
444−concatMapPure outer inner n =
445− S.drain $ S.concatMap
446− (\_ -> unfoldr inner n)
447− (unfoldr outer n)
448−
449−#ifdef INSPECTION
450−inspect $ hasNoTypeClasses 'concatMapPure
451−#endif
452−
453−-- concatMap replicate/unfoldrM
454−
455−{-# INLINE concatMapRepl #-}
456−concatMapRepl :: Int -> Int -> Int -> IO ()
457−concatMapRepl outer inner n =
458− S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
459−
460−#ifdef INSPECTION
461−inspect $ hasNoTypeClasses 'concatMapRepl
462−#endif
463−
464−-- concatMapWith
465−
466−{-# INLINE sourceConcatMapId #-}
467−sourceConcatMapId :: Monad m
468− => Int -> Int -> Stream m (Stream m Int)
469−sourceConcatMapId val n =
470− S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
471−
472−{-# INLINE concatMapBySerial #-}
473−concatMapBySerial :: Int -> Int -> Int -> IO ()
474−concatMapBySerial outer inner n =
475− S.drain $ S.concatMapWith S.serial
476− (unfoldrM inner)
477− (unfoldrM outer n)
478−-}
479−
480−{-
481−-------------------------------------------------------------------------------
482−-- Nested Composition
483−-------------------------------------------------------------------------------
484−
485−instance Monad m => Applicative (S.Stream m) where
486− {-# INLINE pure #-}
487− pure = S.fromPure
488−
489− {-# INLINE (<*>) #-}
490− (<*>) = S.crossApply
491−
492− {-# INLINE liftA2 #-}
493− liftA2 f x = (<*>) (fmap f x)
494−
495− {-# INLINE (*>) #-}
496− (*>) = S.crossApplySnd
497−
498− {-# INLINE (<*) #-}
499− (<*) = S.crossApplyFst
500−
501−-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
502−-- the monad instance of StreamD is slower than StreamK after foldr/build
503−-- fusion.
504−instance Monad m => Monad (S.Stream m) where
505− {-# INLINE return #-}
506− return = pure
507−
508− {-# INLINE (>>=) #-}
509− (>>=) = flip S.concatMap
510−
511−{-# INLINE drainApplicative #-}
512−drainApplicative :: Monad m => Stream m Int -> m ()
513−drainApplicative s = drain $ do
514− (+) <$> s <*> s
515−
516−{-# INLINE drainMonad #-}
517−drainMonad :: Monad m => Stream m Int -> m ()
518−drainMonad s = drain $ do
519− x <- s
520− y <- s
521− return $ x + y
522−
523−{-# INLINE drainMonad3 #-}
524−drainMonad3 :: Monad m => Stream m Int -> m ()
525−drainMonad3 s = drain $ do
526− x <- s
527− y <- s
528− z <- s
529− return $ x + y + z
530−
531−{-# INLINE filterAllOutMonad #-}
532−filterAllOutMonad
533− :: Monad m
534− => Stream m Int -> m ()
535−filterAllOutMonad str = drain $ do
536− x <- str
537− y <- str
538− let s = x + y
539− if s < 0
540− then return s
541− else S.nil
542−
543−{-# INLINE filterAllInMonad #-}
544−filterAllInMonad
545− :: Monad m
546− => Stream m Int -> m ()
547−filterAllInMonad str = drain $ do
548− x <- str
549− y <- str
550− let s = x + y
551− if s > 0
552− then return s
553− else S.nil
554−
555−-------------------------------------------------------------------------------
556−-- Nested Composition Pure lists
557−-------------------------------------------------------------------------------
558−
559−-- There are several list benchmarks here for comparison with lists. It is easy
560−-- and convenient to see the comparisons when they are here, otherwise we'll
561−-- have to add a separate module for list benchmarks with the same names and
562−-- then add a comparison in bench.sh.
563−
564−{-# INLINE unfoldrList #-}
565−unfoldrList :: Int -> Int -> [Int]
566−unfoldrList maxval n = List.unfoldr step n
567− where
568− step cnt =
569− if cnt > n + maxval
570− then Nothing
571− else Just (cnt, cnt + 1)
572−
573−{-# INLINE toNullApNestedList #-}
574−toNullApNestedList :: [Int] -> [Int]
575−toNullApNestedList s = (+) <$> s <*> s
576−
577−{-# INLINE toNullNestedList #-}
578−toNullNestedList :: [Int] -> [Int]
579−toNullNestedList s = do
580− x <- s
581− y <- s
582− return $ x + y
583−
584−{-# INLINE toNullNestedList3 #-}
585−toNullNestedList3 :: [Int] -> [Int]
586−toNullNestedList3 s = do
587− x <- s
588− y <- s
589− z <- s
590− return $ x + y + z
591−
592−{-# INLINE filterAllOutNestedList #-}
593−filterAllOutNestedList :: [Int] -> [Int]
594−filterAllOutNestedList str = do
595− x <- str
596− y <- str
597− let s = x + y
598− if s < 0
599− then return s
600− else []
601−
602−{-# INLINE filterAllInNestedList #-}
603−filterAllInNestedList :: [Int] -> [Int]
604−filterAllInNestedList str = do
605− x <- str
606− y <- str
607− let s = x + y
608− if s > 0
609− then return s
610− else []
611− -}
612−
613−-------------------------------------------------------------------------------
614−-- Benchmarks
615−-------------------------------------------------------------------------------
616−
617−moduleName :: String
618−moduleName = "Data.Stream.ToStreamK"
619−
620−-- Generation of StreamK using StreamD generation functions and eleminating
621−-- using StreamK drain.
622−o_1_space_generation :: Int -> Benchmark
623−o_1_space_generation streamLen =
624− bgroup "generation"
625− [ benchFold "unfoldr" drain (unfoldrD streamLen)
626− , benchFold "unfoldrM" drain (unfoldrMD streamLen)
627− , benchFold "repeat" drain (repeat streamLen)
628− , benchFold "repeatM" drain (repeatM streamLen)
629− , benchFold "replicate" drain (replicate streamLen)
630− , benchFold "replicateM" drain (replicateM streamLen)
631− , benchFold "iterate" drain (iterate streamLen)
632− , benchFold "iterateM" drain (iterateM streamLen)
633−
634− , benchFold "fromFoldable" drain (fromFoldable streamLen)
635− , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
636−
637− -- appends
638− , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
639− , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
640− ]
641−
642−-- Generating using StreamK and eliminating using StreamD folds.
643−o_1_space_elimination :: Int -> Benchmark
644−o_1_space_elimination streamLen =
645− bgroup "elimination"
646− [ benchFold "toNull" drainD (unfoldrMK streamLen)
647− , benchFold "mapM_" mapM_ (unfoldrMK streamLen)
648− -- , benchFold "uncons" uncons (unfoldrMK streamLen)
649− -- , benchFold "init" init (unfoldrM streamLen)
650− , benchFold "foldl'" foldl' (unfoldrMK streamLen)
651− , benchFold "last" last (unfoldrMK streamLen)
652− ]
653−
654−{-
655−o_1_space_nested :: Int -> Benchmark
656−o_1_space_nested streamLen =
657− bgroup "nested"
658− [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
659− , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
660− , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
661− , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
662− , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
663− , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
664− , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
665− , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
666− , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
667− , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
668− ]
669− where
670− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
671− streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
672−-}
673−
674−-- Generate using StreamK and transform using StreamD transformation functions
675−-- and then drain using StreamK.
676−o_1_space_transformation :: Int -> Benchmark
677−o_1_space_transformation streamLen =
678− bgroup "transformation"
679− [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
680− benchFold "scanl'" (scanl' 1) (unfoldrMK streamLen)
681− , benchFold "map" (map 1) (unfoldrMK streamLen)
682− -- , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
683− , benchFold "mapM" (mapM 1) (unfoldrMK streamLen)
684− -- , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
685− ]
686−
687−o_1_space_transformationX4 :: Int -> Benchmark
688−o_1_space_transformationX4 streamLen =
689− bgroup "transformationX4"
690− [ benchFold "scanl'" (scanl' 4) (unfoldrMK streamLen)
691− , benchFold "map" (map 4) (unfoldrMK streamLen)
692− -- , benchFold "fmap" (fmapK 4) (unfoldrMK streamLen)
693− , benchFold "mapM" (mapM 4) (unfoldrMK streamLen)
694− -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
695− -- XXX this is horribly slow
696− -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
697− ]
698−
699−-- Generate using K, fold using K, concat using D.concatMap
700−o_1_space_concat :: Int -> Benchmark
701−o_1_space_concat streamLen =
702− bgroup "concat"
703− [ {- benchIOSrc1 "concatMapPure (n of 1)"
704− (concatMapPure streamLen 1)
705− , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
706− (concatMapPure streamLen2 streamLen2)
707− , benchIOSrc1 "concatMapPure (1 of n)"
708− (concatMapPure 1 streamLen)
709− -}
710−
711− benchIOSrc1 "concatMap (n of 1)"
712− (concatMap streamLen 1)
713− , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
714− (concatMap streamLen2 streamLen2)
715− , benchIOSrc1 "concatMap (1 of n)"
716− (concatMap 1 streamLen)
717−
718−{-
719− , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
720− (concatMapRepl streamLen2 streamLen2)
721−
722− -- This is for comparison with concatMapFoldableWith
723− , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
724− (S.drain
725− . S.concatMapWith S.serial id
726− . sourceConcatMapId streamLen)
727−
728− , benchIOSrc1 "concatMapBy serial (n of 1)"
729− (concatMapBySerial streamLen 1)
730− , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
731− (concatMapBySerial streamLen2 streamLen2)
732− , benchIOSrc1 "concatMapBy serial (1 of n)"
733− (concatMapBySerial 1 streamLen)
734− , benchFold "sortBy" sortBy (unfoldrM streamLen)
735− -}
736− ]
737− where
738− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
739−
740−o_1_space_filtering :: Int -> Benchmark
741−o_1_space_filtering streamLen =
742− bgroup "filtering"
743− [ benchFold "filter-even" (filterEven 1) (unfoldrMK streamLen)
744− {-
745− , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
746− , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
747− , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
748− , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
749− , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
750− , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
751− , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
752− , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
753− -}
754− ]
755−
756−o_1_space_filteringX4 :: Int -> Benchmark
757−o_1_space_filteringX4 streamLen =
758− bgroup "filteringX4"
759− [ benchFold "filter-even" (filterEven 4) (unfoldrMK streamLen)
760− {-
761− , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
762− , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
763− , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
764− , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
765− , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
766− , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
767− , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
768− , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
769− -}
770− ]
771−
772−{-
773−o_1_space_zipping :: Int -> Benchmark
774−o_1_space_zipping streamLen =
775− bgroup "zipping"
776− [ benchFold "zipWith" zipWith (unfoldrM streamLen)
777− , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
778− ]
779−
780−o_1_space_mixed :: Int -> Benchmark
781−o_1_space_mixed streamLen =
782− bgroup "mixed"
783− [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
784− , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
785− , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
786− , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
787− , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
788− , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
789− , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
790− , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
791− , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
792− , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
793− ]
794−
795−o_1_space_mixedX2 :: Int -> Benchmark
796−o_1_space_mixedX2 streamLen =
797− bgroup "mixedX2"
798− [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
799− , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
800− , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
801− , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
802− , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
803− , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
804− , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
805− , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
806− , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
807− , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
808− ]
809−
810−o_1_space_mixedX4 :: Int -> Benchmark
811−o_1_space_mixedX4 streamLen =
812− bgroup "mixedX4"
813− [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
814− , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
815− , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
816− , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
817− , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
818− , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
819− , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
820− , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
821− , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
822− , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
823− ]
824− -}
825−
826−{-
827−o_1_space_list :: Int -> Benchmark
828−o_1_space_list streamLen =
829− bgroup "list"
830− [ bgroup "elimination"
831− [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
832− ]
833− , bgroup "nested"
834− [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
835− , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
836− , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
837− , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
838− , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
839− ]
840− ]
841− where
842−
843− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
844− streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
845−-}
846−
847−o_1_space :: Int -> Benchmark
848−o_1_space streamLen =
849− bgroup (o_1_space_prefix moduleName)
850− [ o_1_space_generation streamLen
851− , o_1_space_elimination streamLen
852− -- , o_1_space_nested streamLen
853− , o_1_space_transformation streamLen
854− , o_1_space_transformationX4 streamLen
855− , o_1_space_concat streamLen
856− , o_1_space_filtering streamLen
857− , o_1_space_filteringX4 streamLen
858− -- , o_1_space_zipping streamLen
859− -- , o_1_space_mixed streamLen
860− -- , o_1_space_mixedX2 streamLen
861− -- , o_1_space_mixedX4 streamLen
862− -- , o_1_space_list streamLen
863− ]
864−
865−{-
866−o_n_heap :: Int -> Benchmark
867−o_n_heap streamLen =
868− bgroup (o_n_heap_prefix moduleName)
869− [ bgroup "transformation"
870− [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
871− ]
872− ]
873−
874−{-# INLINE benchK #-}
875−benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
876−benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
877−
878−o_n_stack :: Int -> Int -> Int -> Benchmark
879−o_n_stack streamLen iterStreamLen maxIters =
880− bgroup (o_n_stack_prefix moduleName)
881− [ bgroup "elimination"
882− [ benchFold "tail" tail (unfoldrM streamLen)
883− , benchFold "nullTail" nullTail (unfoldrM streamLen)
884− , benchFold "headTail" headTail (unfoldrM streamLen)
885− ]
886− , bgroup "transformation"
887− [
888− -- XXX why do these need so much stack
889− benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
890− , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
891− ]
892− , bgroup "transformationX4"
893− [
894− benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
895− ]
896− , bgroup "iterated"
897− [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
898− , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
899− , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
900− , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
901− , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
902− , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
903− , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
904− ]
905− ]
906− where
907− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
908− streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
909−-}
910−
911−o_n_space :: Int -> Benchmark
912−o_n_space streamLen =
913− bgroup (o_n_space_prefix moduleName)
914− [ bgroup "elimination"
915− [ benchFold "toList" toList (unfoldrMK streamLen)
916− ]
917− ]
918−
919−{-
920−{-# INLINE benchList #-}
921−benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
922−benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
923−-}
924−
925−main :: IO ()
926−main =
927− defaultMain
928− [ o_1_space streamLen
929− -- , o_n_stack streamLen iterStreamLen maxIters
930− -- , o_n_heap streamLen
931− , o_n_space streamLen
932− ]
933−
934− where
935−
936− streamLen = 100000
937− -- maxIters = 10000
938− -- iterStreamLen = 10