benchmark/LinearAsync.hs · streamly

git.iko.soy/streamly

on f684e26 help sign in

streamly/benchmark/LinearAsync.hs

148 lines 6.7 kB history raw

1{-# LANGUAGE CPP #-}

2-- |

3-- Module : Main

5--

6-- License : BSD3

7-- Maintainer : streamly@composewell.com

9import Control.DeepSeq (NFData)

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

11import System.Random (randomRIO)

12import Text.Read (readMaybe)

13import System.Environment (getArgs)

14import qualified Streamly.Benchmark.Prelude as Ops

16import Streamly

17import Gauge

19-- 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--

22-- | Takes a fold method, and uses it with a default source.

23{-# INLINE benchIO #-}

24benchIO :: (IsStream t, NFData b) => Int -> String -> (t IO Int -> IO b) -> Benchmark

25benchIO value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source value

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

28{-# INLINE benchSrcIO #-}

29benchSrcIO

30 :: (t IO Int -> SerialT IO Int)

31 -> String

32 -> (Int -> t IO Int)

33 -> Benchmark

34benchSrcIO t name f

35 = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f

37{-# INLINE benchMonadicSrcIO #-}

38benchMonadicSrcIO :: String -> (Int -> IO ()) -> Benchmark

39benchMonadicSrcIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f

41{-

42_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark

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

44-}

46main :: IO ()

47main = do

48 -- Basement.Terminal.initialize required?

49 args <- getArgs

50 let (value, args') = parseValue args

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

52 runMode (mode cfg) cfg extra

53 [ bgroup "asyncly"

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

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

56 , benchSrcIO asyncly "fromFoldable" (Ops.sourceFromFoldable value)

57 , benchSrcIO asyncly "fromFoldableM" (Ops.sourceFromFoldableM value)

58 , benchSrcIO asyncly "foldMapWith" (Ops.sourceFoldMapWith value)

59 , benchSrcIO asyncly "foldMapWithM" (Ops.sourceFoldMapWithM value)

60 , benchSrcIO asyncly "foldMapM" (Ops.sourceFoldMapM value)

61 , benchIO value "map" $ Ops.map' asyncly 1

62 , benchIO value "fmap" $ Ops.fmap' asyncly 1

63 , benchIO value "mapM" $ Ops.mapM asyncly 1

64 , benchSrcIO asyncly "unfoldrM maxThreads 1"

65 (maxThreads 1 . Ops.sourceUnfoldrM value)

66 , benchSrcIO asyncly "unfoldrM maxBuffer 1 (x/10 ops)"

67 (maxBuffer 1 . Ops.sourceUnfoldrMN (value `div` 10))

68 , benchMonadicSrcIO "concatMapWith (2,x/2)"

69 (Ops.concatStreamsWith async 2 (value `div` 2))

70 , benchMonadicSrcIO "concatMapWith (x/2,2)"

71 (Ops.concatStreamsWith async (value `div` 2) 2)

72 ]

73 , bgroup "wAsyncly"

74 [ benchSrcIO wAsyncly "unfoldr" (Ops.sourceUnfoldr value)

75 , benchSrcIO wAsyncly "unfoldrM" (Ops.sourceUnfoldrM value)

76 , benchSrcIO wAsyncly "fromFoldable" (Ops.sourceFromFoldable value)

77 , benchSrcIO wAsyncly "fromFoldableM" (Ops.sourceFromFoldableM value)

78 , benchSrcIO wAsyncly "foldMapWith" (Ops.sourceFoldMapWith value)

79 , benchSrcIO wAsyncly "foldMapWithM" (Ops.sourceFoldMapWithM value)

80 , benchSrcIO wAsyncly "foldMapM" (Ops.sourceFoldMapM value)

81 , benchIO value "map" $ Ops.map' wAsyncly 1

82 , benchIO value "fmap" $ Ops.fmap' wAsyncly 1

83 , benchIO value "mapM" $ Ops.mapM wAsyncly 1

84 , benchMonadicSrcIO "concatMapWith (2,x/2)"

85 (Ops.concatStreamsWith wAsync 2 (value `div` 2))

86 , benchMonadicSrcIO "concatMapWith (x/2,2)"

87 (Ops.concatStreamsWith wAsync (value `div` 2) 2)

88 ]

89 -- unfoldr and fromFoldable are always serial and thereofore the same for

90 -- all stream types.

91 , bgroup "aheadly"

92 [ benchSrcIO aheadly "unfoldr" (Ops.sourceUnfoldr value)

93 , benchSrcIO aheadly "unfoldrM" (Ops.sourceUnfoldrM value)

94 , benchSrcIO aheadly "fromFoldableM" (Ops.sourceFromFoldableM value)

95 -- , benchSrcIO aheadly "foldMapWith" Ops.sourceFoldMapWith

96 , benchSrcIO aheadly "foldMapWithM" (Ops.sourceFoldMapWithM value)

97 , benchSrcIO aheadly "foldMapM" (Ops.sourceFoldMapM value)

98 , benchIO value "map" $ Ops.map' aheadly 1

99 , benchIO value "fmap" $ Ops.fmap' aheadly 1

100 , benchIO value "mapM" $ Ops.mapM aheadly 1

101 , benchSrcIO aheadly "unfoldrM maxThreads 1"

102 (maxThreads 1 . Ops.sourceUnfoldrM value)

103 , benchSrcIO aheadly "unfoldrM maxBuffer 1 (x/10 ops)"

104 (maxBuffer 1 . Ops.sourceUnfoldrMN (value `div` 10))

105 -- , benchSrcIO aheadly "fromFoldable" Ops.sourceFromFoldable

106 , benchMonadicSrcIO "concatMapWith (2,x/2)"

107 (Ops.concatStreamsWith ahead 2 (value `div` 2))

108 , benchMonadicSrcIO "concatMapWith (x/2,2)"

109 (Ops.concatStreamsWith ahead (value `div` 2) 2)

110 ]

111 -- XXX need to use smaller streams to finish in reasonable time

112 , bgroup "parallely"

113 [ benchSrcIO parallely "unfoldr" (Ops.sourceUnfoldr value)

114 , benchSrcIO parallely "unfoldrM" (Ops.sourceUnfoldrM value)

115 --, benchSrcIO parallely "fromFoldable" Ops.sourceFromFoldable

116 , benchSrcIO parallely "fromFoldableM" (Ops.sourceFromFoldableM value)

117 -- , benchSrcIO parallely "foldMapWith" Ops.sourceFoldMapWith

118 , benchSrcIO parallely "foldMapWithM" (Ops.sourceFoldMapWithM value)

119 , benchSrcIO parallely "foldMapM" (Ops.sourceFoldMapM value)

120 , benchIO value "map" $ Ops.map' parallely 1

121 , benchIO value "fmap" $ Ops.fmap' parallely 1

122 , benchIO value "mapM" $ Ops.mapM parallely 1

123 -- Zip has only one parallel flavor

124 , benchIO value "zip" Ops.zipAsync

125 , benchIO value "zipM" Ops.zipAsyncM

126 , benchIO value "zipAp" Ops.zipAsyncAp

127 -- Parallel stages in a pipeline

128 , benchIO value "parAppMap" Ops.parAppMap

129 , benchIO value "parAppSum" Ops.parAppSum

130 , benchMonadicSrcIO "concatMapWith (2,x/2)"

131 (Ops.concatStreamsWith parallel 2 (value `div` 2))

132 , benchMonadicSrcIO "concatMapWith (x/10,10)"

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

134 ]

135 ]

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 }