@@ -16,11 +16,14 @@ import Streamly.Internal.Data.Unfold (Unfold)
16import qualified Prelude
16import qualified Prelude
17import qualified Streamly.Internal.Data.Fold as FL
17import qualified Streamly.Internal.Data.Fold as FL
18import qualified Streamly.Internal.Data.Unfold as UF
18import qualified Streamly.Internal.Data.Unfold as UF
19+import qualified Streamly.Internal.Data.Stream.IsStream as S
20+import qualified Streamly.Internal.Data.Stream.StreamD as D
21+import qualified Streamly.Internal.Data.Stream.StreamK as K
19import qualified Streamly.Benchmark.Data.NestedUnfoldOps as Nested
22import qualified Streamly.Benchmark.Data.NestedUnfoldOps as Nested
21import Streamly.Benchmark.Common
24import Streamly.Benchmark.Common
22import Gauge
25import Gauge
23−import Prelude hiding (concat, take)
26+import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)
25{-# INLINE benchIO #-}
28{-# INLINE benchIO #-}
26benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
29benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
@@ -30,18 +33,14 @@ benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
30-- Benchmark helpers
33-- Benchmark helpers
31-------------------------------------------------------------------------------
34-------------------------------------------------------------------------------
33−{-# INLINE drainUnfold #-}
34−drainUnfold :: Monad m => Unfold m a b -> a -> m ()
35−drainUnfold unf seed = UF.fold unf FL.drain seed
37{-# INLINE drainGeneration #-}
36{-# INLINE drainGeneration #-}
38drainGeneration :: Monad m => Unfold m a b -> a -> m ()
37drainGeneration :: Monad m => Unfold m a b -> a -> m ()
39−drainGeneration = drainUnfold
38+drainGeneration unf seed = UF.fold unf FL.drain seed
41{-# INLINE drainTransformation #-}
40{-# INLINE drainTransformation #-}
42drainTransformation ::
41drainTransformation ::
43 Monad m => Unfold m a b -> (Unfold m a b -> Unfold m c d) -> c -> m ()
42 Monad m => Unfold m a b -> (Unfold m a b -> Unfold m c d) -> c -> m ()
44−drainTransformation unf f seed = drainUnfold (f unf) seed
43+drainTransformation unf f seed = drainGeneration (f unf) seed
46{-# INLINE drainTransformationDefault #-}
45{-# INLINE drainTransformationDefault #-}
47drainTransformationDefault ::
46drainTransformationDefault ::
@@ -57,7 +56,7 @@ drainProduct ::
57 -> (Unfold m a b -> Unfold m c d -> Unfold m e f)
56 -> (Unfold m a b -> Unfold m c d -> Unfold m e f)
60−drainProduct unf1 unf2 f seed = drainUnfold (f unf1 unf2) seed
59+drainProduct unf1 unf2 f seed = drainGeneration (f unf1 unf2) seed
62{-# INLINE drainProductDefault #-}
61{-# INLINE drainProductDefault #-}
63drainProductDefault ::
62drainProductDefault ::
@@ -66,16 +65,137 @@ drainProductDefault ::
66 -> (Unfold m Int Int -> Unfold m Int Int -> Unfold m e f)
65 -> (Unfold m Int Int -> Unfold m Int Int -> Unfold m e f)
69−drainProductDefault size = drainProduct src src
68+drainProductDefault size = drainProduct src1 src2
73− src = UF.take size UF.enumerateFromIntegral
72+ src1 = UF.take size UF.enumerateFromIntegral
73+ src2 = UF.take size (UF.supplySecond UF.enumerateFromStepIntegral 2)
75+-------------------------------------------------------------------------------
76+-- Operations on input
77+-------------------------------------------------------------------------------
80+lmap :: Monad m => Int -> Int -> m ()
81+lmap size start = drainTransformationDefault size (UF.lmap (+ 1)) start
84+lmapM :: Monad m => Int -> Int -> m ()
86+ drainTransformationDefault size (UF.lmapM (return . (+) 1)) start
89+supply :: Monad m => Int -> Int -> m ()
91+ drainTransformationDefault size (flip UF.supply start) undefined
94+{-# INLINE supplyFirst #-}
95+supplyFirst :: Monad m => Int -> Int -> m ()
96+supplyFirst size start =
98+ (UF.take size UF.enumerateFromStepIntegral)
99+ (flip UF.supplyFirst start)
102+{-# INLINE supplySecond #-}
103+supplySecond :: Monad m => Int -> Int -> m ()
104+supplySecond size start =
106+ (UF.take size UF.enumerateFromStepIntegral)
107+ (flip UF.supplySecond 1)
110+{-# INLINE discardFirst #-}
111+discardFirst :: Monad m => Int -> Int -> m ()
112+discardFirst size start =
113+ drainTransformationDefault size UF.discardFirst (start, start)
115+{-# INLINE discardSecond #-}
116+discardSecond :: Monad m => Int -> Int -> m ()
117+discardSecond size start =
118+ drainTransformationDefault size UF.discardSecond (start, start)
121+swap :: Monad m => Int -> Int -> m ()
124+ (UF.take size UF.enumerateFromStepIntegral)
75-------------------------------------------------------------------------------
128-------------------------------------------------------------------------------
76-- Stream generation
129-- Stream generation
77-------------------------------------------------------------------------------
130-------------------------------------------------------------------------------
132+{-# INLINE fromStream #-}
133+fromStream :: Int -> Int -> IO ()
134+fromStream size start =
135+ drainGeneration UF.fromStream (S.replicate size start :: S.SerialT IO Int)
137+{-# INLINE fromStreamK #-}
138+fromStreamK :: Monad m => Int -> Int -> m ()
139+fromStreamK size start = drainGeneration UF.fromStreamK (K.replicate size start)
141+{-# INLINE fromStreamD #-}
142+fromStreamD :: Monad m => Int -> Int -> m ()
143+fromStreamD size start = drainGeneration UF.fromStreamD (D.replicate size start)
146+_nilM :: Monad m => Int -> Int -> m ()
147+_nilM _ start = drainGeneration (UF.nilM return) start
150+consM :: Monad m => Int -> Int -> m ()
151+consM size start = drainTransformationDefault size (UF.consM return) start
153+{-# INLINE _effect #-}
154+_effect :: Monad m => Int -> Int -> m ()
156+ drainGeneration (UF.effect (return start)) undefined
158+{-# INLINE _singletonM #-}
159+_singletonM :: Monad m => Int -> Int -> m ()
160+_singletonM _ start = drainGeneration (UF.singletonM return) start
162+{-# INLINE _singleton #-}
163+_singleton :: Monad m => Int -> Int -> m ()
164+_singleton _ start = drainGeneration (UF.singleton id) start
166+{-# INLINE _identity #-}
167+_identity :: Monad m => Int -> Int -> m ()
168+_identity _ start = drainGeneration UF.identity start
170+{-# INLINE _const #-}
171+_const :: Monad m => Int -> Int -> m ()
173+ drainGeneration (UF.take size (UF.const (return start))) undefined
175+{-# INLINE unfoldrM #-}
176+unfoldrM :: Monad m => Int -> Int -> m ()
177+unfoldrM size start = drainGeneration (UF.unfoldrM step) start
183+ $ if i < start + size
184+ then Just (i, i + 1)
187+{-# INLINE fromList #-}
188+fromList :: Monad m => Int -> Int -> m ()
189+fromList size start = drainGeneration UF.fromList [start .. start + size]
191+{-# INLINE _fromSVar #-}
192+_fromSVar :: Int -> Int -> m ()
193+_fromSVar = undefined
195+{-# INLINE _fromProducer #-}
196+_fromProducer :: Int -> Int -> m ()
197+_fromProducer = undefined
79{-# INLINE fromListM #-}
199{-# INLINE fromListM #-}
80fromListM :: Monad m => Int -> Int -> m ()
200fromListM :: Monad m => Int -> Int -> m ()
81fromListM size start =
201fromListM size start =
@@ -99,10 +219,88 @@ enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
99enumerateFromToIntegral size start =
219enumerateFromToIntegral size start =
100 drainGeneration (UF.enumerateFromToIntegral (size + start)) start
220 drainGeneration (UF.enumerateFromToIntegral (size + start)) start
222+{-# INLINE iterateM #-}
223+iterateM :: Monad m => Int -> Int -> m ()
224+iterateM size start =
225+ drainGeneration (UF.take size (UF.iterateM return)) (return start)
227+{-# INLINE fromIndicesM #-}
228+fromIndicesM :: Monad m => Int -> Int -> m ()
229+fromIndicesM size start =
230+ drainGeneration (UF.take size (UF.fromIndicesM return)) start
232+{-# INLINE enumerateFromIntegral #-}
233+enumerateFromIntegral :: Monad m => Int -> Int -> m ()
234+enumerateFromIntegral size start =
235+ drainGeneration (UF.take size UF.enumerateFromIntegral) start
237+{-# INLINE enumerateFromStepNum #-}
238+enumerateFromStepNum :: Monad m => Int -> Int -> m ()
239+enumerateFromStepNum size start =
240+ drainGeneration (UF.take size (UF.enumerateFromStepNum 1)) start
242+{-# INLINE numFrom #-}
243+numFrom :: Monad m => Int -> Int -> m ()
244+numFrom size start = drainGeneration (UF.take size UF.numFrom) start
246+{-# INLINE enumerateFromToFractional #-}
247+enumerateFromToFractional :: Monad m => Int -> Int -> m ()
248+enumerateFromToFractional size start =
249+ let intToDouble x = (fromInteger (fromIntegral x)) :: Double
251+ (UF.enumerateFromToFractional (intToDouble $ start + size))
102-------------------------------------------------------------------------------
254-------------------------------------------------------------------------------
103-- Stream transformation
255-- Stream transformation
104-------------------------------------------------------------------------------
256-------------------------------------------------------------------------------
259+map :: Monad m => Int -> Int -> m ()
260+map size start = drainTransformationDefault size (UF.map (+1)) start
263+mapM :: Monad m => Int -> Int -> m ()
265+ drainTransformationDefault size (UF.mapM (return . (+) 1)) start
267+{-# INLINE mapMWithInput #-}
268+mapMWithInput :: Monad m => Int -> Int -> m ()
269+mapMWithInput size start =
270+ drainTransformationDefault
272+ (UF.mapMWithInput (\a b -> return $ a + b))
275+{-# INLINE takeWhile #-}
276+takeWhile :: Monad m => Int -> Int -> m ()
277+takeWhile size start =
278+ drainTransformationDefault
280+ (UF.takeWhile (\b -> b <= size + start))
283+{-# INLINE filter #-}
284+filter :: Monad m => Int -> Int -> m ()
286+ drainTransformationDefault size (UF.filter (\_ -> True)) start
289+{-# INLINE filterM #-}
290+filterM :: Monad m => Int -> Int -> m ()
292+ drainTransformationDefault size (UF.filterM (\_ -> (return True))) start
294+{-# INLINE dropWhileTrue #-}
295+dropWhileTrue :: Monad m => Int -> Int -> m ()
296+dropWhileTrue size start =
297+ drainTransformationDefault size (UF.dropWhileM (\_ -> return True)) start
299+{-# INLINE dropWhileFalse #-}
300+dropWhileFalse :: Monad m => Int -> Int -> m ()
301+dropWhileFalse size start =
302+ drainTransformationDefault size (UF.dropWhileM (\_ -> return False)) start
106{-# INLINE take #-}
304{-# INLINE take #-}
107take :: Monad m => Int -> Int -> m ()
305take :: Monad m => Int -> Int -> m ()
108take size start = drainTransformationDefault size (UF.take size) start
306take size start = drainTransformationDefault size (UF.take size) start
@@ -145,6 +343,11 @@ dropWhileMFalse size start =
145-- Stream combination
343-- Stream combination
146-------------------------------------------------------------------------------
344-------------------------------------------------------------------------------
346+{-# INLINE zipWith #-}
347+zipWith :: Monad m => Int -> Int -> m ()
349+ drainProductDefault size (UF.zipWith (+)) (start, start + 1)
148{-# INLINE zipWithM #-}
351{-# INLINE zipWithM #-}
149zipWithM :: Monad m => Int -> Int -> m ()
352zipWithM :: Monad m => Int -> Int -> m ()
150zipWithM size start =
353zipWithM size start =
@@ -153,6 +356,44 @@ zipWithM size start =
153 (UF.zipWithM (\a b -> return $ a + b))
356 (UF.zipWithM (\a b -> return $ a + b))
154 (start, start + 1)
357 (start, start + 1)
359+{-# INLINE teeZipWith #-}
360+teeZipWith :: Monad m => Int -> Int -> m ()
361+teeZipWith size start =
362+ drainProductDefault size (UF.teeZipWith (+)) start
364+-------------------------------------------------------------------------------
366+-------------------------------------------------------------------------------
368+{-# INLINE concatMapM #-}
369+concatMapM :: Monad m => Int -> Int -> m ()
370+concatMapM size start =
371+ drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start
376+ sizeInner = size `div` sizeOuter
380+ $ UF.lmap (\() -> undefined)
381+ $ UF.supply (UF.enumerateFromToIntegral (i + sizeInner)) i
383+ unfoldOut = UF.enumerateFromToIntegral (start + sizeOuter)
386+_ap :: Int -> Int -> m ()
389+{-# INLINE _apDiscardFst #-}
390+_apDiscardFst :: Int -> Int -> m ()
391+_apDiscardFst = undefined
393+{-# INLINE _apDiscardSnd #-}
394+_apDiscardSnd :: Int -> Int -> m ()
395+_apDiscardSnd = undefined
156-------------------------------------------------------------------------------
397-------------------------------------------------------------------------------
157-- Benchmarks
398-- Benchmarks
158-------------------------------------------------------------------------------
399-------------------------------------------------------------------------------
@@ -160,36 +401,93 @@ zipWithM size start =
160moduleName :: String
401moduleName :: String
161moduleName = "Data.Unfold"
402moduleName = "Data.Unfold"
163−o_1_space_generation :: Int -> [Benchmark]
404+o_1_space_generation_input_ops :: Int -> [Benchmark]
164−o_1_space_generation size =
405+o_1_space_generation_input_ops size =
407+ "generation/input-ops"
408+ [ benchIO "lmap" $ lmap size
409+ , benchIO "lmapM" $ lmapM size
410+ , benchIO "supply" $ supply size
411+ , benchIO "supplyFirst" $ supplyFirst size
412+ , benchIO "supplySecond" $ supplySecond size
413+ , benchIO "discardFirst" $ discardFirst size
414+ , benchIO "discardSecond" $ discardSecond size
415+ , benchIO "swap" $ swap size
419+o_1_space_generation_resource :: Int -> [Benchmark]
420+o_1_space_generation_resource size =
422+ "generation/resource"
423+ [ benchIO "fromStream" $ fromStream size
424+ , benchIO "fromStreamK" $ fromStreamK size
425+ , benchIO "fromStreamD" $ fromStreamD size
426+ -- Very small benchmarks, reporting in ns
427+ -- , benchIO "nilM" $ nilM size
428+ , benchIO "consM" $ consM size
429+ -- , benchIO "effect" $ effect size
430+ -- , benchIO "singletonM" $ singletonM size
431+ -- , benchIO "singleton" $ singleton size
432+ -- , benchIO "identity" $ identity size
433+ -- , benchIO "const" $ const size
434+ , benchIO "unfoldrM" $ unfoldrM size
435+ , benchIO "fromList" $ fromList size
436+ , benchIO "fromListM" $ fromListM size
438+ -- , benchIO "fromSVar" $ fromSVar size
439+ -- , benchIO "fromProducer" $ fromProducer size
444+o_1_space_generation_specialized :: Int -> [Benchmark]
445+o_1_space_generation_specialized size =
165− [ bgroup "generation"
446+ [ bgroup
166− [ benchIO "fromListM" $ fromListM size
447+ "generation/specialized"
167− , benchIO "replicateM" $ replicateM size
448+ [ benchIO "replicateM" $ replicateM size
168− , benchIO "repeatM" $ repeatM size
449+ , benchIO "repeatM" $ repeatM size
450+ , benchIO "iterateM" $ iterateM size
451+ , benchIO "fromIndicesM" $ fromIndicesM size
169− , benchIO "enumerateFromStepIntegral" $ enumerateFromStepIntegral size
452+ , benchIO "enumerateFromStepIntegral" $ enumerateFromStepIntegral size
170− , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size
453+ , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size
454+ , benchIO "enumerateFromIntegral" $ enumerateFromIntegral size
455+ , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size
456+ , benchIO "numFrom" $ numFrom size
457+ , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size
174o_1_space_transformation :: Int -> [Benchmark]
461o_1_space_transformation :: Int -> [Benchmark]
175o_1_space_transformation size =
462o_1_space_transformation size =
176− [ bgroup "transformation"
464+ "transformation"
177− [ benchIO "take" $ take size
465+ [ benchIO "map" $ map size
466+ , benchIO "mapM" $ mapM size
467+ , benchIO "mapMWithInput" $ mapMWithInput size
178− , benchIO "takeWhileM" $ takeWhileM size
468+ , benchIO "takeWhileM" $ takeWhileM size
469+ , benchIO "takeWhile" $ takeWhile size
470+ , benchIO "take" $ take size
471+ , benchIO "filter" $ filter size
472+ , benchIO "filterM" $ filterM size
179− -- This will take nanoseconds, We need to fix the benchmark reporting to
473+ -- Very small benchmark, reporting in ns
180− -- have microseconds as the minimum unit before uncommenting this.
474+ -- , benchIO "dropOne" $ dropOne size
181− -- , benchIO "dropOne" $ dropOne size
475+ , benchIO "dropAll" $ dropAll size
182− , benchIO "dropAll" $ dropAll size
476+ , benchIO "dropWhileTrue" $ dropWhileTrue size
477+ , benchIO "dropWhileFalse" $ dropWhileFalse size
183− , benchIO "dropWhileMTrue" $ dropWhileMTrue size
478+ , benchIO "dropWhileMTrue" $ dropWhileMTrue size
184− , benchIO "dropWhileMFalse" $ dropWhileMFalse size
479+ , benchIO "dropWhileMFalse" $ dropWhileMFalse size
188o_1_space_combination :: Int -> [Benchmark]
483o_1_space_combination :: Int -> [Benchmark]
189o_1_space_combination size =
484o_1_space_combination size =
190− [ bgroup "combination"
486+ "combination"
191− [ benchIO "zipWithM" $ zipWithM size
487+ [ benchIO "zipWithM" $ zipWithM size
488+ , benchIO "zipWith" $ zipWith size
489+ , benchIO "teeZipWith" $ teeZipWith size
195o_1_space_nested :: Int -> [Benchmark]
493o_1_space_nested :: Int -> [Benchmark]
@@ -202,6 +500,11 @@ o_1_space_nested size =
202 , benchIO "filterAllOut" $ Nested.filterAllOut size
500 , benchIO "filterAllOut" $ Nested.filterAllOut size
203 , benchIO "filterAllIn" $ Nested.filterAllIn size
501 , benchIO "filterAllIn" $ Nested.filterAllIn size
204 , benchIO "filterSome" $ Nested.filterSome size
502 , benchIO "filterSome" $ Nested.filterSome size
503+ , benchIO "concatMapM (100 x n/100)" $ concatMapM size
505+ -- , benchIO "ap" $ ap size
506+ -- , benchIO "apDiscardFst" $ apDiscardFst size
507+ -- , benchIO "apDiscardSnd" $ apDiscardSnd size
@@ -227,7 +530,9 @@ main = do
227 allBenchmarks size =
530 allBenchmarks size =
228 [ bgroup (o_1_space_prefix moduleName)
531 [ bgroup (o_1_space_prefix moduleName)
229 $ Prelude.concat
532 $ Prelude.concat
230− [ o_1_space_generation size
533+ [ o_1_space_generation_input_ops size
534+ , o_1_space_generation_resource size
535+ , o_1_space_generation_specialized size
231 , o_1_space_transformation size
536 , o_1_space_transformation size
232 , o_1_space_combination size
537 , o_1_space_combination size
233 , o_1_space_nested size
538 , o_1_space_nested size