f97b183 · streamly · git.iko.soy

git.iko.soy/streamly

Add bench to check scaling of Applicative/Alt/Monad

Also merge ParserD and Parser benchmarks.

commitf97b183c74f7133b4ae408a8d4c11aec0d881a00 authorHarendra Kumar <harendra@composewell.com> dateSat 4 Mar 2023, 19:54 (4 years ago) parent5d28f70

4 files changed+515−536

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Data/Parser.hs+339−47 benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs−461 benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+171−7 benchmark/streamly-benchmarks.cabal+5−21

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

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

2222 main

2323 ) where

2424

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

2526import Control.DeepSeq (NFData(..))

27+import Data.Function ((&))

2628import Data.Functor (($>))

2729import Data.Monoid (Sum(..))

2830import GHC.Magic (inline)

2931import GHC.Magic (noinline)

3032import System.IO (Handle)

3133import 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(..))

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

3438import Prelude hiding

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

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

3640

3741import qualified Control.Applicative as AP

42+import qualified Data.Foldable as F

43+import qualified Data.Traversable as TR

3844import qualified Streamly.FileSystem.Handle as Handle

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

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

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

263269manyTill value =

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

265271

266−{-# INLINE splitAp #-}

267−splitAp :: Monad m

272+{-# INLINE splitAp2 #-}

273+splitAp2 :: Monad m

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

269−splitAp value =

275+splitAp2 value =

270276 Stream.parse

271277 ((,)

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

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

274280 )

275281

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+

276310{-# INLINE splitApBefore #-}

277311splitApBefore :: Monad m

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

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

291325 <* PR.dropWhile (<= value)

292326 )

293327

294−{-# INLINE splitWith #-}

295−splitWith :: Monad m

328+{-# INLINE splitWith2 #-}

329+splitWith2 :: Monad m

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

297−splitWith value =

331+splitWith2 value =

298332 Stream.parse

299333 (PR.splitWith (,)

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

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

311345 (PR.dropWhile (<= value))

312346 )

313347

314−{-# INLINE alt #-}

315−alt :: Monad m

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+

375+{-# INLINE alt2 #-}

376+alt2 :: Monad m

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

317−alt value =

378+alt2 value =

318379 Stream.parse

319380 (PR.alt

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

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

321382 (PR.dropWhile (<= value))

322383 )

323384

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+

324433{-# INLINE altSmall #-}

325434altSmall :: Monad m

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

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

332441 (PR.satisfy (<= value))

333442 )

334443

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+

335499{-# INLINE takeEndBy_ #-}

336500takeEndBy_ :: Monad m

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

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

379543 )

380544-}

381545

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+

382564parseManyChunksOfSum :: Int -> Handle -> IO Int

383565parseManyChunksOfSum n inh =

384566 Stream.fold Fold.length

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

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

387569 (Stream.unfold Handle.reader inh)

388570

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−

405571-------------------------------------------------------------------------------

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

407573-------------------------------------------------------------------------------

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

415581lookAhead value =

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

417583

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+

418623{-

419624{-# INLINE choice #-}

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

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

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

424629-}

425630

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+

426647-------------------------------------------------------------------------------

427648-- Stream transformation

428649-------------------------------------------------------------------------------

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

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

436657 . fmap Sum

437658

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+

438688{-# INLINE parseIterate #-}

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

440690parseIterate n =

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

451701concatSequence =

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

453703

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−

459704-------------------------------------------------------------------------------

460705-- Benchmarks

461706-------------------------------------------------------------------------------

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

477722 , benchIOSink value "takeP" $ takeP value

478723 , benchIOSink value "dropWhile" $ dropWhile value

479724 , benchIOSink value "takeStartBy" $ takeStartBy value

725+ , benchIOSink value "takeEndBy_" $ takeEndBy_ value

480726 , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"

481727 $ takeFramedByEsc_ value

482728 , benchIOSink value "groupBy" $ groupBy

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

489735 , benchIOSink value "deintercalate" $ deintercalate value

490736 , benchIOSink value "deintercalate1" $ deintercalate1 value

491737 , benchIOSink value "deintercalateAll" $ deintercalateAll value

492− , benchIOSink value "splitAp" $ splitAp value

738+ -- Applicative and Monad

739+ , benchIOSink value "splitAp2" $ splitAp2 value

740+ , benchIOSink value "splitAp4" $ splitAp4 value

741+ , benchIOSink value "splitAp8" $ splitAp8 value

493742 , benchIOSink value "splitApBefore" $ splitApBefore value

494743 , benchIOSink value "splitApAfter" $ splitApAfter value

495− , benchIOSink value "splitWith" $ splitWith value

496− , benchIOSink value "takeEndBy_" $ takeEndBy_ 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

756+ , benchIOSink value "alt8" $ alt8 value

757+ , benchIOSink value "alt16" $ alt16 value

497758 , benchIOSink value "many" many

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

499760 , benchIOSink value "some" some

500761 , 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

501780 {-

502781 , benchIOSink value "tee" $ teeAllAny value

503782 , benchIOSink value "teeFst" $ teeFstAllAny value

504783 , benchIOSink value "shortest" $ shortestAllAny value

505784 , benchIOSink value "longest" $ longestAllAny value

506785 -}

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 (==))

514786 , benchIOSink value "listEqBy" (listEqBy value)

515787 , benchIOSink value "streamEqBy" (streamEqBy value)

516788 ]

517789

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+

518802o_1_space_filesystem :: BenchEnv -> [Benchmark]

519803o_1_space_filesystem env =

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

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

539823

540824 -- non-linear time complexity (parserD)

541825 , 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

546826

547827 -- These show non-linear time complexity.

548828 -- They accumulate the results in a list.

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

550830 , benchIOSink value "someAlt" someAlt

551831 ]

552832

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+

553844-------------------------------------------------------------------------------

554845-- Driver

555846-------------------------------------------------------------------------------

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

572863 , bgroup (o_1_space_prefix moduleName)

573864 (o_1_space_serial_unfold value arrays)

574865 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)

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

575867 ]

576868#else

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

1414 main

1515 ) where

1616

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

1718import Control.DeepSeq (NFData(..))

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

1920import Data.Foldable (asum)

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

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

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

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

24+import Streamly.Internal.Data.Parser

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

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

2427import System.Random (randomRIO)

2528import Prelude hiding

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

3033import qualified Data.Traversable as TR

3134import qualified Streamly.Data.Stream as Stream

3235import qualified Streamly.Data.Fold as FL

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

3337import qualified Streamly.Data.Parser as PRD

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

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

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

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

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

98102

99−{-# INLINE splitApp #-}

100−splitApp :: MonadIO m

103+{-# INLINE splitAp2 #-}

104+splitAp2 :: MonadIO m

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

102−splitApp value =

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

106+splitAp2 value =

107+ PARSE_OP

108+ ((,)

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+ )

104128

105129{-# INLINE sequenceA #-}

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

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

134158 list = Prelude.replicate value parser

135159 in PARSE_OP (F.sequence_ list)

136160

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+

137238{-# INLINE manyAlt #-}

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

139240manyAlt xs = do

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

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

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

155256

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+

156311-------------------------------------------------------------------------------

157312-- Benchmarks

158313-------------------------------------------------------------------------------

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

166321

167322o_1_space_serial :: Int -> [Benchmark]

168323o_1_space_serial value =

169− [ benchIOSink value "takeWhile" $ takeWhileK value

170− , benchIOSink value "splitApp" $ splitApp value

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

325+ , benchIOSink value "takeWhile" $ takeWhileK 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

171335 ]

172336

173337{-# INLINE sepBy1 #-}

benchmark/streamly-benchmarks.cabal+5−21

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

386386 else

387387 buildable: True

388388

389−benchmark Data.Parser.ParserD

389+benchmark Data.Parser

390390 import: bench-options

391391 type: exitcode-stdio-1.0

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

393− main-is: ParserD.hs

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

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

393+ main-is: Parser.hs

394+ if impl(ghcjs)

395395 buildable: False

396396 else

397397 buildable: True

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

400400 if flag(dev)

401401 ghc-options: +RTS -M3000M -RTS

402402 else

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

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

404404

405405benchmark Data.Parser.ParserK

406406 import: bench-options

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

429429 buildable: True

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

431431

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−

448432-------------------------------------------------------------------------------

449433-- Raw Streams

450434-------------------------------------------------------------------------------