git.iko.soy/streamly
on master help sign in
Merge pull request #1751
f5ef713Harendra Kumar
.github/workflows/regression-check.yml+1−1
compare with master
unifiedsplit
@@ -29,11 +29,11 @@ jobs:
29 Data.Stream.StreamDK
29 Data.Stream.StreamDK
30 Data.Stream.StreamK:6
30 Data.Stream.StreamK:6
31 Data.Unfold
31 Data.Unfold
32+ Data.Stream
32 FileSystem.Handle
33 FileSystem.Handle
33 Prelude.Ahead
34 Prelude.Ahead
34 Prelude.Async:12
35 Prelude.Async:12
35 Prelude.Parallel
36 Prelude.Parallel
36− Prelude.Serial
37 Prelude.WAsync:6
37 Prelude.WAsync:6
38 Prelude.WSerial
38 Prelude.WSerial
39 Prelude.ZipAsync
39 Prelude.ZipAsync
.hlint.yaml+7−6
@@ -26,12 +26,13 @@
26- ignore: {name: "Use fmap"}
26- ignore: {name: "Use fmap"}
27
27
28# Warnings ignored in specific places
28# Warnings ignored in specific places
29−- ignore: {name: "Use ++", within: Serial.Transformation}
29+- ignore: {name: "Use ++", within: Stream.Transform}
30−- ignore: {name: "Use mapM", within: Serial.Transformation}
30+- ignore: {name: "Use mapM", within: Stream.Transform}
31−- ignore: {name: "Use traverse", within: Serial.Transformation}
31+- ignore: {name: "Use traverse", within: Stream.Transform}
32−
33−- ignore: {name: "Redundant <*", within: Serial.NestedStream}
32+- ignore: {name: "Redundant <*", within: Stream.Expand}
33+- ignore: {name: "Use ++", within: Stream.Reduce}
34−- ignore: {name: "Use ++", within: Serial.NestedStream}
34+- ignore: {name: "Use ++", within: Stream.Split}
35+- ignore: {name: "Redundant bracket", within: Stream.Split}
35- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Char.Parser}
36- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Char.Parser}
36
37
37# Specify additional command line arguments
38# Specify additional command line arguments
benchmark/Streamly/Benchmark/Prelude/Serial.hs → benchmark/Streamly/Benchmark/Data/Stream.hsrenamed+14−10
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Serial
2+-- Module : Data.Stream
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -13,19 +13,21 @@ module Main (main) where
13
13
14import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
14import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
15
15
16−import qualified Serial.Elimination as Elimination
16+import qualified Stream.Eliminate as Elimination
17−import qualified Serial.Exceptions as Exceptions
17+import qualified Stream.Exceptions as Exceptions
18−import qualified Serial.Generation as Generation
18+import qualified Stream.Expand as NestedStream
19−import qualified Serial.NestedStream as NestedStream
19+import qualified Stream.Generate as Generation
20−import qualified Serial.Split as Split
20+import qualified Stream.Lift as Lift
21−import qualified Serial.Transformation as Transformation
21+import qualified Stream.Reduce as NestedFold
22+#ifdef USE_PRELUDE
22−import qualified Serial.NestedFold as NestedFold
23+import qualified Stream.Split as Split
24+#endif
23−import qualified Serial.Lift as Lift
25+import qualified Stream.Transform as Transformation
24
26
25import Streamly.Benchmark.Common
27import Streamly.Benchmark.Common
26
28
27moduleName :: String
29moduleName :: String
28−moduleName = "Prelude.Serial"
30+moduleName = "Data.Stream"
29
31
30-------------------------------------------------------------------------------
32-------------------------------------------------------------------------------
31-- Main
33-- Main
@@ -45,7 +47,9 @@ main = do
45 [ Generation.benchmarks moduleName size
47 [ Generation.benchmarks moduleName size
46 , Elimination.benchmarks moduleName size
48 , Elimination.benchmarks moduleName size
47 , Exceptions.benchmarks moduleName env size
49 , Exceptions.benchmarks moduleName env size
50+#ifdef USE_PRELUDE
48 , Split.benchmarks moduleName env
51 , Split.benchmarks moduleName env
52+#endif
49 , Transformation.benchmarks moduleName size
53 , Transformation.benchmarks moduleName size
50 , NestedFold.benchmarks moduleName size
54 , NestedFold.benchmarks moduleName size
51 , Lift.benchmarks moduleName size
55 , Lift.benchmarks moduleName size
benchmark/Streamly/Benchmark/Data/Stream/Common.hsnew file+472
@@ -0,0 +1,472 @@
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+
6+-- |
7+-- Module : Stream.Common
8+-- Copyright : (c) 2018 Composewell Technologies
9+-- License : BSD-3-Clause
10+-- Maintainer : streamly@composewell.com
11+
12+module Stream.Common
13+ ( MonadAsync
14+
15+ -- Generation
16+ , enumerateFromTo
17+ , replicate
18+ , unfoldrM
19+ , fromListM
20+
21+ , append
22+ , append2
23+
24+ -- Elimination
25+ , drain
26+ , foldl'
27+ , scanl'
28+
29+ -- Benchmark stream generation
30+ , sourceUnfoldr
31+ , sourceUnfoldrM
32+ , sourceUnfoldrAction
33+ , sourceConcatMapId
34+ , sourceFromFoldable
35+ , sourceFromFoldableM
36+
37+ -- Benchmark stream elimination
38+ , benchIOSink
39+ , benchIOSrc
40+
41+ -- Benchmarking functions
42+ , concatStreamsWith
43+ , concatPairsWith
44+ , apDiscardFst
45+ , apDiscardSnd
46+ , apLiftA2
47+ , toNullAp
48+ , monadThen
49+ , toNullM
50+ , toNullM3
51+ , filterAllOutM
52+ , filterAllInM
53+ , filterSome
54+ , breakAfterSome
55+ , toListM
56+ , toListSome
57+ , composeN
58+ , mapN
59+ , mapM
60+ , transformMapM
61+ , transformComposeMapM
62+ , transformTeeMapM
63+ , transformZipMapM
64+ )
65+where
66+
67+import Control.Applicative (liftA2)
68+import Control.Exception (try)
69+import GHC.Exception (ErrorCall)
70+import Streamly.Internal.Data.Stream (Stream)
71+import System.Random (randomRIO)
72+
73+import qualified Streamly.Internal.Data.Fold as Fold
74+import qualified Streamly.Internal.Data.Pipe as Pipe
75+
76+#ifdef USE_PRELUDE
77+import Streamly.Prelude (foldl', scanl')
78+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
79+import qualified Streamly.Prelude as Stream
80+import Streamly.Benchmark.Prelude
81+ ( composeN, sourceUnfoldr, sourceUnfoldr, sourceFromFoldable
82+ , sourceFromFoldableM, sourceUnfoldrAction, sourceConcatMapId, benchIOSink
83+ , concatStreamsWith, concatPairsWith
84+ )
85+#else
86+import Control.DeepSeq (NFData)
87+import Streamly.Internal.Data.Stream (unfold)
88+import qualified Streamly.Internal.Data.Stream as Stream
89+import qualified Streamly.Internal.Data.Unfold as Unfold
90+#endif
91+
92+import Gauge
93+import Prelude hiding (mapM, replicate)
94+
95+#ifdef USE_PRELUDE
96+type MonadAsync m = Stream.MonadAsync m
97+#else
98+type MonadAsync = Monad
99+#endif
100+
101+{-# INLINE append #-}
102+append :: Stream m a -> Stream m a -> Stream m a
103+#ifdef USE_PRELUDE
104+append = Stream.serial
105+#else
106+append = Stream.append
107+#endif
108+
109+{-# INLINE append2 #-}
110+append2 :: Monad m => Stream m a -> Stream m a -> Stream m a
111+#ifdef USE_PRELUDE
112+append2 = Stream.append
113+#else
114+append2 = Stream.append2
115+#endif
116+
117+{-# INLINE drain #-}
118+drain :: Monad m => Stream m a -> m ()
119+drain = Stream.fold Fold.drain
120+
121+{-# INLINE enumerateFromTo #-}
122+enumerateFromTo :: Monad m => Int -> Int -> Stream m Int
123+#ifdef USE_PRELUDE
124+enumerateFromTo = Stream.enumerateFromTo
125+#else
126+enumerateFromTo from to = Stream.unfold Unfold.enumerateFromTo (from, to)
127+#endif
128+
129+{-# INLINE replicate #-}
130+replicate :: Monad m => Int -> a -> Stream m a
131+#ifdef USE_PRELUDE
132+replicate = Stream.replicate
133+#else
134+replicate n = Stream.unfold (Unfold.replicateM n) . return
135+#endif
136+
137+{-# INLINE unfoldrM #-}
138+unfoldrM :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> Stream m a
139+#ifdef USE_PRELUDE
140+unfoldrM = Stream.unfoldrM
141+#else
142+unfoldrM step = Stream.unfold (Unfold.unfoldrM step)
143+#endif
144+
145+{-# INLINE fromListM #-}
146+fromListM :: MonadAsync m => [m a] -> Stream m a
147+#ifdef USE_PRELUDE
148+fromListM = Stream.fromListM
149+#else
150+fromListM = Stream.unfold Unfold.fromListM
151+#endif
152+
153+{-# INLINE sourceUnfoldrM #-}
154+sourceUnfoldrM :: MonadAsync m => Int -> Int -> Stream m Int
155+sourceUnfoldrM count start = unfoldrM step start
156+
157+ where
158+
159+ step cnt =
160+ if cnt > start + count
161+ then return Nothing
162+ else return (Just (cnt, cnt + 1))
163+
164+#ifndef USE_PRELUDE
165+{-# INLINE sourceUnfoldr #-}
166+sourceUnfoldr :: Monad m => Int -> Int -> Stream m Int
167+sourceUnfoldr count start = unfold (Unfold.unfoldr step) start
168+
169+ where
170+
171+ step cnt =
172+ if cnt > start + count
173+ then Nothing
174+ else Just (cnt, cnt + 1)
175+
176+{-# INLINE sourceUnfoldrAction #-}
177+sourceUnfoldrAction :: (Monad m1, Monad m) => Int -> Int -> Stream m (m1 Int)
178+sourceUnfoldrAction value n = unfold (Unfold.unfoldr step) n
179+
180+ where
181+
182+ step cnt =
183+ if cnt > n + value
184+ then Nothing
185+ else Just (return cnt, cnt + 1)
186+
187+{-# INLINE sourceFromFoldable #-}
188+sourceFromFoldable :: Int -> Int -> Stream m Int
189+sourceFromFoldable value n = Stream.fromFoldable [n..n+value]
190+
191+{-# INLINE sourceFromFoldableM #-}
192+sourceFromFoldableM :: Monad m => Int -> Int -> Stream m Int
193+sourceFromFoldableM value n = Stream.fromFoldableM (fmap return [n..n+value])
194+
195+{-# INLINE benchIOSink #-}
196+benchIOSink
197+ :: (NFData b)
198+ => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
199+benchIOSink value name f =
200+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
201+#endif
202+
203+-- | Takes a source, and uses it with a default drain/fold method.
204+{-# INLINE benchIOSrc #-}
205+benchIOSrc
206+ :: String
207+ -> (Int -> Stream IO a)
208+ -> Benchmark
209+benchIOSrc name f =
210+ bench name $ nfIO $ randomRIO (1,1) >>= drain . f
211+
212+#ifndef USE_PRELUDE
213+{-# INLINE concatStreamsWith #-}
214+concatStreamsWith
215+ :: (Stream IO Int -> Stream IO Int -> Stream IO Int)
216+ -> Int
217+ -> Int
218+ -> Int
219+ -> IO ()
220+concatStreamsWith op outer inner n =
221+ drain $ Stream.concatMapWith op
222+ (sourceUnfoldrM inner)
223+ (sourceUnfoldrM outer n)
224+
225+{-# INLINE concatPairsWith #-}
226+concatPairsWith
227+ :: (Stream IO Int -> Stream IO Int -> Stream IO Int)
228+ -> Int
229+ -> Int
230+ -> Int
231+ -> IO ()
232+concatPairsWith op outer inner n =
233+ drain $ Stream.concatPairsWith op
234+ (sourceUnfoldrM inner)
235+ (sourceUnfoldrM outer n)
236+
237+{-# INLINE sourceConcatMapId #-}
238+sourceConcatMapId :: (Monad m)
239+ => Int -> Int -> Stream m (Stream m Int)
240+sourceConcatMapId value n =
241+ Stream.fromFoldable $ fmap (Stream.fromEffect . return) [n..n+value]
242+#endif
243+
244+{-# INLINE apDiscardFst #-}
245+apDiscardFst :: MonadAsync m =>
246+ Int -> Int -> m ()
247+apDiscardFst linearCount start = drain $
248+ sourceUnfoldrM nestedCount2 start
249+ *> sourceUnfoldrM nestedCount2 start
250+
251+ where
252+
253+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
254+
255+{-# INLINE apDiscardSnd #-}
256+apDiscardSnd :: MonadAsync m => Int -> Int -> m ()
257+apDiscardSnd linearCount start = drain $
258+ sourceUnfoldrM nestedCount2 start
259+ <* sourceUnfoldrM nestedCount2 start
260+
261+ where
262+
263+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
264+
265+{-# INLINE apLiftA2 #-}
266+apLiftA2 :: MonadAsync m => Int -> Int -> m ()
267+apLiftA2 linearCount start = drain $
268+ liftA2 (+) (sourceUnfoldrM nestedCount2 start)
269+ (sourceUnfoldrM nestedCount2 start)
270+
271+ where
272+
273+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
274+
275+{-# INLINE toNullAp #-}
276+toNullAp :: MonadAsync m => Int -> Int -> m ()
277+toNullAp linearCount start = drain $
278+ (+) <$> sourceUnfoldrM nestedCount2 start
279+ <*> sourceUnfoldrM nestedCount2 start
280+
281+ where
282+
283+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
284+
285+{-# INLINE monadThen #-}
286+monadThen :: MonadAsync m => Int -> Int -> m ()
287+monadThen linearCount start = drain $ do
288+ sourceUnfoldrM nestedCount2 start >>
289+ sourceUnfoldrM nestedCount2 start
290+
291+ where
292+
293+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
294+
295+{-# INLINE toNullM #-}
296+toNullM :: MonadAsync m => Int -> Int -> m ()
297+toNullM linearCount start = drain $ do
298+ x <- sourceUnfoldrM nestedCount2 start
299+ y <- sourceUnfoldrM nestedCount2 start
300+ return $ x + y
301+
302+ where
303+
304+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
305+
306+{-# INLINE toNullM3 #-}
307+toNullM3 :: MonadAsync m => Int -> Int -> m ()
308+toNullM3 linearCount start = drain $ do
309+ x <- sourceUnfoldrM nestedCount3 start
310+ y <- sourceUnfoldrM nestedCount3 start
311+ z <- sourceUnfoldrM nestedCount3 start
312+ return $ x + y + z
313+ where
314+ nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
315+
316+{-# INLINE filterAllOutM #-}
317+filterAllOutM :: MonadAsync m => Int -> Int -> m ()
318+filterAllOutM linearCount start = drain $ do
319+ x <- sourceUnfoldrM nestedCount2 start
320+ y <- sourceUnfoldrM nestedCount2 start
321+ let s = x + y
322+ if s < 0
323+ then return s
324+ else Stream.nil
325+ where
326+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
327+
328+{-# INLINE filterAllInM #-}
329+filterAllInM :: MonadAsync m => Int -> Int -> m ()
330+filterAllInM linearCount start = drain $ do
331+ x <- sourceUnfoldrM nestedCount2 start
332+ y <- sourceUnfoldrM nestedCount2 start
333+ let s = x + y
334+ if s > 0
335+ then return s
336+ else Stream.nil
337+ where
338+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
339+
340+{-# INLINE filterSome #-}
341+filterSome :: MonadAsync m => Int -> Int -> m ()
342+filterSome linearCount start = drain $ do
343+ x <- sourceUnfoldrM nestedCount2 start
344+ y <- sourceUnfoldrM nestedCount2 start
345+ let s = x + y
346+ if s > 1100000
347+ then return s
348+ else Stream.nil
349+ where
350+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
351+
352+{-# INLINE breakAfterSome #-}
353+breakAfterSome :: Int -> Int -> IO ()
354+breakAfterSome linearCount start = do
355+ (_ :: Either ErrorCall ()) <- try $ drain $ do
356+ x <- sourceUnfoldrM nestedCount2 start
357+ y <- sourceUnfoldrM nestedCount2 start
358+ let s = x + y
359+ if s > 1100000
360+ then error "break"
361+ else return s
362+ return ()
363+ where
364+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
365+
366+{-# INLINE toListM #-}
367+toListM :: MonadAsync m => Int -> Int -> m [Int]
368+toListM linearCount start = Stream.fold Fold.toList $ do
369+ x <- sourceUnfoldrM nestedCount2 start
370+ y <- sourceUnfoldrM nestedCount2 start
371+ return $ x + y
372+ where
373+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
374+
375+-- Taking a specified number of elements is very expensive in logict so we have
376+-- a test to measure the same.
377+{-# INLINE toListSome #-}
378+toListSome :: MonadAsync m => Int -> Int -> m [Int]
379+toListSome linearCount start =
380+ Stream.fold Fold.toList $ Stream.take 10000 $ do
381+ x <- sourceUnfoldrM nestedCount2 start
382+ y <- sourceUnfoldrM nestedCount2 start
383+ return $ x + y
384+ where
385+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
386+
387+#ifndef USE_PRELUDE
388+{-# INLINE composeN #-}
389+composeN ::
390+ (Monad m)
391+ => Int
392+ -> (Stream m Int -> Stream m Int)
393+ -> Stream m Int
394+ -> m ()
395+composeN n f =
396+ case n of
397+ 1 -> drain . f
398+ 2 -> drain . f . f
399+ 3 -> drain . f . f . f
400+ 4 -> drain . f . f . f . f
401+ _ -> undefined
402+#endif
403+
404+{-# INLINE mapN #-}
405+mapN ::
406+ Monad m
407+ => Int
408+ -> Stream m Int
409+ -> m ()
410+mapN n = composeN n $ fmap (+ 1)
411+
412+{-# INLINE mapM #-}
413+mapM ::
414+ MonadAsync m
415+ => Int
416+ -> Stream m Int
417+ -> m ()
418+mapM n = composeN n $ Stream.mapM return
419+
420+#ifndef USE_PRELUDE
421+foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b
422+foldl' f z = Stream.fold (Fold.foldl' f z)
423+
424+scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b
425+scanl' f z = Stream.scan (Fold.foldl' f z)
426+#endif
427+
428+{-# INLINE transformMapM #-}
429+transformMapM ::
430+ (Monad m)
431+ => Int
432+ -> Stream m Int
433+ -> m ()
434+transformMapM n = composeN n $ Stream.transform (Pipe.mapM return)
435+
436+{-# INLINE transformComposeMapM #-}
437+transformComposeMapM ::
438+ (Monad m)
439+ => Int
440+ -> Stream m Int
441+ -> m ()
442+transformComposeMapM n =
443+ composeN n $
444+ Stream.transform
445+ (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`
446+ Pipe.mapM (\x -> return (x + 2)))
447+
448+{-# INLINE transformTeeMapM #-}
449+transformTeeMapM ::
450+ (Monad m)
451+ => Int
452+ -> Stream m Int
453+ -> m ()
454+transformTeeMapM n =
455+ composeN n $
456+ Stream.transform
457+ (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`
458+ Pipe.mapM (\x -> return (x + 2)))
459+
460+{-# INLINE transformZipMapM #-}
461+transformZipMapM ::
462+ (Monad m)
463+ => Int
464+ -> Stream m Int
465+ -> m ()
466+transformZipMapM n =
467+ composeN n $
468+ Stream.transform
469+ (Pipe.zipWith
470+ (+)
471+ (Pipe.mapM (\x -> return (x + 1)))
472+ (Pipe.mapM (\x -> return (x + 2))))
benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hs → benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hsrenamed+87−54
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Serial.Elimination
2+-- Module : Stream.Eliminate
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -18,7 +18,7 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
19#endif
20
20
21−module Serial.Elimination (benchmarks) where
21+module Stream.Eliminate (benchmarks) where
22
22
23import Control.DeepSeq (NFData(..))
23import Control.DeepSeq (NFData(..))
24import Data.Functor.Identity (Identity, runIdentity)
24import Data.Functor.Identity (Identity, runIdentity)
@@ -33,21 +33,37 @@ import Test.Inspection
33
33
34import qualified Streamly.Internal.Data.Stream.StreamD as D
34import qualified Streamly.Internal.Data.Stream.StreamD as D
35#endif
35#endif
36−
37−import qualified Streamly.Prelude as S
36+import qualified Streamly.Internal.Data.Fold as Fold
37+#ifdef USE_PRELUDE
38−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
38+import qualified Streamly.Internal.Data.Stream.IsStream as S
39+#else
40+import qualified Streamly.Internal.Data.Stream as S
41+#endif
39
42
40import Gauge
43import Gauge
44+-- XXX Replace SerialT with Stream
45+import Streamly.Internal.Data.Stream.Serial (SerialT)
46+#ifdef USE_PRELUDE
41−import Streamly.Prelude (SerialT, IsStream, fromSerial)
47+import Streamly.Prelude (fromSerial)
42−import Streamly.Benchmark.Common
43import Streamly.Benchmark.Prelude
48import Streamly.Benchmark.Prelude
49+#else
50+import Stream.Common
51+ ( sourceUnfoldr
52+ , sourceUnfoldrM
53+ , sourceUnfoldrAction
54+ , benchIOSink
55+ )
56+#endif
57+import Streamly.Benchmark.Common
44import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
58import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
45 lookup, repeat, minimum, maximum, product, last, mapM_, init)
59 lookup, repeat, minimum, maximum, product, last, mapM_, init)
46import qualified Prelude
60import qualified Prelude
47
61
62+#ifdef USE_PRELUDE
48{-# INLINE repeat #-}
63{-# INLINE repeat #-}
49repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
64repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
50repeat count = S.take count . S.repeat
65repeat count = S.take count . S.repeat
66+#endif
51
67
52-------------------------------------------------------------------------------
68-------------------------------------------------------------------------------
53-- Elimination
69-- Elimination
@@ -60,76 +76,76 @@ repeat count = S.take count . S.repeat
60{-# INLINE foldableFoldl' #-}
76{-# INLINE foldableFoldl' #-}
61foldableFoldl' :: Int -> Int -> Int
77foldableFoldl' :: Int -> Int -> Int
62foldableFoldl' value n =
78foldableFoldl' value n =
63− F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
79+ F.foldl' (+) 0 (sourceUnfoldr value n :: SerialT Identity Int)
64
80
65{-# INLINE foldableFoldrElem #-}
81{-# INLINE foldableFoldrElem #-}
66foldableFoldrElem :: Int -> Int -> Bool
82foldableFoldrElem :: Int -> Int -> Bool
67foldableFoldrElem value n =
83foldableFoldrElem value n =
68 F.foldr (\x xs -> x == value || xs)
84 F.foldr (\x xs -> x == value || xs)
69 False
85 False
70− (sourceUnfoldr value n :: S.SerialT Identity Int)
86+ (sourceUnfoldr value n :: SerialT Identity Int)
71
87
72{-# INLINE foldableSum #-}
88{-# INLINE foldableSum #-}
73foldableSum :: Int -> Int -> Int
89foldableSum :: Int -> Int -> Int
74foldableSum value n =
90foldableSum value n =
75− Prelude.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
91+ Prelude.sum (sourceUnfoldr value n :: SerialT Identity Int)
76
92
77{-# INLINE foldableProduct #-}
93{-# INLINE foldableProduct #-}
78foldableProduct :: Int -> Int -> Int
94foldableProduct :: Int -> Int -> Int
79foldableProduct value n =
95foldableProduct value n =
80− Prelude.product (sourceUnfoldr value n :: S.SerialT Identity Int)
96+ Prelude.product (sourceUnfoldr value n :: SerialT Identity Int)
81
97
82{-# INLINE _foldableNull #-}
98{-# INLINE _foldableNull #-}
83_foldableNull :: Int -> Int -> Bool
99_foldableNull :: Int -> Int -> Bool
84_foldableNull value n =
100_foldableNull value n =
85− Prelude.null (sourceUnfoldr value n :: S.SerialT Identity Int)
101+ Prelude.null (sourceUnfoldr value n :: SerialT Identity Int)
86
102
87{-# INLINE foldableElem #-}
103{-# INLINE foldableElem #-}
88foldableElem :: Int -> Int -> Bool
104foldableElem :: Int -> Int -> Bool
89foldableElem value n =
105foldableElem value n =
90− value `Prelude.elem` (sourceUnfoldr value n :: S.SerialT Identity Int)
106+ value `Prelude.elem` (sourceUnfoldr value n :: SerialT Identity Int)
91
107
92{-# INLINE foldableNotElem #-}
108{-# INLINE foldableNotElem #-}
93foldableNotElem :: Int -> Int -> Bool
109foldableNotElem :: Int -> Int -> Bool
94foldableNotElem value n =
110foldableNotElem value n =
95− value `Prelude.notElem` (sourceUnfoldr value n :: S.SerialT Identity Int)
111+ value `Prelude.notElem` (sourceUnfoldr value n :: SerialT Identity Int)
96
112
97{-# INLINE foldableFind #-}
113{-# INLINE foldableFind #-}
98foldableFind :: Int -> Int -> Maybe Int
114foldableFind :: Int -> Int -> Maybe Int
99foldableFind value n =
115foldableFind value n =
100− F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
116+ F.find (== (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
101
117
102{-# INLINE foldableAll #-}
118{-# INLINE foldableAll #-}
103foldableAll :: Int -> Int -> Bool
119foldableAll :: Int -> Int -> Bool
104foldableAll value n =
120foldableAll value n =
105− Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
121+ Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
106
122
107{-# INLINE foldableAny #-}
123{-# INLINE foldableAny #-}
108foldableAny :: Int -> Int -> Bool
124foldableAny :: Int -> Int -> Bool
109foldableAny value n =
125foldableAny value n =
110− Prelude.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
126+ Prelude.any (> (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
111
127
112{-# INLINE foldableAnd #-}
128{-# INLINE foldableAnd #-}
113foldableAnd :: Int -> Int -> Bool
129foldableAnd :: Int -> Int -> Bool
114foldableAnd value n =
130foldableAnd value n =
115− Prelude.and $ S.map
131+ Prelude.and $ fmap
116− (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
132+ (<= (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
117
133
118{-# INLINE foldableOr #-}
134{-# INLINE foldableOr #-}
119foldableOr :: Int -> Int -> Bool
135foldableOr :: Int -> Int -> Bool
120foldableOr value n =
136foldableOr value n =
121− Prelude.or $ S.map
137+ Prelude.or $ fmap
122− (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
138+ (> (value + 1)) (sourceUnfoldr value n :: SerialT Identity Int)
123
139
124{-# INLINE foldableLength #-}
140{-# INLINE foldableLength #-}
125foldableLength :: Int -> Int -> Int
141foldableLength :: Int -> Int -> Int
126foldableLength value n =
142foldableLength value n =
127− Prelude.length (sourceUnfoldr value n :: S.SerialT Identity Int)
143+ Prelude.length (sourceUnfoldr value n :: SerialT Identity Int)
128
144
129{-# INLINE foldableMin #-}
145{-# INLINE foldableMin #-}
130foldableMin :: Int -> Int -> Int
146foldableMin :: Int -> Int -> Int
131foldableMin value n =
147foldableMin value n =
132− Prelude.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
148+ Prelude.minimum (sourceUnfoldr value n :: SerialT Identity Int)
133
149
134{-# INLINE ordInstanceMin #-}
150{-# INLINE ordInstanceMin #-}
135ordInstanceMin :: SerialT Identity Int -> SerialT Identity Int
151ordInstanceMin :: SerialT Identity Int -> SerialT Identity Int
@@ -138,12 +154,12 @@ ordInstanceMin src = min src src
138{-# INLINE foldableMax #-}
154{-# INLINE foldableMax #-}
139foldableMax :: Int -> Int -> Int
155foldableMax :: Int -> Int -> Int
140foldableMax value n =
156foldableMax value n =
141− Prelude.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
157+ Prelude.maximum (sourceUnfoldr value n :: SerialT Identity Int)
142
158
143{-# INLINE foldableMinBy #-}
159{-# INLINE foldableMinBy #-}
144foldableMinBy :: Int -> Int -> Int
160foldableMinBy :: Int -> Int -> Int
145foldableMinBy value n =
161foldableMinBy value n =
146− F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
162+ F.minimumBy compare (sourceUnfoldr value n :: SerialT Identity Int)
147
163
148{-# INLINE foldableListMinBy #-}
164{-# INLINE foldableListMinBy #-}
149foldableListMinBy :: Int -> Int -> Int
165foldableListMinBy :: Int -> Int -> Int
@@ -152,27 +168,27 @@ foldableListMinBy value n = F.minimumBy compare [1..value+n]
152{-# INLINE foldableMaxBy #-}
168{-# INLINE foldableMaxBy #-}
153foldableMaxBy :: Int -> Int -> Int
169foldableMaxBy :: Int -> Int -> Int
154foldableMaxBy value n =
170foldableMaxBy value n =
155− F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
171+ F.maximumBy compare (sourceUnfoldr value n :: SerialT Identity Int)
156
172
157{-# INLINE foldableToList #-}
173{-# INLINE foldableToList #-}
158foldableToList :: Int -> Int -> [Int]
174foldableToList :: Int -> Int -> [Int]
159foldableToList value n =
175foldableToList value n =
160− F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
176+ F.toList (sourceUnfoldr value n :: SerialT Identity Int)
161
177
162{-# INLINE foldableMapM_ #-}
178{-# INLINE foldableMapM_ #-}
163foldableMapM_ :: Monad m => Int -> Int -> m ()
179foldableMapM_ :: Monad m => Int -> Int -> m ()
164foldableMapM_ value n =
180foldableMapM_ value n =
165− F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)
181+ F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: SerialT Identity Int)
166
182
167{-# INLINE foldableSequence_ #-}
183{-# INLINE foldableSequence_ #-}
168foldableSequence_ :: Int -> Int -> IO ()
184foldableSequence_ :: Int -> Int -> IO ()
169foldableSequence_ value n =
185foldableSequence_ value n =
170− F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
186+ F.sequence_ (sourceUnfoldrAction value n :: SerialT Identity (IO Int))
171
187
172{-# INLINE _foldableMsum #-}
188{-# INLINE _foldableMsum #-}
173_foldableMsum :: Int -> Int -> IO Int
189_foldableMsum :: Int -> Int -> IO Int
174_foldableMsum value n =
190_foldableMsum value n =
175− F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
191+ F.msum (sourceUnfoldrAction value n :: SerialT Identity (IO Int))
176
192
177{-# INLINE showInstance #-}
193{-# INLINE showInstance #-}
178showInstance :: SerialT Identity Int -> String
194showInstance :: SerialT Identity Int -> String
@@ -240,8 +256,8 @@ benchPureSink value name = benchPure name (sourceUnfoldr value)
240
256
241{-# INLINE benchHoistSink #-}
257{-# INLINE benchHoistSink #-}
242benchHoistSink
258benchHoistSink
243− :: (IsStream t, NFData b)
259+ :: (NFData b)
244− => Int -> String -> (t Identity Int -> IO b) -> Benchmark
260+ => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
245benchHoistSink value name f =
261benchHoistSink value name f =
246 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
262 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
247
263
@@ -249,8 +265,8 @@ benchHoistSink value name f =
249-- we can't use it as it requires MonadAsync constraint.
265-- we can't use it as it requires MonadAsync constraint.
250{-# INLINE benchIdentitySink #-}
266{-# INLINE benchIdentitySink #-}
251benchIdentitySink
267benchIdentitySink
252− :: (IsStream t, NFData b)
268+ :: (NFData b)
253− => Int -> String -> (t Identity Int -> Identity b) -> Benchmark
269+ => Int -> String -> (SerialT Identity Int -> Identity b) -> Benchmark
254benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
270benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
255
271
256-------------------------------------------------------------------------------
272-------------------------------------------------------------------------------
@@ -265,6 +281,7 @@ uncons s = do
265 Nothing -> return ()
281 Nothing -> return ()
266 Just (_, t) -> uncons t
282 Just (_, t) -> uncons t
267
283
284+#ifdef USE_PRELUDE
268{-# INLINE init #-}
285{-# INLINE init #-}
269init :: Monad m => SerialT m a -> m ()
286init :: Monad m => SerialT m a -> m ()
270init s = S.init s >>= Prelude.mapM_ S.drain
287init s = S.init s >>= Prelude.mapM_ S.drain
@@ -272,6 +289,7 @@ init s = S.init s >>= Prelude.mapM_ S.drain
272{-# INLINE mapM_ #-}
289{-# INLINE mapM_ #-}
273mapM_ :: Monad m => SerialT m Int -> m ()
290mapM_ :: Monad m => SerialT m Int -> m ()
274mapM_ = S.mapM_ (\_ -> return ())
291mapM_ = S.mapM_ (\_ -> return ())
292+#endif
275
293
276{-# INLINE foldrMElem #-}
294{-# INLINE foldrMElem #-}
277foldrMElem :: Monad m => Int -> SerialT m Int -> m Bool
295foldrMElem :: Monad m => Int -> SerialT m Int -> m Bool
@@ -291,6 +309,7 @@ foldrToStream = S.foldr S.cons S.nil
291foldrMBuild :: Monad m => SerialT m Int -> m [Int]
309foldrMBuild :: Monad m => SerialT m Int -> m [Int]
292foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
310foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
293
311
312+#ifdef USE_PRELUDE
294{-# INLINE foldl'Reduce #-}
313{-# INLINE foldl'Reduce #-}
295foldl'Reduce :: Monad m => SerialT m Int -> m Int
314foldl'Reduce :: Monad m => SerialT m Int -> m Int
296foldl'Reduce = S.foldl' (+) 0
315foldl'Reduce = S.foldl' (+) 0
@@ -393,38 +412,43 @@ drainWhile = S.drainWhile (const True)
393
412
394{-# INLINE (!!) #-}
413{-# INLINE (!!) #-}
395(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
414(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
396−(!!) = flip (Internal.!!)
415+(!!) = flip (S.!!)
397
416
398{-# INLINE lookup #-}
417{-# INLINE lookup #-}
399lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
418lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
400lookup val = S.lookup val . S.map (\x -> (x, x))
419lookup val = S.lookup val . S.map (\x -> (x, x))
420+#endif
401
421
402o_1_space_elimination_folds :: Int -> [Benchmark]
422o_1_space_elimination_folds :: Int -> [Benchmark]
403o_1_space_elimination_folds value =
423o_1_space_elimination_folds value =
404 [ bgroup "elimination"
424 [ bgroup "elimination"
405 -- Basic folds
425 -- Basic folds
426+ [
427+#ifdef USE_PRELUDE
406− [ bgroup "reduce"
428+ bgroup "reduce"
407 [ bgroup
429 [ bgroup
408 "IO"
430 "IO"
409 [ benchIOSink value "foldl'" foldl'Reduce
431 [ benchIOSink value "foldl'" foldl'Reduce
410 , benchIOSink value "foldl1'" foldl1'Reduce
432 , benchIOSink value "foldl1'" foldl1'Reduce
411 , benchIOSink value "foldlM'" foldlM'Reduce
433 , benchIOSink value "foldlM'" foldlM'Reduce
412 ]
434 ]
435+
413 , bgroup
436 , bgroup
414 "Identity"
437 "Identity"
415 [ benchIdentitySink value "foldl'" foldl'Reduce
438 [ benchIdentitySink value "foldl'" foldl'Reduce
416 , benchIdentitySink value "foldl1'" foldl1'Reduce
439 , benchIdentitySink value "foldl1'" foldl1'Reduce
417 , benchIdentitySink value "foldlM'" foldlM'Reduce
440 , benchIdentitySink value "foldlM'" foldlM'Reduce
418 ]
441 ]
419− ]
442+ ] ,
443+#endif
420− , bgroup "build"
444+ bgroup "build"
421 [ bgroup "IO"
445 [ bgroup "IO"
422 [ benchIOSink value "foldrMElem" (foldrMElem value)
446 [ benchIOSink value "foldrMElem" (foldrMElem value)
423 ]
447 ]
424 , bgroup "Identity"
448 , bgroup "Identity"
425 [ benchIdentitySink value "foldrMElem" (foldrMElem value)
449 [ benchIdentitySink value "foldrMElem" (foldrMElem value)
426 , benchIdentitySink value "foldrToStreamLength"
450 , benchIdentitySink value "foldrToStreamLength"
427− (S.length . runIdentity . foldrToStream)
451+ (S.fold Fold.length . runIdentity . foldrToStream)
428 , benchPureSink value "foldrMToListLength"
452 , benchPureSink value "foldrMToListLength"
429 (Prelude.length . runIdentity . foldrMBuild)
453 (Prelude.length . runIdentity . foldrMBuild)
430 ]
454 ]
@@ -432,6 +456,9 @@ o_1_space_elimination_folds value =
432
456
433 -- deconstruction
457 -- deconstruction
434 , benchIOSink value "uncons" uncons
458 , benchIOSink value "uncons" uncons
459+ , benchHoistSink value "length . generally"
460+ (S.fold Fold.length . S.generally)
461+#ifdef USE_PRELUDE
435 , benchIOSink value "init" init
462 , benchIOSink value "init" init
436
463
437 -- draining
464 -- draining
@@ -445,8 +472,6 @@ o_1_space_elimination_folds value =
445 -- , benchIOSink value "head" head
472 -- , benchIOSink value "head" head
446 , benchIOSink value "last" last
473 , benchIOSink value "last" last
447 , benchIOSink value "length" length
474 , benchIOSink value "length" length
448− , benchHoistSink value "length . generally"
449− (length . Internal.generally)
450 , benchIOSink value "sum" sum
475 , benchIOSink value "sum" sum
451 , benchIOSink value "product" product
476 , benchIOSink value "product" product
452 , benchIOSink value "maximumBy" maximumBy
477 , benchIOSink value "maximumBy" maximumBy
@@ -470,6 +495,7 @@ o_1_space_elimination_folds value =
470 , benchIOSink value "any" (any value)
495 , benchIOSink value "any" (any value)
471 , benchIOSink value "and" (and value)
496 , benchIOSink value "and" (and value)
472 , benchIOSink value "or" (or value)
497 , benchIOSink value "or" (or value)
498+#endif
473
499
474 -- length is used to check for foldr/build fusion
500 -- length is used to check for foldr/build fusion
475 , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
501 , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
@@ -480,6 +506,7 @@ o_1_space_elimination_folds value =
480-- Buffered Transformations by fold
506-- Buffered Transformations by fold
481-------------------------------------------------------------------------------
507-------------------------------------------------------------------------------
482
508
509+#ifdef USE_PRELUDE
483{-# INLINE foldl'Build #-}
510{-# INLINE foldl'Build #-}
484foldl'Build :: Monad m => SerialT m Int -> m [Int]
511foldl'Build :: Monad m => SerialT m Int -> m [Int]
485foldl'Build = S.foldl' (flip (:)) []
512foldl'Build = S.foldl' (flip (:)) []
@@ -499,6 +526,7 @@ o_n_heap_elimination_foldl value =
499 , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
526 , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
500 ]
527 ]
501 ]
528 ]
529+#endif
502
530
503-- For comparisons
531-- For comparisons
504{-# INLINE showInstanceList #-}
532{-# INLINE showInstanceList #-}
@@ -534,13 +562,14 @@ o_n_space_elimination_foldr value =
534 ]
562 ]
535 ]
563 ]
536
564
565+#ifdef USE_PRELUDE
537o_n_heap_elimination_toList :: Int -> [Benchmark]
566o_n_heap_elimination_toList :: Int -> [Benchmark]
538o_n_heap_elimination_toList value =
567o_n_heap_elimination_toList value =
539 [ bgroup "toList"
568 [ bgroup "toList"
540 -- Converting the stream to a list or pure stream in a strict monad
569 -- Converting the stream to a list or pure stream in a strict monad
541− [ benchIOSink value "toListRev" Internal.toListRev
570+ [ benchIOSink value "toListRev" S.toListRev
542 , benchIOSink value "toStreamRev"
571 , benchIOSink value "toStreamRev"
543− (Internal.toStreamRev :: (SerialT IO Int -> IO (SerialT Identity Int)))
572+ (S.toStreamRev :: (SerialT IO Int -> IO (SerialT Identity Int)))
544 ]
573 ]
545 ]
574 ]
546
575
@@ -550,9 +579,10 @@ o_n_space_elimination_toList value =
550 -- Converting the stream to a list or pure stream in a strict monad
579 -- Converting the stream to a list or pure stream in a strict monad
551 [ benchIOSink value "toList" S.toList
580 [ benchIOSink value "toList" S.toList
552 , benchIOSink value "toStream"
581 , benchIOSink value "toStream"
553− (Internal.toStream :: (SerialT IO Int -> IO (SerialT Identity Int)))
582+ (S.toStream :: (SerialT IO Int -> IO (SerialT Identity Int)))
554 ]
583 ]
555 ]
584 ]
585+#endif
556
586
557-------------------------------------------------------------------------------
587-------------------------------------------------------------------------------
558-- Multi-stream folds
588-- Multi-stream folds
@@ -673,14 +703,17 @@ benchmarks moduleName size =
673 , o_1_space_elimination_multi_stream_pure size
703 , o_1_space_elimination_multi_stream_pure size
674 , o_1_space_elimination_multi_stream size
704 , o_1_space_elimination_multi_stream size
675 ]
705 ]
706+
676− , bgroup (o_n_heap_prefix moduleName) $ concat
707+ , bgroup (o_n_heap_prefix moduleName) $
708+ o_n_heap_elimination_buffered size
709+#ifdef USE_PRELUDE
677− [ o_n_heap_elimination_foldl size
710+ ++ o_n_heap_elimination_foldl size
678− , o_n_heap_elimination_toList size
711+ ++ o_n_heap_elimination_toList size
679− , o_n_heap_elimination_buffered size
712+#endif
680− ]
681− , bgroup (o_n_space_prefix moduleName) $ concat
713+ , bgroup (o_n_space_prefix moduleName) $
682− [ o_n_space_elimination_foldable size
714+ o_n_space_elimination_foldable size
715+#ifdef USE_PRELUDE
683− , o_n_space_elimination_toList size
716+ ++ o_n_space_elimination_toList size
717+#endif
684− , o_n_space_elimination_foldr size
718+ ++ o_n_space_elimination_foldr size
685− ]
686 ]
719 ]
benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs → benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hsrenamed+72−54
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Streamly.Benchmark.Prelude.Serial.Exceptions
2+-- Module : Stream.Exceptions
3-- Copyright : (c) 2019 Composewell Technologies
3-- Copyright : (c) 2019 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -7,6 +7,7 @@
7-- Portability : GHC
7-- Portability : GHC
8
8
9{-# LANGUAGE CPP #-}
9{-# LANGUAGE CPP #-}
10+{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
11
12
12#ifdef __HADDOCK_VERSION__
13#ifdef __HADDOCK_VERSION__
@@ -18,19 +19,25 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
20#endif
20
21
21−module Serial.Exceptions (benchmarks) where
22+module Stream.Exceptions (benchmarks) where
22
23
23import Control.Exception (SomeException, Exception, throwIO)
24import Control.Exception (SomeException, Exception, throwIO)
25+import Stream.Common (drain, enumerateFromTo)
26+import Streamly.Internal.Data.Stream.Serial (SerialT)
24import System.IO (Handle, hClose, hPutChar)
27import System.IO (Handle, hClose, hPutChar)
25
28
26import qualified Data.IORef as Ref
29import qualified Data.IORef as Ref
27import qualified Data.Map.Strict as Map
30import qualified Data.Map.Strict as Map
28−
31+import qualified Stream.Common as Common
29import qualified Streamly.FileSystem.Handle as FH
32import qualified Streamly.FileSystem.Handle as FH
30import qualified Streamly.Internal.Data.Unfold as IUF
33import qualified Streamly.Internal.Data.Unfold as IUF
31import qualified Streamly.Internal.FileSystem.Handle as IFH
34import qualified Streamly.Internal.FileSystem.Handle as IFH
35+#ifdef USE_PRELUDE
32−import qualified Streamly.Internal.Data.Stream.IsStream as IP
36+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
37+#else
38+import qualified Streamly.Internal.Data.Stream as Stream
33−import qualified Streamly.Prelude as S
39+import qualified Streamly.Internal.Data.Unfold as Unfold
40+#endif
34
41
35import Gauge hiding (env)
42import Gauge hiding (env)
36import Prelude hiding (last, length)
43import Prelude hiding (last, length)
@@ -47,6 +54,14 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D
47-- stream exceptions
54-- stream exceptions
48-------------------------------------------------------------------------------
55-------------------------------------------------------------------------------
49
56
57+{-# INLINE replicateM #-}
58+replicateM :: Common.MonadAsync m => Int -> m a -> SerialT m a
59+#ifdef USE_PRELUDE
60+replicateM = Stream.replicateM
61+#else
62+replicateM = Stream.unfold . Unfold.replicateM
63+#endif
64+
50data BenchException
65data BenchException
51 = BenchException1
66 = BenchException1
52 | BenchException2
67 | BenchException2
@@ -56,37 +71,41 @@ instance Exception BenchException
56
71
57retryNoneSimple :: Int -> Int -> IO ()
72retryNoneSimple :: Int -> Int -> IO ()
58retryNoneSimple length from =
73retryNoneSimple length from =
59− IP.drain
74+ drain
75+ $ Stream.retry
60− $ IP.retry (Map.singleton BenchException1 length) (const S.nil) source
76+ (Map.singleton BenchException1 length)
77+ (const Stream.nil)
78+ source
61
79
62 where
80 where
63
81
64− source = S.enumerateFromTo from (from + length)
82+ source = enumerateFromTo from (from + length)
65
83
66retryNone :: Int -> Int -> IO ()
84retryNone :: Int -> Int -> IO ()
67retryNone length from = do
85retryNone length from = do
68 ref <- Ref.newIORef (0 :: Int)
86 ref <- Ref.newIORef (0 :: Int)
69− IP.drain
87+ drain
70− $ IP.retry (Map.singleton BenchException1 length) (const S.nil)
88+ $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
71 $ source ref
89 $ source ref
72
90
73 where
91 where
74
92
75 source ref =
93 source ref =
76− IP.replicateM (from + length)
94+ replicateM (from + length)
77 $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
95 $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
78
96
79retryAll :: Int -> Int -> IO ()
97retryAll :: Int -> Int -> IO ()
80retryAll length from = do
98retryAll length from = do
81 ref <- Ref.newIORef 0
99 ref <- Ref.newIORef 0
82− IP.drain
100+ drain
101+ $ Stream.retry
83− $ IP.retry (Map.singleton BenchException1 (length + from)) (const S.nil)
102+ (Map.singleton BenchException1 (length + from)) (const Stream.nil)
84 $ source ref
103 $ source ref
85
104
86 where
105 where
87
106
88 source ref =
107 source ref =
89− IP.fromEffect
108+ Stream.fromEffect
90 $ do
109 $ do
91 Ref.modifyIORef' ref (+ 1)
110 Ref.modifyIORef' ref (+ 1)
92 val <- Ref.readIORef ref
111 val <- Ref.readIORef ref
@@ -96,13 +115,13 @@ retryAll length from = do
96
115
97retryUnknown :: Int -> Int -> IO ()
116retryUnknown :: Int -> Int -> IO ()
98retryUnknown length from = do
117retryUnknown length from = do
99− IP.drain
118+ drain
100− $ IP.retry (Map.singleton BenchException1 length) (const source)
119+ $ Stream.retry (Map.singleton BenchException1 length) (const source)
101− $ throwIO BenchException2 `S.before` S.nil
120+ $ throwIO BenchException2 `Stream.before` Stream.nil
102
121
103 where
122 where
104
123
105− source = S.enumerateFromTo from (from + length)
124+ source = enumerateFromTo from (from + length)
106
125
107
126
108o_1_space_serial_exceptions :: Int -> [Benchmark]
127o_1_space_serial_exceptions :: Int -> [Benchmark]
@@ -123,8 +142,8 @@ o_1_space_serial_exceptions length =
123-- | Send the file contents to /dev/null with exception handling
142-- | Send the file contents to /dev/null with exception handling
124readWriteOnExceptionStream :: Handle -> Handle -> IO ()
143readWriteOnExceptionStream :: Handle -> Handle -> IO ()
125readWriteOnExceptionStream inh devNull =
144readWriteOnExceptionStream inh devNull =
126− let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
145+ let readEx = Stream.onException (hClose inh) (Stream.unfold FH.read inh)
127− in S.fold (FH.write devNull) $ readEx
146+ in Stream.fold (FH.write devNull) readEx
128
147
129#ifdef INSPECTION
148#ifdef INSPECTION
130inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
149inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
@@ -133,9 +152,9 @@ inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
133-- | Send the file contents to /dev/null with exception handling
152-- | Send the file contents to /dev/null with exception handling
134readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
153readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
135readWriteHandleExceptionStream inh devNull =
154readWriteHandleExceptionStream inh devNull =
136− let handler (_e :: SomeException) = S.fromEffect (hClose inh >> return 10)
155+ let handler (_e :: SomeException) = Stream.fromEffect (hClose inh >> return 10)
137− readEx = S.handle handler (S.unfold FH.read inh)
156+ readEx = Stream.handle handler (Stream.unfold FH.read inh)
138− in S.fold (FH.write devNull) $ readEx
157+ in Stream.fold (FH.write devNull) readEx
139
158
140#ifdef INSPECTION
159#ifdef INSPECTION
141inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
160inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
@@ -144,8 +163,8 @@ inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
144-- | Send the file contents to /dev/null with exception handling
163-- | Send the file contents to /dev/null with exception handling
145readWriteFinally_Stream :: Handle -> Handle -> IO ()
164readWriteFinally_Stream :: Handle -> Handle -> IO ()
146readWriteFinally_Stream inh devNull =
165readWriteFinally_Stream inh devNull =
147− let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)
166+ let readEx = Stream.finally_ (hClose inh) (Stream.unfold FH.read inh)
148− in S.fold (FH.write devNull) readEx
167+ in Stream.fold (FH.write devNull) readEx
149
168
150#ifdef INSPECTION
169#ifdef INSPECTION
151inspect $ hasNoTypeClasses 'readWriteFinally_Stream
170inspect $ hasNoTypeClasses 'readWriteFinally_Stream
@@ -153,15 +172,15 @@ inspect $ hasNoTypeClasses 'readWriteFinally_Stream
153
172
154readWriteFinallyStream :: Handle -> Handle -> IO ()
173readWriteFinallyStream :: Handle -> Handle -> IO ()
155readWriteFinallyStream inh devNull =
174readWriteFinallyStream inh devNull =
156− let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
175+ let readEx = Stream.finally (hClose inh) (Stream.unfold FH.read inh)
157− in S.fold (FH.write devNull) readEx
176+ in Stream.fold (FH.write devNull) readEx
158
177
159-- | Send the file contents to /dev/null with exception handling
178-- | Send the file contents to /dev/null with exception handling
160fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
179fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
161fromToBytesBracket_Stream inh devNull =
180fromToBytesBracket_Stream inh devNull =
162− let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)
181+ let readEx = Stream.bracket_ (return ()) (\_ -> hClose inh)
163 (\_ -> IFH.getBytes inh)
182 (\_ -> IFH.getBytes inh)
164− in IFH.putBytes devNull $ readEx
183+ in IFH.putBytes devNull readEx
165
184
166#ifdef INSPECTION
185#ifdef INSPECTION
167inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
186inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
@@ -169,16 +188,16 @@ inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
169
188
170fromToBytesBracketStream :: Handle -> Handle -> IO ()
189fromToBytesBracketStream :: Handle -> Handle -> IO ()
171fromToBytesBracketStream inh devNull =
190fromToBytesBracketStream inh devNull =
172− let readEx = S.bracket (return ()) (\_ -> hClose inh)
191+ let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
173 (\_ -> IFH.getBytes inh)
192 (\_ -> IFH.getBytes inh)
174− in IFH.putBytes devNull $ readEx
193+ in IFH.putBytes devNull readEx
175
194
176readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
195readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
177readWriteBeforeAfterStream inh devNull =
196readWriteBeforeAfterStream inh devNull =
178 let readEx =
197 let readEx =
179− IP.after (hClose inh)
198+ Stream.after (hClose inh)
180− $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)
199+ $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.read inh)
181− in S.fold (FH.write devNull) readEx
200+ in Stream.fold (FH.write devNull) readEx
182
201
183#ifdef INSPECTION
202#ifdef INSPECTION
184inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
203inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
@@ -186,8 +205,8 @@ inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
186
205
187readWriteAfterStream :: Handle -> Handle -> IO ()
206readWriteAfterStream :: Handle -> Handle -> IO ()
188readWriteAfterStream inh devNull =
207readWriteAfterStream inh devNull =
189− let readEx = IP.after (hClose inh) (S.unfold FH.read inh)
208+ let readEx = Stream.after (hClose inh) (Stream.unfold FH.read inh)
190− in S.fold (FH.write devNull) readEx
209+ in Stream.fold (FH.write devNull) readEx
191
210
192#ifdef INSPECTION
211#ifdef INSPECTION
193inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
212inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
@@ -195,8 +214,8 @@ inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
195
214
196readWriteAfter_Stream :: Handle -> Handle -> IO ()
215readWriteAfter_Stream :: Handle -> Handle -> IO ()
197readWriteAfter_Stream inh devNull =
216readWriteAfter_Stream inh devNull =
198− let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)
217+ let readEx = Stream.after_ (hClose inh) (Stream.unfold FH.read inh)
199− in S.fold (FH.write devNull) readEx
218+ in Stream.fold (FH.write devNull) readEx
200
219
201#ifdef INSPECTION
220#ifdef INSPECTION
202inspect $ hasNoTypeClasses 'readWriteAfter_Stream
221inspect $ hasNoTypeClasses 'readWriteAfter_Stream
@@ -206,25 +225,25 @@ inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
206o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
225o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
207o_1_space_copy_stream_exceptions env =
226o_1_space_copy_stream_exceptions env =
208 [ bgroup "exceptions"
227 [ bgroup "exceptions"
209− [ mkBenchSmall "S.onException" env $ \inh _ ->
228+ [ mkBenchSmall "Stream.onException" env $ \inh _ ->
210 readWriteOnExceptionStream inh (nullH env)
229 readWriteOnExceptionStream inh (nullH env)
211− , mkBenchSmall "S.handle" env $ \inh _ ->
230+ , mkBenchSmall "Stream.handle" env $ \inh _ ->
212 readWriteHandleExceptionStream inh (nullH env)
231 readWriteHandleExceptionStream inh (nullH env)
213− , mkBenchSmall "S.finally_" env $ \inh _ ->
232+ , mkBenchSmall "Stream.finally_" env $ \inh _ ->
214 readWriteFinally_Stream inh (nullH env)
233 readWriteFinally_Stream inh (nullH env)
215− , mkBenchSmall "S.finally" env $ \inh _ ->
234+ , mkBenchSmall "Stream.finally" env $ \inh _ ->
216 readWriteFinallyStream inh (nullH env)
235 readWriteFinallyStream inh (nullH env)
217− , mkBenchSmall "S.after . S.before" env $ \inh _ ->
236+ , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
218 readWriteBeforeAfterStream inh (nullH env)
237 readWriteBeforeAfterStream inh (nullH env)
219− , mkBenchSmall "S.after" env $ \inh _ ->
238+ , mkBenchSmall "Stream.after" env $ \inh _ ->
220 readWriteAfterStream inh (nullH env)
239 readWriteAfterStream inh (nullH env)
221− , mkBenchSmall "S.after_" env $ \inh _ ->
240+ , mkBenchSmall "Stream.after_" env $ \inh _ ->
222 readWriteAfter_Stream inh (nullH env)
241 readWriteAfter_Stream inh (nullH env)
223 ]
242 ]
224 , bgroup "exceptions/fromToBytes"
243 , bgroup "exceptions/fromToBytes"
225− [ mkBenchSmall "S.bracket_" env $ \inh _ ->
244+ [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
226 fromToBytesBracket_Stream inh (nullH env)
245 fromToBytesBracket_Stream inh (nullH env)
227− , mkBenchSmall "S.bracket" env $ \inh _ ->
246+ , mkBenchSmall "Stream.bracket" env $ \inh _ ->
228 fromToBytesBracketStream inh (nullH env)
247 fromToBytesBracketStream inh (nullH env)
229 ]
248 ]
230 ]
249 ]
@@ -277,11 +296,11 @@ o_1_space_copy_exceptions_readChunks env =
277-- | Send the file contents to /dev/null with exception handling
296-- | Send the file contents to /dev/null with exception handling
278toChunksBracket_ :: Handle -> Handle -> IO ()
297toChunksBracket_ :: Handle -> Handle -> IO ()
279toChunksBracket_ inh devNull =
298toChunksBracket_ inh devNull =
280− let readEx = IP.bracket_
299+ let readEx = Stream.bracket_
281 (return ())
300 (return ())
282 (\_ -> hClose inh)
301 (\_ -> hClose inh)
283 (\_ -> IFH.getChunks inh)
302 (\_ -> IFH.getChunks inh)
284− in S.fold (IFH.writeChunks devNull) $ readEx
303+ in Stream.fold (IFH.writeChunks devNull) readEx
285
304
286#ifdef INSPECTION
305#ifdef INSPECTION
287inspect $ hasNoTypeClasses 'toChunksBracket_
306inspect $ hasNoTypeClasses 'toChunksBracket_
@@ -289,23 +308,22 @@ inspect $ hasNoTypeClasses 'toChunksBracket_
289
308
290toChunksBracket :: Handle -> Handle -> IO ()
309toChunksBracket :: Handle -> Handle -> IO ()
291toChunksBracket inh devNull =
310toChunksBracket inh devNull =
292− let readEx = S.bracket
311+ let readEx = Stream.bracket
293 (return ())
312 (return ())
294 (\_ -> hClose inh)
313 (\_ -> hClose inh)
295 (\_ -> IFH.getChunks inh)
314 (\_ -> IFH.getChunks inh)
296− in S.fold (IFH.writeChunks devNull) $ readEx
315+ in Stream.fold (IFH.writeChunks devNull) readEx
297
316
298o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
317o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
299o_1_space_copy_exceptions_toChunks env =
318o_1_space_copy_exceptions_toChunks env =
300 [ bgroup "exceptions/toChunks"
319 [ bgroup "exceptions/toChunks"
301− [ mkBench "S.bracket_" env $ \inH _ ->
320+ [ mkBench "Stream.bracket_" env $ \inH _ ->
302 toChunksBracket_ inH (nullH env)
321 toChunksBracket_ inH (nullH env)
303− , mkBench "S.bracket" env $ \inH _ ->
322+ , mkBench "Stream.bracket" env $ \inH _ ->
304 toChunksBracket inH (nullH env)
323 toChunksBracket inH (nullH env)
305 ]
324 ]
306 ]
325 ]
307
326
308−
309benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
327benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
310benchmarks moduleName env size =
328benchmarks moduleName env size =
311 [ bgroup (o_1_space_prefix moduleName) $ concat
329 [ bgroup (o_1_space_prefix moduleName) $ concat
benchmark/Streamly/Benchmark/Prelude/Serial/NestedStream.hs → benchmark/Streamly/Benchmark/Data/Stream/Expand.hsrenamed+86−70
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Serial.NestedStream
2+-- Module : Stream.Expand
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -18,9 +18,10 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
19#endif
20
20
21−module Serial.NestedStream (benchmarks) where
21+module Stream.Expand (benchmarks) where
22
22
23import Control.Monad.Trans.Class (lift)
23import Control.Monad.Trans.Class (lift)
24+import Streamly.Internal.Data.Stream.Serial (SerialT)
24
25
25import qualified Control.Applicative as AP
26import qualified Control.Applicative as AP
26
27
@@ -31,14 +32,23 @@ import Test.Inspection
31import qualified Streamly.Internal.Data.Stream.StreamD as D
32import qualified Streamly.Internal.Data.Stream.StreamD as D
32#endif
33#endif
33
34
34−import qualified Streamly.Prelude as S
35+import qualified Stream.Common as Common
36+#ifdef USE_PRELUDE
35−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
37+import qualified Streamly.Internal.Data.Stream.IsStream as S
38+import Streamly.Benchmark.Prelude hiding
39+ (benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2, toNullAp
40+ , monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM, filterSome
41+ , breakAfterSome, toListM, toListSome)
42+#else
43+import Streamly.Benchmark.Prelude (benchIO)
44+import qualified Streamly.Internal.Data.Stream as S
45+#endif
36import qualified Streamly.Internal.Data.Unfold as UF
46import qualified Streamly.Internal.Data.Unfold as UF
47+import qualified Streamly.Internal.Data.Fold as Fold
37
48
38import Gauge
49import Gauge
39−import Streamly.Prelude (SerialT, fromSerial, serial)
50+import Stream.Common hiding (append2)
40import Streamly.Benchmark.Common
51import Streamly.Benchmark.Common
41−import Streamly.Benchmark.Prelude
42import Prelude hiding (concatMap)
52import Prelude hiding (concatMap)
43
53
44-------------------------------------------------------------------------------
54-------------------------------------------------------------------------------
@@ -56,13 +66,14 @@ iterateN g initial count = f count initial
56
66
57-- Iterate a transformation over a singleton stream
67-- Iterate a transformation over a singleton stream
58{-# INLINE iterateSingleton #-}
68{-# INLINE iterateSingleton #-}
59−iterateSingleton :: S.MonadAsync m
69+iterateSingleton :: Monad m
60 => (Int -> SerialT m Int -> SerialT m Int)
70 => (Int -> SerialT m Int -> SerialT m Int)
61 -> Int
71 -> Int
62 -> Int
72 -> Int
63 -> SerialT m Int
73 -> SerialT m Int
64iterateSingleton g count n = iterateN g (return n) count
74iterateSingleton g count n = iterateN g (return n) count
65
75
76+{-
66-- XXX need to check why this is slower than the explicit recursion above, even
77-- XXX need to check why this is slower than the explicit recursion above, even
67-- if the above code is written in a foldr like head recursive way. We also
78-- if the above code is written in a foldr like head recursive way. We also
68-- need to try this with foldlM' once #150 is fixed.
79-- need to try this with foldlM' once #150 is fixed.
@@ -70,12 +81,13 @@ iterateSingleton g count n = iterateN g (return n) count
70-- foldrM and any related fusion issues.
81-- foldrM and any related fusion issues.
71{-# INLINE _iterateSingleton #-}
82{-# INLINE _iterateSingleton #-}
72_iterateSingleton ::
83_iterateSingleton ::
73− S.MonadAsync m
84+ Monad m
74 => (Int -> SerialT m Int -> SerialT m Int)
85 => (Int -> SerialT m Int -> SerialT m Int)
75 -> Int
86 -> Int
76 -> Int
87 -> Int
77 -> SerialT m Int
88 -> SerialT m Int
78_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
89_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
90+-}
79
91
80-------------------------------------------------------------------------------
92-------------------------------------------------------------------------------
81-- Multi-Stream
93-- Multi-Stream
@@ -88,34 +100,34 @@ _iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
88{-# INLINE serial2 #-}
100{-# INLINE serial2 #-}
89serial2 :: Int -> Int -> IO ()
101serial2 :: Int -> Int -> IO ()
90serial2 count n =
102serial2 count n =
91− S.drain $
103+ drain $
92− S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
104+ Common.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
93
105
94{-# INLINE serial4 #-}
106{-# INLINE serial4 #-}
95serial4 :: Int -> Int -> IO ()
107serial4 :: Int -> Int -> IO ()
96serial4 count n =
108serial4 count n =
97− S.drain $
109+ drain $
98− S.serial
110+ Common.append
99− (S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))
111+ (Common.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))
100− (S.serial
112+ (Common.append
101 (sourceUnfoldrM count (n + 2))
113 (sourceUnfoldrM count (n + 2))
102 (sourceUnfoldrM count (n + 3)))
114 (sourceUnfoldrM count (n + 3)))
103
115
104{-# INLINE append2 #-}
116{-# INLINE append2 #-}
105append2 :: Int -> Int -> IO ()
117append2 :: Int -> Int -> IO ()
106append2 count n =
118append2 count n =
107− S.drain $
119+ drain $
108− Internal.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
120+ Common.append2 (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
109
121
110{-# INLINE append4 #-}
122{-# INLINE append4 #-}
111append4 :: Int -> Int -> IO ()
123append4 :: Int -> Int -> IO ()
112append4 count n =
124append4 count n =
113− S.drain $
125+ drain $
114− Internal.append
126+ Common.append2
115− (Internal.append
127+ (Common.append2
116 (sourceUnfoldrM count n)
128 (sourceUnfoldrM count n)
117 (sourceUnfoldrM count (n + 1)))
129 (sourceUnfoldrM count (n + 1)))
118− (Internal.append
130+ (Common.append2
119 (sourceUnfoldrM count (n + 2))
131 (sourceUnfoldrM count (n + 2))
120 (sourceUnfoldrM count (n + 3)))
132 (sourceUnfoldrM count (n + 3)))
121
133
@@ -139,22 +151,24 @@ o_1_space_joining value =
139-- Concat Foldable containers
151-- Concat Foldable containers
140-------------------------------------------------------------------------------
152-------------------------------------------------------------------------------
141
153
154+#ifdef USE_PRELUDE
142o_1_space_concatFoldable :: Int -> [Benchmark]
155o_1_space_concatFoldable :: Int -> [Benchmark]
143o_1_space_concatFoldable value =
156o_1_space_concatFoldable value =
144 [ bgroup "concat-foldable"
157 [ bgroup "concat-foldable"
145− [ benchIOSrc fromSerial "foldMapWith (<>) (List)"
158+ [ benchIOSrc "foldMapWith (<>) (List)"
146 (sourceFoldMapWith value)
159 (sourceFoldMapWith value)
147− , benchIOSrc fromSerial "foldMapWith (<>) (Stream)"
160+ , benchIOSrc "foldMapWith (<>) (Stream)"
148 (sourceFoldMapWithStream value)
161 (sourceFoldMapWithStream value)
149− , benchIOSrc fromSerial "foldMapWithM (<>) (List)"
162+ , benchIOSrc "foldMapWithM (<>) (List)"
150 (sourceFoldMapWithM value)
163 (sourceFoldMapWithM value)
151− , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
164+ , benchIOSrc "S.concatFoldableWith (<>) (List)"
152 (concatFoldableWith value)
165 (concatFoldableWith value)
153− , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
166+ , benchIOSrc "S.concatForFoldableWith (<>) (List)"
154 (concatForFoldableWith value)
167 (concatForFoldableWith value)
155− , benchIOSrc fromSerial "foldMapM (List)" (sourceFoldMapM value)
168+ , benchIOSrc "foldMapM (List)" (sourceFoldMapM value)
156 ]
169 ]
157 ]
170 ]
171+#endif
158
172
159-------------------------------------------------------------------------------
173-------------------------------------------------------------------------------
160-- Concat
174-- Concat
@@ -165,14 +179,14 @@ o_1_space_concatFoldable value =
165{-# INLINE concatMap #-}
179{-# INLINE concatMap #-}
166concatMap :: Int -> Int -> Int -> IO ()
180concatMap :: Int -> Int -> Int -> IO ()
167concatMap outer inner n =
181concatMap outer inner n =
168− S.drain $ S.concatMap
182+ drain $ S.concatMap
169 (\_ -> sourceUnfoldrM inner n)
183 (\_ -> sourceUnfoldrM inner n)
170 (sourceUnfoldrM outer n)
184 (sourceUnfoldrM outer n)
171
185
172{-# INLINE concatMapM #-}
186{-# INLINE concatMapM #-}
173concatMapM :: Int -> Int -> Int -> IO ()
187concatMapM :: Int -> Int -> Int -> IO ()
174concatMapM outer inner n =
188concatMapM outer inner n =
175− S.drain $ S.concatMapM
189+ drain $ S.concatMapM
176 (\_ -> return $ sourceUnfoldrM inner n)
190 (\_ -> return $ sourceUnfoldrM inner n)
177 (sourceUnfoldrM outer n)
191 (sourceUnfoldrM outer n)
178
192
@@ -186,7 +200,7 @@ inspect $ 'concatMap `hasNoType` ''SPEC
186{-# INLINE concatMapPure #-}
200{-# INLINE concatMapPure #-}
187concatMapPure :: Int -> Int -> Int -> IO ()
201concatMapPure :: Int -> Int -> Int -> IO ()
188concatMapPure outer inner n =
202concatMapPure outer inner n =
189− S.drain $ S.concatMap
203+ drain $ S.concatMap
190 (\_ -> sourceUnfoldr inner n)
204 (\_ -> sourceUnfoldr inner n)
191 (sourceUnfoldr outer n)
205 (sourceUnfoldr outer n)
192
206
@@ -200,7 +214,7 @@ inspect $ 'concatMapPure `hasNoType` ''SPEC
200{-# INLINE concatMapRepl #-}
214{-# INLINE concatMapRepl #-}
201concatMapRepl :: Int -> Int -> Int -> IO ()
215concatMapRepl :: Int -> Int -> Int -> IO ()
202concatMapRepl outer inner n =
216concatMapRepl outer inner n =
203− S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrM outer n)
217+ drain $ S.concatMap (Common.replicate inner) (sourceUnfoldrM outer n)
204
218
205#ifdef INSPECTION
219#ifdef INSPECTION
206inspect $ hasNoTypeClasses 'concatMapRepl
220inspect $ hasNoTypeClasses 'concatMapRepl
@@ -211,7 +225,7 @@ inspect $ 'concatMapRepl `hasNoType` ''SPEC
211
225
212{-# INLINE concatMapWithSerial #-}
226{-# INLINE concatMapWithSerial #-}
213concatMapWithSerial :: Int -> Int -> Int -> IO ()
227concatMapWithSerial :: Int -> Int -> Int -> IO ()
214−concatMapWithSerial = concatStreamsWith S.serial
228+concatMapWithSerial = concatStreamsWith Common.append
215
229
216#ifdef INSPECTION
230#ifdef INSPECTION
217inspect $ hasNoTypeClasses 'concatMapWithSerial
231inspect $ hasNoTypeClasses 'concatMapWithSerial
@@ -220,7 +234,7 @@ inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
220
234
221{-# INLINE concatMapWithAppend #-}
235{-# INLINE concatMapWithAppend #-}
222concatMapWithAppend :: Int -> Int -> Int -> IO ()
236concatMapWithAppend :: Int -> Int -> Int -> IO ()
223−concatMapWithAppend = concatStreamsWith Internal.append
237+concatMapWithAppend = concatStreamsWith Common.append2
224
238
225#ifdef INSPECTION
239#ifdef INSPECTION
226inspect $ hasNoTypeClasses 'concatMapWithAppend
240inspect $ hasNoTypeClasses 'concatMapWithAppend
@@ -231,11 +245,11 @@ inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
231
245
232{-# INLINE concatPairWithSerial #-}
246{-# INLINE concatPairWithSerial #-}
233concatPairWithSerial :: Int -> Int -> Int -> IO ()
247concatPairWithSerial :: Int -> Int -> Int -> IO ()
234−concatPairWithSerial = concatPairsWith Internal.serial
248+concatPairWithSerial = concatPairsWith Common.append
235
249
236{-# INLINE concatPairWithAppend #-}
250{-# INLINE concatPairWithAppend #-}
237concatPairWithAppend :: Int -> Int -> Int -> IO ()
251concatPairWithAppend :: Int -> Int -> Int -> IO ()
238−concatPairWithAppend = concatPairsWith Internal.append
252+concatPairWithAppend = concatPairsWith Common.append2
239
253
240-- unfoldMany
254-- unfoldMany
241
255
@@ -244,7 +258,7 @@ concatPairWithAppend = concatPairsWith Internal.append
244{-# INLINE unfoldManyRepl #-}
258{-# INLINE unfoldManyRepl #-}
245unfoldManyRepl :: Int -> Int -> Int -> IO ()
259unfoldManyRepl :: Int -> Int -> Int -> IO ()
246unfoldManyRepl outer inner n =
260unfoldManyRepl outer inner n =
247− S.drain
261+ drain
248 $ S.unfoldMany
262 $ S.unfoldMany
249 (UF.lmap return (UF.replicateM inner))
263 (UF.lmap return (UF.replicateM inner))
250 (sourceUnfoldrM outer n)
264 (sourceUnfoldrM outer n)
@@ -266,7 +280,7 @@ o_1_space_concat value = sqrtVal `seq`
266 (concatMapPure 1 value)
280 (concatMapPure 1 value)
267
281
268 -- This is for comparison with foldMapWith
282 -- This is for comparison with foldMapWith
269− , benchIOSrc fromSerial "concatMapId (n of 1) (fromFoldable)"
283+ , benchIOSrc "concatMapId (n of 1) (fromFoldable)"
270 (S.concatMap id . sourceConcatMapId value)
284 (S.concatMap id . sourceConcatMapId value)
271
285
272 , benchIOSrc1 "concatMap (n of 1)"
286 , benchIOSrc1 "concatMap (n of 1)"
@@ -284,8 +298,8 @@ o_1_space_concat value = sqrtVal `seq`
284 (concatMapM 1 value)
298 (concatMapM 1 value)
285
299
286 -- This is for comparison with foldMapWith
300 -- This is for comparison with foldMapWith
287− , benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
301+ , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"
288− (S.concatMapWith serial id . sourceConcatMapId value)
302+ (S.concatMapWith Common.append id . sourceConcatMapId value)
289
303
290 , benchIOSrc1 "concatMapWith (n of 1)"
304 , benchIOSrc1 "concatMapWith (n of 1)"
291 (concatMapWithSerial value 1)
305 (concatMapWithSerial value 1)
@@ -343,23 +357,23 @@ o_n_space_concat value = sqrtVal `seq`
343o_1_space_applicative :: Int -> [Benchmark]
357o_1_space_applicative :: Int -> [Benchmark]
344o_1_space_applicative value =
358o_1_space_applicative value =
345 [ bgroup "Applicative"
359 [ bgroup "Applicative"
346− [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value fromSerial
360+ [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value
347− , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value fromSerial
361+ , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value
348− , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value fromSerial
362+ , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value
349− , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value fromSerial
363+ , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value
350 ]
364 ]
351 ]
365 ]
352
366
353o_n_space_applicative :: Int -> [Benchmark]
367o_n_space_applicative :: Int -> [Benchmark]
354o_n_space_applicative value =
368o_n_space_applicative value =
355 [ bgroup "Applicative"
369 [ bgroup "Applicative"
356− [ benchIOSrc fromSerial "(*>) (n times)" $
370+ [ benchIOSrc "(*>) (n times)" $
357 iterateSingleton ((*>) . pure) value
371 iterateSingleton ((*>) . pure) value
358− , benchIOSrc fromSerial "(<*) (n times)" $
372+ , benchIOSrc "(<*) (n times)" $
359 iterateSingleton (\x xs -> xs <* pure x) value
373 iterateSingleton (\x xs -> xs <* pure x) value
360− , benchIOSrc fromSerial "(<*>) (n times)" $
374+ , benchIOSrc "(<*>) (n times)" $
361 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
375 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
362− , benchIOSrc fromSerial "liftA2 (n times)" $
376+ , benchIOSrc "liftA2 (n times)" $
363 iterateSingleton (AP.liftA2 (+) . pure) value
377 iterateSingleton (AP.liftA2 (+) . pure) value
364 ]
378 ]
365 ]
379 ]
@@ -371,18 +385,18 @@ o_n_space_applicative value =
371o_1_space_monad :: Int -> [Benchmark]
385o_1_space_monad :: Int -> [Benchmark]
372o_1_space_monad value =
386o_1_space_monad value =
373 [ bgroup "Monad"
387 [ bgroup "Monad"
374− [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value fromSerial
388+ [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value
375− , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value fromSerial
389+ , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value
376 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
390 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
377− filterAllOutM value fromSerial
391+ filterAllOutM value
378 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
392 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
379− filterAllInM value fromSerial
393+ filterAllInM value
380 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
394 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
381− filterSome value fromSerial
395+ filterSome value
382 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
396 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
383− breakAfterSome value fromSerial
397+ breakAfterSome value
384 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
398 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
385− toNullM3 value fromSerial
399+ toNullM3 value
386 ]
400 ]
387 ]
401 ]
388
402
@@ -400,16 +414,16 @@ sieve s = do
400o_n_space_monad :: Int -> [Benchmark]
414o_n_space_monad :: Int -> [Benchmark]
401o_n_space_monad value =
415o_n_space_monad value =
402 [ bgroup "Monad"
416 [ bgroup "Monad"
403− [ benchIOSrc fromSerial "(>>) (n times)" $
417+ [ benchIOSrc "(>>) (n times)" $
404 iterateSingleton ((>>) . pure) value
418 iterateSingleton ((>>) . pure) value
405− , benchIOSrc fromSerial "(>>=) (n times)" $
419+ , benchIOSrc "(>>=) (n times)" $
406 iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
420 iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
407 , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
421 , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
408− toListM value fromSerial
422+ toListM value
409 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
423 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
410− toListSome value fromSerial
424+ toListSome value
411 , benchIO "naive prime sieve (n/4)"
425 , benchIO "naive prime sieve (n/4)"
412− (\n -> S.sum $ sieve $ S.enumerateFromTo 2 (value `div` 4 + n))
426+ (\n -> S.fold Fold.sum $ sieve $ enumerateFromTo 2 (value `div` 4 + n))
413 ]
427 ]
414 ]
428 ]
415
429
@@ -421,22 +435,22 @@ toKv :: Int -> (Int, Int)
421toKv p = (p, p)
435toKv p = (p, p)
422
436
423{-# INLINE joinWith #-}
437{-# INLINE joinWith #-}
424−joinWith :: (S.MonadAsync m) =>
438+joinWith :: Common.MonadAsync m =>
425 ((Int -> Int -> Bool) -> SerialT m Int -> SerialT m Int -> SerialT m b)
439 ((Int -> Int -> Bool) -> SerialT m Int -> SerialT m Int -> SerialT m b)
426 -> Int
440 -> Int
427 -> Int
441 -> Int
428 -> m ()
442 -> m ()
429joinWith j val i =
443joinWith j val i =
430− S.drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
444+ drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
431
445
432{-# INLINE joinMapWith #-}
446{-# INLINE joinMapWith #-}
433−joinMapWith :: (S.MonadAsync m) =>
447+joinMapWith :: Common.MonadAsync m =>
434 (SerialT m (Int, Int) -> SerialT m (Int, Int) -> SerialT m b)
448 (SerialT m (Int, Int) -> SerialT m (Int, Int) -> SerialT m b)
435 -> Int
449 -> Int
436 -> Int
450 -> Int
437 -> m ()
451 -> m ()
438joinMapWith j val i =
452joinMapWith j val i =
439− S.drain
453+ drain
440 $ j
454 $ j
441 (fmap toKv (sourceUnfoldrM val i))
455 (fmap toKv (sourceUnfoldrM val i))
442 (fmap toKv (sourceUnfoldrM val (val `div` 2)))
456 (fmap toKv (sourceUnfoldrM val (val `div` 2)))
@@ -446,21 +460,21 @@ o_n_heap_buffering value =
446 [ bgroup "buffered"
460 [ bgroup "buffered"
447 [
461 [
448 benchIOSrc1 "joinInner (sqrtVal)"
462 benchIOSrc1 "joinInner (sqrtVal)"
449− $ joinWith Internal.joinInner sqrtVal
463+ $ joinWith S.joinInner sqrtVal
450 , benchIOSrc1 "joinInnerMap"
464 , benchIOSrc1 "joinInnerMap"
451− $ joinMapWith Internal.joinInnerMap halfVal
465+ $ joinMapWith S.joinInnerMap halfVal
452 , benchIOSrc1 "joinLeft (sqrtVal)"
466 , benchIOSrc1 "joinLeft (sqrtVal)"
453− $ joinWith Internal.joinLeft sqrtVal
467+ $ joinWith S.joinLeft sqrtVal
454 , benchIOSrc1 "joinLeftMap "
468 , benchIOSrc1 "joinLeftMap "
455− $ joinMapWith Internal.joinLeftMap halfVal
469+ $ joinMapWith S.joinLeftMap halfVal
456 , benchIOSrc1 "joinOuter (sqrtVal)"
470 , benchIOSrc1 "joinOuter (sqrtVal)"
457− $ joinWith Internal.joinOuter sqrtVal
471+ $ joinWith S.joinOuter sqrtVal
458 , benchIOSrc1 "joinOuterMap"
472 , benchIOSrc1 "joinOuterMap"
459− $ joinMapWith Internal.joinOuterMap halfVal
473+ $ joinMapWith S.joinOuterMap halfVal
460 , benchIOSrc1 "intersectBy (sqrtVal)"
474 , benchIOSrc1 "intersectBy (sqrtVal)"
461− $ joinWith Internal.intersectBy sqrtVal
475+ $ joinWith S.intersectBy sqrtVal
462 , benchIOSrc1 "intersectBySorted"
476 , benchIOSrc1 "intersectBySorted"
463− $ joinMapWith (Internal.intersectBySorted compare) halfVal
477+ $ joinMapWith (S.intersectBySorted compare) halfVal
464 ]
478 ]
465 ]
479 ]
466
480
@@ -482,7 +496,9 @@ benchmarks moduleName size =
482 [
496 [
483 -- multi-stream
497 -- multi-stream
484 o_1_space_joining size
498 o_1_space_joining size
499+#ifdef USE_PRELUDE
485 , o_1_space_concatFoldable size
500 , o_1_space_concatFoldable size
501+#endif
486 , o_1_space_concat size
502 , o_1_space_concat size
487
503
488 , o_1_space_applicative size
504 , o_1_space_applicative size
benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hs → benchmark/Streamly/Benchmark/Data/Stream/Generate.hsrenamed+72−34
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Serial.Generation
2+-- Module : Stream.Generate
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -9,19 +9,36 @@
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RankNTypes #-}
11
11
12−module Serial.Generation (benchmarks) where
12+module Stream.Generate (benchmarks) where
13
13
14import Data.Functor.Identity (Identity)
14import Data.Functor.Identity (Identity)
15
15
16−import qualified Prelude
16+import qualified Stream.Common as Common
17+#ifdef USE_PRELUDE
17import qualified GHC.Exts as GHC
18import qualified GHC.Exts as GHC
18−
19−import qualified Streamly.Prelude as S
19+import qualified Streamly.Prelude as S
20+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
21+import qualified Prelude
22+#else
23+import qualified Streamly.Internal.Data.Stream as Stream
24+#endif
20
25
21import Gauge
26import Gauge
22−import Streamly.Prelude (SerialT, fromSerial, MonadAsync)
23import Streamly.Benchmark.Common
27import Streamly.Benchmark.Common
28+import Streamly.Internal.Data.Stream.Serial (SerialT)
29+#ifdef USE_PRELUDE
30+import Streamly.Prelude (MonadAsync)
31+import Stream.Common hiding (MonadAsync, replicate, enumerateFromTo)
24−import Streamly.Benchmark.Prelude
32+import Streamly.Benchmark.Prelude hiding
33+ (benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2, toNullAp
34+ , monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM, filterSome
35+ , breakAfterSome, toListM, toListSome)
36+#else
37+import Stream.Common
38+#endif
39+
40+import System.IO.Unsafe (unsafeInterleaveIO)
41+
25import Prelude hiding (repeat, replicate, iterate)
42import Prelude hiding (repeat, replicate, iterate)
26
43
27-------------------------------------------------------------------------------
44-------------------------------------------------------------------------------
@@ -32,6 +49,7 @@ import Prelude hiding (repeat, replicate, iterate)
32-- fromList
49-- fromList
33-------------------------------------------------------------------------------
50-------------------------------------------------------------------------------
34
51
52+#ifdef USE_PRELUDE
35{-# INLINE sourceIsList #-}
53{-# INLINE sourceIsList #-}
36sourceIsList :: Int -> Int -> SerialT Identity Int
54sourceIsList :: Int -> Int -> SerialT Identity Int
37sourceIsList value n = GHC.fromList [n..n+value]
55sourceIsList value n = GHC.fromList [n..n+value]
@@ -39,6 +57,7 @@ sourceIsList value n = GHC.fromList [n..n+value]
39{-# INLINE sourceIsString #-}
57{-# INLINE sourceIsString #-}
40sourceIsString :: Int -> Int -> SerialT Identity Char
58sourceIsString :: Int -> Int -> SerialT Identity Char
41sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')
59sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')
60+#endif
42
61
43{-# INLINE readInstance #-}
62{-# INLINE readInstance #-}
44readInstance :: String -> SerialT Identity Int
63readInstance :: String -> SerialT Identity Int
@@ -57,6 +76,7 @@ readInstanceList str =
57 [(x,"")] -> x
76 [(x,"")] -> x
58 _ -> error "readInstance: no parse"
77 _ -> error "readInstance: no parse"
59
78
79+#ifdef USE_PRELUDE
60{-# INLINE repeat #-}
80{-# INLINE repeat #-}
61repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
81repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
62repeat count = S.take count . S.repeat
82repeat count = S.take count . S.repeat
@@ -114,41 +134,59 @@ fromIndices value n = S.take value $ S.fromIndices (+ n)
114{-# INLINE fromIndicesM #-}
134{-# INLINE fromIndicesM #-}
115fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
135fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
116fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
136fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
137+#endif
138+
139+{-# INLINE mfixUnfold #-}
140+mfixUnfold :: Int -> Int -> SerialT IO (Int, Int)
141+mfixUnfold count start = Stream.mfix f
142+ where
143+ f action = do
144+ let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act
145+ x <- Common.fromListM [incr 1 action, incr 2 action]
146+ y <- Common.sourceUnfoldr count start
147+ return (x, y)
117
148
118o_1_space_generation :: Int -> [Benchmark]
149o_1_space_generation :: Int -> [Benchmark]
119o_1_space_generation value =
150o_1_space_generation value =
120 [ bgroup "generation"
151 [ bgroup "generation"
121− [ benchIOSrc fromSerial "unfoldr" (sourceUnfoldr value)
152+ [ benchIOSrc "unfoldr" (sourceUnfoldr value)
122− , benchIOSrc fromSerial "unfoldrM" (sourceUnfoldrM value)
153+ , benchIOSrc "unfoldrM" (sourceUnfoldrM value)
154+#ifdef USE_PRELUDE
123− , benchIOSrc fromSerial "repeat" (repeat value)
155+ , benchIOSrc "repeat" (repeat value)
124− , benchIOSrc fromSerial "repeatM" (repeatM value)
156+ , benchIOSrc "repeatM" (repeatM value)
125− , benchIOSrc fromSerial "replicate" (replicate value)
157+ , benchIOSrc "replicate" (replicate value)
126− , benchIOSrc fromSerial "replicateM" (replicateM value)
158+ , benchIOSrc "replicateM" (replicateM value)
127− , benchIOSrc fromSerial "iterate" (iterate value)
159+ , benchIOSrc "iterate" (iterate value)
128− , benchIOSrc fromSerial "iterateM" (iterateM value)
160+ , benchIOSrc "iterateM" (iterateM value)
129− , benchIOSrc fromSerial "fromIndices" (fromIndices value)
161+ , benchIOSrc "fromIndices" (fromIndices value)
130− , benchIOSrc fromSerial "fromIndicesM" (fromIndicesM value)
162+ , benchIOSrc "fromIndicesM" (fromIndicesM value)
131− , benchIOSrc fromSerial "intFromTo" (sourceIntFromTo value)
163+ , benchIOSrc "intFromTo" (sourceIntFromTo value)
132− , benchIOSrc fromSerial "intFromThenTo" (sourceIntFromThenTo value)
164+ , benchIOSrc "intFromThenTo" (sourceIntFromThenTo value)
133− , benchIOSrc fromSerial "integerFromStep" (sourceIntegerFromStep value)
165+ , benchIOSrc "integerFromStep" (sourceIntegerFromStep value)
134− , benchIOSrc fromSerial "fracFromThenTo" (sourceFracFromThenTo value)
166+ , benchIOSrc "fracFromThenTo" (sourceFracFromThenTo value)
135− , benchIOSrc fromSerial "fracFromTo" (sourceFracFromTo value)
167+ , benchIOSrc "fracFromTo" (sourceFracFromTo value)
136− , benchIOSrc fromSerial "fromList" (sourceFromList value)
168+ , benchIOSrc "fromList" (sourceFromList value)
137 , benchPureSrc "IsList.fromList" (sourceIsList value)
169 , benchPureSrc "IsList.fromList" (sourceIsList value)
138 , benchPureSrc "IsString.fromString" (sourceIsString value)
170 , benchPureSrc "IsString.fromString" (sourceIsString value)
139− , benchIOSrc fromSerial "fromListM" (sourceFromListM value)
171+ , benchIOSrc "fromListM" (sourceFromListM value)
140− , benchIOSrc fromSerial "enumerateFrom" (enumerateFrom value)
172+ , benchIOSrc "enumerateFrom" (enumerateFrom value)
141− , benchIOSrc fromSerial "enumerateFromTo" (enumerateFromTo value)
173+ , benchIOSrc "enumerateFromTo" (enumerateFromTo value)
142− , benchIOSrc fromSerial "enumerateFromThen" (enumerateFromThen value)
174+ , benchIOSrc "enumerateFromThen" (enumerateFromThen value)
143− , benchIOSrc fromSerial "enumerateFromThenTo" (enumerateFromThenTo value)
175+ , benchIOSrc "enumerateFromThenTo" (enumerateFromThenTo value)
144− , benchIOSrc fromSerial "enumerate" (enumerate value)
176+ , benchIOSrc "enumerate" (enumerate value)
145− , benchIOSrc fromSerial "enumerateTo" (enumerateTo value)
177+ , benchIOSrc "enumerateTo" (enumerateTo value)
178+#endif
146
179
147 -- These essentially test cons and consM
180 -- These essentially test cons and consM
148− , benchIOSrc fromSerial "fromFoldable" (sourceFromFoldable value)
181+ , benchIOSrc "fromFoldable" (sourceFromFoldable value)
149− , benchIOSrc fromSerial "fromFoldableM" (sourceFromFoldableM value)
182+ , benchIOSrc "fromFoldableM" (sourceFromFoldableM value)
150−
183+
184+#ifdef USE_PRELUDE
151− , benchIOSrc fromSerial "absTimes" $ absTimes value
185+ , benchIOSrc "absTimes" $ absTimes value
186+#endif
187+ , Common.benchIOSrc "mfix_10" (mfixUnfold 10)
188+ , Common.benchIOSrc "mfix_100" (mfixUnfold 100)
189+ , Common.benchIOSrc "mfix_1000" (mfixUnfold 1000)
152 ]
190 ]
153 ]
191 ]
154
192
benchmark/Streamly/Benchmark/Prelude/Serial/Lift.hs → benchmark/Streamly/Benchmark/Data/Stream/Lift.hsrenamed+42−22
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Serial.Lift
2+-- Module : Stream.Lift
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -9,19 +9,30 @@
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RankNTypes #-}
11
11
12−module Serial.Lift (benchmarks) where
12+module Stream.Lift (benchmarks) where
13
13
14+import Control.DeepSeq (NFData(..))
15+import Control.Monad.Trans.Class (lift)
14import Control.Monad.State.Strict (StateT, get, put, MonadState)
16import Control.Monad.State.Strict (StateT, get, put, MonadState)
17+import Data.Functor.Identity (Identity)
18+import Stream.Common (sourceUnfoldr, sourceUnfoldrM, benchIOSrc, drain)
19+import System.Random (randomRIO)
20+#ifdef USE_PRELUDE
21+import Streamly.Benchmark.Prelude hiding
22+ (sourceUnfoldr, sourceUnfoldrM, benchIOSrc)
23+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
24+#else
25+import Streamly.Benchmark.Prelude (benchIO)
26+import qualified Streamly.Internal.Data.Stream as Stream
27+#endif
28+import qualified Streamly.Internal.Data.Fold as Fold
29+import qualified Stream.Common as Common
15import qualified Control.Monad.State.Strict as State
30import qualified Control.Monad.State.Strict as State
16−import Control.Monad.Trans.Class (lift)
17−
18−import qualified Streamly.Prelude as S
19−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
20
31
21import Gauge
32import Gauge
22−import Streamly.Prelude (SerialT, fromSerial)
33+import Streamly.Internal.Data.Stream.Serial (SerialT)
23import Streamly.Benchmark.Common
34import Streamly.Benchmark.Common
24−import Streamly.Benchmark.Prelude
35+
25import Prelude hiding (reverse, tail)
36import Prelude hiding (reverse, tail)
26
37
27-------------------------------------------------------------------------------
38-------------------------------------------------------------------------------
@@ -29,9 +40,9 @@ import Prelude hiding (reverse, tail)
29-------------------------------------------------------------------------------
40-------------------------------------------------------------------------------
30
41
31{-# INLINE sourceUnfoldrState #-}
42{-# INLINE sourceUnfoldrState #-}
32−sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
43+sourceUnfoldrState :: Common.MonadAsync m =>
33− => Int -> Int -> t (StateT Int m) Int
44+ Int -> Int -> SerialT (StateT Int m) Int
34−sourceUnfoldrState value n = S.unfoldrM step n
45+sourceUnfoldrState value n = Common.unfoldrM step n
35 where
46 where
36 step cnt =
47 step cnt =
37 if cnt > n + value
48 if cnt > n + value
@@ -42,27 +53,36 @@ sourceUnfoldrState value n = S.unfoldrM step n
42 return (Just (s, cnt + 1))
53 return (Just (s, cnt + 1))
43
54
44{-# INLINE evalStateT #-}
55{-# INLINE evalStateT #-}
45−evalStateT :: S.MonadAsync m => Int -> Int -> SerialT m Int
56+evalStateT :: Common.MonadAsync m => Int -> Int -> SerialT m Int
46evalStateT value n =
57evalStateT value n =
47− Internal.evalStateT (return 0) (sourceUnfoldrState value n)
58+ Stream.evalStateT (return 0) (sourceUnfoldrState value n)
48
59
49{-# INLINE withState #-}
60{-# INLINE withState #-}
50−withState :: S.MonadAsync m => Int -> Int -> SerialT m Int
61+withState :: Common.MonadAsync m => Int -> Int -> SerialT m Int
51withState value n =
62withState value n =
52− Internal.evalStateT
63+ Stream.evalStateT
53− (return (0 :: Int)) (Internal.liftInner (sourceUnfoldrM value n))
64+ (return (0 :: Int)) (Stream.liftInner (sourceUnfoldrM value n))
65+
66+{-# INLINE benchHoistSink #-}
67+benchHoistSink
68+ :: (NFData b)
69+ => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
70+benchHoistSink value name f =
71+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
54
72
55o_1_space_hoisting :: Int -> [Benchmark]
73o_1_space_hoisting :: Int -> [Benchmark]
56o_1_space_hoisting value =
74o_1_space_hoisting value =
57 [ bgroup "hoisting"
75 [ bgroup "hoisting"
58− [ benchIOSrc fromSerial "evalState" (evalStateT value)
76+ [ benchIOSrc "evalState" (evalStateT value)
59− , benchIOSrc fromSerial "withState" (withState value)
77+ , benchIOSrc "withState" (withState value)
78+ , benchHoistSink value "generally"
79+ ((\xs -> Stream.fold Fold.length xs :: IO Int) . Stream.generally)
60 ]
80 ]
61 ]
81 ]
62
82
63{-# INLINE iterateStateIO #-}
83{-# INLINE iterateStateIO #-}
64iterateStateIO ::
84iterateStateIO ::
65− (S.MonadAsync m)
85+ Monad m
66 => Int
86 => Int
67 -> StateT Int m Int
87 -> StateT Int m Int
68iterateStateIO n = do
88iterateStateIO n = do
@@ -86,7 +106,7 @@ iterateStateT n = do
86{-# INLINE iterateState #-}
106{-# INLINE iterateState #-}
87{-# SPECIALIZE iterateState :: Int -> SerialT (StateT Int IO) Int #-}
107{-# SPECIALIZE iterateState :: Int -> SerialT (StateT Int IO) Int #-}
88iterateState ::
108iterateState ::
89− (S.MonadAsync m, MonadState Int m)
109+ MonadState Int m
90 => Int
110 => Int
91 -> SerialT m Int
111 -> SerialT m Int
92iterateState n = do
112iterateState n = do
@@ -103,9 +123,9 @@ o_n_heap_transformer value =
103 [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
123 [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
104 State.evalStateT (iterateStateIO n) value
124 State.evalStateT (iterateStateIO n) value
105 , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
125 , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
106− State.evalStateT (S.drain (iterateStateT n)) value
126+ State.evalStateT (drain (iterateStateT n)) value
107 , benchIO "MonadState Int m => SerialT m Int" $ \n ->
127 , benchIO "MonadState Int m => SerialT m Int" $ \n ->
108− State.evalStateT (S.drain (iterateState n)) value
128+ State.evalStateT (drain (iterateState n)) value
109 ]
129 ]
110 ]
130 ]
111
131
benchmark/Streamly/Benchmark/Prelude/Serial/NestedFold.hs → benchmark/Streamly/Benchmark/Data/Stream/Reduce.hsrenamed+137−86
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Serial.NestedFold
2+-- Module : Stream.Reduce
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -11,26 +11,37 @@
11{-# LANGUAGE DeriveGeneric #-}
11{-# LANGUAGE DeriveGeneric #-}
12{-# LANGUAGE RankNTypes #-}
12{-# LANGUAGE RankNTypes #-}
13
13
14−module Serial.NestedFold (benchmarks) where
14+module Stream.Reduce (benchmarks) where
15
15
16import Control.DeepSeq (NFData(..))
16import Control.DeepSeq (NFData(..))
17−import Control.Monad (when)
18import Control.Monad.IO.Class (MonadIO(..))
17import Control.Monad.IO.Class (MonadIO(..))
19import Data.Monoid (Sum(..))
18import Data.Monoid (Sum(..))
20−import Data.Proxy (Proxy(..))
21−import Data.HashMap.Strict (HashMap)
22import GHC.Generics (Generic)
19import GHC.Generics (Generic)
23import Streamly.Internal.Data.IsMap.HashMap ()
20import Streamly.Internal.Data.IsMap.HashMap ()
21+import Streamly.Internal.Data.Stream.Serial (SerialT)
24
22
25import qualified Streamly.Internal.Data.Refold.Type as Refold
23import qualified Streamly.Internal.Data.Refold.Type as Refold
26import qualified Streamly.Internal.Data.Fold as FL
24import qualified Streamly.Internal.Data.Fold as FL
25+import qualified Stream.Common as Common
26+#ifdef USE_PRELUDE
27+import Control.Monad (when)
28+import Data.Proxy (Proxy(..))
29+import Data.HashMap.Strict (HashMap)
27−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
30+import qualified Streamly.Internal.Data.Stream.IsStream as S
31+import Streamly.Prelude (fromSerial)
32+import Streamly.Benchmark.Prelude hiding
33+ ( benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2
34+ , toNullAp, monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM
35+ , filterSome, breakAfterSome, toListM, toListSome, transformMapM
36+ , transformComposeMapM, transformTeeMapM, transformZipMapM)
37+#else
38+import Streamly.Benchmark.Prelude (benchIO)
28−import qualified Streamly.Prelude as S
39+import qualified Streamly.Internal.Data.Stream as S
40+#endif
29
41
30import Gauge
42import Gauge
31−import Streamly.Prelude (SerialT, fromSerial)
32import Streamly.Benchmark.Common
43import Streamly.Benchmark.Common
33−import Streamly.Benchmark.Prelude
44+import Stream.Common
34import Prelude hiding (reverse, tail)
45import Prelude hiding (reverse, tail)
35
46
36-------------------------------------------------------------------------------
47-------------------------------------------------------------------------------
@@ -48,13 +59,14 @@ iterateN g initial count = f count initial
48
59
49-- Iterate a transformation over a singleton stream
60-- Iterate a transformation over a singleton stream
50{-# INLINE iterateSingleton #-}
61{-# INLINE iterateSingleton #-}
51−iterateSingleton :: S.MonadAsync m
62+iterateSingleton :: Monad m
52 => (Int -> SerialT m Int -> SerialT m Int)
63 => (Int -> SerialT m Int -> SerialT m Int)
53 -> Int
64 -> Int
54 -> Int
65 -> Int
55 -> SerialT m Int
66 -> SerialT m Int
56iterateSingleton g count n = iterateN g (return n) count
67iterateSingleton g count n = iterateN g (return n) count
57
68
69+{-
58-- XXX need to check why this is slower than the explicit recursion above, even
70-- XXX need to check why this is slower than the explicit recursion above, even
59-- if the above code is written in a foldr like head recursive way. We also
71-- if the above code is written in a foldr like head recursive way. We also
60-- need to try this with foldlM' once #150 is fixed.
72-- need to try this with foldlM' once #150 is fixed.
@@ -62,17 +74,18 @@ iterateSingleton g count n = iterateN g (return n) count
62-- foldrM and any related fusion issues.
74-- foldrM and any related fusion issues.
63{-# INLINE _iterateSingleton #-}
75{-# INLINE _iterateSingleton #-}
64_iterateSingleton ::
76_iterateSingleton ::
65− S.MonadAsync m
77+ Monad m
66 => (Int -> SerialT m Int -> SerialT m Int)
78 => (Int -> SerialT m Int -> SerialT m Int)
67 -> Int
79 -> Int
68 -> Int
80 -> Int
69 -> SerialT m Int
81 -> SerialT m Int
70_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
82_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
83+-}
71
84
72-- Apply transformation g count times on a stream of length len
85-- Apply transformation g count times on a stream of length len
73{-# INLINE iterateSource #-}
86{-# INLINE iterateSource #-}
74iterateSource ::
87iterateSource ::
75− S.MonadAsync m
88+ MonadAsync m
76 => (SerialT m Int -> SerialT m Int)
89 => (SerialT m Int -> SerialT m Int)
77 -> Int
90 -> Int
78 -> Int
91 -> Int
@@ -94,9 +107,9 @@ o_n_space_functor value =
94 [ bgroup "Functor"
107 [ bgroup "Functor"
95 [ benchIO "(+) (n times) (baseline)" $ \i0 ->
108 [ benchIO "(+) (n times) (baseline)" $ \i0 ->
96 iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
109 iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
97− , benchIOSrc fromSerial "(<$) (n times)" $
110+ , benchIOSrc "(<$) (n times)" $
98 iterateSingleton (<$) value
111 iterateSingleton (<$) value
99− , benchIOSrc fromSerial "fmap (n times)" $
112+ , benchIOSrc "fmap (n times)" $
100 iterateSingleton (fmap . (+)) value
113 iterateSingleton (fmap . (+)) value
101 {-
114 {-
102 , benchIOSrc fromSerial "_(<$) (n times)" $
115 , benchIOSrc fromSerial "_(<$) (n times)" $
@@ -111,74 +124,92 @@ o_n_space_functor value =
111-- Grouping transformations
124-- Grouping transformations
112-------------------------------------------------------------------------------
125-------------------------------------------------------------------------------
113
126
127+#ifdef USE_PRELUDE
114{-# INLINE groups #-}
128{-# INLINE groups #-}
115groups :: MonadIO m => SerialT m Int -> m ()
129groups :: MonadIO m => SerialT m Int -> m ()
116−groups = S.drain . S.groups FL.drain
130+groups = Common.drain . S.groups FL.drain
117
131
118-- XXX Change this test when the order of comparison is later changed
132-- XXX Change this test when the order of comparison is later changed
119{-# INLINE groupsByGT #-}
133{-# INLINE groupsByGT #-}
120groupsByGT :: MonadIO m => SerialT m Int -> m ()
134groupsByGT :: MonadIO m => SerialT m Int -> m ()
121−groupsByGT = S.drain . S.groupsBy (>) FL.drain
135+groupsByGT = Common.drain . S.groupsBy (>) FL.drain
122
136
123{-# INLINE groupsByEq #-}
137{-# INLINE groupsByEq #-}
124groupsByEq :: MonadIO m => SerialT m Int -> m ()
138groupsByEq :: MonadIO m => SerialT m Int -> m ()
125−groupsByEq = S.drain . S.groupsBy (==) FL.drain
139+groupsByEq = Common.drain . S.groupsBy (==) FL.drain
126
140
127-- XXX Change this test when the order of comparison is later changed
141-- XXX Change this test when the order of comparison is later changed
128{-# INLINE groupsByRollingLT #-}
142{-# INLINE groupsByRollingLT #-}
129groupsByRollingLT :: MonadIO m => SerialT m Int -> m ()
143groupsByRollingLT :: MonadIO m => SerialT m Int -> m ()
130groupsByRollingLT =
144groupsByRollingLT =
131− S.drain . S.groupsByRolling (<) FL.drain
145+ Common.drain . S.groupsByRolling (<) FL.drain
132
146
133{-# INLINE groupsByRollingEq #-}
147{-# INLINE groupsByRollingEq #-}
134groupsByRollingEq :: MonadIO m => SerialT m Int -> m ()
148groupsByRollingEq :: MonadIO m => SerialT m Int -> m ()
135groupsByRollingEq =
149groupsByRollingEq =
136− S.drain . S.groupsByRolling (==) FL.drain
150+ Common.drain . S.groupsByRolling (==) FL.drain
151+#endif
137
152
138{-# INLINE foldMany #-}
153{-# INLINE foldMany #-}
139foldMany :: Monad m => SerialT m Int -> m ()
154foldMany :: Monad m => SerialT m Int -> m ()
140foldMany =
155foldMany =
141− S.drain
156+ Common.drain
142− . S.map getSum
157+ . fmap getSum
143− . Internal.foldMany (FL.take 2 FL.mconcat)
158+ . S.foldMany (FL.take 2 FL.mconcat)
159+ . fmap Sum
160+
161+{-# INLINE foldManyPost #-}
162+foldManyPost :: Monad m => SerialT m Int -> m ()
163+foldManyPost =
164+ Common.drain
165+ . fmap getSum
166+ . S.foldManyPost (FL.take 2 FL.mconcat)
144− . S.map Sum
167+ . fmap Sum
145
168
146{-# INLINE refoldMany #-}
169{-# INLINE refoldMany #-}
147refoldMany :: Monad m => SerialT m Int -> m ()
170refoldMany :: Monad m => SerialT m Int -> m ()
148refoldMany =
171refoldMany =
149− S.drain
172+ Common.drain
150− . S.map getSum
173+ . fmap getSum
151− . Internal.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
174+ . S.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
152− . S.map Sum
175+ . fmap Sum
153
176
154{-# INLINE foldIterateM #-}
177{-# INLINE foldIterateM #-}
155foldIterateM :: Monad m => SerialT m Int -> m ()
178foldIterateM :: Monad m => SerialT m Int -> m ()
156foldIterateM =
179foldIterateM =
157− S.drain
180+ Common.drain
158− . S.map getSum
181+ . fmap getSum
159− . Internal.foldIterateM
182+ . S.foldIterateM
160 (return . FL.take 2 . FL.sconcat) (return (Sum 0))
183 (return . FL.take 2 . FL.sconcat) (return (Sum 0))
161− . S.map Sum
184+ . fmap Sum
162
185
163{-# INLINE refoldIterateM #-}
186{-# INLINE refoldIterateM #-}
164refoldIterateM :: Monad m => SerialT m Int -> m ()
187refoldIterateM :: Monad m => SerialT m Int -> m ()
165refoldIterateM =
188refoldIterateM =
166− S.drain
189+ Common.drain
167− . S.map getSum
190+ . fmap getSum
168− . Internal.refoldIterateM
191+ . S.refoldIterateM
169 (Refold.take 2 Refold.sconcat) (return (Sum 0))
192 (Refold.take 2 Refold.sconcat) (return (Sum 0))
170− . S.map Sum
193+ . fmap Sum
171
194
172o_1_space_grouping :: Int -> [Benchmark]
195o_1_space_grouping :: Int -> [Benchmark]
173o_1_space_grouping value =
196o_1_space_grouping value =
174 -- Buffering operations using heap proportional to group/window sizes.
197 -- Buffering operations using heap proportional to group/window sizes.
175 [ bgroup "grouping"
198 [ bgroup "grouping"
199+ [
200+#ifdef USE_PRELUDE
176− [ benchIOSink value "groups" groups
201+ benchIOSink value "groups" groups
177 , benchIOSink value "groupsByGT" groupsByGT
202 , benchIOSink value "groupsByGT" groupsByGT
178 , benchIOSink value "groupsByEq" groupsByEq
203 , benchIOSink value "groupsByEq" groupsByEq
179 , benchIOSink value "groupsByRollingLT" groupsByRollingLT
204 , benchIOSink value "groupsByRollingLT" groupsByRollingLT
180 , benchIOSink value "groupsByRollingEq" groupsByRollingEq
205 , benchIOSink value "groupsByRollingEq" groupsByRollingEq
206+ ,
207+#endif
208+ -- XXX parseMany/parseIterate benchmarks are in the Parser/ParserD
209+ -- modules we can bring those here. arraysOf benchmarks are in
210+ -- Parser/ParserD/Array.Stream/FileSystem.Handle.
181− , benchIOSink value "foldMany" foldMany
211+ benchIOSink value "foldMany" foldMany
212+ , benchIOSink value "foldManyPost" foldManyPost
182 , benchIOSink value "refoldMany" refoldMany
213 , benchIOSink value "refoldMany" refoldMany
183 , benchIOSink value "foldIterateM" foldIterateM
214 , benchIOSink value "foldIterateM" foldIterateM
184 , benchIOSink value "refoldIterateM" refoldIterateM
215 , benchIOSink value "refoldIterateM" refoldIterateM
@@ -195,7 +226,7 @@ reverse n = composeN n S.reverse
195
226
196{-# INLINE reverse' #-}
227{-# INLINE reverse' #-}
197reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
228reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
198−reverse' n = composeN n Internal.reverse'
229+reverse' n = composeN n S.reverse'
199
230
200o_n_heap_buffering :: Int -> [Benchmark]
231o_n_heap_buffering :: Int -> [Benchmark]
201o_n_heap_buffering value =
232o_n_heap_buffering value =
@@ -205,7 +236,9 @@ o_n_heap_buffering value =
205 benchIOSink value "reverse" (reverse 1)
236 benchIOSink value "reverse" (reverse 1)
206 , benchIOSink value "reverse'" (reverse' 1)
237 , benchIOSink value "reverse'" (reverse' 1)
207
238
239+#ifdef USE_PRELUDE
208 , benchIOSink value "mkAsync" (mkAsync fromSerial)
240 , benchIOSink value "mkAsync" (mkAsync fromSerial)
241+#endif
209 ]
242 ]
210 ]
243 ]
211
244
@@ -213,25 +246,26 @@ o_n_heap_buffering value =
213-- Grouping/Splitting
246-- Grouping/Splitting
214-------------------------------------------------------------------------------
247-------------------------------------------------------------------------------
215
248
249+#ifdef USE_PRELUDE
216{-# INLINE classifySessionsOf #-}
250{-# INLINE classifySessionsOf #-}
217−classifySessionsOf :: S.MonadAsync m => (Int -> Int) -> SerialT m Int -> m ()
251+classifySessionsOf :: MonadAsync m => (Int -> Int) -> SerialT m Int -> m ()
218classifySessionsOf getKey =
252classifySessionsOf getKey =
219− S.drain
253+ Common.drain
220− . Internal.classifySessionsOf
254+ . S.classifySessionsOf
221 (const (return False)) 3 (FL.take 10 FL.sum)
255 (const (return False)) 3 (FL.take 10 FL.sum)
222− . Internal.timestamped
256+ . S.timestamped
223− . S.map (\x -> (getKey x, x))
257+ . fmap (\x -> (getKey x, x))
224
258
225{-# INLINE classifySessionsOfHash #-}
259{-# INLINE classifySessionsOfHash #-}
226−classifySessionsOfHash :: S.MonadAsync m =>
260+classifySessionsOfHash :: MonadAsync m =>
227 (Int -> Int) -> SerialT m Int -> m ()
261 (Int -> Int) -> SerialT m Int -> m ()
228classifySessionsOfHash getKey =
262classifySessionsOfHash getKey =
229− S.drain
263+ Common.drain
230− . Internal.classifySessionsByGeneric
264+ . S.classifySessionsByGeneric
231 (Proxy :: Proxy (HashMap k))
265 (Proxy :: Proxy (HashMap k))
232 1 False (const (return False)) 3 (FL.take 10 FL.sum)
266 1 False (const (return False)) 3 (FL.take 10 FL.sum)
233− . Internal.timestamped
267+ . S.timestamped
234− . S.map (\x -> (getKey x, x))
268+ . fmap (\x -> (getKey x, x))
235
269
236o_n_space_grouping :: Int -> [Benchmark]
270o_n_space_grouping :: Int -> [Benchmark]
237o_n_space_grouping value =
271o_n_space_grouping value =
@@ -251,6 +285,7 @@ o_n_space_grouping value =
251 where
285 where
252
286
253 getKey n = (`mod` n)
287 getKey n = (`mod` n)
288+#endif
254
289
255-------------------------------------------------------------------------------
290-------------------------------------------------------------------------------
256-- Mixed Transformation
291-- Mixed Transformation
@@ -258,15 +293,15 @@ o_n_space_grouping value =
258
293
259{-# INLINE scanMap #-}
294{-# INLINE scanMap #-}
260scanMap :: MonadIO m => Int -> SerialT m Int -> m ()
295scanMap :: MonadIO m => Int -> SerialT m Int -> m ()
261−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
296+scanMap n = composeN n $ fmap (subtract 1) . Common.scanl' (+) 0
262
297
263{-# INLINE dropMap #-}
298{-# INLINE dropMap #-}
264dropMap :: MonadIO m => Int -> SerialT m Int -> m ()
299dropMap :: MonadIO m => Int -> SerialT m Int -> m ()
265−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
300+dropMap n = composeN n $ fmap (subtract 1) . S.drop 1
266
301
267{-# INLINE dropScan #-}
302{-# INLINE dropScan #-}
268dropScan :: MonadIO m => Int -> SerialT m Int -> m ()
303dropScan :: MonadIO m => Int -> SerialT m Int -> m ()
269−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
304+dropScan n = composeN n $ Common.scanl' (+) 0 . S.drop 1
270
305
271{-# INLINE takeDrop #-}
306{-# INLINE takeDrop #-}
272takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
307takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
@@ -274,11 +309,11 @@ takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
274
309
275{-# INLINE takeScan #-}
310{-# INLINE takeScan #-}
276takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
311takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
277−takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)
312+takeScan value n = composeN n $ Common.scanl' (+) 0 . S.take (value + 1)
278
313
279{-# INLINE takeMap #-}
314{-# INLINE takeMap #-}
280takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
315takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
281−takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)
316+takeMap value n = composeN n $ fmap (subtract 1) . S.take (value + 1)
282
317
283{-# INLINE filterDrop #-}
318{-# INLINE filterDrop #-}
284filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
319filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
@@ -290,15 +325,17 @@ filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
290
325
291{-# INLINE filterScan #-}
326{-# INLINE filterScan #-}
292filterScan :: MonadIO m => Int -> SerialT m Int -> m ()
327filterScan :: MonadIO m => Int -> SerialT m Int -> m ()
293−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
328+filterScan n = composeN n $ Common.scanl' (+) 0 . S.filter (<= maxBound)
294
329
330+#ifdef USE_PRELUDE
295{-# INLINE filterScanl1 #-}
331{-# INLINE filterScanl1 #-}
296filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()
332filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()
297filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
333filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
334+#endif
298
335
299{-# INLINE filterMap #-}
336{-# INLINE filterMap #-}
300filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
337filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
301−filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))
338+filterMap value n = composeN n $ fmap (subtract 1) . S.filter (<= (value + 1))
302
339
303-------------------------------------------------------------------------------
340-------------------------------------------------------------------------------
304-- Scan and fold
341-- Scan and fold
@@ -310,17 +347,17 @@ data Pair a b =
310
347
311{-# INLINE sumProductFold #-}
348{-# INLINE sumProductFold #-}
312sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)
349sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)
313−sumProductFold = S.foldl' (\(s, p) x -> (s + x, p * x)) (0, 1)
350+sumProductFold = Common.foldl' (\(s, p) x -> (s + x, p * x)) (0, 1)
314
351
315{-# INLINE sumProductScan #-}
352{-# INLINE sumProductScan #-}
316sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)
353sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)
317sumProductScan =
354sumProductScan =
318− S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .
355+ Common.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .
319− S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
356+ Common.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
320
357
321{-# INLINE foldl'ReduceMap #-}
358{-# INLINE foldl'ReduceMap #-}
322foldl'ReduceMap :: Monad m => SerialT m Int -> m Int
359foldl'ReduceMap :: Monad m => SerialT m Int -> m Int
323−foldl'ReduceMap = fmap (+ 1) . S.foldl' (+) 0
360+foldl'ReduceMap = fmap (+ 1) . Common.foldl' (+) 0
324
361
325o_1_space_transformations_mixed :: Int -> [Benchmark]
362o_1_space_transformations_mixed :: Int -> [Benchmark]
326o_1_space_transformations_mixed value =
363o_1_space_transformations_mixed value =
@@ -347,7 +384,9 @@ o_1_space_transformations_mixedX4 value =
347 , benchIOSink value "filter-drop" (filterDrop value 4)
384 , benchIOSink value "filter-drop" (filterDrop value 4)
348 , benchIOSink value "filter-take" (filterTake value 4)
385 , benchIOSink value "filter-take" (filterTake value 4)
349 , benchIOSink value "filter-scan" (filterScan 4)
386 , benchIOSink value "filter-scan" (filterScan 4)
387+#ifdef USE_PRELUDE
350 , benchIOSink value "filter-scanl1" (filterScanl1 4)
388 , benchIOSink value "filter-scanl1" (filterScanl1 4)
389+#endif
351 , benchIOSink value "filter-map" (filterMap value 4)
390 , benchIOSink value "filter-map" (filterMap value 4)
352 ]
391 ]
353 ]
392 ]
@@ -358,40 +397,43 @@ o_1_space_transformations_mixedX4 value =
358
397
359-- this is quadratic
398-- this is quadratic
360{-# INLINE iterateScan #-}
399{-# INLINE iterateScan #-}
361−iterateScan :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
400+iterateScan :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
362−iterateScan = iterateSource (S.scanl' (+) 0)
401+iterateScan = iterateSource (Common.scanl' (+) 0)
363
402
403+#ifdef USE_PRELUDE
364-- this is quadratic
404-- this is quadratic
365{-# INLINE iterateScanl1 #-}
405{-# INLINE iterateScanl1 #-}
366−iterateScanl1 :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
406+iterateScanl1 :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
367iterateScanl1 = iterateSource (S.scanl1' (+))
407iterateScanl1 = iterateSource (S.scanl1' (+))
408+#endif
368
409
369{-# INLINE iterateMapM #-}
410{-# INLINE iterateMapM #-}
370−iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
411+iterateMapM :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
371iterateMapM = iterateSource (S.mapM return)
412iterateMapM = iterateSource (S.mapM return)
372
413
373{-# INLINE iterateFilterEven #-}
414{-# INLINE iterateFilterEven #-}
374−iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
415+iterateFilterEven :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
375iterateFilterEven = iterateSource (S.filter even)
416iterateFilterEven = iterateSource (S.filter even)
376
417
377{-# INLINE iterateTakeAll #-}
418{-# INLINE iterateTakeAll #-}
378−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int
419+iterateTakeAll :: MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int
379iterateTakeAll value = iterateSource (S.take (value + 1))
420iterateTakeAll value = iterateSource (S.take (value + 1))
380
421
381{-# INLINE iterateDropOne #-}
422{-# INLINE iterateDropOne #-}
382−iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
423+iterateDropOne :: MonadAsync m => Int -> Int -> Int -> SerialT m Int
383iterateDropOne = iterateSource (S.drop 1)
424iterateDropOne = iterateSource (S.drop 1)
384
425
385{-# INLINE iterateDropWhileFalse #-}
426{-# INLINE iterateDropWhileFalse #-}
386−iterateDropWhileFalse :: S.MonadAsync m
427+iterateDropWhileFalse :: MonadAsync m
387 => Int -> Int -> Int -> Int -> SerialT m Int
428 => Int -> Int -> Int -> Int -> SerialT m Int
388iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))
429iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))
389
430
390{-# INLINE iterateDropWhileTrue #-}
431{-# INLINE iterateDropWhileTrue #-}
391−iterateDropWhileTrue :: S.MonadAsync m
432+iterateDropWhileTrue :: MonadAsync m
392 => Int -> Int -> Int -> Int -> SerialT m Int
433 => Int -> Int -> Int -> Int -> SerialT m Int
393iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
434iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
394
435
436+#ifdef USE_PRELUDE
395{-# INLINE tail #-}
437{-# INLINE tail #-}
396tail :: Monad m => SerialT m a -> m ()
438tail :: Monad m => SerialT m a -> m ()
397tail s = S.tail s >>= mapM_ tail
439tail s = S.tail s >>= mapM_ tail
@@ -403,26 +445,31 @@ nullHeadTail s = do
403 when (not r) $ do
445 when (not r) $ do
404 _ <- S.head s
446 _ <- S.head s
405 S.tail s >>= mapM_ nullHeadTail
447 S.tail s >>= mapM_ nullHeadTail
448+#endif
406
449
407-- Head recursive operations.
450-- Head recursive operations.
408o_n_stack_iterated :: Int -> [Benchmark]
451o_n_stack_iterated :: Int -> [Benchmark]
409o_n_stack_iterated value = by10 `seq` by100 `seq`
452o_n_stack_iterated value = by10 `seq` by100 `seq`
410 [ bgroup "iterated"
453 [ bgroup "iterated"
411− [ benchIOSrc fromSerial "mapM (n/10 x 10)" $ iterateMapM by10 10
454+ [ benchIOSrc "mapM (n/10 x 10)" $ iterateMapM by10 10
412− , benchIOSrc fromSerial "scanl' (quadratic) (n/100 x 100)" $
455+ , benchIOSrc "scanl' (quadratic) (n/100 x 100)" $
413 iterateScan by100 100
456 iterateScan by100 100
457+#ifdef USE_PRELUDE
414− , benchIOSrc fromSerial "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
458+ , benchIOSrc "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
459+#endif
415− , benchIOSrc fromSerial "filterEven (n/10 x 10)" $
460+ , benchIOSrc "filterEven (n/10 x 10)" $
416 iterateFilterEven by10 10
461 iterateFilterEven by10 10
417− , benchIOSrc fromSerial "takeAll (n/10 x 10)" $
462+ , benchIOSrc "takeAll (n/10 x 10)" $
418 iterateTakeAll value by10 10
463 iterateTakeAll value by10 10
419− , benchIOSrc fromSerial "dropOne (n/10 x 10)" $ iterateDropOne by10 10
464+ , benchIOSrc "dropOne (n/10 x 10)" $ iterateDropOne by10 10
420− , benchIOSrc fromSerial "dropWhileFalse (n/10 x 10)" $
465+ , benchIOSrc "dropWhileFalse (n/10 x 10)" $
421 iterateDropWhileFalse value by10 10
466 iterateDropWhileFalse value by10 10
422− , benchIOSrc fromSerial "dropWhileTrue (n/10 x 10)" $
467+ , benchIOSrc "dropWhileTrue (n/10 x 10)" $
423 iterateDropWhileTrue value by10 10
468 iterateDropWhileTrue value by10 10
469+#ifdef USE_PRELUDE
424 , benchIOSink value "tail" tail
470 , benchIOSink value "tail" tail
425 , benchIOSink value "nullHeadTail" nullHeadTail
471 , benchIOSink value "nullHeadTail" nullHeadTail
472+#endif
426 ]
473 ]
427 ]
474 ]
428
475
@@ -438,12 +485,12 @@ o_n_stack_iterated value = by10 `seq` by100 `seq`
438o_1_space_pipes :: Int -> [Benchmark]
485o_1_space_pipes :: Int -> [Benchmark]
439o_1_space_pipes value =
486o_1_space_pipes value =
440 [ bgroup "pipes"
487 [ bgroup "pipes"
441− [ benchIOSink value "mapM" (transformMapM fromSerial 1)
488+ [ benchIOSink value "mapM" (transformMapM 1)
442− , benchIOSink value "compose" (transformComposeMapM fromSerial 1)
489+ , benchIOSink value "compose" (transformComposeMapM 1)
443− , benchIOSink value "tee" (transformTeeMapM fromSerial 1)
490+ , benchIOSink value "tee" (transformTeeMapM 1)
444#ifdef DEVBUILD
491#ifdef DEVBUILD
445 -- XXX this take 1 GB memory to compile
492 -- XXX this take 1 GB memory to compile
446− , benchIOSink value "zip" (transformZipMapM fromSerial 1)
493+ , benchIOSink value "zip" (transformZipMapM 1)
447#endif
494#endif
448 ]
495 ]
449 ]
496 ]
@@ -451,12 +498,12 @@ o_1_space_pipes value =
451o_1_space_pipesX4 :: Int -> [Benchmark]
498o_1_space_pipesX4 :: Int -> [Benchmark]
452o_1_space_pipesX4 value =
499o_1_space_pipesX4 value =
453 [ bgroup "pipesX4"
500 [ bgroup "pipesX4"
454− [ benchIOSink value "mapM" (transformMapM fromSerial 4)
501+ [ benchIOSink value "mapM" (transformMapM 4)
455− , benchIOSink value "compose" (transformComposeMapM fromSerial 4)
502+ , benchIOSink value "compose" (transformComposeMapM 4)
456− , benchIOSink value "tee" (transformTeeMapM fromSerial 4)
503+ , benchIOSink value "tee" (transformTeeMapM 4)
457#ifdef DEVBUILD
504#ifdef DEVBUILD
458 -- XXX this take 1 GB memory to compile
505 -- XXX this take 1 GB memory to compile
459− , benchIOSink value "zip" (transformZipMapM fromSerial 4)
506+ , benchIOSink value "zip" (transformZipMapM 4)
460#endif
507#endif
461 ]
508 ]
462 ]
509 ]
@@ -481,8 +528,12 @@ benchmarks moduleName size =
481 ]
528 ]
482 , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
529 , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
483 , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat
530 , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat
531+ [
532+#ifdef USE_PRELUDE
484− [ o_n_space_grouping size
533+ o_n_space_grouping size
534+ ,
535+#endif
485− , o_n_space_functor size
536+ o_n_space_functor size
486 , o_n_heap_buffering size
537 , o_n_heap_buffering size
487 ]
538 ]
488 ]
539 ]
benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs → benchmark/Streamly/Benchmark/Data/Stream/Split.hsrenamed+2−2
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Streamly.Benchmark.Prelude.Serial.Split
2+-- Module : Stream.Split
3-- Copyright : (c) 2019 Composewell Technologies
3-- Copyright : (c) 2019 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -18,7 +18,7 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
19#endif
20
20
21−module Serial.Split (benchmarks) where
21+module Stream.Split (benchmarks) where
22
22
23import Data.Char (ord)
23import Data.Char (ord)
24import Data.Word (Word8)
24import Data.Word (Word8)
benchmark/Streamly/Benchmark/Prelude/Serial/Transformation.hs → benchmark/Streamly/Benchmark/Data/Stream/Transform.hsrenamed+108−100
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Serial.Transformation
2+-- Module : Stream.Transform
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -18,30 +18,37 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
19#endif
20
20
21−module Serial.Transformation (benchmarks) where
21+module Stream.Transform (benchmarks) where
22
22
23import Control.DeepSeq (NFData(..))
23import Control.DeepSeq (NFData(..))
24import Control.Monad.IO.Class (MonadIO(..))
24import Control.Monad.IO.Class (MonadIO(..))
25import Data.Functor.Identity (Identity)
25import Data.Functor.Identity (Identity)
26−import System.Random (randomRIO)
27
26
28−#ifdef INSPECTION
27+import System.Random (randomRIO)
29−import Test.Inspection
30−#endif
31
28
32−import qualified Streamly.Prelude as S
33−import qualified Streamly.Internal.Data.Stream as Stream
34−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
35import qualified Streamly.Internal.Data.Fold as FL
29import qualified Streamly.Internal.Data.Fold as FL
36−import qualified Streamly.Internal.Data.Unfold as Unfold
30+
37import qualified Prelude
31import qualified Prelude
32+import qualified Stream.Common as Common
33+import qualified Streamly.Internal.Data.Unfold as Unfold
34+#ifdef USE_PRELUDE
35+import Streamly.Benchmark.Prelude hiding
36+ ( benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2, toNullAp
37+ , monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM, filterSome
38+ , breakAfterSome, toListM, toListSome, transformMapM, transformComposeMapM
39+ , transformTeeMapM, transformZipMapM, mapN, mapM)
40+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
41+import Streamly.Internal.Data.Time.Units
42+#else
43+import Streamly.Benchmark.Prelude (benchIO)
44+import qualified Streamly.Internal.Data.Stream as Stream
45+#endif
38
46
39import Gauge
47import Gauge
40−import Streamly.Prelude (SerialT, fromSerial, MonadAsync)
48+import Streamly.Internal.Data.Stream.Serial (SerialT)
49+import Stream.Common hiding (scanl')
41import Streamly.Benchmark.Common
50import Streamly.Benchmark.Common
42−import Streamly.Benchmark.Prelude
43−import Streamly.Internal.Data.Time.Units
44−import Prelude hiding (sequence, mapM, fmap)
51+import Prelude hiding (sequence, mapM)
45
52
46-------------------------------------------------------------------------------
53-------------------------------------------------------------------------------
47-- Pipelines (stream-to-stream transformations)
54-- Pipelines (stream-to-stream transformations)
@@ -94,83 +101,84 @@ o_n_space_traversable value =
94-- maps and scans
101-- maps and scans
95-------------------------------------------------------------------------------
102-------------------------------------------------------------------------------
96
103
104+#ifdef USE_PRELUDE
97{-# INLINE scanl' #-}
105{-# INLINE scanl' #-}
98scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
106scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
99−scanl' n = composeN n $ S.scanl' (+) 0
107+scanl' n = composeN n $ Stream.scanl' (+) 0
100
108
101{-# INLINE scanlM' #-}
109{-# INLINE scanlM' #-}
102scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
110scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
103−scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) (return 0)
111+scanlM' n = composeN n $ Stream.scanlM' (\b a -> return $ b + a) (return 0)
104
112
105{-# INLINE scanl1' #-}
113{-# INLINE scanl1' #-}
106scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
114scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
107−scanl1' n = composeN n $ S.scanl1' (+)
115+scanl1' n = composeN n $ Stream.scanl1' (+)
108
116
109{-# INLINE scanl1M' #-}
117{-# INLINE scanl1M' #-}
110scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
118scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
111−scanl1M' n = composeN n $ S.scanl1M' (\b a -> return $ b + a)
119+scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a)
120+#endif
112
121
113{-# INLINE scan #-}
122{-# INLINE scan #-}
114scan :: MonadIO m => Int -> SerialT m Int -> m ()
123scan :: MonadIO m => Int -> SerialT m Int -> m ()
115−scan n = composeN n $ S.scan FL.sum
124+scan n = composeN n $ Stream.scan FL.sum
116
125
126+#ifdef USE_PRELUDE
117{-# INLINE postscanl' #-}
127{-# INLINE postscanl' #-}
118postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
128postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
119−postscanl' n = composeN n $ S.postscanl' (+) 0
129+postscanl' n = composeN n $ Stream.postscanl' (+) 0
120
130
121{-# INLINE postscanlM' #-}
131{-# INLINE postscanlM' #-}
122postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
132postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
123−postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) (return 0)
133+postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0)
134+#endif
124
135
125{-# INLINE postscan #-}
136{-# INLINE postscan #-}
126postscan :: MonadIO m => Int -> SerialT m Int -> m ()
137postscan :: MonadIO m => Int -> SerialT m Int -> m ()
127−postscan n = composeN n $ S.postscan FL.sum
138+postscan n = composeN n $ Stream.postscan FL.sum
128
139
129{-# INLINE sequence #-}
140{-# INLINE sequence #-}
130−sequence ::
141+sequence :: MonadAsync m => SerialT m (m Int) -> m ()
131− (S.IsStream t, S.MonadAsync m)
132− => (t m Int -> S.SerialT m Int)
133− -> t m (m Int)
134− -> m ()
135−sequence t = S.drain . t . S.sequence
142+sequence = Common.drain . Stream.sequence
136
143
137{-# INLINE tap #-}
144{-# INLINE tap #-}
138tap :: MonadIO m => Int -> SerialT m Int -> m ()
145tap :: MonadIO m => Int -> SerialT m Int -> m ()
139−tap n = composeN n $ S.tap FL.sum
146+tap n = composeN n $ Stream.tap FL.sum
140
147
148+#ifdef USE_PRELUDE
141{-# INLINE pollCounts #-}
149{-# INLINE pollCounts #-}
142pollCounts :: Int -> SerialT IO Int -> IO ()
150pollCounts :: Int -> SerialT IO Int -> IO ()
143pollCounts n =
151pollCounts n =
144− composeN n (Internal.pollCounts (const True) f)
152+ composeN n (Stream.pollCounts (const True) f)
145
153
146 where
154 where
147
155
148− f = S.drain . Internal.rollingMap2 (-) . Internal.delayPost 1
156+ f = Stream.drain . Stream.rollingMap2 (-) . Stream.delayPost 1
149
157
150{-# INLINE timestamped #-}
158{-# INLINE timestamped #-}
151−timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()
159+timestamped :: (MonadAsync m) => SerialT m Int -> m ()
152−timestamped = S.drain . Internal.timestamped
160+timestamped = Stream.drain . Stream.timestamped
161+#endif
153
162
154{-# INLINE foldrS #-}
163{-# INLINE foldrS #-}
155foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
164foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
156−foldrS n = composeN n $ Internal.foldrS S.cons S.nil
165+foldrS n = composeN n $ Stream.foldrS Stream.cons Stream.nil
157
166
158{-# INLINE foldrSMap #-}
167{-# INLINE foldrSMap #-}
159foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
168foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
160−foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
169+foldrSMap n = composeN n $ Stream.foldrS (\x xs -> x + 1 `Stream.cons` xs) Stream.nil
161
170
162{-# INLINE foldrT #-}
171{-# INLINE foldrT #-}
163foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
172foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
164−foldrT n = composeN n $ Internal.foldrT S.cons S.nil
173+foldrT n = composeN n $ Stream.foldrT Stream.cons Stream.nil
165
174
166{-# INLINE foldrTMap #-}
175{-# INLINE foldrTMap #-}
167foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
176foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
168−foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
177+foldrTMap n = composeN n $ Stream.foldrT (\x xs -> x + 1 `Stream.cons` xs) Stream.nil
169−
170
178
171{-# INLINE trace #-}
179{-# INLINE trace #-}
172trace :: MonadAsync m => Int -> SerialT m Int -> m ()
180trace :: MonadAsync m => Int -> SerialT m Int -> m ()
173−trace n = composeN n $ Internal.trace return
181+trace n = composeN n $ Stream.trace return
174
182
175o_1_space_mapping :: Int -> [Benchmark]
183o_1_space_mapping :: Int -> [Benchmark]
176o_1_space_mapping value =
184o_1_space_mapping value =
@@ -184,11 +192,12 @@ o_1_space_mapping value =
184 , benchIOSink value "foldrTMap" (foldrTMap 1)
192 , benchIOSink value "foldrTMap" (foldrTMap 1)
185
193
186 -- Mapping
194 -- Mapping
187− , benchIOSink value "map" (mapN fromSerial 1)
195+ , benchIOSink value "map" (mapN 1)
188 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
196 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
189− sequence fromSerial (sourceUnfoldrAction value n)
197+ sequence (sourceUnfoldrAction value n)
190− , benchIOSink value "mapM" (mapM fromSerial 1)
198+ , benchIOSink value "mapM" (mapM 1)
191 , benchIOSink value "tap" (tap 1)
199 , benchIOSink value "tap" (tap 1)
200+#ifdef USE_PRELUDE
192 , benchIOSink value "pollCounts 1 second" (pollCounts 1)
201 , benchIOSink value "pollCounts 1 second" (pollCounts 1)
193 , benchIOSink value "timestamped" timestamped
202 , benchIOSink value "timestamped" timestamped
194
203
@@ -199,7 +208,7 @@ o_1_space_mapping value =
199 , benchIOSink value "scanl1M'" (scanl1M' 1)
208 , benchIOSink value "scanl1M'" (scanl1M' 1)
200 , benchIOSink value "postscanl'" (postscanl' 1)
209 , benchIOSink value "postscanl'" (postscanl' 1)
201 , benchIOSink value "postscanlM'" (postscanlM' 1)
210 , benchIOSink value "postscanlM'" (postscanlM' 1)
202−
211+#endif
203 , benchIOSink value "scan" (scan 1)
212 , benchIOSink value "scan" (scan 1)
204 , benchIOSink value "postscan" (postscan 1)
213 , benchIOSink value "postscan" (postscan 1)
205 ]
214 ]
@@ -208,36 +217,37 @@ o_1_space_mapping value =
208o_1_space_mappingX4 :: Int -> [Benchmark]
217o_1_space_mappingX4 :: Int -> [Benchmark]
209o_1_space_mappingX4 value =
218o_1_space_mappingX4 value =
210 [ bgroup "mappingX4"
219 [ bgroup "mappingX4"
211− [ benchIOSink value "map" (mapN fromSerial 4)
220+ [ benchIOSink value "map" (mapN 4)
212− , benchIOSink value "mapM" (mapM fromSerial 4)
221+ , benchIOSink value "mapM" (mapM 4)
213 , benchIOSink value "trace" (trace 4)
222 , benchIOSink value "trace" (trace 4)
214
223
224+#ifdef USE_PRELUDE
215 , benchIOSink value "scanl'" (scanl' 4)
225 , benchIOSink value "scanl'" (scanl' 4)
216 , benchIOSink value "scanl1'" (scanl1' 4)
226 , benchIOSink value "scanl1'" (scanl1' 4)
217 , benchIOSink value "scanlM'" (scanlM' 4)
227 , benchIOSink value "scanlM'" (scanlM' 4)
218 , benchIOSink value "scanl1M'" (scanl1M' 4)
228 , benchIOSink value "scanl1M'" (scanl1M' 4)
219 , benchIOSink value "postscanl'" (postscanl' 4)
229 , benchIOSink value "postscanl'" (postscanl' 4)
220 , benchIOSink value "postscanlM'" (postscanlM' 4)
230 , benchIOSink value "postscanlM'" (postscanlM' 4)
221−
231+#endif
222 ]
232 ]
223 ]
233 ]
224
234
225{-# INLINE sieveScan #-}
235{-# INLINE sieveScan #-}
226sieveScan :: Monad m => SerialT m Int -> SerialT m Int
236sieveScan :: Monad m => SerialT m Int -> SerialT m Int
227sieveScan =
237sieveScan =
228− S.mapMaybe snd
238+ Stream.mapMaybe snd
229− . S.scanlM' (\(primes, _) n -> do
239+ . Stream.scan (FL.foldlM' (\(primes, _) n -> do
230 return $
240 return $
231 let ps = takeWhile (\p -> p * p <= n) primes
241 let ps = takeWhile (\p -> p * p <= n) primes
232 in if all (\p -> n `mod` p /= 0) ps
242 in if all (\p -> n `mod` p /= 0) ps
233 then (primes ++ [n], Just n)
243 then (primes ++ [n], Just n)
234− else (primes, Nothing)) (return ([2], Just 2))
244+ else (primes, Nothing)) (return ([2], Just 2)))
235
245
236o_n_space_mapping :: Int -> [Benchmark]
246o_n_space_mapping :: Int -> [Benchmark]
237o_n_space_mapping value =
247o_n_space_mapping value =
238 [ bgroup "mapping"
248 [ bgroup "mapping"
239 [ benchIO "naive prime sieve"
249 [ benchIO "naive prime sieve"
240− (\n -> S.sum $ sieveScan $ S.enumerateFromTo 2 (value + n))
250+ (\n -> Stream.fold FL.sum $ sieveScan $ Common.enumerateFromTo 2 (value + n))
241 ]
251 ]
242 ]
252 ]
243
253
@@ -248,8 +258,8 @@ o_n_space_mapping value =
248o_1_space_functor :: Int -> [Benchmark]
258o_1_space_functor :: Int -> [Benchmark]
249o_1_space_functor value =
259o_1_space_functor value =
250 [ bgroup "Functor"
260 [ bgroup "Functor"
251− [ benchIOSink value "fmap" (fmapN fromSerial 1)
261+ [ benchIOSink value "fmap" (mapN 1)
252− , benchIOSink value "fmap x 4" (fmapN fromSerial 4)
262+ , benchIOSink value "fmap x 4" (mapN 4)
253 ]
263 ]
254 ]
264 ]
255
265
@@ -259,124 +269,124 @@ o_1_space_functor value =
259
269
260{-# INLINE filterEven #-}
270{-# INLINE filterEven #-}
261filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
271filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
262−filterEven n = composeN n $ S.filter even
272+filterEven n = composeN n $ Stream.filter even
263
273
264{-# INLINE filterAllOut #-}
274{-# INLINE filterAllOut #-}
265filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
275filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
266−filterAllOut value n = composeN n $ S.filter (> (value + 1))
276+filterAllOut value n = composeN n $ Stream.filter (> (value + 1))
267
277
268{-# INLINE filterAllIn #-}
278{-# INLINE filterAllIn #-}
269filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
279filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
270−filterAllIn value n = composeN n $ S.filter (<= (value + 1))
280+filterAllIn value n = composeN n $ Stream.filter (<= (value + 1))
271
281
272{-# INLINE filterMEven #-}
282{-# INLINE filterMEven #-}
273filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
283filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
274−filterMEven n = composeN n $ S.filterM (return . even)
284+filterMEven n = composeN n $ Stream.filterM (return . even)
275
285
276{-# INLINE filterMAllOut #-}
286{-# INLINE filterMAllOut #-}
277filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
287filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
278−filterMAllOut value n = composeN n $ S.filterM (\x -> return $ x > (value + 1))
288+filterMAllOut value n = composeN n $ Stream.filterM (\x -> return $ x > (value + 1))
279
289
280{-# INLINE filterMAllIn #-}
290{-# INLINE filterMAllIn #-}
281filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
291filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
282−filterMAllIn value n = composeN n $ S.filterM (\x -> return $ x <= (value + 1))
292+filterMAllIn value n = composeN n $ Stream.filterM (\x -> return $ x <= (value + 1))
283−
284−{-# INLINE foldFilterEven #-}
285−foldFilterEven :: MonadIO m => Int -> SerialT m Int -> m ()
286−foldFilterEven n = composeN n $ Stream.foldFilter (FL.satisfy even)
287
293
288{-# INLINE _takeOne #-}
294{-# INLINE _takeOne #-}
289_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
295_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
290−_takeOne n = composeN n $ S.take 1
296+_takeOne n = composeN n $ Stream.take 1
291
297
292{-# INLINE takeAll #-}
298{-# INLINE takeAll #-}
293takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
299takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
294−takeAll value n = composeN n $ S.take (value + 1)
300+takeAll value n = composeN n $ Stream.take (value + 1)
295
301
296{-# INLINE takeWhileTrue #-}
302{-# INLINE takeWhileTrue #-}
297takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
303takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
298−takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
304+takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1))
299
305
300{-# INLINE takeWhileMTrue #-}
306{-# INLINE takeWhileMTrue #-}
301takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
307takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
302−takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
308+takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1)))
303
309
310+#ifdef USE_PRELUDE
304{-# INLINE takeInterval #-}
311{-# INLINE takeInterval #-}
305takeInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
312takeInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
306−takeInterval i n = composeN n (Internal.takeInterval i)
313+takeInterval i n = composeN n (Stream.takeInterval i)
307
314
308#ifdef INSPECTION
315#ifdef INSPECTION
309-- inspect $ hasNoType 'takeInterval ''SPEC
316-- inspect $ hasNoType 'takeInterval ''SPEC
310inspect $ hasNoTypeClasses 'takeInterval
317inspect $ hasNoTypeClasses 'takeInterval
311-- inspect $ 'takeInterval `hasNoType` ''D.Step
318-- inspect $ 'takeInterval `hasNoType` ''D.Step
312#endif
319#endif
320+#endif
313
321
314{-# INLINE dropOne #-}
322{-# INLINE dropOne #-}
315dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
323dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
316−dropOne n = composeN n $ S.drop 1
324+dropOne n = composeN n $ Stream.drop 1
317
325
318{-# INLINE dropAll #-}
326{-# INLINE dropAll #-}
319dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
327dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
320−dropAll value n = composeN n $ S.drop (value + 1)
328+dropAll value n = composeN n $ Stream.drop (value + 1)
321
329
322{-# INLINE dropWhileTrue #-}
330{-# INLINE dropWhileTrue #-}
323dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
331dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
324−dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
332+dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1))
325
333
326{-# INLINE dropWhileMTrue #-}
334{-# INLINE dropWhileMTrue #-}
327dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
335dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
328−dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
336+dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1)))
329
337
330{-# INLINE dropWhileFalse #-}
338{-# INLINE dropWhileFalse #-}
331dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
339dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
332−dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
340+dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1))
333
341
342+#ifdef USE_PRELUDE
334-- XXX Decide on the time interval
343-- XXX Decide on the time interval
335{-# INLINE _intervalsOfSum #-}
344{-# INLINE _intervalsOfSum #-}
336_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
345_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
337−_intervalsOfSum i n = composeN n (S.intervalsOf i FL.sum)
346+_intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum)
338
347
339{-# INLINE dropInterval #-}
348{-# INLINE dropInterval #-}
340dropInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
349dropInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
341−dropInterval i n = composeN n (Internal.dropInterval i)
350+dropInterval i n = composeN n (Stream.dropInterval i)
342
351
343#ifdef INSPECTION
352#ifdef INSPECTION
344inspect $ hasNoTypeClasses 'dropInterval
353inspect $ hasNoTypeClasses 'dropInterval
345-- inspect $ 'dropInterval `hasNoType` ''D.Step
354-- inspect $ 'dropInterval `hasNoType` ''D.Step
346#endif
355#endif
356+#endif
347
357
348{-# INLINE findIndices #-}
358{-# INLINE findIndices #-}
349findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
359findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
350−findIndices value n = composeN n $ S.findIndices (== (value + 1))
360+findIndices value n = composeN n $ Stream.findIndices (== (value + 1))
351
361
352{-# INLINE elemIndices #-}
362{-# INLINE elemIndices #-}
353elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
363elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
354−elemIndices value n = composeN n $ S.elemIndices (value + 1)
364+elemIndices value n = composeN n $ Stream.elemIndices (value + 1)
355
365
356{-# INLINE deleteBy #-}
366{-# INLINE deleteBy #-}
357deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
367deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
358−deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
368+deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1)
359
369
360-- uniq . uniq == uniq, composeN 2 ~ composeN 1
370-- uniq . uniq == uniq, composeN 2 ~ composeN 1
361{-# INLINE uniq #-}
371{-# INLINE uniq #-}
362uniq :: MonadIO m => Int -> SerialT m Int -> m ()
372uniq :: MonadIO m => Int -> SerialT m Int -> m ()
363−uniq n = composeN n S.uniq
373+uniq n = composeN n Stream.uniq
364
374
365{-# INLINE mapMaybe #-}
375{-# INLINE mapMaybe #-}
366mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
376mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
367mapMaybe n =
377mapMaybe n =
368 composeN n $
378 composeN n $
369− S.mapMaybe
379+ Stream.mapMaybe
370 (\x ->
380 (\x ->
371 if odd x
381 if odd x
372 then Nothing
382 then Nothing
373 else Just x)
383 else Just x)
374
384
375{-# INLINE mapMaybeM #-}
385{-# INLINE mapMaybeM #-}
376−mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()
386+mapMaybeM :: MonadAsync m => Int -> SerialT m Int -> m ()
377mapMaybeM n =
387mapMaybeM n =
378 composeN n $
388 composeN n $
379− S.mapMaybeM
389+ Stream.mapMaybeM
380 (\x ->
390 (\x ->
381 if odd x
391 if odd x
382 then return Nothing
392 then return Nothing
@@ -393,22 +403,22 @@ o_1_space_filtering value =
393 , benchIOSink value "filterM-all-out" (filterMAllOut value 1)
403 , benchIOSink value "filterM-all-out" (filterMAllOut value 1)
394 , benchIOSink value "filterM-all-in" (filterMAllIn value 1)
404 , benchIOSink value "filterM-all-in" (filterMAllIn value 1)
395
405
396− , benchIOSink value "foldFilter-even" (foldFilterEven 1)
397−
398 -- Trimming
406 -- Trimming
399 , benchIOSink value "take-all" (takeAll value 1)
407 , benchIOSink value "take-all" (takeAll value 1)
400− , benchIOSink
401− value
402− "takeInterval-all"
403− (takeInterval (NanoSecond64 maxBound) 1)
404 , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
408 , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
405 -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
409 -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
406 , benchIOSink value "drop-one" (dropOne 1)
410 , benchIOSink value "drop-one" (dropOne 1)
407 , benchIOSink value "drop-all" (dropAll value 1)
411 , benchIOSink value "drop-all" (dropAll value 1)
412+#ifdef USE_PRELUDE
413+ , benchIOSink
414+ value
415+ "takeInterval-all"
416+ (takeInterval (NanoSecond64 maxBound) 1)
408 , benchIOSink
417 , benchIOSink
409 value
418 value
410 "dropInterval-all"
419 "dropInterval-all"
411 (dropInterval (NanoSecond64 maxBound) 1)
420 (dropInterval (NanoSecond64 maxBound) 1)
421+#endif
412 , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
422 , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
413 -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
423 -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
414 , benchIOSink
424 , benchIOSink
@@ -440,8 +450,6 @@ o_1_space_filteringX4 value =
440 , benchIOSink value "filterM-all-out" (filterMAllOut value 4)
450 , benchIOSink value "filterM-all-out" (filterMAllOut value 4)
441 , benchIOSink value "filterM-all-in" (filterMAllIn value 4)
451 , benchIOSink value "filterM-all-in" (filterMAllIn value 4)
442
452
443− , benchIOSink value "foldFilter-even" (foldFilterEven 4)
444−
445 -- trimming
453 -- trimming
446 , benchIOSink value "take-all" (takeAll value 4)
454 , benchIOSink value "take-all" (takeAll value 4)
447 , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
455 , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
@@ -473,26 +481,26 @@ o_1_space_filteringX4 value =
473-------------------------------------------------------------------------------
481-------------------------------------------------------------------------------
474
482
475{-# INLINE intersperse #-}
483{-# INLINE intersperse #-}
476−intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
484+intersperse :: MonadAsync m => Int -> Int -> SerialT m Int -> m ()
477−intersperse value n = composeN n $ S.intersperse (value + 1)
485+intersperse value n = composeN n $ Stream.intersperse (value + 1)
478
486
479{-# INLINE intersperseM #-}
487{-# INLINE intersperseM #-}
480−intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
488+intersperseM :: MonadAsync m => Int -> Int -> SerialT m Int -> m ()
481−intersperseM value n = composeN n $ S.intersperseM (return $ value + 1)
489+intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1)
482
490
483{-# INLINE insertBy #-}
491{-# INLINE insertBy #-}
484insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
492insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
485−insertBy value n = composeN n $ S.insertBy compare (value + 1)
493+insertBy value n = composeN n $ Stream.insertBy compare (value + 1)
486
494
487{-# INLINE interposeSuffix #-}
495{-# INLINE interposeSuffix #-}
488−interposeSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
496+interposeSuffix :: Monad m => Int -> Int -> SerialT m Int -> m ()
489interposeSuffix value n =
497interposeSuffix value n =
490− composeN n $ Internal.interposeSuffix (value + 1) Unfold.identity
498+ composeN n $ Stream.interposeSuffix (value + 1) Unfold.identity
491
499
492{-# INLINE intercalateSuffix #-}
500{-# INLINE intercalateSuffix #-}
493−intercalateSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
501+intercalateSuffix :: Monad m => Int -> Int -> SerialT m Int -> m ()
494intercalateSuffix value n =
502intercalateSuffix value n =
495− composeN n $ Internal.intercalateSuffix Unfold.identity (value + 1)
503+ composeN n $ Stream.intercalateSuffix Unfold.identity (value + 1)
496
504
497o_1_space_inserting :: Int -> [Benchmark]
505o_1_space_inserting :: Int -> [Benchmark]
498o_1_space_inserting value =
506o_1_space_inserting value =
@@ -519,11 +527,11 @@ o_1_space_insertingX4 value =
519
527
520{-# INLINE indexed #-}
528{-# INLINE indexed #-}
521indexed :: MonadIO m => Int -> SerialT m Int -> m ()
529indexed :: MonadIO m => Int -> SerialT m Int -> m ()
522−indexed n = composeN n (S.map snd . S.indexed)
530+indexed n = composeN n (fmap snd . Stream.indexed)
523
531
524{-# INLINE indexedR #-}
532{-# INLINE indexedR #-}
525indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
533indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
526−indexedR value n = composeN n (S.map snd . S.indexedR value)
534+indexedR value n = composeN n (fmap snd . Stream.indexedR value)
527
535
528o_1_space_indexing :: Int -> [Benchmark]
536o_1_space_indexing :: Int -> [Benchmark]
529o_1_space_indexing value =
537o_1_space_indexing value =
benchmark/bench-runner/Main.hs+9−9
@@ -35,22 +35,22 @@ rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific]
35 `isPrefixOf` benchName = "-K2M -M256M"
35 `isPrefixOf` benchName = "-K2M -M256M"
36 | "Prelude.Rate/o-1-space." `isPrefixOf` benchName = "-K128K"
36 | "Prelude.Rate/o-1-space." `isPrefixOf` benchName = "-K128K"
37 | "Prelude.Rate/o-1-space.asyncly." `isPrefixOf` benchName = "-K128K"
37 | "Prelude.Rate/o-1-space.asyncly." `isPrefixOf` benchName = "-K128K"
38− | "Prelude.Serial/o-1-space.mixed.sum-product-fold" == benchName =
38+ | "Data.Stream/o-1-space.mixed.sum-product-fold" == benchName =
39 "-K64M"
39 "-K64M"
40− | "Prelude.Serial/o-n-heap.grouping.classifySessionsOf"
40+ | "Data.Stream/o-n-heap.grouping.classifySessionsOf"
41 `isPrefixOf` benchName = "-K1M -M32M"
41 `isPrefixOf` benchName = "-K1M -M32M"
42− | "Prelude.Serial/o-n-heap.Functor." `isPrefixOf` benchName =
42+ | "Data.Stream/o-n-heap.Functor." `isPrefixOf` benchName =
43 "-K4M -M32M"
43 "-K4M -M32M"
44− | "Prelude.Serial/o-n-heap.transformer." `isPrefixOf` benchName =
44+ | "Data.Stream/o-n-heap.transformer." `isPrefixOf` benchName =
45 "-K8M -M64M"
45 "-K8M -M64M"
46− | "Prelude.Serial/o-n-space.Functor." `isPrefixOf` benchName =
46+ | "Data.Stream/o-n-space.Functor." `isPrefixOf` benchName =
47 "-K4M -M64M"
47 "-K4M -M64M"
48− | "Prelude.Serial/o-n-space.Applicative." `isPrefixOf` benchName =
48+ | "Data.Stream/o-n-space.Applicative." `isPrefixOf` benchName =
49 "-K8M -M128M"
49 "-K8M -M128M"
50− | "Prelude.Serial/o-n-space.Monad." `isPrefixOf` benchName =
50+ | "Data.Stream/o-n-space.Monad." `isPrefixOf` benchName =
51 "-K8M -M64M"
51 "-K8M -M64M"
52− | "Prelude.Serial/o-n-space.grouping." `isPrefixOf` benchName = ""
52+ | "Data.Stream/o-n-space.grouping." `isPrefixOf` benchName = ""
53− | "Prelude.Serial/o-n-space." `isPrefixOf` benchName = "-K4M"
53+ | "Data.Stream/o-n-space." `isPrefixOf` benchName = "-K4M"
54 | "Prelude.WSerial/o-n-space." `isPrefixOf` benchName = "-K4M"
54 | "Prelude.WSerial/o-n-space." `isPrefixOf` benchName = "-K4M"
55 | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =
55 | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =
56 "-K4M"
56 "-K4M"
benchmark/streamly-benchmarks.cabal+22−12
@@ -64,6 +64,11 @@ flag bench-core
64 manual: True
64 manual: True
65 default: False
65 default: False
66
66
67+flag use-prelude
68+ description: Use Prelude instead of Data.Stream for serial benchmarks
69+ manual: True
70+ default: False
71+
67-------------------------------------------------------------------------------
72-------------------------------------------------------------------------------
68-- Common stanzas
73-- Common stanzas
69-------------------------------------------------------------------------------
74-------------------------------------------------------------------------------
@@ -71,6 +76,9 @@ flag bench-core
71common compile-options
76common compile-options
72 default-language: Haskell2010
77 default-language: Haskell2010
73
78
79+ if flag(use-prelude)
80+ cpp-options: -DUSE_PRELUDE
81+
74 if flag(dev)
82 if flag(dev)
75 cpp-options: -DDEVBUILD
83 cpp-options: -DDEVBUILD
76
84
@@ -201,20 +209,23 @@ common bench-options-threaded
201-- Serial Streams
209-- Serial Streams
202-------------------------------------------------------------------------------
210-------------------------------------------------------------------------------
203
211
204−benchmark Prelude.Serial
212+benchmark Data.Stream
205 import: bench-options
213 import: bench-options
206 type: exitcode-stdio-1.0
214 type: exitcode-stdio-1.0
207− hs-source-dirs: Streamly/Benchmark/Prelude
215+ hs-source-dirs: Streamly/Benchmark/Data
208− main-is: Serial.hs
216+ main-is: Stream.hs
209 other-modules:
217 other-modules:
210− Serial.Generation
218+ Stream.Generate
211− , Serial.Elimination
219+ Stream.Eliminate
212− , Serial.Transformation
220+ Stream.Transform
213− , Serial.NestedStream
221+ Stream.Reduce
214− , Serial.NestedFold
222+ Stream.Expand
215− , Serial.Split
216− , Serial.Exceptions
223+ Stream.Exceptions
217− , Serial.Lift
224+ Stream.Lift
225+ Stream.Common
226+ if flag(use-prelude)
227+ other-modules:
228+ Stream.Split
218 if flag(bench-core) || impl(ghcjs)
229 if flag(bench-core) || impl(ghcjs)
219 buildable: False
230 buildable: False
220 else
231 else
@@ -225,7 +236,6 @@ benchmark Prelude.Serial
225 else
236 else
226 ghc-options: +RTS -M2500M -RTS
237 ghc-options: +RTS -M2500M -RTS
227
238
228−
229benchmark Prelude.WSerial
239benchmark Prelude.WSerial
230 import: bench-options
240 import: bench-options
231 type: exitcode-stdio-1.0
241 type: exitcode-stdio-1.0
hie.yaml+10−18
@@ -30,6 +30,16 @@ cradle:
30 component: "bench:Data.Stream.StreamD"
30 component: "bench:Data.Stream.StreamD"
31 - path: "./benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs"
31 - path: "./benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs"
32 component: "bench:Data.Stream.StreamK"
32 component: "bench:Data.Stream.StreamK"
33+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Common.hs"
34+ component: "bench:Data.Stream"
35+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Expand.hs"
36+ component: "bench:Data.Stream"
37+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Generate.hs"
38+ component: "bench:Data.Stream"
39+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs"
40+ component: "bench:Data.Stream"
41+ - path: "./benchmark/Streamly/Benchmark/Data/Stream/Transform.hs"
42+ component: "bench:Data.Stream"
33 - path: "./benchmark/Streamly/Benchmark/Data/Unfold.hs"
43 - path: "./benchmark/Streamly/Benchmark/Data/Unfold.hs"
34 component: "bench:Data.Unfold"
44 component: "bench:Data.Unfold"
35 - path: "./benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs"
45 - path: "./benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs"
@@ -44,24 +54,6 @@ cradle:
44 component: "bench:Prelude.Merge"
54 component: "bench:Prelude.Merge"
45 - path: "./benchmark/Streamly/Benchmark/Prelude/Parallel.hs"
55 - path: "./benchmark/Streamly/Benchmark/Prelude/Parallel.hs"
46 component: "bench:Prelude.Parallel"
56 component: "bench:Prelude.Parallel"
47− - path: "./benchmark/Streamly/Benchmark/Prelude/Serial.hs"
48− component: "bench:Prelude.Serial"
49− - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hs"
50− component: "bench:Prelude.Serial"
51− - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs"
52− component: "bench:Prelude.Serial"
53− - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hs"
54− component: "bench:Prelude.Serial"
55− - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/NestedStream.hs"
56− component: "bench:Prelude.Serial"
57− - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs"
58− component: "bench:Prelude.Serial"
59− - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Transformation.hs"
60− component: "bench:Prelude.Serial"
61− - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/NestedFold.hs"
62− component: "bench:Prelude.Serial"
63− - path: "./benchmark/Streamly/Benchmark/Prelude/Serial/Lift.hs"
64− component: "bench:Prelude.Serial"
65 - path: "./benchmark/Streamly/Benchmark/Prelude/WSerial.hs"
57 - path: "./benchmark/Streamly/Benchmark/Prelude/WSerial.hs"
66 component: "bench:Prelude.WSerial"
58 component: "bench:Prelude.WSerial"
67 - path: "./benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs"
59 - path: "./benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs"
streamly.cabal−1
@@ -65,7 +65,6 @@ extra-source-files:
65 benchmark/Streamly/Benchmark/FileSystem/*.hs
65 benchmark/Streamly/Benchmark/FileSystem/*.hs
66 benchmark/Streamly/Benchmark/FileSystem/Handle/*.hs
66 benchmark/Streamly/Benchmark/FileSystem/Handle/*.hs
67 benchmark/Streamly/Benchmark/Prelude/*.hs
67 benchmark/Streamly/Benchmark/Prelude/*.hs
68− benchmark/Streamly/Benchmark/Prelude/Serial/*.hs
69 benchmark/Streamly/Benchmark/Unicode/*.hs
68 benchmark/Streamly/Benchmark/Unicode/*.hs
70 benchmark/lib/Streamly/Benchmark/*.hs
69 benchmark/lib/Streamly/Benchmark/*.hs
71 benchmark/lib/Streamly/Benchmark/Common/*.hs
70 benchmark/lib/Streamly/Benchmark/Common/*.hs
targets/Targets.hs+2−2
@@ -25,9 +25,9 @@ targets =
25 )
25 )
26
26
27 -- Streams
27 -- Streams
28− , ("Prelude.Serial", ["serial_wserial_cmp"])
28+ , ("Data.Stream", ["serial_wserial_cmp"])
29 , ("Prelude.WSerial", ["serial_wserial_cmp"])
29 , ("Prelude.WSerial", ["serial_wserial_cmp"])
30− , ("Prelude.Serial",
30+ , ("Data.Stream",
31 [ "prelude_serial_grp"
31 [ "prelude_serial_grp"
32 , "infinite_grp"
32 , "infinite_grp"
33 , "serial_wserial_cmp"
33 , "serial_wserial_cmp"