4f556e8 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Make Parser initial of type Initial

4f556e8Adithya Kumar6 years ago

bin/bench-exec-one.sh+1

compare with master

unifiedsplit

@@ -52,6 +52,7 @@ bench_rts_opts_specific () {

52 Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;

54 Prelude.Rate/o-1-space/*) echo -n "-K128K" ;;

55+ Prelude.Rate/o-1-space/asyncly/*) echo -n "-K128K" ;;

56 # XXX For GHC-9.0

57 # XXX For GHC-9.0

57 Prelude.Serial/o-1-space/mixed/sum-product-fold) echo -n "-K64M" ;;

58 Prelude.Serial/o-1-space/mixed/sum-product-fold) echo -n "-K64M" ;;

cabal.project−2

@@ -1,5 +1,3 @@

1packages: streamly.cabal

2 , test/streamly-tests.cabal

3 , benchmark/streamly-benchmarks.cabal

4−

5−

src/Streamly/Internal/Data/Binary/Decode.hs+6−6

@@ -113,7 +113,7 @@ word16beD = PRD.Parser step initial extract

113

114 where

115

116− initial = return Nothing'

116+ initial = return $ PRD.IPartial Nothing'

117

118 step Nothing' a =

119 -- XXX We can use a non-failing parser or a fold so that we do not

@@ -140,7 +140,7 @@ word16leD = PRD.Parser step initial extract

140

141 where

142

143− initial = return Nothing'

143+ initial = return $ PRD.IPartial Nothing'

144

145 step Nothing' a =

146 return $ PRD.Continue 0 (Just' (fromIntegral a))

@@ -165,7 +165,7 @@ word32beD = PRD.Parser step initial extract

165

166 where

167

168− initial = return $ Tuple' 0 24

168+ initial = return $ PRD.IPartial $ Tuple' 0 24

169

170 step (Tuple' w sh) a = return $

171 if sh /= 0

@@ -192,7 +192,7 @@ word32leD = PRD.Parser step initial extract

192

193 where

194

195− initial = return $ Tuple' 0 0

195+ initial = return $ PRD.IPartial $ Tuple' 0 0

196

197 step (Tuple' w sh) a = return $

198 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)

@@ -218,7 +218,7 @@ word64beD = PRD.Parser step initial extract

218

219 where

220

221− initial = return $ Tuple' 0 56

221+ initial = return $ PRD.IPartial $ Tuple' 0 56

222

223 step (Tuple' w sh) a = return $

224 if sh /= 0

@@ -245,7 +245,7 @@ word64leD = PRD.Parser step initial extract

245

246 where

247

248− initial = return $ Tuple' 0 0

248+ initial = return $ PRD.IPartial $ Tuple' 0 0

249

250 step (Tuple' w sh) a = return $

251 let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)

src/Streamly/Internal/Data/Parser/ParserD.hs+126−69

@@ -15,6 +15,7 @@ module Streamly.Internal.Data.Parser.ParserD

15 Parser (..)

16 , ParseError (..)

17 , Step (..)

18+ , Initial (..)

19 -- First order parsers

20 -- First order parsers

20 -- * Accumulators

21 -- * Accumulators

@@ -191,20 +192,23 @@ import Streamly.Internal.Data.Parser.ParserD.Types

191--

192--

192{-# INLINE fromFold #-}

193{-# INLINE fromFold #-}

193fromFold :: Monad m => Fold m a b -> Parser m a b

194fromFold :: Monad m => Fold m a b -> Parser m a b

194−fromFold (Fold fstep finitial fextract) = Parser step finitial extract

195+fromFold (Fold fstep finitial fextract) = Parser step initial fextract

195

196

196 where

197 where

197

198

199+ initial = do

200+ res <- finitial

201+ return

202+ $ case res of

203+ FL.Partial s1 -> IPartial s1

204+ FL.Done b -> IDone b

205+

198− step (FL.Partial s) a = do

206+ step s a = do

199 res <- fstep s a

207 res <- fstep s a

200 return

208 return

201 $ case res of

209 $ case res of

202− FL.Partial s1 -> Partial 0 (FL.Partial s1)

210+ FL.Partial s1 -> Partial 0 s1

203 FL.Done b -> Done 0 b

211 FL.Done b -> Done 0 b

204− step (FL.Done b) _ = return $ Done 1 b

205−

206− extract (FL.Partial s) = fextract s

207− extract (FL.Done b) = return b

208

212

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

213-------------------------------------------------------------------------------

210-- Failing Parsers

214-- Failing Parsers

@@ -220,7 +224,7 @@ peek = Parser step initial extract

220

224

221 where

225 where

222

226

223− initial = return ()

227+ initial = return $ IPartial ()

224

228

225 step () a = return $ Done 1 a

229 step () a = return $ Done 1 a

226

230

@@ -236,7 +240,7 @@ eof = Parser step initial return

236

240

237 where

241 where

238

242

239− initial = return ()

243+ initial = return $ IPartial ()

240

244

241 step () _ = return $ Error "eof: not at end of input"

245 step () _ = return $ Error "eof: not at end of input"

242

246

@@ -250,7 +254,7 @@ satisfy predicate = Parser step initial extract

250

254

251 where

255 where

252

256

253− initial = return ()

257+ initial = return $ IPartial ()

254

258

255 step () a = return $

259 step () a = return $

256 if predicate a

260 if predicate a

@@ -269,7 +273,7 @@ maybe parser = Parser step initial extract

269

273

270 where

274 where

271

275

272− initial = return ()

276+ initial = return $ IPartial ()

273

277

274 step () a = return $

278 step () a = return $

275 case parser a of

279 case parser a of

@@ -288,7 +292,7 @@ either parser = Parser step initial extract

288

292

289 where

293 where

290

294

291− initial = return ()

295+ initial = return $ IPartial ()

292

296

293 step () a = return $

297 step () a = return $

294 case parser a of

298 case parser a of

@@ -315,10 +319,15 @@ takeBetween low high (Fold fstep finitial fextract) =

315

319

316 initial = do

320 initial = do

317 res <- finitial

321 res <- finitial

318− case res of

322+ return $ case res of

319− FL.Partial s -> return $ Tuple' 0 s

323+ FL.Partial s -> IPartial $ Tuple' 0 s

320− FL.Done _ ->

324+ FL.Done b ->

321− error "takeBetween: Done/Error in initial not implemented yet."

325+ if low <= 0

326+ then IDone b

327+ else IError

328+ $ "takeBetween: the collecting fold terminated without"

329+ ++ " consuming any elements"

330+ ++ " minimum" ++ show low ++ " elements needed"

322

331

323 step (Tuple' i s) a

332 step (Tuple' i s) a

324 | low > high =

333 | low > high =

@@ -374,10 +383,15 @@ takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

374

383

375 initial = do

384 initial = do

376 res <- finitial

385 res <- finitial

377− case res of

386+ return $ case res of

378− FL.Partial s -> return $ Tuple' 0 s

387+ FL.Partial s -> IPartial $ Tuple' 0 s

379− FL.Done _ ->

388+ FL.Done b ->

380− error "takeEQ: Done/Error in initial not implemented yet."

389+ if cnt == 0

390+ then IDone b

391+ else IError

392+ $ "takeEQ: Expecting exactly " ++ show cnt

393+ ++ " elements, fold terminated without"

394+ ++ " consuming any elements"

381

395

382 step (Tuple' i r) a

396 step (Tuple' i r) a

383 | i1 < cnt = do

397 | i1 < cnt = do

@@ -424,10 +438,15 @@ takeGE n (Fold fstep finitial fextract) = Parser step initial extract

424 cnt = max n 0

438 cnt = max n 0

425 initial = do

439 initial = do

426 res <- finitial

440 res <- finitial

427− case res of

441+ return $ case res of

428− FL.Partial s -> return $ Tuple' 0 s

442+ FL.Partial s -> IPartial $ Tuple' 0 s

429− FL.Done _ ->

443+ FL.Done b ->

430− error "takeGE: Done/Error in initial not implemented yet."

444+ if cnt == 0

445+ then IDone b

446+ else IError

447+ $ "takeGE: Expecting at least " ++ show cnt

448+ ++ " elements, fold terminated without"

449+ ++ " consuming any elements"

431

450

432 step (Tuple' i r) a

451 step (Tuple' i r) a

433 | i1 < cnt = do

452 | i1 < cnt = do

@@ -471,10 +490,9 @@ takeWhile predicate (Fold fstep finitial fextract) =

471

490

472 initial = do

491 initial = do

473 res <- finitial

492 res <- finitial

474− case res of

493+ return $ case res of

475− FL.Partial s -> return s

494+ FL.Partial s -> IPartial s

476− FL.Done _ ->

495+ FL.Done b -> IDone b

477− error "takeWhile: Done/Error in initial not implemented yet."

478

496

479 step s a =

497 step s a =

480 if predicate a

498 if predicate a

@@ -497,35 +515,36 @@ takeWhile1 predicate (Fold fstep finitial fextract) =

497

515

498 where

516 where

499

517

500− initial = return Nothing

518+ initial = do

501−

519+ res <- finitial

502− step Nothing a =

520+ return $ case res of

503− let err = Error "takeWhile1: predicate failed on first element"

521+ FL.Partial s -> IPartial (Left s)

504− in if predicate a

522+ FL.Done _ ->

505− then do

523+ IError

506− res <- finitial

524+ $ "takeWhile1: fold terminated without consuming:"

507− case res of

525+ ++ " any element"

508− FL.Partial s -> do

526+

527+ {-# INLINE process #-}

528+ process s a = do

509− sr <- fstep s a

529+ res <- fstep s a

510− return

530+ return

511− $ case sr of

531+ $ case res of

512− FL.Partial s1 -> Partial 0 (Just s1)

532+ FL.Partial s1 -> Partial 0 (Right s1)

513− FL.Done b -> Done 0 b

533+ FL.Done b -> Done 0 b

514− FL.Done _ -> return err

534+

515− else return err

516− step (Just s) a =

535+ step (Left s) a =

517 if predicate a

536 if predicate a

518− then do

537+ then process s a

519− sr <- fstep s a

538+ else return $ Error "takeWhile1: predicate failed on first element"

520− case sr of

539+ step (Right s) a =

521− FL.Partial r -> return $ Partial 0 (Just r)

540+ if predicate a

522− FL.Done b -> return $ Done 0 b

541+ then process s a

523 else do

542 else do

524 b <- fextract s

543 b <- fextract s

525 return $ Done 1 b

544 return $ Done 1 b

526

545

527− extract Nothing = throwM $ ParseError "takeWhile1: end of input"

546+ extract (Left _) = throwM $ ParseError "takeWhile1: end of input"

528− extract (Just s) = fextract s

547+ extract (Right s) = fextract s

529

548

530-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.

549-- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.

531--

550--

@@ -566,8 +585,8 @@ sliceBeginWith cond (Fold fstep finitial fextract) =

566 res <- finitial

585 res <- finitial

567 return $

586 return $

568 case res of

587 case res of

569− FL.Partial s -> Left' s

588+ FL.Partial s -> IPartial (Left' s)

570− FL.Done _ -> error "sliceBeginWith : bad finitial"

589+ FL.Done _ -> IError "sliceBeginWith : bad finitial"

571

590

572 {-# INLINE process #-}

591 {-# INLINE process #-}

573 process s a = do

592 process s a = do

@@ -613,8 +632,8 @@ wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract

613 res <- finitial

632 res <- finitial

614 return

633 return

615 $ case res of

634 $ case res of

616− FL.Partial s -> WBLeft s

635+ FL.Partial s -> IPartial $ WBLeft s

617− FL.Done _ -> error "wordBy: Done in initial not implemented"

636+ FL.Done b -> IDone b

618

637

619 step (WBLeft s) a =

638 step (WBLeft s) a =

620 if not (predicate a)

639 if not (predicate a)

@@ -661,8 +680,8 @@ groupBy eq (Fold fstep finitial fextract) = Parser step initial extract

661 res <- finitial

680 res <- finitial

662 return

681 return

663 $ case res of

682 $ case res of

664− FL.Partial s -> GroupByInit s

683+ FL.Partial s -> IPartial $ GroupByInit s

665− FL.Done _ -> error "groupBy: Done in initial not implemented"

684+ FL.Done b -> IDone b

666

685

667 step (GroupByInit s) a = grouper s a a

686 step (GroupByInit s) a = grouper s a a

668 step (GroupByGrouping a0 s) a =

687 step (GroupByGrouping a0 s) a =

@@ -693,8 +712,8 @@ groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract

693 res <- finitial

712 res <- finitial

694 return

713 return

695 $ case res of

714 $ case res of

696− FL.Partial s -> GroupByInit s

715+ FL.Partial s -> IPartial $ GroupByInit s

697− FL.Done _ -> error "groupByRolling: Done in initial not implemented"

716+ FL.Done b -> IDone b

698

717

699 step (GroupByInit s) a = grouper s a

718 step (GroupByInit s) a = grouper s a

700 step (GroupByGrouping a0 s) a =

719 step (GroupByGrouping a0 s) a =

@@ -718,7 +737,7 @@ eqBy cmp str = Parser step initial extract

718

737

719 where

738 where

720

739

721− initial = return str

740+ initial = return $ IPartial str

722

741

723 step [] _ = return $ Done 0 ()

742 step [] _ = return $ Done 0 ()

724 step [x] a =

743 step [x] a =

@@ -804,7 +823,12 @@ lookAhead (Parser step1 initial1 _) = Parser step initial extract

804

823

805 where

824 where

806

825

807− initial = Tuple' 0 <$> initial1

826+ initial = do

827+ res <- initial1

828+ return $ case res of

829+ IPartial s -> IPartial (Tuple' 0 s)

830+ IDone b -> IDone b

831+ IError e -> IError e

808

832

809 step (Tuple' cnt st) a = do

833 step (Tuple' cnt st) a = do

810 r <- step1 st a

834 r <- step1 st a

@@ -932,11 +956,33 @@ manyTill (Fold fstep finitial fextract)

932

956

933 where

957 where

934

958

959+ -- Caution: Mutual recursion

960+

961+ -- Don't inline this

962+ scrutL fs p c d e = do

963+ resL <- initialL

964+ case resL of

965+ IPartial sl -> return $ c (ManyTillL 0 fs sl)

966+ IDone bl -> do

967+ fr <- fstep fs bl

968+ case fr of

969+ FL.Partial fs1 -> scrutR fs1 p c d e

970+ FL.Done fb -> return $ d fb

971+ IError err -> return $ e err

972+

973+ {-# INLINE scrutR #-}

974+ scrutR fs p c d e = do

975+ resR <- initialR

976+ case resR of

977+ IPartial sr -> return $ p (ManyTillR 0 fs sr)

978+ IDone _ -> d <$> fextract fs

979+ IError _ -> scrutL fs p c d e

980+

935 initial = do

981 initial = do

936 res <- finitial

982 res <- finitial

937 case res of

983 case res of

938− FL.Partial fs -> ManyTillR 0 fs <$> initialR

984+ FL.Partial fs -> scrutR fs IPartial IPartial IDone IError

939− FL.Done _ -> error "manyTill: Done in initial not implemented"

985+ FL.Done b -> return $ IDone b

940

986

941 step (ManyTillR cnt fs st) a = do

987 step (ManyTillR cnt fs st) a = do

942 r <- stepR st a

988 r <- stepR st a

@@ -949,8 +995,20 @@ manyTill (Fold fstep finitial fextract)

949 b <- fextract fs

995 b <- fextract fs

950 return $ Done n b

996 return $ Done n b

951 Error _ -> do

997 Error _ -> do

952− rR <- initialL

998+ resL <- initialL

999+ case resL of

1000+ IPartial sl ->

953− return $ Continue (cnt + 1) (ManyTillL 0 fs rR)

1001+ return $ Continue (cnt + 1) (ManyTillL 0 fs sl)

1002+ IDone bl -> do

1003+ fr <- fstep fs bl

1004+ let cnt1 = cnt + 1

1005+ p = Partial cnt

1006+ c = Continue cnt

1007+ d = Done cnt

1008+ case fr of

1009+ FL.Partial fs1 -> scrutR fs1 p c d Error

1010+ FL.Done fb -> return $ Done cnt1 fb

1011+ IError err -> return $ Error err

954 -- XXX the cnt is being used only by the assert

1012 -- XXX the cnt is being used only by the assert

955 step (ManyTillL cnt fs st) a = do

1013 step (ManyTillL cnt fs st) a = do

956 r <- stepL st a

1014 r <- stepL st a

@@ -962,9 +1020,8 @@ manyTill (Fold fstep finitial fextract)

962 Done n b -> do

1020 Done n b -> do

963 fs1 <- fstep fs b

1021 fs1 <- fstep fs b

964 case fs1 of

1022 case fs1 of

965− FL.Partial s -> do

1023+ FL.Partial s ->

966− l <- initialR

1024+ scrutR s (Partial n) (Continue n) (Done n) Error

967− return $ Partial n (ManyTillR 0 s l)

968 FL.Done b1 -> return $ Done n b1

1025 FL.Done b1 -> return $ Done n b1

969 Error err -> return $ Error err

1026 Error err -> return $ Error err

970

1027

src/Streamly/Internal/Data/Parser/ParserD/Tee.hs+78−13

@@ -44,7 +44,7 @@ import Prelude

45import Fusion.Plugin.Types (Fuse(..))

46import Streamly.Internal.Data.Parser.ParserD.Types

47− (Parser(..), Step(..), ParseError)

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

49-------------------------------------------------------------------------------

50-- Distribute input to two parsers and collect both results

@@ -81,6 +81,7 @@ import Streamly.Internal.Data.Parser.ParserD.Types

81-- different lengths of the stream we consider the maximum of the two as

82-- consumed.

83--

84+ -- XXX We can use Initial instead of StepState

84{-# ANN type StepState Fuse #-}

85{-# ANN type StepState Fuse #-}

85data StepState s a = StepState s | StepResult a

86data StepState s a = StepState s | StepResult a

@@ -108,9 +109,24 @@ teeWith zf (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

108

109

109 {-# INLINE_LATE initial #-}

110 {-# INLINE_LATE initial #-}

110 initial = do

111 initial = do

111− sL <- initialL

112+ resL <- initialL

112− sR <- initialR

113+ resR <- initialR

114+ return $ case resL of

115+ IPartial sl ->

116+ case resR of

113− return $ TeePair ([], StepState sL, [], []) ([], StepState sR, [], [])

117+ IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])

118+ ([], StepState sr, [], [])

119+ IDone br -> IPartial $ TeePair ([], StepState sl, [], [])

120+ ([], StepResult br, [], [])

121+ IError err -> IError err

122+ IDone bl ->

123+ case resR of

124+ IPartial sr ->

125+ IPartial $ TeePair ([], StepResult bl, [], [])

126+ ([], StepState sr, [], [])

127+ IDone br -> IDone $ zf bl br

128+ IError err -> IError err

129+ IError err -> IError err

114

130

115 {-# INLINE consume #-}

131 {-# INLINE consume #-}

116 consume buf inp1 inp2 stp st y = do

132 consume buf inp1 inp2 stp st y = do

@@ -236,9 +252,22 @@ teeWithFst zf (Parser stepL initialL extractL)

236

252

237 {-# INLINE_LATE initial #-}

253 {-# INLINE_LATE initial #-}

238 initial = do

254 initial = do

239− sL <- initialL

255+ resL <- initialL

240− sR <- initialR

256+ resR <- initialR

257+ case resL of

258+ IPartial sl ->

259+ return $ case resR of

241− return $ TeePair ([], StepState sL, [], []) ([], StepState sR, [], [])

260+ IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])

261+ ([], StepState sr, [], [])

262+ IDone br -> IPartial $ TeePair ([], StepState sl, [], [])

263+ ([], StepResult br, [], [])

264+ IError err -> IError err

265+ IDone bl ->

266+ case resR of

267+ IPartial sr -> IDone . zf bl <$> extractR sr

268+ IDone br -> return $ IDone $ zf bl br

269+ IError err -> return $ IError err

270+ IError err -> return $ IError err

242

271

243 {-# INLINE consume #-}

272 {-# INLINE consume #-}

244 consume buf inp1 inp2 stp st y = do

273 consume buf inp1 inp2 stp st y = do

@@ -358,9 +387,21 @@ shortest (Parser stepL initialL extractL) (Parser stepR initialR _) =

358

387

359 {-# INLINE_LATE initial #-}

388 {-# INLINE_LATE initial #-}

360 initial = do

389 initial = do

361− sL <- initialL

390+ resL <- initialL

362− sR <- initialR

391+ resR <- initialR

392+ return $ case resL of

393+ IPartial sl ->

394+ case resR of

363− return $ TeePair ([], StepState sL, [], []) ([], StepState sR, [], [])

395+ IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])

396+ ([], StepState sr, [], [])

397+ IDone br -> IDone br

398+ IError err -> IError err

399+ IDone bl -> IDone bl

400+ IError errL ->

401+ case resR of

402+ IPartial _ -> IError errL

403+ IDone br -> IDone br

404+ IError errR -> IError errR

364

405

365 {-# INLINE consume #-}

406 {-# INLINE consume #-}

366 consume buf inp1 inp2 stp st y = do

407 consume buf inp1 inp2 stp st y = do

@@ -433,11 +474,35 @@ longest (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

433

474

434 where

475 where

435

476

477+

436 {-# INLINE_LATE initial #-}

478 {-# INLINE_LATE initial #-}

437 initial = do

479 initial = do

438− sL <- initialL

480+ resL <- initialL

439− sR <- initialR

481+ resR <- initialR

482+ return $ case resL of

483+ IPartial sl ->

484+ case resR of

485+ IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])

486+ ([], StepState sr, [], [])

440− return $ TeePair ([], StepState sL, [], []) ([], StepState sR, [], [])

487+ IDone br -> IPartial $ TeePair ([], StepState sl, [], [])

488+ ([], StepResult br, [], [])

489+ IError _ ->

490+ IPartial $ TeePair ([], StepState sl, [], [])

491+ ([], StepResult undefined, [], [])

492+ IDone bl ->

493+ case resR of

494+ IPartial sr ->

495+ IPartial $ TeePair ([], StepResult bl, [], [])

496+ ([], StepState sr, [], [])

497+ IDone _ -> IDone bl

498+ IError _ -> IDone bl

499+ IError _ ->

500+ case resR of

501+ IPartial sr ->

502+ IPartial $ TeePair ([], StepResult undefined, [], [])

503+ ([], StepState sr, [], [])

504+ IDone br -> IDone br

505+ IError err -> IError err

441

506

442 {-# INLINE consume #-}

507 {-# INLINE consume #-}

443 consume buf inp1 inp2 stp st y = do

508 consume buf inp1 inp2 stp st y = do

src/Streamly/Internal/Data/Parser/ParserD/Types.hs+260−106

@@ -36,9 +36,9 @@

36-- 'Step' functor provides the following commands to the fold driver

37-- corresponding to the use cases outlined in the previous para:

38--

39−-- 1. 'Continue': buffer the current input and go back to a previous

39+-- 1. 'Continue': buffer the current input and optionally go back to a previous

40-- position in the stream

41−-- 2. 'Partial': buffer the current input and go back to a previous

41+-- 2. 'Partial': buffer the current input and optionally go back to a previous

42-- position in the stream, drop the buffer before that position.

43-- 3. 'Done': parser succeeded, returns how much input was leftover

44-- 4. 'Error': indicates that the parser has failed without a result

@@ -111,7 +111,8 @@

111

112module Streamly.Internal.Data.Parser.ParserD.Types

113 (

114+ Initial (..)

114− Step (..)

115+ , Step (..)

115 , Parser (..)

116 , Parser (..)

116 , ParseError (..)

117 , ParseError (..)

117

118

@@ -135,6 +136,7 @@ import Control.Applicative (Alternative(..))

135import Control.Exception (assert, Exception(..))

136import Control.Exception (assert, Exception(..))

136import Control.Monad (MonadPlus(..))

137import Control.Monad (MonadPlus(..))

137import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)

138import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)

139+import Data.Bifunctor (Bifunctor(..))

138import Fusion.Plugin.Types (Fuse(..))

140import Fusion.Plugin.Types (Fuse(..))

139import Streamly.Internal.Data.Fold.Types (Fold(..), toList)

141import Streamly.Internal.Data.Fold.Types (Fold(..), toList)

140import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))

142import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))

@@ -151,6 +153,48 @@ import Prelude hiding (concatMap)

151-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse)

153-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse)

152-- >>> import qualified Streamly.Internal.Data.Parser as Parser

154-- >>> import qualified Streamly.Internal.Data.Parser as Parser

153

155

156+-- | The type of a 'Parser''s initial action.

157+--

158+-- /Internal/

159+--

160+{-# ANN type Initial Fuse #-}

161+data Initial s b

162+ = IPartial !s -- ^ Wait for step function to be called with state @s@.

163+ | IDone !b -- ^ Return a result right away without an input.

164+ | IError String -- ^ Return an error right away without an input.

165+

166+-- | @first@ maps on 'IPartial' and @second@ maps on 'IDone'.

167+--

168+-- /Internal/

169+--

170+instance Bifunctor Initial where

171+ {-# INLINE bimap #-}

172+ bimap f _ (IPartial a) = IPartial (f a)

173+ bimap _ g (IDone b) = IDone (g b)

174+ bimap _ _ (IError err) = IError err

175+

176+ {-# INLINE first #-}

177+ first f (IPartial a) = IPartial (f a)

178+ first _ (IDone x) = IDone x

179+ first _ (IError err) = IError err

180+

181+ {-# INLINE second #-}

182+ second _ (IPartial x) = IPartial x

183+ second f (IDone a) = IDone (f a)

184+ second _ (IError err) = IError err

185+

186+-- | Maps a function over the result held by 'IDone'.

187+--

188+-- @

189+-- fmap = 'second'

190+-- @

191+--

192+-- /Internal/

193+--

194+instance Functor (Initial s) where

195+ {-# INLINE fmap #-}

196+ fmap = second

197+

154-- | The return type of a 'Parser' step.

198-- | The return type of a 'Parser' step.

155--

199--

156-- The parse operation feeds the input stream to the parser one element at a

200-- The parse operation feeds the input stream to the parser one element at a

@@ -231,7 +275,7 @@ instance Functor (Step s) where

231-- /Internal/

275-- /Internal/

232--

276--

233data Parser m a b =

277data Parser m a b =

234− forall s. Parser (s -> a -> m (Step s b)) (m s) (s -> m b)

278+ forall s. Parser (s -> a -> m (Step s b)) (m (Initial s b)) (s -> m b)

235

279

236-- | This exception is used for two purposes:

280-- | This exception is used for two purposes:

237--

281--

@@ -249,11 +293,12 @@ instance Exception ParseError where

249

293

250instance Functor m => Functor (Parser m a) where

294instance Functor m => Functor (Parser m a) where

251 {-# INLINE fmap #-}

295 {-# INLINE fmap #-}

252− fmap f (Parser step1 initial extract) =

296+ fmap f (Parser step1 initial1 extract) =

253 Parser step initial (fmap2 f extract)

297 Parser step initial (fmap2 f extract)

254

298

255 where

299 where

256

300

301+ initial = fmap2 f initial1

257 step s b = fmap2 f (step1 s b)

302 step s b = fmap2 f (step1 s b)

258 fmap2 g = fmap (fmap g)

303 fmap2 g = fmap (fmap g)

259

304

@@ -263,9 +308,7 @@ instance Functor m => Functor (Parser m a) where

263--

308--

264{-# INLINE_NORMAL yield #-}

309{-# INLINE_NORMAL yield #-}

265yield :: Monad m => b -> Parser m a b

310yield :: Monad m => b -> Parser m a b

266−yield b = Parser (\_ _ -> pure $ Done 1 b) -- step

311+yield b = Parser undefined (pure $ IDone b) undefined

267− (pure ()) -- initial

268− (\_ -> pure b) -- extract

269

312

270-- | See 'Streamly.Internal.Data.Parser.yieldM'.

313-- | See 'Streamly.Internal.Data.Parser.yieldM'.

271--

314--

@@ -273,9 +316,7 @@ yield b = Parser (\_ _ -> pure $ Done 1 b) -- step

273--

316--

274{-# INLINE yieldM #-}

317{-# INLINE yieldM #-}

275yieldM :: Monad m => m b -> Parser m a b

318yieldM :: Monad m => m b -> Parser m a b

276−yieldM b = Parser (\_ _ -> Done 1 <$> b) -- step

319+yieldM b = Parser undefined (IDone <$> b) undefined

277− (pure ()) -- initial

278− (const b) -- extract

279

320

280-------------------------------------------------------------------------------

321-------------------------------------------------------------------------------

281-- Sequential applicative

322-- Sequential applicative

@@ -296,7 +337,7 @@ data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr

296-- /Internal/

337-- /Internal/

297--

338--

298{-# INLINE splitWith #-}

339{-# INLINE splitWith #-}

299−splitWith :: Monad m

340+splitWith :: MonadThrow m

300 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c

341 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c

301splitWith func (Parser stepL initialL extractL)

342splitWith func (Parser stepL initialL extractL)

302 (Parser stepR initialR extractR) =

343 (Parser stepR initialR extractR) =

@@ -304,38 +345,55 @@ splitWith func (Parser stepL initialL extractL)

304

345

305 where

346 where

306

347

348+ initial = do

307− initial = SeqParseL <$> initialL

349+ resL <- initialL

350+ case resL of

351+ IPartial sl -> return $ IPartial $ SeqParseL sl

352+ IDone bl -> do

353+ resR <- initialR

354+ return $ case resR of

355+ IPartial sr -> IPartial $ SeqParseR (func bl) sr

356+ IDone br -> IDone (func bl br)

357+ IError err -> IError err

358+ IError err -> return $ IError err

308

359

309 -- Note: For the composed parse to terminate, the left parser has to be

360 -- Note: For the composed parse to terminate, the left parser has to be

310 -- a terminating parser returning a Done at some point.

361 -- a terminating parser returning a Done at some point.

311− step (SeqParseL st) a = do

362+ step (SeqParseL st) a =

312− r <- stepL st a

363+ (\resL initR ->

313− case r of

364+ case resL of

314 -- Note: We need to buffer the input for a possible Alternative

365 -- Note: We need to buffer the input for a possible Alternative

315 -- e.g. in ((,) <$> p1 <*> p2) <|> p3, if p2 fails we have to

366 -- e.g. in ((,) <$> p1 <*> p2) <|> p3, if p2 fails we have to

316 -- backtrack and start running p3. So we need to keep the input

367 -- backtrack and start running p3. So we need to keep the input

317 -- buffered until we know that the applicative cannot fail.

368 -- buffered until we know that the applicative cannot fail.

318− Partial n s -> return $ Continue n (SeqParseL s)

369+ Partial n s -> Continue n (SeqParseL s)

319− Continue n s -> return $ Continue n (SeqParseL s)

370+ Continue n s -> Continue n (SeqParseL s)

371+ Done n b ->

372+ case initR of

320− Done n b -> Continue n <$> (SeqParseR (func b) <$> initialR)

373+ IPartial sr -> Continue n $ SeqParseR (func b) sr

321− Error err -> return $ Error err

374+ IDone br -> Done n (func b br)

375+ IError err -> Error err

376+ Error err -> Error err) <$> stepL st a <*> initialR

322

377

323− step (SeqParseR f st) a = do

378+ step (SeqParseR f st) a =

324− r <- stepR st a

325− return $ case r of

379+ (\case

326 Partial n s -> Partial n (SeqParseR f s)

380 Partial n s -> Partial n (SeqParseR f s)

327 Continue n s -> Continue n (SeqParseR f s)

381 Continue n s -> Continue n (SeqParseR f s)

328 Done n b -> Done n (f b)

382 Done n b -> Done n (f b)

329− Error err -> Error err

383+ Error err -> Error err) <$> stepR st a

330

384

331 extract (SeqParseR f sR) = fmap f (extractR sR)

385 extract (SeqParseR f sR) = fmap f (extractR sR)

332 extract (SeqParseL sL) = do

386 extract (SeqParseL sL) = do

333 rL <- extractL sL

387 rL <- extractL sL

334− sR <- initialR

388+ res <- initialR

389+ case res of

390+ IPartial sR -> do

335− rR <- extractR sR

391+ rR <- extractR sR

392+ return $ func rL rR

336− return $ func rL rR

393+ IDone rR -> return $ func rL rR

337−

394+ IError err -> throwM $ ParseError err

338−-- Only use this if you know what you're doing

395+

396+-- | Works correctly only if the first parser is guaranteed to never fail.

339{-# INLINE noErrorUnsafeSplitWith #-}

397{-# INLINE noErrorUnsafeSplitWith #-}

340noErrorUnsafeSplitWith :: Monad m

398noErrorUnsafeSplitWith :: Monad m

341 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c

399 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c

@@ -345,14 +403,34 @@ noErrorUnsafeSplitWith func (Parser stepL initialL extractL)

345

403

346 where

404 where

347

405

406+ initial = do

348− initial = SeqParseL <$> initialL

407+ resL <- initialL

408+ case resL of

409+ IPartial sl -> return $ IPartial $ SeqParseL sl

410+ IDone bl -> do

411+ resR <- initialR

412+ return $ case resR of

413+ IPartial sr -> IPartial $ SeqParseR (func bl) sr

414+ IDone br -> IDone (func bl br)

415+ IError err -> IError err

416+ IError err -> return $ IError err

349

417

418+ -- Note: For the composed parse to terminate, the left parser has to be

419+ -- a terminating parser returning a Done at some point.

350 step (SeqParseL st) a = do

420 step (SeqParseL st) a = do

351 r <- stepL st a

421 r <- stepL st a

352 case r of

422 case r of

423+ -- Assume that the first parser can never fail, therefore we do not

424+ -- need to keep the input for backtracking.

353 Partial n s -> return $ Partial n (SeqParseL s)

425 Partial n s -> return $ Partial n (SeqParseL s)

354 Continue n s -> return $ Partial n (SeqParseL s)

426 Continue n s -> return $ Partial n (SeqParseL s)

427+ Done n b -> do

428+ res <- initialR

429+ return

430+ $ case res of

355− Done n b -> Partial n <$> (SeqParseR (func b) <$> initialR)

431+ IPartial sr -> Partial n $ SeqParseR (func b) sr

432+ IDone br -> Done n (func b br)

433+ IError err -> Error err

356 Error err -> return $ Error err

434 Error err -> return $ Error err

357

435

358 step (SeqParseR f st) a = do

436 step (SeqParseR f st) a = do

@@ -366,9 +444,15 @@ noErrorUnsafeSplitWith func (Parser stepL initialL extractL)

366 extract (SeqParseR f sR) = fmap f (extractR sR)

444 extract (SeqParseR f sR) = fmap f (extractR sR)

367 extract (SeqParseL sL) = do

445 extract (SeqParseL sL) = do

368 rL <- extractL sL

446 rL <- extractL sL

369− sR <- initialR

447+ res <- initialR

448+ case res of

449+ IPartial sR -> do

370− rR <- extractR sR

450+ rR <- extractR sR

371− return $ func rL rR

451+ return $ func rL rR

452+ IDone rR -> return $ func rL rR

453+ IError err -> error $ "noErrorUnsafeSplitWith: cannot use a "

454+ ++ "failing parser. Parser failed with: " ++ err

455+

372

456

373{-# ANN type SeqAState Fuse #-}

457{-# ANN type SeqAState Fuse #-}

374data SeqAState sl sr = SeqAL sl | SeqAR sr

458data SeqAState sl sr = SeqAL sl | SeqAR sr

@@ -379,23 +463,37 @@ data SeqAState sl sr = SeqAL sl | SeqAR sr

379-- /Internal/

463-- /Internal/

380--

464--

381{-# INLINE split_ #-}

465{-# INLINE split_ #-}

382−split_ :: Monad m => Parser m x a -> Parser m x b -> Parser m x b

466+split_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b

383split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

467split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

384 Parser step initial extract

468 Parser step initial extract

385

469

386 where

470 where

387

471

388− initial = SeqAL <$> initialL

472+ initial = do

473+ resL <- initialL

474+ case resL of

475+ IPartial sl -> return $ IPartial $ SeqAL sl

476+ IDone _ -> do

477+ resR <- initialR

478+ return $ case resR of

479+ IPartial sr -> IPartial $ SeqAR sr

480+ IDone br -> IDone br

481+ IError err -> IError err

482+ IError err -> return $ IError err

389

483

390 -- Note: For the composed parse to terminate, the left parser has to be

484 -- Note: For the composed parse to terminate, the left parser has to be

391 -- a terminating parser returning a Done at some point.

485 -- a terminating parser returning a Done at some point.

392 step (SeqAL st) a =

486 step (SeqAL st) a =

393− (\r i -> case r of

487+ (\resL initR -> case resL of

394 -- Note: this leads to buffering even if we are not in an

488 -- Note: this leads to buffering even if we are not in an

395 -- Alternative composition.

489 -- Alternative composition.

396 Partial n s -> Continue n (SeqAL s)

490 Partial n s -> Continue n (SeqAL s)

397 Continue n s -> Continue n (SeqAL s)

491 Continue n s -> Continue n (SeqAL s)

492+ Done n _ -> do

493+ case initR of

398− Done n _ -> Continue n (SeqAR i)

494+ IPartial s -> Continue n (SeqAR s)

495+ IDone b -> Done n b

496+ IError err -> Error err

399 -- XXX should we sequence initialR monadically?

497 -- XXX should we sequence initialR monadically?

400 Error err -> Error err) <$> stepL st a <*> initialR

498 Error err -> Error err) <$> stepL st a <*> initialR

401

499

@@ -409,10 +507,14 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

409 extract (SeqAR sR) = extractR sR

507 extract (SeqAR sR) = extractR sR

410 extract (SeqAL sL) = do

508 extract (SeqAL sL) = do

411 _ <- extractL sL

509 _ <- extractL sL

412− initialR >>= extractR

510+ res <- initialR

511+ case res of

512+ IPartial sR -> extractR sR

513+ IDone rR -> return rR

514+ IError err -> throwM $ ParseError err

413

515

414-- | 'Applicative' form of 'splitWith'.

516-- | 'Applicative' form of 'splitWith'.

415−instance Monad m => Applicative (Parser m a) where

517+instance MonadThrow m => Applicative (Parser m a) where

416 {-# INLINE pure #-}

518 {-# INLINE pure #-}

417 pure = yield

519 pure = yield

418

520

@@ -445,7 +547,17 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

445

547

446 where

548 where

447

549

448− initial = AltParseL 0 <$> initialL

550+ initial = do

551+ resL <- initialL

552+ case resL of

553+ IPartial sl -> return $ IPartial $ AltParseL 0 sl

554+ IDone bl -> return $ IDone bl

555+ IError _ -> do

556+ resR <- initialR

557+ return $ case resR of

558+ IPartial sr -> IPartial $ AltParseR sr

559+ IDone br -> IDone br

560+ IError err -> IError err

449

561

450 -- Once a parser yields at least one value it cannot fail. This

562 -- Once a parser yields at least one value it cannot fail. This

451 -- restriction helps us make backtracking more efficient, as we do not need

563 -- restriction helps us make backtracking more efficient, as we do not need

@@ -461,8 +573,12 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

461 return $ Continue n (AltParseL (cnt + 1 - n) s)

573 return $ Continue n (AltParseL (cnt + 1 - n) s)

462 Done n b -> return $ Done n b

574 Done n b -> return $ Done n b

463 Error _ -> do

575 Error _ -> do

464− rR <- initialR

576+ res <- initialR

577+ return

578+ $ case res of

465− return $ Continue (cnt + 1) (AltParseR rR)

579+ IPartial rR -> Continue (cnt + 1) (AltParseR rR)

580+ IDone b -> Done (cnt + 1) b

581+ IError err -> Error err

466

582

467 step (AltParseR st) a = do

583 step (AltParseR st) a = do

468 r <- stepR st a

584 r <- stepR st a

@@ -486,14 +602,25 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

486

602

487 where

603 where

488

604

489− initial = do

605+ -- Caution! There is mutual recursion here, inlining the right functions is

606+ -- important.

607+

608+ {-# INLINE handleCollect #-}

609+ handleCollect partial done fres =

610+ case fres of

611+ FL.Partial fs -> do

490− ps <- initial1 -- parse state

612+ pres <- initial1

491− res <- finitial -- fold state

613+ case pres of

492− return

614+ IPartial ps -> return $ partial $ Tuple3' ps 0 fs

493− $ case res of

615+ IDone pb ->

494− FL.Partial fs -> Tuple3' ps (0 :: Int) fs

616+ runCollectorWith (handleCollect partial done) fs pb

495− FL.Done _ ->

617+ IError _ -> done <$> fextract fs

496− error "splitMany: Done in initial not implemented"

618+ FL.Done fb -> return $ done fb

619+

620+ -- Do not inline this

621+ runCollectorWith cont fs pb = fstep fs pb >>= cont

622+

623+ initial = finitial >>= handleCollect IPartial IDone

497

624

498 {-# INLINE step #-}

625 {-# INLINE step #-}

499 step (Tuple3' st cnt fs) a = do

626 step (Tuple3' st cnt fs) a = do

@@ -507,13 +634,8 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

507 assert (cnt1 - n >= 0) (return ())

634 assert (cnt1 - n >= 0) (return ())

508 return $ Continue n (Tuple3' s (cnt1 - n) fs)

635 return $ Continue n (Tuple3' s (cnt1 - n) fs)

509 Done n b -> do

636 Done n b -> do

510− s <- initial1

511− fs1 <- fstep fs b

512 assert (cnt1 - n >= 0) (return ())

637 assert (cnt1 - n >= 0) (return ())

513− return

638+ fstep fs b >>= handleCollect (Partial n) (Done n)

514− $ case fs1 of

515− FL.Partial s1 -> Partial n (Tuple3' s 0 s1)

516− FL.Done b1 -> Done n b1

517 Error _ -> do

639 Error _ -> do

518 xs <- fextract fs

640 xs <- fextract fs

519 return $ Done cnt1 xs

641 return $ Done cnt1 xs

@@ -540,14 +662,39 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

540

662

541 where

663 where

542

664

665+ -- Caution! There is mutual recursion here, inlining the right functions is

666+ -- important.

667+

668+ {-# INLINE handleCollect #-}

669+ handleCollect partial done fres =

670+ case fres of

671+ FL.Partial fs -> do

672+ pres <- initial1

673+ case pres of

674+ IPartial ps -> return $ partial $ Tuple3' ps 0 $ Right fs

675+ IDone pb ->

676+ runCollectorWith (handleCollect partial done) fs pb

677+ IError _ -> done <$> fextract fs

678+ FL.Done fb -> return $ done fb

679+

680+ -- Do not inline this

681+ runCollectorWith cont fs pb = fstep fs pb >>= cont

682+

543 initial = do

683 initial = do

544− ps <- initial1 -- parse state

545− res <- finitial -- fold state

684+ fres <- finitial

546− return

547− $ case res of

685+ case fres of

548− FL.Partial fs -> Tuple3' ps (0 :: Int) (Left fs)

686+ FL.Partial fs -> do

687+ pres <- initial1

688+ case pres of

689+ IPartial ps -> return $ IPartial $ Tuple3' ps 0 $ Left fs

690+ IDone pb ->

691+ runCollectorWith (handleCollect IPartial IDone) fs pb

692+ IError err -> return $ IError err

549− FL.Done _ ->

693+ FL.Done _ ->

550− error "splitSome: Done/Error in initial not implemented"

694+ return

695+ $ IError

696+ $ "splitSome: The collecting fold terminated without"

697+ ++ " consuming any elements."

551

698

552 {-# INLINE step #-}

699 {-# INLINE step #-}

553 step (Tuple3' st cnt (Left fs)) a = do

700 step (Tuple3' st cnt (Left fs)) a = do

@@ -563,12 +710,7 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

563 return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))

710 return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))

564 Done n b -> do

711 Done n b -> do

565 assert (cnt1 - n >= 0) (return ())

712 assert (cnt1 - n >= 0) (return ())

566− s <- initial1

713+ fstep fs b >>= handleCollect (Partial n) (Done n)

567− fs1 <- fstep fs b

568− return

569− $ case fs1 of

570− FL.Partial s1 -> Partial n (Tuple3' s 0 (Right s1))

571− FL.Done b1 -> Done n b1

572 Error err -> return $ Error err

714 Error err -> return $ Error err

573 step (Tuple3' st cnt (Right fs)) a = do

715 step (Tuple3' st cnt (Right fs)) a = do

574 r <- step1 st a

716 r <- step1 st a

@@ -582,12 +724,7 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

582 return $ Continue n (Tuple3' s (cnt1 - n) (Right fs))

724 return $ Continue n (Tuple3' s (cnt1 - n) (Right fs))

583 Done n b -> do

725 Done n b -> do

584 assert (cnt1 - n >= 0) (return ())

726 assert (cnt1 - n >= 0) (return ())

585− s <- initial1

727+ fstep fs b >>= handleCollect (Partial n) (Done n)

586− fs1 <- fstep fs b

587− return

588− $ case fs1 of

589− FL.Partial s1 -> Partial n (Tuple3' s 0 (Right s1))

590− FL.Done b1 -> Done n b1

591 Error _ -> Done cnt1 <$> fextract fs

728 Error _ -> Done cnt1 <$> fextract fs

592

729

593 -- XXX The "try" may impact performance if this parser is used as a scan

730 -- XXX The "try" may impact performance if this parser is used as a scan

@@ -613,10 +750,7 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

613--

750--

614{-# INLINE_NORMAL die #-}

751{-# INLINE_NORMAL die #-}

615die :: MonadThrow m => String -> Parser m a b

752die :: MonadThrow m => String -> Parser m a b

616−die err =

753+die err = Parser undefined (pure (IError err)) undefined

617− Parser (\_ _ -> pure $ Error err) -- step

618− (pure ()) -- initial

619− (\_ -> throwM $ ParseError err) -- extract

620

754

621-- | See 'Streamly.Internal.Data.Parser.dieM'.

755-- | See 'Streamly.Internal.Data.Parser.dieM'.

622--

756--

@@ -624,10 +758,7 @@ die err =

624--

758--

625{-# INLINE dieM #-}

759{-# INLINE dieM #-}

626dieM :: MonadThrow m => m String -> Parser m a b

760dieM :: MonadThrow m => m String -> Parser m a b

627−dieM err =

761+dieM err = Parser undefined (IError <$> err) undefined

628− Parser (\_ _ -> Error <$> err) -- step

629− (pure ()) -- initial

630− (\_ -> err >>= throwM . ParseError) -- extract

631

762

632-- Note: The default implementations of "some" and "many" loop infinitely

763-- Note: The default implementations of "some" and "many" loop infinitely

633-- because of the strict pattern match on both the arguments in applicative and

764-- because of the strict pattern match on both the arguments in applicative and

@@ -659,47 +790,70 @@ instance MonadCatch m => Alternative (Parser m a) where

659 some = splitSome toList

790 some = splitSome toList

660

791

661{-# ANN type ConcatParseState Fuse #-}

792{-# ANN type ConcatParseState Fuse #-}

662−data ConcatParseState sl p = ConcatParseL sl | ConcatParseR p

793+data ConcatParseState sl m a b =

794+ ConcatParseL sl

795+ | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m b)

663

796

664-- | See 'Streamly.Internal.Data.Parser.concatMap'.

797-- | See 'Streamly.Internal.Data.Parser.concatMap'.

665--

798--

666-- /Internal/

799-- /Internal/

667--

800--

668{-# INLINE concatMap #-}

801{-# INLINE concatMap #-}

802+concatMap :: MonadThrow m =>

669−concatMap :: Monad m => (b -> Parser m a c) -> Parser m a b -> Parser m a c

803+ (b -> Parser m a c) -> Parser m a b -> Parser m a c

670concatMap func (Parser stepL initialL extractL) = Parser step initial extract

804concatMap func (Parser stepL initialL extractL) = Parser step initial extract

671

805

672 where

806 where

673

807

808+ {-# INLINE initializeR #-}

809+ initializeR (Parser stepR initialR extractR) = do

810+ resR <- initialR

811+ return $ case resR of

812+ IPartial sr -> IPartial $ ConcatParseR stepR sr extractR

813+ IDone br -> IDone br

814+ IError err -> IError err

815+

816+ initial = do

674− initial = ConcatParseL <$> initialL

817+ res <- initialL

818+ case res of

819+ IPartial s -> return $ IPartial $ ConcatParseL s

820+ IDone b -> initializeR (func b)

821+ IError err -> return $ IError err

822+

823+ {-# INLINE initializeRL #-}

824+ initializeRL n (Parser stepR initialR extractR) = do

825+ resR <- initialR

826+ return $ case resR of

827+ IPartial sr -> Continue n $ ConcatParseR stepR sr extractR

828+ IDone br -> Done n br

829+ IError err -> Error err

675

830

676 step (ConcatParseL st) a = do

831 step (ConcatParseL st) a = do

677 r <- stepL st a

832 r <- stepL st a

678− return $ case r of

833+ case r of

679− Partial n s -> Continue n (ConcatParseL s)

834+ Partial n s -> return $ Continue n (ConcatParseL s)

680− Continue n s -> Continue n (ConcatParseL s)

835+ Continue n s -> return $ Continue n (ConcatParseL s)

681− Done n b -> Continue n (ConcatParseR (func b))

836+ Done n b -> initializeRL n (func b)

682− Error err -> Error err

837+ Error err -> return $ Error err

683

838

684− step (ConcatParseR (Parser stepR initialR extractR)) a = do

839+ step (ConcatParseR stepR st extractR) a = do

685− st <- initialR

686 r <- stepR st a

840 r <- stepR st a

687 return $ case r of

841 return $ case r of

688− Partial n s ->

689− Partial n (ConcatParseR (Parser stepR (return s) extractR))

842+ Partial n s -> Partial n $ ConcatParseR stepR s extractR

690− Continue n s ->

691− Continue n (ConcatParseR (Parser stepR (return s) extractR))

843+ Continue n s -> Continue n $ ConcatParseR stepR s extractR

692 Done n b -> Done n b

844 Done n b -> Done n b

693 Error err -> Error err

845 Error err -> Error err

694

846

847+ {-# INLINE extractP #-}

695− extract (ConcatParseR (Parser _ initialR extractR)) =

848+ extractP (Parser _ initialR extractR) = do

696− initialR >>= extractR

849+ res <- initialR

697−

850+ case res of

698− extract (ConcatParseL sL) = extractL sL >>= f . func

851+ IPartial s -> extractR s

699−

852+ IDone b -> return b

700− where

853+ IError err -> throwM $ ParseError err

701

854

702− f (Parser _ initialR extractR) = initialR >>= extractR

855+ extract (ConcatParseR _ s extractR) = extractR s

856+ extract (ConcatParseL sL) = extractL sL >>= extractP . func

703

857

704-- Note: The monad instance has quadratic performance complexity. It works fine

858-- Note: The monad instance has quadratic performance complexity. It works fine

705-- for small number of compositions but for a scalable implementation we need a

859-- for small number of compositions but for a scalable implementation we need a

@@ -707,7 +861,7 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract

707

861

708-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Types.Parser'.

862-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Types.Parser'.

709--

863--

710−instance Monad m => Monad (Parser m a) where

864+instance MonadThrow m => Monad (Parser m a) where

711 {-# INLINE return #-}

865 {-# INLINE return #-}

712 return = pure

866 return = pure

713

867

src/Streamly/Internal/Data/Parser/ParserK/Types.hs+18−12

@@ -112,15 +112,19 @@ newtype Parser m a b = MkParser

112parseDToK

113 :: MonadCatch m

114 => (s -> a -> m (D.Step s b))

115− -> m s

115+ -> m (D.Initial s b)

116 -> (s -> m b)

117 -> Int

118 -> (Int, Int)

119 -> ((Int, Int) -> Parse b -> m (Driver m a r))

120 -> m (Driver m a r)

121

122−parseDToK pstep initial extract leftover (0, _) cont =

122+parseDToK pstep initial extract leftover (0, _) cont = do

123+ res <- initial

124+ case res of

123− return $ Continue leftover (parseCont initial)

125+ D.IPartial r -> return $ Continue leftover (parseCont (return r))

126+ D.IDone b -> cont (0,0) (Done 0 b)

127+ D.IError err -> cont (0,0) (Error err)

124

128

125 where

129 where

126

130

@@ -140,8 +144,12 @@ parseDToK pstep initial extract leftover (0, _) cont =

140 Left (e :: D.ParseError) -> cont (0,0) (Error (displayException e))

144 Left (e :: D.ParseError) -> cont (0,0) (Error (displayException e))

141 Right b -> cont (0,0) (Done 0 b)

145 Right b -> cont (0,0) (Done 0 b)

142

146

143−parseDToK pstep initial extract leftover (level, count) cont =

147+parseDToK pstep initial extract leftover (level, count) cont = do

148+ res <- initial

149+ case res of

144− return $ Continue leftover (parseCont count initial)

150+ D.IPartial r -> return $ Continue leftover (parseCont count (return r))

151+ D.IDone b -> cont (level,count) (Done 0 b)

152+ D.IError err -> cont (level,count) (Error err)

145

153

146 where

154 where

147

155

@@ -203,7 +211,7 @@ extractParse cont = do

203 Continue _ cont1 -> extractParse cont1

211 Continue _ cont1 -> extractParse cont1

204 Failed e -> throwM $ D.ParseError e

212 Failed e -> throwM $ D.ParseError e

205

213

206−data FromParserK b e c = FPKDone !Int !b | FPKError !e | FPKCont c

214+data FromParserK b c = FPKDone !Int !b | FPKCont c

207

215

208-- | Convert a CPS style 'Parser' to a direct style 'D.Parser'.

216-- | Convert a CPS style 'Parser' to a direct style 'D.Parser'.

209--

217--

@@ -221,10 +229,10 @@ fromParserK parser = D.Parser step initial extract

221 initial = do

229 initial = do

222 r <- runParser parser 0 (0,0) parserDone

230 r <- runParser parser 0 (0,0) parserDone

223 return $ case r of

231 return $ case r of

224− Stop n b -> FPKDone n b

232+ Stop n b -> D.IPartial $ FPKDone n b

225− Failed e -> FPKError e

233+ Failed e -> D.IError e

226− Partial _ cont -> FPKCont cont -- XXX can we get this?

234+ Partial _ cont -> D.IPartial $ FPKCont cont -- XXX can we get this?

227− Continue _ cont -> FPKCont cont

235+ Continue _ cont -> D.IPartial $ FPKCont cont

228

236

229 -- Note, we can only reach FPKDone and FPKError from "initial". FPKCont

237 -- Note, we can only reach FPKDone and FPKError from "initial". FPKCont

230 -- always transitions to only FPKCont. The input remains unconsumed in

238 -- always transitions to only FPKCont. The input remains unconsumed in

@@ -232,7 +240,6 @@ fromParserK parser = D.Parser step initial extract

232 step (FPKDone n b) _ = do

240 step (FPKDone n b) _ = do

233 assertM (n == 0)

241 assertM (n == 0)

234 return $ D.Done (n + 1) b

242 return $ D.Done (n + 1) b

235− step (FPKError e) _ = return $ D.Error e

236 step (FPKCont cont) a = do

243 step (FPKCont cont) a = do

237 r <- cont (Just a)

244 r <- cont (Just a)

238 return $ case r of

245 return $ case r of

@@ -243,7 +250,6 @@ fromParserK parser = D.Parser step initial extract

243

250

244 -- Note, we can only reach FPKDone and FPKError from "initial".

251 -- Note, we can only reach FPKDone and FPKError from "initial".

245 extract (FPKDone _ b) = return b

252 extract (FPKDone _ b) = return b

246− extract (FPKError e) = throwM $ D.ParseError e

247 extract (FPKCont cont) = extractParse cont

253 extract (FPKCont cont) = extractParse cont

248

254

249#ifndef DISABLE_FUSION

255#ifndef DISABLE_FUSION

src/Streamly/Internal/Data/Producer/Source.hs+7−2

@@ -122,8 +122,13 @@ parseD

122 (Producer ustep uinject uextract)

123 seed = do

124

125+ res <- initial

126+ case res of

127+ ParserD.IPartial s -> do

125− state <- uinject seed

128+ state <- uinject seed

126− initial >>= go SPEC state (List [])

129+ go SPEC state (List []) s

130+ ParserD.IDone b -> return (b, seed)

131+ ParserD.IError err -> throwM $ ParseError err

127

132

128 where

133 where

129

134

src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs+1−1

@@ -338,7 +338,7 @@ runSink = fold . toFold

338--

339{-# INLINE_NORMAL parseD #-}

340parseD :: MonadThrow m => PRD.Parser m a b -> SerialT m a -> m b

341−parseD (PRD.Parser step initial extract) = P.parselMx' step initial extract

341+parseD p = D.parse p . toStreamD

342

343{-# INLINE parseK #-}

344parseK :: MonadThrow m => PRK.Parser m a b -> SerialT m a -> m b

src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs+63−1

@@ -16,7 +16,7 @@ module Streamly.Internal.Data.Stream.StreamD.Eliminate

16 foldOnce -- XXX rename to "fold"

18 -- -- * Running a 'Parser'

19− -- , parse

19+ , parse

21 -- * Stream Deconstruction

22 , uncons

@@ -83,6 +83,7 @@ import GHC.Types (SPEC(..))

83import Streamly.Internal.Data.Parser (ParseError(..))

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

86+import qualified Streamly.Internal.Data.Parser.ParserD as PRD

87import Prelude hiding

88import Prelude hiding

88 ( all, any, elem, foldr, foldr1, head, last, lookup, mapM, mapM_

89 ( all, any, elem, foldr, foldr1, head, last, lookup, mapM, mapM_

@@ -193,6 +194,67 @@ parselMx' pstep initial extract (Stream step state) = do

193 PR.Done _ b -> return b

194 PR.Done _ b -> return b

194 PR.Error err -> throwM $ ParseError err

195 PR.Error err -> throwM $ ParseError err

195

196

197+-- | Run a 'Parse' over a stream.

198+{-# INLINE_NORMAL parse #-}

199+parse :: MonadThrow m => PRD.Parser m a b -> Stream m a -> m b

200+parse (PRD.Parser pstep initial extract) (Stream step state) = do

201+ res <- initial

202+ case res of

203+ PRD.IPartial s -> go SPEC state (List []) s

204+ PRD.IDone b -> return b

205+ PRD.IError err -> throwM $ ParseError err

206+

207+ where

208+

209+ -- XXX currently we are using a dumb list based approach for backtracking

210+ -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.

211+ -- That will allow us more efficient random back and forth movement.

212+ {-# INLINE go #-}

213+ go !_ st buf !pst = do

214+ r <- step defState st

215+ case r of

216+ Yield x s -> do

217+ pRes <- pstep pst x

218+ case pRes of

219+ PR.Partial 0 pst1 -> go SPEC s (List []) pst1

220+ PR.Partial n pst1 -> do

221+ assert (n <= length (x:getList buf)) (return ())

222+ let src0 = Prelude.take n (x:getList buf)

223+ src = Prelude.reverse src0

224+ gobuf SPEC s (List []) (List src) pst1

225+ PR.Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1

226+ PR.Continue n pst1 -> do

227+ assert (n <= length (x:getList buf)) (return ())

228+ let (src0, buf1) = splitAt n (x:getList buf)

229+ src = Prelude.reverse src0

230+ gobuf SPEC s (List buf1) (List src) pst1

231+ -- Specialcase the Done 1 case

232+ PR.Done _ b -> return b

233+ PR.Error err -> throwM $ ParseError err

234+ Skip s -> go SPEC s buf pst

235+ Stop -> extract pst

236+

237+ gobuf !_ s buf (List []) !pst = go SPEC s buf pst

238+ gobuf !_ s buf (List (x:xs)) !pst = do

239+ pRes <- pstep pst x

240+ case pRes of

241+ PR.Partial 0 pst1 ->

242+ gobuf SPEC s (List []) (List xs) pst1

243+ PR.Partial n pst1 -> do

244+ assert (n <= length (x:getList buf)) (return ())

245+ let src0 = Prelude.take n (x:getList buf)

246+ src = Prelude.reverse src0 ++ xs

247+ gobuf SPEC s (List []) (List src) pst1

248+ PR.Continue 0 pst1 ->

249+ gobuf SPEC s (List (x:getList buf)) (List xs) pst1

250+ PR.Continue n pst1 -> do

251+ assert (n <= length (x:getList buf)) (return ())

252+ let (src0, buf1) = splitAt n (x:getList buf)

253+ src = Prelude.reverse src0 ++ xs

254+ gobuf SPEC s (List buf1) (List src) pst1

255+ PR.Done _ b -> return b

256+ PR.Error err -> throwM $ ParseError err

257+

196------------------------------------------------------------------------------

258------------------------------------------------------------------------------

197-- Specialized Folds

259-- Specialized Folds

198------------------------------------------------------------------------------

260------------------------------------------------------------------------------

src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs+49−34

@@ -986,13 +986,28 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) =

986 stepOuter gst (ParseChunksInit [] st) = do

987 r <- step (adaptState gst) st

988 case r of

989+ Yield x s -> do

990+ res <- initial

991+ case res of

992+ PRD.IPartial ps ->

989− Yield x s -> initial >>= return . Skip . ParseChunksBuf [x] s []

993+ return $ Skip $ ParseChunksBuf [x] s [] ps

994+ PRD.IDone pb ->

995+ let next = ParseChunksInit [x] s

996+ in return $ Skip $ ParseChunksYield pb next

997+ PRD.IError err -> throwM $ ParseError err

990 Skip s -> return $ Skip $ ParseChunksInit [] s

998 Skip s -> return $ Skip $ ParseChunksInit [] s

991 Stop -> return Stop

999 Stop -> return Stop

992

1000

993 -- Buffer is not empty, go to buffered processing loop

1001 -- Buffer is not empty, go to buffered processing loop

994 stepOuter _ (ParseChunksInit src st) = do

1002 stepOuter _ (ParseChunksInit src st) = do

1003+ res <- initial

1004+ case res of

1005+ PRD.IPartial ps ->

995− initial >>= return . Skip . ParseChunksBuf src st []

1006+ return $ Skip $ ParseChunksBuf src st [] ps

1007+ PRD.IDone pb ->

1008+ let next = ParseChunksInit src st

1009+ in return $ Skip $ ParseChunksYield pb next

1010+ PRD.IError err -> throwM $ ParseError err

996

1011

997 -- XXX we just discard any leftover input at the end

1012 -- XXX we just discard any leftover input at the end

998 stepOuter _ (ParseChunksInitLeftOver _) = return Stop

1013 stepOuter _ (ParseChunksInitLeftOver _) = return Stop

@@ -1067,12 +1082,12 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) =

1067 stepOuter _ (ParseChunksYield a next) = return $ Yield a next

1082 stepOuter _ (ParseChunksYield a next) = return $ Yield a next

1068

1083

1069{-# ANN type ConcatParseState Fuse #-}

1084{-# ANN type ConcatParseState Fuse #-}

1070−data ConcatParseState x inpBuf st p =

1085+data ConcatParseState b inpBuf st p m a =

1071 ConcatParseInit inpBuf st p

1086 ConcatParseInit inpBuf st p

1072 | ConcatParseInitLeftOver inpBuf

1087 | ConcatParseInitLeftOver inpBuf

1073− | ConcatParseStream st inpBuf p

1088+ | forall s. ConcatParseStream st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m b)

1074− | ConcatParseBuf inpBuf st inpBuf p

1089+ | forall s. ConcatParseBuf inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m b)

1075− | ConcatParseYield x (ConcatParseState x inpBuf st p)

1090+ | ConcatParseYield b (ConcatParseState b inpBuf st p m a)

1076

1091

1077{-# INLINE_NORMAL parseIterate #-}

1092{-# INLINE_NORMAL parseIterate #-}

1078parseIterate

1093parseIterate

@@ -1089,44 +1104,51 @@ parseIterate func seed (Stream step state) =

1089 {-# INLINE_LATE stepOuter #-}

1104 {-# INLINE_LATE stepOuter #-}

1090 -- Buffer is empty, go to stream processing loop

1105 -- Buffer is empty, go to stream processing loop

1091 stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do

1106 stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do

1107+ res <- initial

1108+ case res of

1109+ PRD.IPartial ps ->

1092− initial >>= \r -> return $ Skip $ ConcatParseStream st []

1110+ return $ Skip $ ConcatParseStream st [] pstep ps extract

1093− (PRD.Parser pstep (return r) extract)

1111+ PRD.IDone pb ->

1112+ let next = ConcatParseInit [] st (func pb)

1113+ in return $ Skip $ ConcatParseYield pb next

1114+ PRD.IError err -> throwM $ ParseError err

1094

1115

1095 -- Buffer is not empty, go to buffered processing loop

1116 -- Buffer is not empty, go to buffered processing loop

1096 stepOuter _ (ConcatParseInit src st

1117 stepOuter _ (ConcatParseInit src st

1097 (PRD.Parser pstep initial extract)) = do

1118 (PRD.Parser pstep initial extract)) = do

1119+ res <- initial

1120+ case res of

1121+ PRD.IPartial ps ->

1098− initial >>= \r -> return $ Skip $ ConcatParseBuf src st []

1122+ return $ Skip $ ConcatParseBuf src st [] pstep ps extract

1099− (PRD.Parser pstep (return r) extract)

1123+ PRD.IDone pb ->

1124+ let next = ConcatParseInit src st (func pb)

1125+ in return $ Skip $ ConcatParseYield pb next

1126+ PRD.IError err -> throwM $ ParseError err

1100

1127

1101 -- XXX we just discard any leftover input at the end

1128 -- XXX we just discard any leftover input at the end

1102 stepOuter _ (ConcatParseInitLeftOver _) = return Stop

1129 stepOuter _ (ConcatParseInitLeftOver _) = return Stop

1103

1130

1104 -- Buffer is empty process elements from the stream

1131 -- Buffer is empty process elements from the stream

1105− stepOuter gst (ConcatParseStream st buf

1132+ stepOuter gst (ConcatParseStream st buf pstep pst extract) = do

1106− p@(PRD.Parser pstep initial extract)) = do

1107 r <- step (adaptState gst) st

1133 r <- step (adaptState gst) st

1108 case r of

1134 case r of

1109 Yield x s -> do

1135 Yield x s -> do

1110− pst <- initial

1111 pRes <- pstep pst x

1136 pRes <- pstep pst x

1112 case pRes of

1137 case pRes of

1113 PR.Partial 0 pst1 ->

1138 PR.Partial 0 pst1 ->

1114− return $ Skip $ ConcatParseStream s []

1139+ return $ Skip $ ConcatParseStream s [] pstep pst1 extract

1115− (PRD.Parser pstep (return pst1) extract)

1116 PR.Partial n pst1 -> do

1140 PR.Partial n pst1 -> do

1117 assert (n <= length (x:buf)) (return ())

1141 assert (n <= length (x:buf)) (return ())

1118 let src0 = Prelude.take n (x:buf)

1142 let src0 = Prelude.take n (x:buf)

1119 src = Prelude.reverse src0

1143 src = Prelude.reverse src0

1120− return $ Skip $ ConcatParseBuf src s []

1144+ return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract

1121− (PRD.Parser pstep (return pst1) extract)

1122 -- PR.Continue 0 pst1 ->

1145 -- PR.Continue 0 pst1 ->

1123 -- return $ Skip $ ConcatParseStream s (x:buf) pst1

1146 -- return $ Skip $ ConcatParseStream s (x:buf) pst1

1124 PR.Continue n pst1 -> do

1147 PR.Continue n pst1 -> do

1125 assert (n <= length (x:buf)) (return ())

1148 assert (n <= length (x:buf)) (return ())

1126 let (src0, buf1) = splitAt n (x:buf)

1149 let (src0, buf1) = splitAt n (x:buf)

1127 src = Prelude.reverse src0

1150 src = Prelude.reverse src0

1128− return $ Skip $ ConcatParseBuf src s buf1

1151+ return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract

1129− (PRD.Parser pstep (return pst1) extract)

1130 -- XXX Specialize for Stop 0 common case?

1152 -- XXX Specialize for Stop 0 common case?

1131 PR.Done n b -> do

1153 PR.Done n b -> do

1132 assert (n <= length (x:buf)) (return ())

1154 assert (n <= length (x:buf)) (return ())

@@ -1134,40 +1156,33 @@ parseIterate func seed (Stream step state) =

1134 return $ Skip $

1156 return $ Skip $

1135 ConcatParseYield b (ConcatParseInit src s (func b))

1157 ConcatParseYield b (ConcatParseInit src s (func b))

1136 PR.Error err -> throwM $ ParseError err

1158 PR.Error err -> throwM $ ParseError err

1137− Skip s -> return $ Skip $ ConcatParseStream s buf p

1159+ Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract

1138 Stop -> do

1160 Stop -> do

1139− pst <- initial

1140 b <- extract pst

1161 b <- extract pst

1141 let src = Prelude.reverse buf

1162 let src = Prelude.reverse buf

1142− return $ Skip $

1143− ConcatParseYield b (ConcatParseInitLeftOver src)

1163+ return $ Skip $ ConcatParseYield b (ConcatParseInitLeftOver src)

1144

1164

1145 -- go back to stream processing mode

1165 -- go back to stream processing mode

1146− stepOuter _ (ConcatParseBuf [] s buf p) =

1166+ stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) =

1147− return $ Skip $ ConcatParseStream s buf p

1167+ return $ Skip $ ConcatParseStream s buf pstep ps extract

1148

1168

1149 -- buffered processing loop

1169 -- buffered processing loop

1150− stepOuter _ (ConcatParseBuf (x:xs) s buf

1170+ stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do

1151− (PRD.Parser pstep initial extract)) = do

1152− pst <- initial

1153 pRes <- pstep pst x

1171 pRes <- pstep pst x

1154 case pRes of

1172 case pRes of

1155 PR.Partial 0 pst1 ->

1173 PR.Partial 0 pst1 ->

1156− return $ Skip $ ConcatParseBuf xs s []

1174+ return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract

1157− (PRD.Parser pstep (return pst1) extract)

1158 PR.Partial n pst1 -> do

1175 PR.Partial n pst1 -> do

1159 assert (n <= length (x:buf)) (return ())

1176 assert (n <= length (x:buf)) (return ())

1160 let src0 = Prelude.take n (x:buf)

1177 let src0 = Prelude.take n (x:buf)

1161 src = Prelude.reverse src0 ++ xs

1178 src = Prelude.reverse src0 ++ xs

1162− return $ Skip $ ConcatParseBuf src s []

1179+ return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract

1163− (PRD.Parser pstep (return pst1) extract)

1164 -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1

1180 -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1

1165 PR.Continue n pst1 -> do

1181 PR.Continue n pst1 -> do

1166 assert (n <= length (x:buf)) (return ())

1182 assert (n <= length (x:buf)) (return ())

1167 let (src0, buf1) = splitAt n (x:buf)

1183 let (src0, buf1) = splitAt n (x:buf)

1168 src = Prelude.reverse src0 ++ xs

1184 src = Prelude.reverse src0 ++ xs

1169− return $ Skip $ ConcatParseBuf src s buf1

1185+ return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract

1170− (PRD.Parser pstep (return pst1) extract)

1171 -- XXX Specialize for Stop 0 common case?

1186 -- XXX Specialize for Stop 0 common case?

1172 PR.Done n b -> do

1187 PR.Done n b -> do

1173 assert (n <= length (x:buf)) (return ())

1188 assert (n <= length (x:buf)) (return ())