on master help sign in
add concurrent stream generation benchmarks
2f706b9Harendra Kumar
benchmark/Linear.hs+59−17
@@ -15,11 +15,16 @@ import Gauge
15
15
16-- We need a monadic bind here to make sure that the function f does not get
16-- We need a monadic bind here to make sure that the function f does not get
17-- completely optimized out by the compiler in some cases.
17-- completely optimized out by the compiler in some cases.
18−benchIO :: NFData b => String -> (Ops.Stream m Int -> IO b) -> Benchmark
18+benchIO :: (IsStream t, NFData b) => String -> (t IO Int -> IO b) -> Benchmark
19benchIO name f = bench name $ nfIO $ randomRIO (1,1000) >>= f . Ops.source
19benchIO name f = bench name $ nfIO $ randomRIO (1,1000) >>= f . Ops.source
20
20
21−benchSrcIO :: String -> (Int -> Ops.Stream IO Int) -> Benchmark
21+benchSrcIO
22+ :: (t IO Int -> SerialT IO Int)
23+ -> String
24+ -> (Int -> t IO Int)
25+ -> Benchmark
26+benchSrcIO t name f
22−benchSrcIO name f = bench name $ nfIO $ randomRIO (1,1000) >>= Ops.toNull . f
27+ = bench name $ nfIO $ randomRIO (1,1000) >>= Ops.toNull t . f
23
28
24benchIOAppend :: (NFData b) => String -> (Int -> IO b) -> Benchmark
29benchIOAppend :: (NFData b) => String -> (Int -> IO b) -> Benchmark
25benchIOAppend name f = bench name $ nfIO $ randomRIO (1,1000) >>= f
30benchIOAppend name f = bench name $ nfIO $ randomRIO (1,1000) >>= f
@@ -30,12 +35,57 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
30main :: IO ()
35main :: IO ()
31main = do
36main = do
32 defaultMain
37 defaultMain
38+ [ bgroup "generation"
39+ [ bgroup "serially"
40+ [ benchIO "unfoldr" $ Ops.toNull serially
41+ , benchSrcIO serially "fromFoldable" Ops.sourceFromFoldable
42+ , benchSrcIO serially "foldMapWith" Ops.sourceFoldMapWith
43+ , benchSrcIO serially "unfoldrM" Ops.sourceUnfoldrM
44+ , benchSrcIO serially "fromFoldableM" Ops.sourceFromFoldableM
45+ , benchSrcIO serially "foldMapWithM" Ops.sourceFoldMapWithM
46+ ]
47+ -- unfoldr and fromFoldable are always serial and thereofore the same for
48+ -- all stream types.
49+ , bgroup "aheadly"
50+ [ -- benchIO "unfoldr" $ Ops.toNull aheadly
51+ -- , benchSrcIO aheadly "fromFoldable" Ops.sourceFromFoldable
52+ benchSrcIO aheadly "foldMapWith" Ops.sourceFoldMapWith
53+ , benchSrcIO aheadly "unfoldrM" Ops.sourceUnfoldrM
54+ , benchSrcIO aheadly "fromFoldableM" Ops.sourceFromFoldableM
55+ , benchSrcIO aheadly "foldMapWithM" Ops.sourceFoldMapWithM
56+ ]
57+ , bgroup "asyncly"
58+ [ -- benchIO "unfoldr" $ Ops.toNull asyncly
59+ -- , benchSrcIO asyncly "fromFoldable" Ops.sourceFromFoldable
60+ benchSrcIO asyncly "foldMapWith" Ops.sourceFoldMapWith
61+ , benchSrcIO asyncly "unfoldrM" Ops.sourceUnfoldrM
62+ , benchSrcIO asyncly "fromFoldableM" Ops.sourceFromFoldableM
63+ , benchSrcIO asyncly "foldMapWithM" Ops.sourceFoldMapWithM
64+ ]
65+ -- XXX need to use smaller streams to finish in reasonable time
66+ , bgroup "parallely"
67+ [ --benchIO "unfoldr" $ Ops.toNull parallely
68+ --, benchSrcIO parallely "fromFoldable" Ops.sourceFromFoldable
69+ --, benchSrcIO parallely "foldMapWith" Ops.sourceFoldMapWith
70+ -- , benchSrcIO parallely "unfoldrM" Ops.sourceUnfoldrM
71+ -- , benchSrcIO parallely "fromFoldableM" Ops.sourceFromFoldableM
72+ -- , benchSrcIO parallely "foldMapWithM" Ops.sourceFoldMapWithM
73+ ]
74+ ]
75+ -- XXX this is the same foldMapWith in the above benchmarks, need to dedup
76+ -- this one provides a single place comparsion of all types and uses
77+ -- smaller stream size for faster benchmarking. We can use the same for
78+ -- above benchmarks and remove this.
79+ , bgroup "append"
80+ [ benchIOAppend "serially" $ Ops.append serially
81+ , benchIOAppend "wSerially" $ Ops.append wSerially
82+ , benchIOAppend "aheadly" $ Ops.append aheadly
83+ , benchIOAppend "asyncly" $ Ops.append asyncly
84+ , benchIOAppend "wAsyncly" $ Ops.append wAsyncly
85+ , benchIOAppend "parallely" $ Ops.append parallely
86+ ]
33− [ bgroup "elimination"
87+ , bgroup "elimination"
34− [ benchIO "toNull" Ops.toNull
88+ [ benchIO "toNull" $ Ops.toNull serially
35− , benchSrcIO "fromFoldable" Ops.sourceFromFoldable
36− , benchSrcIO "fromFoldableM" Ops.sourceFromFoldableM
37− , benchSrcIO "foldMapWith" Ops.sourceFoldMapWith
38− , benchSrcIO "unfoldrM" Ops.sourceUnfoldrM
39 , benchIO "toList" Ops.toList
89 , benchIO "toList" Ops.toList
40 , benchIO "fold" Ops.foldl
90 , benchIO "fold" Ops.foldl
41 , benchIO "last" Ops.last
91 , benchIO "last" Ops.last
@@ -56,14 +106,6 @@ main = do
56 , benchIO "dropWhile-true" Ops.dropWhileTrue
106 , benchIO "dropWhile-true" Ops.dropWhileTrue
57 ]
107 ]
58 , benchIO "zip" Ops.zip
108 , benchIO "zip" Ops.zip
59− , bgroup "append"
60− [ benchIOAppend "serially" $ Ops.append serially
61− , benchIOAppend "wSerially" $ Ops.append wSerially
62− , benchIOAppend "aheadly" $ Ops.append aheadly
63− , benchIOAppend "asyncly" $ Ops.append asyncly
64− , benchIOAppend "wAsyncly" $ Ops.append wAsyncly
65− , benchIOAppend "parallely" $ Ops.append parallely
66− ]
67 , bgroup "compose"
109 , bgroup "compose"
68 [ benchIO "mapM" Ops.composeMapM
110 [ benchIO "mapM" Ops.composeMapM
69 , benchIO "map-with-all-in-filter" Ops.composeMapAllInFilter
111 , benchIO "map-with-all-in-filter" Ops.composeMapAllInFilter
benchmark/LinearOps.hs+18−8
@@ -46,7 +46,7 @@ maxValue = value + 1000
46{-# INLINE composeAllInFilters #-}
46{-# INLINE composeAllInFilters #-}
47{-# INLINE composeAllOutFilters #-}
47{-# INLINE composeAllOutFilters #-}
48{-# INLINE composeMapAllInFilter #-}
48{-# INLINE composeMapAllInFilter #-}
49−toNull, scan, map, filterEven, filterAllOut,
49+scan, map, filterEven, filterAllOut,
50 filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,
50 filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,
51 concat, composeAllInFilters, composeAllOutFilters,
51 concat, composeAllInFilters, composeAllOutFilters,
52 composeMapAllInFilter
52 composeMapAllInFilter
@@ -58,6 +58,8 @@ toList :: Monad m => Stream m Int -> m [Int]
58foldl :: Monad m => Stream m Int -> m Int
58foldl :: Monad m => Stream m Int -> m Int
59last :: Monad m => Stream m Int -> m (Maybe Int)
59last :: Monad m => Stream m Int -> m (Maybe Int)
60
60
61+toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()
62+
61-------------------------------------------------------------------------------
63-------------------------------------------------------------------------------
62-- Stream generation and elimination
64-- Stream generation and elimination
63-------------------------------------------------------------------------------
65-------------------------------------------------------------------------------
@@ -65,7 +67,7 @@ last :: Monad m => Stream m Int -> m (Maybe Int)
65type Stream m a = S.SerialT m a
67type Stream m a = S.SerialT m a
66
68
67{-# INLINE source #-}
69{-# INLINE source #-}
68−source :: Int -> Stream m Int
70+source :: S.IsStream t => Int -> t m Int
69source n = S.unfoldr step n
71source n = S.unfoldr step n
70 where
72 where
71 step cnt =
73 step cnt =
@@ -73,18 +75,26 @@ source n = S.unfoldr step n
73 then Nothing
75 then Nothing
74 else (Just (cnt, cnt + 1))
76 else (Just (cnt, cnt + 1))
75
77
78+{-# INLINE sourceFromFoldable #-}
76−sourceFromFoldable :: Int -> Stream m Int
79+sourceFromFoldable :: S.IsStream t => Int -> t m Int
77sourceFromFoldable n = S.fromFoldable [n..n+value]
80sourceFromFoldable n = S.fromFoldable [n..n+value]
78
81
79{-# INLINE sourceFromFoldableM #-}
82{-# INLINE sourceFromFoldableM #-}
80−sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
83+sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
81sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
84sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
82
85
83−sourceFoldMapWith :: Monad m => Int -> Stream m Int
86+{-# INLINE sourceFoldMapWith #-}
87+sourceFoldMapWith :: (S.IsStream t, Monad (t m), S.Semigroup (t m Int))
88+ => Int -> t m Int
84−sourceFoldMapWith n = S.foldMapWith S.serial return [n..n+value]
89+sourceFoldMapWith n = S.foldMapWith (S.<>) return [n..n+value]
90+
91+{-# INLINE sourceFoldMapWithM #-}
92+sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
93+ => Int -> t m Int
94+sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.once . return) [n..n+value]
85
95
86{-# INLINE sourceUnfoldrM #-}
96{-# INLINE sourceUnfoldrM #-}
87−sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int
97+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
88sourceUnfoldrM n = S.unfoldrM step n
98sourceUnfoldrM n = S.unfoldrM step n
89 where
99 where
90 step cnt =
100 step cnt =
@@ -100,7 +110,7 @@ runStream = S.runStream
100-- Elimination
110-- Elimination
101-------------------------------------------------------------------------------
111-------------------------------------------------------------------------------
102
112
103−toNull = runStream
113+toNull t = runStream . t
104toList = S.toList
114toList = S.toList
105foldl = S.foldl' (+) 0
115foldl = S.foldl' (+) 0
106last = S.last
116last = S.last