@@ -16,11 +16,14 @@ import Streamly.Internal.Data.Unfold (Unfold)
1616import qualified Prelude
1717import qualified Streamly.Internal.Data.Fold as FL
1818import 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
1922import qualified Streamly.Benchmark.Data.NestedUnfoldOps as Nested
2023
2124import Streamly.Benchmark.Common
2225import Gauge
23−import Prelude hiding (concat, take)
26+import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)
2427
2528{-# INLINE benchIO #-}
2629benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
@@ -30,18 +33,14 @@ benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
3033-- Benchmark helpers
3134-------------------------------------------------------------------------------
3235
33−{-# INLINE drainUnfold #-}
34−drainUnfold :: Monad m => Unfold m a b -> a -> m ()
35−drainUnfold unf seed = UF.fold unf FL.drain seed
36−
3736{-# INLINE drainGeneration #-}
3837drainGeneration :: Monad m => Unfold m a b -> a -> m ()
39−drainGeneration = drainUnfold
38+drainGeneration unf seed = UF.fold unf FL.drain seed
4039
4140{-# INLINE drainTransformation #-}
4241drainTransformation ::
4342 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
4544
4645{-# INLINE drainTransformationDefault #-}
4746drainTransformationDefault ::
@@ -57,7 +56,7 @@ drainProduct ::
5756 -> (Unfold m a b -> Unfold m c d -> Unfold m e f)
5857 -> e
5958 -> m ()
60−drainProduct unf1 unf2 f seed = drainUnfold (f unf1 unf2) seed
59+drainProduct unf1 unf2 f seed = drainGeneration (f unf1 unf2) seed
6160
6261{-# INLINE drainProductDefault #-}
6362drainProductDefault ::
@@ -66,16 +65,137 @@ drainProductDefault ::
6665 -> (Unfold m Int Int -> Unfold m Int Int -> Unfold m e f)
6766 -> e
6867 -> m ()
69−drainProductDefault size = drainProduct src src
68+drainProductDefault size = drainProduct src1 src2
7069
7170 where
7271
73− src = UF.take size UF.enumerateFromIntegral
72+ src1 = UF.take size UF.enumerateFromIntegral
73+ src2 = UF.take size (UF.supplySecond UF.enumerateFromStepIntegral 2)
74+
75+-------------------------------------------------------------------------------
76+-- Operations on input
77+-------------------------------------------------------------------------------
78+
79+{-# INLINE lmap #-}
80+lmap :: Monad m => Int -> Int -> m ()
81+lmap size start = drainTransformationDefault size (UF.lmap (+ 1)) start
82+
83+{-# INLINE lmapM #-}
84+lmapM :: Monad m => Int -> Int -> m ()
85+lmapM size start =
86+ drainTransformationDefault size (UF.lmapM (return . (+) 1)) start
87+
88+{-# INLINE supply #-}
89+supply :: Monad m => Int -> Int -> m ()
90+supply size start =
91+ drainTransformationDefault size (flip UF.supply start) undefined
92+
93+
94+{-# INLINE supplyFirst #-}
95+supplyFirst :: Monad m => Int -> Int -> m ()
96+supplyFirst size start =
97+ drainTransformation
98+ (UF.take size UF.enumerateFromStepIntegral)
99+ (flip UF.supplyFirst start)
100+ 1
101+
102+{-# INLINE supplySecond #-}
103+supplySecond :: Monad m => Int -> Int -> m ()
104+supplySecond size start =
105+ drainTransformation
106+ (UF.take size UF.enumerateFromStepIntegral)
107+ (flip UF.supplySecond 1)
108+ start
109+
110+{-# INLINE discardFirst #-}
111+discardFirst :: Monad m => Int -> Int -> m ()
112+discardFirst size start =
113+ drainTransformationDefault size UF.discardFirst (start, start)
114+
115+{-# INLINE discardSecond #-}
116+discardSecond :: Monad m => Int -> Int -> m ()
117+discardSecond size start =
118+ drainTransformationDefault size UF.discardSecond (start, start)
119+
120+{-# INLINE swap #-}
121+swap :: Monad m => Int -> Int -> m ()
122+swap size start =
123+ drainTransformation
124+ (UF.take size UF.enumerateFromStepIntegral)
125+ UF.swap
126+ (1, start)
74127
75128-------------------------------------------------------------------------------
76129-- Stream generation
77130-------------------------------------------------------------------------------
78131
132+{-# INLINE fromStream #-}
133+fromStream :: Int -> Int -> IO ()
134+fromStream size start =
135+ drainGeneration UF.fromStream (S.replicate size start :: S.SerialT IO Int)
136+
137+{-# INLINE fromStreamK #-}
138+fromStreamK :: Monad m => Int -> Int -> m ()
139+fromStreamK size start = drainGeneration UF.fromStreamK (K.replicate size start)
140+
141+{-# INLINE fromStreamD #-}
142+fromStreamD :: Monad m => Int -> Int -> m ()
143+fromStreamD size start = drainGeneration UF.fromStreamD (D.replicate size start)
144+
145+{-# INLINE _nilM #-}
146+_nilM :: Monad m => Int -> Int -> m ()
147+_nilM _ start = drainGeneration (UF.nilM return) start
148+
149+{-# INLINE consM #-}
150+consM :: Monad m => Int -> Int -> m ()
151+consM size start = drainTransformationDefault size (UF.consM return) start
152+
153+{-# INLINE _effect #-}
154+_effect :: Monad m => Int -> Int -> m ()
155+_effect _ start =
156+ drainGeneration (UF.effect (return start)) undefined
157+
158+{-# INLINE _singletonM #-}
159+_singletonM :: Monad m => Int -> Int -> m ()
160+_singletonM _ start = drainGeneration (UF.singletonM return) start
161+
162+{-# INLINE _singleton #-}
163+_singleton :: Monad m => Int -> Int -> m ()
164+_singleton _ start = drainGeneration (UF.singleton id) start
165+
166+{-# INLINE _identity #-}
167+_identity :: Monad m => Int -> Int -> m ()
168+_identity _ start = drainGeneration UF.identity start
169+
170+{-# INLINE _const #-}
171+_const :: Monad m => Int -> Int -> m ()
172+_const size start =
173+ drainGeneration (UF.take size (UF.const (return start))) undefined
174+
175+{-# INLINE unfoldrM #-}
176+unfoldrM :: Monad m => Int -> Int -> m ()
177+unfoldrM size start = drainGeneration (UF.unfoldrM step) start
178+
179+ where
180+
181+ step i =
182+ return
183+ $ if i < start + size
184+ then Just (i, i + 1)
185+ else Nothing
186+
187+{-# INLINE fromList #-}
188+fromList :: Monad m => Int -> Int -> m ()
189+fromList size start = drainGeneration UF.fromList [start .. start + size]
190+
191+{-# INLINE _fromSVar #-}
192+_fromSVar :: Int -> Int -> m ()
193+_fromSVar = undefined
194+
195+{-# INLINE _fromProducer #-}
196+_fromProducer :: Int -> Int -> m ()
197+_fromProducer = undefined
198+
79199{-# INLINE fromListM #-}
80200fromListM :: Monad m => Int -> Int -> m ()
81201fromListM size start =
@@ -99,10 +219,88 @@ enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
99219enumerateFromToIntegral size start =
100220 drainGeneration (UF.enumerateFromToIntegral (size + start)) start
101221
222+{-# INLINE iterateM #-}
223+iterateM :: Monad m => Int -> Int -> m ()
224+iterateM size start =
225+ drainGeneration (UF.take size (UF.iterateM return)) (return start)
226+
227+{-# INLINE fromIndicesM #-}
228+fromIndicesM :: Monad m => Int -> Int -> m ()
229+fromIndicesM size start =
230+ drainGeneration (UF.take size (UF.fromIndicesM return)) start
231+
232+{-# INLINE enumerateFromIntegral #-}
233+enumerateFromIntegral :: Monad m => Int -> Int -> m ()
234+enumerateFromIntegral size start =
235+ drainGeneration (UF.take size UF.enumerateFromIntegral) start
236+
237+{-# INLINE enumerateFromStepNum #-}
238+enumerateFromStepNum :: Monad m => Int -> Int -> m ()
239+enumerateFromStepNum size start =
240+ drainGeneration (UF.take size (UF.enumerateFromStepNum 1)) start
241+
242+{-# INLINE numFrom #-}
243+numFrom :: Monad m => Int -> Int -> m ()
244+numFrom size start = drainGeneration (UF.take size UF.numFrom) start
245+
246+{-# INLINE enumerateFromToFractional #-}
247+enumerateFromToFractional :: Monad m => Int -> Int -> m ()
248+enumerateFromToFractional size start =
249+ let intToDouble x = (fromInteger (fromIntegral x)) :: Double
250+ in drainGeneration
251+ (UF.enumerateFromToFractional (intToDouble $ start + size))
252+ (intToDouble start)
253+
102254-------------------------------------------------------------------------------
103255-- Stream transformation
104256-------------------------------------------------------------------------------
105257
258+{-# INLINE map #-}
259+map :: Monad m => Int -> Int -> m ()
260+map size start = drainTransformationDefault size (UF.map (+1)) start
261+
262+{-# INLINE mapM #-}
263+mapM :: Monad m => Int -> Int -> m ()
264+mapM size start =
265+ drainTransformationDefault size (UF.mapM (return . (+) 1)) start
266+
267+{-# INLINE mapMWithInput #-}
268+mapMWithInput :: Monad m => Int -> Int -> m ()
269+mapMWithInput size start =
270+ drainTransformationDefault
271+ size
272+ (UF.mapMWithInput (\a b -> return $ a + b))
273+ start
274+
275+{-# INLINE takeWhile #-}
276+takeWhile :: Monad m => Int -> Int -> m ()
277+takeWhile size start =
278+ drainTransformationDefault
279+ size
280+ (UF.takeWhile (\b -> b <= size + start))
281+ start
282+
283+{-# INLINE filter #-}
284+filter :: Monad m => Int -> Int -> m ()
285+filter size start =
286+ drainTransformationDefault size (UF.filter (\_ -> True)) start
287+
288+
289+{-# INLINE filterM #-}
290+filterM :: Monad m => Int -> Int -> m ()
291+filterM size start =
292+ drainTransformationDefault size (UF.filterM (\_ -> (return True))) start
293+
294+{-# INLINE dropWhileTrue #-}
295+dropWhileTrue :: Monad m => Int -> Int -> m ()
296+dropWhileTrue size start =
297+ drainTransformationDefault size (UF.dropWhileM (\_ -> return True)) start
298+
299+{-# INLINE dropWhileFalse #-}
300+dropWhileFalse :: Monad m => Int -> Int -> m ()
301+dropWhileFalse size start =
302+ drainTransformationDefault size (UF.dropWhileM (\_ -> return False)) start
303+
106304{-# INLINE take #-}
107305take :: Monad m => Int -> Int -> m ()
108306take size start = drainTransformationDefault size (UF.take size) start
@@ -145,6 +343,11 @@ dropWhileMFalse size start =
145343-- Stream combination
146344-------------------------------------------------------------------------------
147345
346+{-# INLINE zipWith #-}
347+zipWith :: Monad m => Int -> Int -> m ()
348+zipWith size start =
349+ drainProductDefault size (UF.zipWith (+)) (start, start + 1)
350+
148351{-# INLINE zipWithM #-}
149352zipWithM :: Monad m => Int -> Int -> m ()
150353zipWithM size start =
@@ -153,6 +356,44 @@ zipWithM size start =
153356 (UF.zipWithM (\a b -> return $ a + b))
154357 (start, start + 1)
155358
359+{-# INLINE teeZipWith #-}
360+teeZipWith :: Monad m => Int -> Int -> m ()
361+teeZipWith size start =
362+ drainProductDefault size (UF.teeZipWith (+)) start
363+
364+-------------------------------------------------------------------------------
365+-- Nested
366+-------------------------------------------------------------------------------
367+
368+{-# INLINE concatMapM #-}
369+concatMapM :: Monad m => Int -> Int -> m ()
370+concatMapM size start =
371+ drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start
372+
373+ where
374+
375+ sizeOuter = 100
376+ sizeInner = size `div` sizeOuter
377+
378+ unfoldInGen i =
379+ return
380+ $ UF.lmap (\() -> undefined)
381+ $ UF.supply (UF.enumerateFromToIntegral (i + sizeInner)) i
382+
383+ unfoldOut = UF.enumerateFromToIntegral (start + sizeOuter)
384+
385+{-# INLINE _ap #-}
386+_ap :: Int -> Int -> m ()
387+_ap = undefined
388+
389+{-# INLINE _apDiscardFst #-}
390+_apDiscardFst :: Int -> Int -> m ()
391+_apDiscardFst = undefined
392+
393+{-# INLINE _apDiscardSnd #-}
394+_apDiscardSnd :: Int -> Int -> m ()
395+_apDiscardSnd = undefined
396+
156397-------------------------------------------------------------------------------
157398-- Benchmarks
158399-------------------------------------------------------------------------------
@@ -160,36 +401,93 @@ zipWithM size start =
160401moduleName :: String
161402moduleName = "Data.Unfold"
162403
163−o_1_space_generation :: Int -> [Benchmark]
164−o_1_space_generation size =
165− [ bgroup "generation"
166− [ benchIO "fromListM" $ fromListM size
167− , benchIO "replicateM" $ replicateM size
168− , benchIO "repeatM" $ repeatM size
169− , benchIO "enumerateFromStepIntegral" $ enumerateFromStepIntegral size
170− , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size
171− ]
404+o_1_space_generation_input_ops :: Int -> [Benchmark]
405+o_1_space_generation_input_ops size =
406+ [ bgroup
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
416+ ]
417+ ]
418+
419+o_1_space_generation_resource :: Int -> [Benchmark]
420+o_1_space_generation_resource size =
421+ [ bgroup
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
437+ -- Unimplemented
438+ -- , benchIO "fromSVar" $ fromSVar size
439+ -- , benchIO "fromProducer" $ fromProducer size
440+ ]
441+ ]
442+
443+
444+o_1_space_generation_specialized :: Int -> [Benchmark]
445+o_1_space_generation_specialized size =
446+ [ bgroup
447+ "generation/specialized"
448+ [ benchIO "replicateM" $ replicateM size
449+ , benchIO "repeatM" $ repeatM size
450+ , benchIO "iterateM" $ iterateM size
451+ , benchIO "fromIndicesM" $ fromIndicesM size
452+ , benchIO "enumerateFromStepIntegral" $ enumerateFromStepIntegral 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
458+ ]
172459 ]
173460
174461o_1_space_transformation :: Int -> [Benchmark]
175462o_1_space_transformation size =
176− [ bgroup "transformation"
177− [ benchIO "take" $ take size
178− , benchIO "takeWhileM" $ takeWhileM size
179− -- This will take nanoseconds, We need to fix the benchmark reporting to
180− -- have microseconds as the minimum unit before uncommenting this.
181− -- , benchIO "dropOne" $ dropOne size
182− , benchIO "dropAll" $ dropAll size
183− , benchIO "dropWhileMTrue" $ dropWhileMTrue size
184− , benchIO "dropWhileMFalse" $ dropWhileMFalse size
185− ]
463+ [ bgroup
464+ "transformation"
465+ [ benchIO "map" $ map size
466+ , benchIO "mapM" $ mapM size
467+ , benchIO "mapMWithInput" $ mapMWithInput 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
473+ -- Very small benchmark, reporting in ns
474+ -- , benchIO "dropOne" $ dropOne size
475+ , benchIO "dropAll" $ dropAll size
476+ , benchIO "dropWhileTrue" $ dropWhileTrue size
477+ , benchIO "dropWhileFalse" $ dropWhileFalse size
478+ , benchIO "dropWhileMTrue" $ dropWhileMTrue size
479+ , benchIO "dropWhileMFalse" $ dropWhileMFalse size
480+ ]
186481 ]
187482
188483o_1_space_combination :: Int -> [Benchmark]
189484o_1_space_combination size =
190− [ bgroup "combination"
191− [ benchIO "zipWithM" $ zipWithM size
192− ]
485+ [ bgroup
486+ "combination"
487+ [ benchIO "zipWithM" $ zipWithM size
488+ , benchIO "zipWith" $ zipWith size
489+ , benchIO "teeZipWith" $ teeZipWith size
490+ ]
193491 ]
194492
195493o_1_space_nested :: Int -> [Benchmark]
@@ -202,6 +500,11 @@ o_1_space_nested size =
202500 , benchIO "filterAllOut" $ Nested.filterAllOut size
203501 , benchIO "filterAllIn" $ Nested.filterAllIn size
204502 , benchIO "filterSome" $ Nested.filterSome size
503+ , benchIO "concatMapM (100 x n/100)" $ concatMapM size
504+ -- Unimplemented
505+ -- , benchIO "ap" $ ap size
506+ -- , benchIO "apDiscardFst" $ apDiscardFst size
507+ -- , benchIO "apDiscardSnd" $ apDiscardSnd size
205508 ]
206509 ]
207510
@@ -227,7 +530,9 @@ main = do
227530 allBenchmarks size =
228531 [ bgroup (o_1_space_prefix moduleName)
229532 $ 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
231536 , o_1_space_transformation size
232537 , o_1_space_combination size
233538 , o_1_space_nested size