git.iko.soy/streamly
on 3feeec2 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
881 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.Data.Stream.StreamK as S
35import qualified Streamly.Internal.Data.SVar as S
37import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
39import Streamly.Benchmark.Common
41#ifdef INSPECTION
42import Test.Inspection
43#endif
45{-
47Benchmarks that need to be added
49-- fromList
51-- bindWith
52-- concatPairsWith
53-- apWith
54-- apSerial
55-- apSerialDiscardFst
56-- apSerialDiscardSnd
58-- the
59-- serial
60-- consMStream
61-- withLocal
62-- mfix
64-- elem
65-- notElem
66-- all
67-- any
68-- minimum
69-- minimumBy
70-- maximum
71-- maximumBy
72-- findIndices
73-- lookup
74-- findM
75-- find
76-- (!!)
78-- foldlM'
79-- foldlT
80-- foldlx'
81-- foldlMx'
82-- fold
84-- sequence
86-- foldrSM
87-- buildS
88-- buildM
89-- augmentS
90-- augmentSM
91-- foldr
92-- foldr1
93-- foldrM
94-- foldrT
96-- intersperseM
97-- insertBy
98-- deleteBy
99-- reverse
100-- mapMaybe
102-- zipWithM
103-- mergeBy
104-- mergeByM
106-- toStreamK (Probably can be skipped)
107-- hoist
109-- scanlx'
111-}
113-------------------------------------------------------------------------------
114-- Stream generation and elimination
115-------------------------------------------------------------------------------
117type Stream m a = S.Stream m a
119{-# INLINE unfoldr #-}
120unfoldr :: Int -> Int -> Stream m Int
121unfoldr streamLen n = S.unfoldr step n
122 where
123 step cnt =
124 if cnt > n + streamLen
125 then Nothing
126 else Just (cnt, cnt + 1)
128{-# INLINE unfoldrM #-}
129unfoldrM :: S.MonadAsync m => Int -> Int -> Stream m Int
130unfoldrM streamLen n = S.unfoldrM step n
131 where
132 step cnt =
133 if cnt > n + streamLen
134 then return Nothing
135 else return (Just (cnt, cnt + 1))
137{-# INLINE repeat #-}
138repeat :: Int -> Int -> Stream m Int
139repeat streamLen = S.take streamLen . S.repeat
141{-# INLINE repeatM #-}
142repeatM :: S.MonadAsync m => Int -> Int -> Stream m Int
143repeatM streamLen = S.take streamLen . S.repeatM . return
145{-# INLINE replicate #-}
146replicate :: Int -> Int -> Stream m Int
147replicate = S.replicate
149{-# INLINE replicateM #-}
150replicateM :: S.MonadAsync m => Int -> Int -> Stream m Int
151replicateM streamLen = S.replicateM streamLen . return
153{-# INLINE iterate #-}
154iterate :: Int -> Int -> Stream m Int
155iterate streamLen = S.take streamLen . S.iterate (+1)
157{-# INLINE iterateM #-}
158iterateM :: S.MonadAsync m => Int -> Int -> Stream m Int
159iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
161{-# INLINE fromFoldable #-}
162fromFoldable :: Int -> Int -> Stream m Int
163fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
165{-# INLINE fromFoldableM #-}
166fromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int
167fromFoldableM streamLen n =
168 Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
170{-# INLINABLE concatMapFoldableWith #-}
171concatMapFoldableWith :: (S.IsStream t, Foldable f)
172 => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b
173concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
175{-# INLINE concatMapFoldableSerial #-}
176concatMapFoldableSerial :: Int -> Int -> Stream m Int
177concatMapFoldableSerial streamLen n = concatMapFoldableWith S.serial S.fromPure [n..n+streamLen]
179{-# INLINE concatMapFoldableSerialM #-}
180concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
181concatMapFoldableSerialM streamLen n =
182 concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
184-------------------------------------------------------------------------------
185-- Elimination
186-------------------------------------------------------------------------------
188{-# INLINE drain #-}
189drain :: Monad m => Stream m a -> m ()
190drain = S.drain
192{-# INLINE mapM_ #-}
193mapM_ :: Monad m => Stream m a -> m ()
194mapM_ = S.mapM_ (\_ -> return ())
196{-# INLINE uncons #-}
197uncons :: Monad m => Stream m Int -> m ()
198uncons s = do
199 r <- S.uncons s
200 case r of
201 Nothing -> return ()
202 Just (_, t) -> uncons t
204{-# INLINE init #-}
205init :: (Monad m, S.IsStream t) => t m a -> m ()
206init s = do
207 t <- S.init s
208 P.mapM_ S.drain t
210{-# INLINE tail #-}
211tail :: (Monad m, S.IsStream t) => t m a -> m ()
212tail s = S.tail s >>= P.mapM_ tail
214{-# INLINE nullTail #-}
215nullTail :: Monad m => Stream m Int -> m ()
216nullTail s = do
217 r <- S.null s
218 when (not r) $ S.tail s >>= P.mapM_ nullTail
220{-# INLINE headTail #-}
221headTail :: Monad m => Stream m Int -> m ()
222headTail s = do
223 h <- S.head s
224 when (isJust h) $ S.tail s >>= P.mapM_ headTail
226{-# INLINE toList #-}
227toList :: Monad m => Stream m Int -> m [Int]
228toList = S.toList
230{-# INLINE foldl' #-}
231foldl' :: Monad m => Stream m Int -> m Int
232foldl' = S.foldl' (+) 0
234{-# INLINE last #-}
235last :: Monad m => Stream m Int -> m (Maybe Int)
236last = S.last
238-------------------------------------------------------------------------------
239-- Transformation
240-------------------------------------------------------------------------------
242{-# INLINE composeN #-}
243composeN
244 :: Monad m
245 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
246composeN n f =
247 case n of
248 1 -> drain . f
249 2 -> drain . f . f
250 3 -> drain . f . f . f
251 4 -> drain . f . f . f . f
252 _ -> undefined
254{-# INLINE scanl' #-}
255scanl' :: Monad m => Int -> Stream m Int -> m ()
256scanl' n = composeN n $ S.scanl' (+) 0
258{-# INLINE map #-}
259map :: Monad m => Int -> Stream m Int -> m ()
260map n = composeN n $ S.map (+ 1)
262{-# INLINE fmapK #-}
263fmapK :: Monad m => Int -> Stream m Int -> m ()
264fmapK n = composeN n $ P.fmap (+ 1)
266{-# INLINE mapM #-}
267mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()
268mapM n = composeN n $ S.mapM return
270{-# INLINE mapMSerial #-}
271mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
272mapMSerial n = composeN n $ S.mapMSerial return
274{-# INLINE filterEven #-}
275filterEven :: Monad m => Int -> Stream m Int -> m ()
276filterEven n = composeN n $ S.filter even
278{-# INLINE filterAllOut #-}
279filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
280filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
282{-# INLINE filterAllIn #-}
283filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
284filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
286{-# INLINE _takeOne #-}
287_takeOne :: Monad m => Int -> Stream m Int -> m ()
288_takeOne n = composeN n $ S.take 1
290{-# INLINE takeAll #-}
291takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
292takeAll streamLen n = composeN n $ S.take streamLen
294{-# INLINE takeWhileTrue #-}
295takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
296takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
298{-# INLINE dropOne #-}
299dropOne :: Monad m => Int -> Stream m Int -> m ()
300dropOne n = composeN n $ S.drop 1
302{-# INLINE dropAll #-}
303dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
304dropAll streamLen n = composeN n $ S.drop streamLen
306{-# INLINE dropWhileTrue #-}
307dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
308dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
310{-# INLINE dropWhileFalse #-}
311dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
312dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
314{-# INLINE foldrS #-}
315foldrS :: Monad m => Int -> Stream m Int -> m ()
316foldrS n = composeN n $ S.foldrS S.cons S.nil
318{-# INLINE foldlS #-}
319foldlS :: Monad m => Int -> Stream m Int -> m ()
320foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
322{-# INLINE intersperse #-}
323intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
324intersperse streamLen n = composeN n $ S.intersperse streamLen
326-------------------------------------------------------------------------------
327-- Iteration
328-------------------------------------------------------------------------------
330{-# INLINE iterateSource #-}
331iterateSource
332 :: S.MonadAsync m
333 => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
334iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
335 where
336 f (0 :: Int) m = g m
337 f x m = g (f (x P.- 1) m)
339-- this is quadratic
340{-# INLINE iterateScan #-}
341iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
342iterateScan iterStreamLen maxIters = iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
344-- this is quadratic
345{-# INLINE iterateDropWhileFalse #-}
346iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
347iterateDropWhileFalse streamLen iterStreamLen maxIters =
348 iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
350{-# INLINE iterateMapM #-}
351iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
352iterateMapM iterStreamLen maxIters = iterateSource iterStreamLen (S.mapM return) maxIters
354{-# INLINE iterateFilterEven #-}
355iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
356iterateFilterEven iterStreamLen maxIters = iterateSource iterStreamLen (S.filter even) maxIters
358{-# INLINE iterateTakeAll #-}
359iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
360iterateTakeAll streamLen iterStreamLen maxIters = iterateSource iterStreamLen (S.take streamLen) maxIters
362{-# INLINE iterateDropOne #-}
363iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
364iterateDropOne iterStreamLen maxIters = iterateSource iterStreamLen (S.drop 1) maxIters
366{-# INLINE iterateDropWhileTrue #-}
367iterateDropWhileTrue :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
368iterateDropWhileTrue streamLen iterStreamLen maxIters = iterateSource iterStreamLen (S.dropWhile (<= streamLen)) maxIters
370-------------------------------------------------------------------------------
371-- Zipping
372-------------------------------------------------------------------------------
374{-# INLINE zipWith #-}
375zipWith :: S.MonadAsync m => Stream m Int -> m ()
376zipWith src = drain $ S.zipWith (,) src src
378-------------------------------------------------------------------------------
379-- Mixed Composition
380-------------------------------------------------------------------------------
382{-# INLINE scanMap #-}
383scanMap :: Monad m => Int -> Stream m Int -> m ()
384scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
386{-# INLINE dropMap #-}
387dropMap :: Monad m => Int -> Stream m Int -> m ()
388dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
390{-# INLINE dropScan #-}
391dropScan :: Monad m => Int -> Stream m Int -> m ()
392dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
394{-# INLINE takeDrop #-}
395takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
396takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
398{-# INLINE takeScan #-}
399takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
400takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
402{-# INLINE takeMap #-}
403takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
404takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
406{-# INLINE filterDrop #-}
407filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
408filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
410{-# INLINE filterTake #-}
411filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
412filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
414{-# INLINE filterScan #-}
415filterScan :: Monad m => Int -> Stream m Int -> m ()
416filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
418{-# INLINE filterMap #-}
419filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
420filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
422-------------------------------------------------------------------------------
423-- ConcatMap
424-------------------------------------------------------------------------------
426-- concatMap unfoldrM/unfoldrM
428{-# INLINE concatMap #-}
429concatMap :: Int -> Int -> Int -> IO ()
430concatMap outer inner n =
431 S.drain $ S.concatMap
432 (\_ -> unfoldrM inner n)
433 (unfoldrM outer n)
435#ifdef INSPECTION
436inspect $ hasNoTypeClasses 'concatMap
437#endif
439-- concatMap unfoldr/unfoldr
441{-# INLINE concatMapPure #-}
442concatMapPure :: Int -> Int -> Int -> IO ()
443concatMapPure outer inner n =
444 S.drain $ S.concatMap
445 (\_ -> unfoldr inner n)
446 (unfoldr outer n)
448#ifdef INSPECTION
449inspect $ hasNoTypeClasses 'concatMapPure
450#endif
452-- concatMap replicate/unfoldrM
454{-# INLINE concatMapRepl #-}
455concatMapRepl :: Int -> Int -> Int -> IO ()
456concatMapRepl outer inner n =
457 S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
459#ifdef INSPECTION
460inspect $ hasNoTypeClasses 'concatMapRepl
461#endif
463-- concatMapWith
465{-# INLINE sourceConcatMapId #-}
466sourceConcatMapId :: Monad m
467 => Int -> Int -> Stream m (Stream m Int)
468sourceConcatMapId val n =
469 S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
471{-# INLINE concatMapBySerial #-}
472concatMapBySerial :: Int -> Int -> Int -> IO ()
473concatMapBySerial outer inner n =
474 S.drain $ S.concatMapBy S.serial
475 (unfoldrM inner)
476 (unfoldrM outer n)
478-------------------------------------------------------------------------------
479-- Nested Composition
480-------------------------------------------------------------------------------
482{-# INLINE drainApplicative #-}
483drainApplicative :: Monad m => Stream m Int -> m ()
484drainApplicative s = drain $ do
485 (+) <$> s <*> s
487{-# INLINE drainMonad #-}
488drainMonad :: Monad m => Stream m Int -> m ()
489drainMonad s = drain $ do
490 x <- s
491 y <- s
492 return $ x + y
494{-# INLINE drainMonad3 #-}
495drainMonad3 :: Monad m => Stream m Int -> m ()
496drainMonad3 s = drain $ do
497 x <- s
498 y <- s
499 z <- s
500 return $ x + y + z
502{-# INLINE filterAllOutMonad #-}
503filterAllOutMonad
504 :: Monad m
505 => Stream m Int -> m ()
506filterAllOutMonad str = drain $ do
507 x <- str
508 y <- str
509 let s = x + y
510 if s < 0
511 then return s
512 else S.nil
514{-# INLINE filterAllInMonad #-}
515filterAllInMonad
516 :: Monad m
517 => Stream m Int -> m ()
518filterAllInMonad str = drain $ do
519 x <- str
520 y <- str
521 let s = x + y
522 if s > 0
523 then return s
524 else S.nil
526-------------------------------------------------------------------------------
527-- Nested Composition Pure lists
528-------------------------------------------------------------------------------
530-- There are several list benchmarks here for comparison with lists. It is easy
531-- and convenient to see the comparisons when they are here, otherwise we'll
532-- have to add a separate module for list benchmarks with the same names and
533-- then add a comparison in bench.sh.
535{-# INLINE unfoldrList #-}
536unfoldrList :: Int -> Int -> [Int]
537unfoldrList maxval n = List.unfoldr step n
538 where
539 step cnt =
540 if cnt > n + maxval
541 then Nothing
542 else Just (cnt, cnt + 1)
544{-# INLINE toNullApNestedList #-}
545toNullApNestedList :: [Int] -> [Int]
546toNullApNestedList s = (+) <$> s <*> s
548{-# INLINE toNullNestedList #-}
549toNullNestedList :: [Int] -> [Int]
550toNullNestedList s = do
551 x <- s
552 y <- s
553 return $ x + y
555{-# INLINE toNullNestedList3 #-}
556toNullNestedList3 :: [Int] -> [Int]
557toNullNestedList3 s = do
558 x <- s
559 y <- s
560 z <- s
561 return $ x + y + z
563{-# INLINE filterAllOutNestedList #-}
564filterAllOutNestedList :: [Int] -> [Int]
565filterAllOutNestedList str = do
566 x <- str
567 y <- str
568 let s = x + y
569 if s < 0
570 then return s
571 else []
573{-# INLINE filterAllInNestedList #-}
574filterAllInNestedList :: [Int] -> [Int]
575filterAllInNestedList str = do
576 x <- str
577 y <- str
578 let s = x + y
579 if s > 0
580 then return s
581 else []
583-------------------------------------------------------------------------------
584-- Benchmarks
585-------------------------------------------------------------------------------
587moduleName :: String
588moduleName = "Data.Stream.StreamK"
590o_1_space_generation :: Int -> Benchmark
591o_1_space_generation streamLen =
592 bgroup "generation"
593 [ benchFold "unfoldr" drain (unfoldr streamLen)
594 , benchFold "unfoldrM" drain (unfoldrM streamLen)
595 , benchFold "repeat" drain (repeat streamLen)
596 , benchFold "repeatM" drain (repeatM streamLen)
597 , benchFold "replicate" drain (replicate streamLen)
598 , benchFold "replicateM" drain (replicateM streamLen)
599 , benchFold "iterate" drain (iterate streamLen)
600 , benchFold "iterateM" drain (iterateM streamLen)
602 , benchFold "fromFoldable" drain (fromFoldable streamLen)
603 , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
605 -- appends
606 , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
607 , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
608 ]
610o_1_space_elimination :: Int -> Benchmark
611o_1_space_elimination streamLen =
612 bgroup "elimination"
613 [ benchFold "toNull" drain (unfoldrM streamLen)
614 , benchFold "mapM_" mapM_ (unfoldrM streamLen)
615 , benchFold "uncons" uncons (unfoldrM streamLen)
616 , benchFold "init" init (unfoldrM streamLen)
617 , benchFold "foldl'" foldl' (unfoldrM streamLen)
618 , benchFold "last" last (unfoldrM streamLen)
619 ]
621o_1_space_nested :: Int -> Benchmark
622o_1_space_nested streamLen =
623 bgroup "nested"
624 [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
625 , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
626 , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
627 , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
628 , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
629 , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
630 , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
631 , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
632 , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
633 , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
634 ]
635 where
636 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
637 streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
639o_1_space_transformation :: Int -> Benchmark
640o_1_space_transformation streamLen =
641 bgroup "transformation"
642 [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
643 , benchFold "scanl'" (scanl' 1) (unfoldrM streamLen)
644 , benchFold "map" (map 1) (unfoldrM streamLen)
645 , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
646 , benchFold "mapM" (mapM 1) (unfoldrM streamLen)
647 , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
648 ]
650o_1_space_transformationX4 :: Int -> Benchmark
651o_1_space_transformationX4 streamLen =
652 bgroup "transformationX4"
653 [ benchFold "scanl'" (scanl' 4) (unfoldrM streamLen)
654 , benchFold "map" (map 4) (unfoldrM streamLen)
655 , benchFold "fmap" (fmapK 4) (unfoldrM streamLen)
656 , benchFold "mapM" (mapM 4) (unfoldrM streamLen)
657 , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
658 -- XXX this is horribly slow
659 -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
660 ]
662o_1_space_concat :: Int -> Benchmark
663o_1_space_concat streamLen =
664 bgroup "concat"
665 [ benchIOSrc1 "concatMapPure (n of 1)"
666 (concatMapPure streamLen 1)
667 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
668 (concatMapPure streamLen2 streamLen2)
669 , benchIOSrc1 "concatMapPure (1 of n)"
670 (concatMapPure 1 streamLen)
672 , benchIOSrc1 "concatMap (n of 1)"
673 (concatMap streamLen 1)
674 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
675 (concatMap streamLen2 streamLen2)
676 , benchIOSrc1 "concatMap (1 of n)"
677 (concatMap 1 streamLen)
679 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
680 (concatMapRepl streamLen2 streamLen2)
682 -- This is for comparison with concatMapFoldableWith
683 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
684 (S.drain . S.concatMapBy S.serial id . sourceConcatMapId streamLen)
686 , benchIOSrc1 "concatMapBy serial (n of 1)"
687 (concatMapBySerial streamLen 1)
688 , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
689 (concatMapBySerial streamLen2 streamLen2)
690 , benchIOSrc1 "concatMapBy serial (1 of n)"
691 (concatMapBySerial 1 streamLen)
692 ]
693 where
694 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
696o_1_space_filtering :: Int -> Benchmark
697o_1_space_filtering streamLen =
698 bgroup "filtering"
699 [ benchFold "filter-even" (filterEven 1) (unfoldrM streamLen)
700 , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
701 , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
702 , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
703 , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
704 , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
705 , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
706 , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
707 , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
708 ]
710o_1_space_filteringX4 :: Int -> Benchmark
711o_1_space_filteringX4 streamLen =
712 bgroup "filteringX4"
713 [ benchFold "filter-even" (filterEven 4) (unfoldrM streamLen)
714 , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
715 , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
716 , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
717 , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
718 , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
719 , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
720 , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
721 , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
722 ]
724o_1_space_zipping :: Int -> Benchmark
725o_1_space_zipping streamLen =
726 bgroup "zipping"
727 [ benchFold "zipWith" zipWith (unfoldrM streamLen)
728 ]
730o_1_space_mixed :: Int -> Benchmark
731o_1_space_mixed streamLen =
732 bgroup "mixed"
733 [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
734 , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
735 , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
736 , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
737 , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
738 , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
739 , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
740 , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
741 , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
742 , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
743 ]
745o_1_space_mixedX2 :: Int -> Benchmark
746o_1_space_mixedX2 streamLen =
747 bgroup "mixedX2"
748 [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
749 , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
750 , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
751 , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
752 , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
753 , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
754 , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
755 , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
756 , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
757 , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
758 ]
760o_1_space_mixedX4 :: Int -> Benchmark
761o_1_space_mixedX4 streamLen =
762 bgroup "mixedX4"
763 [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
764 , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
765 , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
766 , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
767 , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
768 , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
769 , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
770 , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
771 , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
772 , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
773 ]
775o_1_space_list :: Int -> Benchmark
776o_1_space_list streamLen =
777 bgroup "list"
778 [ bgroup "elimination"
779 [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
780 ]
781 , bgroup "nested"
782 [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
783 , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
784 , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
785 , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
786 , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
787 ]
788 ]
789 where
791 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
792 streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
794o_1_space :: Int -> Benchmark
795o_1_space streamLen =
796 bgroup (o_1_space_prefix moduleName)
797 [ o_1_space_generation streamLen
798 , o_1_space_elimination streamLen
799 , o_1_space_nested streamLen
800 , o_1_space_transformation streamLen
801 , o_1_space_transformationX4 streamLen
802 , o_1_space_concat streamLen
803 , o_1_space_filtering streamLen
804 , o_1_space_filteringX4 streamLen
805 , o_1_space_zipping streamLen
806 , o_1_space_mixed streamLen
807 , o_1_space_mixedX2 streamLen
808 , o_1_space_mixedX4 streamLen
809 , o_1_space_list streamLen
810 ]
812o_n_heap :: Int -> Benchmark
813o_n_heap streamLen =
814 bgroup (o_n_heap_prefix moduleName)
815 [ bgroup "transformation"
816 [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
817 ]
818 ]
820{-# INLINE benchK #-}
821benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
822benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
824o_n_stack :: Int -> Int -> Int -> Benchmark
825o_n_stack streamLen iterStreamLen maxIters =
826 bgroup (o_n_stack_prefix moduleName)
827 [ bgroup "elimination"
828 [ benchFold "tail" tail (unfoldrM streamLen)
829 , benchFold "nullTail" nullTail (unfoldrM streamLen)
830 , benchFold "headTail" headTail (unfoldrM streamLen)
831 ]
832 , bgroup "transformation"
833 [
834 -- XXX why do these need so much stack
835 benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
836 , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
837 ]
838 , bgroup "transformationX4"
839 [
840 benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
841 ]
842 , bgroup "iterated"
843 [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
844 , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
845 , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
846 , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
847 , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
848 , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
849 , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
850 ]
851 ]
852 where
853 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
854 streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
856o_n_space :: Int -> Benchmark
857o_n_space streamLen =
858 bgroup (o_n_space_prefix moduleName)
859 [ bgroup "elimination"
860 [ benchFold "toList" toList (unfoldrM streamLen)
861 ]
862 ]
864{-# INLINE benchList #-}
865benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
866benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
868main :: IO ()
869main =
870 defaultMain
871 [ o_1_space streamLen
872 , o_n_stack streamLen iterStreamLen maxIters
873 , o_n_heap streamLen
874 , o_n_space streamLen
875 ]
877 where
879 streamLen = 100000
880 maxIters = 10000
881 iterStreamLen = 10