on master help sign in
add concurrent stream generation benchmarks
commit2f706b9bfbb473c76614d75d6805137c2715d328 authorHarendra Kumar <harendra.kumar@gmail.com> dateSun 27 May 2018, 15:22 (8 years ago) parent21c07ab
2 files changed+77−25
benchmark/Linear.hs+59−17 benchmark/LinearOps.hs+18−8
benchmark/Linear.hs+59−17
@@ -15,11 +15,16 @@ import Gauge
1515
1616-- We need a monadic bind here to make sure that the function f does not get
1717-- 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
1919benchIO name f = bench name $ nfIO $ randomRIO (1,1000) >>= f . Ops.source
2020
21−benchSrcIO :: String -> (Int -> Ops.Stream IO Int) -> Benchmark
22−benchSrcIO name f = bench name $ nfIO $ randomRIO (1,1000) >>= Ops.toNull . f
21+benchSrcIO
22+ :: (t IO Int -> SerialT IO Int)
23+ -> String
24+ -> (Int -> t IO Int)
25+ -> Benchmark
26+benchSrcIO t name f
27+ = bench name $ nfIO $ randomRIO (1,1000) >>= Ops.toNull t . f
2328
2429benchIOAppend :: (NFData b) => String -> (Int -> IO b) -> Benchmark
2530benchIOAppend name f = bench name $ nfIO $ randomRIO (1,1000) >>= f
@@ -30,12 +35,57 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
3035main :: IO ()
3136main = do
3237 defaultMain
33− [ bgroup "elimination"
34− [ benchIO "toNull" Ops.toNull
35− , benchSrcIO "fromFoldable" Ops.sourceFromFoldable
36− , benchSrcIO "fromFoldableM" Ops.sourceFromFoldableM
37− , benchSrcIO "foldMapWith" Ops.sourceFoldMapWith
38− , benchSrcIO "unfoldrM" Ops.sourceUnfoldrM
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+ ]
87+ , bgroup "elimination"
88+ [ benchIO "toNull" $ Ops.toNull serially
3989 , benchIO "toList" Ops.toList
4090 , benchIO "fold" Ops.foldl
4191 , benchIO "last" Ops.last
@@ -56,14 +106,6 @@ main = do
56106 , benchIO "dropWhile-true" Ops.dropWhileTrue
57107 ]
58108 , 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− ]
67109 , bgroup "compose"
68110 [ benchIO "mapM" Ops.composeMapM
69111 , benchIO "map-with-all-in-filter" Ops.composeMapAllInFilter
benchmark/LinearOps.hs+18−8
@@ -46,7 +46,7 @@ maxValue = value + 1000
4646{-# INLINE composeAllInFilters #-}
4747{-# INLINE composeAllOutFilters #-}
4848{-# INLINE composeMapAllInFilter #-}
49−toNull, scan, map, filterEven, filterAllOut,
49+scan, map, filterEven, filterAllOut,
5050 filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,
5151 concat, composeAllInFilters, composeAllOutFilters,
5252 composeMapAllInFilter
@@ -58,6 +58,8 @@ toList :: Monad m => Stream m Int -> m [Int]
5858foldl :: Monad m => Stream m Int -> m Int
5959last :: Monad m => Stream m Int -> m (Maybe Int)
6060
61+toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()
62+
6163-------------------------------------------------------------------------------
6264-- Stream generation and elimination
6365-------------------------------------------------------------------------------
@@ -65,7 +67,7 @@ last :: Monad m => Stream m Int -> m (Maybe Int)
6567type Stream m a = S.SerialT m a
6668
6769{-# INLINE source #-}
68−source :: Int -> Stream m Int
70+source :: S.IsStream t => Int -> t m Int
6971source n = S.unfoldr step n
7072 where
7173 step cnt =
@@ -73,18 +75,26 @@ source n = S.unfoldr step n
7375 then Nothing
7476 else (Just (cnt, cnt + 1))
7577
76−sourceFromFoldable :: Int -> Stream m Int
78+{-# INLINE sourceFromFoldable #-}
79+sourceFromFoldable :: S.IsStream t => Int -> t m Int
7780sourceFromFoldable n = S.fromFoldable [n..n+value]
7881
7982{-# INLINE sourceFromFoldableM #-}
80−sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
83+sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
8184sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
8285
83−sourceFoldMapWith :: Monad m => Int -> Stream m Int
84−sourceFoldMapWith n = S.foldMapWith S.serial return [n..n+value]
86+{-# INLINE sourceFoldMapWith #-}
87+sourceFoldMapWith :: (S.IsStream t, Monad (t m), S.Semigroup (t m Int))
88+ => Int -> t m Int
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]
8595
8696{-# INLINE sourceUnfoldrM #-}
87−sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int
97+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
8898sourceUnfoldrM n = S.unfoldrM step n
8999 where
90100 step cnt =
@@ -100,7 +110,7 @@ runStream = S.runStream
100110-- Elimination
101111-------------------------------------------------------------------------------
102112
103−toNull = runStream
113+toNull t = runStream . t
104114toList = S.toList
105115foldl = S.foldl' (+) 0
106116last = S.last