@@ -1,207 +1,139 @@
11-- |
22-- Module : Streamly.Benchmark.Data.Stream.StreamK
3−-- Copyright : (c) 2018 Composewell Technologies
3+-- Copyright : (c) 2018 Harendra Kumar
44--
55-- License : BSD3
66-- Maintainer : streamly@composewell.com
77
8−{-# LANGUAGE CPP #-}
98{-# LANGUAGE FlexibleContexts #-}
109{-# LANGUAGE ScopedTypeVariables #-}
11−{-# OPTIONS_GHC -Wno-orphans #-}
1210
13−#ifdef __HADDOCK_VERSION__
14−#undef INSPECTION
15−#endif
11+module Streamly.Benchmark.Data.Stream.StreamK where
1612
17−#ifdef INSPECTION
18−{-# LANGUAGE TemplateHaskell #-}
19−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20−#endif
21−
22−module Main (main) where
23−
24−#if !MIN_VERSION_base(4,18,0)
25−import Control.Applicative (liftA2)
26−#endif
2713import Control.Monad (when)
2814import Data.Maybe (isJust)
29−import System.Random (randomRIO)
30−import Prelude hiding
31− ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate
32− , repeat, replicate
33− )
34−
15+import Prelude
16+ (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,
17+ subtract, undefined, Maybe(..), not, (>>=),
18+ maxBound, flip, (<$>), (<*>), round, (/), (**), (<))
3519import qualified Prelude as P
3620import qualified Data.List as List
3721
38−import qualified Streamly.Internal.Data.StreamK as S
39−
40−import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
22+import qualified Streamly.Internal.Data.Stream.StreamK as S
23+import qualified Streamly.Internal.Data.Stream.Prelude as SP
24+import qualified Streamly.Internal.Data.SVar as S
4125
42−import Streamly.Benchmark.Common
26+value, value2, value3, value16, maxValue :: Int
27+value = 100000
28+value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
29+value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
30+value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
31+maxValue = value
4332
44−#ifdef INSPECTION
45−import Test.Inspection
46−#endif
47−
48−{-
33+-------------------------------------------------------------------------------
34+-- Benchmark ops
35+-------------------------------------------------------------------------------
4936
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'
37+{-# INLINE toNull #-}
38+{-# INLINE uncons #-}
39+{-# INLINE nullTail #-}
40+{-# INLINE headTail #-}
41+{-# INLINE zip #-}
42+toNull, uncons, nullTail, headTail, zip
43+ :: Monad m
44+ => Stream m Int -> m ()
11345
114−-}
46+{-# INLINE toList #-}
47+toList :: Monad m => Stream m Int -> m [Int]
48+{-# INLINE foldl #-}
49+foldl :: Monad m => Stream m Int -> m Int
50+{-# INLINE last #-}
51+last :: Monad m => Stream m Int -> m (Maybe Int)
11552
11653-------------------------------------------------------------------------------
11754-- Stream generation and elimination
11855-------------------------------------------------------------------------------
11956
120−type Stream m a = S.StreamK m a
57+type Stream m a = S.Stream m a
58+
59+{-# INLINE sourceUnfoldr #-}
60+sourceUnfoldr :: Int -> Stream m Int
61+sourceUnfoldr n = S.unfoldr step n
62+ where
63+ step cnt =
64+ if cnt > n + value
65+ then Nothing
66+ else Just (cnt, cnt + 1)
12167
122−{-# INLINE unfoldr #-}
123−unfoldr :: Int -> Int -> Stream m Int
124−unfoldr streamLen n = S.unfoldr step n
68+{-# INLINE sourceUnfoldrN #-}
69+sourceUnfoldrN :: Int -> Int -> Stream m Int
70+sourceUnfoldrN m n = S.unfoldr step n
12571 where
12672 step cnt =
127− if cnt > n + streamLen
73+ if cnt > n + m
12874 then Nothing
12975 else Just (cnt, cnt + 1)
13076
131−{-# INLINE unfoldrM #-}
132−unfoldrM :: Monad m => Int -> Int -> Stream m Int
133−unfoldrM streamLen n = S.unfoldrMWith S.consM step n
77+{-# INLINE sourceUnfoldrM #-}
78+sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int
79+sourceUnfoldrM n = S.unfoldrM step n
80+ where
81+ step cnt =
82+ if cnt > n + value
83+ then return Nothing
84+ else return (Just (cnt, cnt + 1))
85+
86+{-# INLINE sourceUnfoldrMN #-}
87+sourceUnfoldrMN :: S.MonadAsync m => Int -> Int -> Stream m Int
88+sourceUnfoldrMN m n = S.unfoldrM step n
13489 where
13590 step cnt =
136− if cnt > n + streamLen
91+ if cnt > n + m
13792 then return Nothing
13893 else return (Just (cnt, cnt + 1))
13994
140−{-# INLINE repeat #-}
141−repeat :: Int -> Int -> Stream m Int
142−repeat streamLen = S.take streamLen . S.repeat
143−
144−{-# INLINE repeatM #-}
145−repeatM :: Monad m => Int -> Int -> Stream m Int
146−repeatM streamLen = S.take streamLen . S.repeatM . return
147−
148−{-# INLINE replicate #-}
149−replicate :: Int -> Int -> Stream m Int
150−replicate = S.replicate
151−
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)
159−
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]
95+{-
96+{-# INLINE sourceFromEnum #-}
97+sourceFromEnum :: Monad m => Int -> Stream m Int
98+sourceFromEnum n = S.enumFromStepN n 1 value
99+-}
100+
101+{-# INLINE sourceFromFoldable #-}
102+sourceFromFoldable :: Int -> Stream m Int
103+sourceFromFoldable n = S.fromFoldable [n..n+value]
104+
105+{-
106+{-# INLINE sourceFromFoldableM #-}
107+sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
108+sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
109+-}
110+
111+{-# INLINE sourceFoldMapWith #-}
112+sourceFoldMapWith :: Int -> Stream m Int
113+sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
114+
115+{-# INLINE sourceFoldMapWithM #-}
116+sourceFoldMapWithM :: Monad m => Int -> Stream m Int
117+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
118+
119+{-# INLINE source #-}
120+source :: S.MonadAsync m => Int -> Stream m Int
121+source = sourceUnfoldrM
190122
191123-------------------------------------------------------------------------------
192124-- Elimination
193125-------------------------------------------------------------------------------
194126
195−{-# INLINE drain #-}
196−drain :: Monad m => Stream m a -> m ()
197−drain = S.drain
127+{-# INLINE runStream #-}
128+runStream :: Monad m => Stream m a -> m ()
129+runStream = S.drain
130+-- runStream = S.mapM_ (\_ -> return ())
198131
199132{-# INLINE mapM_ #-}
200133mapM_ :: Monad m => Stream m a -> m ()
201134mapM_ = S.mapM_ (\_ -> return ())
202135
203−{-# INLINE uncons #-}
204−uncons :: Monad m => Stream m Int -> m ()
136+toNull = runStream
205137uncons s = do
206138 r <- S.uncons s
207139 case r of
@@ -209,350 +141,203 @@ uncons s = do
209141 Just (_, t) -> uncons t
210142
211143{-# INLINE init #-}
212−init :: Monad m => Stream m a -> m ()
144+init :: (Monad m, S.IsStream t) => t m a -> m ()
213145init s = do
214146 t <- S.init s
215147 P.mapM_ S.drain t
216148
217149{-# INLINE tail #-}
218−tail :: Monad m => Stream m a -> m ()
150+tail :: (Monad m, S.IsStream t) => t m a -> m ()
219151tail s = S.tail s >>= P.mapM_ tail
220152
221−{-# INLINE nullTail #-}
222−nullTail :: Monad m => Stream m Int -> m ()
223153nullTail s = do
224154 r <- S.null s
225155 when (not r) $ S.tail s >>= P.mapM_ nullTail
226156
227−{-# INLINE headTail #-}
228−headTail :: Monad m => Stream m Int -> m ()
229157headTail s = do
230158 h <- S.head s
231159 when (isJust h) $ S.tail s >>= P.mapM_ headTail
232160
233−{-# INLINE toList #-}
234−toList :: Monad m => Stream m Int -> m [Int]
235161toList = S.toList
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
162+foldl = S.foldl' (+) 0
163+last = S.last
244164
245165-------------------------------------------------------------------------------
246166-- Transformation
247167-------------------------------------------------------------------------------
248168
169+{-# INLINE transform #-}
170+transform :: Monad m => Stream m a -> m ()
171+transform = runStream
172+
249173{-# INLINE composeN #-}
250174composeN
251175 :: Monad m
252176 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
253177composeN n f =
254178 case n of
255− 1 -> drain . f
256− 2 -> drain . f . f
257− 3 -> drain . f . f . f
258− 4 -> drain . f . f . f . f
179+ 1 -> transform . f
180+ 2 -> transform . f . f
181+ 3 -> transform . f . f . f
182+ 4 -> transform . f . f . f . f
259183 _ -> undefined
260184
261−{-# INLINE scanl' #-}
262−scanl' :: Monad m => Int -> Stream m Int -> m ()
263−scanl' n = composeN n $ S.scanl' (+) 0
264−
185+{-# INLINE scan #-}
265186{-# INLINE map #-}
266−map :: Monad m => Int -> Stream m Int -> m ()
267−map n = composeN n $ S.map (+ 1)
268−
269−{-# 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−
187+{-# INLINE fmap #-}
281188{-# INLINE filterEven #-}
282−filterEven :: Monad m => Int -> Stream m Int -> m ()
283−filterEven n = composeN n $ S.filter even
284−
285189{-# INLINE filterAllOut #-}
286−filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
287−filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
288−
289190{-# INLINE filterAllIn #-}
290−filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
291−filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
292−
293−{-# INLINE _takeOne #-}
294−_takeOne :: Monad m => Int -> Stream m Int -> m ()
295−_takeOne n = composeN n $ S.take 1
296−
191+{-# INLINE takeOne #-}
297192{-# INLINE takeAll #-}
298−takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
299−takeAll streamLen n = composeN n $ S.take streamLen
300−
301193{-# INLINE takeWhileTrue #-}
302−takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
303−takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
304−
305194{-# INLINE dropOne #-}
306−dropOne :: Monad m => Int -> Stream m Int -> m ()
307−dropOne n = composeN n $ S.drop 1
308−
309195{-# INLINE dropAll #-}
310−dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
311−dropAll streamLen n = composeN n $ S.drop streamLen
312−
313196{-# INLINE dropWhileTrue #-}
314−dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
315−dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
316−
317197{-# INLINE dropWhileFalse #-}
318−dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
319−dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
320−
321−{-# INLINE foldrS #-}
322−foldrS :: Monad m => Int -> Stream m Int -> m ()
323−foldrS n = composeN n $ S.foldrS S.cons S.nil
324−
325198{-# INLINE foldlS #-}
326−foldlS :: Monad m => Int -> Stream m Int -> m ()
327−foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
199+{-# INLINE concatMap #-}
200+scan, map, fmap, filterEven, filterAllOut,
201+ filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
202+ dropWhileTrue, dropWhileFalse, foldlS, concatMap
203+ :: Monad m
204+ => Int -> Stream m Int -> m ()
328205
206+{-# INLINE mapM #-}
207+{-# INLINE mapMSerial #-}
329208{-# INLINE intersperse #-}
330−intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
331−intersperse streamLen n = composeN n $ S.intersperse streamLen
209+mapM, mapMSerial, intersperse
210+ :: S.MonadAsync m => Int -> Stream m Int -> m ()
211+
212+scan n = composeN n $ S.scanl' (+) 0
213+map n = composeN n $ P.fmap (+1)
214+fmap n = composeN n $ P.fmap (+1)
215+mapM n = composeN n $ S.mapM return
216+mapMSerial n = composeN n $ S.mapMSerial return
217+filterEven n = composeN n $ S.filter even
218+filterAllOut n = composeN n $ S.filter (> maxValue)
219+filterAllIn n = composeN n $ S.filter (<= maxValue)
220+takeOne n = composeN n $ S.take 1
221+takeAll n = composeN n $ S.take maxValue
222+takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
223+dropOne n = composeN n $ S.drop 1
224+dropAll n = composeN n $ S.drop maxValue
225+dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
226+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
227+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
228+-- We use a (sqrt n) element stream as source and then concat the same stream
229+-- for each element to produce an n element stream.
230+concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)
231+intersperse n = composeN n $ S.intersperse maxValue
332232
333233-------------------------------------------------------------------------------
334234-- Iteration
335235-------------------------------------------------------------------------------
336236
237+iterStreamLen, maxIters :: Int
238+iterStreamLen = 10
239+maxIters = 10000
240+
337241{-# INLINE iterateSource #-}
338242iterateSource
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)
243+ :: S.MonadAsync m
244+ => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
245+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
341246 where
342247 f (0 :: Int) m = g m
343248 f x m = g (f (x P.- 1) m)
344249
345−-- this is quadratic
346−{-# 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−
357250{-# INLINE iterateMapM #-}
358−iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
359−iterateMapM iterStreamLen =
360− iterateSource iterStreamLen (S.mapMWith S.consM return)
361−
251+{-# INLINE iterateScan #-}
362252{-# INLINE iterateFilterEven #-}
363−iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
364−iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
365−
366253{-# INLINE iterateTakeAll #-}
367−iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
368−iterateTakeAll streamLen iterStreamLen =
369− iterateSource iterStreamLen (S.take streamLen)
370−
371254{-# INLINE iterateDropOne #-}
372−iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
373−iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
374−
255+{-# INLINE iterateDropWhileFalse #-}
375256{-# INLINE iterateDropWhileTrue #-}
376−iterateDropWhileTrue ::
377− Monad m => Int -> Int -> Int -> Int -> Stream m Int
378−iterateDropWhileTrue streamLen iterStreamLen =
379− iterateSource iterStreamLen (S.dropWhile (<= streamLen))
257+iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
258+ iterateDropWhileFalse, iterateDropWhileTrue
259+ :: S.MonadAsync m
260+ => Int -> Stream m Int
380261
381−-------------------------------------------------------------------------------
382−-- Zipping
383−-------------------------------------------------------------------------------
262+-- this is quadratic
263+iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
264+iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
265+ (maxIters `div` 10)
384266
385−{-# INLINE zipWith #-}
386−zipWith :: Monad m => Stream m Int -> m ()
387−zipWith src = drain $ S.zipWith (,) src src
267+iterateMapM = iterateSource (S.mapM return) maxIters
268+iterateFilterEven = iterateSource (S.filter even) maxIters
269+iterateTakeAll = iterateSource (S.take maxValue) maxIters
270+iterateDropOne = iterateSource (S.drop 1) maxIters
271+iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
388272
389−{-# INLINE zipWithM #-}
390−zipWithM :: Monad m => Stream m Int -> m ()
391−zipWithM src = drain $ S.zipWithM (curry return) src src
273+-------------------------------------------------------------------------------
274+-- Zipping and concat
275+-------------------------------------------------------------------------------
392276
393−{-# INLINE sortByK #-}
394−sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
395−sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure
277+zip src = transform $ S.zipWith (,) src src
396278
397−{-# INLINE sortBy #-}
398−sortBy :: Monad m => Stream m Int -> m ()
399−sortBy = drain . sortByK compare
279+{-# INLINE concatMapRepl4xN #-}
280+concatMapRepl4xN :: Monad m => Stream m Int -> m ()
281+concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
400282
401283-------------------------------------------------------------------------------
402284-- Mixed Composition
403285-------------------------------------------------------------------------------
404286
405287{-# INLINE scanMap #-}
406−scanMap :: Monad m => Int -> Stream m Int -> m ()
407−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
408−
409288{-# INLINE dropMap #-}
410−dropMap :: Monad m => Int -> Stream m Int -> m ()
411−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
412−
413289{-# INLINE dropScan #-}
414−dropScan :: Monad m => Int -> Stream m Int -> m ()
415−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
416−
417290{-# 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−
421291{-# 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−
425292{-# 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−
429293{-# 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−
433294{-# 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−
437295{-# INLINE filterScan #-}
438−filterScan :: Monad m => Int -> Stream m Int -> m ()
439−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
440−
441296{-# 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)
444−
445−-------------------------------------------------------------------------------
446−-- ConcatMap
447−-------------------------------------------------------------------------------
448−
449−-- concatMap unfoldrM/unfoldrM
450−
451−{-# INLINE concatMap #-}
452−concatMap :: Int -> Int -> Int -> IO ()
453−concatMap outer inner n =
454− S.drain $ S.concatMap
455− (\_ -> unfoldrM inner n)
456− (unfoldrM outer n)
457−
458−#ifdef INSPECTION
459−inspect $ hasNoTypeClasses 'concatMap
460−#endif
461−
462−-- concatMap unfoldr/unfoldr
463−
464−{-# INLINE concatMapPure #-}
465−concatMapPure :: Int -> Int -> Int -> IO ()
466−concatMapPure outer inner n =
467− S.drain $ S.concatMap
468− (\_ -> unfoldr inner n)
469− (unfoldr outer n)
470−
471−#ifdef INSPECTION
472−inspect $ hasNoTypeClasses 'concatMapPure
473−#endif
474−
475−-- concatMap replicate/unfoldrM
476−
477−{-# INLINE concatMapRepl #-}
478−concatMapRepl :: Int -> Int -> Int -> IO ()
479−concatMapRepl outer inner n =
480− S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
481−
482−#ifdef INSPECTION
483−inspect $ hasNoTypeClasses 'concatMapRepl
484−#endif
485−
486−-- concatMapWith
487−
488−{-# INLINE sourceConcatMapId #-}
489−sourceConcatMapId :: Monad m
490− => Int -> Int -> Stream m (Stream m Int)
491−sourceConcatMapId val n =
492− S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
493−
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)
297+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
298+ filterTake, filterScan, filterMap
299+ :: Monad m => Int -> Stream m Int -> m ()
300+
301+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
302+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
303+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
304+takeDrop n = composeN n $ S.drop 1 . S.take maxValue
305+takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
306+takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
307+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
308+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
309+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
310+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
500311
501312-------------------------------------------------------------------------------
502313-- Nested Composition
503314-------------------------------------------------------------------------------
504315
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
316+{-# INLINE toNullApNested #-}
317+toNullApNested :: Monad m => Stream m Int -> m ()
318+toNullApNested s = runStream $ do
534319 (+) <$> s <*> s
535320
536−{-# INLINE drainMonad #-}
537−drainMonad :: Monad m => Stream m Int -> m ()
538−drainMonad s = drain $ do
321+{-# INLINE toNullNested #-}
322+toNullNested :: Monad m => Stream m Int -> m ()
323+toNullNested s = runStream $ do
539324 x <- s
540325 y <- s
541326 return $ x + y
542327
543−{-# INLINE drainMonad3 #-}
544−drainMonad3 :: Monad m => Stream m Int -> m ()
545−drainMonad3 s = drain $ do
328+{-# INLINE toNullNested3 #-}
329+toNullNested3 :: Monad m => Stream m Int -> m ()
330+toNullNested3 s = runStream $ do
546331 x <- s
547332 y <- s
548333 z <- s
549334 return $ x + y + z
550335
551−{-# INLINE filterAllOutMonad #-}
552−filterAllOutMonad
336+{-# INLINE filterAllOutNested #-}
337+filterAllOutNested
553338 :: Monad m
554339 => Stream m Int -> m ()
555−filterAllOutMonad str = drain $ do
340+filterAllOutNested str = runStream $ do
556341 x <- str
557342 y <- str
558343 let s = x + y
@@ -560,11 +345,11 @@ filterAllOutMonad str = drain $ do
560345 then return s
561346 else S.nil
562347
563−{-# INLINE filterAllInMonad #-}
564−filterAllInMonad
348+{-# INLINE filterAllInNested #-}
349+filterAllInNested
565350 :: Monad m
566351 => Stream m Int -> m ()
567−filterAllInMonad str = drain $ do
352+filterAllInNested str = runStream $ do
568353 x <- str
569354 y <- str
570355 let s = x + y
@@ -576,14 +361,9 @@ filterAllInMonad str = drain $ do
576361-- Nested Composition Pure lists
577362-------------------------------------------------------------------------------
578363
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
364+{-# INLINE sourceUnfoldrList #-}
365+sourceUnfoldrList :: Int -> Int -> [Int]
366+sourceUnfoldrList maxval n = List.unfoldr step n
587367 where
588368 step cnt =
589369 if cnt > n + maxval
@@ -628,307 +408,3 @@ filterAllInNestedList str = do
628408 if s > 0
629409 then return s
630410 else []
631−
632−-------------------------------------------------------------------------------
633−-- Benchmarks
634−-------------------------------------------------------------------------------
635−
636−moduleName :: String
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)
653−
654− -- appends
655− , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
656− , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
657− ]
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)
668− ]
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)
683− ]
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)
697− ]
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)
707− -- XXX this is horribly slow
708− -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
709− ]
710−
711−o_1_space_concat :: Int -> Benchmark
712−o_1_space_concat streamLen =
713− bgroup "concat"
714− [ benchIOSrc1 "concatMapPure (n of 1)"
715− (concatMapPure streamLen 1)
716− , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
717− (concatMapPure streamLen2 streamLen2)
718− , benchIOSrc1 "concatMapPure (1 of n)"
719− (concatMapPure 1 streamLen)
720−
721− , benchIOSrc1 "concatMap (n of 1)"
722− (concatMap streamLen 1)
723− , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
724− (concatMap streamLen2 streamLen2)
725− , benchIOSrc1 "concatMap (1 of n)"
726− (concatMap 1 streamLen)
727−
728− , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
729− (concatMapRepl streamLen2 streamLen2)
730−
731− -- This is for comparison with concatMapFoldableWith
732− , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
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)
744− ]
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)
760− ]
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)
774− ]
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)
781− ]
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)
796− ]
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)
811− ]
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)
840− ]
841− ]
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− ]
864−
865−o_n_heap :: Int -> Benchmark
866−o_n_heap streamLen =
867− bgroup (o_n_heap_prefix moduleName)
868− [ bgroup "transformation"
869− [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
870− ]
871− ]
872−
873−{-# INLINE benchK #-}
874−benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
875−benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
876−
877−o_n_stack :: Int -> Int -> Int -> Benchmark
878−o_n_stack streamLen iterStreamLen maxIters =
879− bgroup (o_n_stack_prefix moduleName)
880− [ bgroup "elimination"
881− [ benchFold "tail" tail (unfoldrM streamLen)
882− , benchFold "nullTail" nullTail (unfoldrM streamLen)
883− , benchFold "headTail" headTail (unfoldrM streamLen)
884− ]
885− , bgroup "transformation"
886− [
887− -- XXX why do these need so much stack
888− benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
889− , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
890− ]
891− , bgroup "transformationX4"
892− [
893− benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
894− ]
895− , bgroup "iterated"
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)
903− ]
904− ]
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
908−
909−o_n_space :: Int -> Benchmark
910−o_n_space streamLen =
911− bgroup (o_n_space_prefix moduleName)
912− [ bgroup "elimination"
913− [ benchFold "toList" toList (unfoldrM streamLen)
914− ]
915− ]
916−
917−{-# INLINE benchList #-}
918−benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
919−benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
920−
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
928− ]
929−
930− where
931−
932− streamLen = 100000
933− maxIters = 10000
934− iterStreamLen = 10