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