@@ -0,0 +1,935 @@
2+-- Module : Streamly.Benchmark.Data.Stream.StreamK
3+-- Copyright : (c) 2018 Composewell Technologies
6+-- Maintainer : streamly@composewell.com
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# OPTIONS_GHC -Wno-orphans #-}
13+#ifdef __HADDOCK_VERSION__
18+{-# LANGUAGE TemplateHaskell #-}
19+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
22+module Main (main) where
24+-- import Control.Applicative (liftA2)
25+-- import Control.Monad (when)
26+-- import Data.Maybe (isJust)
27+-- import System.Random (randomRIO)
29+ ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate
33+import qualified Prelude as P
34+-- import qualified Data.List as List
36+import qualified Streamly.Internal.Control.Concurrent as S
37+import qualified Streamly.Internal.Data.Stream.StreamK.Type as S
38+import qualified Streamly.Internal.Data.Stream.StreamK as S
39+import qualified Streamly.Internal.Data.Stream.StreamD as D
40+-- import qualified Streamly.Internal.Data.Stream as Stream
41+import qualified Streamly.Internal.Data.Fold as Fold
43+import Gauge (bgroup, Benchmark, defaultMain)
45+import Streamly.Benchmark.Common
48+import Test.Inspection
51+-------------------------------------------------------------------------------
52+-- Stream generation and elimination
53+-------------------------------------------------------------------------------
55+type Stream m a = S.Stream m a
57+{-# INLINE unfoldrD #-}
58+unfoldrD :: Monad m => Int -> Int -> Stream m Int
59+unfoldrD streamLen n = D.toStreamK (D.unfoldr step n)
62+ if cnt > n + streamLen
64+ else Just (cnt, cnt + 1)
66+{-# INLINE unfoldrMD #-}
67+unfoldrMD :: S.MonadAsync m => Int -> Int -> Stream m Int
68+unfoldrMD streamLen n = D.toStreamK (D.unfoldrM step n)
71+ if cnt > n + streamLen
73+ else return (Just (cnt, cnt + 1))
76+{-# INLINE unfoldrK #-}
77+unfoldrK :: Int -> Int -> Stream m Int
78+unfoldrK streamLen n = S.unfoldr step n
81+ if cnt > n + streamLen
83+ else Just (cnt, cnt + 1)
86+{-# INLINE unfoldrMK #-}
87+unfoldrMK :: S.MonadAsync m => Int -> Int -> Stream m Int
88+unfoldrMK streamLen n = S.unfoldrMWith S.consM step n
91+ if cnt > n + streamLen
93+ else return (Just (cnt, cnt + 1))
96+repeat :: Monad m => Int -> Int -> Stream m Int
97+repeat streamLen = S.take streamLen . D.toStreamK . D.repeat
99+{-# INLINE repeatM #-}
100+repeatM :: S.MonadAsync m => Int -> Int -> Stream m Int
101+repeatM streamLen = S.take streamLen . D.toStreamK . D.repeatM . return
103+{-# INLINE replicate #-}
104+replicate :: Monad m => Int -> Int -> Stream m Int
105+replicate x y = D.toStreamK $ D.replicate x y
107+{-# INLINE replicateM #-}
108+replicateM :: S.MonadAsync m => Int -> Int -> Stream m Int
109+replicateM streamLen = D.toStreamK . D.replicateM streamLen . return
111+{-# INLINE iterate #-}
112+iterate :: Monad m => Int -> Int -> Stream m Int
113+iterate streamLen = S.take streamLen . D.toStreamK . D.iterate (+1)
115+{-# INLINE iterateM #-}
116+iterateM :: S.MonadAsync m => Int -> Int -> Stream m Int
117+iterateM streamLen = S.take streamLen . D.toStreamK . D.iterateM (return . (+1)) . return
119+{-# INLINE fromFoldable #-}
120+fromFoldable :: Int -> Int -> Stream m Int
121+fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
123+{-# INLINE fromFoldableM #-}
124+fromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int
125+fromFoldableM streamLen n =
126+ Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
129+{-# INLINABLE concatMapFoldableWith #-}
130+concatMapFoldableWith :: Foldable f
131+ => (Stream m b -> Stream m b -> Stream m b)
132+ -> (a -> Stream m b)
135+concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
138+{-# INLINE concatMapFoldableSerial #-}
139+concatMapFoldableSerial :: Monad m => Int -> Int -> Stream m Int
140+concatMapFoldableSerial streamLen n =
141+ D.toStreamK $ D.concatMap D.fromPure $ D.fromStreamK $ S.fromList [n..n+streamLen]
143+{-# INLINE concatMapFoldableSerialM #-}
144+concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
145+concatMapFoldableSerialM streamLen n =
146+ -- concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
147+ D.toStreamK $ D.concatMap (D.fromEffect . return) $ D.fromStreamK $ S.fromList [n..n+streamLen]
149+-------------------------------------------------------------------------------
151+-------------------------------------------------------------------------------
153+{-# INLINE drainD #-}
154+drainD :: Monad m => Stream m a -> m ()
155+drainD = D.drain . D.fromStreamK
158+drain :: Monad m => Stream m a -> m ()
162+mapM_ :: Monad m => Stream m a -> m ()
163+mapM_ s = D.mapM_ (\_ -> return ()) $ D.fromStreamK s
166+{-# INLINE uncons #-}
167+uncons :: Monad m => Stream m Int -> m ()
169+ r <- D.uncons $ D.fromStreamK s
171+ Nothing -> return ()
172+ Just (_, t) -> uncons (D.toStreamK t)
175+init :: Monad m => Stream m a -> m ()
181+tail :: Monad m => Stream m a -> m ()
182+tail s = S.tail s >>= P.mapM_ tail
184+{-# INLINE nullTail #-}
185+nullTail :: Monad m => Stream m Int -> m ()
188+ when (not r) $ S.tail s >>= P.mapM_ nullTail
190+{-# INLINE headTail #-}
191+headTail :: Monad m => Stream m Int -> m ()
194+ when (isJust h) $ S.tail s >>= P.mapM_ headTail
197+{-# INLINE toList #-}
198+toList :: Monad m => Stream m Int -> m [Int]
199+toList = D.fold Fold.toList . D.fromStreamK
201+{-# INLINE foldl' #-}
202+foldl' :: Monad m => Stream m Int -> m Int
203+foldl' = D.fold (Fold.foldl' (+) 0) . D.fromStreamK
206+last :: Monad m => Stream m Int -> m (Maybe Int)
207+last = D.fold Fold.latest . D.fromStreamK
209+-------------------------------------------------------------------------------
211+-------------------------------------------------------------------------------
213+{-# INLINE composeN #-}
216+ => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
221+ 3 -> drain . f . f . f
222+ 4 -> drain . f . f . f . f
225+{-# INLINE scanl' #-}
226+scanl' :: Monad m => Int -> Stream m Int -> m ()
228+ composeN n (D.toStreamK . D.scanOnce (Fold.foldl' (+) 0) . D.fromStreamK)
231+map :: Monad m => Int -> Stream m Int -> m ()
232+map n = composeN n (D.toStreamK . D.map (+ 1) . D.fromStreamK)
236+fmapK :: Monad m => Int -> Stream m Int -> m ()
237+fmapK n = composeN n $ P.fmap (+ 1)
241+mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()
242+mapM n = composeN n (D.toStreamK . D.mapM return . D.fromStreamK)
245+{-# INLINE mapMSerial #-}
246+mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
247+mapMSerial n = composeN n $ S.mapMSerial return
250+{-# INLINE filterEven #-}
251+filterEven :: Monad m => Int -> Stream m Int -> m ()
252+filterEven n = composeN n (D.toStreamK . D.filter even . D.fromStreamK)
255+{-# INLINE filterAllOut #-}
256+filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
257+filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
259+{-# INLINE filterAllIn #-}
260+filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
261+filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
263+{-# INLINE _takeOne #-}
264+_takeOne :: Monad m => Int -> Stream m Int -> m ()
265+_takeOne n = composeN n $ S.take 1
267+{-# INLINE takeAll #-}
268+takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
269+takeAll streamLen n = composeN n $ S.take streamLen
271+{-# INLINE takeWhileTrue #-}
272+takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
273+takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
275+{-# INLINE dropOne #-}
276+dropOne :: Monad m => Int -> Stream m Int -> m ()
277+dropOne n = composeN n $ S.drop 1
279+{-# INLINE dropAll #-}
280+dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
281+dropAll streamLen n = composeN n $ S.drop streamLen
283+{-# INLINE dropWhileTrue #-}
284+dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
285+dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
287+{-# INLINE dropWhileFalse #-}
288+dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
289+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
293+{-# INLINE foldrS #-}
294+foldrS :: Monad m => Int -> Stream m Int -> m ()
295+foldrS n = composeN n $ S.foldrS S.cons S.nil
297+{-# INLINE foldlS #-}
298+foldlS :: Monad m => Int -> Stream m Int -> m ()
299+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
303+{-# INLINE intersperse #-}
304+intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
305+intersperse streamLen n = composeN n $ S.intersperse streamLen
308+-------------------------------------------------------------------------------
310+-------------------------------------------------------------------------------
313+{-# INLINE iterateSource #-}
316+ => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
317+iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
319+ f (0 :: Int) m = g m
320+ f x m = g (f (x P.- 1) m)
323+{-# INLINE iterateScan #-}
324+iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
325+iterateScan iterStreamLen maxIters =
326+ iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
329+{-# INLINE iterateDropWhileFalse #-}
330+iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
331+iterateDropWhileFalse streamLen iterStreamLen maxIters =
332+ iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
334+{-# INLINE iterateMapM #-}
335+iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
336+iterateMapM iterStreamLen =
337+ iterateSource iterStreamLen (S.mapMWith S.consM return)
339+{-# INLINE iterateFilterEven #-}
340+iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
341+iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
343+{-# INLINE iterateTakeAll #-}
344+iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
345+iterateTakeAll streamLen iterStreamLen =
346+ iterateSource iterStreamLen (S.take streamLen)
348+{-# INLINE iterateDropOne #-}
349+iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
350+iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
352+{-# INLINE iterateDropWhileTrue #-}
353+iterateDropWhileTrue :: S.MonadAsync m =>
354+ Int -> Int -> Int -> Int -> Stream m Int
355+iterateDropWhileTrue streamLen iterStreamLen =
356+ iterateSource iterStreamLen (S.dropWhile (<= streamLen))
359+-------------------------------------------------------------------------------
361+-------------------------------------------------------------------------------
364+{-# INLINE zipWith #-}
365+zipWith :: Monad m => Stream m Int -> m ()
366+zipWith src = drain $ S.zipWith (,) src src
368+{-# INLINE zipWithM #-}
369+zipWithM :: Monad m => Stream m Int -> m ()
370+zipWithM src = drain $ S.zipWithM (curry return) src src
372+{-# INLINE sortByK #-}
373+sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
374+sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
376+{-# INLINE sortBy #-}
377+sortBy :: Monad m => Stream m Int -> m ()
378+sortBy = drain . sortByK compare
380+-------------------------------------------------------------------------------
382+-------------------------------------------------------------------------------
384+{-# INLINE scanMap #-}
385+scanMap :: Monad m => Int -> Stream m Int -> m ()
386+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
388+{-# INLINE dropMap #-}
389+dropMap :: Monad m => Int -> Stream m Int -> m ()
390+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
392+{-# INLINE dropScan #-}
393+dropScan :: Monad m => Int -> Stream m Int -> m ()
394+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
396+{-# INLINE takeDrop #-}
397+takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
398+takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
400+{-# INLINE takeScan #-}
401+takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
402+takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
404+{-# INLINE takeMap #-}
405+takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
406+takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
408+{-# INLINE filterDrop #-}
409+filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
410+filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
412+{-# INLINE filterTake #-}
413+filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
414+filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
416+{-# INLINE filterScan #-}
417+filterScan :: Monad m => Int -> Stream m Int -> m ()
418+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
420+{-# INLINE filterMap #-}
421+filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
422+filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
425+-------------------------------------------------------------------------------
427+-------------------------------------------------------------------------------
429+-- concatMap unfoldrM/unfoldrM
431+{-# INLINE concatMap #-}
432+concatMap :: Int -> Int -> Int -> IO ()
433+concatMap outer inner n =
434+ S.drain $ D.toStreamK $ D.concatMap
435+ (\_ -> D.fromStreamK $ unfoldrMK inner n)
436+ (D.fromStreamK $ unfoldrMK outer n)
439+inspect $ hasNoTypeClasses 'concatMap
442+-- concatMap unfoldr/unfoldr
445+{-# INLINE concatMapPure #-}
446+concatMapPure :: Int -> Int -> Int -> IO ()
447+concatMapPure outer inner n =
448+ S.drain $ S.concatMap
449+ (\_ -> unfoldr inner n)
453+inspect $ hasNoTypeClasses 'concatMapPure
456+-- concatMap replicate/unfoldrM
458+{-# INLINE concatMapRepl #-}
459+concatMapRepl :: Int -> Int -> Int -> IO ()
460+concatMapRepl outer inner n =
461+ S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
464+inspect $ hasNoTypeClasses 'concatMapRepl
469+{-# INLINE sourceConcatMapId #-}
470+sourceConcatMapId :: Monad m
471+ => Int -> Int -> Stream m (Stream m Int)
472+sourceConcatMapId val n =
473+ S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
475+{-# INLINE concatMapBySerial #-}
476+concatMapBySerial :: Int -> Int -> Int -> IO ()
477+concatMapBySerial outer inner n =
478+ S.drain $ S.concatMapWith S.serial
484+-------------------------------------------------------------------------------
485+-- Nested Composition
486+-------------------------------------------------------------------------------
488+instance Monad m => Applicative (S.Stream m) where
492+ {-# INLINE (<*>) #-}
493+ (<*>) = S.crossApply
495+ {-# INLINE liftA2 #-}
496+ liftA2 f x = (<*>) (fmap f x)
499+ (*>) = S.crossApplySnd
502+ (<*) = S.crossApplyFst
504+-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
505+-- the monad instance of StreamD is slower than StreamK after foldr/build
507+instance Monad m => Monad (S.Stream m) where
508+ {-# INLINE return #-}
511+ {-# INLINE (>>=) #-}
512+ (>>=) = flip S.concatMap
514+{-# INLINE drainApplicative #-}
515+drainApplicative :: Monad m => Stream m Int -> m ()
516+drainApplicative s = drain $ do
519+{-# INLINE drainMonad #-}
520+drainMonad :: Monad m => Stream m Int -> m ()
521+drainMonad s = drain $ do
526+{-# INLINE drainMonad3 #-}
527+drainMonad3 :: Monad m => Stream m Int -> m ()
528+drainMonad3 s = drain $ do
534+{-# INLINE filterAllOutMonad #-}
537+ => Stream m Int -> m ()
538+filterAllOutMonad str = drain $ do
546+{-# INLINE filterAllInMonad #-}
549+ => Stream m Int -> m ()
550+filterAllInMonad str = drain $ do
558+-------------------------------------------------------------------------------
559+-- Nested Composition Pure lists
560+-------------------------------------------------------------------------------
562+-- There are several list benchmarks here for comparison with lists. It is easy
563+-- and convenient to see the comparisons when they are here, otherwise we'll
564+-- have to add a separate module for list benchmarks with the same names and
565+-- then add a comparison in bench.sh.
567+{-# INLINE unfoldrList #-}
568+unfoldrList :: Int -> Int -> [Int]
569+unfoldrList maxval n = List.unfoldr step n
574+ else Just (cnt, cnt + 1)
576+{-# INLINE toNullApNestedList #-}
577+toNullApNestedList :: [Int] -> [Int]
578+toNullApNestedList s = (+) <$> s <*> s
580+{-# INLINE toNullNestedList #-}
581+toNullNestedList :: [Int] -> [Int]
582+toNullNestedList s = do
587+{-# INLINE toNullNestedList3 #-}
588+toNullNestedList3 :: [Int] -> [Int]
589+toNullNestedList3 s = do
595+{-# INLINE filterAllOutNestedList #-}
596+filterAllOutNestedList :: [Int] -> [Int]
597+filterAllOutNestedList str = do
605+{-# INLINE filterAllInNestedList #-}
606+filterAllInNestedList :: [Int] -> [Int]
607+filterAllInNestedList str = do
616+-------------------------------------------------------------------------------
618+-------------------------------------------------------------------------------
621+moduleName = "Data.Stream.ToStreamK"
623+o_1_space_generation :: Int -> Benchmark
624+o_1_space_generation streamLen =
626+ [ benchFold "unfoldr" drain (unfoldrD streamLen)
627+ , benchFold "unfoldrM" drain (unfoldrMD streamLen)
628+ , benchFold "repeat" drain (repeat streamLen)
629+ , benchFold "repeatM" drain (repeatM streamLen)
630+ , benchFold "replicate" drain (replicate streamLen)
631+ , benchFold "replicateM" drain (replicateM streamLen)
632+ , benchFold "iterate" drain (iterate streamLen)
633+ , benchFold "iterateM" drain (iterateM streamLen)
635+ , benchFold "fromFoldable" drain (fromFoldable streamLen)
636+ , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
639+ , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
640+ , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
643+o_1_space_elimination :: Int -> Benchmark
644+o_1_space_elimination streamLen =
645+ bgroup "elimination"
646+ [ benchFold "toNull" drainD (unfoldrMK streamLen)
647+ , benchFold "mapM_" mapM_ (unfoldrMK streamLen)
648+ -- , benchFold "uncons" uncons (unfoldrMK streamLen)
649+ -- , benchFold "init" init (unfoldrM streamLen)
650+ , benchFold "foldl'" foldl' (unfoldrMK streamLen)
651+ , benchFold "last" last (unfoldrMK streamLen)
655+o_1_space_nested :: Int -> Benchmark
656+o_1_space_nested streamLen =
658+ [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
659+ , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
660+ , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
661+ , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
662+ , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
663+ , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
664+ , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
665+ , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
666+ , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
667+ , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
670+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
671+ streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
674+o_1_space_transformation :: Int -> Benchmark
675+o_1_space_transformation streamLen =
676+ bgroup "transformation"
677+ [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
678+ benchFold "scanl'" (scanl' 1) (unfoldrMK streamLen)
679+ , benchFold "map" (map 1) (unfoldrMK streamLen)
680+ -- , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
681+ , benchFold "mapM" (mapM 1) (unfoldrMK streamLen)
682+ -- , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
685+o_1_space_transformationX4 :: Int -> Benchmark
686+o_1_space_transformationX4 streamLen =
687+ bgroup "transformationX4"
688+ [ benchFold "scanl'" (scanl' 4) (unfoldrMK streamLen)
689+ , benchFold "map" (map 4) (unfoldrMK streamLen)
690+ -- , benchFold "fmap" (fmapK 4) (unfoldrMK streamLen)
691+ , benchFold "mapM" (mapM 4) (unfoldrMK streamLen)
692+ -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
693+ -- XXX this is horribly slow
694+ -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
697+o_1_space_concat :: Int -> Benchmark
698+o_1_space_concat streamLen =
700+ [ {- benchIOSrc1 "concatMapPure (n of 1)"
701+ (concatMapPure streamLen 1)
702+ , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
703+ (concatMapPure streamLen2 streamLen2)
704+ , benchIOSrc1 "concatMapPure (1 of n)"
705+ (concatMapPure 1 streamLen)
708+ benchIOSrc1 "concatMap (n of 1)"
709+ (concatMap streamLen 1)
710+ , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
711+ (concatMap streamLen2 streamLen2)
712+ , benchIOSrc1 "concatMap (1 of n)"
713+ (concatMap 1 streamLen)
716+ , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
717+ (concatMapRepl streamLen2 streamLen2)
719+ -- This is for comparison with concatMapFoldableWith
720+ , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
722+ . S.concatMapWith S.serial id
723+ . sourceConcatMapId streamLen)
725+ , benchIOSrc1 "concatMapBy serial (n of 1)"
726+ (concatMapBySerial streamLen 1)
727+ , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
728+ (concatMapBySerial streamLen2 streamLen2)
729+ , benchIOSrc1 "concatMapBy serial (1 of n)"
730+ (concatMapBySerial 1 streamLen)
731+ , benchFold "sortBy" sortBy (unfoldrM streamLen)
735+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
737+o_1_space_filtering :: Int -> Benchmark
738+o_1_space_filtering streamLen =
740+ [ benchFold "filter-even" (filterEven 1) (unfoldrMK streamLen)
742+ , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
743+ , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
744+ , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
745+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
746+ , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
747+ , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
748+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
749+ , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
753+o_1_space_filteringX4 :: Int -> Benchmark
754+o_1_space_filteringX4 streamLen =
755+ bgroup "filteringX4"
756+ [ benchFold "filter-even" (filterEven 4) (unfoldrMK streamLen)
758+ , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
759+ , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
760+ , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
761+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
762+ , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
763+ , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
764+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
765+ , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
770+o_1_space_zipping :: Int -> Benchmark
771+o_1_space_zipping streamLen =
773+ [ benchFold "zipWith" zipWith (unfoldrM streamLen)
774+ , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
777+o_1_space_mixed :: Int -> Benchmark
778+o_1_space_mixed streamLen =
780+ [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
781+ , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
782+ , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
783+ , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
784+ , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
785+ , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
786+ , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
787+ , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
788+ , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
789+ , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
792+o_1_space_mixedX2 :: Int -> Benchmark
793+o_1_space_mixedX2 streamLen =
795+ [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
796+ , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
797+ , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
798+ , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
799+ , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
800+ , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
801+ , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
802+ , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
803+ , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
804+ , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
807+o_1_space_mixedX4 :: Int -> Benchmark
808+o_1_space_mixedX4 streamLen =
810+ [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
811+ , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
812+ , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
813+ , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
814+ , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
815+ , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
816+ , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
817+ , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
818+ , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
819+ , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
824+o_1_space_list :: Int -> Benchmark
825+o_1_space_list streamLen =
827+ [ bgroup "elimination"
828+ [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
831+ [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
832+ , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
833+ , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
834+ , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
835+ , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
840+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
841+ streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
844+o_1_space :: Int -> Benchmark
845+o_1_space streamLen =
846+ bgroup (o_1_space_prefix moduleName)
847+ [ o_1_space_generation streamLen
848+ , o_1_space_elimination streamLen
849+ -- , o_1_space_nested streamLen
850+ , o_1_space_transformation streamLen
851+ , o_1_space_transformationX4 streamLen
852+ , o_1_space_concat streamLen
853+ , o_1_space_filtering streamLen
854+ , o_1_space_filteringX4 streamLen
855+ -- , o_1_space_zipping streamLen
856+ -- , o_1_space_mixed streamLen
857+ -- , o_1_space_mixedX2 streamLen
858+ -- , o_1_space_mixedX4 streamLen
859+ -- , o_1_space_list streamLen
863+o_n_heap :: Int -> Benchmark
865+ bgroup (o_n_heap_prefix moduleName)
866+ [ bgroup "transformation"
867+ [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
871+{-# INLINE benchK #-}
872+benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
873+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
875+o_n_stack :: Int -> Int -> Int -> Benchmark
876+o_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)
883+ , bgroup "transformation"
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)
889+ , bgroup "transformationX4"
891+ benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
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)
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
908+o_n_space :: Int -> Benchmark
909+o_n_space streamLen =
910+ bgroup (o_n_space_prefix moduleName)
911+ [ bgroup "elimination"
912+ [ benchFold "toList" toList (unfoldrMK streamLen)
917+{-# INLINE benchList #-}
918+benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
919+benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
925+ [ o_1_space streamLen
926+ -- , o_n_stack streamLen iterStreamLen maxIters
927+ -- , o_n_heap streamLen
928+ , o_n_space streamLen
935+ -- iterStreamLen = 10