git.iko.soy/streamly
on master help sign in
add more benchmarks, update benchmarks
aa4c870Harendra Kumar
bench.sh+1
compare with master
unifiedsplit
@@ -63,6 +63,7 @@ if test "$GRAPH" != "0"
63then
63then
64 CHART_PROG="chart-$BENCHMARK"
64 CHART_PROG="chart-$BENCHMARK"
65 prog=$($STACK exec which $CHART_PROG)
65 prog=$($STACK exec which $CHART_PROG)
66+ hash -r
66 if test ! -x "$prog"
67 if test ! -x "$prog"
67 then
68 then
68 echo "Building charting executable"
69 echo "Building charting executable"
benchmark/Adaptive.hs+24−7
@@ -38,35 +38,44 @@ run srange crange t = runStream $ do
38 when (d /= 0) $ liftIO $ threadDelay d
38 when (d /= 0) $ liftIO $ threadDelay d
39 return n
39 return n
40
40
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+
41{-# INLINE alwaysConstSlowSerial #-}
50{-# INLINE alwaysConstSlowSerial #-}
42alwaysConstSlowSerial :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
51alwaysConstSlowSerial :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
43−alwaysConstSlowSerial = run (0,0) (20,20)
52+alwaysConstSlowSerial = run (0,0) (medium,medium)
44
53
45{-# INLINE alwaysConstSlow #-}
54{-# INLINE alwaysConstSlow #-}
46alwaysConstSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
55alwaysConstSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
47−alwaysConstSlow = run (10,10) (20,20)
56+alwaysConstSlow = run (low,low) (medium,medium)
48
57
49{-# INLINE alwaysConstFast #-}
58{-# INLINE alwaysConstFast #-}
50alwaysConstFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
59alwaysConstFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
51−alwaysConstFast = run (30,30) (20,20)
60+alwaysConstFast = run (high,high) (medium,medium)
52
61
53{-# INLINE alwaysVarSlow #-}
62{-# INLINE alwaysVarSlow #-}
54alwaysVarSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
63alwaysVarSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
55−alwaysVarSlow = run (10,10) (10,30)
64+alwaysVarSlow = run (low,low) (low,high)
56
65
57{-# INLINE alwaysVarFast #-}
66{-# INLINE alwaysVarFast #-}
58alwaysVarFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
67alwaysVarFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
59−alwaysVarFast = run (30,30) (10,30)
68+alwaysVarFast = run (high,high) (low,high)
60
69
61-- XXX add variable producer tests as well
70-- XXX add variable producer tests as well
62
71
63{-# INLINE runVarSometimesFast #-}
72{-# INLINE runVarSometimesFast #-}
64runVarSometimesFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
73runVarSometimesFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
65−runVarSometimesFast = run (20,20) (10,30)
74+runVarSometimesFast = run (medium,medium) (low,high)
66
75
67{-# INLINE randomVar #-}
76{-# INLINE randomVar #-}
68randomVar :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
77randomVar :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()
69−randomVar = run (10,30) (10,30)
78+randomVar = run (low,high) (low,high)
70
79
71main :: IO ()
80main :: IO ()
72main = do
81main = do
@@ -76,6 +85,14 @@ main = do
76 [ bench "serially" $ nfIO $ alwaysConstSlowSerial serially
85 [ bench "serially" $ nfIO $ alwaysConstSlowSerial serially
77 , bench "wSerially" $ nfIO $ alwaysConstSlowSerial wSerially
86 , bench "wSerially" $ nfIO $ alwaysConstSlowSerial wSerially
78 ]
87 ]
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+ ]
79 , bgroup "constantSlowConsumer"
96 , bgroup "constantSlowConsumer"
80 [ bench "aheadly" $ nfIO $ alwaysConstSlow aheadly
97 [ bench "aheadly" $ nfIO $ alwaysConstSlow aheadly
81 , bench "asyncly" $ nfIO $ alwaysConstSlow asyncly
98 , bench "asyncly" $ nfIO $ alwaysConstSlow asyncly
benchmark/ChartLinear.hs+17−6
@@ -6,7 +6,7 @@ module Main where
6import Data.List
6import Data.List
7import Data.List.Split
7import Data.List.Split
8import BenchGraph (bgraph, defaultConfig, Config(..), ComparisonStyle(..))
8import BenchGraph (bgraph, defaultConfig, Config(..), ComparisonStyle(..))
9−import Control.Exception (handle, catch, SomeException, ErrorCall)
9+import Control.Exception (handle, catch, SomeException, ErrorCall(..))
10
10
11main :: IO ()
11main :: IO ()
12main = do
12main = do
@@ -15,8 +15,8 @@ main = do
15 , comparisonStyle = CompareDelta
15 , comparisonStyle = CompareDelta
16 }
16 }
17
17
18− ignoringErr a = catch a (\(_ :: ErrorCall) ->
18+ ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
19− putStrLn "Failed. Skipping.")
19+ putStrLn $ "Failed with error:\n" ++ err ++ "\nSkipping.")
20 -- bgraph <input> <output> <field in csv file to be plotted>
20 -- bgraph <input> <output> <field in csv file to be plotted>
21 -- other interesting fields to plot are:
21 -- other interesting fields to plot are:
22 -- allocated
22 -- allocated
@@ -26,18 +26,29 @@ main = do
26 ignoringErr $ bgraph "charts/results.csv" "operations" "time" $ cfg
26 ignoringErr $ bgraph "charts/results.csv" "operations" "time" $ cfg
27 { chartTitle = Just "Streamly operations (time)"
27 { chartTitle = Just "Streamly operations (time)"
28 , classifyBenchmark = \b ->
28 , classifyBenchmark = \b ->
29+ if (not $ "serially/" `isPrefixOf` b)
30+ || "/generation" `isInfixOf` b
31+ || "/compose" `isInfixOf` b
29− if "compose" `isPrefixOf` b || "/concat" `isSuffixOf` b
32+ || "/concat" `isSuffixOf` b
30 then Nothing
33 then Nothing
31 else Just ("Streamly", last $ splitOn "/" b)
34 else Just ("Streamly", last $ splitOn "/" b)
32 }
35 }
33
36
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+
34 ignoringErr $ bgraph "charts/results.csv" "composition" "time" $ cfg
45 ignoringErr $ bgraph "charts/results.csv" "composition" "time" $ cfg
35 { chartTitle = Just "Streamly composition performance (time)"
46 { chartTitle = Just "Streamly composition performance (time)"
36− , classifyBenchmark = fmap ("Streamly",) . stripPrefix "compose/"
47+ , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose/"
37 }
48 }
38
49
39 ignoringErr $ bgraph "charts/results.csv" "composition-scaling" "time"
50 ignoringErr $ bgraph "charts/results.csv" "composition-scaling" "time"
40 $ cfg
51 $ cfg
41 { chartTitle = Just "Streamly composition scaling (time)"
52 { chartTitle = Just "Streamly composition scaling (time)"
42− , classifyBenchmark = fmap ("Streamly",) . stripPrefix "compose-"
53+ , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose-"
43 }
54 }
benchmark/Linear.hs+88−88
@@ -6,7 +6,7 @@
6-- Maintainer : harendra.kumar@gmail.com
6-- Maintainer : harendra.kumar@gmail.com
7
7
8import Control.DeepSeq (NFData)
8import Control.DeepSeq (NFData)
9−import Data.Functor.Identity (Identity, runIdentity)
9+-- import Data.Functor.Identity (Identity, runIdentity)
10import System.Random (randomRIO)
10import System.Random (randomRIO)
11import qualified LinearOps as Ops
11import qualified LinearOps as Ops
12
12
@@ -29,102 +29,102 @@ benchSrcIO t name f
29benchIOAppend :: (NFData b) => String -> (Int -> IO b) -> Benchmark
29benchIOAppend :: (NFData b) => String -> (Int -> IO b) -> Benchmark
30benchIOAppend name f = bench name $ nfIO $ randomRIO (1,1000) >>= f
30benchIOAppend name f = bench name $ nfIO $ randomRIO (1,1000) >>= f
31
31
32+{-
32_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark
33_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark
33_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
34_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
35+-}
34
36
35main :: IO ()
37main :: IO ()
36main = do
38main = do
37 defaultMain
39 defaultMain
40+ [ bgroup "serially"
38− [ bgroup "generation"
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+ ]
39− [ bgroup "serially"
85+ , bgroup "asyncly"
40− [ benchIO "unfoldr" $ Ops.toNull serially
86+ [ -- benchIO "unfoldr" $ Ops.toNull asyncly
41− , benchSrcIO serially "fromFoldable" Ops.sourceFromFoldable
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
42− , benchSrcIO serially "foldMapWith" Ops.sourceFoldMapWith
98+ benchSrcIO wAsyncly "foldMapWith" Ops.sourceFoldMapWith
43− , benchSrcIO serially "unfoldrM" Ops.sourceUnfoldrM
99+ , benchSrcIO wAsyncly "unfoldrM" Ops.sourceUnfoldrM
44− , benchSrcIO serially "fromFoldableM" Ops.sourceFromFoldableM
100+ , benchSrcIO wAsyncly "fromFoldableM" Ops.sourceFromFoldableM
45− , benchSrcIO serially "foldMapWithM" Ops.sourceFoldMapWithM
101+ , benchSrcIO wAsyncly "foldMapWithM" Ops.sourceFoldMapWithM
102+ , benchIO "mapM" $ Ops.mapM wAsyncly
103+ , benchIOAppend "append" $ Ops.append wAsyncly
46− ]
104+ ]
47 -- unfoldr and fromFoldable are always serial and thereofore the same for
105 -- unfoldr and fromFoldable are always serial and thereofore the same for
48 -- all stream types.
106 -- all stream types.
49 , bgroup "aheadly"
107 , bgroup "aheadly"
50− [ -- benchIO "unfoldr" $ Ops.toNull aheadly
108+ [ -- benchIO "unfoldr" $ Ops.toNull aheadly
51− -- , benchSrcIO aheadly "fromFoldable" Ops.sourceFromFoldable
109+ -- , benchSrcIO aheadly "fromFoldable" Ops.sourceFromFoldable
52− benchSrcIO aheadly "foldMapWith" Ops.sourceFoldMapWith
110+ benchSrcIO aheadly "foldMapWith" Ops.sourceFoldMapWith
53− , benchSrcIO aheadly "unfoldrM" Ops.sourceUnfoldrM
111+ , benchSrcIO aheadly "unfoldrM" Ops.sourceUnfoldrM
54− , benchSrcIO aheadly "fromFoldableM" Ops.sourceFromFoldableM
112+ , benchSrcIO aheadly "fromFoldableM" Ops.sourceFromFoldableM
55− , benchSrcIO aheadly "foldMapWithM" Ops.sourceFoldMapWithM
113+ , benchSrcIO aheadly "foldMapWithM" Ops.sourceFoldMapWithM
56− ]
114+ , benchIO "mapM" $ Ops.mapM aheadly
57− , bgroup "asyncly"
115+ , benchIOAppend "append" $ Ops.append aheadly
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− ]
116+ ]
73 -- XXX need to use smaller streams to finish in reasonable time
117 -- XXX need to use smaller streams to finish in reasonable time
74 , bgroup "parallely"
118 , bgroup "parallely"
75− [ --benchIO "unfoldr" $ Ops.toNull parallely
119+ [ --benchIO "unfoldr" $ Ops.toNull parallely
76− --, benchSrcIO parallely "fromFoldable" Ops.sourceFromFoldable
120+ --, benchSrcIO parallely "fromFoldable" Ops.sourceFromFoldable
77− benchSrcIO parallely "foldMapWith" Ops.sourceFoldMapWith
121+ benchSrcIO parallely "foldMapWith" Ops.sourceFoldMapWith
78− , benchSrcIO parallely "unfoldrM" Ops.sourceUnfoldrM
122+ , benchSrcIO parallely "unfoldrM" Ops.sourceUnfoldrM
79− , benchSrcIO parallely "fromFoldableM" Ops.sourceFromFoldableM
123+ , benchSrcIO parallely "fromFoldableM" Ops.sourceFromFoldableM
80− , benchSrcIO parallely "foldMapWithM" Ops.sourceFoldMapWithM
124+ , benchSrcIO parallely "foldMapWithM" Ops.sourceFoldMapWithM
81− ]
125+ , benchIO "mapM" $ Ops.mapM parallely
82− ]
126+ , benchIOAppend "append" $ Ops.append parallely
83− -- XXX this is the same foldMapWith in the above benchmarks, need to dedup
127+ -- Zip has only one parallel flavor
84− -- this one provides a single place comparsion of all types and uses
128+ , benchIO "zip" $ Ops.zipAsync
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− ]
129+ ]
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
129 ]
130 ]
130− ]
benchmark/LinearOps.hs+17−9
@@ -53,12 +53,15 @@ scan, map, filterEven, filterAllOut,
53 :: Monad m
53 :: Monad m
54 => Stream m Int -> m ()
54 => Stream m Int -> m ()
55
55
56−mapM, composeMapM :: S.MonadAsync m => Stream m Int -> m ()
56+composeMapM :: S.MonadAsync m => Stream m Int -> m ()
57toList :: Monad m => Stream m Int -> m [Int]
57toList :: 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
61toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()
61toNull :: 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 ()
62
65
63-------------------------------------------------------------------------------
66-------------------------------------------------------------------------------
64-- Stream generation and elimination
67-- Stream generation and elimination
@@ -67,13 +70,8 @@ toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()
67type Stream m a = S.SerialT m a
70type Stream m a = S.SerialT m a
68
71
69{-# INLINE source #-}
72{-# INLINE source #-}
70−source :: S.IsStream t => Int -> t m Int
73+source :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
71−source n = S.unfoldr step n
74+source n = S.serially $ sourceUnfoldrM n
72− where
73− step cnt =
74− if cnt > n + value
75− then Nothing
76− else (Just (cnt, cnt + 1))
77
75
78{-# INLINE sourceFromFoldable #-}
76{-# INLINE sourceFromFoldable #-}
79sourceFromFoldable :: S.IsStream t => Int -> t m Int
77sourceFromFoldable :: S.IsStream t => Int -> t m Int
@@ -93,6 +91,15 @@ sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
93 => Int -> t m Int
91 => Int -> t m Int
94sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.once . return) [n..n+value]
92sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.once . return) [n..n+value]
95
93
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+
96{-# INLINE sourceUnfoldrM #-}
103{-# INLINE sourceUnfoldrM #-}
97sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
104sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
98sourceUnfoldrM n = S.unfoldrM step n
105sourceUnfoldrM n = S.unfoldrM step n
@@ -125,7 +132,7 @@ transform = runStream
125
132
126scan = transform . S.scanl' (+) 0
133scan = transform . S.scanl' (+) 0
127map = transform . fmap (+1)
134map = transform . fmap (+1)
128−mapM = transform . S.mapM return
135+mapM t = transform . t . S.mapM return
129filterEven = transform . S.filter even
136filterEven = transform . S.filter even
130filterAllOut = transform . S.filter (> maxValue)
137filterAllOut = transform . S.filter (> maxValue)
131filterAllIn = transform . S.filter (<= maxValue)
138filterAllIn = transform . S.filter (<= maxValue)
@@ -140,6 +147,7 @@ dropWhileTrue = transform . S.dropWhile (<= maxValue)
140-------------------------------------------------------------------------------
147-------------------------------------------------------------------------------
141
148
142zip src = transform $ (S.zipWith (,) src src)
149zip src = transform $ (S.zipWith (,) src src)
150+zipAsync src = transform $ (S.zipAsyncWith (,) src src)
143concat _n = return ()
151concat _n = return ()
144
152
145-------------------------------------------------------------------------------
153-------------------------------------------------------------------------------
benchmark/Nested.hs+8−30
@@ -22,16 +22,8 @@ main :: IO ()
22main = do
22main = do
23 -- TBD Study scaling with 10, 100, 1000 loop iterations
23 -- TBD Study scaling with 10, 100, 1000 loop iterations
24 defaultMain
24 defaultMain
25− [ bgroup "linear"
26− [ benchIO "toNullLinear" Ops.toNullLinear
27− , benchIO "toListLinear" Ops.toListLinear
28− ]
29−
30− , bgroup "serially"
25+ [ 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
26+ [ benchIO "toNull" $ Ops.toNull serially
35 , benchIO "toList" $ Ops.toList serially
27 , benchIO "toList" $ Ops.toList serially
36 , benchIO "toListSome" $ Ops.toListSome serially
28 , benchIO "toListSome" $ Ops.toListSome serially
37 , benchIO "filterAllOut" $ Ops.filterAllOut serially
29 , benchIO "filterAllOut" $ Ops.filterAllOut serially
@@ -41,10 +33,7 @@ main = do
41 ]
33 ]
42
34
43 , bgroup "wSerially"
35 , 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
48 , benchIO "toList" $ Ops.toList wSerially
37 , benchIO "toList" $ Ops.toList wSerially
49 , benchIO "toListSome" $ Ops.toListSome wSerially
38 , benchIO "toListSome" $ Ops.toListSome wSerially
50 , benchIO "filterAllOut" $ Ops.filterAllOut wSerially
39 , benchIO "filterAllOut" $ Ops.filterAllOut wSerially
@@ -54,23 +43,18 @@ main = do
54 ]
43 ]
55
44
56 , bgroup "aheadly"
45 , 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
61 , benchIO "toList" $ Ops.toList aheadly
47 , benchIO "toList" $ Ops.toList aheadly
62 , benchIO "toListSome" $ Ops.toListSome aheadly
48 , benchIO "toListSome" $ Ops.toListSome aheadly
63 , benchIO "filterAllOut" $ Ops.filterAllOut aheadly
49 , benchIO "filterAllOut" $ Ops.filterAllOut aheadly
64 , benchIO "filterAllIn" $ Ops.filterAllIn aheadly
50 , benchIO "filterAllIn" $ Ops.filterAllIn aheadly
51+ -- this hangs, need to investigate
65 , benchIO "filterSome" $ Ops.filterSome aheadly
52 , benchIO "filterSome" $ Ops.filterSome aheadly
66 , benchIO "breakAfterSome" $ Ops.breakAfterSome aheadly
53 , benchIO "breakAfterSome" $ Ops.breakAfterSome aheadly
67 ]
54 ]
68
55
69 , bgroup "asyncly"
56 , 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
74 , benchIO "toList" $ Ops.toList asyncly
58 , benchIO "toList" $ Ops.toList asyncly
75 , benchIO "toListSome" $ Ops.toListSome asyncly
59 , benchIO "toListSome" $ Ops.toListSome asyncly
76 , benchIO "filterAllOut" $ Ops.filterAllOut asyncly
60 , benchIO "filterAllOut" $ Ops.filterAllOut asyncly
@@ -80,10 +64,7 @@ main = do
80 ]
64 ]
81
65
82 , bgroup "wAsyncly"
66 , 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
87 , benchIO "toList" $ Ops.toList wAsyncly
68 , benchIO "toList" $ Ops.toList wAsyncly
88 , benchIO "toListSome" $ Ops.toListSome wAsyncly
69 , benchIO "toListSome" $ Ops.toListSome wAsyncly
89 , benchIO "filterAllOut" $ Ops.filterAllOut wAsyncly
70 , benchIO "filterAllOut" $ Ops.filterAllOut wAsyncly
@@ -93,10 +74,7 @@ main = do
93 ]
74 ]
94
75
95 , bgroup "parallely"
76 , 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
100 , benchIO "toList" $ Ops.toList parallely
78 , benchIO "toList" $ Ops.toList parallely
101 , benchIO "toListSome" $ Ops.toListSome parallely
79 , benchIO "toListSome" $ Ops.toListSome parallely
102 , benchIO "filterAllOut" $ Ops.filterAllOut parallely
80 , benchIO "filterAllOut" $ Ops.filterAllOut parallely
benchmark/NestedOps.hs+31−49
@@ -5,6 +5,7 @@
5-- License : MIT
5-- License : MIT
6-- Maintainer : harendra.kumar@gmail.com
6-- Maintainer : harendra.kumar@gmail.com
7
7
8+{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
9
10
10module NestedOps where
11module NestedOps where
@@ -28,8 +29,21 @@ prodCount = 1000
28type Stream m a = S.SerialT m a
29type Stream m a = S.SerialT m a
29
30
30{-# INLINE source #-}
31{-# INLINE source #-}
31−source :: S.IsStream t => Int -> Int -> t m Int
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
32−source start n = S.unfoldr step start
46+sourceUnfoldr start n = S.unfoldr step start
33 where
47 where
34 step cnt =
48 step cnt =
35 if cnt > start + n
49 if cnt > start + n
@@ -48,98 +62,66 @@ runToList = S.toList
48-- Benchmark ops
62-- Benchmark ops
49-------------------------------------------------------------------------------
63-------------------------------------------------------------------------------
50
64
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−
83{-# INLINE toNull #-}
65{-# INLINE toNull #-}
84toNull
66toNull
85− :: (S.IsStream t, Monad m, Monad (t m))
67+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
86 => (t m Int -> S.SerialT m Int) -> Int -> m ()
68 => (t m Int -> S.SerialT m Int) -> Int -> m ()
87toNull t start = runStream . t $ do
69toNull t start = runStream . t $ do
88 x <- source start prodCount
70 x <- source start prodCount
89 y <- source start prodCount
71 y <- source start prodCount
90− return $ x * x + y * y
72+ return $ x + y
91
73
92{-# INLINE toList #-}
74{-# INLINE toList #-}
93toList
75toList
94− :: (S.IsStream t, Monad m, Monad (t m))
76+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
95 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
77 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
96toList t start = runToList . t $ do
78toList t start = runToList . t $ do
97 x <- source start prodCount
79 x <- source start prodCount
98 y <- source start prodCount
80 y <- source start prodCount
99− return $ x * x + y * y
81+ return $ x + y
100
82
101{-# INLINE toListSome #-}
83{-# INLINE toListSome #-}
102toListSome
84toListSome
103− :: (S.IsStream t, Monad m, Monad (t m))
85+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
104 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
86 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
105toListSome t start =
87toListSome t start =
106 runToList . t $ S.take 1000 $ do
88 runToList . t $ S.take 1000 $ do
107 x <- source start prodCount
89 x <- source start prodCount
108 y <- source start prodCount
90 y <- source start prodCount
109− return $ x * x + y * y
91+ return $ x + y
110
92
111{-# INLINE filterAllOut #-}
93{-# INLINE filterAllOut #-}
112filterAllOut
94filterAllOut
113− :: (S.IsStream t, Monad m, Monad (t m))
95+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
114 => (t m Int -> S.SerialT m Int) -> Int -> m ()
96 => (t m Int -> S.SerialT m Int) -> Int -> m ()
115filterAllOut t start = runStream . t $ do
97filterAllOut t start = runStream . t $ do
116 x <- source start prodCount
98 x <- source start prodCount
117 y <- source start prodCount
99 y <- source start prodCount
118− let s = x * x + y * y
100+ let s = x + y
119− if (s < 1)
101+ if (s < 0)
120 then return s
102 then return s
121 else S.nil
103 else S.nil
122
104
123{-# INLINE filterAllIn #-}
105{-# INLINE filterAllIn #-}
124filterAllIn
106filterAllIn
125− :: (S.IsStream t, Monad m, Monad (t m))
107+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
126 => (t m Int -> S.SerialT m Int) -> Int -> m ()
108 => (t m Int -> S.SerialT m Int) -> Int -> m ()
127filterAllIn t start = runStream . t $ do
109filterAllIn t start = runStream . t $ do
128 x <- source start prodCount
110 x <- source start prodCount
129 y <- source start prodCount
111 y <- source start prodCount
130− let s = x * x + y * y
112+ let s = x + y
131− if (s > 1)
113+ if (s > 0)
132 then return s
114 then return s
133 else S.nil
115 else S.nil
134
116
135{-# INLINE filterSome #-}
117{-# INLINE filterSome #-}
136filterSome
118filterSome
137− :: (S.IsStream t, Monad m, Monad (t m))
119+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
138 => (t m Int -> S.SerialT m Int) -> Int -> m ()
120 => (t m Int -> S.SerialT m Int) -> Int -> m ()
139filterSome t start = runStream . t $ do
121filterSome t start = runStream . t $ do
140 x <- source start prodCount
122 x <- source start prodCount
141 y <- source start prodCount
123 y <- source start prodCount
142− let s = x * x + y * y
124+ let s = x + y
143 if (s > 1100000)
125 if (s > 1100000)
144 then return s
126 then return s
145 else S.nil
127 else S.nil
@@ -152,7 +134,7 @@ breakAfterSome t start = do
152 (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
134 (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
153 x <- source start prodCount
135 x <- source start prodCount
154 y <- source start prodCount
136 y <- source start prodCount
155− let s = x * x + y * y
137+ let s = x + y
156 if (s > 1100000)
138 if (s > 1100000)
157 then error "break"
139 then error "break"
158 else return s
140 else return s