git.iko.soy/streamly
on efecb26 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
932 lines 31 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 #-}
11{-# OPTIONS_GHC -Wno-orphans #-}
13#ifdef __HADDOCK_VERSION__
14#undef INSPECTION
15#endif
17#ifdef INSPECTION
18{-# LANGUAGE TemplateHaskell #-}
19{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20#endif
22module Main (main) where
24import Control.Applicative (liftA2)
25import Control.Monad (when)
26import Data.Maybe (isJust)
27import System.Random (randomRIO)
28import Prelude hiding
29 ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate
30 , repeat, replicate
31 )
33import qualified Prelude as P
34import qualified Data.List as List
36import qualified Streamly.Internal.Data.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.StreamK 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 :: Monad 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 :: Monad 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 :: Monad 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 :: Monad 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 :: Monad m => Int -> Int -> Stream m Int
168fromFoldableM streamLen n =
169 List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
171{-# INLINABLE concatMapFoldableWith #-}
172concatMapFoldableWith :: P.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 = P.foldr (f . g) S.nil
179{-# INLINE concatMapFoldableSerial #-}
180concatMapFoldableSerial :: Int -> Int -> Stream m Int
181concatMapFoldableSerial streamLen n =
182 concatMapFoldableWith S.append S.fromPure [n..n+streamLen]
184{-# INLINE concatMapFoldableSerialM #-}
185concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
186concatMapFoldableSerialM streamLen n =
187 concatMapFoldableWith S.append (S.fromEffect . return) [n..n+streamLen]
189-------------------------------------------------------------------------------
190-- Elimination
191-------------------------------------------------------------------------------
193{-# INLINE drain #-}
194drain :: Monad m => Stream m a -> m ()
195drain = S.drain
197{-# INLINE mapM_ #-}
198mapM_ :: Monad m => Stream m a -> m ()
199mapM_ = S.mapM_ (\_ -> return ())
201{-# INLINE uncons #-}
202uncons :: Monad m => Stream m Int -> m ()
203uncons s = do
204 r <- S.uncons s
205 case r of
206 Nothing -> return ()
207 Just (_, t) -> uncons t
209{-# INLINE init #-}
210init :: Monad m => Stream m a -> m ()
211init s = do
212 t <- S.init s
213 P.mapM_ S.drain t
215{-# INLINE tail #-}
216tail :: Monad m => Stream m a -> m ()
217tail s = S.tail s >>= P.mapM_ tail
219{-# INLINE nullTail #-}
220nullTail :: Monad m => Stream m Int -> m ()
221nullTail s = do
222 r <- S.null s
223 when (not r) $ S.tail s >>= P.mapM_ nullTail
225{-# INLINE headTail #-}
226headTail :: Monad m => Stream m Int -> m ()
227headTail s = do
228 h <- S.head s
229 when (isJust h) $ S.tail s >>= P.mapM_ headTail
231{-# INLINE toList #-}
232toList :: Monad m => Stream m Int -> m [Int]
233toList = S.toList
235{-# INLINE foldl' #-}
236foldl' :: Monad m => Stream m Int -> m Int
237foldl' = S.foldl' (+) 0
239{-# INLINE last #-}
240last :: Monad m => Stream m Int -> m (Maybe Int)
241last = S.last
243-------------------------------------------------------------------------------
244-- Transformation
245-------------------------------------------------------------------------------
247{-# INLINE composeN #-}
248composeN
249 :: Monad m
250 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
251composeN n f =
252 case n of
253 1 -> drain . f
254 2 -> drain . f . f
255 3 -> drain . f . f . f
256 4 -> drain . f . f . f . f
257 _ -> undefined
259{-# INLINE scanl' #-}
260scanl' :: Monad m => Int -> Stream m Int -> m ()
261scanl' n = composeN n $ S.scanl' (+) 0
263{-# INLINE map #-}
264map :: Monad m => Int -> Stream m Int -> m ()
265map n = composeN n $ S.map (+ 1)
267{-# INLINE fmapK #-}
268fmapK :: Monad m => Int -> Stream m Int -> m ()
269fmapK n = composeN n $ P.fmap (+ 1)
271{-# INLINE mapM #-}
272mapM :: Monad m => Int -> Stream m Int -> m ()
273mapM n = composeN n $ S.mapMWith S.consM return
275{-# INLINE mapMSerial #-}
276mapMSerial :: Monad m => Int -> Stream m Int -> m ()
277mapMSerial n = composeN n $ S.mapMSerial return
279{-# INLINE filterEven #-}
280filterEven :: Monad m => Int -> Stream m Int -> m ()
281filterEven n = composeN n $ S.filter even
283{-# INLINE filterAllOut #-}
284filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
285filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
287{-# INLINE filterAllIn #-}
288filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
289filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
291{-# INLINE _takeOne #-}
292_takeOne :: Monad m => Int -> Stream m Int -> m ()
293_takeOne n = composeN n $ S.take 1
295{-# INLINE takeAll #-}
296takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
297takeAll streamLen n = composeN n $ S.take streamLen
299{-# INLINE takeWhileTrue #-}
300takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
301takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
303{-# INLINE dropOne #-}
304dropOne :: Monad m => Int -> Stream m Int -> m ()
305dropOne n = composeN n $ S.drop 1
307{-# INLINE dropAll #-}
308dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
309dropAll streamLen n = composeN n $ S.drop streamLen
311{-# INLINE dropWhileTrue #-}
312dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
313dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
315{-# INLINE dropWhileFalse #-}
316dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
317dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
319{-# INLINE foldrS #-}
320foldrS :: Monad m => Int -> Stream m Int -> m ()
321foldrS n = composeN n $ S.foldrS S.cons S.nil
323{-# INLINE foldlS #-}
324foldlS :: Monad m => Int -> Stream m Int -> m ()
325foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
327{-# INLINE intersperse #-}
328intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
329intersperse streamLen n = composeN n $ S.intersperse streamLen
331-------------------------------------------------------------------------------
332-- Iteration
333-------------------------------------------------------------------------------
335{-# INLINE iterateSource #-}
336iterateSource
337 :: Monad m => 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 :: Monad 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 :: Monad 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 :: Monad m => Int -> Int -> Int -> Stream m Int
357iterateMapM iterStreamLen =
358 iterateSource iterStreamLen (S.mapMWith S.consM return)
360{-# INLINE iterateFilterEven #-}
361iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
362iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
364{-# INLINE iterateTakeAll #-}
365iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
366iterateTakeAll streamLen iterStreamLen =
367 iterateSource iterStreamLen (S.take streamLen)
369{-# INLINE iterateDropOne #-}
370iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
371iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
373{-# INLINE iterateDropWhileTrue #-}
374iterateDropWhileTrue ::
375 Monad m => 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.mergeMapWith (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.append
496 (unfoldrM inner)
497 (unfoldrM outer n)
499-------------------------------------------------------------------------------
500-- Nested Composition
501-------------------------------------------------------------------------------
503instance Monad m => Applicative (S.StreamK m) where
504 {-# INLINE pure #-}
505 pure = S.fromPure
507 {-# INLINE (<*>) #-}
508 (<*>) = S.crossApply
510 {-# INLINE liftA2 #-}
511 liftA2 f x = (<*>) (fmap f x)
513 {-# INLINE (*>) #-}
514 (*>) = S.crossApplySnd
516 {-# INLINE (<*) #-}
517 (<*) = S.crossApplyFst
519-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
520-- the monad instance of StreamD is slower than StreamK after foldr/build
521-- fusion.
522instance Monad m => Monad (S.StreamK m) where
523 {-# INLINE return #-}
524 return = pure
526 {-# INLINE (>>=) #-}
527 (>>=) = flip S.concatMap
529{-# INLINE drainApplicative #-}
530drainApplicative :: Monad m => Stream m Int -> m ()
531drainApplicative s = drain $ do
532 (+) <$> s <*> s
534{-# INLINE drainMonad #-}
535drainMonad :: Monad m => Stream m Int -> m ()
536drainMonad s = drain $ do
537 x <- s
538 y <- s
539 return $ x + y
541{-# INLINE drainMonad3 #-}
542drainMonad3 :: Monad m => Stream m Int -> m ()
543drainMonad3 s = drain $ do
544 x <- s
545 y <- s
546 z <- s
547 return $ x + y + z
549{-# INLINE filterAllOutMonad #-}
550filterAllOutMonad
551 :: Monad m
552 => Stream m Int -> m ()
553filterAllOutMonad str = drain $ do
554 x <- str
555 y <- str
556 let s = x + y
557 if s < 0
558 then return s
559 else S.nil
561{-# INLINE filterAllInMonad #-}
562filterAllInMonad
563 :: Monad m
564 => Stream m Int -> m ()
565filterAllInMonad str = drain $ do
566 x <- str
567 y <- str
568 let s = x + y
569 if s > 0
570 then return s
571 else S.nil
573-------------------------------------------------------------------------------
574-- Nested Composition Pure lists
575-------------------------------------------------------------------------------
577-- There are several list benchmarks here for comparison with lists. It is easy
578-- and convenient to see the comparisons when they are here, otherwise we'll
579-- have to add a separate module for list benchmarks with the same names and
580-- then add a comparison in bench.sh.
582{-# INLINE unfoldrList #-}
583unfoldrList :: Int -> Int -> [Int]
584unfoldrList maxval n = List.unfoldr step n
585 where
586 step cnt =
587 if cnt > n + maxval
588 then Nothing
589 else Just (cnt, cnt + 1)
591{-# INLINE toNullApNestedList #-}
592toNullApNestedList :: [Int] -> [Int]
593toNullApNestedList s = (+) <$> s <*> s
595{-# INLINE toNullNestedList #-}
596toNullNestedList :: [Int] -> [Int]
597toNullNestedList s = do
598 x <- s
599 y <- s
600 return $ x + y
602{-# INLINE toNullNestedList3 #-}
603toNullNestedList3 :: [Int] -> [Int]
604toNullNestedList3 s = do
605 x <- s
606 y <- s
607 z <- s
608 return $ x + y + z
610{-# INLINE filterAllOutNestedList #-}
611filterAllOutNestedList :: [Int] -> [Int]
612filterAllOutNestedList str = do
613 x <- str
614 y <- str
615 let s = x + y
616 if s < 0
617 then return s
618 else []
620{-# INLINE filterAllInNestedList #-}
621filterAllInNestedList :: [Int] -> [Int]
622filterAllInNestedList str = do
623 x <- str
624 y <- str
625 let s = x + y
626 if s > 0
627 then return s
628 else []
630-------------------------------------------------------------------------------
631-- Benchmarks
632-------------------------------------------------------------------------------
634moduleName :: String
635moduleName = "Data.StreamK"
637o_1_space_generation :: Int -> Benchmark
638o_1_space_generation streamLen =
639 bgroup "generation"
640 [ benchFold "unfoldr" drain (unfoldr streamLen)
641 , benchFold "unfoldrM" drain (unfoldrM streamLen)
642 , benchFold "repeat" drain (repeat streamLen)
643 , benchFold "repeatM" drain (repeatM streamLen)
644 , benchFold "replicate" drain (replicate streamLen)
645 , benchFold "replicateM" drain (replicateM streamLen)
646 , benchFold "iterate" drain (iterate streamLen)
647 , benchFold "iterateM" drain (iterateM streamLen)
649 , benchFold "fromFoldable" drain (fromFoldable streamLen)
650 , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
652 -- appends
653 , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
654 , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
655 ]
657o_1_space_elimination :: Int -> Benchmark
658o_1_space_elimination streamLen =
659 bgroup "elimination"
660 [ benchFold "toNull" drain (unfoldrM streamLen)
661 , benchFold "mapM_" mapM_ (unfoldrM streamLen)
662 , benchFold "uncons" uncons (unfoldrM streamLen)
663 , benchFold "init" init (unfoldrM streamLen)
664 , benchFold "foldl'" foldl' (unfoldrM streamLen)
665 , benchFold "last" last (unfoldrM streamLen)
666 ]
668o_1_space_nested :: Int -> Benchmark
669o_1_space_nested streamLen =
670 bgroup "nested"
671 [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
672 , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
673 , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
674 , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
675 , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
676 , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
677 , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
678 , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
679 , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
680 , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
681 ]
682 where
683 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
684 streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
686o_1_space_transformation :: Int -> Benchmark
687o_1_space_transformation streamLen =
688 bgroup "transformation"
689 [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
690 , benchFold "scanl'" (scanl' 1) (unfoldrM streamLen)
691 , benchFold "map" (map 1) (unfoldrM streamLen)
692 , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
693 , benchFold "mapM" (mapM 1) (unfoldrM streamLen)
694 , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
695 ]
697o_1_space_transformationX4 :: Int -> Benchmark
698o_1_space_transformationX4 streamLen =
699 bgroup "transformationX4"
700 [ benchFold "scanl'" (scanl' 4) (unfoldrM streamLen)
701 , benchFold "map" (map 4) (unfoldrM streamLen)
702 , benchFold "fmap" (fmapK 4) (unfoldrM streamLen)
703 , benchFold "mapM" (mapM 4) (unfoldrM streamLen)
704 , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
705 -- XXX this is horribly slow
706 -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
707 ]
709o_1_space_concat :: Int -> Benchmark
710o_1_space_concat streamLen =
711 bgroup "concat"
712 [ benchIOSrc1 "concatMapPure (n of 1)"
713 (concatMapPure streamLen 1)
714 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
715 (concatMapPure streamLen2 streamLen2)
716 , benchIOSrc1 "concatMapPure (1 of n)"
717 (concatMapPure 1 streamLen)
719 , benchIOSrc1 "concatMap (n of 1)"
720 (concatMap streamLen 1)
721 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
722 (concatMap streamLen2 streamLen2)
723 , benchIOSrc1 "concatMap (1 of n)"
724 (concatMap 1 streamLen)
726 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
727 (concatMapRepl streamLen2 streamLen2)
729 -- This is for comparison with concatMapFoldableWith
730 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
731 (S.drain
732 . S.concatMapWith S.append id
733 . sourceConcatMapId streamLen)
735 , benchIOSrc1 "concatMapBy serial (n of 1)"
736 (concatMapBySerial streamLen 1)
737 , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
738 (concatMapBySerial streamLen2 streamLen2)
739 , benchIOSrc1 "concatMapBy serial (1 of n)"
740 (concatMapBySerial 1 streamLen)
741 , benchFold "sortBy" sortBy (unfoldrM streamLen)
742 ]
743 where
744 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
746o_1_space_filtering :: Int -> Benchmark
747o_1_space_filtering streamLen =
748 bgroup "filtering"
749 [ benchFold "filter-even" (filterEven 1) (unfoldrM streamLen)
750 , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
751 , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
752 , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
753 , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
754 , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
755 , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
756 , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
757 , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
758 ]
760o_1_space_filteringX4 :: Int -> Benchmark
761o_1_space_filteringX4 streamLen =
762 bgroup "filteringX4"
763 [ benchFold "filter-even" (filterEven 4) (unfoldrM streamLen)
764 , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
765 , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
766 , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
767 , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
768 , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
769 , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
770 , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
771 , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
772 ]
774o_1_space_zipping :: Int -> Benchmark
775o_1_space_zipping streamLen =
776 bgroup "zipping"
777 [ benchFold "zipWith" zipWith (unfoldrM streamLen)
778 , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
779 ]
781o_1_space_mixed :: Int -> Benchmark
782o_1_space_mixed streamLen =
783 bgroup "mixed"
784 [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
785 , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
786 , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
787 , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
788 , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
789 , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
790 , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
791 , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
792 , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
793 , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
794 ]
796o_1_space_mixedX2 :: Int -> Benchmark
797o_1_space_mixedX2 streamLen =
798 bgroup "mixedX2"
799 [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
800 , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
801 , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
802 , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
803 , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
804 , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
805 , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
806 , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
807 , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
808 , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
809 ]
811o_1_space_mixedX4 :: Int -> Benchmark
812o_1_space_mixedX4 streamLen =
813 bgroup "mixedX4"
814 [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
815 , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
816 , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
817 , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
818 , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
819 , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
820 , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
821 , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
822 , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
823 , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
824 ]
826o_1_space_list :: Int -> Benchmark
827o_1_space_list streamLen =
828 bgroup "list"
829 [ bgroup "elimination"
830 [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
831 ]
832 , bgroup "nested"
833 [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
834 , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
835 , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
836 , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
837 , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
838 ]
839 ]
840 where
842 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
843 streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
845o_1_space :: Int -> Benchmark
846o_1_space streamLen =
847 bgroup (o_1_space_prefix moduleName)
848 [ o_1_space_generation streamLen
849 , o_1_space_elimination streamLen
850 , o_1_space_nested streamLen
851 , o_1_space_transformation streamLen
852 , o_1_space_transformationX4 streamLen
853 , o_1_space_concat streamLen
854 , o_1_space_filtering streamLen
855 , o_1_space_filteringX4 streamLen
856 , o_1_space_zipping streamLen
857 , o_1_space_mixed streamLen
858 , o_1_space_mixedX2 streamLen
859 , o_1_space_mixedX4 streamLen
860 , o_1_space_list streamLen
861 ]
863o_n_heap :: Int -> Benchmark
864o_n_heap streamLen =
865 bgroup (o_n_heap_prefix moduleName)
866 [ bgroup "transformation"
867 [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
868 ]
869 ]
871{-# INLINE benchK #-}
872benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
873benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
875o_n_stack :: Int -> Int -> Int -> Benchmark
876o_n_stack streamLen iterStreamLen maxIters =
877 bgroup (o_n_stack_prefix moduleName)
878 [ bgroup "elimination"
879 [ benchFold "tail" tail (unfoldrM streamLen)
880 , benchFold "nullTail" nullTail (unfoldrM streamLen)
881 , benchFold "headTail" headTail (unfoldrM streamLen)
882 ]
883 , bgroup "transformation"
884 [
885 -- XXX why do these need so much stack
886 benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
887 , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
888 ]
889 , bgroup "transformationX4"
890 [
891 benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
892 ]
893 , bgroup "iterated"
894 [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
895 , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
896 , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
897 , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
898 , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
899 , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
900 , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
901 ]
902 ]
903 where
904 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
905 streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
907o_n_space :: Int -> Benchmark
908o_n_space streamLen =
909 bgroup (o_n_space_prefix moduleName)
910 [ bgroup "elimination"
911 [ benchFold "toList" toList (unfoldrM streamLen)
912 ]
913 ]
915{-# INLINE benchList #-}
916benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
917benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
919main :: IO ()
920main =
921 defaultMain
922 [ o_1_space streamLen
923 , o_n_stack streamLen iterStreamLen maxIters
924 , o_n_heap streamLen
925 , o_n_space streamLen
926 ]
928 where
930 streamLen = 100000
931 maxIters = 10000
932 iterStreamLen = 10