@@ -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,112 +45,163 @@ import Streamly.Benchmark.Common
4045import Test.Inspection
4146#endif
4247
43−value, value2, value3, value16, maxValue :: Int
44−value = 100000
45−value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
46−value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
47−value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
48−maxValue = value
49−
50−-------------------------------------------------------------------------------
51−-- Benchmark ops
52−-------------------------------------------------------------------------------
53−
54−{-# INLINE toNull #-}
55−{-# INLINE uncons #-}
56−{-# INLINE nullTail #-}
57−{-# INLINE headTail #-}
58−{-# INLINE zip #-}
59−toNull, uncons, nullTail, headTail, zip
60− :: Monad m
61− => Stream m Int -> m ()
62−
63−{-# INLINE toList #-}
64−toList :: Monad m => Stream m Int -> m [Int]
65−{-# INLINE foldl #-}
66−foldl :: Monad m => Stream m Int -> m Int
67−{-# INLINE last #-}
68−last :: Monad m => Stream m Int -> m (Maybe Int)
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+-}
69115
70116-------------------------------------------------------------------------------
71117-- Stream generation and elimination
72118-------------------------------------------------------------------------------
73119
74−type Stream m a = S.Stream m a
75−
76−{-# INLINE sourceUnfoldr #-}
77−sourceUnfoldr :: Int -> Stream m Int
78−sourceUnfoldr n = S.unfoldr step n
79− where
80− step cnt =
81− if cnt > n + value
82− then Nothing
83− else Just (cnt, cnt + 1)
120+type Stream m a = S.StreamK m a
84121
85−{-# INLINE sourceUnfoldrN #-}
86−sourceUnfoldrN :: Int -> Int -> Stream m Int
87−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
88125 where
89126 step cnt =
90− if cnt > n + m
127+ if cnt > n + streamLen
91128 then Nothing
92129 else Just (cnt, cnt + 1)
93130
94−{-# INLINE sourceUnfoldrM #-}
95−sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int
96−sourceUnfoldrM 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
97134 where
98135 step cnt =
99− if cnt > n + value
136+ if cnt > n + streamLen
100137 then return Nothing
101138 else return (Just (cnt, cnt + 1))
102139
103−{-# INLINE sourceUnfoldrMN #-}
104−sourceUnfoldrMN :: S.MonadAsync m => Int -> Int -> Stream m Int
105−sourceUnfoldrMN m n = S.unfoldrM step n
106− where
107− step cnt =
108− if cnt > n + m
109− then return Nothing
110− else return (Just (cnt, cnt + 1))
140+{-# INLINE repeat #-}
141+repeat :: Int -> Int -> Stream m Int
142+repeat streamLen = S.take streamLen . S.repeat
111143
112−{-# INLINE sourceFromFoldable #-}
113−sourceFromFoldable :: Int -> Stream m Int
114−sourceFromFoldable 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
115147
116−{-# INLINE sourceFromFoldableM #-}
117−sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
118−sourceFromFoldableM n =
119− 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
120151
121−{-# INLINABLE concatMapFoldableWith #-}
122−concatMapFoldableWith :: (S.IsStream t, Foldable f)
123− => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b
124−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
155+
156+{-# INLINE iterate #-}
157+iterate :: Int -> Int -> Stream m Int
158+iterate streamLen = S.take streamLen . S.iterate (+1)
125159
126−{-# INLINE sourceFoldMapWith #-}
127−sourceFoldMapWith :: Int -> Stream m Int
128−sourceFoldMapWith n = concatMapFoldableWith S.serial S.yield [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
129163
130−{-# INLINE sourceFoldMapWithM #-}
131−sourceFoldMapWithM :: Monad m => Int -> Stream m Int
132−sourceFoldMapWithM n =
133− concatMapFoldableWith S.serial (S.yieldM . return) [n..n+value]
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]
134190
135191-------------------------------------------------------------------------------
136192-- Elimination
137193-------------------------------------------------------------------------------
138194
139−{-# INLINE runStream #-}
140−runStream :: Monad m => Stream m a -> m ()
141−runStream = S.drain
142−-- runStream = S.mapM_ (\_ -> return ())
195+{-# INLINE drain #-}
196+drain :: Monad m => Stream m a -> m ()
197+drain = S.drain
143198
144199{-# INLINE mapM_ #-}
145200mapM_ :: Monad m => Stream m a -> m ()
146201mapM_ = S.mapM_ (\_ -> return ())
147202
148−toNull = runStream
203+{-# INLINE uncons #-}
204+uncons :: Monad m => Stream m Int -> m ()
149205uncons s = do
150206 r <- S.uncons s
151207 case r of
@@ -153,167 +209,238 @@ uncons s = do
153209 Just (_, t) -> uncons t
154210
155211{-# INLINE init #-}
156−init :: (Monad m, S.IsStream t) => t m a -> m ()
212+init :: Monad m => Stream m a -> m ()
157213init s = do
158214 t <- S.init s
159215 P.mapM_ S.drain t
160216
161217{-# INLINE tail #-}
162−tail :: (Monad m, S.IsStream t) => t m a -> m ()
218+tail :: Monad m => Stream m a -> m ()
163219tail s = S.tail s >>= P.mapM_ tail
164220
221+{-# INLINE nullTail #-}
222+nullTail :: Monad m => Stream m Int -> m ()
165223nullTail s = do
166224 r <- S.null s
167225 when (not r) $ S.tail s >>= P.mapM_ nullTail
168226
227+{-# INLINE headTail #-}
228+headTail :: Monad m => Stream m Int -> m ()
169229headTail s = do
170230 h <- S.head s
171231 when (isJust h) $ S.tail s >>= P.mapM_ headTail
172232
233+{-# INLINE toList #-}
234+toList :: Monad m => Stream m Int -> m [Int]
173235toList = S.toList
174−foldl = S.foldl' (+) 0
175−last = S.last
236+
237+{-# INLINE foldl' #-}
238+foldl' :: Monad m => Stream m Int -> m Int
239+foldl' = S.foldl' (+) 0
240+
241+{-# INLINE last #-}
242+last :: Monad m => Stream m Int -> m (Maybe Int)
243+last = S.last
176244
177245-------------------------------------------------------------------------------
178246-- Transformation
179247-------------------------------------------------------------------------------
180248
181−{-# INLINE transform #-}
182−transform :: Monad m => Stream m a -> m ()
183−transform = runStream
184−
185249{-# INLINE composeN #-}
186250composeN
187251 :: Monad m
188252 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
189253composeN n f =
190254 case n of
191− 1 -> transform . f
192− 2 -> transform . f . f
193− 3 -> transform . f . f . f
194− 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
195259 _ -> undefined
196260
197−{-# INLINE scan #-}
261+{-# INLINE scanl' #-}
262+scanl' :: Monad m => Int -> Stream m Int -> m ()
263+scanl' n = composeN n $ S.scanl' (+) 0
264+
198265{-# INLINE map #-}
266+map :: Monad m => Int -> Stream m Int -> m ()
267+map n = composeN n $ S.map (+ 1)
268+
199269{-# INLINE fmapK #-}
270+fmapK :: Monad m => Int -> Stream m Int -> m ()
271+fmapK n = composeN n $ P.fmap (+ 1)
272+
273+{-# INLINE mapM #-}
274+mapM :: Monad m => Int -> Stream m Int -> m ()
275+mapM n = composeN n $ S.mapMWith S.consM return
276+
277+{-# INLINE mapMSerial #-}
278+mapMSerial :: Monad m => Int -> Stream m Int -> m ()
279+mapMSerial n = composeN n $ S.mapMSerial return
280+
200281{-# INLINE filterEven #-}
282+filterEven :: Monad m => Int -> Stream m Int -> m ()
283+filterEven n = composeN n $ S.filter even
284+
201285{-# INLINE filterAllOut #-}
286+filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
287+filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
288+
202289{-# INLINE filterAllIn #-}
290+filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
291+filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
292+
203293{-# INLINE _takeOne #-}
294+_takeOne :: Monad m => Int -> Stream m Int -> m ()
295+_takeOne n = composeN n $ S.take 1
296+
204297{-# INLINE takeAll #-}
298+takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
299+takeAll streamLen n = composeN n $ S.take streamLen
300+
205301{-# INLINE takeWhileTrue #-}
302+takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
303+takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
304+
206305{-# INLINE dropOne #-}
306+dropOne :: Monad m => Int -> Stream m Int -> m ()
307+dropOne n = composeN n $ S.drop 1
308+
207309{-# INLINE dropAll #-}
310+dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
311+dropAll streamLen n = composeN n $ S.drop streamLen
312+
208313{-# INLINE dropWhileTrue #-}
314+dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
315+dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
316+
209317{-# INLINE dropWhileFalse #-}
318+dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
319+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
320+
210321{-# INLINE foldrS #-}
322+foldrS :: Monad m => Int -> Stream m Int -> m ()
323+foldrS n = composeN n $ S.foldrS S.cons S.nil
324+
211325{-# INLINE foldlS #-}
212−scan, map, fmapK, filterEven, filterAllOut,
213− filterAllIn, _takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
214− dropWhileTrue, dropWhileFalse, foldrS, foldlS
215− :: Monad m
216− => Int -> Stream m Int -> m ()
326+foldlS :: Monad m => Int -> Stream m Int -> m ()
327+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
217328
218−{-# INLINE mapM #-}
219−{-# INLINE mapMSerial #-}
220329{-# INLINE intersperse #-}
221−mapM, mapMSerial, intersperse
222− :: S.MonadAsync m => Int -> Stream m Int -> m ()
223−
224−scan n = composeN n $ S.scanl' (+) 0
225−map n = composeN n $ P.fmap (+1)
226−fmapK n = composeN n $ P.fmap (+1)
227−mapM n = composeN n $ S.mapM return
228−mapMSerial n = composeN n $ S.mapMSerial return
229−filterEven n = composeN n $ S.filter even
230−filterAllOut n = composeN n $ S.filter (> maxValue)
231−filterAllIn n = composeN n $ S.filter (<= maxValue)
232−_takeOne n = composeN n $ S.take 1
233−takeAll n = composeN n $ S.take maxValue
234−takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
235−dropOne n = composeN n $ S.drop 1
236−dropAll n = composeN n $ S.drop maxValue
237−dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
238−dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
239−foldrS n = composeN n $ S.foldrS S.cons S.nil
240−foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
241−intersperse 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
242332
243333-------------------------------------------------------------------------------
244334-- Iteration
245335-------------------------------------------------------------------------------
246336
247−iterStreamLen, maxIters :: Int
248−iterStreamLen = 10
249−maxIters = 10000
250−
251337{-# INLINE iterateSource #-}
252338iterateSource
253− :: S.MonadAsync m
254− => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
255−iterateSource 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)
256341 where
257342 f (0 :: Int) m = g m
258343 f x m = g (f (x P.- 1) m)
259344
260−{-# INLINE iterateMapM #-}
345+-- this is quadratic
261346{-# INLINE iterateScan #-}
347+iterateScan :: Monad m => Int -> Int -> Int -> Stream m Int
348+iterateScan iterStreamLen maxIters =
349+ iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
350+
351+-- this is quadratic
352+{-# INLINE iterateDropWhileFalse #-}
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)
356+
357+{-# INLINE iterateMapM #-}
358+iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
359+iterateMapM iterStreamLen =
360+ iterateSource iterStreamLen (S.mapMWith S.consM return)
361+
262362{-# INLINE iterateFilterEven #-}
363+iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
364+iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
365+
263366{-# INLINE iterateTakeAll #-}
264−{-# INLINE iterateDropOne #-}
265−{-# INLINE iterateDropWhileFalse #-}
266−{-# INLINE iterateDropWhileTrue #-}
267−iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
268− iterateDropWhileFalse, iterateDropWhileTrue
269− :: S.MonadAsync m
270− => Int -> Stream m Int
367+iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
368+iterateTakeAll streamLen iterStreamLen =
369+ iterateSource iterStreamLen (S.take streamLen)
271370
272−-- this is quadratic
273−iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
274−iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
275− (maxIters `div` 10)
371+{-# INLINE iterateDropOne #-}
372+iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
373+iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
276374
277−iterateMapM = iterateSource (S.mapM return) maxIters
278−iterateFilterEven = iterateSource (S.filter even) maxIters
279−iterateTakeAll = iterateSource (S.take maxValue) maxIters
280−iterateDropOne = iterateSource (S.drop 1) maxIters
281−iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
375+{-# INLINE iterateDropWhileTrue #-}
376+iterateDropWhileTrue ::
377+ Monad m => Int -> Int -> Int -> Int -> Stream m Int
378+iterateDropWhileTrue streamLen iterStreamLen =
379+ iterateSource iterStreamLen (S.dropWhile (<= streamLen))
282380
283381-------------------------------------------------------------------------------
284382-- Zipping
285383-------------------------------------------------------------------------------
286384
287−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
288400
289401-------------------------------------------------------------------------------
290402-- Mixed Composition
291403-------------------------------------------------------------------------------
292404
293405{-# INLINE scanMap #-}
406+scanMap :: Monad m => Int -> Stream m Int -> m ()
407+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
408+
294409{-# INLINE dropMap #-}
410+dropMap :: Monad m => Int -> Stream m Int -> m ()
411+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
412+
295413{-# INLINE dropScan #-}
414+dropScan :: Monad m => Int -> Stream m Int -> m ()
415+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
416+
296417{-# INLINE takeDrop #-}
418+takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
419+takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
420+
297421{-# INLINE takeScan #-}
422+takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
423+takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
424+
298425{-# INLINE takeMap #-}
426+takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
427+takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
428+
299429{-# INLINE filterDrop #-}
430+filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
431+filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
432+
300433{-# INLINE filterTake #-}
434+filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
435+filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
436+
301437{-# INLINE filterScan #-}
302−{-# INLINE filterMap #-}
303−scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
304− filterTake, filterScan, filterMap
305− :: Monad m => Int -> Stream m Int -> m ()
306−
307−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
308−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
309−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
310−takeDrop n = composeN n $ S.drop 1 . S.take maxValue
311−takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
312−takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
313−filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
314−filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
438+filterScan :: Monad m => Int -> Stream m Int -> m ()
315439filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
316−filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
440+
441+{-# INLINE filterMap #-}
442+filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
443+filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
317444
318445-------------------------------------------------------------------------------
319446-- ConcatMap
@@ -325,8 +452,8 @@ filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
325452concatMap :: Int -> Int -> Int -> IO ()
326453concatMap outer inner n =
327454 S.drain $ S.concatMap
328− (\_ -> sourceUnfoldrMN inner n)
329− (sourceUnfoldrMN outer n)
455+ (\_ -> unfoldrM inner n)
456+ (unfoldrM outer n)
330457
331458#ifdef INSPECTION
332459inspect $ hasNoTypeClasses 'concatMap
@@ -338,8 +465,8 @@ inspect $ hasNoTypeClasses 'concatMap
338465concatMapPure :: Int -> Int -> Int -> IO ()
339466concatMapPure outer inner n =
340467 S.drain $ S.concatMap
341− (\_ -> sourceUnfoldrN inner n)
342− (sourceUnfoldrN outer n)
468+ (\_ -> unfoldr inner n)
469+ (unfoldr outer n)
343470
344471#ifdef INSPECTION
345472inspect $ hasNoTypeClasses 'concatMapPure
@@ -350,7 +477,7 @@ inspect $ hasNoTypeClasses 'concatMapPure
350477{-# INLINE concatMapRepl #-}
351478concatMapRepl :: Int -> Int -> Int -> IO ()
352479concatMapRepl outer inner n =
353− S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrMN outer n)
480+ S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
354481
355482#ifdef INSPECTION
356483inspect $ hasNoTypeClasses 'concatMapRepl
@@ -362,44 +489,70 @@ inspect $ hasNoTypeClasses 'concatMapRepl
362489sourceConcatMapId :: Monad m
363490 => Int -> Int -> Stream m (Stream m Int)
364491sourceConcatMapId val n =
365− S.fromFoldable $ fmap (S.yieldM . return) [n..n+val]
492+ S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
366493
367−{-# INLINE concatStreamsWith #-}
368−concatStreamsWith :: Int -> Int -> Int -> IO ()
369−concatStreamsWith outer inner n =
370− S.drain $ S.concatMapBy S.serial
371− (sourceUnfoldrMN inner)
372− (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)
373500
374501-------------------------------------------------------------------------------
375502-- Nested Composition
376503-------------------------------------------------------------------------------
377504
378−{-# INLINE toNullApNested #-}
379−toNullApNested :: Monad m => Stream m Int -> m ()
380−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
381534 (+) <$> s <*> s
382535
383−{-# INLINE toNullNested #-}
384−toNullNested :: Monad m => Stream m Int -> m ()
385−toNullNested s = runStream $ do
536+{-# INLINE drainMonad #-}
537+drainMonad :: Monad m => Stream m Int -> m ()
538+drainMonad s = drain $ do
386539 x <- s
387540 y <- s
388541 return $ x + y
389542
390−{-# INLINE toNullNested3 #-}
391−toNullNested3 :: Monad m => Stream m Int -> m ()
392−toNullNested3 s = runStream $ do
543+{-# INLINE drainMonad3 #-}
544+drainMonad3 :: Monad m => Stream m Int -> m ()
545+drainMonad3 s = drain $ do
393546 x <- s
394547 y <- s
395548 z <- s
396549 return $ x + y + z
397550
398−{-# INLINE filterAllOutNested #-}
399−filterAllOutNested
551+{-# INLINE filterAllOutMonad #-}
552+filterAllOutMonad
400553 :: Monad m
401554 => Stream m Int -> m ()
402−filterAllOutNested str = runStream $ do
555+filterAllOutMonad str = drain $ do
403556 x <- str
404557 y <- str
405558 let s = x + y
@@ -407,11 +560,11 @@ filterAllOutNested str = runStream $ do
407560 then return s
408561 else S.nil
409562
410−{-# INLINE filterAllInNested #-}
411−filterAllInNested
563+{-# INLINE filterAllInMonad #-}
564+filterAllInMonad
412565 :: Monad m
413566 => Stream m Int -> m ()
414−filterAllInNested str = runStream $ do
567+filterAllInMonad str = drain $ do
415568 x <- str
416569 y <- str
417570 let s = x + y
@@ -423,9 +576,14 @@ filterAllInNested str = runStream $ do
423576-- Nested Composition Pure lists
424577-------------------------------------------------------------------------------
425578
426−{-# INLINE sourceUnfoldrList #-}
427−sourceUnfoldrList :: Int -> Int -> [Int]
428−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
429587 where
430588 step cnt =
431589 if cnt > n + maxval
@@ -476,229 +634,301 @@ filterAllInNestedList str = do
476634-------------------------------------------------------------------------------
477635
478636moduleName :: String
479−moduleName = "Data.Stream.StreamK"
480−
481−o_1_space :: [Benchmark]
482−o_1_space =
483− [ bgroup (o_1_space_prefix moduleName)
484− [ bgroup "generation"
485− [ benchFold "unfoldr" toNull sourceUnfoldr
486− , benchFold "unfoldrM" toNull sourceUnfoldrM
487−
488− , benchFold "fromFoldable" toNull sourceFromFoldable
489− , benchFold "fromFoldableM" toNull sourceFromFoldableM
637+moduleName = "Data.StreamK"
638+
639+o_1_space_generation :: Int -> Benchmark
640+o_1_space_generation streamLen =
641+ bgroup "generation"
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)
490653
491654 -- appends
492− , benchFold "concatMapFoldableWith" toNull sourceFoldMapWith
493− , benchFold "concatMapFoldableWithM" toNull sourceFoldMapWithM
655+ , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
656+ , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
494657 ]
495− , bgroup "elimination"
496− [ benchFold "toNull" toNull sourceUnfoldrM
497− , benchFold "mapM_" mapM_ sourceUnfoldrM
498− , benchFold "uncons" uncons sourceUnfoldrM
499− , benchFold "init" init sourceUnfoldrM
500− , benchFold "foldl'" foldl sourceUnfoldrM
501− , benchFold "last" last sourceUnfoldrM
658+
659+o_1_space_elimination :: Int -> Benchmark
660+o_1_space_elimination streamLen =
661+ bgroup "elimination"
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)
502668 ]
503− , bgroup "nested"
504− [ benchFold "toNullAp" toNullApNested (sourceUnfoldrMN value2)
505− , benchFold "toNull" toNullNested (sourceUnfoldrMN value2)
506− , benchFold "toNull3" toNullNested3 (sourceUnfoldrMN value3)
507− , benchFold "filterAllIn" filterAllInNested (sourceUnfoldrMN value2)
508− , benchFold "filterAllOut" filterAllOutNested (sourceUnfoldrMN value2)
509− , benchFold "toNullApPure" toNullApNested (sourceUnfoldrN value2)
510− , benchFold "toNullPure" toNullNested (sourceUnfoldrN value2)
511− , benchFold "toNull3Pure" toNullNested3 (sourceUnfoldrN value3)
512− , benchFold "filterAllInPure" filterAllInNested (sourceUnfoldrN value2)
513− , benchFold "filterAllOutPure" filterAllOutNested (sourceUnfoldrN value2)
669+
670+o_1_space_nested :: Int -> Benchmark
671+o_1_space_nested streamLen =
672+ bgroup "nested"
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)
514683 ]
515− , bgroup "transformation"
516− [ benchFold "foldrS" (foldrS 1) sourceUnfoldrM
517− , benchFold "scan" (scan 1) sourceUnfoldrM
518− , benchFold "map" (map 1) sourceUnfoldrM
519− , benchFold "fmap" (fmapK 1) sourceUnfoldrM
520− , benchFold "mapM" (mapM 1) sourceUnfoldrM
521− , benchFold "mapMSerial" (mapMSerial 1) sourceUnfoldrM
684+ where
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
687+
688+o_1_space_transformation :: Int -> Benchmark
689+o_1_space_transformation streamLen =
690+ bgroup "transformation"
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)
522697 ]
523− , bgroup "transformationX4"
524− [ benchFold "scan" (scan 4) sourceUnfoldrM
525− , benchFold "map" (map 4) sourceUnfoldrM
526− , benchFold "fmap" (fmapK 4) sourceUnfoldrM
527− , benchFold "mapM" (mapM 4) sourceUnfoldrM
528− , benchFold "mapMSerial" (mapMSerial 4) sourceUnfoldrM
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)
529707 -- XXX this is horribly slow
530− -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)
708+ -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
531709 ]
532− , bgroup "concat"
710+
711+o_1_space_concat :: Int -> Benchmark
712+o_1_space_concat streamLen =
713+ bgroup "concat"
533714 [ benchIOSrc1 "concatMapPure (n of 1)"
534− (concatMapPure value 1)
715+ (concatMapPure streamLen 1)
535716 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
536− (concatMapPure value2 value2)
717+ (concatMapPure streamLen2 streamLen2)
537718 , benchIOSrc1 "concatMapPure (1 of n)"
538− (concatMapPure 1 value)
719+ (concatMapPure 1 streamLen)
539720
540721 , benchIOSrc1 "concatMap (n of 1)"
541− (concatMap value 1)
722+ (concatMap streamLen 1)
542723 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
543− (concatMap value2 value2)
724+ (concatMap streamLen2 streamLen2)
544725 , benchIOSrc1 "concatMap (1 of n)"
545− (concatMap 1 value)
726+ (concatMap 1 streamLen)
546727
547728 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
548− (concatMapRepl value2 value2)
729+ (concatMapRepl streamLen2 streamLen2)
549730
550731 -- This is for comparison with concatMapFoldableWith
551732 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
552− (S.drain . S.concatMapBy S.serial id . sourceConcatMapId value)
553−
554− , benchIOSrc1 "concatMapWith (n of 1)"
555− (concatStreamsWith value 1)
556− , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"
557− (concatStreamsWith value2 value2)
558− , benchIOSrc1 "concatMapWith (1 of n)"
559− (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)
560744 ]
561− , bgroup "filtering"
562− [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
563− , benchFold "filter-all-out" (filterAllOut 1) sourceUnfoldrM
564− , benchFold "filter-all-in" (filterAllIn 1) sourceUnfoldrM
565− , benchFold "take-all" (takeAll 1) sourceUnfoldrM
566− , benchFold "takeWhile-true" (takeWhileTrue 1) sourceUnfoldrM
567− , benchFold "drop-one" (dropOne 1) sourceUnfoldrM
568− , benchFold "drop-all" (dropAll 1) sourceUnfoldrM
569− , benchFold "dropWhile-true" (dropWhileTrue 1) sourceUnfoldrM
570− , benchFold "dropWhile-false" (dropWhileFalse 1) sourceUnfoldrM
745+ where
746+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
747+
748+o_1_space_filtering :: Int -> Benchmark
749+o_1_space_filtering streamLen =
750+ bgroup "filtering"
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)
571760 ]
572− , bgroup "filteringX4"
573− [ benchFold "filter-even" (filterEven 4) sourceUnfoldrM
574− , benchFold "filter-all-out" (filterAllOut 4) sourceUnfoldrM
575− , benchFold "filter-all-in" (filterAllIn 4) sourceUnfoldrM
576− , benchFold "take-all" (takeAll 4) sourceUnfoldrM
577− , benchFold "takeWhile-true" (takeWhileTrue 4) sourceUnfoldrM
578− , benchFold "drop-one" (dropOne 4) sourceUnfoldrM
579− , benchFold "drop-all" (dropAll 4) sourceUnfoldrM
580− , benchFold "dropWhile-true" (dropWhileTrue 4) sourceUnfoldrM
581− , benchFold "dropWhile-false" (dropWhileFalse 4) sourceUnfoldrM
761+
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)
582774 ]
583− , bgroup "zipping"
584− [ benchFold "zip" zip sourceUnfoldrM
775+
776+o_1_space_zipping :: Int -> Benchmark
777+o_1_space_zipping streamLen =
778+ bgroup "zipping"
779+ [ benchFold "zipWith" zipWith (unfoldrM streamLen)
780+ , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
585781 ]
586− , bgroup "mixed"
587− [ benchFold "scan-map" (scanMap 1) sourceUnfoldrM
588− , benchFold "drop-map" (dropMap 1) sourceUnfoldrM
589− , benchFold "drop-scan" (dropScan 1) sourceUnfoldrM
590− , benchFold "take-drop" (takeDrop 1) sourceUnfoldrM
591− , benchFold "take-scan" (takeScan 1) sourceUnfoldrM
592− , benchFold "take-map" (takeMap 1) sourceUnfoldrM
593− , benchFold "filter-drop" (filterDrop 1) sourceUnfoldrM
594− , benchFold "filter-take" (filterTake 1) sourceUnfoldrM
595− , benchFold "filter-scan" (filterScan 1) sourceUnfoldrM
596− , benchFold "filter-map" (filterMap 1) sourceUnfoldrM
782+
783+o_1_space_mixed :: Int -> Benchmark
784+o_1_space_mixed streamLen =
785+ bgroup "mixed"
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)
597796 ]
598− , bgroup "mixedX2"
599− [ benchFold "scan-map" (scanMap 2) sourceUnfoldrM
600− , benchFold "drop-map" (dropMap 2) sourceUnfoldrM
601− , benchFold "drop-scan" (dropScan 2) sourceUnfoldrM
602− , benchFold "take-drop" (takeDrop 2) sourceUnfoldrM
603− , benchFold "take-scan" (takeScan 2) sourceUnfoldrM
604− , benchFold "take-map" (takeMap 2) sourceUnfoldrM
605− , benchFold "filter-drop" (filterDrop 2) sourceUnfoldrM
606− , benchFold "filter-take" (filterTake 2) sourceUnfoldrM
607− , benchFold "filter-scan" (filterScan 2) sourceUnfoldrM
608− , benchFold "filter-map" (filterMap 2) sourceUnfoldrM
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)
609811 ]
610− , bgroup "mixedX4"
611− [ benchFold "scan-map" (scanMap 4) sourceUnfoldrM
612− , benchFold "drop-map" (dropMap 4) sourceUnfoldrM
613− , benchFold "drop-scan" (dropScan 4) sourceUnfoldrM
614− , benchFold "take-drop" (takeDrop 4) sourceUnfoldrM
615− , benchFold "take-scan" (takeScan 4) sourceUnfoldrM
616− , benchFold "take-map" (takeMap 4) sourceUnfoldrM
617− , benchFold "filter-drop" (filterDrop 4) sourceUnfoldrM
618− , benchFold "filter-take" (filterTake 4) sourceUnfoldrM
619− , benchFold "filter-scan" (filterScan 4) sourceUnfoldrM
620− , benchFold "filter-map" (filterMap 4) sourceUnfoldrM
812+
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+ ]
827+
828+o_1_space_list :: Int -> Benchmark
829+o_1_space_list streamLen =
830+ bgroup "list"
831+ [ bgroup "elimination"
832+ [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
833+ ]
834+ , bgroup "nested"
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)
621840 ]
622841 ]
623− ]
842+ where
843+
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
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+ ]
624864
625−o_n_heap :: [Benchmark]
626−o_n_heap =
627− [ bgroup (o_n_heap_prefix moduleName)
865+o_n_heap :: Int -> Benchmark
866+o_n_heap streamLen =
867+ bgroup (o_n_heap_prefix moduleName)
628868 [ bgroup "transformation"
629− [ benchFold "foldlS" (foldlS 1) sourceUnfoldrM
869+ [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
630870 ]
631871 ]
632− ]
633872
634873{-# INLINE benchK #-}
635874benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
636−benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= toNull . f
875+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
637876
638−o_n_stack :: [Benchmark]
639−o_n_stack =
640− [ 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)
641880 [ bgroup "elimination"
642− [ benchFold "tail" tail sourceUnfoldrM
643− , benchFold "nullTail" nullTail sourceUnfoldrM
644− , benchFold "headTail" headTail sourceUnfoldrM
881+ [ benchFold "tail" tail (unfoldrM streamLen)
882+ , benchFold "nullTail" nullTail (unfoldrM streamLen)
883+ , benchFold "headTail" headTail (unfoldrM streamLen)
645884 ]
646885 , bgroup "transformation"
647886 [
648887 -- XXX why do these need so much stack
649− benchFold "intersperse" (intersperse 1) (sourceUnfoldrMN value2)
650− , benchFold "interspersePure" (intersperse 1) (sourceUnfoldrN value2)
888+ benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
889+ , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
651890 ]
652891 , bgroup "transformationX4"
653892 [
654− benchFold "intersperse" (intersperse 4) (sourceUnfoldrMN value16)
893+ benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
655894 ]
656895 , bgroup "iterated"
657− [ benchK "mapM" iterateMapM
658− , benchK "scan(1/10)" iterateScan
659− , benchK "filterEven" iterateFilterEven
660− , benchK "takeAll" iterateTakeAll
661− , benchK "dropOne" iterateDropOne
662− , benchK "dropWhileFalse(1/10)" iterateDropWhileFalse
663− , benchK "dropWhileTrue" iterateDropWhileTrue
896+ [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
897+ , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
898+ , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
899+ , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
900+ , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
901+ , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
902+ , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
664903 ]
665904 ]
666− ]
905+ 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
667908
668−o_n_space :: [Benchmark]
669−o_n_space =
670− [ bgroup (o_n_space_prefix moduleName)
909+o_n_space :: Int -> Benchmark
910+o_n_space streamLen =
911+ bgroup (o_n_space_prefix moduleName)
671912 [ bgroup "elimination"
672− [ benchFold "toList" toList sourceUnfoldrM
913+ [ benchFold "toList" toList (unfoldrM streamLen)
673914 ]
674915 ]
675− ]
676916
677917{-# INLINE benchList #-}
678918benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
679919benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
680920
681−o_1_space_list :: [Benchmark]
682−o_1_space_list =
683− [ bgroup "list"
684− [ bgroup "elimination"
685− [ benchList "last" (\xs -> [List.last xs]) (sourceUnfoldrList value)
686− ]
687− , bgroup "nested"
688− [ benchList "toNullAp" toNullApNestedList (sourceUnfoldrList value2)
689− , benchList "toNull" toNullNestedList (sourceUnfoldrList value2)
690− , benchList "toNull3" toNullNestedList3 (sourceUnfoldrList value3)
691− , benchList "filterAllIn" filterAllInNestedList (sourceUnfoldrList value2)
692− , benchList "filterAllOut" filterAllOutNestedList (sourceUnfoldrList value2)
921+main :: IO ()
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
693928 ]
694− ]
695− ]
696929
697−main :: IO ()
698−main = defaultMain $ concat
699− [ o_1_space
700− , [bgroup (o_1_space_prefix moduleName) o_1_space_list]
701− , o_n_stack
702− , o_n_heap
703− , o_n_space
704− ]
930+ where
931+
932+ streamLen = 100000
933+ maxIters = 10000
934+ iterStreamLen = 10