@@ -8,6 +8,7 @@
88{-# LANGUAGE CPP #-}
99{-# LANGUAGE FlexibleContexts #-}
1010{-# LANGUAGE ScopedTypeVariables #-}
11+{-# OPTIONS_GHC -Wno-orphans #-}
1112
1213#ifdef __HADDOCK_VERSION__
1314#undef INSPECTION
@@ -20,19 +21,23 @@
2021
2122module Main (main) where
2223
24+#if !MIN_VERSION_base(4,18,0)
25+import Control.Applicative (liftA2)
26+#endif
2327import Control.Monad (when)
2428import Data.Maybe (isJust)
2529import System.Random (randomRIO)
2630import Prelude hiding
27− (tail, mapM_, foldl, last, map, mapM, concatMap, zip, init)
31+ ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate
32+ , repeat, replicate
33+ )
2834
2935import qualified Prelude as P
3036import qualified Data.List as List
3137
32−import qualified Streamly.Internal.Data.Stream.StreamK as S
33−import qualified Streamly.Internal.Data.SVar as S
38+import qualified Streamly.Internal.Data.StreamK as S
3439
35−import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
40+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
3641
3742import Streamly.Benchmark.Common
3843
@@ -40,88 +45,161 @@ import Streamly.Benchmark.Common
4045import Test.Inspection
4146#endif
4247
48+{-
49+
50+Benchmarks that need to be added
51+
52+-- fromList
53+
54+-- bindWith
55+-- concatPairsWith
56+-- apWith
57+-- apSerial
58+-- apSerialDiscardFst
59+-- apSerialDiscardSnd
60+
61+-- the
62+-- serial
63+-- consMStream
64+-- withLocal
65+-- mfix
66+
67+-- elem
68+-- notElem
69+-- all
70+-- any
71+-- minimum
72+-- minimumBy
73+-- maximum
74+-- maximumBy
75+-- findIndices
76+-- lookup
77+-- findM
78+-- find
79+-- (!!)
80+
81+-- foldlM'
82+-- foldlT
83+-- foldlx'
84+-- foldlMx'
85+-- fold
86+
87+-- sequence
88+
89+-- foldrSM
90+-- buildS
91+-- buildM
92+-- augmentS
93+-- augmentSM
94+-- foldr
95+-- foldr1
96+-- foldrM
97+-- foldrT
98+
99+-- intersperseM
100+-- insertBy
101+-- deleteBy
102+-- reverse
103+-- mapMaybe
104+
105+-- zipWithM
106+-- mergeBy
107+-- mergeByM
108+
109+-- toStreamK (Probably can be skipped)
110+-- hoist
111+
112+-- scanlx'
113+
114+-}
115+
43116-------------------------------------------------------------------------------
44117-- Stream generation and elimination
45118-------------------------------------------------------------------------------
46119
47−type Stream m a = S.Stream m a
48−
49−{-# INLINE sourceUnfoldr #-}
50−sourceUnfoldr :: Int -> Int -> Stream m Int
51−sourceUnfoldr value n = S.unfoldr step n
52− where
53− step cnt =
54− if cnt > n + value
55− then Nothing
56− else Just (cnt, cnt + 1)
120+type Stream m a = S.StreamK m a
57121
58−{-# INLINE sourceUnfoldrN #-}
59−sourceUnfoldrN :: Int -> Int -> Stream m Int
60−sourceUnfoldrN m n = S.unfoldr step n
122+{-# INLINE unfoldr #-}
123+unfoldr :: Int -> Int -> Stream m Int
124+unfoldr streamLen n = S.unfoldr step n
61125 where
62126 step cnt =
63− if cnt > n + m
127+ if cnt > n + streamLen
64128 then Nothing
65129 else Just (cnt, cnt + 1)
66130
67−{-# INLINE sourceUnfoldrM #-}
68−sourceUnfoldrM :: S.MonadAsync m => Int -> Int -> Stream m Int
69−sourceUnfoldrM value n = S.unfoldrM step n
131+{-# INLINE unfoldrM #-}
132+unfoldrM :: Monad m => Int -> Int -> Stream m Int
133+unfoldrM streamLen n = S.unfoldrMWith S.consM step n
70134 where
71135 step cnt =
72− if cnt > n + value
136+ if cnt > n + streamLen
73137 then return Nothing
74138 else return (Just (cnt, cnt + 1))
75139
76−{-# INLINE sourceUnfoldrMN #-}
77−sourceUnfoldrMN :: S.MonadAsync m => Int -> Int -> Stream m Int
78−sourceUnfoldrMN m n = S.unfoldrM step n
79− where
80− step cnt =
81− if cnt > n + m
82− then return Nothing
83− else return (Just (cnt, cnt + 1))
140+{-# INLINE repeat #-}
141+repeat :: Int -> Int -> Stream m Int
142+repeat streamLen = S.take streamLen . S.repeat
84143
85−{-# INLINE sourceFromFoldable #-}
86−sourceFromFoldable :: Int -> Int -> Stream m Int
87−sourceFromFoldable value n = S.fromFoldable [n..n+value]
144+{-# INLINE repeatM #-}
145+repeatM :: Monad m => Int -> Int -> Stream m Int
146+repeatM streamLen = S.take streamLen . S.repeatM . return
88147
89−{-# INLINE sourceFromFoldableM #-}
90−sourceFromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int
91−sourceFromFoldableM value n =
92− Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+value])
148+{-# INLINE replicate #-}
149+replicate :: Int -> Int -> Stream m Int
150+replicate = S.replicate
93151
94−{-# INLINABLE concatMapFoldableWith #-}
95−concatMapFoldableWith :: (S.IsStream t, Foldable f)
96− => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b
97−concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
152+{-# INLINE replicateM #-}
153+replicateM :: Monad m => Int -> Int -> Stream m Int
154+replicateM streamLen = S.replicateMWith S.consM streamLen . return
98155
99−{-# INLINE sourceFoldMapWith #-}
100−sourceFoldMapWith :: Int -> Int -> Stream m Int
101−sourceFoldMapWith value n = concatMapFoldableWith S.serial S.yield [n..n+value]
156+{-# INLINE iterate #-}
157+iterate :: Int -> Int -> Stream m Int
158+iterate streamLen = S.take streamLen . S.iterate (+1)
102159
103−{-# INLINE sourceFoldMapWithM #-}
104−sourceFoldMapWithM :: Monad m => Int -> Int -> Stream m Int
105−sourceFoldMapWithM value n =
106− concatMapFoldableWith S.serial (S.yieldM . return) [n..n+value]
160+{-# INLINE iterateM #-}
161+iterateM :: Monad m => Int -> Int -> Stream m Int
162+iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
163+
164+{-# INLINE fromFoldable #-}
165+fromFoldable :: Int -> Int -> Stream m Int
166+fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
167+
168+{-# INLINE fromFoldableM #-}
169+fromFoldableM :: Monad m => Int -> Int -> Stream m Int
170+fromFoldableM streamLen n =
171+ List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
172+
173+{-# INLINABLE concatMapFoldableWith #-}
174+concatMapFoldableWith :: P.Foldable f
175+ => (Stream m b -> Stream m b -> Stream m b)
176+ -> (a -> Stream m b)
177+ -> f a
178+ -> Stream m b
179+concatMapFoldableWith f g = P.foldr (f . g) S.nil
180+
181+{-# INLINE concatMapFoldableSerial #-}
182+concatMapFoldableSerial :: Int -> Int -> Stream m Int
183+concatMapFoldableSerial streamLen n =
184+ concatMapFoldableWith S.append S.fromPure [n..n+streamLen]
185+
186+{-# INLINE concatMapFoldableSerialM #-}
187+concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
188+concatMapFoldableSerialM streamLen n =
189+ concatMapFoldableWith S.append (S.fromEffect . return) [n..n+streamLen]
107190
108191-------------------------------------------------------------------------------
109192-- Elimination
110193-------------------------------------------------------------------------------
111194
112−{-# INLINE runStream #-}
113−runStream :: Monad m => Stream m a -> m ()
114−runStream = S.drain
115−-- runStream = S.mapM_ (\_ -> return ())
195+{-# INLINE drain #-}
196+drain :: Monad m => Stream m a -> m ()
197+drain = S.drain
116198
117199{-# INLINE mapM_ #-}
118200mapM_ :: Monad m => Stream m a -> m ()
119201mapM_ = S.mapM_ (\_ -> return ())
120202
121−{-# INLINE toNull #-}
122−toNull :: Monad m => Stream m Int -> m ()
123−toNull = runStream
124−
125203{-# INLINE uncons #-}
126204uncons :: Monad m => Stream m Int -> m ()
127205uncons s = do
@@ -131,13 +209,13 @@ uncons s = do
131209 Just (_, t) -> uncons t
132210
133211{-# INLINE init #-}
134−init :: (Monad m, S.IsStream t) => t m a -> m ()
212+init :: Monad m => Stream m a -> m ()
135213init s = do
136214 t <- S.init s
137215 P.mapM_ S.drain t
138216
139217{-# INLINE tail #-}
140−tail :: (Monad m, S.IsStream t) => t m a -> m ()
218+tail :: Monad m => Stream m a -> m ()
141219tail s = S.tail s >>= P.mapM_ tail
142220
143221{-# INLINE nullTail #-}
@@ -156,9 +234,9 @@ headTail s = do
156234toList :: Monad m => Stream m Int -> m [Int]
157235toList = S.toList
158236
159−{-# INLINE foldl #-}
160−foldl :: Monad m => Stream m Int -> m Int
161−foldl = S.foldl' (+) 0
237+{-# INLINE foldl' #-}
238+foldl' :: Monad m => Stream m Int -> m Int
239+foldl' = S.foldl' (+) 0
162240
163241{-# INLINE last #-}
164242last :: Monad m => Stream m Int -> m (Maybe Int)
@@ -168,40 +246,36 @@ last = S.last
168246-- Transformation
169247-------------------------------------------------------------------------------
170248
171−{-# INLINE transform #-}
172−transform :: Monad m => Stream m a -> m ()
173−transform = runStream
174−
175249{-# INLINE composeN #-}
176250composeN
177251 :: Monad m
178252 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
179253composeN n f =
180254 case n of
181− 1 -> transform . f
182− 2 -> transform . f . f
183− 3 -> transform . f . f . f
184− 4 -> transform . f . f . f . f
255+ 1 -> drain . f
256+ 2 -> drain . f . f
257+ 3 -> drain . f . f . f
258+ 4 -> drain . f . f . f . f
185259 _ -> undefined
186260
187−{-# INLINE scan #-}
188−scan :: Monad m => Int -> Stream m Int -> m ()
189−scan n = composeN n $ S.scanl' (+) 0
261+{-# INLINE scanl' #-}
262+scanl' :: Monad m => Int -> Stream m Int -> m ()
263+scanl' n = composeN n $ S.scanl' (+) 0
190264
191265{-# INLINE map #-}
192266map :: Monad m => Int -> Stream m Int -> m ()
193−map n = composeN n $ P.fmap (+ 1)
267+map n = composeN n $ S.map (+ 1)
194268
195269{-# INLINE fmapK #-}
196270fmapK :: Monad m => Int -> Stream m Int -> m ()
197271fmapK n = composeN n $ P.fmap (+ 1)
198272
199273{-# INLINE mapM #-}
200−mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()
201−mapM n = composeN n $ S.mapM return
274+mapM :: Monad m => Int -> Stream m Int -> m ()
275+mapM n = composeN n $ S.mapMWith S.consM return
202276
203277{-# INLINE mapMSerial #-}
204−mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
278+mapMSerial :: Monad m => Int -> Stream m Int -> m ()
205279mapMSerial n = composeN n $ S.mapMSerial return
206280
207281{-# INLINE filterEven #-}
@@ -210,11 +284,11 @@ filterEven n = composeN n $ S.filter even
210284
211285{-# INLINE filterAllOut #-}
212286filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
213−filterAllOut maxValue n = composeN n $ S.filter (> maxValue)
287+filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
214288
215289{-# INLINE filterAllIn #-}
216290filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
217−filterAllIn maxValue n = composeN n $ S.filter (<= maxValue)
291+filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
218292
219293{-# INLINE _takeOne #-}
220294_takeOne :: Monad m => Int -> Stream m Int -> m ()
@@ -222,11 +296,11 @@ _takeOne n = composeN n $ S.take 1
222296
223297{-# INLINE takeAll #-}
224298takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
225−takeAll maxValue n = composeN n $ S.take maxValue
299+takeAll streamLen n = composeN n $ S.take streamLen
226300
227301{-# INLINE takeWhileTrue #-}
228302takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
229−takeWhileTrue maxValue n = composeN n $ S.takeWhile (<= maxValue)
303+takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
230304
231305{-# INLINE dropOne #-}
232306dropOne :: Monad m => Int -> Stream m Int -> m ()
@@ -234,11 +308,11 @@ dropOne n = composeN n $ S.drop 1
234308
235309{-# INLINE dropAll #-}
236310dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
237−dropAll maxValue n = composeN n $ S.drop maxValue
311+dropAll streamLen n = composeN n $ S.drop streamLen
238312
239313{-# INLINE dropWhileTrue #-}
240314dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
241−dropWhileTrue maxValue n = composeN n $ S.dropWhile (<= maxValue)
315+dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
242316
243317{-# INLINE dropWhileFalse #-}
244318dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
@@ -253,8 +327,8 @@ foldlS :: Monad m => Int -> Stream m Int -> m ()
253327foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
254328
255329{-# INLINE intersperse #-}
256−intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
257−intersperse maxValue n = composeN n $ S.intersperse maxValue
330+intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
331+intersperse streamLen n = composeN n $ S.intersperse streamLen
258332
259333-------------------------------------------------------------------------------
260334-- Iteration
@@ -262,51 +336,67 @@ intersperse maxValue n = composeN n $ S.intersperse maxValue
262336
263337{-# INLINE iterateSource #-}
264338iterateSource
265− :: S.MonadAsync m
266− => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
267−iterateSource iterStreamLen g i n = f i (sourceUnfoldrMN iterStreamLen n)
339+ :: Monad m => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
340+iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
268341 where
269342 f (0 :: Int) m = g m
270343 f x m = g (f (x P.- 1) m)
271344
272345-- this is quadratic
273346{-# INLINE iterateScan #-}
274−iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
275−iterateScan iterStreamLen maxIters = iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
347+iterateScan :: Monad m => Int -> Int -> Int -> Stream m Int
348+iterateScan iterStreamLen maxIters =
349+ iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
276350
277351-- this is quadratic
278352{-# INLINE iterateDropWhileFalse #-}
279−iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
280−iterateDropWhileFalse maxValue iterStreamLen maxIters =
281− iterateSource iterStreamLen (S.dropWhile (> maxValue)) (maxIters `div` 10)
353+iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
354+iterateDropWhileFalse streamLen iterStreamLen maxIters =
355+ iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
282356
283357{-# INLINE iterateMapM #-}
284−iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
285−iterateMapM iterStreamLen maxIters = iterateSource iterStreamLen (S.mapM return) maxIters
358+iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
359+iterateMapM iterStreamLen =
360+ iterateSource iterStreamLen (S.mapMWith S.consM return)
286361
287362{-# INLINE iterateFilterEven #-}
288−iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
289−iterateFilterEven iterStreamLen maxIters = iterateSource iterStreamLen (S.filter even) maxIters
363+iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
364+iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
290365
291366{-# INLINE iterateTakeAll #-}
292−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
293−iterateTakeAll maxValue iterStreamLen maxIters = iterateSource iterStreamLen (S.take maxValue) maxIters
367+iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
368+iterateTakeAll streamLen iterStreamLen =
369+ iterateSource iterStreamLen (S.take streamLen)
294370
295371{-# INLINE iterateDropOne #-}
296−iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
297−iterateDropOne iterStreamLen maxIters = iterateSource iterStreamLen (S.drop 1) maxIters
372+iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
373+iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
298374
299375{-# INLINE iterateDropWhileTrue #-}
300−iterateDropWhileTrue :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
301−iterateDropWhileTrue maxValue iterStreamLen maxIters = iterateSource iterStreamLen (S.dropWhile (<= maxValue)) maxIters
376+iterateDropWhileTrue ::
377+ Monad m => Int -> Int -> Int -> Int -> Stream m Int
378+iterateDropWhileTrue streamLen iterStreamLen =
379+ iterateSource iterStreamLen (S.dropWhile (<= streamLen))
302380
303381-------------------------------------------------------------------------------
304382-- Zipping
305383-------------------------------------------------------------------------------
306384
307−{-# INLINE zip #-}
308−zip :: Monad m => Stream m Int -> m ()
309−zip src = transform $ S.zipWith (,) src src
385+{-# INLINE zipWith #-}
386+zipWith :: Monad m => Stream m Int -> m ()
387+zipWith src = drain $ S.zipWith (,) src src
388+
389+{-# INLINE zipWithM #-}
390+zipWithM :: Monad m => Stream m Int -> m ()
391+zipWithM src = drain $ S.zipWithM (curry return) src src
392+
393+{-# INLINE sortByK #-}
394+sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
395+sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure
396+
397+{-# INLINE sortBy #-}
398+sortBy :: Monad m => Stream m Int -> m ()
399+sortBy = drain . sortByK compare
310400
311401-------------------------------------------------------------------------------
312402-- Mixed Composition
@@ -326,32 +416,31 @@ dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
326416
327417{-# INLINE takeDrop #-}
328418takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
329−takeDrop maxValue n = composeN n $ S.drop 1 . S.take maxValue
419+takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
330420
331421{-# INLINE takeScan #-}
332422takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
333−takeScan maxValue n = composeN n $ S.scanl' (+) 0 . S.take maxValue
423+takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
334424
335425{-# INLINE takeMap #-}
336426takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
337−takeMap maxValue n = composeN n $ S.map (subtract 1) . S.take maxValue
427+takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
338428
339429{-# INLINE filterDrop #-}
340430filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
341−filterDrop maxValue n = composeN n $ S.drop 1 . S.filter (<= maxValue)
431+filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
342432
343433{-# INLINE filterTake #-}
344434filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
345−filterTake maxValue n = composeN n $ S.take maxValue . S.filter (<= maxValue)
435+filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
346436
347−-- Initially, this used maxBound not maxValue
348437{-# INLINE filterScan #-}
349−filterScan :: Monad m => Int -> Int -> Stream m Int -> m ()
350−filterScan maxValue n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxValue)
438+filterScan :: Monad m => Int -> Stream m Int -> m ()
439+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
351440
352441{-# INLINE filterMap #-}
353442filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
354−filterMap maxValue n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
443+filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
355444
356445-------------------------------------------------------------------------------
357446-- ConcatMap
@@ -363,8 +452,8 @@ filterMap maxValue n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
363452concatMap :: Int -> Int -> Int -> IO ()
364453concatMap outer inner n =
365454 S.drain $ S.concatMap
366− (\_ -> sourceUnfoldrMN inner n)
367− (sourceUnfoldrMN outer n)
455+ (\_ -> unfoldrM inner n)
456+ (unfoldrM outer n)
368457
369458#ifdef INSPECTION
370459inspect $ hasNoTypeClasses 'concatMap
@@ -376,8 +465,8 @@ inspect $ hasNoTypeClasses 'concatMap
376465concatMapPure :: Int -> Int -> Int -> IO ()
377466concatMapPure outer inner n =
378467 S.drain $ S.concatMap
379− (\_ -> sourceUnfoldrN inner n)
380− (sourceUnfoldrN outer n)
468+ (\_ -> unfoldr inner n)
469+ (unfoldr outer n)
381470
382471#ifdef INSPECTION
383472inspect $ hasNoTypeClasses 'concatMapPure
@@ -388,7 +477,7 @@ inspect $ hasNoTypeClasses 'concatMapPure
388477{-# INLINE concatMapRepl #-}
389478concatMapRepl :: Int -> Int -> Int -> IO ()
390479concatMapRepl outer inner n =
391− S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrMN outer n)
480+ S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
392481
393482#ifdef INSPECTION
394483inspect $ hasNoTypeClasses 'concatMapRepl
@@ -400,44 +489,70 @@ inspect $ hasNoTypeClasses 'concatMapRepl
400489sourceConcatMapId :: Monad m
401490 => Int -> Int -> Stream m (Stream m Int)
402491sourceConcatMapId val n =
403− S.fromFoldable $ fmap (S.yieldM . return) [n..n+val]
492+ S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
404493
405−{-# INLINE concatStreamsWith #-}
406−concatStreamsWith :: Int -> Int -> Int -> IO ()
407−concatStreamsWith outer inner n =
408− S.drain $ S.concatMapBy S.serial
409− (sourceUnfoldrMN inner)
410− (sourceUnfoldrMN outer n)
494+{-# INLINE concatMapBySerial #-}
495+concatMapBySerial :: Int -> Int -> Int -> IO ()
496+concatMapBySerial outer inner n =
497+ S.drain $ S.concatMapWith S.append
498+ (unfoldrM inner)
499+ (unfoldrM outer n)
411500
412501-------------------------------------------------------------------------------
413502-- Nested Composition
414503-------------------------------------------------------------------------------
415504
416−{-# INLINE toNullApNested #-}
417−toNullApNested :: Monad m => Stream m Int -> m ()
418−toNullApNested s = runStream $ do
505+instance Monad m => Applicative (S.StreamK m) where
506+ {-# INLINE pure #-}
507+ pure = S.fromPure
508+
509+ {-# INLINE (<*>) #-}
510+ (<*>) = S.crossApply
511+
512+ {-# INLINE liftA2 #-}
513+ liftA2 f x = (<*>) (fmap f x)
514+
515+ {-# INLINE (*>) #-}
516+ (*>) = S.crossApplySnd
517+
518+ {-# INLINE (<*) #-}
519+ (<*) = S.crossApplyFst
520+
521+-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
522+-- the monad instance of StreamD is slower than StreamK after foldr/build
523+-- fusion.
524+instance Monad m => Monad (S.StreamK m) where
525+ {-# INLINE return #-}
526+ return = pure
527+
528+ {-# INLINE (>>=) #-}
529+ (>>=) = flip S.concatMap
530+
531+{-# INLINE drainApplicative #-}
532+drainApplicative :: Monad m => Stream m Int -> m ()
533+drainApplicative s = drain $ do
419534 (+) <$> s <*> s
420535
421−{-# INLINE toNullNested #-}
422−toNullNested :: Monad m => Stream m Int -> m ()
423−toNullNested s = runStream $ do
536+{-# INLINE drainMonad #-}
537+drainMonad :: Monad m => Stream m Int -> m ()
538+drainMonad s = drain $ do
424539 x <- s
425540 y <- s
426541 return $ x + y
427542
428−{-# INLINE toNullNested3 #-}
429−toNullNested3 :: Monad m => Stream m Int -> m ()
430−toNullNested3 s = runStream $ do
543+{-# INLINE drainMonad3 #-}
544+drainMonad3 :: Monad m => Stream m Int -> m ()
545+drainMonad3 s = drain $ do
431546 x <- s
432547 y <- s
433548 z <- s
434549 return $ x + y + z
435550
436−{-# INLINE filterAllOutNested #-}
437−filterAllOutNested
551+{-# INLINE filterAllOutMonad #-}
552+filterAllOutMonad
438553 :: Monad m
439554 => Stream m Int -> m ()
440−filterAllOutNested str = runStream $ do
555+filterAllOutMonad str = drain $ do
441556 x <- str
442557 y <- str
443558 let s = x + y
@@ -445,11 +560,11 @@ filterAllOutNested str = runStream $ do
445560 then return s
446561 else S.nil
447562
448−{-# INLINE filterAllInNested #-}
449−filterAllInNested
563+{-# INLINE filterAllInMonad #-}
564+filterAllInMonad
450565 :: Monad m
451566 => Stream m Int -> m ()
452−filterAllInNested str = runStream $ do
567+filterAllInMonad str = drain $ do
453568 x <- str
454569 y <- str
455570 let s = x + y
@@ -461,9 +576,14 @@ filterAllInNested str = runStream $ do
461576-- Nested Composition Pure lists
462577-------------------------------------------------------------------------------
463578
464−{-# INLINE sourceUnfoldrList #-}
465−sourceUnfoldrList :: Int -> Int -> [Int]
466−sourceUnfoldrList maxval n = List.unfoldr step n
579+-- There are several list benchmarks here for comparison with lists. It is easy
580+-- and convenient to see the comparisons when they are here, otherwise we'll
581+-- have to add a separate module for list benchmarks with the same names and
582+-- then add a comparison in bench.sh.
583+
584+{-# INLINE unfoldrList #-}
585+unfoldrList :: Int -> Int -> [Int]
586+unfoldrList maxval n = List.unfoldr step n
467587 where
468588 step cnt =
469589 if cnt > n + maxval
@@ -514,298 +634,301 @@ filterAllInNestedList str = do
514634-------------------------------------------------------------------------------
515635
516636moduleName :: String
517−moduleName = "Data.Stream.StreamK"
637+moduleName = "Data.StreamK"
518638
519639o_1_space_generation :: Int -> Benchmark
520−o_1_space_generation value =
640+o_1_space_generation streamLen =
521641 bgroup "generation"
522− [ benchFold "unfoldr" toNull (sourceUnfoldr value)
523− , benchFold "unfoldrM" toNull (sourceUnfoldrM value)
524−
525− , benchFold "fromFoldable" toNull (sourceFromFoldable value)
526− , benchFold "fromFoldableM" toNull (sourceFromFoldableM value)
642+ [ benchFold "unfoldr" drain (unfoldr streamLen)
643+ , benchFold "unfoldrM" drain (unfoldrM streamLen)
644+ , benchFold "repeat" drain (repeat streamLen)
645+ , benchFold "repeatM" drain (repeatM streamLen)
646+ , benchFold "replicate" drain (replicate streamLen)
647+ , benchFold "replicateM" drain (replicateM streamLen)
648+ , benchFold "iterate" drain (iterate streamLen)
649+ , benchFold "iterateM" drain (iterateM streamLen)
650+
651+ , benchFold "fromFoldable" drain (fromFoldable streamLen)
652+ , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
527653
528654 -- appends
529− , benchFold "concatMapFoldableWith" toNull (sourceFoldMapWith value)
530− , benchFold "concatMapFoldableWithM" toNull (sourceFoldMapWithM value)
655+ , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
656+ , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
531657 ]
532658
533659o_1_space_elimination :: Int -> Benchmark
534−o_1_space_elimination value =
660+o_1_space_elimination streamLen =
535661 bgroup "elimination"
536− [ benchFold "toNull" toNull (sourceUnfoldrM value)
537− , benchFold "mapM_" mapM_ (sourceUnfoldrM value)
538− , benchFold "uncons" uncons (sourceUnfoldrM value)
539− , benchFold "init" init (sourceUnfoldrM value)
540− , benchFold "foldl'" foldl (sourceUnfoldrM value)
541− , benchFold "last" last (sourceUnfoldrM value)
662+ [ benchFold "toNull" drain (unfoldrM streamLen)
663+ , benchFold "mapM_" mapM_ (unfoldrM streamLen)
664+ , benchFold "uncons" uncons (unfoldrM streamLen)
665+ , benchFold "init" init (unfoldrM streamLen)
666+ , benchFold "foldl'" foldl' (unfoldrM streamLen)
667+ , benchFold "last" last (unfoldrM streamLen)
542668 ]
543669
544670o_1_space_nested :: Int -> Benchmark
545−o_1_space_nested value =
671+o_1_space_nested streamLen =
546672 bgroup "nested"
547− [ benchFold "toNullAp" toNullApNested (sourceUnfoldrMN value2)
548− , benchFold "toNull" toNullNested (sourceUnfoldrMN value2)
549− , benchFold "toNull3" toNullNested3 (sourceUnfoldrMN value3)
550− , benchFold "filterAllIn" filterAllInNested (sourceUnfoldrMN value2)
551− , benchFold "filterAllOut" filterAllOutNested (sourceUnfoldrMN value2)
552− , benchFold "toNullApPure" toNullApNested (sourceUnfoldrN value2)
553− , benchFold "toNullPure" toNullNested (sourceUnfoldrN value2)
554− , benchFold "toNull3Pure" toNullNested3 (sourceUnfoldrN value3)
555− , benchFold "filterAllInPure" filterAllInNested (sourceUnfoldrN value2)
556− , benchFold "filterAllOutPure" filterAllOutNested (sourceUnfoldrN value2)
673+ [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
674+ , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
675+ , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
676+ , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
677+ , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
678+ , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
679+ , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
680+ , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
681+ , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
682+ , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
557683 ]
558684 where
559− value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
560− value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
685+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
686+ streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
561687
562688o_1_space_transformation :: Int -> Benchmark
563−o_1_space_transformation value =
689+o_1_space_transformation streamLen =
564690 bgroup "transformation"
565− [ bgroup "X1"
566− [ benchFold "foldrS" (foldrS 1) (sourceUnfoldrM value)
567− , benchFold "scan" (scan 1) (sourceUnfoldrM value)
568− , benchFold "map" (map 1) (sourceUnfoldrM value)
569− , benchFold "fmap" (fmapK 1) (sourceUnfoldrM value)
570− , benchFold "mapM" (mapM 1) (sourceUnfoldrM value)
571− , benchFold "mapMSerial" (mapMSerial 1) (sourceUnfoldrM value)
691+ [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
692+ , benchFold "scanl'" (scanl' 1) (unfoldrM streamLen)
693+ , benchFold "map" (map 1) (unfoldrM streamLen)
694+ , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
695+ , benchFold "mapM" (mapM 1) (unfoldrM streamLen)
696+ , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
572697 ]
573− , bgroup "X4"
574− [ benchFold "scan" (scan 4) (sourceUnfoldrM value)
575− , benchFold "map" (map 4) (sourceUnfoldrM value)
576− , benchFold "fmap" (fmapK 4) (sourceUnfoldrM value)
577− , benchFold "mapM" (mapM 4) (sourceUnfoldrM value)
578− , benchFold "mapMSerial" (mapMSerial 4) (sourceUnfoldrM value)
698+
699+o_1_space_transformationX4 :: Int -> Benchmark
700+o_1_space_transformationX4 streamLen =
701+ bgroup "transformationX4"
702+ [ benchFold "scanl'" (scanl' 4) (unfoldrM streamLen)
703+ , benchFold "map" (map 4) (unfoldrM streamLen)
704+ , benchFold "fmap" (fmapK 4) (unfoldrM streamLen)
705+ , benchFold "mapM" (mapM 4) (unfoldrM streamLen)
706+ , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
579707 -- XXX this is horribly slow
580− -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)
708+ -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
581709 ]
582− ]
583710
584711o_1_space_concat :: Int -> Benchmark
585−o_1_space_concat value =
712+o_1_space_concat streamLen =
586713 bgroup "concat"
587714 [ benchIOSrc1 "concatMapPure (n of 1)"
588− (concatMapPure value 1)
715+ (concatMapPure streamLen 1)
589716 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
590− (concatMapPure value2 value2)
717+ (concatMapPure streamLen2 streamLen2)
591718 , benchIOSrc1 "concatMapPure (1 of n)"
592− (concatMapPure 1 value)
719+ (concatMapPure 1 streamLen)
593720
594721 , benchIOSrc1 "concatMap (n of 1)"
595− (concatMap value 1)
722+ (concatMap streamLen 1)
596723 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
597− (concatMap value2 value2)
724+ (concatMap streamLen2 streamLen2)
598725 , benchIOSrc1 "concatMap (1 of n)"
599− (concatMap 1 value)
726+ (concatMap 1 streamLen)
600727
601728 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
602− (concatMapRepl value2 value2)
729+ (concatMapRepl streamLen2 streamLen2)
603730
604731 -- This is for comparison with concatMapFoldableWith
605732 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
606− (S.drain . S.concatMapBy S.serial id . sourceConcatMapId value)
607−
608− , benchIOSrc1 "concatMapWith (n of 1)"
609− (concatStreamsWith value 1)
610− , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"
611− (concatStreamsWith value2 value2)
612− , benchIOSrc1 "concatMapWith (1 of n)"
613− (concatStreamsWith 1 value)
733+ (S.drain
734+ . S.concatMapWith S.append id
735+ . sourceConcatMapId streamLen)
736+
737+ , benchIOSrc1 "concatMapBy serial (n of 1)"
738+ (concatMapBySerial streamLen 1)
739+ , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
740+ (concatMapBySerial streamLen2 streamLen2)
741+ , benchIOSrc1 "concatMapBy serial (1 of n)"
742+ (concatMapBySerial 1 streamLen)
743+ , benchFold "sortBy" sortBy (unfoldrM streamLen)
614744 ]
615745 where
616− value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
746+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
617747
618748o_1_space_filtering :: Int -> Benchmark
619−o_1_space_filtering value =
749+o_1_space_filtering streamLen =
620750 bgroup "filtering"
621− [ bgroup "X1"
622− [ benchFold "filter-even" (filterEven 1) (sourceUnfoldrM value)
623− , benchFold "filter-all-out" (filterAllOut maxValue 1) (sourceUnfoldrM value)
624− , benchFold "filter-all-in" (filterAllIn maxValue 1) (sourceUnfoldrM value)
625− , benchFold "take-all" (takeAll maxValue 1) (sourceUnfoldrM value)
626− , benchFold "takeWhile-true" (takeWhileTrue maxValue 1) (sourceUnfoldrM value)
627− , benchFold "drop-one" (dropOne 1) (sourceUnfoldrM value)
628− , benchFold "drop-all" (dropAll maxValue 1) (sourceUnfoldrM value)
629− , benchFold "dropWhile-true" (dropWhileTrue maxValue 1) (sourceUnfoldrM value)
630− , benchFold "dropWhile-false" (dropWhileFalse 1) (sourceUnfoldrM value)
631− ]
632− , bgroup "X4"
633− [ benchFold "filter-even" (filterEven 4) (sourceUnfoldrM value)
634− , benchFold "filter-all-out" (filterAllOut maxValue 4) (sourceUnfoldrM value)
635− , benchFold "filter-all-in" (filterAllIn maxValue 4) (sourceUnfoldrM value)
636− , benchFold "take-all" (takeAll maxValue 4) (sourceUnfoldrM value)
637− , benchFold "takeWhile-true" (takeWhileTrue maxValue 4) (sourceUnfoldrM value)
638− , benchFold "drop-one" (dropOne 4) (sourceUnfoldrM value)
639− , benchFold "drop-all" (dropAll maxValue 4) (sourceUnfoldrM value)
640− , benchFold "dropWhile-true" (dropWhileTrue maxValue 4) (sourceUnfoldrM value)
641− , benchFold "dropWhile-false" (dropWhileFalse 4) (sourceUnfoldrM value)
751+ [ benchFold "filter-even" (filterEven 1) (unfoldrM streamLen)
752+ , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
753+ , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
754+ , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
755+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
756+ , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
757+ , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
758+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
759+ , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
642760 ]
643− ]
644− where
645−
646− maxValue = value
647761
762+o_1_space_filteringX4 :: Int -> Benchmark
763+o_1_space_filteringX4 streamLen =
764+ bgroup "filteringX4"
765+ [ benchFold "filter-even" (filterEven 4) (unfoldrM streamLen)
766+ , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
767+ , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
768+ , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
769+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
770+ , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
771+ , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
772+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
773+ , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
774+ ]
648775
649776o_1_space_zipping :: Int -> Benchmark
650−o_1_space_zipping value =
777+o_1_space_zipping streamLen =
651778 bgroup "zipping"
652− [ benchFold "zip" zip (sourceUnfoldrM value)
779+ [ benchFold "zipWith" zipWith (unfoldrM streamLen)
780+ , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
653781 ]
654782
655783o_1_space_mixed :: Int -> Benchmark
656−o_1_space_mixed value =
784+o_1_space_mixed streamLen =
657785 bgroup "mixed"
658− [ bgroup "X1"
659− [ benchFold "scan-map" (scanMap 1) (sourceUnfoldrM value)
660− , benchFold "drop-map" (dropMap 1) (sourceUnfoldrM value)
661− , benchFold "drop-scan" (dropScan 1) (sourceUnfoldrM value)
662− , benchFold "take-drop" (takeDrop maxValue 1) (sourceUnfoldrM value)
663− , benchFold "take-scan" (takeScan maxValue 1) (sourceUnfoldrM value)
664− , benchFold "take-map" (takeMap maxValue 1) (sourceUnfoldrM value)
665− , benchFold "filter-drop" (filterDrop maxValue 1) (sourceUnfoldrM value)
666− , benchFold "filter-take" (filterTake maxValue 1) (sourceUnfoldrM value)
667− , benchFold "filter-scan" (filterScan maxValue 1) (sourceUnfoldrM value)
668− , benchFold "filter-map" (filterMap maxValue 1) (sourceUnfoldrM value)
669− ]
670− , bgroup "X2"
671− [ benchFold "scan-map" (scanMap 2) (sourceUnfoldrM value)
672− , benchFold "drop-map" (dropMap 2) (sourceUnfoldrM value)
673− , benchFold "drop-scan" (dropScan 2) (sourceUnfoldrM value)
674− , benchFold "take-drop" (takeDrop maxValue 2) (sourceUnfoldrM value)
675− , benchFold "take-scan" (takeScan maxValue 2) (sourceUnfoldrM value)
676− , benchFold "take-map" (takeMap maxValue 2) (sourceUnfoldrM value)
677− , benchFold "filter-drop" (filterDrop maxValue 2) (sourceUnfoldrM value)
678− , benchFold "filter-take" (filterTake maxValue 2) (sourceUnfoldrM value)
679− , benchFold "filter-scan" (filterScan maxValue 2) (sourceUnfoldrM value)
680− , benchFold "filter-map" (filterMap maxValue 2) (sourceUnfoldrM value)
786+ [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
787+ , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
788+ , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
789+ , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
790+ , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
791+ , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
792+ , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
793+ , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
794+ , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
795+ , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
681796 ]
682− , bgroup "X4"
683− [ benchFold "scan-map" (scanMap 4) (sourceUnfoldrM value)
684− , benchFold "drop-map" (dropMap 4) (sourceUnfoldrM value)
685− , benchFold "drop-scan" (dropScan 4) (sourceUnfoldrM value)
686− , benchFold "take-drop" (takeDrop maxValue 4) (sourceUnfoldrM value)
687− , benchFold "take-scan" (takeScan maxValue 4) (sourceUnfoldrM value)
688− , benchFold "take-map" (takeMap maxValue 4) (sourceUnfoldrM value)
689− , benchFold "filter-drop" (filterDrop maxValue 4) (sourceUnfoldrM value)
690− , benchFold "filter-take" (filterTake maxValue 4) (sourceUnfoldrM value)
691− , benchFold "filter-scan" (filterScan maxValue 4) (sourceUnfoldrM value)
692− , benchFold "filter-map" (filterMap maxValue 4) (sourceUnfoldrM value)
797+
798+o_1_space_mixedX2 :: Int -> Benchmark
799+o_1_space_mixedX2 streamLen =
800+ bgroup "mixedX2"
801+ [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
802+ , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
803+ , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
804+ , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
805+ , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
806+ , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
807+ , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
808+ , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
809+ , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
810+ , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
693811 ]
694− ]
695− where
696812
697− maxValue = value
813+o_1_space_mixedX4 :: Int -> Benchmark
814+o_1_space_mixedX4 streamLen =
815+ bgroup "mixedX4"
816+ [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
817+ , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
818+ , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
819+ , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
820+ , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
821+ , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
822+ , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
823+ , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
824+ , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
825+ , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
826+ ]
698827
699828o_1_space_list :: Int -> Benchmark
700−o_1_space_list value =
829+o_1_space_list streamLen =
701830 bgroup "list"
702831 [ bgroup "elimination"
703− [ benchList "last" (\xs -> [List.last xs]) (sourceUnfoldrList value)
832+ [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
704833 ]
705834 , bgroup "nested"
706− [ benchList "toNullAp" toNullApNestedList (sourceUnfoldrList value2)
707− , benchList "toNull" toNullNestedList (sourceUnfoldrList value2)
708− , benchList "toNull3" toNullNestedList3 (sourceUnfoldrList value3)
709− , benchList "filterAllIn" filterAllInNestedList (sourceUnfoldrList value2)
710− , benchList "filterAllOut" filterAllOutNestedList (sourceUnfoldrList value2)
835+ [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
836+ , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
837+ , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
838+ , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
839+ , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
711840 ]
712841 ]
713842 where
714843
715− value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
716− value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
844+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
845+ streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
717846
718−o_1_space :: Benchmark
719−o_1_space =
847+o_1_space :: Int -> Benchmark
848+o_1_space streamLen =
720849 bgroup (o_1_space_prefix moduleName)
721− [ o_1_space_generation value
722− , o_1_space_elimination value
723− , o_1_space_nested value
724− , o_1_space_transformation value
725− , o_1_space_concat value
726− , o_1_space_filtering value
727− , o_1_space_zipping value
728− , o_1_space_mixed value
729− , o_1_space_list value
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
730863 ]
731− where
732− value = 100000
733864
734−o_n_heap :: [Benchmark]
735−o_n_heap =
736− [ bgroup (o_n_heap_prefix moduleName)
865+o_n_heap :: Int -> Benchmark
866+o_n_heap streamLen =
867+ bgroup (o_n_heap_prefix moduleName)
737868 [ bgroup "transformation"
738− [ benchFold "foldlS" (foldlS 1) (sourceUnfoldrM value)
869+ [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
739870 ]
740871 ]
741− ]
742− where
743−
744− value = 100000
745872
746873{-# INLINE benchK #-}
747874benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
748−benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= toNull . f
875+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
749876
750−o_n_stack :: [Benchmark]
751−o_n_stack =
752− [ bgroup (o_n_stack_prefix moduleName)
877+o_n_stack :: Int -> Int -> Int -> Benchmark
878+o_n_stack streamLen iterStreamLen maxIters =
879+ bgroup (o_n_stack_prefix moduleName)
753880 [ bgroup "elimination"
754− [ benchFold "tail" tail (sourceUnfoldrM value)
755− , benchFold "nullTail" nullTail (sourceUnfoldrM value)
756− , benchFold "headTail" headTail (sourceUnfoldrM value)
881+ [ benchFold "tail" tail (unfoldrM streamLen)
882+ , benchFold "nullTail" nullTail (unfoldrM streamLen)
883+ , benchFold "headTail" headTail (unfoldrM streamLen)
757884 ]
758885 , bgroup "transformation"
759886 [
760887 -- XXX why do these need so much stack
761− benchFold "intersperse" (intersperse maxValue 1) (sourceUnfoldrMN value2)
762− , benchFold "interspersePure" (intersperse maxValue 1) (sourceUnfoldrN value2)
888+ benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
889+ , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
763890 ]
764891 , bgroup "transformationX4"
765892 [
766− benchFold "intersperse" (intersperse maxValue 4) (sourceUnfoldrMN value16)
893+ benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
767894 ]
768895 , bgroup "iterated"
769896 [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
770897 , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
771898 , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
772− , benchK "takeAll" (iterateTakeAll maxValue iterStreamLen maxIters)
899+ , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
773900 , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
774− , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse maxValue iterStreamLen maxIters)
775− , benchK "dropWhileTrue" (iterateDropWhileTrue maxValue iterStreamLen maxIters)
901+ , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
902+ , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
776903 ]
777904 ]
778− ]
779905 where
906+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
907+ streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
780908
781− value = 100000
782− value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
783− value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
784− maxValue = value
785− maxIters = 10000
786− iterStreamLen = 10
787−
788−o_n_space :: [Benchmark]
789−o_n_space =
790− [ bgroup (o_n_space_prefix moduleName)
909+o_n_space :: Int -> Benchmark
910+o_n_space streamLen =
911+ bgroup (o_n_space_prefix moduleName)
791912 [ bgroup "elimination"
792− [ benchFold "toList" toList (sourceUnfoldrM value)
913+ [ benchFold "toList" toList (unfoldrM streamLen)
793914 ]
794915 ]
795− ]
796− where
797−
798− value = 100000
799−
800916
801917{-# INLINE benchList #-}
802918benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
803919benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
804920
805921main :: IO ()
806−main = defaultMain $ concat
807− [ [ o_1_space ]
808− , o_n_stack
809− , o_n_heap
810− , o_n_space
811− ]
922+main =
923+ defaultMain
924+ [ o_1_space streamLen
925+ , o_n_stack streamLen iterStreamLen maxIters
926+ , o_n_heap streamLen
927+ , o_n_space streamLen
928+ ]
929+
930+ where
931+
932+ streamLen = 100000
933+ maxIters = 10000
934+ iterStreamLen = 10