@@ -0,0 +1,938 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.StreamK
3+-- Copyright : (c) 2018 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# OPTIONS_GHC -Wno-orphans #-}
12+
13+#ifdef __HADDOCK_VERSION__
14+#undef INSPECTION
15+#endif
16+
17+#ifdef INSPECTION
18+{-# LANGUAGE TemplateHaskell #-}
19+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20+#endif
21+
22+module Main (main) where
23+
24+-- import Control.Applicative (liftA2)
25+-- import Control.Monad (when)
26+-- import Data.Maybe (isJust)
27+-- import System.Random (randomRIO)
28+import Prelude hiding
29+ ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate
30+ , repeat, replicate
31+ )
32+
33+import qualified Prelude as P
34+-- import qualified Data.List as List
35+
36+import qualified Streamly.Internal.Data.StreamK as S
37+import qualified Streamly.Internal.Data.Stream as D
38+import qualified Streamly.Internal.Data.Fold as Fold
39+
40+import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)
41+
42+import Streamly.Benchmark.Common
43+
44+#ifdef INSPECTION
45+import Test.Inspection
46+#endif
47+
48+-------------------------------------------------------------------------------
49+-- Stream generation and elimination
50+-------------------------------------------------------------------------------
51+
52+type Stream m a = S.Stream m a
53+
54+{-# INLINE unfoldrD #-}
55+unfoldrD :: Monad m => Int -> Int -> Stream m Int
56+unfoldrD streamLen n = D.toStreamK (D.unfoldr step n)
57+ where
58+ step cnt =
59+ if cnt > n + streamLen
60+ then Nothing
61+ else Just (cnt, cnt + 1)
62+
63+{-# INLINE unfoldrMD #-}
64+unfoldrMD :: Monad m => Int -> Int -> Stream m Int
65+unfoldrMD streamLen n = D.toStreamK (D.unfoldrM step n)
66+ where
67+ step cnt =
68+ if cnt > n + streamLen
69+ then return Nothing
70+ else return (Just (cnt, cnt + 1))
71+
72+{-
73+{-# INLINE unfoldrK #-}
74+unfoldrK :: Int -> Int -> Stream m Int
75+unfoldrK streamLen n = S.unfoldr step n
76+ where
77+ step cnt =
78+ if cnt > n + streamLen
79+ then Nothing
80+ else Just (cnt, cnt + 1)
81+-}
82+
83+{-# INLINE unfoldrMK #-}
84+unfoldrMK :: Monad m => Int -> Int -> Stream m Int
85+unfoldrMK streamLen n = S.unfoldrMWith S.consM step n
86+ where
87+ step cnt =
88+ if cnt > n + streamLen
89+ then return Nothing
90+ else return (Just (cnt, cnt + 1))
91+
92+{-# INLINE repeat #-}
93+repeat :: Monad m => Int -> Int -> Stream m Int
94+repeat streamLen = S.take streamLen . D.toStreamK . D.repeat
95+
96+{-# INLINE repeatM #-}
97+repeatM :: Monad m => Int -> Int -> Stream m Int
98+repeatM streamLen = S.take streamLen . D.toStreamK . D.repeatM . return
99+
100+{-# INLINE replicate #-}
101+replicate :: Monad m => Int -> Int -> Stream m Int
102+replicate x y = D.toStreamK $ D.replicate x y
103+
104+{-# INLINE replicateM #-}
105+replicateM :: Monad m => Int -> Int -> Stream m Int
106+replicateM streamLen = D.toStreamK . D.replicateM streamLen . return
107+
108+{-# INLINE iterate #-}
109+iterate :: Monad m => Int -> Int -> Stream m Int
110+iterate streamLen = S.take streamLen . D.toStreamK . D.iterate (+1)
111+
112+{-# INLINE iterateM #-}
113+iterateM :: Monad m => Int -> Int -> Stream m Int
114+iterateM streamLen = S.take streamLen . D.toStreamK . D.iterateM (return . (+1)) . return
115+
116+{-# INLINE fromFoldable #-}
117+fromFoldable :: Int -> Int -> Stream m Int
118+fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
119+
120+{-# INLINE fromFoldableM #-}
121+fromFoldableM :: Monad m => Int -> Int -> Stream m Int
122+fromFoldableM streamLen n =
123+ Prelude.foldr (S.consM . return) S.nil [n .. n + streamLen]
124+
125+{-
126+{-# INLINABLE concatMapFoldableWith #-}
127+concatMapFoldableWith :: Foldable f
128+ => (Stream m b -> Stream m b -> Stream m b)
129+ -> (a -> Stream m b)
130+ -> f a
131+ -> Stream m b
132+concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
133+-}
134+
135+{-# INLINE concatMapFoldableSerial #-}
136+concatMapFoldableSerial :: Monad m => Int -> Int -> Stream m Int
137+concatMapFoldableSerial streamLen n =
138+ D.toStreamK $ D.concatMap D.fromPure $ D.fromStreamK $ S.fromList [n..n+streamLen]
139+
140+{-# INLINE concatMapFoldableSerialM #-}
141+concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
142+concatMapFoldableSerialM streamLen n =
143+ -- concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
144+ D.toStreamK $ D.concatMap (D.fromEffect . return) $ D.fromStreamK $ S.fromList [n..n+streamLen]
145+
146+-------------------------------------------------------------------------------
147+-- Elimination
148+-------------------------------------------------------------------------------
149+
150+{-# INLINE drainD #-}
151+drainD :: Monad m => Stream m a -> m ()
152+drainD = D.drain . D.fromStreamK
153+
154+{-# INLINE drain #-}
155+drain :: Monad m => Stream m a -> m ()
156+drain = S.drain
157+
158+{-# INLINE mapM_ #-}
159+mapM_ :: Monad m => Stream m a -> m ()
160+mapM_ s = D.mapM_ (\_ -> return ()) $ D.fromStreamK s
161+
162+{-
163+{-# INLINE uncons #-}
164+uncons :: Monad m => Stream m Int -> m ()
165+uncons s = do
166+ r <- D.uncons $ D.fromStreamK s
167+ case r of
168+ Nothing -> return ()
169+ Just (_, t) -> uncons (D.toStreamK t)
170+
171+{-# INLINE init #-}
172+init :: Monad m => Stream m a -> m ()
173+init s = do
174+ t <- S.init s
175+ P.mapM_ S.drain t
176+
177+{-# INLINE tail #-}
178+tail :: Monad m => Stream m a -> m ()
179+tail s = S.tail s >>= P.mapM_ tail
180+
181+{-# INLINE nullTail #-}
182+nullTail :: Monad m => Stream m Int -> m ()
183+nullTail s = do
184+ r <- S.null s
185+ when (not r) $ S.tail s >>= P.mapM_ nullTail
186+
187+{-# INLINE headTail #-}
188+headTail :: Monad m => Stream m Int -> m ()
189+headTail s = do
190+ h <- S.head s
191+ when (isJust h) $ S.tail s >>= P.mapM_ headTail
192+-}
193+
194+{-# INLINE toList #-}
195+toList :: Monad m => Stream m Int -> m [Int]
196+toList = D.fold Fold.toList . D.fromStreamK
197+
198+{-# INLINE foldl' #-}
199+foldl' :: Monad m => Stream m Int -> m Int
200+foldl' = D.fold (Fold.foldl' (+) 0) . D.fromStreamK
201+
202+{-# INLINE last #-}
203+last :: Monad m => Stream m Int -> m (Maybe Int)
204+last = D.fold Fold.latest . D.fromStreamK
205+
206+-------------------------------------------------------------------------------
207+-- Transformation
208+-------------------------------------------------------------------------------
209+
210+{-# INLINE composeN #-}
211+composeN
212+ :: Monad m
213+ => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
214+composeN n f =
215+ case n of
216+ 1 -> drain . f
217+ 2 -> drain . f . f
218+ 3 -> drain . f . f . f
219+ 4 -> drain . f . f . f . f
220+ _ -> undefined
221+
222+{-# INLINE scanl' #-}
223+scanl' :: Monad m => Int -> Stream m Int -> m ()
224+scanl' n =
225+ composeN n (D.toStreamK . D.scan (Fold.foldl' (+) 0) . D.fromStreamK)
226+
227+{-# INLINE map #-}
228+map :: Monad m => Int -> Stream m Int -> m ()
229+map n = composeN n (D.toStreamK . D.map (+ 1) . D.fromStreamK)
230+
231+{-
232+{-# INLINE fmapK #-}
233+fmapK :: Monad m => Int -> Stream m Int -> m ()
234+fmapK n = composeN n $ P.fmap (+ 1)
235+-}
236+
237+{-# INLINE mapM #-}
238+mapM :: Monad m => Int -> Stream m Int -> m ()
239+mapM n = composeN n (D.toStreamK . D.mapM return . D.fromStreamK)
240+
241+{-
242+{-# INLINE mapMSerial #-}
243+mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
244+mapMSerial n = composeN n $ S.mapMSerial return
245+-}
246+
247+{-# INLINE filterEven #-}
248+filterEven :: Monad m => Int -> Stream m Int -> m ()
249+filterEven n = composeN n (D.toStreamK . D.filter even . D.fromStreamK)
250+
251+{-
252+{-# INLINE filterAllOut #-}
253+filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
254+filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
255+
256+{-# INLINE filterAllIn #-}
257+filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
258+filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
259+
260+{-# INLINE _takeOne #-}
261+_takeOne :: Monad m => Int -> Stream m Int -> m ()
262+_takeOne n = composeN n $ S.take 1
263+
264+{-# INLINE takeAll #-}
265+takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
266+takeAll streamLen n = composeN n $ S.take streamLen
267+
268+{-# INLINE takeWhileTrue #-}
269+takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
270+takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
271+
272+{-# INLINE dropOne #-}
273+dropOne :: Monad m => Int -> Stream m Int -> m ()
274+dropOne n = composeN n $ S.drop 1
275+
276+{-# INLINE dropAll #-}
277+dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
278+dropAll streamLen n = composeN n $ S.drop streamLen
279+
280+{-# INLINE dropWhileTrue #-}
281+dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
282+dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
283+
284+{-# INLINE dropWhileFalse #-}
285+dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
286+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
287+-}
288+
289+{-
290+{-# INLINE foldrS #-}
291+foldrS :: Monad m => Int -> Stream m Int -> m ()
292+foldrS n = composeN n $ S.foldrS S.cons S.nil
293+
294+{-# INLINE foldlS #-}
295+foldlS :: Monad m => Int -> Stream m Int -> m ()
296+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
297+-}
298+
299+{-
300+{-# INLINE intersperse #-}
301+intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
302+intersperse streamLen n = composeN n $ S.intersperse streamLen
303+-}
304+
305+-------------------------------------------------------------------------------
306+-- Iteration
307+-------------------------------------------------------------------------------
308+
309+{-
310+{-# INLINE iterateSource #-}
311+iterateSource
312+ :: S.MonadAsync m
313+ => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
314+iterateSource 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)
318+
319+-- this is quadratic
320+{-# INLINE iterateScan #-}
321+iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
322+iterateScan iterStreamLen maxIters =
323+ iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
324+
325+-- this is quadratic
326+{-# INLINE iterateDropWhileFalse #-}
327+iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
328+iterateDropWhileFalse streamLen iterStreamLen maxIters =
329+ iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
330+
331+{-# INLINE iterateMapM #-}
332+iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
333+iterateMapM iterStreamLen =
334+ iterateSource iterStreamLen (S.mapMWith S.consM return)
335+
336+{-# INLINE iterateFilterEven #-}
337+iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
338+iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
339+
340+{-# INLINE iterateTakeAll #-}
341+iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
342+iterateTakeAll streamLen iterStreamLen =
343+ iterateSource iterStreamLen (S.take streamLen)
344+
345+{-# INLINE iterateDropOne #-}
346+iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
347+iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
348+
349+{-# INLINE iterateDropWhileTrue #-}
350+iterateDropWhileTrue :: S.MonadAsync m =>
351+ Int -> Int -> Int -> Int -> Stream m Int
352+iterateDropWhileTrue streamLen iterStreamLen =
353+ iterateSource iterStreamLen (S.dropWhile (<= streamLen))
354+-}
355+
356+-------------------------------------------------------------------------------
357+-- Zipping
358+-------------------------------------------------------------------------------
359+
360+{-
361+{-# INLINE zipWith #-}
362+zipWith :: Monad m => Stream m Int -> m ()
363+zipWith src = drain $ S.zipWith (,) src src
364+
365+{-# INLINE zipWithM #-}
366+zipWithM :: Monad m => Stream m Int -> m ()
367+zipWithM src = drain $ S.zipWithM (curry return) src src
368+
369+{-# INLINE sortByK #-}
370+sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
371+sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
372+
373+{-# INLINE sortBy #-}
374+sortBy :: Monad m => Stream m Int -> m ()
375+sortBy = drain . sortByK compare
376+
377+-------------------------------------------------------------------------------
378+-- Mixed Composition
379+-------------------------------------------------------------------------------
380+
381+{-# INLINE scanMap #-}
382+scanMap :: Monad m => Int -> Stream m Int -> m ()
383+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
384+
385+{-# INLINE dropMap #-}
386+dropMap :: Monad m => Int -> Stream m Int -> m ()
387+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
388+
389+{-# INLINE dropScan #-}
390+dropScan :: Monad m => Int -> Stream m Int -> m ()
391+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
392+
393+{-# INLINE takeDrop #-}
394+takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
395+takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
396+
397+{-# INLINE takeScan #-}
398+takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
399+takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
400+
401+{-# INLINE takeMap #-}
402+takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
403+takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
404+
405+{-# INLINE filterDrop #-}
406+filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
407+filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
408+
409+{-# INLINE filterTake #-}
410+filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
411+filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
412+
413+{-# INLINE filterScan #-}
414+filterScan :: Monad m => Int -> Stream m Int -> m ()
415+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
416+
417+{-# INLINE filterMap #-}
418+filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
419+filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
420+-}
421+
422+-------------------------------------------------------------------------------
423+-- ConcatMap
424+-------------------------------------------------------------------------------
425+
426+-- concatMap unfoldrM/unfoldrM
427+
428+{-# INLINE concatMap #-}
429+concatMap :: Int -> Int -> Int -> IO ()
430+concatMap outer inner n =
431+ S.drain $ D.toStreamK $ D.concatMap
432+ (\_ -> D.fromStreamK $ unfoldrMK inner n)
433+ (D.fromStreamK $ unfoldrMK outer n)
434+
435+#ifdef INSPECTION
436+inspect $ hasNoTypeClasses 'concatMap
437+#endif
438+
439+-- concatMap unfoldr/unfoldr
440+
441+{-
442+{-# INLINE concatMapPure #-}
443+concatMapPure :: Int -> Int -> Int -> IO ()
444+concatMapPure outer inner n =
445+ S.drain $ S.concatMap
446+ (\_ -> unfoldr inner n)
447+ (unfoldr outer n)
448+
449+#ifdef INSPECTION
450+inspect $ hasNoTypeClasses 'concatMapPure
451+#endif
452+
453+-- concatMap replicate/unfoldrM
454+
455+{-# INLINE concatMapRepl #-}
456+concatMapRepl :: Int -> Int -> Int -> IO ()
457+concatMapRepl outer inner n =
458+ S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
459+
460+#ifdef INSPECTION
461+inspect $ hasNoTypeClasses 'concatMapRepl
462+#endif
463+
464+-- concatMapWith
465+
466+{-# INLINE sourceConcatMapId #-}
467+sourceConcatMapId :: Monad m
468+ => Int -> Int -> Stream m (Stream m Int)
469+sourceConcatMapId val n =
470+ S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
471+
472+{-# INLINE concatMapBySerial #-}
473+concatMapBySerial :: Int -> Int -> Int -> IO ()
474+concatMapBySerial outer inner n =
475+ S.drain $ S.concatMapWith S.serial
476+ (unfoldrM inner)
477+ (unfoldrM outer n)
478+-}
479+
480+{-
481+-------------------------------------------------------------------------------
482+-- Nested Composition
483+-------------------------------------------------------------------------------
484+
485+instance Monad m => Applicative (S.Stream m) where
486+ {-# INLINE pure #-}
487+ pure = S.fromPure
488+
489+ {-# INLINE (<*>) #-}
490+ (<*>) = S.crossApply
491+
492+ {-# INLINE liftA2 #-}
493+ liftA2 f x = (<*>) (fmap f x)
494+
495+ {-# INLINE (*>) #-}
496+ (*>) = S.crossApplySnd
497+
498+ {-# INLINE (<*) #-}
499+ (<*) = S.crossApplyFst
500+
501+-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
502+-- the monad instance of StreamD is slower than StreamK after foldr/build
503+-- fusion.
504+instance Monad m => Monad (S.Stream m) where
505+ {-# INLINE return #-}
506+ return = pure
507+
508+ {-# INLINE (>>=) #-}
509+ (>>=) = flip S.concatMap
510+
511+{-# INLINE drainApplicative #-}
512+drainApplicative :: Monad m => Stream m Int -> m ()
513+drainApplicative s = drain $ do
514+ (+) <$> s <*> s
515+
516+{-# INLINE drainMonad #-}
517+drainMonad :: Monad m => Stream m Int -> m ()
518+drainMonad s = drain $ do
519+ x <- s
520+ y <- s
521+ return $ x + y
522+
523+{-# INLINE drainMonad3 #-}
524+drainMonad3 :: Monad m => Stream m Int -> m ()
525+drainMonad3 s = drain $ do
526+ x <- s
527+ y <- s
528+ z <- s
529+ return $ x + y + z
530+
531+{-# INLINE filterAllOutMonad #-}
532+filterAllOutMonad
533+ :: Monad m
534+ => Stream m Int -> m ()
535+filterAllOutMonad str = drain $ do
536+ x <- str
537+ y <- str
538+ let s = x + y
539+ if s < 0
540+ then return s
541+ else S.nil
542+
543+{-# INLINE filterAllInMonad #-}
544+filterAllInMonad
545+ :: Monad m
546+ => Stream m Int -> m ()
547+filterAllInMonad str = drain $ do
548+ x <- str
549+ y <- str
550+ let s = x + y
551+ if s > 0
552+ then return s
553+ else S.nil
554+
555+-------------------------------------------------------------------------------
556+-- Nested Composition Pure lists
557+-------------------------------------------------------------------------------
558+
559+-- There are several list benchmarks here for comparison with lists. It is easy
560+-- and convenient to see the comparisons when they are here, otherwise we'll
561+-- have to add a separate module for list benchmarks with the same names and
562+-- then add a comparison in bench.sh.
563+
564+{-# INLINE unfoldrList #-}
565+unfoldrList :: Int -> Int -> [Int]
566+unfoldrList maxval n = List.unfoldr step n
567+ where
568+ step cnt =
569+ if cnt > n + maxval
570+ then Nothing
571+ else Just (cnt, cnt + 1)
572+
573+{-# INLINE toNullApNestedList #-}
574+toNullApNestedList :: [Int] -> [Int]
575+toNullApNestedList s = (+) <$> s <*> s
576+
577+{-# INLINE toNullNestedList #-}
578+toNullNestedList :: [Int] -> [Int]
579+toNullNestedList s = do
580+ x <- s
581+ y <- s
582+ return $ x + y
583+
584+{-# INLINE toNullNestedList3 #-}
585+toNullNestedList3 :: [Int] -> [Int]
586+toNullNestedList3 s = do
587+ x <- s
588+ y <- s
589+ z <- s
590+ return $ x + y + z
591+
592+{-# INLINE filterAllOutNestedList #-}
593+filterAllOutNestedList :: [Int] -> [Int]
594+filterAllOutNestedList str = do
595+ x <- str
596+ y <- str
597+ let s = x + y
598+ if s < 0
599+ then return s
600+ else []
601+
602+{-# INLINE filterAllInNestedList #-}
603+filterAllInNestedList :: [Int] -> [Int]
604+filterAllInNestedList str = do
605+ x <- str
606+ y <- str
607+ let s = x + y
608+ if s > 0
609+ then return s
610+ else []
611+ -}
612+
613+-------------------------------------------------------------------------------
614+-- Benchmarks
615+-------------------------------------------------------------------------------
616+
617+moduleName :: String
618+moduleName = "Data.Stream.ToStreamK"
619+
620+-- Generation of StreamK using StreamD generation functions and eleminating
621+-- using StreamK drain.
622+o_1_space_generation :: Int -> Benchmark
623+o_1_space_generation streamLen =
624+ bgroup "generation"
625+ [ benchFold "unfoldr" drain (unfoldrD streamLen)
626+ , benchFold "unfoldrM" drain (unfoldrMD streamLen)
627+ , benchFold "repeat" drain (repeat streamLen)
628+ , benchFold "repeatM" drain (repeatM streamLen)
629+ , benchFold "replicate" drain (replicate streamLen)
630+ , benchFold "replicateM" drain (replicateM streamLen)
631+ , benchFold "iterate" drain (iterate streamLen)
632+ , benchFold "iterateM" drain (iterateM streamLen)
633+
634+ , benchFold "fromFoldable" drain (fromFoldable streamLen)
635+ , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
636+
637+ -- appends
638+ , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
639+ , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
640+ ]
641+
642+-- Generating using StreamK and eliminating using StreamD folds.
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)
652+ ]
653+
654+{-
655+o_1_space_nested :: Int -> Benchmark
656+o_1_space_nested streamLen =
657+ bgroup "nested"
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)
668+ ]
669+ where
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
672+-}
673+
674+-- Generate using StreamK and transform using StreamD transformation functions
675+-- and then drain using StreamK.
676+o_1_space_transformation :: Int -> Benchmark
677+o_1_space_transformation streamLen =
678+ bgroup "transformation"
679+ [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
680+ benchFold "scanl'" (scanl' 1) (unfoldrMK streamLen)
681+ , benchFold "map" (map 1) (unfoldrMK streamLen)
682+ -- , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
683+ , benchFold "mapM" (mapM 1) (unfoldrMK streamLen)
684+ -- , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
685+ ]
686+
687+o_1_space_transformationX4 :: Int -> Benchmark
688+o_1_space_transformationX4 streamLen =
689+ bgroup "transformationX4"
690+ [ benchFold "scanl'" (scanl' 4) (unfoldrMK streamLen)
691+ , benchFold "map" (map 4) (unfoldrMK streamLen)
692+ -- , benchFold "fmap" (fmapK 4) (unfoldrMK streamLen)
693+ , benchFold "mapM" (mapM 4) (unfoldrMK streamLen)
694+ -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
695+ -- XXX this is horribly slow
696+ -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
697+ ]
698+
699+-- Generate using K, fold using K, concat using D.concatMap
700+o_1_space_concat :: Int -> Benchmark
701+o_1_space_concat streamLen =
702+ bgroup "concat"
703+ [ {- benchIOSrc1 "concatMapPure (n of 1)"
704+ (concatMapPure streamLen 1)
705+ , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
706+ (concatMapPure streamLen2 streamLen2)
707+ , benchIOSrc1 "concatMapPure (1 of n)"
708+ (concatMapPure 1 streamLen)
709+ -}
710+
711+ benchIOSrc1 "concatMap (n of 1)"
712+ (concatMap streamLen 1)
713+ , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
714+ (concatMap streamLen2 streamLen2)
715+ , benchIOSrc1 "concatMap (1 of n)"
716+ (concatMap 1 streamLen)
717+
718+{-
719+ , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
720+ (concatMapRepl streamLen2 streamLen2)
721+
722+ -- This is for comparison with concatMapFoldableWith
723+ , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
724+ (S.drain
725+ . S.concatMapWith S.serial id
726+ . sourceConcatMapId streamLen)
727+
728+ , benchIOSrc1 "concatMapBy serial (n of 1)"
729+ (concatMapBySerial streamLen 1)
730+ , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
731+ (concatMapBySerial streamLen2 streamLen2)
732+ , benchIOSrc1 "concatMapBy serial (1 of n)"
733+ (concatMapBySerial 1 streamLen)
734+ , benchFold "sortBy" sortBy (unfoldrM streamLen)
735+ -}
736+ ]
737+ where
738+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
739+
740+o_1_space_filtering :: Int -> Benchmark
741+o_1_space_filtering streamLen =
742+ bgroup "filtering"
743+ [ benchFold "filter-even" (filterEven 1) (unfoldrMK streamLen)
744+ {-
745+ , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
746+ , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
747+ , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
748+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
749+ , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
750+ , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
751+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
752+ , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
753+ -}
754+ ]
755+
756+o_1_space_filteringX4 :: Int -> Benchmark
757+o_1_space_filteringX4 streamLen =
758+ bgroup "filteringX4"
759+ [ benchFold "filter-even" (filterEven 4) (unfoldrMK streamLen)
760+ {-
761+ , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
762+ , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
763+ , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
764+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
765+ , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
766+ , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
767+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
768+ , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
769+ -}
770+ ]
771+
772+{-
773+o_1_space_zipping :: Int -> Benchmark
774+o_1_space_zipping streamLen =
775+ bgroup "zipping"
776+ [ benchFold "zipWith" zipWith (unfoldrM streamLen)
777+ , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
778+ ]
779+
780+o_1_space_mixed :: Int -> Benchmark
781+o_1_space_mixed streamLen =
782+ bgroup "mixed"
783+ [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
784+ , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
785+ , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
786+ , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
787+ , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
788+ , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
789+ , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
790+ , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
791+ , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
792+ , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
793+ ]
794+
795+o_1_space_mixedX2 :: Int -> Benchmark
796+o_1_space_mixedX2 streamLen =
797+ bgroup "mixedX2"
798+ [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
799+ , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
800+ , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
801+ , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
802+ , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
803+ , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
804+ , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
805+ , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
806+ , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
807+ , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
808+ ]
809+
810+o_1_space_mixedX4 :: Int -> Benchmark
811+o_1_space_mixedX4 streamLen =
812+ bgroup "mixedX4"
813+ [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
814+ , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
815+ , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
816+ , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
817+ , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
818+ , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
819+ , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
820+ , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
821+ , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
822+ , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
823+ ]
824+ -}
825+
826+{-
827+o_1_space_list :: Int -> Benchmark
828+o_1_space_list streamLen =
829+ bgroup "list"
830+ [ bgroup "elimination"
831+ [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
832+ ]
833+ , bgroup "nested"
834+ [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
835+ , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
836+ , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
837+ , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
838+ , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
839+ ]
840+ ]
841+ where
842+
843+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
844+ streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
845+-}
846+
847+o_1_space :: Int -> Benchmark
848+o_1_space streamLen =
849+ bgroup (o_1_space_prefix moduleName)
850+ [ o_1_space_generation streamLen
851+ , o_1_space_elimination streamLen
852+ -- , o_1_space_nested streamLen
853+ , o_1_space_transformation streamLen
854+ , o_1_space_transformationX4 streamLen
855+ , o_1_space_concat streamLen
856+ , o_1_space_filtering streamLen
857+ , o_1_space_filteringX4 streamLen
858+ -- , o_1_space_zipping streamLen
859+ -- , o_1_space_mixed streamLen
860+ -- , o_1_space_mixedX2 streamLen
861+ -- , o_1_space_mixedX4 streamLen
862+ -- , o_1_space_list streamLen
863+ ]
864+
865+{-
866+o_n_heap :: Int -> Benchmark
867+o_n_heap streamLen =
868+ bgroup (o_n_heap_prefix moduleName)
869+ [ bgroup "transformation"
870+ [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
871+ ]
872+ ]
873+
874+{-# INLINE benchK #-}
875+benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
876+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
877+
878+o_n_stack :: Int -> Int -> Int -> Benchmark
879+o_n_stack streamLen iterStreamLen maxIters =
880+ bgroup (o_n_stack_prefix moduleName)
881+ [ bgroup "elimination"
882+ [ benchFold "tail" tail (unfoldrM streamLen)
883+ , benchFold "nullTail" nullTail (unfoldrM streamLen)
884+ , benchFold "headTail" headTail (unfoldrM streamLen)
885+ ]
886+ , bgroup "transformation"
887+ [
888+ -- XXX why do these need so much stack
889+ benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
890+ , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
891+ ]
892+ , bgroup "transformationX4"
893+ [
894+ benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
895+ ]
896+ , bgroup "iterated"
897+ [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
898+ , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
899+ , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
900+ , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
901+ , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
902+ , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
903+ , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
904+ ]
905+ ]
906+ where
907+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
908+ streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
909+-}
910+
911+o_n_space :: Int -> Benchmark
912+o_n_space streamLen =
913+ bgroup (o_n_space_prefix moduleName)
914+ [ bgroup "elimination"
915+ [ benchFold "toList" toList (unfoldrMK streamLen)
916+ ]
917+ ]
918+
919+{-
920+{-# INLINE benchList #-}
921+benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
922+benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
923+-}
924+
925+main :: IO ()
926+main =
927+ defaultMain
928+ [ o_1_space streamLen
929+ -- , o_n_stack streamLen iterStreamLen maxIters
930+ -- , o_n_heap streamLen
931+ , o_n_space streamLen
932+ ]
933+
934+ where
935+
936+ streamLen = 100000
937+ -- maxIters = 10000
938+ -- iterStreamLen = 10