benchmark/Streamly/Benchmark/Data/Parser.hs · streamly

git.iko.soy/streamly

on 19db3e2 help sign in

streamly/benchmark/Streamly/Benchmark/Data/Parser.hs

340 lines 11 kB history raw

1-- |

2-- Module : Streamly.Benchmark.Data.Parser

4--

5-- License : BSD-3-Clause

6-- Maintainer : streamly@composewell.com

8{-# LANGUAGE FlexibleContexts #-}

10module Main

11 (

12 main

13 ) where

15import Control.DeepSeq (NFData(..))

16import Control.Monad.Catch (MonadCatch)

17import Data.Foldable (asum)

18import Data.Functor (($>))

19import Data.Monoid (Sum(..))

20import System.Random (randomRIO)

21import Prelude

22 hiding (any, all, take, sequence, sequence_, sequenceA, takeWhile)

24import qualified Data.Traversable as TR

25import qualified Data.Foldable as F

26import qualified Control.Applicative as AP

27import qualified Streamly.Prelude as S

28import qualified Streamly.Internal.Data.Fold as FL

29import qualified Streamly.Internal.Data.Parser as PR

30import qualified Streamly.Internal.Data.Stream.IsStream as IP

32import Gauge

33import Streamly.Prelude (SerialT)

34import Streamly.Benchmark.Common

36-------------------------------------------------------------------------------

37-- Utilities

38-------------------------------------------------------------------------------

40-- XXX these can be moved to the common module

42{-# INLINE sourceUnfoldrM #-}

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

44sourceUnfoldrM value n = S.unfoldrM step n

45 where

46 step cnt =

47 if cnt > n + value

48 then return Nothing

49 else return (Just (cnt, cnt + 1))

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

52{-# INLINE benchIOSink #-}

53benchIOSink

54 :: (S.IsStream t, NFData b)

55 => Int -> String -> (t IO Int -> IO b) -> Benchmark

56benchIOSink value name f =

57 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value

59-------------------------------------------------------------------------------

60-- Parsers

61-------------------------------------------------------------------------------

63{-# INLINE takeBetween #-}

64takeBetween :: MonadCatch m => Int -> SerialT m a -> m ()

65takeBetween value = IP.parse (PR.takeBetween 0 value FL.drain)

67{-# INLINE takeEQ #-}

68takeEQ :: MonadCatch m => Int -> SerialT m a -> m ()

69takeEQ value = IP.parse (PR.takeEQ value FL.drain)

71{-# INLINE drainWhile #-}

72drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()

73drainWhile value = IP.parse (PR.drainWhile (<= value))

75{-# INLINE takeWhile #-}

76takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()

77takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)

79{-# INLINE groupBy #-}

80groupBy :: MonadCatch m => SerialT m Int -> m ()

81groupBy = IP.parse (PR.groupBy (<=) FL.drain)

83{-# INLINE wordBy #-}

84wordBy :: MonadCatch m => Int -> SerialT m Int -> m ()

85wordBy value = IP.parse (PR.wordBy (>= value) FL.drain)

87{-# INLINE manyWordByEven #-}

88manyWordByEven :: MonadCatch m => SerialT m Int -> m ()

89manyWordByEven = IP.parse (PR.many FL.drain (PR.wordBy (Prelude.even) FL.drain))

91{-# INLINE many #-}

92many :: MonadCatch m => SerialT m Int -> m Int

93many = IP.parse (PR.many FL.length (PR.satisfy (> 0)))

95{-# INLINE manyAlt #-}

96manyAlt :: MonadCatch m => SerialT m Int -> m Int

97manyAlt xs = do

98 x <- IP.parse (AP.many (PR.satisfy (> 0))) xs

99 return $ Prelude.length x

100

101{-# INLINE some #-}

102some :: MonadCatch m => SerialT m Int -> m Int

103some = IP.parse (PR.some FL.length (PR.satisfy (> 0)))

104

105{-# INLINE someAlt #-}

106someAlt :: MonadCatch m => SerialT m Int -> m Int

107someAlt xs = do

108 x <- IP.parse (AP.some (PR.satisfy (> 0))) xs

109 return $ Prelude.length x

110

111{-# INLINE manyTill #-}

112manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int

113manyTill value =

114 IP.parse (PR.manyTill FL.length (PR.satisfy (> 0)) (PR.satisfy (== value)))

115

116{-# INLINE splitAp #-}

117splitAp :: MonadCatch m

118 => Int -> SerialT m Int -> m ((), ())

119splitAp value =

120 IP.parse

121 ((,)

122 <$> PR.drainWhile (<= (value `div` 2))

123 <*> PR.drainWhile (<= value)

124 )

125

126{-# INLINE splitApBefore #-}

127splitApBefore :: MonadCatch m

128 => Int -> SerialT m Int -> m ()

129splitApBefore value =

130 IP.parse

131 ( PR.drainWhile (<= (value `div` 2))

132 *> PR.drainWhile (<= value)

133 )

134

135{-# INLINE splitApAfter #-}

136splitApAfter :: MonadCatch m

137 => Int -> SerialT m Int -> m ()

138splitApAfter value =

139 IP.parse

140 ( PR.drainWhile (<= (value `div` 2))

141 <* PR.drainWhile (<= value)

142 )

143

144{-# INLINE splitWith #-}

145splitWith :: MonadCatch m

146 => Int -> SerialT m Int -> m ((), ())

147splitWith value =

148 IP.parse

149 (PR.splitWith (,)

150 (PR.drainWhile (<= (value `div` 2)))

151 (PR.drainWhile (<= value))

152 )

153

154{-# INLINE split_ #-}

155split_ :: MonadCatch m

156 => Int -> SerialT m Int -> m ()

157split_ value =

158 IP.parse

159 (PR.split_

160 (PR.drainWhile (<= (value `div` 2)))

161 (PR.drainWhile (<= value))

162 )

163

164{-# INLINE sliceSepByP #-}

165sliceSepByP :: MonadCatch m

166 => Int -> SerialT m Int -> m()

167sliceSepByP value = IP.parse (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))

168

169{-# INLINE teeAllAny #-}

170teeAllAny :: MonadCatch m

171 => Int -> SerialT m Int -> m ((), ())

172teeAllAny value =

173 IP.parse

174 (PR.teeWith (,)

175 (PR.drainWhile (<= value))

176 (PR.drainWhile (<= value))

177 )

178

179{-# INLINE teeFstAllAny #-}

180teeFstAllAny :: MonadCatch m

181 => Int -> SerialT m Int -> m ((), ())

182teeFstAllAny value =

183 IP.parse

184 (PR.teeWithFst (,)

185 (PR.drainWhile (<= value))

186 (PR.drainWhile (<= value))

187 )

188

189{-# INLINE shortestAllAny #-}

190shortestAllAny :: MonadCatch m

191 => Int -> SerialT m Int -> m ()

192shortestAllAny value =

193 IP.parse

194 (PR.shortest

195 (PR.drainWhile (<= value))

196 (PR.drainWhile (<= value))

197 )

198

199{-# INLINE longestAllAny #-}

200longestAllAny :: MonadCatch m

201 => Int -> SerialT m Int -> m ()

202longestAllAny value =

203 IP.parse

204 (PR.longest

205 (PR.drainWhile (<= value))

206 (PR.drainWhile (<= value))

207 )

208

209-------------------------------------------------------------------------------

210-- Parsers in which -fspec-constr-recursive=16 is problematic

211-------------------------------------------------------------------------------

212

213-- XXX -fspec-constr-recursive=16 makes GHC go beserk when compiling these.

214-- We need to fix GHC so that we can have better control over that option or do

215-- not have to rely on it.

216--

217{-# INLINE lookAhead #-}

218lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()

219lookAhead value =

220 IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())

221

222{-# INLINE sequenceA #-}

223sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int

224sequenceA value xs = do

225 x <- IP.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs

226 return $ length x

227

228{-# INLINE sequenceA_ #-}

229sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()

230sequenceA_ value =

231 IP.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))

232

233{-# INLINE sequence #-}

234sequence :: MonadCatch m => Int -> SerialT m Int -> m Int

235sequence value xs = do

236 x <- IP.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs

237 return $ length x

238

239{-# INLINE sequence_ #-}

240sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()

241sequence_ value =

242 IP.parse (F.sequence_ $ replicate value (PR.satisfy (> 0)))

243

244{-# INLINE choice #-}

245choice :: MonadCatch m => Int -> SerialT m Int -> m Int

246choice value =

247 IP.parse (asum (replicate value (PR.satisfy (< 0)))

248 AP.<|> PR.satisfy (> 0))

249

250-------------------------------------------------------------------------------

251-- Stream transformation

252-------------------------------------------------------------------------------

253

254{-# INLINE parseMany #-}

255parseMany :: MonadCatch m => SerialT m Int -> m ()

256parseMany =

257 S.drain

258 . S.map getSum

259 . IP.parseMany (PR.fromFold $ FL.takeLE 2 FL.mconcat)

260 . S.map Sum

261

262{-# INLINE parseIterate #-}

263parseIterate :: MonadCatch m => SerialT m Int -> m ()

264parseIterate =

265 S.drain

266 . S.map getSum

267 . IP.parseIterate (PR.fromFold . FL.takeLE 2 . FL.sconcat) (Sum 0)

268 . S.map Sum

269

270-------------------------------------------------------------------------------

271-- Benchmarks

272-------------------------------------------------------------------------------

273

274moduleName :: String

275moduleName = "Data.Parser"

276

277o_1_space_serial :: Int -> [Benchmark]

278o_1_space_serial value =

279 [ benchIOSink value "takeBetween" $ takeBetween value

280 , benchIOSink value "takeEQ" $ takeEQ value

281 , benchIOSink value "takeWhile" $ takeWhile value

282 , benchIOSink value "drainWhile" $ drainWhile value

283 , benchIOSink value "groupBy" $ groupBy

284 , benchIOSink value "wordBy" $ wordBy value

285 , benchIOSink value "splitAp" $ splitAp value

286 , benchIOSink value "splitApBefore" $ splitApBefore value

287 , benchIOSink value "splitApAfter" $ splitApAfter value

288 , benchIOSink value "splitWith" $ splitWith value

289 , benchIOSink value "sliceSepByP" $ sliceSepByP value

290 , benchIOSink value "many" many

291 , benchIOSink value "many (wordBy even)" $ manyWordByEven

292 , benchIOSink value "some" some

293 , benchIOSink value "manyTill" $ manyTill value

294 , benchIOSink value "tee" $ teeAllAny value

295 , benchIOSink value "teeFst" $ teeFstAllAny value

296 , benchIOSink value "shortest" $ shortestAllAny value

297 , benchIOSink value "longest" $ longestAllAny value

298 , benchIOSink value "parseMany" parseMany

299 , benchIOSink value "parseIterate" parseIterate

300 ]

301

302o_n_heap_serial :: Int -> [Benchmark]

303o_n_heap_serial value =

304 [

305 -- lookahead benchmark holds the entire input till end

306 benchIOSink value "lookAhead" $ lookAhead value

307

308 -- accumulates the results in a list

309 , benchIOSink value "sequence" $ sequence value

310 , benchIOSink value "sequenceA" $ sequenceA value

311

312 -- XXX why should this take O(n) heap, it discards the results?

313 , benchIOSink value "sequence_" $ sequence_ value

314 , benchIOSink value "sequenceA_" $ sequenceA_ value

315 -- non-linear time complexity (parserD)

316 , benchIOSink value "split_" $ split_ value

317 -- XXX why O(n) heap?

318 , benchIOSink value "choice" $ choice value

319

320 -- These show non-linear time complexity.

321 -- They accumulate the results in a list.

322 , benchIOSink value "manyAlt" manyAlt

323 , benchIOSink value "someAlt" someAlt

324 ]

325

326-------------------------------------------------------------------------------

327-- Driver

328-------------------------------------------------------------------------------

329

330main :: IO ()

331main = do

332 (value, cfg, benches) <- parseCLIOpts defaultStreamSize

333 value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)

334

335 where

336

337 allBenchmarks value =

338 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)

339 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)

340 ]