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

git.iko.soy/streamly

on efecb26 help sign in

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

437 lines 14 kB history raw

1-- |

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

4--

5-- License : BSD-3-Clause

6-- Maintainer : streamly@composewell.com

8-- BENCH_CHUNKED -> adaptC

9-- BENCH_CHUNKED_GENERIC -> adaptCG

10-- BENCH_SINGULAR -> adapt

12{-# LANGUAGE CPP #-}

13{-# LANGUAGE FlexibleContexts #-}

14{-# OPTIONS_GHC -Wno-orphans #-}

16module Main

17 (

18 main

19 ) where

21import Control.Applicative ((<|>))

22import Control.DeepSeq (NFData(..))

23import Control.Monad.IO.Class (MonadIO)

24import Data.Foldable (asum)

25#ifdef BENCH_CHUNKED

26import Streamly.Data.Array (Array, Unbox)

27#endif

28#ifdef BENCH_CHUNKED_GENERIC

29import Streamly.Data.Array.Generic (Array)

30import qualified Streamly.Internal.Data.Array.Generic as GenArr (chunksOf)

31#endif

32import Streamly.Internal.Data.Fold (Fold(..))

33import Streamly.Data.StreamK (StreamK)

34import Streamly.Internal.Data.Parser

35 (ParseError(..), Parser(..), Initial(..), Step(..))

36import Streamly.Internal.Data.Stream (Stream)

37import System.Random (randomRIO)

38import Prelude hiding

39 (any, all, take, sequence, sequence_, sequenceA, takeWhile)

41import qualified Control.Applicative as AP

42import qualified Data.Foldable as F

43import qualified Data.Traversable as TR

44import qualified Streamly.Data.Stream as Stream

45import qualified Streamly.Data.Fold as FL

46import qualified Streamly.Internal.Data.Fold as Fold

47import qualified Streamly.Data.Parser as PRD

48import qualified Streamly.Internal.Data.ParserK as PR

49import qualified Streamly.Internal.Data.StreamK as StreamK

51import Gauge

52import Streamly.Benchmark.Common

54-------------------------------------------------------------------------------

55-- CPP Helpers

56-------------------------------------------------------------------------------

58#ifdef BENCH_CHUNKED

60#define PARSE_OP StreamK.parseChunks

61#define FROM_PARSER adaptC

62#define INPUT (Array a)

63#define PARSE_ELEM (Array Int)

64#define CONSTRAINT_IO (MonadIO m, Unbox a)

65#define CONSTRAINT (Monad m, Unbox a)

66#define MODULE_NAME "ParserK.Chunked"

68#endif

70#ifdef BENCH_CHUNKED_GENERIC

72#define PARSE_OP StreamK.parseChunksGeneric

73#define FROM_PARSER adaptCG

74#define INPUT (Array a)

75#define PARSE_ELEM (Array Int)

76#define CONSTRAINT_IO (MonadIO m)

77#define CONSTRAINT (Monad m)

78#define MODULE_NAME "ParserK.Chunked.Generic"

80#endif

82#ifdef BENCH_SINGULAR

84#define PARSE_OP StreamK.parse

85#define FROM_PARSER adapt

86#define INPUT a

87#define PARSE_ELEM Int

88#define CONSTRAINT_IO (MonadIO m)

89#define CONSTRAINT (Monad m)

90#define MODULE_NAME "ParserK"

92#endif

94-------------------------------------------------------------------------------

95-- Utilities

96-------------------------------------------------------------------------------

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

100{-# INLINE sourceUnfoldrM #-}

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

102sourceUnfoldrM value n = Stream.unfoldrM step n

103 where

104 step cnt =

105 if cnt > n + value

106 then return Nothing

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

108

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

110{-# INLINE benchIOSink #-}

111benchIOSink

112 :: NFData b

113 => Int -> String -> (StreamK IO PARSE_ELEM -> IO b) -> Benchmark

114benchIOSink value name f =

115 bench name $ nfIO $ randomRIO (1,1)

116 >>= f

117 . StreamK.fromStream

118#ifdef BENCH_CHUNKED

119 . Stream.chunksOf 4000

120#endif

121#ifdef BENCH_CHUNKED_GENERIC

122 . GenArr.chunksOf 4000

123#endif

124 . sourceUnfoldrM value

125

126-------------------------------------------------------------------------------

127-- Parsers

128-------------------------------------------------------------------------------

129

130{-# INLINE one #-}

131one :: MonadIO m =>

132 Int -> StreamK m PARSE_ELEM -> m (Either ParseError (Maybe Int))

133one value = PARSE_OP p

134

135 where

136

137 p = do

138 m <- PR.FROM_PARSER (PRD.fromFold FL.one)

139 case m of

140 Just i -> if i >= value then pure m else p

141 Nothing -> pure Nothing

142

143{-# INLINE satisfy #-}

144satisfy :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m a

145satisfy = PR.FROM_PARSER . PRD.satisfy

146

147{-# INLINE takeWhile #-}

148takeWhile :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m ()

149takeWhile p = PR.FROM_PARSER $ PRD.takeWhile p FL.drain

150

151{-# INLINE takeWhileK #-}

152takeWhileK :: MonadIO m =>

153 Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

154takeWhileK value = PARSE_OP (takeWhile (<= value))

155

156{-# INLINE splitAp2 #-}

157splitAp2 :: MonadIO m

158 => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ((), ()))

159splitAp2 value =

160 PARSE_OP

161 ((,)

162 <$> takeWhile (<= (value `div` 2))

163 <*> takeWhile (<= value)

164 )

165

166{-# INLINE splitAp8 #-}

167splitAp8 :: MonadIO m

168 => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

169splitAp8 value =

170 PARSE_OP

171 ( (\() () () () () () () () -> ())

172 <$> takeWhile (<= ( value `div` 8))

173 <*> takeWhile (<= ((value * 2) `div` 8))

174 <*> takeWhile (<= ((value * 3) `div` 8))

175 <*> takeWhile (<= ((value * 4) `div` 8))

176 <*> takeWhile (<= ((value * 5) `div` 8))

177 <*> takeWhile (<= ((value * 6) `div` 8))

178 <*> takeWhile (<= ((value * 7) `div` 8))

179 <*> takeWhile (<= value)

180 )

181

182{-# INLINE sequenceA #-}

183sequenceA :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int

184sequenceA value xs = do

185 let parser = satisfy (> 0)

186 list = Prelude.replicate value parser

187 x <- PARSE_OP (TR.sequenceA list) xs

188 return $ Prelude.length x

189

190{-# INLINE sequenceA_ #-}

191sequenceA_ :: MonadIO m =>

192 Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

193sequenceA_ value xs = do

194 let parser = satisfy (> 0)

195 list = Prelude.replicate value parser

196 PARSE_OP (F.sequenceA_ list) xs

197

198{-# INLINE sequence #-}

199sequence :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int

200sequence value xs = do

201 let parser = satisfy (> 0)

202 list = Prelude.replicate value parser

203 x <- PARSE_OP (TR.sequence list) xs

204 return $ Prelude.length x

205

206{-# INLINE sequence_ #-}

207sequence_ :: MonadIO m =>

208 Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

209sequence_ value =

210 let parser = satisfy (> 0)

211 list = Prelude.replicate value parser

212 in PARSE_OP (F.sequence_ list)

213

214{-# INLINE takeWhileFailD #-}

215takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b

216takeWhileFailD predicate (Fold fstep finitial fextract) =

217 Parser step initial extract

218

219 where

220

221 initial = do

222 res <- finitial

223 return $ case res of

224 Fold.Partial s -> IPartial s

225 Fold.Done b -> IDone b

226

227 step s a =

228 if predicate a

229 then do

230 fres <- fstep s a

231 return

232 $ case fres of

233 Fold.Partial s1 -> Partial 0 s1

234 Fold.Done b -> Done 0 b

235 else return $ Error "fail"

236

237 extract s = fmap (Done 0) (fextract s)

238

239{-# INLINE takeWhileFail #-}

240takeWhileFail :: CONSTRAINT =>

241 (a -> Bool) -> Fold m a b -> PR.ParserK INPUT m b

242takeWhileFail p f = PR.FROM_PARSER (takeWhileFailD p f)

243

244{-# INLINE alt2 #-}

245alt2 :: MonadIO m

246 => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

247alt2 value =

248 PARSE_OP

249 ( takeWhileFail (<= (value `div` 2)) Fold.drain

250 <|> takeWhile (<= value)

251 )

252

253{-# INLINE alt8 #-}

254alt8 :: MonadIO m

255 => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

256alt8 value =

257 PARSE_OP

258 ( takeWhileFail (<= ( value `div` 8)) Fold.drain

259 <|> takeWhileFail (<= ((value * 2) `div` 8)) Fold.drain

260 <|> takeWhileFail (<= ((value * 3) `div` 8)) Fold.drain

261 <|> takeWhileFail (<= ((value * 4) `div` 8)) Fold.drain

262 <|> takeWhileFail (<= ((value * 5) `div` 8)) Fold.drain

263 <|> takeWhileFail (<= ((value * 6) `div` 8)) Fold.drain

264 <|> takeWhileFail (<= ((value * 7) `div` 8)) Fold.drain

265 <|> takeWhile (<= value)

266 )

267

268{-# INLINE alt16 #-}

269alt16 :: MonadIO m

270 => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

271alt16 value =

272 PARSE_OP

273 ( takeWhileFail (<= ( value `div` 16)) Fold.drain

274 <|> takeWhileFail (<= ((value * 2) `div` 16)) Fold.drain

275 <|> takeWhileFail (<= ((value * 3) `div` 16)) Fold.drain

276 <|> takeWhileFail (<= ((value * 4) `div` 16)) Fold.drain

277 <|> takeWhileFail (<= ((value * 5) `div` 16)) Fold.drain

278 <|> takeWhileFail (<= ((value * 6) `div` 16)) Fold.drain

279 <|> takeWhileFail (<= ((value * 7) `div` 16)) Fold.drain

280 <|> takeWhileFail (<= ((value * 8) `div` 16)) Fold.drain

281 <|> takeWhileFail (<= ((value * 9) `div` 16)) Fold.drain

282 <|> takeWhileFail (<= ((value * 10) `div` 16)) Fold.drain

283 <|> takeWhileFail (<= ((value * 11) `div` 16)) Fold.drain

284 <|> takeWhileFail (<= ((value * 12) `div` 16)) Fold.drain

285 <|> takeWhileFail (<= ((value * 13) `div` 16)) Fold.drain

286 <|> takeWhileFail (<= ((value * 14) `div` 16)) Fold.drain

287 <|> takeWhileFail (<= ((value * 15) `div` 16)) Fold.drain

288 <|> takeWhile (<= value)

289 )

290

291{-# INLINE manyAlt #-}

292manyAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int

293manyAlt xs = do

294 x <- PARSE_OP (AP.many (satisfy (> 0))) xs

295 return $ Prelude.length x

296

297{-# INLINE someAlt #-}

298someAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int

299someAlt xs = do

300 x <- PARSE_OP (AP.some (satisfy (> 0))) xs

301 return $ Prelude.length x

302

303{-# INLINE choice #-}

304choice :: MonadIO m =>

305 Int -> StreamK m PARSE_ELEM -> m (Either ParseError Int)

306choice value =

307 PARSE_OP (asum (replicate value (satisfy (< 0)))

308 AP.<|> satisfy (> 0))

309

310{-# INLINE monad2 #-}

311monad2 :: MonadIO m

312 => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

313monad2 value =

314 PARSE_OP $ do

315 takeWhile (<= (value `div` 2))

316 takeWhile (<= value)

317

318{-# INLINE monad4 #-}

319monad4 :: MonadIO m

320 => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

321monad4 value =

322 PARSE_OP $ do

323 takeWhile (<= ( value `div` 4))

324 takeWhile (<= ((value * 2) `div` 4))

325 takeWhile (<= ((value * 3) `div` 4))

326 takeWhile (<= value)

327

328{-# INLINE monad8 #-}

329monad8 :: MonadIO m

330 => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

331monad8 value =

332 PARSE_OP $ do

333 takeWhile (<= ( value `div` 8))

334 takeWhile (<= ((value * 2) `div` 8))

335 takeWhile (<= ((value * 3) `div` 8))

336 takeWhile (<= ((value * 4) `div` 8))

337 takeWhile (<= ((value * 5) `div` 8))

338 takeWhile (<= ((value * 6) `div` 8))

339 takeWhile (<= ((value * 7) `div` 8))

340 takeWhile (<= value)

341

342{-# INLINE monad16 #-}

343monad16 :: MonadIO m

344 => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())

345monad16 value =

346 PARSE_OP $ do

347 takeWhile (<= ( value `div` 16))

348 takeWhile (<= ((value * 2) `div` 16))

349 takeWhile (<= ((value * 3) `div` 16))

350 takeWhile (<= ((value * 4) `div` 16))

351 takeWhile (<= ((value * 5) `div` 16))

352 takeWhile (<= ((value * 6) `div` 16))

353 takeWhile (<= ((value * 7) `div` 16))

354 takeWhile (<= ((value * 8) `div` 16))

355 takeWhile (<= ((value * 9) `div` 16))

356 takeWhile (<= ((value * 10) `div` 16))

357 takeWhile (<= ((value * 11) `div` 16))

358 takeWhile (<= ((value * 12) `div` 16))

359 takeWhile (<= ((value * 13) `div` 16))

360 takeWhile (<= ((value * 14) `div` 16))

361 takeWhile (<= ((value * 15) `div` 16))

362 takeWhile (<= value)

363

364-------------------------------------------------------------------------------

365-- Benchmarks

366-------------------------------------------------------------------------------

367

368moduleName :: String

369moduleName = MODULE_NAME

370

371instance NFData ParseError where

372 {-# INLINE rnf #-}

373 rnf (ParseError x) = rnf x

374

375o_1_space_serial :: Int -> [Benchmark]

376o_1_space_serial value =

377 [ benchIOSink value "drain" (Stream.fold Fold.drain . StreamK.toStream)

378 , benchIOSink value "takeWhile" $ takeWhileK value

379 , benchIOSink value "splitAp2" $ splitAp2 value

380 , benchIOSink value "splitAp8" $ splitAp8 value

381 , benchIOSink value "alt2" $ alt2 value

382 , benchIOSink value "alt8" $ alt8 value

383 , benchIOSink value "alt16" $ alt16 value

384 , benchIOSink value "monad2" $ monad2 value

385 , benchIOSink value "monad4" $ monad4 value

386 , benchIOSink value "monad8" $ monad8 value

387 , benchIOSink value "monad16" $ monad16 value

388 ]

389

390{-# INLINE sepBy1 #-}

391sepBy1 :: MonadIO m => StreamK m PARSE_ELEM -> m Int

392sepBy1 xs = do

393 x <- PARSE_OP (parser (satisfy odd) (satisfy even)) xs

394 return $ Prelude.length x

395

396 where

397

398 parser p sep = do

399 x <- p

400 fmap (x :) $ AP.many (sep >> p)

401

402-- O(n) heap beacuse of accumulation of the list in strict IO monad?

403o_n_heap_serial :: Int -> [Benchmark]

404o_n_heap_serial value =

405 [

406 -- accumulates the results in a list

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

408 benchIOSink value "sequence_" $ sequence_ value

409 , benchIOSink value "sequenceA_" $ sequenceA_ value

410 , benchIOSink value "sequence" $ sequence value

411 , benchIOSink value "sequenceA" $ sequenceA value

412 , benchIOSink value "manyAlt" manyAlt

413 , benchIOSink value "sepBy1" sepBy1

414 , benchIOSink value "someAlt" someAlt

415 , benchIOSink value "choice" $ choice value

416 ]

417

418-- O(n) heap beacuse of accumulation of the list in strict IO monad?

419o_1_space_recursive :: Int -> [Benchmark]

420o_1_space_recursive value =

421 [ benchIOSink value "one (recursive)" $ one value

422 ]

423

424-------------------------------------------------------------------------------

425-- Driver

426-------------------------------------------------------------------------------

427

428main :: IO ()

429main = runWithCLIOpts defaultStreamSize allBenchmarks

430

431 where

432

433 allBenchmarks value =

434 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)

435 , bgroup (o_1_space_prefix moduleName) (o_1_space_recursive value)

436 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)

437 ]