git.iko.soy/streamly
on master help sign in
add more benchmarks, update benchmarks
commitaa4c8707b5be2bdd5da3c10075374f59b7302659 authorHarendra Kumar <harendra.kumar@gmail.com> dateSat 9 Jun 2018, 21:11 (8 years ago) parentb6b103a
7 files changed+186−189
compare with master
unifiedsplit
bench.sh+1 benchmark/Adaptive.hs+24−7 benchmark/ChartLinear.hs+17−6 benchmark/Linear.hs+88−88 benchmark/LinearOps.hs+17−9 benchmark/Nested.hs+8−30 benchmark/NestedOps.hs+31−49
bench.sh+1
@@ -63,6 +63,7 @@ if test "$GRAPH" != "0"
6363then
6464 CHART_PROG="chart-$BENCHMARK"
6565 prog=$($STACK exec which $CHART_PROG)
66+ hash -r
6667 if test ! -x "$prog"
6768 then
6869 echo "Building charting executable"
benchmark/Adaptive.hs+24−7
@@ -38,35 +38,44 @@ run srange crange t = runStream $ do
3838 when (d /= 0) $ liftIO $ threadDelay d
3939 return n
4040
41+low, medium, high :: Int
42+low = 10
43+medium = 20
44+high = 30
45+
46+{-# INLINE noDelay #-}
47+noDelay :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
48+noDelay = run (0,0) (0,0)
49+
4150{-# INLINE alwaysConstSlowSerial #-}
4251alwaysConstSlowSerial :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
43−alwaysConstSlowSerial = run (0,0) (20,20)
52+alwaysConstSlowSerial = run (0,0) (medium,medium)
4453
4554{-# INLINE alwaysConstSlow #-}
4655alwaysConstSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
47−alwaysConstSlow = run (10,10) (20,20)
56+alwaysConstSlow = run (low,low) (medium,medium)
4857
4958{-# INLINE alwaysConstFast #-}
5059alwaysConstFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
51−alwaysConstFast = run (30,30) (20,20)
60+alwaysConstFast = run (high,high) (medium,medium)
5261
5362{-# INLINE alwaysVarSlow #-}
5463alwaysVarSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
55−alwaysVarSlow = run (10,10) (10,30)
64+alwaysVarSlow = run (low,low) (low,high)
5665
5766{-# INLINE alwaysVarFast #-}
5867alwaysVarFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
59−alwaysVarFast = run (30,30) (10,30)
68+alwaysVarFast = run (high,high) (low,high)
6069
6170-- XXX add variable producer tests as well
6271
6372{-# INLINE runVarSometimesFast #-}
6473runVarSometimesFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
65−runVarSometimesFast = run (20,20) (10,30)
74+runVarSometimesFast = run (medium,medium) (low,high)
6675
6776{-# INLINE randomVar #-}
6877randomVar :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
69−randomVar = run (10,30) (10,30)
78+randomVar = run (low,high) (low,high)
7079
7180main :: IO ()
7281main = do
@@ -76,6 +85,14 @@ main = do
7685 [ bench "serially" $ nfIO $ alwaysConstSlowSerial serially
7786 , bench "wSerially" $ nfIO $ alwaysConstSlowSerial wSerially
7887 ]
88+ , bgroup "default"
89+ [ bench "serially" $ nfIO $ noDelay serially
90+ , bench "wSerially" $ nfIO $ noDelay wSerially
91+ , bench "aheadly" $ nfIO $ noDelay aheadly
92+ , bench "asyncly" $ nfIO $ noDelay asyncly
93+ , bench "wAsyncly" $ nfIO $ noDelay wAsyncly
94+ , bench "parallely" $ nfIO $ noDelay parallely
95+ ]
7996 , bgroup "constantSlowConsumer"
8097 [ bench "aheadly" $ nfIO $ alwaysConstSlow aheadly
8198 , bench "asyncly" $ nfIO $ alwaysConstSlow asyncly
benchmark/ChartLinear.hs+17−6
@@ -6,7 +6,7 @@ module Main where
66import Data.List
77import Data.List.Split
88import BenchGraph (bgraph, defaultConfig, Config(..), ComparisonStyle(..))
9−import Control.Exception (handle, catch, SomeException, ErrorCall)
9+import Control.Exception (handle, catch, SomeException, ErrorCall(..))
1010
1111main :: IO ()
1212main = do
@@ -15,8 +15,8 @@ main = do
1515 , comparisonStyle = CompareDelta
1616 }
1717
18− ignoringErr a = catch a (\(_ :: ErrorCall) ->
19− putStrLn "Failed. Skipping.")
18+ ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
19+ putStrLn $ "Failed with error:\n" ++ err ++ "\nSkipping.")
2020 -- bgraph <input> <output> <field in csv file to be plotted>
2121 -- other interesting fields to plot are:
2222 -- allocated
@@ -26,18 +26,29 @@ main = do
2626 ignoringErr $ bgraph "charts/results.csv" "operations" "time" $ cfg
2727 { chartTitle = Just "Streamly operations (time)"
2828 , classifyBenchmark = \b ->
29− if "compose" `isPrefixOf` b || "/concat" `isSuffixOf` b
29+ if (not $ "serially/" `isPrefixOf` b)
30+ || "/generation" `isInfixOf` b
31+ || "/compose" `isInfixOf` b
32+ || "/concat" `isSuffixOf` b
3033 then Nothing
3134 else Just ("Streamly", last $ splitOn "/" b)
3235 }
3336
37+ ignoringErr $ bgraph "charts/results.csv" "generation" "time" $ cfg
38+ { chartTitle = Just "Stream generation (time)"
39+ , classifyBenchmark = \b ->
40+ if "serially/generation" `isPrefixOf` b
41+ then Just ("Streamly", last $ splitOn "/" b)
42+ else Nothing
43+ }
44+
3445 ignoringErr $ bgraph "charts/results.csv" "composition" "time" $ cfg
3546 { chartTitle = Just "Streamly composition performance (time)"
36− , classifyBenchmark = fmap ("Streamly",) . stripPrefix "compose/"
47+ , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose/"
3748 }
3849
3950 ignoringErr $ bgraph "charts/results.csv" "composition-scaling" "time"
4051 $ cfg
4152 { chartTitle = Just "Streamly composition scaling (time)"
42− , classifyBenchmark = fmap ("Streamly",) . stripPrefix "compose-"
53+ , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose-"
4354 }
benchmark/Linear.hs+88−88
@@ -6,7 +6,7 @@
66-- Maintainer : harendra.kumar@gmail.com
77
88import Control.DeepSeq (NFData)
9−import Data.Functor.Identity (Identity, runIdentity)
9+-- import Data.Functor.Identity (Identity, runIdentity)
1010import System.Random (randomRIO)
1111import qualified LinearOps as Ops
1212
@@ -29,102 +29,102 @@ benchSrcIO t name f
2929benchIOAppend :: (NFData b) => String -> (Int -> IO b) -> Benchmark
3030benchIOAppend name f = bench name $ nfIO $ randomRIO (1,1000) >>= f
3131
32+{-
3233_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark
3334_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
35+-}
3436
3537main :: IO ()
3638main = do
3739 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− ]
40+ [ bgroup "serially"
41+ [ bgroup "generation"
42+ [ benchSrcIO serially "unfoldr" $ Ops.sourceUnfoldr
43+ , benchSrcIO serially "fromFoldable" Ops.sourceFromFoldable
44+ , benchSrcIO serially "foldMapWith" Ops.sourceFoldMapWith
45+ , benchSrcIO serially "unfoldrM" Ops.sourceUnfoldrM
46+ , benchSrcIO serially "fromFoldableM" Ops.sourceFromFoldableM
47+ , benchSrcIO serially "foldMapWithM" Ops.sourceFoldMapWithM
48+ ]
49+ , bgroup "elimination"
50+ [ benchIO "toList" Ops.toList
51+ , benchIO "fold" Ops.foldl
52+ , benchIO "last" Ops.last
53+ ]
54+ , bgroup "transformation"
55+ [ benchIO "scan" Ops.scan
56+ , benchIO "map" Ops.map
57+ , benchIO "mapM" (Ops.mapM serially)
58+ , benchIO "concat" Ops.concat
59+ ]
60+ , bgroup "filtering"
61+ [ benchIO "filter-even" Ops.filterEven
62+ , benchIO "filter-all-out" Ops.filterAllOut
63+ , benchIO "filter-all-in" Ops.filterAllIn
64+ , benchIO "take-all" Ops.takeAll
65+ , benchIO "takeWhile-true" Ops.takeWhileTrue
66+ , benchIO "drop-all" Ops.dropAll
67+ , benchIO "dropWhile-true" Ops.dropWhileTrue
68+ ]
69+ , benchIOAppend "append" $ Ops.append serially
70+ , benchIO "zip" $ Ops.zip
71+ , bgroup "compose"
72+ [ benchIO "mapM" Ops.composeMapM
73+ , benchIO "map-with-all-in-filter" Ops.composeMapAllInFilter
74+ , benchIO "all-in-filters" Ops.composeAllInFilters
75+ , benchIO "all-out-filters" Ops.composeAllOutFilters
76+ ]
77+ -- Scaling with same operation in sequence
78+ , bgroup "compose-scaling"
79+ [ benchIO "1" $ Ops.composeScaling 1
80+ , benchIO "2" $ Ops.composeScaling 2
81+ , benchIO "3" $ Ops.composeScaling 3
82+ , benchIO "4" $ Ops.composeScaling 4
83+ ]
84+ ]
85+ , bgroup "asyncly"
86+ [ -- benchIO "unfoldr" $ Ops.toNull asyncly
87+ -- , benchSrcIO asyncly "fromFoldable" Ops.sourceFromFoldable
88+ benchSrcIO asyncly "foldMapWith" Ops.sourceFoldMapWith
89+ , benchSrcIO asyncly "unfoldrM" Ops.sourceUnfoldrM
90+ , benchSrcIO asyncly "fromFoldableM" Ops.sourceFromFoldableM
91+ , benchSrcIO asyncly "foldMapWithM" Ops.sourceFoldMapWithM
92+ , benchIO "mapM" $ Ops.mapM asyncly
93+ , benchIOAppend "append" $ Ops.append asyncly
94+ ]
95+ , bgroup "wAsyncly"
96+ [ -- benchIO "unfoldr" $ Ops.toNull wAsyncly
97+ -- , benchSrcIO wAsyncly "fromFoldable" Ops.sourceFromFoldable
98+ benchSrcIO wAsyncly "foldMapWith" Ops.sourceFoldMapWith
99+ , benchSrcIO wAsyncly "unfoldrM" Ops.sourceUnfoldrM
100+ , benchSrcIO wAsyncly "fromFoldableM" Ops.sourceFromFoldableM
101+ , benchSrcIO wAsyncly "foldMapWithM" Ops.sourceFoldMapWithM
102+ , benchIO "mapM" $ Ops.mapM wAsyncly
103+ , benchIOAppend "append" $ Ops.append wAsyncly
104+ ]
47105 -- unfoldr and fromFoldable are always serial and thereofore the same for
48106 -- all stream types.
49107 , 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− , bgroup "wAsyncly"
66− [ -- benchIO "unfoldr" $ Ops.toNull wAsyncly
67− -- , benchSrcIO wAsyncly "fromFoldable" Ops.sourceFromFoldable
68− benchSrcIO wAsyncly "foldMapWith" Ops.sourceFoldMapWith
69− , benchSrcIO wAsyncly "unfoldrM" Ops.sourceUnfoldrM
70− , benchSrcIO wAsyncly "fromFoldableM" Ops.sourceFromFoldableM
71− , benchSrcIO wAsyncly "foldMapWithM" Ops.sourceFoldMapWithM
72− ]
108+ [ -- benchIO "unfoldr" $ Ops.toNull aheadly
109+ -- , benchSrcIO aheadly "fromFoldable" Ops.sourceFromFoldable
110+ benchSrcIO aheadly "foldMapWith" Ops.sourceFoldMapWith
111+ , benchSrcIO aheadly "unfoldrM" Ops.sourceUnfoldrM
112+ , benchSrcIO aheadly "fromFoldableM" Ops.sourceFromFoldableM
113+ , benchSrcIO aheadly "foldMapWithM" Ops.sourceFoldMapWithM
114+ , benchIO "mapM" $ Ops.mapM aheadly
115+ , benchIOAppend "append" $ Ops.append aheadly
116+ ]
73117 -- XXX need to use smaller streams to finish in reasonable time
74118 , bgroup "parallely"
75− [ --benchIO "unfoldr" $ Ops.toNull parallely
76− --, benchSrcIO parallely "fromFoldable" Ops.sourceFromFoldable
77− benchSrcIO parallely "foldMapWith" Ops.sourceFoldMapWith
78− , benchSrcIO parallely "unfoldrM" Ops.sourceUnfoldrM
79− , benchSrcIO parallely "fromFoldableM" Ops.sourceFromFoldableM
80− , benchSrcIO parallely "foldMapWithM" Ops.sourceFoldMapWithM
81− ]
82− ]
83− -- XXX this is the same foldMapWith in the above benchmarks, need to dedup
84− -- this one provides a single place comparsion of all types and uses
85− -- smaller stream size for faster benchmarking. We can use the same for
86− -- above benchmarks and remove this.
87− , bgroup "append"
88− [ benchIOAppend "serially" $ Ops.append serially
89− , benchIOAppend "wSerially" $ Ops.append wSerially
90− , benchIOAppend "aheadly" $ Ops.append aheadly
91− , benchIOAppend "asyncly" $ Ops.append asyncly
92− , benchIOAppend "wAsyncly" $ Ops.append wAsyncly
93− , benchIOAppend "parallely" $ Ops.append parallely
94− ]
95− , bgroup "elimination"
96− [ benchIO "toNull" $ Ops.toNull serially
97− , benchIO "toList" Ops.toList
98− , benchIO "fold" Ops.foldl
99− , benchIO "last" Ops.last
100− ]
101− , bgroup "transformation"
102− [ benchIO "scan" Ops.scan
103− , benchIO "map" Ops.map
104− , benchIO "mapM" Ops.mapM
105− , benchIO "concat" Ops.concat
106− ]
107− , bgroup "filtering"
108− [ benchIO "filter-even" Ops.filterEven
109− , benchIO "filter-all-out" Ops.filterAllOut
110− , benchIO "filter-all-in" Ops.filterAllIn
111− , benchIO "take-all" Ops.takeAll
112− , benchIO "takeWhile-true" Ops.takeWhileTrue
113− , benchIO "drop-all" Ops.dropAll
114− , benchIO "dropWhile-true" Ops.dropWhileTrue
115− ]
116− , benchIO "zip" Ops.zip
117− , bgroup "compose"
118− [ benchIO "mapM" Ops.composeMapM
119− , benchIO "map-with-all-in-filter" Ops.composeMapAllInFilter
120− , benchIO "all-in-filters" Ops.composeAllInFilters
121− , benchIO "all-out-filters" Ops.composeAllOutFilters
122− ]
123− , bgroup "compose-scaling"
124− -- Scaling with same operation in sequence
125− [ benchIO "1" $ Ops.composeScaling 1
126− , benchIO "2" $ Ops.composeScaling 2
127− , benchIO "3" $ Ops.composeScaling 3
128− , benchIO "4" $ Ops.composeScaling 4
119+ [ --benchIO "unfoldr" $ Ops.toNull parallely
120+ --, benchSrcIO parallely "fromFoldable" Ops.sourceFromFoldable
121+ benchSrcIO parallely "foldMapWith" Ops.sourceFoldMapWith
122+ , benchSrcIO parallely "unfoldrM" Ops.sourceUnfoldrM
123+ , benchSrcIO parallely "fromFoldableM" Ops.sourceFromFoldableM
124+ , benchSrcIO parallely "foldMapWithM" Ops.sourceFoldMapWithM
125+ , benchIO "mapM" $ Ops.mapM parallely
126+ , benchIOAppend "append" $ Ops.append parallely
127+ -- Zip has only one parallel flavor
128+ , benchIO "zip" $ Ops.zipAsync
129+ ]
129130 ]
130− ]
benchmark/LinearOps.hs+17−9
@@ -53,12 +53,15 @@ scan, map, filterEven, filterAllOut,
5353 :: Monad m
5454 => Stream m Int -> m ()
5555
56−mapM, composeMapM :: S.MonadAsync m => Stream m Int -> m ()
56+composeMapM :: S.MonadAsync m => Stream m Int -> m ()
5757toList :: 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
6161toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()
62+mapM :: (S.IsStream t, S.MonadAsync m)
63+ => (t m Int -> S.SerialT m Int) -> t m Int -> m ()
64+zipAsync :: S.MonadAsync m => Stream m Int -> m ()
6265
6366-------------------------------------------------------------------------------
6467-- Stream generation and elimination
@@ -67,13 +70,8 @@ toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()
6770type Stream m a = S.SerialT m a
6871
6972{-# INLINE source #-}
70−source :: S.IsStream t => Int -> t m Int
71−source n = S.unfoldr step n
72− where
73− step cnt =
74− if cnt > n + value
75− then Nothing
76− else (Just (cnt, cnt + 1))
73+source :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
74+source n = S.serially $ sourceUnfoldrM n
7775
7876{-# INLINE sourceFromFoldable #-}
7977sourceFromFoldable :: S.IsStream t => Int -> t m Int
@@ -93,6 +91,15 @@ sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
9391 => Int -> t m Int
9492sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.once . return) [n..n+value]
9593
94+{-# INLINE sourceUnfoldr #-}
95+sourceUnfoldr :: S.IsStream t => Int -> t m Int
96+sourceUnfoldr n = S.unfoldr step n
97+ where
98+ step cnt =
99+ if cnt > n + value
100+ then Nothing
101+ else (Just (cnt, cnt + 1))
102+
96103{-# INLINE sourceUnfoldrM #-}
97104sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
98105sourceUnfoldrM n = S.unfoldrM step n
@@ -125,7 +132,7 @@ transform = runStream
125132
126133scan = transform . S.scanl' (+) 0
127134map = transform . fmap (+1)
128−mapM = transform . S.mapM return
135+mapM t = transform . t . S.mapM return
129136filterEven = transform . S.filter even
130137filterAllOut = transform . S.filter (> maxValue)
131138filterAllIn = transform . S.filter (<= maxValue)
@@ -140,6 +147,7 @@ dropWhileTrue = transform . S.dropWhile (<= maxValue)
140147-------------------------------------------------------------------------------
141148
142149zip src = transform $ (S.zipWith (,) src src)
150+zipAsync src = transform $ (S.zipAsyncWith (,) src src)
143151concat _n = return ()
144152
145153-------------------------------------------------------------------------------
benchmark/Nested.hs+8−30
@@ -22,16 +22,8 @@ main :: IO ()
2222main = do
2323 -- TBD Study scaling with 10, 100, 1000 loop iterations
2424 defaultMain
25− [ bgroup "linear"
26− [ benchIO "toNullLinear" Ops.toNullLinear
27− , benchIO "toListLinear" Ops.toListLinear
28− ]
29−
30− , bgroup "serially"
31− [ benchIO "append" $ Ops.append serially
32− , benchIO "toNull0" $ Ops.toNull0 serially
33− , benchIO "toList0" $ Ops.toList0 serially
34− , benchIO "toNull" $ Ops.toNull serially
25+ [ bgroup "serially"
26+ [ benchIO "toNull" $ Ops.toNull serially
3527 , benchIO "toList" $ Ops.toList serially
3628 , benchIO "toListSome" $ Ops.toListSome serially
3729 , benchIO "filterAllOut" $ Ops.filterAllOut serially
@@ -41,10 +33,7 @@ main = do
4133 ]
4234
4335 , bgroup "wSerially"
44− [ benchIO "append" $ Ops.append wSerially
45− , benchIO "toNull0" $ Ops.toNull0 wSerially
46− , benchIO "toList0" $ Ops.toList0 wSerially
47− , benchIO "toNull" $ Ops.toNull wSerially
36+ [ benchIO "toNull" $ Ops.toNull wSerially
4837 , benchIO "toList" $ Ops.toList wSerially
4938 , benchIO "toListSome" $ Ops.toListSome wSerially
5039 , benchIO "filterAllOut" $ Ops.filterAllOut wSerially
@@ -54,23 +43,18 @@ main = do
5443 ]
5544
5645 , bgroup "aheadly"
57− [ benchIO "append" $ Ops.append aheadly
58− , benchIO "toNull0" $ Ops.toNull0 aheadly
59− , benchIO "toList0" $ Ops.toList0 aheadly
60− , benchIO "toNull" $ Ops.toNull aheadly
46+ [ benchIO "toNull" $ Ops.toNull aheadly
6147 , benchIO "toList" $ Ops.toList aheadly
6248 , benchIO "toListSome" $ Ops.toListSome aheadly
6349 , benchIO "filterAllOut" $ Ops.filterAllOut aheadly
6450 , benchIO "filterAllIn" $ Ops.filterAllIn aheadly
51+ -- this hangs, need to investigate
6552 , benchIO "filterSome" $ Ops.filterSome aheadly
6653 , benchIO "breakAfterSome" $ Ops.breakAfterSome aheadly
6754 ]
6855
6956 , bgroup "asyncly"
70− [ benchIO "append" $ Ops.append asyncly
71− , benchIO "toNull0" $ Ops.toNull0 asyncly
72− , benchIO "toList0" $ Ops.toList0 asyncly
73− , benchIO "toNull" $ Ops.toNull asyncly
57+ [ benchIO "toNull" $ Ops.toNull asyncly
7458 , benchIO "toList" $ Ops.toList asyncly
7559 , benchIO "toListSome" $ Ops.toListSome asyncly
7660 , benchIO "filterAllOut" $ Ops.filterAllOut asyncly
@@ -80,10 +64,7 @@ main = do
8064 ]
8165
8266 , bgroup "wAsyncly"
83− [ benchIO "append" $ Ops.append wAsyncly
84− , benchIO "toNull0" $ Ops.toNull0 wAsyncly
85− , benchIO "toList0" $ Ops.toList0 wAsyncly
86− , benchIO "toNull" $ Ops.toNull wAsyncly
67+ [ benchIO "toNull" $ Ops.toNull wAsyncly
8768 , benchIO "toList" $ Ops.toList wAsyncly
8869 , benchIO "toListSome" $ Ops.toListSome wAsyncly
8970 , benchIO "filterAllOut" $ Ops.filterAllOut wAsyncly
@@ -93,10 +74,7 @@ main = do
9374 ]
9475
9576 , bgroup "parallely"
96− [ benchIO "append" $ Ops.append parallely
97− , benchIO "toNull0" $ Ops.toNull0 parallely
98− , benchIO "toList0" $ Ops.toList0 parallely
99− , benchIO "toNull" $ Ops.toNull parallely
77+ [ benchIO "toNull" $ Ops.toNull parallely
10078 , benchIO "toList" $ Ops.toList parallely
10179 , benchIO "toListSome" $ Ops.toListSome parallely
10280 , benchIO "filterAllOut" $ Ops.filterAllOut parallely
benchmark/NestedOps.hs+31−49
@@ -5,6 +5,7 @@
55-- License : MIT
66-- Maintainer : harendra.kumar@gmail.com
77
8+{-# LANGUAGE FlexibleContexts #-}
89{-# LANGUAGE ScopedTypeVariables #-}
910
1011module NestedOps where
@@ -28,8 +29,21 @@ prodCount = 1000
2829type Stream m a = S.SerialT m a
2930
3031{-# INLINE source #-}
31−source :: S.IsStream t => Int -> Int -> t m Int
32−source start n = S.unfoldr step start
32+source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
33+source = sourceUnfoldrM
34+
35+{-# INLINE sourceUnfoldrM #-}
36+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
37+sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
38+ where
39+ step cnt =
40+ if cnt > n + value
41+ then return Nothing
42+ else return (Just (cnt, cnt + 1))
43+
44+{-# INLINE sourceUnfoldr #-}
45+sourceUnfoldr :: S.IsStream t => Int -> Int -> t m Int
46+sourceUnfoldr start n = S.unfoldr step start
3347 where
3448 step cnt =
3549 if cnt > start + n
@@ -48,98 +62,66 @@ runToList = S.toList
4862-- Benchmark ops
4963-------------------------------------------------------------------------------
5064
51−{-# INLINE toNullLinear #-}
52−toNullLinear :: Monad m => Int -> m ()
53−toNullLinear start = runStream $ source start sumCount
54−
55−{-# INLINE toListLinear #-}
56−toListLinear :: Monad m => Int -> m [Int]
57−toListLinear start = runToList $ source start sumCount
58−
59−{-# INLINE append #-}
60−append
61− :: (Monoid (t m Int), Monad m, Monad (t m))
62− => (t m Int -> S.SerialT m Int) -> Int -> m ()
63−append t start = runStream $ t $ foldMap return [start..start+sumCount]
64−
65−{-# INLINE toNull0 #-}
66−toNull0
67− :: (S.IsStream t, Monad m, Monad (t m))
68− => (t m (Int, Int) -> S.SerialT m (Int, Int)) -> Int -> m ()
69−toNull0 t start = runStream . t $ do
70− x <- source start prodCount
71− y <- source start prodCount
72− return (x,y)
73−
74−{-# INLINE toList0 #-}
75−toList0
76− :: (S.IsStream t, Monad m, Monad (t m))
77− => (t m (Int, Int) -> S.SerialT m (Int, Int)) -> Int -> m [(Int, Int)]
78−toList0 t start = runToList . t $ do
79− x <- source start prodCount
80− y <- source start prodCount
81− return (x,y)
82−
8365{-# INLINE toNull #-}
8466toNull
85− :: (S.IsStream t, Monad m, Monad (t m))
67+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
8668 => (t m Int -> S.SerialT m Int) -> Int -> m ()
8769toNull t start = runStream . t $ do
8870 x <- source start prodCount
8971 y <- source start prodCount
90− return $ x * x + y * y
72+ return $ x + y
9173
9274{-# INLINE toList #-}
9375toList
94− :: (S.IsStream t, Monad m, Monad (t m))
76+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
9577 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
9678toList t start = runToList . t $ do
9779 x <- source start prodCount
9880 y <- source start prodCount
99− return $ x * x + y * y
81+ return $ x + y
10082
10183{-# INLINE toListSome #-}
10284toListSome
103− :: (S.IsStream t, Monad m, Monad (t m))
85+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
10486 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
10587toListSome t start =
10688 runToList . t $ S.take 1000 $ do
10789 x <- source start prodCount
10890 y <- source start prodCount
109− return $ x * x + y * y
91+ return $ x + y
11092
11193{-# INLINE filterAllOut #-}
11294filterAllOut
113− :: (S.IsStream t, Monad m, Monad (t m))
95+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
11496 => (t m Int -> S.SerialT m Int) -> Int -> m ()
11597filterAllOut t start = runStream . t $ do
11698 x <- source start prodCount
11799 y <- source start prodCount
118− let s = x * x + y * y
119− if (s < 1)
100+ let s = x + y
101+ if (s < 0)
120102 then return s
121103 else S.nil
122104
123105{-# INLINE filterAllIn #-}
124106filterAllIn
125− :: (S.IsStream t, Monad m, Monad (t m))
107+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
126108 => (t m Int -> S.SerialT m Int) -> Int -> m ()
127109filterAllIn t start = runStream . t $ do
128110 x <- source start prodCount
129111 y <- source start prodCount
130− let s = x * x + y * y
131− if (s > 1)
112+ let s = x + y
113+ if (s > 0)
132114 then return s
133115 else S.nil
134116
135117{-# INLINE filterSome #-}
136118filterSome
137− :: (S.IsStream t, Monad m, Monad (t m))
119+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
138120 => (t m Int -> S.SerialT m Int) -> Int -> m ()
139121filterSome t start = runStream . t $ do
140122 x <- source start prodCount
141123 y <- source start prodCount
142− let s = x * x + y * y
124+ let s = x + y
143125 if (s > 1100000)
144126 then return s
145127 else S.nil
@@ -152,7 +134,7 @@ breakAfterSome t start = do
152134 (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
153135 x <- source start prodCount
154136 y <- source start prodCount
155− let s = x * x + y * y
137+ let s = x + y
156138 if (s > 1100000)
157139 then error "break"
158140 else return s