git.iko.soy/streamly
on a05abfc help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
906 lines 30 kB history raw
1-- |
2-- Module : Streamly.Benchmark.Data.Stream.StreamK
3-- Copyright : (c) 2018 Composewell Technologies
4--
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
8{-# LANGUAGE CPP #-}
9{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
12#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
14#endif
16#ifdef INSPECTION
17{-# LANGUAGE TemplateHaskell #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
21module Main (main) where
23import Control.Monad (when)
24import Data.Maybe (isJust)
25import System.Random (randomRIO)
26import Prelude hiding
27 ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate
28 , repeat, replicate
29 )
31import qualified Prelude as P
32import qualified Data.List as List
34import qualified Streamly.Internal.Control.Concurrent as S
35import qualified Streamly.Internal.Data.Stream.StreamK.Type as S
36import qualified Streamly.Internal.Data.Stream.StreamK as S
38import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
40import Streamly.Benchmark.Common
42#ifdef INSPECTION
43import Test.Inspection
44#endif
46{-
48Benchmarks that need to be added
50-- fromList
52-- bindWith
53-- concatPairsWith
54-- apWith
55-- apSerial
56-- apSerialDiscardFst
57-- apSerialDiscardSnd
59-- the
60-- serial
61-- consMStream
62-- withLocal
63-- mfix
65-- elem
66-- notElem
67-- all
68-- any
69-- minimum
70-- minimumBy
71-- maximum
72-- maximumBy
73-- findIndices
74-- lookup
75-- findM
76-- find
77-- (!!)
79-- foldlM'
80-- foldlT
81-- foldlx'
82-- foldlMx'
83-- fold
85-- sequence
87-- foldrSM
88-- buildS
89-- buildM
90-- augmentS
91-- augmentSM
92-- foldr
93-- foldr1
94-- foldrM
95-- foldrT
97-- intersperseM
98-- insertBy
99-- deleteBy
100-- reverse
101-- mapMaybe
103-- zipWithM
104-- mergeBy
105-- mergeByM
107-- toStreamK (Probably can be skipped)
108-- hoist
110-- scanlx'
112-}
114-------------------------------------------------------------------------------
115-- Stream generation and elimination
116-------------------------------------------------------------------------------
118type Stream m a = S.Stream m a
120{-# INLINE unfoldr #-}
121unfoldr :: Int -> Int -> Stream m Int
122unfoldr streamLen n = S.unfoldr step n
123 where
124 step cnt =
125 if cnt > n + streamLen
126 then Nothing
127 else Just (cnt, cnt + 1)
129{-# INLINE unfoldrM #-}
130unfoldrM :: S.MonadAsync m => Int -> Int -> Stream m Int
131unfoldrM streamLen n = S.unfoldrMWith S.consM step n
132 where
133 step cnt =
134 if cnt > n + streamLen
135 then return Nothing
136 else return (Just (cnt, cnt + 1))
138{-# INLINE repeat #-}
139repeat :: Int -> Int -> Stream m Int
140repeat streamLen = S.take streamLen . S.repeat
142{-# INLINE repeatM #-}
143repeatM :: S.MonadAsync m => Int -> Int -> Stream m Int
144repeatM streamLen = S.take streamLen . S.repeatM . return
146{-# INLINE replicate #-}
147replicate :: Int -> Int -> Stream m Int
148replicate = S.replicate
150{-# INLINE replicateM #-}
151replicateM :: S.MonadAsync m => Int -> Int -> Stream m Int
152replicateM streamLen = S.replicateMWith S.consM streamLen . return
154{-# INLINE iterate #-}
155iterate :: Int -> Int -> Stream m Int
156iterate streamLen = S.take streamLen . S.iterate (+1)
158{-# INLINE iterateM #-}
159iterateM :: S.MonadAsync m => Int -> Int -> Stream m Int
160iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
162{-# INLINE fromFoldable #-}
163fromFoldable :: Int -> Int -> Stream m Int
164fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
166{-# INLINE fromFoldableM #-}
167fromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int
168fromFoldableM streamLen n =
169 Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
171{-# INLINABLE concatMapFoldableWith #-}
172concatMapFoldableWith :: Foldable f
173 => (Stream m b -> Stream m b -> Stream m b)
174 -> (a -> Stream m b)
175 -> f a
176 -> Stream m b
177concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
179{-# INLINE concatMapFoldableSerial #-}
180concatMapFoldableSerial :: Int -> Int -> Stream m Int
181concatMapFoldableSerial streamLen n = concatMapFoldableWith S.serial S.fromPure [n..n+streamLen]
183{-# INLINE concatMapFoldableSerialM #-}
184concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
185concatMapFoldableSerialM streamLen n =
186 concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
188-------------------------------------------------------------------------------
189-- Elimination
190-------------------------------------------------------------------------------
192{-# INLINE drain #-}
193drain :: Monad m => Stream m a -> m ()
194drain = S.drain
196{-# INLINE mapM_ #-}
197mapM_ :: Monad m => Stream m a -> m ()
198mapM_ = S.mapM_ (\_ -> return ())
200{-# INLINE uncons #-}
201uncons :: Monad m => Stream m Int -> m ()
202uncons s = do
203 r <- S.uncons s
204 case r of
205 Nothing -> return ()
206 Just (_, t) -> uncons t
208{-# INLINE init #-}
209init :: Monad m => Stream m a -> m ()
210init s = do
211 t <- S.init s
212 P.mapM_ S.drain t
214{-# INLINE tail #-}
215tail :: Monad m => Stream m a -> m ()
216tail s = S.tail s >>= P.mapM_ tail
218{-# INLINE nullTail #-}
219nullTail :: Monad m => Stream m Int -> m ()
220nullTail s = do
221 r <- S.null s
222 when (not r) $ S.tail s >>= P.mapM_ nullTail
224{-# INLINE headTail #-}
225headTail :: Monad m => Stream m Int -> m ()
226headTail s = do
227 h <- S.head s
228 when (isJust h) $ S.tail s >>= P.mapM_ headTail
230{-# INLINE toList #-}
231toList :: Monad m => Stream m Int -> m [Int]
232toList = S.toList
234{-# INLINE foldl' #-}
235foldl' :: Monad m => Stream m Int -> m Int
236foldl' = S.foldl' (+) 0
238{-# INLINE last #-}
239last :: Monad m => Stream m Int -> m (Maybe Int)
240last = S.last
242-------------------------------------------------------------------------------
243-- Transformation
244-------------------------------------------------------------------------------
246{-# INLINE composeN #-}
247composeN
248 :: Monad m
249 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
250composeN n f =
251 case n of
252 1 -> drain . f
253 2 -> drain . f . f
254 3 -> drain . f . f . f
255 4 -> drain . f . f . f . f
256 _ -> undefined
258{-# INLINE scanl' #-}
259scanl' :: Monad m => Int -> Stream m Int -> m ()
260scanl' n = composeN n $ S.scanl' (+) 0
262{-# INLINE map #-}
263map :: Monad m => Int -> Stream m Int -> m ()
264map n = composeN n $ S.map (+ 1)
266{-# INLINE fmapK #-}
267fmapK :: Monad m => Int -> Stream m Int -> m ()
268fmapK n = composeN n $ P.fmap (+ 1)
270{-# INLINE mapM #-}
271mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()
272mapM n = composeN n $ S.mapMWith S.consM return
274{-# INLINE mapMSerial #-}
275mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
276mapMSerial n = composeN n $ S.mapMSerial return
278{-# INLINE filterEven #-}
279filterEven :: Monad m => Int -> Stream m Int -> m ()
280filterEven n = composeN n $ S.filter even
282{-# INLINE filterAllOut #-}
283filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
284filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
286{-# INLINE filterAllIn #-}
287filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
288filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
290{-# INLINE _takeOne #-}
291_takeOne :: Monad m => Int -> Stream m Int -> m ()
292_takeOne n = composeN n $ S.take 1
294{-# INLINE takeAll #-}
295takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
296takeAll streamLen n = composeN n $ S.take streamLen
298{-# INLINE takeWhileTrue #-}
299takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
300takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
302{-# INLINE dropOne #-}
303dropOne :: Monad m => Int -> Stream m Int -> m ()
304dropOne n = composeN n $ S.drop 1
306{-# INLINE dropAll #-}
307dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
308dropAll streamLen n = composeN n $ S.drop streamLen
310{-# INLINE dropWhileTrue #-}
311dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
312dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
314{-# INLINE dropWhileFalse #-}
315dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
316dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
318{-# INLINE foldrS #-}
319foldrS :: Monad m => Int -> Stream m Int -> m ()
320foldrS n = composeN n $ S.foldrS S.cons S.nil
322{-# INLINE foldlS #-}
323foldlS :: Monad m => Int -> Stream m Int -> m ()
324foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
326{-# INLINE intersperse #-}
327intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
328intersperse streamLen n = composeN n $ S.intersperse streamLen
330-------------------------------------------------------------------------------
331-- Iteration
332-------------------------------------------------------------------------------
334{-# INLINE iterateSource #-}
335iterateSource
336 :: S.MonadAsync m
337 => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
338iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
339 where
340 f (0 :: Int) m = g m
341 f x m = g (f (x P.- 1) m)
343-- this is quadratic
344{-# INLINE iterateScan #-}
345iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
346iterateScan iterStreamLen maxIters =
347 iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
349-- this is quadratic
350{-# INLINE iterateDropWhileFalse #-}
351iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
352iterateDropWhileFalse streamLen iterStreamLen maxIters =
353 iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
355{-# INLINE iterateMapM #-}
356iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
357iterateMapM iterStreamLen =
358 iterateSource iterStreamLen (S.mapMWith S.consM return)
360{-# INLINE iterateFilterEven #-}
361iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
362iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
364{-# INLINE iterateTakeAll #-}
365iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
366iterateTakeAll streamLen iterStreamLen =
367 iterateSource iterStreamLen (S.take streamLen)
369{-# INLINE iterateDropOne #-}
370iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
371iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
373{-# INLINE iterateDropWhileTrue #-}
374iterateDropWhileTrue :: S.MonadAsync m =>
375 Int -> Int -> Int -> Int -> Stream m Int
376iterateDropWhileTrue streamLen iterStreamLen =
377 iterateSource iterStreamLen (S.dropWhile (<= streamLen))
379-------------------------------------------------------------------------------
380-- Zipping
381-------------------------------------------------------------------------------
383{-# INLINE zipWith #-}
384zipWith :: Monad m => Stream m Int -> m ()
385zipWith src = drain $ S.zipWith (,) src src
387{-# INLINE zipWithM #-}
388zipWithM :: Monad m => Stream m Int -> m ()
389zipWithM src = drain $ S.zipWithM (curry return) src src
391{-# INLINE sortByK #-}
392sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
393sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
395{-# INLINE sortBy #-}
396sortBy :: Monad m => Stream m Int -> m ()
397sortBy = drain . sortByK compare
399-------------------------------------------------------------------------------
400-- Mixed Composition
401-------------------------------------------------------------------------------
403{-# INLINE scanMap #-}
404scanMap :: Monad m => Int -> Stream m Int -> m ()
405scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
407{-# INLINE dropMap #-}
408dropMap :: Monad m => Int -> Stream m Int -> m ()
409dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
411{-# INLINE dropScan #-}
412dropScan :: Monad m => Int -> Stream m Int -> m ()
413dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
415{-# INLINE takeDrop #-}
416takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
417takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
419{-# INLINE takeScan #-}
420takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
421takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
423{-# INLINE takeMap #-}
424takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
425takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
427{-# INLINE filterDrop #-}
428filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
429filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
431{-# INLINE filterTake #-}
432filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
433filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
435{-# INLINE filterScan #-}
436filterScan :: Monad m => Int -> Stream m Int -> m ()
437filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
439{-# INLINE filterMap #-}
440filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
441filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
443-------------------------------------------------------------------------------
444-- ConcatMap
445-------------------------------------------------------------------------------
447-- concatMap unfoldrM/unfoldrM
449{-# INLINE concatMap #-}
450concatMap :: Int -> Int -> Int -> IO ()
451concatMap outer inner n =
452 S.drain $ S.concatMap
453 (\_ -> unfoldrM inner n)
454 (unfoldrM outer n)
456#ifdef INSPECTION
457inspect $ hasNoTypeClasses 'concatMap
458#endif
460-- concatMap unfoldr/unfoldr
462{-# INLINE concatMapPure #-}
463concatMapPure :: Int -> Int -> Int -> IO ()
464concatMapPure outer inner n =
465 S.drain $ S.concatMap
466 (\_ -> unfoldr inner n)
467 (unfoldr outer n)
469#ifdef INSPECTION
470inspect $ hasNoTypeClasses 'concatMapPure
471#endif
473-- concatMap replicate/unfoldrM
475{-# INLINE concatMapRepl #-}
476concatMapRepl :: Int -> Int -> Int -> IO ()
477concatMapRepl outer inner n =
478 S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
480#ifdef INSPECTION
481inspect $ hasNoTypeClasses 'concatMapRepl
482#endif
484-- concatMapWith
486{-# INLINE sourceConcatMapId #-}
487sourceConcatMapId :: Monad m
488 => Int -> Int -> Stream m (Stream m Int)
489sourceConcatMapId val n =
490 S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
492{-# INLINE concatMapBySerial #-}
493concatMapBySerial :: Int -> Int -> Int -> IO ()
494concatMapBySerial outer inner n =
495 S.drain $ S.concatMapWith S.serial
496 (unfoldrM inner)
497 (unfoldrM outer n)
499-------------------------------------------------------------------------------
500-- Nested Composition
501-------------------------------------------------------------------------------
503{-# INLINE drainApplicative #-}
504drainApplicative :: Monad m => Stream m Int -> m ()
505drainApplicative s = drain $ do
506 (+) <$> s <*> s
508{-# INLINE drainMonad #-}
509drainMonad :: Monad m => Stream m Int -> m ()
510drainMonad s = drain $ do
511 x <- s
512 y <- s
513 return $ x + y
515{-# INLINE drainMonad3 #-}
516drainMonad3 :: Monad m => Stream m Int -> m ()
517drainMonad3 s = drain $ do
518 x <- s
519 y <- s
520 z <- s
521 return $ x + y + z
523{-# INLINE filterAllOutMonad #-}
524filterAllOutMonad
525 :: Monad m
526 => Stream m Int -> m ()
527filterAllOutMonad str = drain $ do
528 x <- str
529 y <- str
530 let s = x + y
531 if s < 0
532 then return s
533 else S.nil
535{-# INLINE filterAllInMonad #-}
536filterAllInMonad
537 :: Monad m
538 => Stream m Int -> m ()
539filterAllInMonad str = drain $ do
540 x <- str
541 y <- str
542 let s = x + y
543 if s > 0
544 then return s
545 else S.nil
547-------------------------------------------------------------------------------
548-- Nested Composition Pure lists
549-------------------------------------------------------------------------------
551-- There are several list benchmarks here for comparison with lists. It is easy
552-- and convenient to see the comparisons when they are here, otherwise we'll
553-- have to add a separate module for list benchmarks with the same names and
554-- then add a comparison in bench.sh.
556{-# INLINE unfoldrList #-}
557unfoldrList :: Int -> Int -> [Int]
558unfoldrList maxval n = List.unfoldr step n
559 where
560 step cnt =
561 if cnt > n + maxval
562 then Nothing
563 else Just (cnt, cnt + 1)
565{-# INLINE toNullApNestedList #-}
566toNullApNestedList :: [Int] -> [Int]
567toNullApNestedList s = (+) <$> s <*> s
569{-# INLINE toNullNestedList #-}
570toNullNestedList :: [Int] -> [Int]
571toNullNestedList s = do
572 x <- s
573 y <- s
574 return $ x + y
576{-# INLINE toNullNestedList3 #-}
577toNullNestedList3 :: [Int] -> [Int]
578toNullNestedList3 s = do
579 x <- s
580 y <- s
581 z <- s
582 return $ x + y + z
584{-# INLINE filterAllOutNestedList #-}
585filterAllOutNestedList :: [Int] -> [Int]
586filterAllOutNestedList str = do
587 x <- str
588 y <- str
589 let s = x + y
590 if s < 0
591 then return s
592 else []
594{-# INLINE filterAllInNestedList #-}
595filterAllInNestedList :: [Int] -> [Int]
596filterAllInNestedList str = do
597 x <- str
598 y <- str
599 let s = x + y
600 if s > 0
601 then return s
602 else []
604-------------------------------------------------------------------------------
605-- Benchmarks
606-------------------------------------------------------------------------------
608moduleName :: String
609moduleName = "Data.Stream.StreamK"
611o_1_space_generation :: Int -> Benchmark
612o_1_space_generation streamLen =
613 bgroup "generation"
614 [ benchFold "unfoldr" drain (unfoldr streamLen)
615 , benchFold "unfoldrM" drain (unfoldrM streamLen)
616 , benchFold "repeat" drain (repeat streamLen)
617 , benchFold "repeatM" drain (repeatM streamLen)
618 , benchFold "replicate" drain (replicate streamLen)
619 , benchFold "replicateM" drain (replicateM streamLen)
620 , benchFold "iterate" drain (iterate streamLen)
621 , benchFold "iterateM" drain (iterateM streamLen)
623 , benchFold "fromFoldable" drain (fromFoldable streamLen)
624 , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
626 -- appends
627 , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
628 , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
629 ]
631o_1_space_elimination :: Int -> Benchmark
632o_1_space_elimination streamLen =
633 bgroup "elimination"
634 [ benchFold "toNull" drain (unfoldrM streamLen)
635 , benchFold "mapM_" mapM_ (unfoldrM streamLen)
636 , benchFold "uncons" uncons (unfoldrM streamLen)
637 , benchFold "init" init (unfoldrM streamLen)
638 , benchFold "foldl'" foldl' (unfoldrM streamLen)
639 , benchFold "last" last (unfoldrM streamLen)
640 ]
642o_1_space_nested :: Int -> Benchmark
643o_1_space_nested streamLen =
644 bgroup "nested"
645 [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
646 , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
647 , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
648 , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
649 , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
650 , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
651 , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
652 , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
653 , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
654 , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
655 ]
656 where
657 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
658 streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
660o_1_space_transformation :: Int -> Benchmark
661o_1_space_transformation streamLen =
662 bgroup "transformation"
663 [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
664 , benchFold "scanl'" (scanl' 1) (unfoldrM streamLen)
665 , benchFold "map" (map 1) (unfoldrM streamLen)
666 , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
667 , benchFold "mapM" (mapM 1) (unfoldrM streamLen)
668 , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
669 ]
671o_1_space_transformationX4 :: Int -> Benchmark
672o_1_space_transformationX4 streamLen =
673 bgroup "transformationX4"
674 [ benchFold "scanl'" (scanl' 4) (unfoldrM streamLen)
675 , benchFold "map" (map 4) (unfoldrM streamLen)
676 , benchFold "fmap" (fmapK 4) (unfoldrM streamLen)
677 , benchFold "mapM" (mapM 4) (unfoldrM streamLen)
678 , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
679 -- XXX this is horribly slow
680 -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
681 ]
683o_1_space_concat :: Int -> Benchmark
684o_1_space_concat streamLen =
685 bgroup "concat"
686 [ benchIOSrc1 "concatMapPure (n of 1)"
687 (concatMapPure streamLen 1)
688 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
689 (concatMapPure streamLen2 streamLen2)
690 , benchIOSrc1 "concatMapPure (1 of n)"
691 (concatMapPure 1 streamLen)
693 , benchIOSrc1 "concatMap (n of 1)"
694 (concatMap streamLen 1)
695 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
696 (concatMap streamLen2 streamLen2)
697 , benchIOSrc1 "concatMap (1 of n)"
698 (concatMap 1 streamLen)
700 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
701 (concatMapRepl streamLen2 streamLen2)
703 -- This is for comparison with concatMapFoldableWith
704 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
705 (S.drain
706 . S.concatMapWith S.serial id
707 . sourceConcatMapId streamLen)
709 , benchIOSrc1 "concatMapBy serial (n of 1)"
710 (concatMapBySerial streamLen 1)
711 , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
712 (concatMapBySerial streamLen2 streamLen2)
713 , benchIOSrc1 "concatMapBy serial (1 of n)"
714 (concatMapBySerial 1 streamLen)
715 , benchFold "sortBy" sortBy (unfoldrM streamLen)
716 ]
717 where
718 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
720o_1_space_filtering :: Int -> Benchmark
721o_1_space_filtering streamLen =
722 bgroup "filtering"
723 [ benchFold "filter-even" (filterEven 1) (unfoldrM streamLen)
724 , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
725 , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
726 , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
727 , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
728 , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
729 , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
730 , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
731 , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
732 ]
734o_1_space_filteringX4 :: Int -> Benchmark
735o_1_space_filteringX4 streamLen =
736 bgroup "filteringX4"
737 [ benchFold "filter-even" (filterEven 4) (unfoldrM streamLen)
738 , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
739 , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
740 , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
741 , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
742 , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
743 , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
744 , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
745 , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
746 ]
748o_1_space_zipping :: Int -> Benchmark
749o_1_space_zipping streamLen =
750 bgroup "zipping"
751 [ benchFold "zipWith" zipWith (unfoldrM streamLen)
752 , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
753 ]
755o_1_space_mixed :: Int -> Benchmark
756o_1_space_mixed streamLen =
757 bgroup "mixed"
758 [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
759 , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
760 , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
761 , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
762 , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
763 , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
764 , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
765 , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
766 , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
767 , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
768 ]
770o_1_space_mixedX2 :: Int -> Benchmark
771o_1_space_mixedX2 streamLen =
772 bgroup "mixedX2"
773 [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
774 , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
775 , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
776 , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
777 , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
778 , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
779 , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
780 , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
781 , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
782 , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
783 ]
785o_1_space_mixedX4 :: Int -> Benchmark
786o_1_space_mixedX4 streamLen =
787 bgroup "mixedX4"
788 [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
789 , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
790 , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
791 , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
792 , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
793 , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
794 , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
795 , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
796 , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
797 , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
798 ]
800o_1_space_list :: Int -> Benchmark
801o_1_space_list streamLen =
802 bgroup "list"
803 [ bgroup "elimination"
804 [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
805 ]
806 , bgroup "nested"
807 [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
808 , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
809 , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
810 , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
811 , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
812 ]
813 ]
814 where
816 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
817 streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
819o_1_space :: Int -> Benchmark
820o_1_space streamLen =
821 bgroup (o_1_space_prefix moduleName)
822 [ o_1_space_generation streamLen
823 , o_1_space_elimination streamLen
824 , o_1_space_nested streamLen
825 , o_1_space_transformation streamLen
826 , o_1_space_transformationX4 streamLen
827 , o_1_space_concat streamLen
828 , o_1_space_filtering streamLen
829 , o_1_space_filteringX4 streamLen
830 , o_1_space_zipping streamLen
831 , o_1_space_mixed streamLen
832 , o_1_space_mixedX2 streamLen
833 , o_1_space_mixedX4 streamLen
834 , o_1_space_list streamLen
835 ]
837o_n_heap :: Int -> Benchmark
838o_n_heap streamLen =
839 bgroup (o_n_heap_prefix moduleName)
840 [ bgroup "transformation"
841 [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
842 ]
843 ]
845{-# INLINE benchK #-}
846benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
847benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
849o_n_stack :: Int -> Int -> Int -> Benchmark
850o_n_stack streamLen iterStreamLen maxIters =
851 bgroup (o_n_stack_prefix moduleName)
852 [ bgroup "elimination"
853 [ benchFold "tail" tail (unfoldrM streamLen)
854 , benchFold "nullTail" nullTail (unfoldrM streamLen)
855 , benchFold "headTail" headTail (unfoldrM streamLen)
856 ]
857 , bgroup "transformation"
858 [
859 -- XXX why do these need so much stack
860 benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
861 , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
862 ]
863 , bgroup "transformationX4"
864 [
865 benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
866 ]
867 , bgroup "iterated"
868 [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
869 , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
870 , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
871 , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
872 , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
873 , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
874 , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
875 ]
876 ]
877 where
878 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
879 streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
881o_n_space :: Int -> Benchmark
882o_n_space streamLen =
883 bgroup (o_n_space_prefix moduleName)
884 [ bgroup "elimination"
885 [ benchFold "toList" toList (unfoldrM streamLen)
886 ]
887 ]
889{-# INLINE benchList #-}
890benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
891benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
893main :: IO ()
894main =
895 defaultMain
896 [ o_1_space streamLen
897 , o_n_stack streamLen iterStreamLen maxIters
898 , o_n_heap streamLen
899 , o_n_space streamLen
900 ]
902 where
904 streamLen = 100000
905 maxIters = 10000
906 iterStreamLen = 10