bf39d27 · streamly · git.iko.soy

benchmark/Adaptive.hs+1−1

compare with master

unifiedsplit

@@ -78,7 +78,7 @@ randomVar :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()

78randomVar = run (low,high) (low,high)

79

80main :: IO ()

81−main = do

81+main =

82 defaultMain

83 [

84 bgroup "serialConstantSlowConsumer"

benchmark/BaseStreams.hs+1−1

@@ -31,7 +31,7 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)

31-}

32

33main :: IO ()

34−main = do

34+main =

35 defaultMain

36 [ bgroup "streamD"

37 [ bgroup "generation"

benchmark/Chart.hs+9−9

@@ -55,10 +55,10 @@ parseBench = do

55 Just "nested" -> setBenchType Nested

56 Just "base" -> setBenchType Base

57 Just str -> do

58− liftIO $ putStrLn $ "unrecognized benchmark type " ++ str

58+ liftIO $ putStrLn $ "unrecognized benchmark type " <> str

59 mzero

60 Nothing -> do

61− liftIO $ putStrLn $ "please provide a benchmark type "

61+ liftIO $ putStrLn "please provide a benchmark type "

62 mzero

63

64-- totally imperative style option parsing

@@ -71,13 +71,13 @@ parseOptions = do

71 Just "--graphs" -> setGenGraphs True

72 Just "--benchmark" -> parseBench

73 Just str -> do

74− liftIO $ putStrLn $ "Unrecognized option " ++ str

74+ liftIO $ putStrLn $ "Unrecognized option " <> str

75 mzero

76 Nothing -> return ()

77 fmap snd get

78

79ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->

80− putStrLn $ "Failed with error:\n" ++ err ++ "\nSkipping.")

80+ putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")

81

82------------------------------------------------------------------------------

83-- Linear composition charts

@@ -88,7 +88,7 @@ makeLinearGraphs cfg inputFile = do

88 ignoringErr $ graph inputFile "operations" $ cfg

89 { title = Just "Streamly operations"

90 , classifyBenchmark = \b ->

91− if (not $ "serially/" `isPrefixOf` b)

91+ if not ("serially/" `isPrefixOf` b)

92 || "/generation" `isInfixOf` b

93 || "/compose" `isInfixOf` b

94 || "/concat" `isSuffixOf` b

@@ -120,7 +120,7 @@ makeLinearGraphs cfg inputFile = do

120------------------------------------------------------------------------------

121

122makeNestedGraphs :: Config -> String -> IO ()

123−makeNestedGraphs cfg inputFile = do

123+makeNestedGraphs cfg inputFile =

124 ignoringErr $ graph inputFile "nested-serial-diff" $ cfg

125 { title = Just "Nested serial"

126 , classifyBenchmark = \b ->

@@ -165,10 +165,10 @@ benchShow Options{..} cfg func inp out =

165 { selectBenchmarks =

166 \f ->

167 reverse

168− $ map fst

168+ $ fmap fst

169 $ either

170 (const $ either error id $ f $ ColumnIndex 0)

171− (sortBy (comparing snd))

171+ (sortOn snd)

172 $ f $ ColumnIndex 1

173 }

174

@@ -181,7 +181,7 @@ main = do

181 Nothing -> do

182 putStrLn "cannot parse options"

183 return ()

184− Just opts@Options{..} -> do

184+ Just opts@Options{..} ->

185 case benchType of

186 Linear -> benchShow opts cfg makeLinearGraphs

187 "charts/linear/results.csv"

benchmark/Linear.hs+5−5

@@ -37,12 +37,12 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)

37-}

38

39main :: IO ()

40−main = do

40+main =

41 defaultMain

42 [ bgroup "serially"

43 [ bgroup "generation"

44 [ -- Most basic, barely stream continuations running

45− benchSrcIO serially "unfoldr" $ Ops.sourceUnfoldr

45+ benchSrcIO serially "unfoldr" Ops.sourceUnfoldr

46 , benchSrcIO serially "unfoldrM" Ops.sourceUnfoldrM

47 , benchSrcIO serially "fromList" Ops.sourceFromList

48 , benchSrcIO serially "fromListM" Ops.sourceFromListM

@@ -91,7 +91,7 @@ main = do

91 , benchIO "mapMaybe" Ops.mapMaybe

92 , benchIO "mapMaybeM" Ops.mapMaybeM

93 , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->

94− (Ops.sequence serially) (Ops.sourceUnfoldrMAction n)

94+ Ops.sequence serially (Ops.sourceUnfoldrMAction n)

95 , benchIO "findIndices" Ops.findIndices

96 , benchIO "elemIndices" Ops.elemIndices

97 -- , benchIO "concat" Ops.concat

@@ -107,8 +107,8 @@ main = do

107 , benchIO "dropWhile-true" Ops.dropWhileTrue

108 , benchIO "dropWhileM-true" Ops.dropWhileMTrue

109 ]

110− , benchIO "zip" $ Ops.zip

110+ , benchIO "zip" Ops.zip

111− , benchIO "zipM" $ Ops.zipM

111+ , benchIO "zipM" Ops.zipM

112 , bgroup "compose"

113 [ benchIO "mapM" Ops.composeMapM

114 , benchIO "map-with-all-in-filter" Ops.composeMapAllInFilter

benchmark/LinearAsync.hs+3−3

@@ -37,7 +37,7 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)

37-}

38

39main :: IO ()

40−main = do

40+main =

41 defaultMain

42 [ bgroup "asyncly"

43 [ -- benchIO "unfoldr" $ Ops.toNull asyncly

@@ -86,7 +86,7 @@ main = do

86 , benchSrcIO parallely "foldMapWithM" Ops.sourceFoldMapWithM

87 , benchIO "mapM" $ Ops.mapM parallely

88 -- Zip has only one parallel flavor

89− , benchIO "zip" $ Ops.zipAsync

89+ , benchIO "zip" Ops.zipAsync

90− , benchIO "zipM" $ Ops.zipAsyncM

90+ , benchIO "zipM" Ops.zipAsyncM

91 ]

92 ]

benchmark/LinearOps.hs+12−24

@@ -10,10 +10,11 @@

10

11module LinearOps where

12

13+import Control.Monad (when)

13import Data.Maybe (fromJust)

14import Data.Maybe (fromJust)

14import Prelude

15import Prelude

15 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (<=),

16 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (<=),

16− subtract, undefined, Maybe(..), odd, Bool, not)

17+ subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry)

17

18

18import qualified Streamly as S

19import qualified Streamly as S

19import qualified Streamly.Prelude as S

20import qualified Streamly.Prelude as S

@@ -74,7 +75,7 @@ sourceUnfoldr n = S.unfoldr step n

74 step cnt =

75 step cnt =

75 if cnt > n + value

76 if cnt > n + value

76 then Nothing

77 then Nothing

77− else (Just (cnt, cnt + 1))

78+ else Just (cnt, cnt + 1)

78

79

79{-# INLINE sourceUnfoldrM #-}

80{-# INLINE sourceUnfoldrM #-}

80sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int

81sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int

@@ -154,32 +155,19 @@ uncons s = do

154

155

155{-# INLINE init #-}

156{-# INLINE init #-}

156init :: Monad m => Stream m a -> m ()

157init :: Monad m => Stream m a -> m ()

157−init s = do

158− r <- S.init s

159− case r of

160− Nothing -> return ()

161− Just x -> S.runStream x

158+init s = S.init s >>= Prelude.mapM_ S.runStream

162

159

163{-# INLINE tail #-}

160{-# INLINE tail #-}

164tail :: Monad m => Stream m a -> m ()

161tail :: Monad m => Stream m a -> m ()

165−tail s = do

162+tail s = S.tail s >>= Prelude.mapM_ tail

166− r <- S.tail s

167− case r of

168− Nothing -> return ()

169− Just x -> tail x

170

163

171{-# INLINE nullHeadTail #-}

164{-# INLINE nullHeadTail #-}

172nullHeadTail :: Monad m => Stream m Int -> m ()

165nullHeadTail :: Monad m => Stream m Int -> m ()

173nullHeadTail s = do

166nullHeadTail s = do

174 r <- S.null s

167 r <- S.null s

175− if not r

168+ when (not r) $ do

176− then do

177 _ <- S.head s

169 _ <- S.head s

178− t <- S.tail s

179− case t of

180− Nothing -> return ()

181− Just x -> nullHeadTail x

170+ S.tail s >>= Prelude.mapM_ nullHeadTail

182− else return ()

183

171

184mapM_ = S.mapM_ (\_ -> return ())

172mapM_ = S.mapM_ (\_ -> return ())

185toList = S.toList

173toList = S.toList

@@ -254,7 +242,7 @@ mapM t = transform . t . S.mapM return

254mapMaybe = transform . S.mapMaybe

242mapMaybe = transform . S.mapMaybe

255 (\x -> if Prelude.odd x then Nothing else Just ())

243 (\x -> if Prelude.odd x then Nothing else Just ())

256mapMaybeM = transform . S.mapMaybeM

244mapMaybeM = transform . S.mapMaybeM

257− (\x -> if Prelude.odd x then (return Nothing) else return $ Just ())

245+ (\x -> if Prelude.odd x then return Nothing else return $ Just ())

258sequence t = transform . t . S.sequence

246sequence t = transform . t . S.sequence

259filterEven = transform . S.filter even

247filterEven = transform . S.filter even

260filterAllOut = transform . S.filter (> maxValue)

248filterAllOut = transform . S.filter (> maxValue)

@@ -285,19 +273,19 @@ zipAsync, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()

285zip src = do

273zip src = do

286 r <- S.tail src

274 r <- S.tail src

287 let src1 = fromJust r

275 let src1 = fromJust r

288− transform $ (S.zipWith (,) src src1)

276+ transform (S.zipWith (,) src src1)

289zipM src = do

277zipM src = do

290 r <- S.tail src

278 r <- S.tail src

291 let src1 = fromJust r

279 let src1 = fromJust r

292− transform $ (S.zipWithM (\a b -> return (a,b)) src src1)

280+ transform (S.zipWithM (curry return) src src1)

293zipAsync src = do

281zipAsync src = do

294 r <- S.tail src

282 r <- S.tail src

295 let src1 = fromJust r

283 let src1 = fromJust r

296− transform $ (S.zipAsyncWith (,) src src1)

284+ transform (S.zipAsyncWith (,) src src1)

297zipAsyncM src = do

285zipAsyncM src = do

298 r <- S.tail src

286 r <- S.tail src

299 let src1 = fromJust r

287 let src1 = fromJust r

300− transform $ (S.zipAsyncWithM (\a b -> return (a,b)) src src1)

288+ transform (S.zipAsyncWithM (curry return) src src1)

301concat _n = return ()

289concat _n = return ()

302

290

303-------------------------------------------------------------------------------

291-------------------------------------------------------------------------------

benchmark/LinearRate.hs+1−1

@@ -31,7 +31,7 @@ _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)

31-}

32

33main :: IO ()

34−main = do

34+main =

35 defaultMain

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

37 [ bgroup "avgrate"

benchmark/Nested.hs+1−1

@@ -19,7 +19,7 @@ _benchId :: (NFData b) => String -> (Int -> Identity b) -> Benchmark

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

20

21main :: IO ()

22−main = do

22+main =

23 -- TBD Study scaling with 10, 100, 1000 loop iterations

24 defaultMain

25 [ bgroup "serially"

benchmark/NestedOps.hs+5−5

@@ -48,7 +48,7 @@ sourceUnfoldr start n = S.unfoldr step start

48 step cnt =

49 if cnt > start + n

50 then Nothing

51− else (Just (cnt, cnt + 1))

51+ else Just (cnt, cnt + 1)

52

53{-# INLINE runStream #-}

54runStream :: Monad m => Stream m a -> m ()

@@ -98,7 +98,7 @@ filterAllOut t start = runStream . t $ do

98 x <- source start prodCount

99 y <- source start prodCount

100 let s = x + y

101− if (s < 0)

101+ if s < 0

102 then return s

103 else S.nil

104

@@ -110,7 +110,7 @@ filterAllIn t start = runStream . t $ do

110 x <- source start prodCount

111 y <- source start prodCount

112 let s = x + y

113− if (s > 0)

113+ if s > 0

114 then return s

115 else S.nil

116

@@ -122,7 +122,7 @@ filterSome t start = runStream . t $ do

122 x <- source start prodCount

123 y <- source start prodCount

124 let s = x + y

125− if (s > 1100000)

125+ if s > 1100000

126 then return s

127 else S.nil

128

@@ -135,7 +135,7 @@ breakAfterSome t start = do

135 x <- source start prodCount

136 y <- source start prodCount

137 let s = x + y

138− if (s > 1100000)

138+ if s > 1100000

139 then error "break"

140 else return s

141 return ()

benchmark/StreamDOps.hs+7−11

@@ -9,9 +9,10 @@

9

10module StreamDOps where

11

12+import Control.Monad (when)

12import Prelude

13import Prelude

13 (Monad, Int, (+), ($), (.), return, (>), even, (<=),

14 (Monad, Int, (+), ($), (.), return, (>), even, (<=),

14− subtract, undefined, Maybe(..), not)

15+ subtract, undefined, Maybe(..), not, mapM_, (>>=))

15

16

16import qualified Streamly.Streams.StreamD as S

17import qualified Streamly.Streams.StreamD as S

17

18

@@ -76,7 +77,7 @@ sourceUnfoldr n = S.unfoldr step n

76 step cnt =

77 step cnt =

77 if cnt > n + value

78 if cnt > n + value

78 then Nothing

79 then Nothing

79− else (Just (cnt, cnt + 1))

80+ else Just (cnt, cnt + 1)

80

81

81{-# INLINE sourceUnfoldrM #-}

82{-# INLINE sourceUnfoldrM #-}

82sourceUnfoldrM :: Monad m => Int -> Stream m Int

83sourceUnfoldrM :: Monad m => Int -> Stream m Int

@@ -97,7 +98,7 @@ sourceFromList n = S.fromList [n..n+value]

97

98

98{-# INLINE source #-}

99{-# INLINE source #-}

99source :: Monad m => Int -> Stream m Int

100source :: Monad m => Int -> Stream m Int

100−source n = sourceUnfoldrM n

101+source = sourceUnfoldrM

101

102

102-------------------------------------------------------------------------------

103-------------------------------------------------------------------------------

103-- Elimination

104-- Elimination

@@ -115,14 +116,9 @@ uncons s = do

115 Just (_, t) -> uncons t

116 Just (_, t) -> uncons t

116nullHeadTail s = do

117nullHeadTail s = do

117 r <- S.null s

118 r <- S.null s

118− if not r

119+ when (not r) $ do

119− then do

120 _ <- S.head s

121− t <- S.tail s

122− case t of

123− Nothing -> return ()

124− Just x -> nullHeadTail x

121+ S.tail s >>= mapM_ nullHeadTail

125− else return ()

126toList = S.toList

122toList = S.toList

127foldl = S.foldl' (+) 0

123foldl = S.foldl' (+) 0

128last = S.last

124last = S.last

@@ -151,7 +147,7 @@ dropWhileTrue = transform . S.dropWhile (<= maxValue)

151-- Zipping and concat

147-- Zipping and concat

152-------------------------------------------------------------------------------

148-------------------------------------------------------------------------------

153

149

154−zip src = transform $ (S.zipWith (,) src src)

150+zip src = transform $ S.zipWith (,) src src

155-- concat _n = return ()

151-- concat _n = return ()

156

152

157-------------------------------------------------------------------------------

153-------------------------------------------------------------------------------

benchmark/StreamKOps.hs+12−22

@@ -9,9 +9,10 @@

9

10module StreamKOps where

11

12+import Control.Monad (when)

12import Prelude

13import Prelude

13 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=),

14 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=),

14− subtract, undefined, Maybe(..), not)

15+ subtract, undefined, Maybe(..), not, mapM_, (>>=))

15

16

16import qualified Streamly.Streams.StreamK as S

17import qualified Streamly.Streams.StreamK as S

17import qualified Streamly.Streams.Prelude as S

18import qualified Streamly.Streams.Prelude as S

@@ -76,7 +77,7 @@ sourceUnfoldr n = S.unfoldr step n

76 step cnt =

77 step cnt =

77 if cnt > n + value

78 if cnt > n + value

78 then Nothing

79 then Nothing

79− else (Just (cnt, cnt + 1))

80+ else Just (cnt, cnt + 1)

80

81

81{-# INLINE sourceUnfoldrM #-}

82{-# INLINE sourceUnfoldrM #-}

82sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int

83sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int

@@ -105,15 +106,15 @@ sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])

105

106

106{-# INLINE sourceFoldMapWith #-}

107{-# INLINE sourceFoldMapWith #-}

107sourceFoldMapWith :: Int -> Stream m Int

108sourceFoldMapWith :: Int -> Stream m Int

108−sourceFoldMapWith n = S.foldMapWith (S.serial) S.yield [n..n+value]

109+sourceFoldMapWith n = S.foldMapWith S.serial S.yield [n..n+value]

109

110

110{-# INLINE sourceFoldMapWithM #-}

111{-# INLINE sourceFoldMapWithM #-}

111sourceFoldMapWithM :: Monad m => Int -> Stream m Int

112sourceFoldMapWithM :: Monad m => Int -> Stream m Int

112−sourceFoldMapWithM n = S.foldMapWith (S.serial) (S.yieldM . return) [n..n+value]

113+sourceFoldMapWithM n = S.foldMapWith S.serial (S.yieldM . return) [n..n+value]

113

114

114{-# INLINE source #-}

115{-# INLINE source #-}

115source :: S.MonadAsync m => Int -> Stream m Int

116source :: S.MonadAsync m => Int -> Stream m Int

116−source n = sourceUnfoldrM n

117+source = sourceUnfoldrM

117

118

118-------------------------------------------------------------------------------

119-------------------------------------------------------------------------------

119-- Elimination

120-- Elimination

@@ -133,31 +134,20 @@ uncons s = do

133{-# INLINE init #-}

134{-# INLINE init #-}

134init :: (Monad m, S.IsStream t) => t m a -> m ()

135init :: (Monad m, S.IsStream t) => t m a -> m ()

135init s = do

136init s = do

136− r <- S.init s

137+ t <- S.init s

137− case r of

138− Nothing -> return ()

139− Just x -> S.runStream x

138+ mapM_ S.runStream t

140

139

141{-# INLINE tail #-}

140{-# INLINE tail #-}

142tail :: (Monad m, S.IsStream t) => t m a -> m ()

141tail :: (Monad m, S.IsStream t) => t m a -> m ()

143−tail s = do

144− r <- S.tail s

142+tail s = S.tail s >>= mapM_ tail

145− case r of

146− Nothing -> return ()

147− Just x -> tail x

148

143

149-- | If the stream is not null get its head and tail and then do the same to

144-- | If the stream is not null get its head and tail and then do the same to

150-- the tail.

145-- the tail.

151nullHeadTail s = do

146nullHeadTail s = do

152 r <- S.null s

147 r <- S.null s

153− if not r

148+ when (not r) $ do

154− then do

155 _ <- S.head s

149 _ <- S.head s

156− t <- S.tail s

157− case t of

158− Nothing -> return ()

159− Just x -> nullHeadTail x

150+ S.tail s >>= mapM_ nullHeadTail

160− else return ()

161

151

162toList = S.toList

152toList = S.toList

163foldl = S.foldl' (+) 0

153foldl = S.foldl' (+) 0

@@ -187,7 +177,7 @@ dropWhileTrue = transform . S.dropWhile (<= maxValue)

187-- Zipping and concat

177-- Zipping and concat

188-------------------------------------------------------------------------------

178-------------------------------------------------------------------------------

189

179

190−zip src = transform $ (S.zipWith (,) src src)

180+zip src = transform $ S.zipWith (,) src src

191concat _n = return ()

181concat _n = return ()

192

182

193-------------------------------------------------------------------------------

183-------------------------------------------------------------------------------