f97b183 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add bench to check scaling of Applicative/Alt/Monad

f97b183Harendra Kumar4 years ago

benchmark/Streamly/Benchmark/Data/Parser.hs+339−47

compare with master

unifiedsplit

@@ -22,19 +22,25 @@ module Main

22 main

23 ) where

25+import Control.Applicative ((<|>))

25import Control.DeepSeq (NFData(..))

26import Control.DeepSeq (NFData(..))

27+import Data.Function ((&))

26import Data.Functor (($>))

28import Data.Functor (($>))

27import Data.Monoid (Sum(..))

29import Data.Monoid (Sum(..))

28import GHC.Magic (inline)

30import GHC.Magic (inline)

29import GHC.Magic (noinline)

31import GHC.Magic (noinline)

30import System.IO (Handle)

32import System.IO (Handle)

31import System.Random (randomRIO)

33import System.Random (randomRIO)

32−import Streamly.Internal.Data.Parser (ParseError(..))

34+import Streamly.Internal.Data.Fold (Fold(..))

35+import Streamly.Internal.Data.Parser

36+ (ParseError(..), Parser(..), Initial(..), Step(..))

33import Streamly.Internal.Data.Stream.StreamD (Stream)

37import Streamly.Internal.Data.Stream.StreamD (Stream)

34import Prelude hiding

38import Prelude hiding

35− (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile)

39+ (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile, span)

37import qualified Control.Applicative as AP

41import qualified Control.Applicative as AP

42+import qualified Data.Foldable as F

43+import qualified Data.Traversable as TR

38import qualified Streamly.FileSystem.Handle as Handle

44import qualified Streamly.FileSystem.Handle as Handle

39import qualified Streamly.Internal.Data.Array as Array

45import qualified Streamly.Internal.Data.Array as Array

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

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

@@ -263,16 +269,44 @@ manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

263manyTill value =

269manyTill value =

264 Stream.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) Fold.length)

270 Stream.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) Fold.length)

265

271

266−{-# INLINE splitAp #-}

272+{-# INLINE splitAp2 #-}

267−splitAp :: Monad m

273+splitAp2 :: Monad m

268 => Int -> Stream m Int -> m (Either ParseError ((), ()))

274 => Int -> Stream m Int -> m (Either ParseError ((), ()))

269−splitAp value =

275+splitAp2 value =

270 Stream.parse

276 Stream.parse

271 ((,)

277 ((,)

272 <$> PR.dropWhile (<= (value `div` 2))

278 <$> PR.dropWhile (<= (value `div` 2))

273 <*> PR.dropWhile (<= value)

279 <*> PR.dropWhile (<= value)

274 )

280 )

275

281

282+{-# INLINE splitAp4 #-}

283+splitAp4 :: Monad m

284+ => Int -> Stream m Int -> m (Either ParseError ())

285+splitAp4 value =

286+ Stream.parse

287+ ( (\() () () () -> ())

288+ <$> PR.dropWhile (<= (value * 1 `div` 4))

289+ <*> PR.dropWhile (<= (value * 2 `div` 4))

290+ <*> PR.dropWhile (<= (value * 3 `div` 4))

291+ <*> PR.dropWhile (<= value)

292+ )

293+

294+{-# INLINE splitAp8 #-}

295+splitAp8 :: Monad m

296+ => Int -> Stream m Int -> m (Either ParseError ())

297+splitAp8 value =

298+ Stream.parse

299+ ( (\() () () () () () () () -> ())

300+ <$> PR.dropWhile (<= (value * 1 `div` 8))

301+ <*> PR.dropWhile (<= (value * 2 `div` 8))

302+ <*> PR.dropWhile (<= (value * 3 `div` 8))

303+ <*> PR.dropWhile (<= (value * 4 `div` 8))

304+ <*> PR.dropWhile (<= (value * 5 `div` 8))

305+ <*> PR.dropWhile (<= (value * 6 `div` 8))

306+ <*> PR.dropWhile (<= (value * 7 `div` 8))

307+ <*> PR.dropWhile (<= value)

308+ )

309+

276{-# INLINE splitApBefore #-}

310{-# INLINE splitApBefore #-}

277splitApBefore :: Monad m

311splitApBefore :: Monad m

278 => Int -> Stream m Int -> m (Either ParseError ())

312 => Int -> Stream m Int -> m (Either ParseError ())

@@ -291,10 +325,10 @@ splitApAfter value =

291 <* PR.dropWhile (<= value)

325 <* PR.dropWhile (<= value)

292 )

326 )

293

327

294−{-# INLINE splitWith #-}

328+{-# INLINE splitWith2 #-}

295−splitWith :: Monad m

329+splitWith2 :: Monad m

296 => Int -> Stream m Int -> m (Either ParseError ((), ()))

330 => Int -> Stream m Int -> m (Either ParseError ((), ()))

297−splitWith value =

331+splitWith2 value =

298 Stream.parse

332 Stream.parse

299 (PR.splitWith (,)

333 (PR.splitWith (,)

300 (PR.dropWhile (<= (value `div` 2)))

334 (PR.dropWhile (<= (value `div` 2)))

@@ -311,16 +345,91 @@ split_ value =

311 (PR.dropWhile (<= value))

345 (PR.dropWhile (<= value))

312 )

346 )

313

347

348+-- XXX dropWhile with applicative does not fuse

349+-- PR.dropWhile (<= (value * 1 `div` 4)) *> PR.die "alt"

350+{-# INLINE takeWhileFail #-}

351+takeWhileFail :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b

352+takeWhileFail predicate (Fold fstep finitial fextract) =

353+ Parser step initial extract

354+

355+ where

356+

357+ initial = do

358+ res <- finitial

359+ return $ case res of

360+ Fold.Partial s -> IPartial s

361+ Fold.Done b -> IDone b

362+

363+ step s a =

364+ if predicate a

365+ then do

366+ fres <- fstep s a

367+ return

368+ $ case fres of

369+ Fold.Partial s1 -> Partial 0 s1

370+ Fold.Done b -> Done 0 b

371+ else return $ Error "fail"

372+

373+ extract s = fmap (Done 0) (fextract s)

374+

314−{-# INLINE alt #-}

375+{-# INLINE alt2 #-}

315−alt :: Monad m

376+alt2 :: Monad m

316 => Int -> Stream m Int -> m (Either ParseError ())

377 => Int -> Stream m Int -> m (Either ParseError ())

317−alt value =

378+alt2 value =

318 Stream.parse

379 Stream.parse

319 (PR.alt

380 (PR.alt

320− (PR.dropWhile (<= (value `div` 2)) *> PR.die "alt")

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

321 (PR.dropWhile (<= value))

382 (PR.dropWhile (<= value))

322 )

383 )

323

384

385+{-# INLINE alt4 #-}

386+alt4 :: Monad m

387+ => Int -> Stream m Int -> m (Either ParseError ())

388+alt4 value =

389+ Stream.parse

390+ ( takeWhileFail (<= (value * 1 `div` 4)) Fold.drain

391+ <|> takeWhileFail (<= (value * 2 `div` 4)) Fold.drain

392+ <|> takeWhileFail (<= (value * 3 `div` 4)) Fold.drain

393+ <|> PR.dropWhile (<= value)

394+ )

395+

396+{-# INLINE alt8 #-}

397+alt8 :: Monad m

398+ => Int -> Stream m Int -> m (Either ParseError ())

399+alt8 value =

400+ Stream.parse

401+ ( takeWhileFail (<= (value * 1 `div` 8)) Fold.drain

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

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

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

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

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

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

408+ <|> PR.dropWhile (<= value)

409+ )

410+

411+{-# INLINE alt16 #-}

412+alt16 :: Monad m

413+ => Int -> Stream m Int -> m (Either ParseError ())

414+alt16 value =

415+ Stream.parse

416+ ( takeWhileFail (<= (value * 1 `div` 16)) Fold.drain

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

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

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

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

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

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

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

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

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

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

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

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

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

430+ <|> PR.dropWhile (<= value)

431+ )

432+

324{-# INLINE altSmall #-}

433{-# INLINE altSmall #-}

325altSmall :: Monad m

434altSmall :: Monad m

326 => Int -> Stream m Int -> m ()

435 => Int -> Stream m Int -> m ()

@@ -332,6 +441,61 @@ altSmall value =

332 (PR.satisfy (<= value))

441 (PR.satisfy (<= value))

333 )

442 )

334

443

444+{-# INLINE monad #-}

445+monad :: Monad m

446+ => Int -> Stream m Int -> m (Either ParseError ())

447+monad value =

448+ Stream.parse

449+ $ do

450+ PR.dropWhile (<= (value `div` 2))

451+ PR.dropWhile (<= value)

452+

453+{-# INLINE monad4 #-}

454+monad4 :: Monad m

455+ => Int -> Stream m Int -> m (Either ParseError ())

456+monad4 value =

457+ Stream.parse $ do

458+ PR.dropWhile (<= (value `div` 4))

459+ PR.dropWhile (<= (value `div` 2))

460+ PR.dropWhile (<= (value * 3 `div` 4))

461+ PR.dropWhile (<= value)

462+

463+{-# INLINE monad8 #-}

464+monad8 :: Monad m

465+ => Int -> Stream m Int -> m (Either ParseError ())

466+monad8 value =

467+ Stream.parse $ do

468+ PR.dropWhile (<= (value * 1 `div` 8))

469+ PR.dropWhile (<= (value * 2 `div` 8))

470+ PR.dropWhile (<= (value * 3 `div` 8))

471+ PR.dropWhile (<= (value * 4 `div` 8))

472+ PR.dropWhile (<= (value * 5 `div` 8))

473+ PR.dropWhile (<= (value * 6 `div` 8))

474+ PR.dropWhile (<= (value * 7 `div` 8))

475+ PR.dropWhile (<= value)

476+

477+{-# INLINE monad16 #-}

478+monad16 :: Monad m

479+ => Int -> Stream m Int -> m (Either ParseError ())

480+monad16 value =

481+ Stream.parse $ do

482+ PR.dropWhile (<= (value * 1 `div` 16))

483+ PR.dropWhile (<= (value * 2 `div` 16))

484+ PR.dropWhile (<= (value * 3 `div` 16))

485+ PR.dropWhile (<= (value * 4 `div` 16))

486+ PR.dropWhile (<= (value * 5 `div` 16))

487+ PR.dropWhile (<= (value * 6 `div` 16))

488+ PR.dropWhile (<= (value * 7 `div` 16))

489+ PR.dropWhile (<= (value * 8 `div` 16))

490+ PR.dropWhile (<= (value * 9 `div` 16))

491+ PR.dropWhile (<= (value * 10 `div` 16))

492+ PR.dropWhile (<= (value * 11 `div` 16))

493+ PR.dropWhile (<= (value * 12 `div` 16))

494+ PR.dropWhile (<= (value * 13 `div` 16))

495+ PR.dropWhile (<= (value * 14 `div` 16))

496+ PR.dropWhile (<= (value * 15 `div` 16))

497+ PR.dropWhile (<= value)

498+

335{-# INLINE takeEndBy_ #-}

499{-# INLINE takeEndBy_ #-}

336takeEndBy_ :: Monad m

500takeEndBy_ :: Monad m

337 => Int -> Stream m Int -> m (Either ParseError ())

501 => Int -> Stream m Int -> m (Either ParseError ())

@@ -379,6 +543,24 @@ longestAllAny value =

379 )

543 )

380-}

544-}

381

545

546+-------------------------------------------------------------------------------

547+-- Spanning

548+-------------------------------------------------------------------------------

549+

550+{-# INLINE span #-}

551+span :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))

552+span value = Stream.parse (PR.span (<= (value `div` 2)) Fold.drain Fold.drain)

553+

554+{-# INLINE spanBy #-}

555+spanBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))

556+spanBy value =

557+ Stream.parse (PR.spanBy (\_ i -> i <= (value `div` 2)) Fold.drain Fold.drain)

558+

559+{-# INLINE spanByRolling #-}

560+spanByRolling :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))

561+spanByRolling value =

562+ Stream.parse (PR.spanByRolling (\_ i -> i <= value `div` 2) Fold.drain Fold.drain)

563+

382parseManyChunksOfSum :: Int -> Handle -> IO Int

564parseManyChunksOfSum :: Int -> Handle -> IO Int

383parseManyChunksOfSum n inh =

565parseManyChunksOfSum n inh =

384 Stream.fold Fold.length

566 Stream.fold Fold.length

@@ -386,22 +568,6 @@ parseManyChunksOfSum n inh =

386 (PR.fromFold $ Fold.take n Fold.sum)

568 (PR.fromFold $ Fold.take n Fold.sum)

387 (Stream.unfold Handle.reader inh)

569 (Stream.unfold Handle.reader inh)

388

570

389−-------------------------------------------------------------------------------

390−-- Parsing with unfolds

391−-------------------------------------------------------------------------------

392−

393−{-# INLINE parseManyUnfoldArrays #-}

394−parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()

395−parseManyUnfoldArrays count arrays = do

396− let src = Source.source (Just (Producer.OuterLoop arrays))

397− let parser = PR.fromFold (Fold.take count Fold.drain)

398− let readSrc =

399− Source.producer

400− $ Producer.concat Producer.fromList Array.producer

401− let streamParser =

402− Producer.simplify (Source.parseMany parser readSrc)

403− Stream.fold Fold.drain $ Stream.unfold streamParser src

404−

405-------------------------------------------------------------------------------

571-------------------------------------------------------------------------------

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

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

407-------------------------------------------------------------------------------

573-------------------------------------------------------------------------------

@@ -415,6 +581,45 @@ lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

415lookAhead value =

581lookAhead value =

416 Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())

582 Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())

417

583

584+-- XXX The timing of this increased 3x after the stepify extract changes.

585+{-# INLINE sequenceA_ #-}

586+sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

587+sequenceA_ value =

588+ Stream.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))

589+

590+-- quadratic complexity

591+{-# INLINE sequenceA #-}

592+sequenceA :: Monad m => Int -> Stream m Int -> m Int

593+sequenceA value xs = do

594+ x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs

595+ return $ length x

596+

597+-- quadratic complexity

598+{-# INLINE sequence #-}

599+sequence :: Monad m => Int -> Stream m Int -> m Int

600+sequence value xs = do

601+ x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs

602+ return $ length x

603+

604+{-# INLINE sequence_ #-}

605+sequence_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

606+sequence_ value xs =

607+ Stream.parse (foldr f (return ()) (replicate value (PR.takeBetween 0 1 Fold.drain))) xs

608+

609+ where

610+

611+ {-# INLINE f #-}

612+ f m k = m >>= (\_ -> k)

613+

614+-- choice using the "Alternative" instance with direct style parser type has

615+-- quadratic performance complexity.

616+--

617+{-# INLINE choiceAsum #-}

618+choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

619+choiceAsum value =

620+ Stream.parse (F.asum (replicate value (PR.satisfy (< 0)))

621+ AP.<|> PR.satisfy (> 0))

622+

418{-

623{-

419{-# INLINE choice #-}

624{-# INLINE choice #-}

420choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

625choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

@@ -423,6 +628,22 @@ choice value =

423 (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))

628 (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))

424-}

629-}

425

630

631+-------------------------------------------------------------------------------

632+-- Parsing with unfolds

633+-------------------------------------------------------------------------------

634+

635+{-# INLINE parseManyUnfoldArrays #-}

636+parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()

637+parseManyUnfoldArrays count arrays = do

638+ let src = Source.source (Just (Producer.OuterLoop arrays))

639+ let parser = PR.fromFold (Fold.take count Fold.drain)

640+ let readSrc =

641+ Source.producer

642+ $ Producer.concat Producer.fromList Array.producer

643+ let streamParser =

644+ Producer.simplify (Source.parseMany parser readSrc)

645+ Stream.fold Fold.drain $ Stream.unfold streamParser src

646+

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

647-------------------------------------------------------------------------------

427-- Stream transformation

648-- Stream transformation

428-------------------------------------------------------------------------------

649-------------------------------------------------------------------------------

@@ -435,6 +656,35 @@ parseMany n =

435 . Stream.catRights . Stream.parseMany (PR.fromFold $ Fold.take n Fold.mconcat)

656 . Stream.catRights . Stream.parseMany (PR.fromFold $ Fold.take n Fold.mconcat)

436 . fmap Sum

657 . fmap Sum

437

658

659+{-# INLINE parseManyGroupBy #-}

660+parseManyGroupBy :: Monad m => (Int -> Int -> Bool) -> Stream m Int -> m ()

661+parseManyGroupBy cmp =

662+ Stream.fold Fold.drain . Stream.parseMany (PR.groupBy cmp Fold.drain)

663+

664+{-# INLINE parseManyGroupsRolling #-}

665+parseManyGroupsRolling :: Monad m => Bool -> Stream m Int -> m ()

666+parseManyGroupsRolling b =

667+ Stream.fold Fold.drain

668+ . Stream.parseMany (PR.groupByRolling (\_ _ -> b) Fold.drain)

669+

670+{-# INLINE parseManyGroupsRollingEither #-}

671+parseManyGroupsRollingEither :: Monad m =>

672+ (Int -> Int -> Bool) -> Int -> m ()

673+parseManyGroupsRollingEither cmp value = do

674+ sourceUnfoldrM value 1

675+ & Stream.parseMany (PR.groupByRollingEither cmp Fold.drain Fold.drain)

676+ & Stream.fold Fold.drain

677+

678+{-# INLINE parseManyGroupsRollingEitherAlt #-}

679+parseManyGroupsRollingEitherAlt :: Monad m =>

680+ (Int -> Int -> Bool) -> Int -> m ()

681+parseManyGroupsRollingEitherAlt cmp value = do

682+ sourceUnfoldrM value 1

683+ -- Make the input unsorted.

684+ & fmap (\x -> if even x then x + 2 else x)

685+ & Stream.parseMany (PR.groupByRollingEither cmp Fold.drain Fold.drain)

686+ & Stream.fold Fold.drain

687+

438{-# INLINE parseIterate #-}

688{-# INLINE parseIterate #-}

439parseIterate :: Monad m => Int -> Stream m Int -> m ()

689parseIterate :: Monad m => Int -> Stream m Int -> m ()

440parseIterate n =

690parseIterate n =

@@ -451,11 +701,6 @@ concatSequence :: Monad m => Stream m Int -> m (Either ParseError ())

451concatSequence =

701concatSequence =

452 Stream.parse $ PR.sequence (Stream.repeat PR.one) Fold.drain

702 Stream.parse $ PR.sequence (Stream.repeat PR.one) Fold.drain

453

703

454−{-# INLINE parseManyGroupBy #-}

455−parseManyGroupBy :: Monad m => (Int -> Int -> Bool) -> Stream m Int -> m ()

456−parseManyGroupBy cmp =

457− Stream.fold Fold.drain . Stream.parseMany (PR.groupBy cmp Fold.drain)

458−

459-------------------------------------------------------------------------------

704-------------------------------------------------------------------------------

460-- Benchmarks

705-- Benchmarks

461-------------------------------------------------------------------------------

706-------------------------------------------------------------------------------

@@ -477,6 +722,7 @@ o_1_space_serial value =

477 , benchIOSink value "takeP" $ takeP value

722 , benchIOSink value "takeP" $ takeP value

478 , benchIOSink value "dropWhile" $ dropWhile value

723 , benchIOSink value "dropWhile" $ dropWhile value

479 , benchIOSink value "takeStartBy" $ takeStartBy value

724 , benchIOSink value "takeStartBy" $ takeStartBy value

725+ , benchIOSink value "takeEndBy_" $ takeEndBy_ value

480 , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"

726 , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"

481 $ takeFramedByEsc_ value

727 $ takeFramedByEsc_ value

482 , benchIOSink value "groupBy" $ groupBy

728 , benchIOSink value "groupBy" $ groupBy

@@ -489,32 +735,70 @@ o_1_space_serial value =

489 , benchIOSink value "deintercalate" $ deintercalate value

735 , benchIOSink value "deintercalate" $ deintercalate value

490 , benchIOSink value "deintercalate1" $ deintercalate1 value

736 , benchIOSink value "deintercalate1" $ deintercalate1 value

491 , benchIOSink value "deintercalateAll" $ deintercalateAll value

737 , benchIOSink value "deintercalateAll" $ deintercalateAll value

738+ -- Applicative and Monad

492− , benchIOSink value "splitAp" $ splitAp value

739+ , benchIOSink value "splitAp2" $ splitAp2 value

740+ , benchIOSink value "splitAp4" $ splitAp4 value

741+ , benchIOSink value "splitAp8" $ splitAp8 value

493 , benchIOSink value "splitApBefore" $ splitApBefore value

742 , benchIOSink value "splitApBefore" $ splitApBefore value

494 , benchIOSink value "splitApAfter" $ splitApAfter value

743 , benchIOSink value "splitApAfter" $ splitApAfter value

495− , benchIOSink value "splitWith" $ splitWith value

744+ , benchIOSink value "splitWith2" $ splitWith2 value

745+ , benchIOSink value "span" $ span value

746+ , benchIOSink value "spanBy" $ spanBy value

747+ , benchIOSink value "spanByRolling" $ spanByRolling value

748+ , benchIOSink value "monad2" $ monad value

749+ , benchIOSink value "monad4" $ monad4 value

750+ , benchIOSink value "monad8" $ monad8 value

751+ , benchIOSink value "monad16" $ monad16 value

752+ -- Alternative

753+ , benchIOSink value "alt2parseMany" $ altSmall value

754+ , benchIOSink value "alt2" $ alt2 value

755+ , benchIOSink value "alt4" $ alt4 value

496− , benchIOSink value "takeEndBy_" $ takeEndBy_ value

756+ , benchIOSink value "alt8" $ alt8 value

757+ , benchIOSink value "alt16" $ alt16 value

497 , benchIOSink value "many" many

758 , benchIOSink value "many" many

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

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

499 , benchIOSink value "some" some

760 , benchIOSink value "some" some

500 , benchIOSink value "manyTill" $ manyTill value

761 , benchIOSink value "manyTill" $ manyTill value

762+ , benchIOSink value "parseMany" $ parseMany value

763+ , benchIOSink value "parseMany (take 1)" (parseMany 1)

764+ , benchIOSink value "parseMany (take all)" (parseMany value)

765+ , benchIOSink value "parseMany (groupBy (<))" (parseManyGroupBy (<))

766+ , benchIOSink value "parseMany (groupBy (==))" (parseManyGroupBy (==))

767+ , benchIOSink value "parseMany groupRollingBy (bound groups)"

768+ $ parseManyGroupsRolling False

769+ , benchIOSink value "parseMany groupRollingBy (1 group)"

770+ $ parseManyGroupsRolling True

771+ , bench "parseMany groupRollingByEither (Left)"

772+ $ nfIO $ parseManyGroupsRollingEitherLeft

773+ , bench "parseMany groupRollingByEither (Right)"

774+ $ nfIO $ parseManyGroupsRollingEitherRight

775+ , bench "parseMany groupRollingByEither (Alternating)"

776+ $ nfIO $ parseManyGroupsRollingEitherAlt1

777+ , benchIOSink value "parseIterate (take 1)" (parseIterate 1)

778+ , benchIOSink value "parseIterate (take all)" (parseIterate value)

779+ , benchIOSink value "concatSequence" concatSequence

501 {-

780 {-

502 , benchIOSink value "tee" $ teeAllAny value

781 , benchIOSink value "tee" $ teeAllAny value

503 , benchIOSink value "teeFst" $ teeFstAllAny value

782 , benchIOSink value "teeFst" $ teeFstAllAny value

504 , benchIOSink value "shortest" $ shortestAllAny value

783 , benchIOSink value "shortest" $ shortestAllAny value

505 , benchIOSink value "longest" $ longestAllAny value

784 , benchIOSink value "longest" $ longestAllAny value

506 -}

785 -}

507− , benchIOSink value "parseMany (take 1)" (parseMany 1)

508− , benchIOSink value "parseMany (take all)" (parseMany value)

509− , benchIOSink value "parseIterate (take 1)" (parseIterate 1)

510− , benchIOSink value "parseIterate (take all)" (parseIterate value)

511− , benchIOSink value "concatSequence" concatSequence

512− , benchIOSink value "parseMany (groupBy (<))" (parseManyGroupBy (<))

513− , benchIOSink value "parseMany (groupBy (==))" (parseManyGroupBy (==))

514 , benchIOSink value "listEqBy" (listEqBy value)

786 , benchIOSink value "listEqBy" (listEqBy value)

515 , benchIOSink value "streamEqBy" (streamEqBy value)

787 , benchIOSink value "streamEqBy" (streamEqBy value)

516 ]

788 ]

517

789

790+ where

791+

792+ {-# NOINLINE parseManyGroupsRollingEitherLeft #-}

793+ parseManyGroupsRollingEitherLeft = parseManyGroupsRollingEither (<) value

794+

795+ {-# NOINLINE parseManyGroupsRollingEitherRight #-}

796+ parseManyGroupsRollingEitherRight = parseManyGroupsRollingEither (>) value

797+

798+ {-# NOINLINE parseManyGroupsRollingEitherAlt1 #-}

799+ parseManyGroupsRollingEitherAlt1 =

800+ parseManyGroupsRollingEitherAlt (>) value

801+

518o_1_space_filesystem :: BenchEnv -> [Benchmark]

802o_1_space_filesystem :: BenchEnv -> [Benchmark]

519o_1_space_filesystem env =

803o_1_space_filesystem env =

520 [ mkBench ("S.parseMany (Fold.take " ++ show (bigSize env) ++ " Fold.sum)") env

804 [ mkBench ("S.parseMany (Fold.take " ++ show (bigSize env) ++ " Fold.sum)") env

@@ -539,10 +823,6 @@ o_n_heap_serial value =

539

823

540 -- non-linear time complexity (parserD)

824 -- non-linear time complexity (parserD)

541 , benchIOSink value "split_" $ split_ value

825 , benchIOSink value "split_" $ split_ value

542− , benchIOSink value "altSmall (2 x parseMany)" $ altSmall value

543− , benchIOSink value "altBig (1/2 x 2)" $ alt value

544− -- XXX why O(n) heap?

545− -- , benchIOSink value "choice" $ choice value

546

826

547 -- These show non-linear time complexity.

827 -- These show non-linear time complexity.

548 -- They accumulate the results in a list.

828 -- They accumulate the results in a list.

@@ -550,6 +830,17 @@ o_n_heap_serial value =

550 , benchIOSink value "someAlt" someAlt

830 , benchIOSink value "someAlt" someAlt

551 ]

831 ]

552

832

833+-- accumulate results in a list in IO

834+o_n_space_serial :: Int -> [Benchmark]

835+o_n_space_serial value =

836+ [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)

837+ , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)

838+ , benchIOSink value "sequence/100" $ sequence (value `div` 100)

839+ , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)

840+ , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)

841+ -- , benchIOSink value "choice/100" $ choice (value `div` 100)

842+ ]

843+

553-------------------------------------------------------------------------------

844-------------------------------------------------------------------------------

554-- Driver

845-- Driver

555-------------------------------------------------------------------------------

846-------------------------------------------------------------------------------

@@ -572,6 +863,7 @@ main = do

572 , bgroup (o_1_space_prefix moduleName)

863 , bgroup (o_1_space_prefix moduleName)

573 (o_1_space_serial_unfold value arrays)

864 (o_1_space_serial_unfold value arrays)

574 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)

865 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)

866+ , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)

575 ]

867 ]

576#else

868#else

577 -- Enable FUSION_CHECK macro at the beginning of the file

869 -- Enable FUSION_CHECK macro at the beginning of the file

benchmark/Streamly/Benchmark/Data/Parser/ParserD.hsdeleted−461

@@ -1,461 +0,0 @@

1−{-# OPTIONS_GHC -Wno-deprecations #-}

2−

3−-- |

4−-- Module : Streamly.Benchmark.Data.ParserD

6−--

7−-- License : BSD-3-Clause

8−-- Maintainer : streamly@composewell.com

9−

10−{-# LANGUAGE FlexibleContexts #-}

11−{-# LANGUAGE ScopedTypeVariables #-}

12−{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}

13−{-# OPTIONS_GHC -Wno-orphans #-}

14−

15−module Main

16− (

17− main

18− ) where

19−

20−import Control.DeepSeq (NFData(..))

21−import Data.Foldable (asum)

22−import Data.Function ((&))

23−import Data.Functor (($>))

24−import Streamly.Internal.Data.Parser (ParseError(..))

25−import Streamly.Internal.Data.Stream.StreamD (Stream)

26−import System.Random (randomRIO)

27−import Prelude hiding (any, all, take, sequence, sequenceA, sequence_, takeWhile, span)

28−

29−import qualified Data.Traversable as TR

30−import qualified Data.Foldable as F

31−import qualified Control.Applicative as AP

32−import qualified Streamly.Internal.Data.Array as Array

33−import qualified Streamly.Internal.Data.Fold as Fold

34−import qualified Streamly.Internal.Data.Parser.ParserD as PR

35−import qualified Streamly.Internal.Data.Producer as Producer

36−import qualified Streamly.Internal.Data.Producer.Source as Source

37−import qualified Streamly.Data.Stream as Stream

38−import qualified Streamly.Internal.Data.Stream.StreamD as Stream

39−

40−import Gauge

41−import Streamly.Benchmark.Common

42−

43−-------------------------------------------------------------------------------

44−-- Utilities

45−-------------------------------------------------------------------------------

46−

47−-- XXX these can be moved to the common module

48−

49−{-# INLINE sourceUnfoldrM #-}

50−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int

51−sourceUnfoldrM value n = Stream.unfoldrM step n

52− where

53− step cnt =

54− if cnt > n + value

55− then return Nothing

56− else return (Just (cnt, cnt + 1))

57−

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

59−{-# INLINE benchIOSink #-}

60−benchIOSink

61− :: (NFData b)

62− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark

63−benchIOSink value name f =

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

65−

66−-------------------------------------------------------------------------------

67−-- Parsers

68−-------------------------------------------------------------------------------

69−

70−{-# INLINE listEqBy #-}

71−listEqBy :: Int -> Stream IO Int -> IO (Either ParseError [Int])

72−listEqBy len = Stream.parseD (PR.listEqBy (==) [1 .. len])

73−

74−{-# INLINE streamEqBy #-}

75−streamEqBy :: Int -> Stream IO Int -> IO (Either ParseError ())

76−streamEqBy len = Stream.parseD (PR.streamEqBy (==) (Stream.enumerateFromToIntegral 1 len))

77−

78−{-# INLINE drainWhile #-}

79−drainWhile :: Monad m => (a -> Bool) -> PR.Parser a m ()

80−drainWhile p = PR.takeWhile p Fold.drain

81−

82−{-# INLINE takeStartBy #-}

83−takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

84−takeStartBy value stream = do

85− let stream2 = value `Stream.cons` stream

86− Stream.parseD (PR.takeStartBy (== value) Fold.drain) stream2

87−

88−{-# INLINE takeWhile #-}

89−takeWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

90−takeWhile value = Stream.parseD (drainWhile (<= value))

91−

92−{-# INLINE takeP #-}

93−takeP :: Monad m => Int -> Stream m a -> m (Either ParseError ())

94−takeP value = Stream.parseD (PR.takeP value (PR.fromFold Fold.drain))

95−

96−{-# INLINE takeBetween #-}

97−takeBetween :: Monad m => Int -> Stream m a -> m (Either ParseError ())

98−takeBetween value = Stream.parseD (PR.takeBetween 0 value Fold.drain)

99−

100−{-# INLINE groupBy #-}

101−groupBy :: Monad m => Stream m Int -> m (Either ParseError ())

102−groupBy = Stream.parseD (PR.groupBy (<=) Fold.drain)

103−

104−{-# INLINE groupByRolling #-}

105−groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())

106−groupByRolling = Stream.parseD (PR.groupByRolling (<=) Fold.drain)

107−

108−{-# INLINE wordBy #-}

109−wordBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

110−wordBy value = Stream.parseD (PR.wordBy (>= value) Fold.drain)

111−

112−{-# INLINE manyWordByEven #-}

113−manyWordByEven :: Monad m => Stream m Int -> m (Either ParseError ())

114−manyWordByEven =

115− Stream.parseD (PR.many (PR.wordBy (Prelude.even) Fold.drain) Fold.drain)

116−

117−{-# INLINE many #-}

118−many :: Monad m => Stream m Int -> m (Either ParseError Int)

119−many = Stream.parseD (PR.many (PR.satisfy (> 0)) Fold.length)

120−

121−{-# INLINE manyAlt #-}

122−manyAlt :: Monad m => Stream m Int -> m Int

123−manyAlt xs = do

124− x <- Stream.parseD (AP.many (PR.satisfy (> 0))) xs

125− return $ Prelude.length x

126−

127−{-# INLINE some #-}

128−some :: Monad m => Stream m Int -> m (Either ParseError Int)

129−some = Stream.parseD (PR.some (PR.satisfy (> 0)) Fold.length)

130−

131−{-# INLINE someAlt #-}

132−someAlt :: Monad m => Stream m Int -> m Int

133−someAlt xs = do

134− x <- Stream.parseD (AP.some (PR.satisfy (> 0))) xs

135− return $ Prelude.length x

136−

137−{-#INLINE takeEndBy_ #-}

138−takeEndBy_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

139−takeEndBy_ value = Stream.parseD (PR.takeEndBy_ (>= value) (PR.fromFold Fold.drain))

140−

141−{-# INLINE manyTill #-}

142−manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

143−manyTill value =

144− let p = PR.satisfy (> 0)

145− pcond = PR.satisfy (== value)

146− in Stream.parseD (PR.manyTill p pcond Fold.length)

147−

148−{-# INLINE splitWith #-}

149−splitWith :: Monad m

150− => Int -> Stream m Int -> m (Either ParseError ((), ()))

151−splitWith value =

152− Stream.parseD

153− ((,)

154− <$> drainWhile (<= (value `div` 2))

155− <*> drainWhile (<= value)

156− )

157−

158−{-

159−{-# INLINE teeAllAny #-}

160−teeAllAny :: Monad m

161− => Int -> Stream m Int -> m ((), ())

162−teeAllAny value =

163− Stream.parseD

164− (PR.teeWith (,)

165− (drainWhile (<= value))

166− (drainWhile (<= value))

167− )

168−

169−{-# INLINE teeFstAllAny #-}

170−teeFstAllAny :: Monad m

171− => Int -> Stream m Int -> m ((), ())

172−teeFstAllAny value =

173− Stream.parseD

174− (PR.teeWithFst (,)

175− (drainWhile (<= value))

176− (drainWhile (<= value))

177− )

178−

179−{-# INLINE shortestAllAny #-}

180−shortestAllAny :: Monad m

181− => Int -> Stream m Int -> m ()

182−shortestAllAny value =

183− Stream.parseD

184− (PR.shortest

185− (drainWhile (<= value))

186− (drainWhile (<= value))

187− )

188−

189−{-# INLINE longestAllAny #-}

190−longestAllAny :: Monad m

191− => Int -> Stream m Int -> m ()

192−longestAllAny value =

193− Stream.parseD

194− (PR.longest

195− (drainWhile (<= value))

196− (drainWhile (<= value))

197− )

198−-}

199−

200−{-# INLINE sequenceParser #-}

201−sequenceParser :: Monad m => Stream m Int -> m (Either ParseError ())

202−sequenceParser =

203− Stream.parseD

204− (PR.sequence (Stream.repeat (PR.satisfy $ const True)) Fold.drain)

205−

206−-------------------------------------------------------------------------------

207−-- Spanning

208−-------------------------------------------------------------------------------

209−

210−{-# INLINE span #-}

211−span :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))

212−span value = Stream.parseD (PR.span (<= (value `div` 2)) Fold.drain Fold.drain)

213−

214−{-# INLINE spanBy #-}

215−spanBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))

216−spanBy value =

217− Stream.parseD (PR.spanBy (\_ i -> i <= (value `div` 2)) Fold.drain Fold.drain)

218−

219−{-# INLINE spanByRolling #-}

220−spanByRolling :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))

221−spanByRolling value =

222− Stream.parseD (PR.spanByRolling (\_ i -> i <= value `div` 2) Fold.drain Fold.drain)

223−

224−-------------------------------------------------------------------------------

225−-- Nested

226−-------------------------------------------------------------------------------

227−

228−{-# INLINE parseMany #-}

229−parseMany :: Monad m => Int -> Stream m Int -> m ()

230−parseMany value = Stream.fold Fold.drain . Stream.parseManyD (drainWhile (<= value + 1))

231−

232−{-# INLINE parseManyGroups #-}

233−parseManyGroups :: Monad m => Bool -> Stream m Int -> m ()

234−parseManyGroups b = Stream.fold Fold.drain . Stream.parseManyD (PR.groupBy (\_ _ -> b) Fold.drain)

235−

236−{-# INLINE parseManyGroupsRolling #-}

237−parseManyGroupsRolling :: Monad m => Bool -> Stream m Int -> m ()

238−parseManyGroupsRolling b =

239− Stream.fold Fold.drain . Stream.parseManyD (PR.groupByRolling (\_ _ -> b) Fold.drain)

240−

241−{-# INLINE parseManyGroupsRollingEither #-}

242−parseManyGroupsRollingEither :: Monad m =>

243− (Int -> Int -> Bool) -> Int -> m ()

244−parseManyGroupsRollingEither cmp value = do

245− sourceUnfoldrM value 1

246− & Stream.parseManyD (PR.groupByRollingEither cmp Fold.drain Fold.drain)

247− & Stream.fold Fold.drain

248−

249−{-# INLINE parseManyGroupsRollingEitherAlt #-}

250−parseManyGroupsRollingEitherAlt :: Monad m =>

251− (Int -> Int -> Bool) -> Int -> m ()

252−parseManyGroupsRollingEitherAlt cmp value = do

253− sourceUnfoldrM value 1

254− -- Make the input unsorted.

255− & fmap (\x -> if even x then x + 2 else x)

256− & Stream.parseManyD (PR.groupByRollingEither cmp Fold.drain Fold.drain)

257− & Stream.fold Fold.drain

258−

259−-------------------------------------------------------------------------------

260−-- Parsing with unfolds

261−-------------------------------------------------------------------------------

262−

263−{-# INLINE parseManyUnfoldArrays #-}

264−parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()

265−parseManyUnfoldArrays count arrays = do

266− let src = Source.source (Just (Producer.OuterLoop arrays))

267− let parser = PR.fromFold (Fold.take count Fold.drain)

268− let readSrc =

269− Source.producer

270− $ Producer.concat Producer.fromList Array.producer

271− let streamParser =

272− Producer.simplify (Source.parseManyD parser readSrc)

273− Stream.fold Fold.drain $ Stream.unfold streamParser src

274−

275−-------------------------------------------------------------------------------

276−-- Parsers in which -fspec-constr-recursive=16 is problematic

277−-------------------------------------------------------------------------------

278−

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

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

281−-- not have to rely on it.

282−--

283−{-# INLINE lookAhead #-}

284−lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

285−lookAhead value =

286− Stream.parseD (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())

287−

288−-- XXX The timing of this increased 3x after the stepify extract changes.

289−{-# INLINE sequenceA_ #-}

290−sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

291−sequenceA_ value =

292− Stream.parseD (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))

293−

294−-- quadratic complexity

295−{-# INLINE sequenceA #-}

296−sequenceA :: Monad m => Int -> Stream m Int -> m Int

297−sequenceA value xs = do

298− x <- Stream.parseD (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs

299− return $ length x

300−

301−-- quadratic complexity

302−{-# INLINE sequence #-}

303−sequence :: Monad m => Int -> Stream m Int -> m Int

304−sequence value xs = do

305− x <- Stream.parseD (TR.sequence (replicate value (PR.satisfy (> 0)))) xs

306− return $ length x

307−

308−{-# INLINE sequence_ #-}

309−sequence_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())

310−sequence_ value xs =

311− Stream.parseD (foldr f (return ()) (replicate value (PR.takeBetween 0 1 Fold.drain))) xs

312−

313− where

314−

315− {-# INLINE f #-}

316− f m k = m >>= (\_ -> k)

317−

318−-- choice using the "Alternative" instance with direct style parser type has

319−-- quadratic performance complexity.

320−--

321−{-# INLINE choiceAsum #-}

322−choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)

323−choiceAsum value =

324− Stream.parseD (asum (replicate value (PR.satisfy (< 0)))

325− AP.<|> PR.satisfy (> 0))

326−

327−{-

328−{-# INLINE choice #-}

329−choice :: Monad m => Int -> Stream m Int -> m Int

330−choice value =

331− Stream.parseD

332− (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))

333−-}

334−

335−-------------------------------------------------------------------------------

336−-- Benchmarks

337−-------------------------------------------------------------------------------

338−

339−moduleName :: String

340−moduleName = "Data.Parser.ParserD"

341−

342−instance NFData ParseError where

343− {-# INLINE rnf #-}

344− rnf (ParseError x) = rnf x

345−

346−o_1_space_serial :: Int -> [Benchmark]

347−o_1_space_serial value =

348− [ benchIOSink value "takeWhile" $ takeWhile value

349− , benchIOSink value "takeP" $ takeP value

350− , benchIOSink value "takeBetween" $ takeBetween value

351− , benchIOSink value "takeStartBy" $ takeStartBy value

352− , benchIOSink value "groupBy" $ groupBy

353− , benchIOSink value "groupByRolling" $ groupByRolling

354− , benchIOSink value "wordBy" $ wordBy value

355− , benchIOSink value "splitWith" $ splitWith value

356− , benchIOSink value "many" many

357− , benchIOSink value "many (wordBy even)" $ manyWordByEven

358− , benchIOSink value "some" some

359− , benchIOSink value "takeEndBy_" $ takeEndBy_ value

360− , benchIOSink value "manyTill" $ manyTill value

361− {-

362− , benchIOSink value "tee (all,any)" $ teeAllAny value

363− , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value

364− , benchIOSink value "shortest (all,any)" $ shortestAllAny value

365− , benchIOSink value "longest (all,any)" $ longestAllAny value

366− -}

367− , benchIOSink value "sequenceParser" sequenceParser

368− , benchIOSink value "listEqBy" (listEqBy value)

369− , benchIOSink value "streamEqBy" (streamEqBy value)

370− ]

371−

372−o_1_space_serial_spanning :: Int -> [Benchmark]

373−o_1_space_serial_spanning value =

374− [ benchIOSink value "span" $ span value

375− , benchIOSink value "spanBy" $ spanBy value

376− , benchIOSink value "spanByRolling" $ spanByRolling value

377− ]

378−

379−o_1_space_serial_nested :: Int -> [Benchmark]

380−o_1_space_serial_nested value =

381− [ benchIOSink value "parseMany" $ parseMany value

382− , benchIOSink value "parseMany groupBy (bound groups)"

383− $ parseManyGroups False

384− , benchIOSink value "parseMany groupRollingBy (bound groups)"

385− $ parseManyGroupsRolling False

386− , benchIOSink value "parseMany groupBy (1 group)" $ parseManyGroups True

387− , benchIOSink value "parseMany groupRollingBy (1 group)"

388− $ parseManyGroupsRolling True

389− , bench "parseMany groupRollingByEither (Left)"

390− $ nfIO $ parseManyGroupsRollingEitherLeft

391− , bench "parseMany groupRollingByEither (Right)"

392− $ nfIO $ parseManyGroupsRollingEitherRight

393− , bench "parseMany groupRollingByEither (Alternating)"

394− $ nfIO $ parseManyGroupsRollingEitherAlt1

395− ]

396−

397− where

398−

399− {-# NOINLINE parseManyGroupsRollingEitherLeft #-}

400− parseManyGroupsRollingEitherLeft = parseManyGroupsRollingEither (<) value

401−

402− {-# NOINLINE parseManyGroupsRollingEitherRight #-}

403− parseManyGroupsRollingEitherRight = parseManyGroupsRollingEither (>) value

404−

405− {-# NOINLINE parseManyGroupsRollingEitherAlt1 #-}

406− parseManyGroupsRollingEitherAlt1 =

407− parseManyGroupsRollingEitherAlt (>) value

408−

409−o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]

410−o_1_space_serial_unfold bound arrays =

411− [ bench "parseMany/Unfold/1000 arrays/1 parse"

412− $ nfIO $ parseManyUnfoldArrays bound arrays

413− , bench "parseMany/Unfold/1000 arrays/100000 parses"

414− $ nfIO $ parseManyUnfoldArrays 1 arrays

415− ]

416−

417−o_n_heap_serial :: Int -> [Benchmark]

418−o_n_heap_serial value =

419− [

420− -- lookahead benchmark holds the entire input till end

421− benchIOSink value "lookAhead" $ lookAhead value

422−

423− -- These show non-linear time complexity

424− -- They accumulate the results in a list.

425− , benchIOSink value "manyAlt" manyAlt

426− , benchIOSink value "someAlt" someAlt

427− ]

428−

429−-- accumulate results in a list in IO

430−o_n_space_serial :: Int -> [Benchmark]

431−o_n_space_serial value =

432− [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)

433− , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)

434− , benchIOSink value "sequence/100" $ sequence (value `div` 100)

435− , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)

436− , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)

437− -- , benchIOSink value "choice/100" $ choice (value `div` 100)

438− ]

439−

440−-------------------------------------------------------------------------------

441−-- Driver

442−-------------------------------------------------------------------------------

443−

444−main :: IO ()

445−main = do

446− x <- randomRIO (1,1)

447− runWithCLIOptsEnv (defaultStreamSize + x) alloc allBenchmarks

448−

449− where

450−

451− alloc value = Stream.fold Fold.toList $ Stream.arraysOf 100 $ sourceUnfoldrM value 0

452−

453− allBenchmarks arraysSmall value =

454− [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)

455− , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_spanning value)

456− , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_nested value)

457− , bgroup (o_1_space_prefix moduleName)

458− (o_1_space_serial_unfold value arraysSmall)

459− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)

460− , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)

461− ]

benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+171−7

@@ -14,12 +14,15 @@ module Main

14 main

15 ) where

17+import Control.Applicative ((<|>))

17import Control.DeepSeq (NFData(..))

18import Control.DeepSeq (NFData(..))

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

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

19import Data.Foldable (asum)

20import Data.Foldable (asum)

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

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

22+import Streamly.Internal.Data.Fold.Type (Fold(..))

21import Streamly.Data.Stream.StreamK (StreamK)

23import Streamly.Data.Stream.StreamK (StreamK)

22−import Streamly.Internal.Data.Parser (ParseError(..))

24+import Streamly.Internal.Data.Parser

25+ (ParseError(..), Parser(..), Initial(..), Step(..))

23import Streamly.Internal.Data.Stream.StreamD (Stream)

26import Streamly.Internal.Data.Stream.StreamD (Stream)

24import System.Random (randomRIO)

27import System.Random (randomRIO)

25import Prelude hiding

28import Prelude hiding

@@ -30,6 +33,7 @@ import qualified Data.Foldable as F

30import qualified Data.Traversable as TR

33import qualified Data.Traversable as TR

31import qualified Streamly.Data.Stream as Stream

34import qualified Streamly.Data.Stream as Stream

32import qualified Streamly.Data.Fold as FL

35import qualified Streamly.Data.Fold as FL

36+import qualified Streamly.Internal.Data.Fold as Fold

33import qualified Streamly.Data.Parser as PRD

37import qualified Streamly.Data.Parser as PRD

34import qualified Streamly.Data.Parser.ParserK as PR

38import qualified Streamly.Data.Parser.ParserK as PR

35import qualified Streamly.Internal.Data.Stream.StreamK as StreamK

39import qualified Streamly.Internal.Data.Stream.StreamK as StreamK

@@ -96,11 +100,31 @@ takeWhileK :: MonadIO m =>

96 Int -> StreamK m (Array Int) -> m (Either ParseError ())

100 Int -> StreamK m (Array Int) -> m (Either ParseError ())

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

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

102

99−{-# INLINE splitApp #-}

103+{-# INLINE splitAp2 #-}

100−splitApp :: MonadIO m

104+splitAp2 :: MonadIO m

101 => Int -> StreamK m (Array Int) -> m (Either ParseError ((), ()))

105 => Int -> StreamK m (Array Int) -> m (Either ParseError ((), ()))

102−splitApp value =

106+splitAp2 value =

107+ PARSE_OP

108+ ((,)

103− PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))

109+ <$> takeWhile (<= (value `div` 2))

110+ <*> takeWhile (<= value)

111+ )

112+

113+{-# INLINE splitAp8 #-}

114+splitAp8 :: MonadIO m

115+ => Int -> StreamK m (Array Int) -> m (Either ParseError ())

116+splitAp8 value =

117+ PARSE_OP

118+ ( (\() () () () () () () () -> ())

119+ <$> takeWhile (<= ( value `div` 8))

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

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

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

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

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

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

126+ <*> takeWhile (<= value)

127+ )

104

128

105{-# INLINE sequenceA #-}

129{-# INLINE sequenceA #-}

106sequenceA :: MonadIO m => Int -> StreamK m (Array Int) -> m Int

130sequenceA :: MonadIO m => Int -> StreamK m (Array Int) -> m Int

@@ -134,6 +158,83 @@ sequence_ value =

134 list = Prelude.replicate value parser

158 list = Prelude.replicate value parser

135 in PARSE_OP (F.sequence_ list)

159 in PARSE_OP (F.sequence_ list)

136

160

161+{-# INLINE takeWhileFailD #-}

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

163+takeWhileFailD predicate (Fold fstep finitial fextract) =

164+ Parser step initial extract

165+

166+ where

167+

168+ initial = do

169+ res <- finitial

170+ return $ case res of

171+ Fold.Partial s -> IPartial s

172+ Fold.Done b -> IDone b

173+

174+ step s a =

175+ if predicate a

176+ then do

177+ fres <- fstep s a

178+ return

179+ $ case fres of

180+ Fold.Partial s1 -> Partial 0 s1

181+ Fold.Done b -> Done 0 b

182+ else return $ Error "fail"

183+

184+ extract s = fmap (Done 0) (fextract s)

185+

186+{-# INLINE takeWhileFail #-}

187+takeWhileFail :: (Monad m, Unbox a) =>

188+ (a -> Bool) -> Fold m a b -> PR.ParserK a m b

189+takeWhileFail p f = PR.fromParser (takeWhileFailD p f)

190+

191+{-# INLINE alt2 #-}

192+alt2 :: MonadIO m

193+ => Int -> StreamK m (Array Int) -> m (Either ParseError ())

194+alt2 value =

195+ PARSE_OP

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

197+ <|> takeWhile (<= value)

198+ )

199+

200+{-# INLINE alt8 #-}

201+alt8 :: MonadIO m

202+ => Int -> StreamK m (Array Int) -> m (Either ParseError ())

203+alt8 value =

204+ PARSE_OP

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

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

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

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

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

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

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

212+ <|> takeWhile (<= value)

213+ )

214+

215+{-# INLINE alt16 #-}

216+alt16 :: MonadIO m

217+ => Int -> StreamK m (Array Int) -> m (Either ParseError ())

218+alt16 value =

219+ PARSE_OP

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

235+ <|> takeWhile (<= value)

236+ )

237+

137{-# INLINE manyAlt #-}

238{-# INLINE manyAlt #-}

138manyAlt :: MonadIO m => StreamK m (Array Int) -> m Int

239manyAlt :: MonadIO m => StreamK m (Array Int) -> m Int

139manyAlt xs = do

240manyAlt xs = do

@@ -153,6 +254,60 @@ choice value =

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

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

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

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

155

256

257+{-# INLINE monad2 #-}

258+monad2 :: MonadIO m

259+ => Int -> StreamK m (Array Int) -> m (Either ParseError ())

260+monad2 value =

261+ PARSE_OP $ do

262+ takeWhile (<= (value `div` 2))

263+ takeWhile (<= value)

264+

265+{-# INLINE monad4 #-}

266+monad4 :: MonadIO m

267+ => Int -> StreamK m (Array Int) -> m (Either ParseError ())

268+monad4 value =

269+ PARSE_OP $ do

270+ takeWhile (<= ( value `div` 4))

271+ takeWhile (<= ((value * 2) `div` 4))

272+ takeWhile (<= ((value * 3) `div` 4))

273+ takeWhile (<= value)

274+

275+{-# INLINE monad8 #-}

276+monad8 :: MonadIO m

277+ => Int -> StreamK m (Array Int) -> m (Either ParseError ())

278+monad8 value =

279+ PARSE_OP $ do

280+ takeWhile (<= ( value `div` 8))

281+ takeWhile (<= ((value * 2) `div` 8))

282+ takeWhile (<= ((value * 3) `div` 8))

283+ takeWhile (<= ((value * 4) `div` 8))

284+ takeWhile (<= ((value * 5) `div` 8))

285+ takeWhile (<= ((value * 6) `div` 8))

286+ takeWhile (<= ((value * 7) `div` 8))

287+ takeWhile (<= value)

288+

289+{-# INLINE monad16 #-}

290+monad16 :: MonadIO m

291+ => Int -> StreamK m (Array Int) -> m (Either ParseError ())

292+monad16 value =

293+ PARSE_OP $ do

294+ takeWhile (<= ( value `div` 16))

295+ takeWhile (<= ((value * 2) `div` 16))

296+ takeWhile (<= ((value * 3) `div` 16))

297+ takeWhile (<= ((value * 4) `div` 16))

298+ takeWhile (<= ((value * 5) `div` 16))

299+ takeWhile (<= ((value * 6) `div` 16))

300+ takeWhile (<= ((value * 7) `div` 16))

301+ takeWhile (<= ((value * 8) `div` 16))

302+ takeWhile (<= ((value * 9) `div` 16))

303+ takeWhile (<= ((value * 10) `div` 16))

304+ takeWhile (<= ((value * 11) `div` 16))

305+ takeWhile (<= ((value * 12) `div` 16))

306+ takeWhile (<= ((value * 13) `div` 16))

307+ takeWhile (<= ((value * 14) `div` 16))

308+ takeWhile (<= ((value * 15) `div` 16))

309+ takeWhile (<= value)

310+

156-------------------------------------------------------------------------------

311-------------------------------------------------------------------------------

157-- Benchmarks

312-- Benchmarks

158-------------------------------------------------------------------------------

313-------------------------------------------------------------------------------

@@ -166,8 +321,17 @@ instance NFData ParseError where

166

321

167o_1_space_serial :: Int -> [Benchmark]

322o_1_space_serial :: Int -> [Benchmark]

168o_1_space_serial value =

323o_1_space_serial value =

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

169− [ benchIOSink value "takeWhile" $ takeWhileK value

325+ , benchIOSink value "takeWhile" $ takeWhileK value

170− , benchIOSink value "splitApp" $ splitApp value

326+ , benchIOSink value "splitAp2" $ splitAp2 value

327+ , benchIOSink value "splitAp8" $ splitAp8 value

328+ , benchIOSink value "alt2" $ alt2 value

329+ , benchIOSink value "alt8" $ alt8 value

330+ , benchIOSink value "alt16" $ alt16 value

331+ , benchIOSink value "monad2" $ monad2 value

332+ , benchIOSink value "monad4" $ monad4 value

333+ , benchIOSink value "monad8" $ monad8 value

334+ , benchIOSink value "monad16" $ monad16 value

171 ]

335 ]

172

336

173{-# INLINE sepBy1 #-}

337{-# INLINE sepBy1 #-}

benchmark/streamly-benchmarks.cabal+5−21

@@ -386,12 +386,12 @@ benchmark Data.Fold.Window

386 else

387 buildable: True

388

389−benchmark Data.Parser.ParserD

389+benchmark Data.Parser

390 import: bench-options

391 type: exitcode-stdio-1.0

392− hs-source-dirs: Streamly/Benchmark/Data/Parser

392+ hs-source-dirs: Streamly/Benchmark/Data

393− main-is: ParserD.hs

393+ main-is: Parser.hs

394− if flag(use-streamly-core) || impl(ghcjs)

394+ if impl(ghcjs)

395 buildable: False

396 else

397 buildable: True

@@ -400,7 +400,7 @@ benchmark Data.Parser.ParserD

400 if flag(dev)

401 ghc-options: +RTS -M3000M -RTS

402 else

403− ghc-options: +RTS -M750M -RTS

403+ ghc-options: +RTS -M1000M -RTS

404

405benchmark Data.Parser.ParserK

406 import: bench-options

@@ -429,22 +429,6 @@ benchmark Data.Parser.FromParserK

429 buildable: True

430 build-depends: exceptions >= 0.8 && < 0.11

431

432−benchmark Data.Parser

433− import: bench-options

434− type: exitcode-stdio-1.0

435− hs-source-dirs: Streamly/Benchmark/Data

436− main-is: Parser.hs

437− if impl(ghcjs)

438− buildable: False

439− else

440− buildable: True

441− build-depends: exceptions >= 0.8 && < 0.11

442− if flag(limit-build-mem)

443− if flag(dev)

444− ghc-options: +RTS -M3000M -RTS

445− else

446− ghc-options: +RTS -M1000M -RTS

447−

448-------------------------------------------------------------------------------

432-------------------------------------------------------------------------------

449-- Raw Streams

433-- Raw Streams

450-------------------------------------------------------------------------------

434-------------------------------------------------------------------------------