8ec2ebe · streamly · git.iko.soy

benchmark/Common.hsnew file+82

compare with master

unifiedsplit

@@ -0,0 +1,82 @@

1+-- |

2+-- Module : Main

4+--

5+-- License : BSD3

6+-- Maintainer : streamly@composewell.com

7+

8+module Common (parseCLIOpts) where

9+

10+import Control.Exception (evaluate)

11+import Control.Monad (when)

12+import Data.List (scanl')

13+import Data.Maybe (catMaybes)

14+import System.Console.GetOpt

15+ (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt')

16+import System.Environment (getArgs)

17+import Text.Read (readMaybe)

18+

19+import Gauge

20+

21+-------------------------------------------------------------------------------

22+-- Parse custom CLI options

23+-------------------------------------------------------------------------------

24+

25+data BenchOpts = StreamSize Int deriving Show

26+

27+options :: [OptDescr BenchOpts]

28+options =

29+ [

30+ Option [] ["stream-size"] (ReqArg getSize "COUNT") "Stream element count"

31+ ]

32+

33+ where

34+

35+ getSize :: String -> BenchOpts

36+ getSize size =

37+ case (readMaybe size :: Maybe Int) of

38+ Just x -> StreamSize x

39+ Nothing -> error "Stream size must be numeric"

40+

41+deleteOptArgs

42+ :: (Maybe String, Maybe String) -- (prev, yielded)

43+ -> String

44+ -> (Maybe String, Maybe String)

45+deleteOptArgs (Nothing, _) opt =

46+ if opt == "--stream-size"

47+ then (Just opt, Nothing)

48+ else (Just opt, Just opt)

49+

50+deleteOptArgs (Just prev, _) opt =

51+ if opt == "--stream-size" || prev == "--stream-size"

52+ then (Just opt, Nothing)

53+ else (Just opt, Just opt)

54+

55+parseCLIOpts :: Int -> IO (Int, Config, [String])

56+parseCLIOpts defaultStreamSize = do

57+ args <- getArgs

58+

59+ -- Parse custom options

60+ let (opts, _, _, errs) = getOpt' Permute options args

61+ when (not $ null errs) $ error $ concat errs

62+ (streamSize, args') <- evaluate $

63+ case opts of

64+ StreamSize x : _ ->

65+ -- Hack! remove the option and its argument from args

66+ -- getOpt should have a way to return the unconsumed args in

67+ -- correct order.

68+ let newArgs =

69+ catMaybes

70+ $ map snd

71+ $ scanl' deleteOptArgs (Nothing, Nothing) args

72+ in (x, newArgs)

73+ _ -> (defaultStreamSize, args)

74+

75+ -- Parse gauge options

76+ let config = defaultConfig

77+ { timeLimit = Just 1

78+ , minDuration = 0

79+ , includeFirstIter = streamSize > defaultStreamSize

80+ }

81+ let (cfg, benches) = parseWith config args'

82+ return (streamSize, cfg, benches)

benchmark/Linear.hs+9−15

@@ -12,10 +12,10 @@

12

13import Control.DeepSeq (NFData(..), deepseq)

14import Data.Functor.Identity (Identity, runIdentity)

15−import System.Random (randomRIO)

16import Data.Monoid (Last(..))

15import Data.Monoid (Last(..))

17−import System.Environment (getArgs)

16+import System.Random (randomRIO)

18−import Text.Read (readMaybe)

17+

18+import Common (parseCLIOpts)

19

20import qualified GHC.Exts as GHC

21import qualified Streamly.Benchmark.Prelude as Ops

@@ -121,13 +121,14 @@ mkListString value = "[1" ++ concat (replicate value ",1") ++ "]"

121mkList :: Int -> [Int]

122mkList value = [1..value]

123

124+defaultStreamSize :: Int

125+defaultStreamSize = 100000

126+

124main :: IO ()

127main :: IO ()

125main = do

128main = do

126− -- Basement.Terminal.initialize required?

129+ -- XXX Fix indentation

127− args <- getArgs

130+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize

128− let (value, args') = parseValue args

129− (cfg, extra) = parseWith defaultConfig args'

130− runMode (mode cfg) cfg extra

131+ runMode (mode cfg) cfg benches

131 [ bgroup "serially"

132 [ bgroup "serially"

132 [ bgroup "pure"

133 [ bgroup "pure"

133 [ benchPureSink value "id" id

134 [ benchPureSink value "id" id

@@ -474,10 +475,3 @@ main = do

474 ]

475 ]

476 ]

477 ]

477− where

478− defaultValue = 100000

479− parseValue [] = (defaultValue, [])

480− parseValue a@(x:xs) =

481− case (readMaybe x :: Maybe Int) of

482− Just value -> (value, xs)

483− Nothing -> (defaultValue, a)

benchmark/LinearAsync.hs+10−21

@@ -9,13 +9,14 @@

9import Control.DeepSeq (NFData)

10-- import Data.Functor.Identity (Identity, runIdentity)

11import System.Random (randomRIO)

12−import Text.Read (readMaybe)

12+

13−import System.Environment (getArgs)

13+import Common (parseCLIOpts)

14−import qualified Streamly.Benchmark.Prelude as Ops

15

14

16import Streamly

15import Streamly

17import Gauge

16import Gauge

18

17

18+import qualified Streamly.Benchmark.Prelude as Ops

19+

19-- We need a monadic bind here to make sure that the function f does not get

20-- We need a monadic bind here to make sure that the function f does not get

20-- completely optimized out by the compiler in some cases.

21-- completely optimized out by the compiler in some cases.

21--

22--

@@ -43,13 +44,14 @@ _benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark

43_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)

44_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)

44-}

45-}

45

46

47+defaultStreamSize :: Int

48+defaultStreamSize = 10000

49+

46main :: IO ()

50main :: IO ()

47main = do

51main = do

48− -- Basement.Terminal.initialize required?

52+ -- XXX Fix indentation

49− args <- getArgs

53+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize

50− let (value, args') = parseValue args

51− (cfg, extra) = parseWith (newConfig value) args'

52− runMode (mode cfg) cfg extra

54+ runMode (mode cfg) cfg benches

53 [ bgroup "asyncly"

55 [ bgroup "asyncly"

54 [ benchSrcIO asyncly "unfoldr" (Ops.sourceUnfoldr value)

56 [ benchSrcIO asyncly "unfoldr" (Ops.sourceUnfoldr value)

55 , benchSrcIO asyncly "unfoldrM" (Ops.sourceUnfoldrM value)

57 , benchSrcIO asyncly "unfoldrM" (Ops.sourceUnfoldrM value)

@@ -133,16 +135,3 @@ main = do

133 (Ops.concatStreamsWith parallel (value `div` 10) 10)

135 (Ops.concatStreamsWith parallel (value `div` 10) 10)

134 ]

136 ]

135 ]

137 ]

136− where

137− defaultValue = 10000

138− parseValue [] = (defaultValue, [])

139− parseValue a@(x:xs) =

140− case (readMaybe x :: Maybe Int) of

141− Just value -> (value, xs)

142− Nothing -> (defaultValue, a)

143− newConfig value =

144− defaultConfig

145− { timeLimit = Just 1

146− , minDuration = 0

147− , includeFirstIter = value >= 10000000

148− }

benchmark/LinearRate.hs+10−16

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2-- |

1-- |

3-- Module : Main

2-- Module : Main

@@ -11,13 +10,14 @@

11

10

12-- import Data.Functor.Identity (Identity, runIdentity)

11-- import Data.Functor.Identity (Identity, runIdentity)

13import System.Random (randomRIO)

12import System.Random (randomRIO)

14−import qualified Streamly.Benchmark.Prelude as Ops

13+

15−import System.Environment (getArgs)

14+import Common (parseCLIOpts)

16−import Text.Read (readMaybe)

17

15

18import Streamly

16import Streamly

19import Gauge

17import Gauge

20

18

19+import qualified Streamly.Benchmark.Prelude as Ops

20+

21-- | Takes a source, and uses it with a default drain/fold method.

22{-# INLINE benchSrcIO #-}

23benchSrcIO

@@ -33,13 +33,14 @@ _benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark

33_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)

34-}

35

36+defaultStreamSize :: Int

37+defaultStreamSize = 100000

38+

36main :: IO ()

39main :: IO ()

37main = do

40main = do

38− -- Basement.Terminal.initialize required?

41+ -- XXX Fix indentation

39− args <- getArgs

42+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize

40− let (value, args') = parseValue args

41− (cfg, extra) = parseWith defaultConfig args'

42− runMode (mode cfg) cfg extra

43+ runMode (mode cfg) cfg benches

43 -- XXX arbitrarily large rate should be the same as rate Nothing

44 -- XXX arbitrarily large rate should be the same as rate Nothing

44 [ bgroup "avgrate"

45 [ bgroup "avgrate"

45 [ bgroup "asyncly"

46 [ bgroup "asyncly"

@@ -65,10 +66,3 @@ main = do

65 ]

66 ]

67 ]

68 ]

68− where

69− defaultValue = 100000

70− parseValue [] = (defaultValue, [])

71− parseValue a@(x:xs) =

72− case (readMaybe x :: Maybe Int) of

73− Just value -> (value, xs)

74− Nothing -> (defaultValue, a)

benchmark/Nested.hs+11−16

@@ -8,11 +8,13 @@

8import Control.DeepSeq (NFData)

9import Data.Functor.Identity (Identity, runIdentity)

10import System.Random (randomRIO)

11−import qualified NestedOps as Ops

11+

12+import Common (parseCLIOpts)

13+

12import Streamly

14import Streamly

13import Gauge

15import Gauge

14−import System.Environment (getArgs)

16+

15−import Text.Read (readMaybe)

17+import qualified NestedOps as Ops

16

18

17benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark

19benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark

18benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f

20benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f

@@ -20,14 +22,14 @@ benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f

20_benchId :: (NFData b) => String -> (Int -> Identity b) -> Benchmark

22_benchId :: (NFData b) => String -> (Int -> Identity b) -> Benchmark

21_benchId name f = bench name $ nf (\g -> runIdentity (g 1)) f

23_benchId name f = bench name $ nf (\g -> runIdentity (g 1)) f

22

24

25+defaultStreamSize :: Int

26+defaultStreamSize = 100000

27+

23main :: IO ()

28main :: IO ()

24main = do

29main = do

25− -- TBD Study scaling with 10, 100, 1000 loop iterations

30+ -- XXX Fix indentation

26− -- Basement.Terminal.initialize required?

31+ (linearCount, cfg, benches) <- parseCLIOpts defaultStreamSize

27− args <- getArgs

28− let (linearCount, args') = parseValue args

29− (cfg, extra) = parseWith defaultConfig args'

30− runMode (mode cfg) cfg extra

32+ runMode (mode cfg) cfg benches

31 [ bgroup "serially"

33 [ bgroup "serially"

32 [ benchIO "toNullAp" $ Ops.toNullAp linearCount serially

34 [ benchIO "toNullAp" $ Ops.toNullAp linearCount serially

33 , benchIO "toNull" $ Ops.toNull linearCount serially

35 , benchIO "toNull" $ Ops.toNull linearCount serially

@@ -56,10 +58,3 @@ main = do

56 [ benchIO "toNullAp" $ Ops.toNullAp linearCount zipSerially

58 [ benchIO "toNullAp" $ Ops.toNullAp linearCount zipSerially

57 ]

59 ]

58 ]

60 ]

59− where

60− defaultValue = 100000

61− parseValue [] = (defaultValue, [])

62− parseValue a@(x:xs) =

63− case (readMaybe x :: Maybe Int) of

64− Just value -> (value, xs)

65− Nothing -> (defaultValue, a)

benchmark/NestedConcurrent.hs+11−16