@@ -1,139 +1,207 @@
2-- Module : Streamly.Benchmark.Data.Stream.StreamK
2-- Module : Streamly.Benchmark.Data.Stream.StreamK
3−-- Copyright : (c) 2018 Harendra Kumar
3+-- Copyright : (c) 2018 Composewell Technologies
5-- License : BSD3
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
6-- Maintainer : streamly@composewell.com
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11+{-# OPTIONS_GHC -Wno-orphans #-}
11−module Streamly.Benchmark.Data.Stream.StreamK where
13+#ifdef __HADDOCK_VERSION__
18+{-# LANGUAGE TemplateHaskell #-}
19+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
22+module Main (main) where
24+#if !MIN_VERSION_base(4,18,0)
25+import Control.Applicative (liftA2)
13import Control.Monad (when)
27import Control.Monad (when)
14import Data.Maybe (isJust)
28import Data.Maybe (isJust)
29+import System.Random (randomRIO)
15−import Prelude
30+import Prelude hiding
16− (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,
31+ ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate
17− subtract, undefined, Maybe(..), not, (>>=),
32+ , repeat, replicate
18− maxBound, flip, (<$>), (<*>), round, (/), (**), (<))
33+ )
19import qualified Prelude as P
35import qualified Prelude as P
20import qualified Data.List as List
36import qualified Data.List as List
22−import qualified Streamly.Internal.Data.Stream.StreamK as S
38+import qualified Streamly.Internal.Data.StreamK as S
23−import qualified Streamly.Internal.Data.Stream.Prelude as SP
24−import qualified Streamly.Internal.Data.SVar as S
26−value, value2, value3, value16, maxValue :: Int
40+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
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
33−-------------------------------------------------------------------------------
34−-- Benchmark ops
42+import Streamly.Benchmark.Common
35−-------------------------------------------------------------------------------
37−{-# INLINE toNull #-}
44+#ifdef INSPECTION
38−{-# INLINE uncons #-}
45+import Test.Inspection
39−{-# INLINE nullTail #-}
46+#endif
40−{-# INLINE headTail #-}
42−toNull, uncons, nullTail, headTail, zip
44− => Stream m Int -> m ()
46−{-# INLINE toList #-}
48+{-
47−toList :: Monad m => Stream m Int -> m [Int]
49+
48−{-# INLINE foldl #-}
50+Benchmarks that need to be added
49−foldl :: Monad m => Stream m Int -> m Int
51+
50−{-# INLINE last #-}
52+-- fromList
51−last :: Monad m => Stream m Int -> m (Maybe Int)
53+
109+-- toStreamK (Probably can be skipped)
53-------------------------------------------------------------------------------
116-------------------------------------------------------------------------------
54-- Stream generation and elimination
117-- Stream generation and elimination
55-------------------------------------------------------------------------------
118-------------------------------------------------------------------------------
57−type Stream m a = S.Stream m a
120+type Stream m a = S.StreamK m a
59−{-# INLINE sourceUnfoldr #-}
60−sourceUnfoldr :: Int -> Stream m Int
61−sourceUnfoldr n = S.unfoldr step n
66− else Just (cnt, cnt + 1)
68−{-# INLINE sourceUnfoldrN #-}
122+{-# INLINE unfoldr #-}
69−sourceUnfoldrN :: Int -> Int -> Stream m Int
123+unfoldr :: Int -> Int -> Stream m Int
70−sourceUnfoldrN m n = S.unfoldr step n
124+unfoldr streamLen n = S.unfoldr step n
72 step cnt =
126 step cnt =
73− if cnt > n + m
127+ if cnt > n + streamLen
74 then Nothing
128 then Nothing
75 else Just (cnt, cnt + 1)
129 else Just (cnt, cnt + 1)
77−{-# INLINE sourceUnfoldrM #-}
131+{-# INLINE unfoldrM #-}
78−sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int
79−sourceUnfoldrM n = S.unfoldrM step n
84− else return (Just (cnt, cnt + 1))
86−{-# INLINE sourceUnfoldrMN #-}
87−sourceUnfoldrMN :: S.MonadAsync m => Int -> Int -> Stream m Int
132+unfoldrM :: Monad m => Int -> Int -> Stream m Int
88−sourceUnfoldrMN m n = S.unfoldrM step n
133+unfoldrM streamLen n = S.unfoldrMWith S.consM step n
90 step cnt =
135 step cnt =
91− if cnt > n + m
136+ if cnt > n + streamLen
92 then return Nothing
137 then return Nothing
93 else return (Just (cnt, cnt + 1))
138 else return (Just (cnt, cnt + 1))
95−{-
140+{-# INLINE repeat #-}
96−{-# INLINE sourceFromEnum #-}
141+repeat :: Int -> Int -> Stream m Int
142+repeat streamLen = S.take streamLen . S.repeat
144+{-# INLINE repeatM #-}
97−sourceFromEnum :: Monad m => Int -> Stream m Int
145+repeatM :: Monad m => Int -> Int -> Stream m Int
98−sourceFromEnum n = S.enumFromStepN n 1 value
146+repeatM streamLen = S.take streamLen . S.repeatM . return
100−
148+{-# INLINE replicate #-}
101−{-# INLINE sourceFromFoldable #-}
149+replicate :: Int -> Int -> Stream m Int
150+replicate = S.replicate
152+{-# INLINE replicateM #-}
102−sourceFromFoldable :: Int -> Stream m Int
153+replicateM :: Monad m => Int -> Int -> Stream m Int
103−sourceFromFoldable n = S.fromFoldable [n..n+value]
154+replicateM streamLen = S.replicateMWith S.consM streamLen . return
105−{-
156+{-# INLINE iterate #-}
106−{-# INLINE sourceFromFoldableM #-}
157+iterate :: Int -> Int -> Stream m Int
107−sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
158+iterate streamLen = S.take streamLen . S.iterate (+1)
108−sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
159+
109−-}
160+{-# INLINE iterateM #-}
110−
161+iterateM :: Monad m => Int -> Int -> Stream m Int
111−{-# INLINE sourceFoldMapWith #-}
162+iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
112−sourceFoldMapWith :: Int -> Stream m Int
163+
113−sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
164+{-# INLINE fromFoldable #-}
114−
165+fromFoldable :: Int -> Int -> Stream m Int
115−{-# INLINE sourceFoldMapWithM #-}
166+fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
116−sourceFoldMapWithM :: Monad m => Int -> Stream m Int
167+
117−sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
168+{-# INLINE fromFoldableM #-}
118−
169+fromFoldableM :: Monad m => Int -> Int -> Stream m Int
119−{-# INLINE source #-}
170+fromFoldableM streamLen n =
120−source :: S.MonadAsync m => Int -> Stream m Int
171+ List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
121−source = sourceUnfoldrM
172+
173+{-# INLINABLE concatMapFoldableWith #-}
174+concatMapFoldableWith :: P.Foldable f
175+ => (Stream m b -> Stream m b -> Stream m b)
176+ -> (a -> Stream m b)
179+concatMapFoldableWith f g = P.foldr (f . g) S.nil
181+{-# INLINE concatMapFoldableSerial #-}
182+concatMapFoldableSerial :: Int -> Int -> Stream m Int
183+concatMapFoldableSerial streamLen n =
184+ concatMapFoldableWith S.append S.fromPure [n..n+streamLen]
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]
123-------------------------------------------------------------------------------
191-------------------------------------------------------------------------------
124-- Elimination
192-- Elimination
125-------------------------------------------------------------------------------
193-------------------------------------------------------------------------------
127−{-# INLINE runStream #-}
195+{-# INLINE drain #-}
128−runStream :: Monad m => Stream m a -> m ()
196+drain :: Monad m => Stream m a -> m ()
129−runStream = S.drain
197+drain = S.drain
130−-- runStream = S.mapM_ (\_ -> return ())
132{-# INLINE mapM_ #-}
199{-# INLINE mapM_ #-}
133mapM_ :: Monad m => Stream m a -> m ()
200mapM_ :: Monad m => Stream m a -> m ()
134mapM_ = S.mapM_ (\_ -> return ())
201mapM_ = S.mapM_ (\_ -> return ())
136−toNull = runStream
203+{-# INLINE uncons #-}
204+uncons :: Monad m => Stream m Int -> m ()
137uncons s = do
205uncons s = do
138 r <- S.uncons s
206 r <- S.uncons s
139 case r of
207 case r of
@@ -141,203 +209,350 @@ uncons s = do
141 Just (_, t) -> uncons t
209 Just (_, t) -> uncons t
143{-# INLINE init #-}
211{-# INLINE init #-}
144−init :: (Monad m, S.IsStream t) => t m a -> m ()
212+init :: Monad m => Stream m a -> m ()
145init s = do
213init s = do
146 t <- S.init s
214 t <- S.init s
147 P.mapM_ S.drain t
215 P.mapM_ S.drain t
149{-# INLINE tail #-}
217{-# INLINE tail #-}
150−tail :: (Monad m, S.IsStream t) => t m a -> m ()
218+tail :: Monad m => Stream m a -> m ()
151tail s = S.tail s >>= P.mapM_ tail
219tail s = S.tail s >>= P.mapM_ tail
221+{-# INLINE nullTail #-}
222+nullTail :: Monad m => Stream m Int -> m ()
153nullTail s = do
223nullTail s = do
154 r <- S.null s
224 r <- S.null s
155 when (not r) $ S.tail s >>= P.mapM_ nullTail
225 when (not r) $ S.tail s >>= P.mapM_ nullTail
227+{-# INLINE headTail #-}
228+headTail :: Monad m => Stream m Int -> m ()
157headTail s = do
229headTail s = do
158 h <- S.head s
230 h <- S.head s
159 when (isJust h) $ S.tail s >>= P.mapM_ headTail
231 when (isJust h) $ S.tail s >>= P.mapM_ headTail
233+{-# INLINE toList #-}
234+toList :: Monad m => Stream m Int -> m [Int]
161toList = S.toList
235toList = S.toList
237+{-# INLINE foldl' #-}
238+foldl' :: Monad m => Stream m Int -> m Int
162−foldl = S.foldl' (+) 0
239+foldl' = S.foldl' (+) 0
242+last :: Monad m => Stream m Int -> m (Maybe Int)
163−last = S.last
243+last = S.last
165-------------------------------------------------------------------------------
245-------------------------------------------------------------------------------
166-- Transformation
246-- Transformation
167-------------------------------------------------------------------------------
247-------------------------------------------------------------------------------
169−{-# INLINE transform #-}
170−transform :: Monad m => Stream m a -> m ()
171−transform = runStream
173{-# INLINE composeN #-}
249{-# INLINE composeN #-}
175 :: Monad m
251 :: Monad m
176 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
252 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
177composeN n f =
253composeN n f =
178 case n of
254 case n of
179− 1 -> transform . f
255+ 1 -> drain . f
180− 2 -> transform . f . f
256+ 2 -> drain . f . f
181− 3 -> transform . f . f . f
257+ 3 -> drain . f . f . f
182− 4 -> transform . f . f . f . f
258+ 4 -> drain . f . f . f . f
183 _ -> undefined
259 _ -> undefined
185−{-# INLINE scan #-}
261+{-# INLINE scanl' #-}
262+scanl' :: Monad m => Int -> Stream m Int -> m ()
263+scanl' n = composeN n $ S.scanl' (+) 0
186{-# INLINE map #-}
265{-# INLINE map #-}
266+map :: Monad m => Int -> Stream m Int -> m ()
267+map n = composeN n $ S.map (+ 1)
187−{-# INLINE fmap #-}
269+{-# INLINE fmapK #-}
270+fmapK :: Monad m => Int -> Stream m Int -> m ()
271+fmapK n = composeN n $ P.fmap (+ 1)
274+mapM :: Monad m => Int -> Stream m Int -> m ()
275+mapM n = composeN n $ S.mapMWith S.consM return
277+{-# INLINE mapMSerial #-}
278+mapMSerial :: Monad m => Int -> Stream m Int -> m ()
279+mapMSerial n = composeN n $ S.mapMSerial return
188{-# INLINE filterEven #-}
281{-# INLINE filterEven #-}
282+filterEven :: Monad m => Int -> Stream m Int -> m ()
283+filterEven n = composeN n $ S.filter even
189{-# INLINE filterAllOut #-}
285{-# INLINE filterAllOut #-}
286+filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
287+filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
190{-# INLINE filterAllIn #-}
289{-# INLINE filterAllIn #-}
290+filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
291+filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
191−{-# INLINE takeOne #-}
293+{-# INLINE _takeOne #-}
294+_takeOne :: Monad m => Int -> Stream m Int -> m ()
295+_takeOne n = composeN n $ S.take 1
192{-# INLINE takeAll #-}
297{-# INLINE takeAll #-}
298+takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
299+takeAll streamLen n = composeN n $ S.take streamLen
193{-# INLINE takeWhileTrue #-}
301{-# INLINE takeWhileTrue #-}
302+takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
303+takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
194{-# INLINE dropOne #-}
305{-# INLINE dropOne #-}
306+dropOne :: Monad m => Int -> Stream m Int -> m ()
307+dropOne n = composeN n $ S.drop 1
195{-# INLINE dropAll #-}
309{-# INLINE dropAll #-}
310+dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
311+dropAll streamLen n = composeN n $ S.drop streamLen
196{-# INLINE dropWhileTrue #-}
313{-# INLINE dropWhileTrue #-}
314+dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
315+dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
197{-# INLINE dropWhileFalse #-}
317{-# INLINE dropWhileFalse #-}
318+dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
319+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
321+{-# INLINE foldrS #-}
322+foldrS :: Monad m => Int -> Stream m Int -> m ()
323+foldrS n = composeN n $ S.foldrS S.cons S.nil
198{-# INLINE foldlS #-}
325{-# INLINE foldlS #-}
199−{-# INLINE concatMap #-}
200−scan, map, fmap, filterEven, filterAllOut,
201− filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
202− dropWhileTrue, dropWhileFalse, foldlS, concatMap
204− => 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
207−{-# INLINE mapMSerial #-}
208{-# INLINE intersperse #-}
329{-# INLINE intersperse #-}
209−mapM, mapMSerial, intersperse
210− :: S.MonadAsync m => Int -> Stream m Int -> m ()
330+intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
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
331+intersperse streamLen n = composeN n $ S.intersperse streamLen
233-------------------------------------------------------------------------------
333-------------------------------------------------------------------------------
234-- Iteration
334-- Iteration
235-------------------------------------------------------------------------------
335-------------------------------------------------------------------------------
237−iterStreamLen, maxIters :: Int
241{-# INLINE iterateSource #-}
337{-# INLINE iterateSource #-}
242iterateSource
338iterateSource
244− => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
339+ :: Monad m => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
245−iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
340+iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
247 f (0 :: Int) m = g m
342 f (0 :: Int) m = g m
248 f x m = g (f (x P.- 1) m)
343 f x m = g (f (x P.- 1) m)
250−{-# INLINE iterateMapM #-}
345+-- this is quadratic
251{-# INLINE iterateScan #-}
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)
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)
357+{-# INLINE iterateMapM #-}
358+iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
359+iterateMapM iterStreamLen =
360+ iterateSource iterStreamLen (S.mapMWith S.consM return)
252{-# INLINE iterateFilterEven #-}
362{-# INLINE iterateFilterEven #-}
363+iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
364+iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
253{-# INLINE iterateTakeAll #-}
366{-# INLINE iterateTakeAll #-}
254−{-# INLINE iterateDropOne #-}
255−{-# INLINE iterateDropWhileFalse #-}
256−{-# INLINE iterateDropWhileTrue #-}
257−iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
258− iterateDropWhileFalse, iterateDropWhileTrue
260− => 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)
262−-- this is quadratic
371+{-# INLINE iterateDropOne #-}
263−iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
372+iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
264−iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
373+iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
267−iterateMapM = iterateSource (S.mapM return) maxIters
375+{-# INLINE iterateDropWhileTrue #-}
268−iterateFilterEven = iterateSource (S.filter even) maxIters
376+iterateDropWhileTrue ::
269−iterateTakeAll = iterateSource (S.take maxValue) maxIters
377+ Monad m => Int -> Int -> Int -> Int -> Stream m Int
270−iterateDropOne = iterateSource (S.drop 1) maxIters
378+iterateDropWhileTrue streamLen iterStreamLen =
271−iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
379+ iterateSource iterStreamLen (S.dropWhile (<= streamLen))
273-------------------------------------------------------------------------------
381-------------------------------------------------------------------------------
274−-- Zipping and concat
382+-- Zipping
275-------------------------------------------------------------------------------
383-------------------------------------------------------------------------------
385+{-# INLINE zipWith #-}
386+zipWith :: Monad m => Stream m Int -> m ()
277−zip src = transform $ S.zipWith (,) src src
387+zipWith src = drain $ S.zipWith (,) src src
279−{-# INLINE concatMapRepl4xN #-}
389+{-# INLINE zipWithM #-}
280−concatMapRepl4xN :: Monad m => Stream m Int -> m ()
390+zipWithM :: Monad m => Stream m Int -> m ()
281−concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
391+zipWithM src = drain $ S.zipWithM (curry return) src src
393+{-# INLINE sortByK #-}
394+sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
395+sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure
397+{-# INLINE sortBy #-}
398+sortBy :: Monad m => Stream m Int -> m ()
399+sortBy = drain . sortByK compare
283-------------------------------------------------------------------------------
401-------------------------------------------------------------------------------
284-- Mixed Composition
402-- Mixed Composition
285-------------------------------------------------------------------------------
403-------------------------------------------------------------------------------
287{-# INLINE scanMap #-}
405{-# INLINE scanMap #-}
406+scanMap :: Monad m => Int -> Stream m Int -> m ()
407+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
288{-# INLINE dropMap #-}
409{-# INLINE dropMap #-}
410+dropMap :: Monad m => Int -> Stream m Int -> m ()
411+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
289{-# INLINE dropScan #-}
413{-# INLINE dropScan #-}
414+dropScan :: Monad m => Int -> Stream m Int -> m ()
415+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
290{-# INLINE takeDrop #-}
417{-# INLINE takeDrop #-}
418+takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
419+takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
291{-# INLINE takeScan #-}
421{-# INLINE takeScan #-}
422+takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
423+takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
292{-# INLINE takeMap #-}
425{-# 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
293{-# INLINE filterDrop #-}
429{-# INLINE filterDrop #-}
430+filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
431+filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
294{-# INLINE filterTake #-}
433{-# INLINE filterTake #-}
434+filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
435+filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
295{-# INLINE filterScan #-}
437{-# INLINE filterScan #-}
296−{-# INLINE filterMap #-}
297−scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
298− filterTake, filterScan, filterMap
299− :: Monad m => Int -> Stream m Int -> m ()
438+filterScan :: Monad m => Int -> Stream m Int -> m ()
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)
309filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
439filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
441+{-# INLINE filterMap #-}
442+filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
310−filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
443+filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
445+-------------------------------------------------------------------------------
447+-------------------------------------------------------------------------------
449+-- concatMap unfoldrM/unfoldrM
451+{-# INLINE concatMap #-}
452+concatMap :: Int -> Int -> Int -> IO ()
453+concatMap outer inner n =
454+ S.drain $ S.concatMap
455+ (\_ -> unfoldrM inner n)
459+inspect $ hasNoTypeClasses 'concatMap
462+-- concatMap unfoldr/unfoldr
464+{-# INLINE concatMapPure #-}
465+concatMapPure :: Int -> Int -> Int -> IO ()
466+concatMapPure outer inner n =
467+ S.drain $ S.concatMap
468+ (\_ -> unfoldr inner n)
472+inspect $ hasNoTypeClasses 'concatMapPure
475+-- concatMap replicate/unfoldrM
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)
483+inspect $ hasNoTypeClasses 'concatMapRepl
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]
494+{-# INLINE concatMapBySerial #-}
495+concatMapBySerial :: Int -> Int -> Int -> IO ()
496+concatMapBySerial outer inner n =
497+ S.drain $ S.concatMapWith S.append
312-------------------------------------------------------------------------------
501-------------------------------------------------------------------------------
313-- Nested Composition
502-- Nested Composition
314-------------------------------------------------------------------------------
503-------------------------------------------------------------------------------
316−{-# INLINE toNullApNested #-}
505+instance Monad m => Applicative (S.StreamK m) where
509+ {-# INLINE (<*>) #-}
510+ (<*>) = S.crossApply
512+ {-# INLINE liftA2 #-}
513+ liftA2 f x = (<*>) (fmap f x)
516+ (*>) = S.crossApplySnd
519+ (<*) = S.crossApplyFst
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
524+instance Monad m => Monad (S.StreamK m) where
525+ {-# INLINE return #-}
528+ {-# INLINE (>>=) #-}
529+ (>>=) = flip S.concatMap
531+{-# INLINE drainApplicative #-}
317−toNullApNested :: Monad m => Stream m Int -> m ()
532+drainApplicative :: Monad m => Stream m Int -> m ()
318−toNullApNested s = runStream $ do
533+drainApplicative s = drain $ do
319 (+) <$> s <*> s
534 (+) <$> s <*> s
321−{-# INLINE toNullNested #-}
536+{-# INLINE drainMonad #-}
322−toNullNested :: Monad m => Stream m Int -> m ()
537+drainMonad :: Monad m => Stream m Int -> m ()
323−toNullNested s = runStream $ do
538+drainMonad s = drain $ do
326 return $ x + y
541 return $ x + y
328−{-# INLINE toNullNested3 #-}
543+{-# INLINE drainMonad3 #-}
329−toNullNested3 :: Monad m => Stream m Int -> m ()
544+drainMonad3 :: Monad m => Stream m Int -> m ()
330−toNullNested3 s = runStream $ do
545+drainMonad3 s = drain $ do
334 return $ x + y + z
549 return $ x + y + z
336−{-# INLINE filterAllOutNested #-}
551+{-# INLINE filterAllOutMonad #-}
337−filterAllOutNested
552+filterAllOutMonad
338 :: Monad m
553 :: Monad m
339 => Stream m Int -> m ()
554 => Stream m Int -> m ()
340−filterAllOutNested str = runStream $ do
555+filterAllOutMonad str = drain $ do
343 let s = x + y
558 let s = x + y
@@ -345,11 +560,11 @@ filterAllOutNested str = runStream $ do
345 then return s
560 then return s
346 else S.nil
561 else S.nil
348−{-# INLINE filterAllInNested #-}
563+{-# INLINE filterAllInMonad #-}
349−filterAllInNested
564+filterAllInMonad
350 :: Monad m
565 :: Monad m
351 => Stream m Int -> m ()
566 => Stream m Int -> m ()
352−filterAllInNested str = runStream $ do
567+filterAllInMonad str = drain $ do
355 let s = x + y
570 let s = x + y
@@ -361,9 +576,14 @@ filterAllInNested str = runStream $ do
361-- Nested Composition Pure lists
576-- Nested Composition Pure lists
362-------------------------------------------------------------------------------
577-------------------------------------------------------------------------------
364−{-# INLINE sourceUnfoldrList #-}
579+-- There are several list benchmarks here for comparison with lists. It is easy
365−sourceUnfoldrList :: Int -> Int -> [Int]
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.
584+{-# INLINE unfoldrList #-}
585+unfoldrList :: Int -> Int -> [Int]
366−sourceUnfoldrList maxval n = List.unfoldr step n
586+unfoldrList maxval n = List.unfoldr step n
368 step cnt =
588 step cnt =
369 if cnt > n + maxval
589 if cnt > n + maxval
@@ -408,3 +628,307 @@ filterAllInNestedList str = do
409 then return s
629 then return s
632+-------------------------------------------------------------------------------
634+-------------------------------------------------------------------------------
637+moduleName = "Data.StreamK"
639+o_1_space_generation :: Int -> Benchmark
640+o_1_space_generation streamLen =
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)
651+ , benchFold "fromFoldable" drain (fromFoldable streamLen)
652+ , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
655+ , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
656+ , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
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)
670+o_1_space_nested :: Int -> Benchmark
671+o_1_space_nested streamLen =
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)
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
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)
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)
711+o_1_space_concat :: Int -> Benchmark
712+o_1_space_concat streamLen =
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)
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)
728+ , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
729+ (concatMapRepl streamLen2 streamLen2)
731+ -- This is for comparison with concatMapFoldableWith
732+ , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
734+ . S.concatMapWith S.append id
735+ . sourceConcatMapId streamLen)
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)
746+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
748+o_1_space_filtering :: Int -> Benchmark
749+o_1_space_filtering streamLen =
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)
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)
776+o_1_space_zipping :: Int -> Benchmark
777+o_1_space_zipping streamLen =
779+ [ benchFold "zipWith" zipWith (unfoldrM streamLen)
780+ , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
783+o_1_space_mixed :: Int -> Benchmark
784+o_1_space_mixed streamLen =
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)
798+o_1_space_mixedX2 :: Int -> Benchmark
799+o_1_space_mixedX2 streamLen =
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)
813+o_1_space_mixedX4 :: Int -> Benchmark
814+o_1_space_mixedX4 streamLen =
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)
828+o_1_space_list :: Int -> Benchmark
829+o_1_space_list streamLen =
831+ [ bgroup "elimination"
832+ [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
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)
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
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
865+o_n_heap :: Int -> Benchmark
867+ bgroup (o_n_heap_prefix moduleName)
868+ [ bgroup "transformation"
869+ [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
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
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)
885+ , bgroup "transformation"
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)
891+ , bgroup "transformationX4"
893+ benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
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)
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
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)
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
924+ [ o_1_space streamLen
925+ , o_n_stack streamLen iterStreamLen maxIters
926+ , o_n_heap streamLen
927+ , o_n_space streamLen