60d3228 · streamly · git.iko.soy

git.iko.soy/streamly

Combine Yield and YieldB constructors

Yield 0: now means a partial result is available Yield n: means a partial result is available, and we need to backtrack by n elements.

commit60d322812b7e69711c82f0b1700971baa9f6ba8a authorHarendra Kumar <harendra@composewell.com> dateTue 23 Jun 2020, 16:01 (6 years ago) parent55d49bd

6 files changed+54−103

compare with master

unifiedsplit

bin/bench-exec-one.sh+2−2 src/Streamly/Internal/Data/Parser/ParserD.hs+2−5 src/Streamly/Internal/Data/Parser/ParserD/Tee.hs+15−15 src/Streamly/Internal/Data/Parser/ParserD/Types.hs+14−34 src/Streamly/Internal/Data/Stream/StreamD.hs+14−31 src/Streamly/Internal/Data/Zipper.hs+7−16

bin/bench-exec-one.sh+2−2

@@ -64,8 +64,8 @@ bench_rts_opts_specific () {

6464 Prelude.WAsync/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;

6565

6666 # XXX need to investigate these, taking too much stack

67− Data.Parser.ParserD/o-1-space/some) echo -n "-K1M" ;;

68− Data.Parser/o-1-space/some) echo -n "-K1M" ;;

67+ Data.Parser.ParserD/o-1-space/some) echo -n "-K8M" ;;

68+ Data.Parser/o-1-space/some) echo -n "-K8M" ;;

6969 Data.Parser.ParserD/o-1-space/manyTill) echo -n "-K4M" ;;

7070 Data.Parser/o-1-space/manyTill) echo -n "-K4M" ;;

7171

src/Streamly/Internal/Data/Parser/ParserD.hs+2−5

@@ -588,8 +588,7 @@ lookAhead (Parser step1 initial1 _) =

588588 r <- step1 st a

589589 let cnt1 = cnt + 1

590590 return $ case r of

591− Yield _ s -> Skip 0 (Tuple' cnt1 s)

592− YieldB n s -> Skip n (Tuple' (cnt1 - n) s)

591+ Yield n s -> Skip n (Tuple' (cnt1 - n) s)

593592 Skip n s -> Skip n (Tuple' (cnt1 - n) s)

594593 Stop _ b -> Stop cnt1 b

595594 Error err -> Error err

@@ -713,7 +712,6 @@ manyTill (Fold fstep finitial fextract)

713712 r <- stepR st a

714713 case r of

715714 Yield n s -> return $ Yield n (ManyTillR 0 fs s)

716− YieldB n s -> return $ YieldB n (ManyTillR 0 fs s)

717715 Skip n s -> do

718716 assert (cnt + 1 - n >= 0) (return ())

719717 return $ Skip n (ManyTillR (cnt + 1 - n) fs s)

@@ -728,12 +726,11 @@ manyTill (Fold fstep finitial fextract)

728726 r <- stepL st a

729727 case r of

730728 Yield n s -> return $ Yield n (ManyTillL fs s)

731− YieldB n s -> return $ YieldB n (ManyTillL fs s)

732729 Skip n s -> return $ Skip n (ManyTillL fs s)

733730 Stop n b -> do

734731 fs1 <- fstep fs b

735732 l <- initialR

736− return $ YieldB n (ManyTillR 0 fs1 l)

733+ return $ Yield n (ManyTillR 0 fs1 l)

737734 Error err -> return $ Error err

738735

739736 extract (ManyTillL fs sR) = extractL sR >>= fstep fs >>= fextract

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

@@ -137,10 +137,10 @@ teeWith zf (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

137137 useStream buf inp1 inp2 stp st y = do

138138 (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y

139139 case r of

140+ Yield 0 s ->

141+ let state = ([], StepState s, inp11, inp21)

142+ in return (state, Yld 0)

140143 Yield n s ->

141− let state = (Prelude.take n buf1, StepState s, inp11, inp21)

142− in assert (n <= length buf1) (return (state, Yld n))

143− YieldB n s ->

144144 let src0 = Prelude.take n buf1

145145 src = Prelude.reverse src0

146146 state = ([], StepState s, src ++ inp11, inp21)

@@ -261,10 +261,10 @@ teeWithFst zf (Parser stepL initialL extractL)

261261 useStream buf inp1 inp2 stp st y = do

262262 (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y

263263 case r of

264− Yield n s ->

265− let state = (Prelude.take n buf1, StepState s, inp11, inp21)

266− in assert (n <= length buf1) (return (state, Yld n))

267− YieldB _ _ -> undefined

264+ Yield 0 s ->

265+ let state = ([], StepState s, inp11, inp21)

266+ in return (state, Yld 0)

267+ Yield n _ -> return (undefined, Yld n) -- Not implemented

268268 Stop n b ->

269269 let state = (Prelude.take n buf1, StepResult b, inp11, inp21)

270270 in assert (n <= length buf1) (return (state, Stp n))

@@ -383,10 +383,10 @@ shortest (Parser stepL initialL extractL) (Parser stepR initialR _) =

383383 useStream buf inp1 inp2 stp st y = do

384384 (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y

385385 case r of

386− Yield n s ->

387− let state = (Prelude.take n buf1, StepState s, inp11, inp21)

388− in assert (n <= length buf1) (return (state, Yld n))

389− YieldB _ _ -> undefined

386+ Yield 0 s ->

387+ let state = ([], StepState s, inp11, inp21)

388+ in return (state, Yld 0)

389+ Yield n _ -> return (undefined, Yld n) -- Not implemented

390390 Stop n b ->

391391 let state = (Prelude.take n buf1, StepResult b, inp11, inp21)

392392 in assert (n <= length buf1) (return (state, Stp n))

@@ -460,10 +460,10 @@ longest (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

460460 useStream buf inp1 inp2 stp st y = do

461461 (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y

462462 case r of

463− Yield n s ->

464− let state = (Prelude.take n buf1, StepState s, inp11, inp21)

465− in assert (n <= length buf1) (return (state, Yld n))

466− YieldB _ _ -> undefined

463+ Yield 0 s ->

464+ let state = ([], StepState s, inp11, inp21)

465+ in return (state, Yld 0)

466+ Yield n _ -> return (undefined, Yld n) -- Not implemented

467467 Stop n b ->

468468 let state = (Prelude.take n buf1, StepResult b, inp11, inp21)

469469 in assert (n <= length buf1) (return (state, Stp n))

src/Streamly/Internal/Data/Parser/ParserD/Types.hs+14−34

@@ -161,20 +161,13 @@ import Streamly.Internal.Data.Strict (Tuple3'(..))

161161--

162162{-# ANN type Step Fuse #-}

163163data Step s b =

164− Yield Int s

165− -- ^ Trim the backtracking buffer keeping only most recent @n@ items.

166− -- @Yield n state@ indicates that the parser has yielded a new result

167− -- which is a point of no return. The result can be extracted using

168− -- @extract@. The driver drops the buffer except @n@ most recent

169− -- elements. The rule is that if a parser has yielded at least once it

170− -- cannot return a failure result.

171−

172− | YieldB Int s

164+ Yield Int s

173165 -- ^ Go back by @n@ items in the input buffer and drop the rest.

174− -- @YieldB n state@ indicates that the parser has yielded a new result

166+ -- @Yield n state@ indicates that the parser has yielded a new result

175167 -- which is a point of no return. The result can be extracted using

176168 -- @extract@. The driver moves back the current position of the cursor by

177− -- @n@ elements and drops any buffer before that.

169+ -- @n@ elements and drops any buffer before that. The rule is that if a

170+ -- parser has yielded at least once it cannot return a failure result.

178171

179172 -- only rewind

180173 | Skip Int s

@@ -202,7 +195,6 @@ data Step s b =

202195instance Functor (Step s) where

203196 {-# INLINE fmap #-}

204197 fmap _ (Yield n s) = Yield n s

205− fmap _ (YieldB n s) = YieldB n s

206198 fmap _ (Skip n s) = Skip n s

207199 fmap f (Stop n b) = Stop n (f b)

208200 fmap _ (Error err) = Error err

@@ -303,8 +295,7 @@ splitWith func (Parser stepL initialL extractL)

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

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

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

306− Yield _ s -> return $ Skip 0 (SeqParseL s)

307− YieldB n s -> return $ Skip n (SeqParseL s)

298+ Yield n s -> return $ Skip n (SeqParseL s)

308299 Skip n s -> return $ Skip n (SeqParseL s)

309300 Stop n b -> Skip n <$> (SeqParseR (func b) <$> initialR)

310301 Error err -> return $ Error err

@@ -313,7 +304,6 @@ splitWith func (Parser stepL initialL extractL)

313304 r <- stepR st a

314305 return $ case r of

315306 Yield n s -> Yield n (SeqParseR f s)

316− YieldB n s -> YieldB n (SeqParseR f s)

317307 Skip n s -> Skip n (SeqParseR f s)

318308 Stop n b -> Stop n (f b)

319309 Error err -> Error err

@@ -348,8 +338,7 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

348338 (\r i -> case r of

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

350340 -- Alternative composition.

351− Yield _ s -> Skip 0 (SeqAL s)

352− YieldB n s -> Skip n (SeqAL s)

341+ Yield n s -> Skip n (SeqAL s)

353342 Skip n s -> Skip n (SeqAL s)

354343 Stop n _ -> Skip n (SeqAR i)

355344 -- XXX should we sequence initialR monadically?

@@ -358,7 +347,6 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

358347 step (SeqAR st) a = do

359348 (\r -> case r of

360349 Yield n s -> Yield n (SeqAR s)

361− YieldB n s -> YieldB n (SeqAR s)

362350 Skip n s -> Skip n (SeqAR s)

363351 Stop n b -> Stop n b

364352 Error err -> Error err) <$> stepR st a

@@ -413,7 +401,6 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

413401 r <- stepL st a

414402 case r of

415403 Yield n s -> return $ Yield n (AltParseL 0 s)

416− YieldB n s -> return $ YieldB n (AltParseL 0 s)

417404 Skip n s -> do

418405 assert (cnt + 1 - n >= 0) (return ())

419406 return $ Skip n (AltParseL (cnt + 1 - n) s)

@@ -426,7 +413,6 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =

426413 r <- stepR st a

427414 return $ case r of

428415 Yield n s -> Yield n (AltParseR s)

429− YieldB n s -> YieldB n (AltParseR s)

430416 Skip n s -> Skip n (AltParseR s)

431417 Stop n b -> Stop n b

432418 Error err -> Error err

@@ -455,8 +441,7 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

455441 r <- step1 st a

456442 let cnt1 = cnt + 1

457443 case r of

458− Yield _ s -> return $ Skip 0 (Tuple3' s cnt1 fs)

459− YieldB n s -> do

444+ Yield n s -> do

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

461446 return $ Skip n (Tuple3' s (cnt1 - n) fs)

462447 Skip n s -> do

@@ -465,7 +450,7 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

465450 Stop n b -> do

466451 s <- initial1

467452 fs1 <- fstep fs b

468− return $ YieldB n (Tuple3' s 0 fs1)

453+ return $ Yield n (Tuple3' s 0 fs1)

469454 Error _ -> do

470455 xs <- fextract fs

471456 return $ Stop cnt1 xs

@@ -497,29 +482,27 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

497482 step (Tuple3' st _ (Left fs)) a = do

498483 r <- step1 st a

499484 case r of

500− Yield _ s -> return $ Skip 0 (Tuple3' s undefined (Left fs))

501− YieldB n s -> return $ Skip n (Tuple3' s undefined (Left fs))

485+ Yield n s -> return $ Skip n (Tuple3' s undefined (Left fs))

502486 Skip n s -> return $ Skip n (Tuple3' s undefined (Left fs))

503487 Stop n b -> do

504488 s <- initial1

505489 fs1 <- fstep fs b

506− return $ YieldB n (Tuple3' s 0 (Right fs1))

490+ return $ Yield n (Tuple3' s 0 (Right fs1))

507491 Error err -> return $ Error err

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

509493 r <- step1 st a

510494 let cnt1 = cnt + 1

511495 case r of

512− Yield _ s -> return $ Yield 0 (Tuple3' s cnt1 (Right fs))

513− YieldB n s -> do

496+ Yield n s -> do

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

515− return $ YieldB n (Tuple3' s (cnt1 - n) (Right fs))

498+ return $ Yield n (Tuple3' s (cnt1 - n) (Right fs))

516499 Skip n s -> do

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

518501 return $ Skip n (Tuple3' s (cnt1 - n) (Right fs))

519502 Stop n b -> do

520503 s <- initial1

521504 fs1 <- fstep fs b

522− return $ YieldB n (Tuple3' s 0 (Right fs1))

505+ return $ Yield n (Tuple3' s 0 (Right fs1))

523506 Error _ -> Stop cnt1 <$> fextract fs

524507

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

@@ -598,8 +581,7 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract

598581 step (ConcatParseL st) a = do

599582 r <- stepL st a

600583 return $ case r of

601− Yield _ s -> Skip 0 (ConcatParseL s)

602− YieldB n s -> Skip n (ConcatParseL s)

584+ Yield n s -> Skip n (ConcatParseL s)

603585 Skip n s -> Skip n (ConcatParseL s)

604586 Stop n b -> Skip n (ConcatParseR (func b))

605587 Error err -> Error err

@@ -610,8 +592,6 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract

610592 return $ case r of

611593 Yield n s ->

612594 Yield n (ConcatParseR (Parser stepR (return s) extractR))

613− YieldB n s ->

614− YieldB n (ConcatParseR (Parser stepR (return s) extractR))

615595 Skip n s ->

616596 Skip n (ConcatParseR (Parser stepR (return s) extractR))

617597 Stop n b -> Stop n b

src/Streamly/Internal/Data/Stream/StreamD.hs+14−31

@@ -998,11 +998,8 @@ parselMx' pstep initial extract (Stream step state) = do

998998 Yield x s -> do

999999 pRes <- pstep pst x

10001000 case pRes of

1001− -- PR.Yield 0 pst1 -> go SPEC s [] pst1

1001+ PR.Yield 0 pst1 -> go SPEC s [] pst1

10021002 PR.Yield n pst1 -> do

1003− assert (n <= length (x:buf)) (return ())

1004− go SPEC s (Prelude.take n (x:buf)) pst1

1005− PR.YieldB n pst1 -> do

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

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

10081005 src = Prelude.reverse src0

@@ -1022,11 +1019,9 @@ parselMx' pstep initial extract (Stream step state) = do

10221019 gobuf !_ s buf (x:xs) !pst = do

10231020 pRes <- pstep pst x

10241021 case pRes of

1025− -- PR.Yield 0 pst1 -> go SPEC s [] pst1

1022+ PR.Yield 0 pst1 ->

1023+ gobuf SPEC s [] xs pst1

10261024 PR.Yield n pst1 -> do

1027− assert (n <= length (x:buf)) (return ())

1028− gobuf SPEC s (Prelude.take n (x:buf)) xs pst1

1029− PR.YieldB n pst1 -> do

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

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

10321027 src = Prelude.reverse src0 ++ xs

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

10821077 Yield x s -> do

10831078 pRes <- pstep pst x

10841079 case pRes of

1085− -- PR.Yield 0 pst1 -> go SPEC s [] pst1

1080+ PR.Yield 0 pst1 ->

1081+ return $ Skip $ ParseChunksStream s [] pst1

10861082 PR.Yield n pst1 -> do

1087− assert (n <= length (x:buf)) (return ())

1088− let buf1 = Prelude.take n (x:buf)

1089− return $ Skip $ ParseChunksStream s buf1 pst1

1090− PR.YieldB n pst1 -> do

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

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

10931085 src = Prelude.reverse src0

@@ -1121,12 +1113,9 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) =

11211113 stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do

11221114 pRes <- pstep pst x

11231115 case pRes of

1124− -- PR.Yield 0 pst1 ->

1125− PR.Yield n pst1 -> do

1126− assert (n <= length (x:buf)) (return ())

1127− let buf1 = Prelude.take n (x:buf)

1128− return $ Skip $ ParseChunksBuf xs s buf1 pst1

1129− PR.YieldB n pst1 -> do

1116+ PR.Yield 0 pst1 ->

1117+ return $ Skip $ ParseChunksBuf xs s [] pst1

1118+ PR.Yield n pst1 -> do

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

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

11321121 src = Prelude.reverse src0 ++ xs

@@ -1190,13 +1179,10 @@ parseIterate func seed (Stream step state) =

11901179 pst <- initial

11911180 pRes <- pstep pst x

11921181 case pRes of

1193− -- PR.Yield 0 pst1 -> go SPEC s [] pst1

1194− PR.Yield n pst1 -> do

1195− assert (n <= length (x:buf)) (return ())

1196− let buf1 = Prelude.take n (x:buf)

1197− return $ Skip $ ConcatParseStream s buf1

1182+ PR.Yield 0 pst1 ->

1183+ return $ Skip $ ConcatParseStream s []

11981184 (PRD.Parser pstep (return pst1) extract)

1199− PR.YieldB n pst1 -> do

1185+ PR.Yield n pst1 -> do

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

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

12021188 src = Prelude.reverse src0

@@ -1235,13 +1221,10 @@ parseIterate func seed (Stream step state) =

12351221 pst <- initial

12361222 pRes <- pstep pst x

12371223 case pRes of

1238− -- PR.Yield 0 pst1 ->

1239− PR.Yield n pst1 -> do

1240− assert (n <= length (x:buf)) (return ())

1241− let buf1 = Prelude.take n (x:buf)

1242− return $ Skip $ ConcatParseBuf xs s buf1

1224+ PR.Yield 0 pst1 ->

1225+ return $ Skip $ ConcatParseBuf xs s []

12431226 (PRD.Parser pstep (return pst1) extract)

1244− PR.YieldB n pst1 -> do

1227+ PR.Yield n pst1 -> do

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

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

12471230 src = Prelude.reverse src0 ++ xs

src/Streamly/Internal/Data/Zipper.hs+7−16

@@ -221,11 +221,8 @@ parse pstep initial extract (Zipper [] ls rs stream) =

221221 yieldk x r = do

222222 acc1 <- acc >>= \b -> pstep b x

223223 case acc1 of

224− -- PR.Yield 0 pst1 -> go SPEC s [] pst1

224+ PR.Yield 0 pst1 -> go r [] (return pst1)

225225 PR.Yield n pst1 -> do

226− assert (n <= length (x:buf)) (return ())

227− go r (Prelude.take n (x:buf)) (return pst1)

228− PR.YieldB n pst1 -> do

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

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

231228 src = Prelude.reverse src0

@@ -250,11 +247,9 @@ parse pstep initial extract (Zipper [] ls rs stream) =

250247 r <- pst

251248 pRes <- pstep r x

252249 case pRes of

253− -- PR.Yield 0 pst1 -> go SPEC s [] pst1

250+ PR.Yield 0 pst1 ->

251+ gobuf s [] xs (return pst1)

254252 PR.Yield n pst1 -> do

255− assert (n <= length (x:buf)) (return ())

256− gobuf s (Prelude.take n (x:buf)) xs (return pst1)

257− PR.YieldB n pst1 -> do

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

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

260255 src = Prelude.reverse src0

@@ -296,11 +291,9 @@ parse pstep initial extract (Zipper (cp:cps) ls rs stream) =

296291 acc1 <- acc >>= \b -> pstep b x

297292 let cnt1 = cnt + 1

298293 case acc1 of

299− -- PR.Yield 0 pst1 -> go SPEC s [] pst1

294+ PR.Yield 0 pst1 ->

295+ go cnt1 r [] (return pst1)

300296 PR.Yield n pst1 -> do

301− assert (n <= length (x:buf)) (return ())

302− go cnt1 r (x:buf) (return pst1)

303− PR.YieldB n pst1 -> do

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

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

306299 src = Prelude.reverse src0

@@ -332,11 +325,9 @@ parse pstep initial extract (Zipper (cp:cps) ls rs stream) =

332325 pRes <- pstep r x

333326 let cnt1 = cnt + 1

334327 case pRes of

335− -- PR.Yield 0 pst1 -> go SPEC s [] pst1

328+ PR.Yield 0 pst1 ->

329+ gobuf cnt1 s [] xs (return pst1)

336330 PR.Yield n pst1 -> do

337− assert (n <= length (x:buf)) (return ())

338− gobuf cnt1 s (x:buf) xs (return pst1)

339− PR.YieldB n pst1 -> do

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

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

342333 src = Prelude.reverse src0