8a37cd8 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Remove the stream component from the Zipper

8a37cd8Harendra Kumar6 years ago

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

compare with master

unifiedsplit

@@ -224,24 +224,28 @@ fromParserK parser = Parser step initial extract

224 initial = return Nothing

225

226 step Nothing a = do

227− let yieldk _ (K.Done b) =

227+ let yieldk _ (K.Done b) = return $ K.Stop b

228− -- let leftover = 0 -- XXX get it from the zipper

229− return $ K.Stop b

230− yieldk _ K.Continue = error "Bug: fromParserK: got Continue"

231 yieldk _ (K.Error e) = return $ K.Failed e

228 yieldk _ (K.Error e) = return $ K.Failed e

232− r <- K.runParser parser (Z.append a Z.nil) yieldk

229+ r <- K.runParser parser (Z.Zipper [] [] [a]) yieldk

233 case r of

230 case r of

231+ -- XXX it should return the leftover count

234 K.Stop b -> return $ Done 0 b

232 K.Stop b -> return $ Done 0 b

235 K.Failed e -> return $ Error e

233 K.Failed e -> return $ Error e

236− -- XXX we can use the zipper state here to pare down the driver

234+ -- XXX when it pauses it may not have the result available, so it

237− -- buffer

235+ -- is not necessarily Partial. It could be Skip instead.

236+ -- Always returning Skip may lead to buffer accumulation.

237+ -- XXX In case of Partial the backtrack count is always 0 because

238+ -- ParserK would never ask to backtrack. Even for Skip it would

239+ -- always be zero. The only place where it may need the ParserD

240+ -- buffer is the final "Done" event where it can say there is a

241+ -- leftover.

238− K.Pause cont -> return $ Partial 0 $ Just cont

242+ K.Partial cont -> return $ Partial 0 $ Just cont

239 step (Just cont) a = do

243 step (Just cont) a = do

240 r <- cont (Just a)

244 r <- cont (Just a)

241 case r of

245 case r of

242 K.Stop b -> return $ Done 0 b

246 K.Stop b -> return $ Done 0 b

243 K.Failed e -> return $ Error e

247 K.Failed e -> return $ Error e

244− K.Pause cont1 -> return $ Partial 0 $ Just cont1

248+ K.Partial cont1 -> return $ Partial 0 $ Just cont1

245

249

246 extract Nothing = throwM $ ParseError "end of input"

250 extract Nothing = throwM $ ParseError "end of input"

247 extract (Just cont) = K.extractParse cont

251 extract (Just cont) = K.extractParse cont

src/Streamly/Internal/Data/Parser/ParserK/Types.hs+113−120

@@ -43,12 +43,10 @@ import qualified Control.Monad.Fail as Fail

43import Data.Semigroup ((<>))

44#endif

45import Streamly.Internal.Data.Zipper (Zipper (..))

46−import Streamly.Internal.Data.SVar (defState)

47import Prelude hiding (splitAt)

46import Prelude hiding (splitAt)

49import qualified Streamly.Internal.Data.Zipper as Z

48import qualified Streamly.Internal.Data.Zipper as Z

50import qualified Streamly.Internal.Data.Parser.ParserD.Types as PD

49import qualified Streamly.Internal.Data.Parser.ParserD.Types as PD

51−import qualified Streamly.Internal.Data.Stream.StreamK as K

53-- | The parse driver result. The driver may stop with a final result, pause

51-- | The parse driver result. The driver may stop with a final result, pause

54-- with a continuation to resume, or fail with an error.

52-- with a continuation to resume, or fail with an error.

@@ -59,12 +57,12 @@ data Driver m a r =

59 Stop r

57 Stop r

60 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.

58 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.

61 -- measure if that works any better.

59 -- measure if that works any better.

62− | Pause (Maybe a -> m (Driver m a r))

60+ | Partial (Maybe a -> m (Driver m a r))

63 | Failed String

61 | Failed String

65instance Functor m => Functor (Driver m a) where

63instance Functor m => Functor (Driver m a) where

66 fmap f (Stop r) = Stop (f r)

64 fmap f (Stop r) = Stop (f r)

67− fmap f (Pause yld) = Pause (fmap (fmap f) . yld)

65+ fmap f (Partial yld) = Partial (fmap (fmap f) . yld)

68 fmap _ (Failed e) = Failed e

66 fmap _ (Failed e) = Failed e

70-- The parser's result.

68-- The parser's result.

@@ -73,12 +71,10 @@ instance Functor m => Functor (Driver m a) where

73--

71--

74data Parse b =

72data Parse b =

75 Done !b -- Done, no more input needed

73 Done !b -- Done, no more input needed

76− | Continue -- No result, need more input

77 | Error !String -- Failed

74 | Error !String -- Failed

79instance Functor Parse where

76instance Functor Parse where

80 fmap f (Done b) = Done (f b)

77 fmap f (Done b) = Done (f b)

81− fmap _ Continue = Continue

82 fmap _ (Error e) = Error e

78 fmap _ (Error e) = Error e

84-- | A continuation passing style parser representation. The parser is supplied

80-- | A continuation passing style parser representation. The parser is supplied

@@ -88,8 +84,8 @@ instance Functor Parse where

88--

84--

89newtype Parser m a b = MkParser

85newtype Parser m a b = MkParser

90 { runParser :: forall r.

86 { runParser :: forall r.

91− Zipper m a

87+ Zipper a

92− -> (Zipper m a -> Parse b -> m (Driver m a r))

88+ -> (Zipper a -> Parse b -> m (Driver m a r))

93 -> m (Driver m a r)

89 -> m (Driver m a r)

94 }

90 }

@@ -102,7 +98,7 @@ extractParse cont = do

102 r <- cont Nothing

98 r <- cont Nothing

103 case r of

99 case r of

104 Stop b -> return b

100 Stop b -> return b

105− Pause _ -> error "Bug: extractParse got Pause"

101+ Partial _ -> error "Bug: extractParse got Partial"

106 Failed e -> throwM $ PD.ParseError e

102 Failed e -> throwM $ PD.ParseError e

107

103

108-- | Maps a function over the output of the parser.

104-- | Maps a function over the output of the parser.

@@ -139,7 +135,6 @@ instance Monad m => Applicative (Parser m a) where

139 {-# INLINE (*>) #-}

135 {-# INLINE (*>) #-}

140 m1 *> m2 = MkParser $ \zipper yieldk ->

136 m1 *> m2 = MkParser $ \zipper yieldk ->

141 let yield1 z (Done _) = runParser m2 z yieldk

137 let yield1 z (Done _) = runParser m2 z yieldk

142− yield1 z Continue = yieldk z Continue

143 yield1 z (Error e) = yieldk z (Error e)

138 yield1 z (Error e) = yieldk z (Error e)

144 in runParser m1 zipper yield1

139 in runParser m1 zipper yield1

145

140

@@ -147,7 +142,6 @@ instance Monad m => Applicative (Parser m a) where

147 m1 <* m2 = MkParser $ \zipper yieldk ->

142 m1 <* m2 = MkParser $ \zipper yieldk ->

148 let

143 let

149 yield1 z (Done b) = runParser m2 z $ \z1 _ -> yieldk z1 (Done b)

144 yield1 z (Done b) = runParser m2 z $ \z1 _ -> yieldk z1 (Done b)

150− yield1 z Continue = yieldk z Continue

151 yield1 z (Error e) = yieldk z (Error e)

145 yield1 z (Error e) = yieldk z (Error e)

152 in runParser m1 zipper yield1

146 in runParser m1 zipper yield1

153

147

@@ -209,7 +203,6 @@ instance Monad m => Monad (Parser m a) where

209 m >>= k = MkParser $ \zipper yieldk ->

203 m >>= k = MkParser $ \zipper yieldk ->

210 let

204 let

211 yield1 z (Done b) = runParser (k b) z yieldk

205 yield1 z (Done b) = runParser (k b) z yieldk

212− yield1 z Continue = yieldk z Continue

213 yield1 z (Error e) = yieldk z (Error e)

206 yield1 z (Error e) = yieldk z (Error e)

214 in runParser m zipper yield1

207 in runParser m zipper yield1

215

208

@@ -226,6 +219,13 @@ instance Monad m => Fail.MonadFail (Parser m a) where

226 fail = die

219 fail = die

227#endif

220#endif

228

221

222+-- XXX one way to backtrack is to ask the input driver to create and release

223+-- checkpoints, like we do in the zipper. The other way is to pass around the

224+-- zipper itself. Currently in the direct style code we manage the checkpoints

225+-- manually by counting the input. We need to unify the CPS and direct style

226+-- code by either using a zipper in both or by using checkpointing commands for

227+-- the driver.

228+--

229-- | 'Alternative' form of 'Streamly.Internal.Data.Parser.alt'. Backtrack and

230-- run the second parser if the first one fails.

231--

@@ -246,7 +246,6 @@ instance Monad m => Alternative (Parser m a) where

246 {-# INLINE (<|>) #-}

247 m1 <|> m2 = MkParser $ \zipper yieldk ->

248 let yield1 z (Done b) = yieldk (Z.release z) (Done b)

249− yield1 z Continue = yieldk z Continue

250 yield1 z (Error _) = runParser m2 (Z.restore z) yieldk

249 yield1 z (Error _) = runParser m2 (Z.restore z) yieldk

251 in runParser m1 (Z.checkpoint zipper) yield1

250 in runParser m1 (Z.checkpoint zipper) yield1

252

251

@@ -310,160 +309,154 @@ parse

310 => (s -> a -> m (PD.Step s b))

309 => (s -> a -> m (PD.Step s b))

311 -> m s

310 -> m s

312 -> (s -> m b)

311 -> (s -> m b)

313− -> Zipper m a

312+ -> Zipper a

314− -> (Zipper m a -> Parse b -> m (Driver m a r))

313+ -> (Zipper a -> Parse b -> m (Driver m a r))

315 -> m (Driver m a r)

314 -> m (Driver m a r)

316

315

317-- The case when no checkpoints exist

316-- The case when no checkpoints exist

318−parse pstep initial extract (Zipper [] backward forward stream) cont =

317+parse pstep initial extract (Zipper [] backward forward) cont =

319 case forward of

318 case forward of

320− -- Stop if stream is nil

321− [] -> goStream stream backward initial

319+ [] -> return $ Partial (parseCont backward initial)

322− _ -> goBuf stream backward forward initial

320+ _ -> goBuf backward forward initial

323

321

324 where

322 where

325

323

326− -- Pauses if no input was generated by the stream and returns a

324+ parseCont back acc (Just x) = goSingle back x acc

327− -- continuation. If the continuation is called with Nothing then it stops

328− -- and returns the result.

329− {-# INLINE goStream #-}

330− goStream st back !acc =

331− -- XXX We do not need to wrap the element in a stream we can process it

332− -- directly.

333− let parseCont (Just x) = goStream (K.yield x) back acc

334− parseCont Nothing = do

325+ parseCont back acc Nothing = do

335− pst <- acc

326+ pst <- acc

336− r <- try $ extract pst

327+ r <- try $ extract pst

328+ let z = Zipper [] back []

337− case r of

329+ case r of

338− Left (e :: PD.ParseError) ->

330+ Left (e :: PD.ParseError) ->

339− cont Z.nil (Error (displayException e))

331+ cont z (Error (displayException e))

340− Right b -> cont Z.nil (Done b)

332+ Right b -> cont z (Done b)

341− stop = return $ Pause parseCont

333+

342− single x = yieldk x K.nil

334+ {-# INLINE goSingle #-}

343− yieldk x r = do

335+ goSingle back x !pst = do

336+ r <- pst

344− acc1 <- acc >>= \b -> pstep b x

337+ pRes <- pstep r x

345− case acc1 of

338+ case pRes of

339+ -- XXX return Partial pause

346− PD.Partial 0 pst1 -> goStream r [] (return pst1)

340+ PD.Partial 0 pst1 -> return $ Partial (parseCont [] (return pst1))

347− PD.Partial n pst1 -> do

341+ PD.Partial n pst1 -> do

348− assert (n <= length (x:back)) (return ())

342+ assert (n <= length (x:back)) (return ())

349− let src0 = Prelude.take n (x:back)

343+ let src0 = Prelude.take n (x:back)

350− src = Prelude.reverse src0

344+ src = Prelude.reverse src0

351− goBuf r [] src (return pst1)

345+ goBuf [] src (return pst1)

352− PD.Continue 0 pst1 -> goStream r (x:back) (return pst1)

346+ PD.Continue 0 pst1 ->

347+ return $ Partial (parseCont (x:back) (return pst1))

353− PD.Continue n pst1 -> do

348+ PD.Continue n pst1 -> do

354− assert (n <= length (x:back)) (return ())

349+ assert (n <= length (x:back)) (return ())

355− let (src0, buf1) = splitAt n (x:back)

350+ let (src0, buf1) = splitAt n (x:back)

356− src = Prelude.reverse src0

351+ src = Prelude.reverse src0

357− goBuf r buf1 src (return pst1)

352+ goBuf buf1 src (return pst1)

358− PD.Done n b -> do

353+ PD.Done n b -> do

359− assert (n <= length (x:back)) (return ())

354+ assert (n <= length (x:back)) (return ())

360− let (src0, buf1) = splitAt n (x:back)

355+ let (src0, buf1) = splitAt n (x:back)

361− src = Prelude.reverse src0

356+ src = Prelude.reverse src0

362− cont (Zipper [] buf1 src r) (Done b)

357+ cont (Zipper [] buf1 src) (Done b)

363− PD.Error err -> cont (Zipper [] (x:back) [] r) (Error err)

358+ PD.Error err -> cont (Zipper [] (x:back) []) (Error err)

364− in K.foldStream defState yieldk single stop st

359+

365−

360+ goBuf back [] !acc = return $ Partial (parseCont back acc)

366− goBuf s back [] !pst = goStream s back pst

367− goBuf s back (x:xs) !pst = do

361+ goBuf back (x:xs) !pst = do

368 r <- pst

362 r <- pst

369 pRes <- pstep r x

363 pRes <- pstep r x

370 case pRes of

364 case pRes of

371 PD.Partial 0 pst1 ->

365 PD.Partial 0 pst1 ->

372− goBuf s [] xs (return pst1)

366+ goBuf [] xs (return pst1)

373 PD.Partial n pst1 -> do

367 PD.Partial n pst1 -> do

374 assert (n <= length (x:back)) (return ())

368 assert (n <= length (x:back)) (return ())

375 let src0 = Prelude.take n (x:back)

369 let src0 = Prelude.take n (x:back)

376 src = Prelude.reverse src0

370 src = Prelude.reverse src0

377− goBuf s [] (src ++ xs) (return pst1)

371+ goBuf [] (src ++ xs) (return pst1)

378− PD.Continue 0 pst1 -> goBuf s (x:back) xs (return pst1)

372+ PD.Continue 0 pst1 -> goBuf (x:back) xs (return pst1)

379 PD.Continue n pst1 -> do

373 PD.Continue n pst1 -> do

380 assert (n <= length (x:back)) (return ())

374 assert (n <= length (x:back)) (return ())

381 let (src0, buf1) = splitAt n (x:back)

375 let (src0, buf1) = splitAt n (x:back)

382 src = Prelude.reverse src0 ++ xs

376 src = Prelude.reverse src0 ++ xs

383− goBuf s buf1 src (return pst1)

377+ goBuf buf1 src (return pst1)

384 PD.Done n b -> do

378 PD.Done n b -> do

385 assert (n <= length (x:back)) (return ())

379 assert (n <= length (x:back)) (return ())

386 let (src0, buf1) = splitAt n (x:back)

380 let (src0, buf1) = splitAt n (x:back)

387 src = Prelude.reverse src0 ++ xs

381 src = Prelude.reverse src0 ++ xs

388− cont (Zipper [] buf1 src s) (Done b)

382+ cont (Zipper [] buf1 src) (Done b)

389− PD.Error err -> cont (Zipper [] (x:back) xs s) (Error err)

383+ PD.Error err -> cont (Zipper [] (x:back) xs) (Error err)

390

384

391-- The case when checkpoints exist

385-- The case when checkpoints exist

392-- XXX code duplication alert!

386-- XXX code duplication alert!

393−parse pstep initial extract (Zipper (cp:cps) backward forward stream) cont =

387+parse pstep initial extract (Zipper (cp:cps) backward forward) cont =

394 case forward of

388 case forward of

395− [] -> goStream 0 stream backward initial

389+ [] -> return $ Partial (parseCont 0 backward initial)

396− _ -> goBuf 0 stream backward forward initial

390+ _ -> goBuf 0 backward forward initial

397

391

398 where

392 where

399

393

400− {-# INLINE goStream #-}

394+ parseCont cnt back acc (Just x) = goSingle cnt back x acc

401− goStream cnt st back !acc =

402− let parseCont (Just x) = goStream cnt (K.yield x) back acc

403− parseCont Nothing = do

395+ parseCont _ back acc Nothing = do

404− pst <- acc

396+ pst <- acc

405− r <- try $ extract pst

397+ r <- try $ extract pst

398+ let z = Zipper [] back []

406− case r of

399+ case r of

407− Left (e :: PD.ParseError) ->

400+ Left (e :: PD.ParseError) ->

408− cont Z.nil (Error (displayException e))

401+ cont z (Error (displayException e))

409− Right b -> cont Z.nil (Done b)

402+ Right b -> cont z (Done b)

410− stop = return $ Pause parseCont

403+

411− single x = yieldk x K.nil

404+ {-# INLINE goSingle #-}

412− yieldk x r = do

405+ goSingle cnt back x !pst = do

406+ r <- pst

413− acc1 <- acc >>= \b -> pstep b x

407+ pRes <- pstep r x

414− let cnt1 = cnt + 1

408+ let cnt1 = cnt + 1

415− case acc1 of

409+ case pRes of

410+ -- XXX return Partial pause

416− PD.Partial 0 pst1 ->

411+ PD.Partial 0 pst1 ->

417− goStream cnt1 r [] (return pst1)

412+ return $ Partial (parseCont cnt1 [] (return pst1))

418− PD.Partial n pst1 -> do

413+ PD.Partial n pst1 -> do

419− assert (n <= length (x:back)) (return ())

414+ assert (n <= length (x:back)) (return ())

420− let src0 = Prelude.take n (x:back)

415+ let src0 = Prelude.take n (x:back)

421− src = Prelude.reverse src0

416+ src = Prelude.reverse src0

422− goBuf (cnt1 - n) r [] src (return pst1)

417+ goBuf (cnt1 - n) [] src (return pst1)

423− PD.Continue 0 pst1 -> goStream cnt1 r (x:back) (return pst1)

418+ PD.Continue 0 pst1 ->

419+ return $ Partial (parseCont cnt1 (x:back) (return pst1))

424− PD.Continue n pst1 -> do

420+ PD.Continue n pst1 -> do

425− assert (n <= length (x:back)) (return ())

421+ assert (n <= length (x:back)) (return ())

426− let (src0, buf1) = splitAt n (x:back)

422+ let (src0, buf1) = splitAt n (x:back)

427− src = Prelude.reverse src0

423+ src = Prelude.reverse src0

428− assert (cnt1 - n >= 0) (return ())

424+ assert (cnt1 - n >= 0) (return ())

429− goBuf (cnt1 - n) r buf1 src (return pst1)

425+ goBuf (cnt1 - n) buf1 src (return pst1)

430− PD.Done n b -> do

426+ PD.Done n b -> do

431− assert (n <= length (x:back)) (return ())

427+ assert (n <= length (x:back)) (return ())

432− let (src0, buf1) = splitAt n (x:back)

428+ let (src0, buf1) = splitAt n (x:back)

433− src = Prelude.reverse src0

429+ src = Prelude.reverse src0

434− assert (cp + cnt1 - n >= 0) (return ())

430+ assert (cp + cnt1 - n >= 0) (return ())

435− cont (Zipper (cp + cnt1 - n : cps) buf1 src r)

431+ cont (Zipper (cp + cnt1 - n : cps) buf1 src) (Done b)

436− (Done b)

437− PD.Error err ->

432+ PD.Error err ->

438− cont (Zipper (cp + cnt1 : cps) (x:back) [] r)

433+ cont (Zipper (cp + cnt1 : cps) (x:back) []) (Error err)

439− (Error err)

434+

440− in K.foldStream defState yieldk single stop st

441−

442− goBuf cnt s back [] !pst = goStream cnt s back pst

435+ goBuf cnt back [] !acc = return $ Partial (parseCont cnt back acc)

443− goBuf cnt s back (x:xs) !pst = do

436+ goBuf cnt back (x:xs) !pst = do

444 r <- pst

437 r <- pst

445 pRes <- pstep r x

438 pRes <- pstep r x

446 let cnt1 = cnt + 1

439 let cnt1 = cnt + 1

447 case pRes of

440 case pRes of

448 PD.Partial 0 pst1 ->

441 PD.Partial 0 pst1 ->

449− goBuf cnt1 s [] xs (return pst1)

442+ goBuf cnt1 [] xs (return pst1)

450 PD.Partial n pst1 -> do

443 PD.Partial n pst1 -> do

451 assert (n <= length (x:back)) (return ())

444 assert (n <= length (x:back)) (return ())

452 let src0 = Prelude.take n (x:back)

445 let src0 = Prelude.take n (x:back)

453 src = Prelude.reverse src0

446 src = Prelude.reverse src0

454− goBuf (cnt1 - n) s [] (src ++ xs) (return pst1)

447+ goBuf (cnt1 - n) [] (src ++ xs) (return pst1)

455− PD.Continue 0 pst1 -> goBuf cnt1 s (x:back) xs (return pst1)

448+ PD.Continue 0 pst1 -> goBuf cnt1 (x:back) xs (return pst1)

456 PD.Continue n pst1 -> do

449 PD.Continue n pst1 -> do

457 assert (n <= length (x:back)) (return ())

450 assert (n <= length (x:back)) (return ())

458 let (src0, buf1) = splitAt n (x:back)

451 let (src0, buf1) = splitAt n (x:back)

459 src = Prelude.reverse src0 ++ xs

452 src = Prelude.reverse src0 ++ xs

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

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

461− goBuf (cnt1 - n) s buf1 src (return pst1)

454+ goBuf (cnt1 - n) buf1 src (return pst1)

462 PD.Done n b -> do

455 PD.Done n b -> do

463 assert (n <= length (x:back)) (return ())

456 assert (n <= length (x:back)) (return ())

464 let (src0, buf1) = splitAt n (x:back)

457 let (src0, buf1) = splitAt n (x:back)

465 src = Prelude.reverse src0 ++ xs

458 src = Prelude.reverse src0 ++ xs

466 assert (cp + cnt1 - n >= 0) (return ())

459 assert (cp + cnt1 - n >= 0) (return ())

467− cont (Zipper (cp + cnt1 - n : cps) buf1 src s) (Done b)

460+ cont (Zipper (cp + cnt1 - n : cps) buf1 src) (Done b)

468 PD.Error err ->

461 PD.Error err ->

469− cont (Zipper (cp + cnt1 : cps) (x:back) xs s) (Error err)

462+ cont (Zipper (cp + cnt1 : cps) (x:back) xs) (Error err)

src/Streamly/Internal/Data/Zipper.hs+18−52

@@ -49,12 +49,8 @@ module Streamly.Internal.Data.Zipper

50 -- * Construction

51 , nil

52− , fromStream

53 , fromList

52 , fromList

55− -- * Updating

56− , append

57−

58 -- * Checkpointing

54 -- * Checkpointing

59 , checkpoint

55 , checkpoint

60 , release

56 , release

@@ -63,15 +59,8 @@ module Streamly.Internal.Data.Zipper

63where

59where

65import Control.Exception (assert)

61import Control.Exception (assert)

66−#if !(MIN_VERSION_base(4,13,0))

67−import Data.Semigroup ((<>))

68−#endif

69import Prelude hiding (splitAt)

62import Prelude hiding (splitAt)

71−import Streamly.Internal.Data.Stream.StreamK.Type (Stream(..))

72−

73−import qualified Streamly.Internal.Data.Stream.StreamK as K

74−

75-------------------------------------------------------------------------------

64-------------------------------------------------------------------------------

76-- Zipper type

65-- Zipper type

77-------------------------------------------------------------------------------

66-------------------------------------------------------------------------------

@@ -79,8 +68,7 @@ import qualified Streamly.Internal.Data.Stream.StreamK as K

79-- | @Zipper checkpoints lefts rights tail@. The focus is on the first element

68-- | @Zipper checkpoints lefts rights tail@. The focus is on the first element

80-- of @rights@. @lefts@ is buffered data on the right of the cursor. Note that

69-- of @rights@. @lefts@ is buffered data on the right of the cursor. Note that

81-- @lefts@ is stored as a reversed list, this helps is adding more items to the

70-- @lefts@ is stored as a reversed list, this helps is adding more items to the

82−-- list quickly. @tail@ is a stream that is used to generate more data if the

71+-- list quickly.

83−-- cursor moves past @rights@.

84--

72--

85-- @checkpoints@ is a stack of checkpoints. A new checkpoint is created by a

73-- @checkpoints@ is a stack of checkpoints. A new checkpoint is created by a

86-- @checkpoint@ operation. A checkpoint consists of a count that tracks how

74-- @checkpoint@ operation. A checkpoint consists of a count that tracks how

@@ -94,11 +82,10 @@ import qualified Streamly.Internal.Data.Stream.StreamK as K

94--

82--

95-- /Internal/

83-- /Internal/

96--

84--

97−data Zipper m a = Zipper

85+data Zipper a = Zipper

98 [Int] -- checkpoints

86 [Int] -- checkpoints

99− [a] -- past buffered inputs (for backtracking)

87+ [a] -- past buffered inputs in reverse order (for backtracking)

100 [a] -- future buffered inputs (created by backtracking)

88 [a] -- future buffered inputs (created by backtracking)

101− (Stream m a) -- stream input to use after buffer is over

102

103-------------------------------------------------------------------------------

90-------------------------------------------------------------------------------

104-- Construction

91-- Construction

@@ -109,37 +96,16 @@ data Zipper m a = Zipper

109-- /Internal/

96-- /Internal/

110--

97--

111{-# INLINE nil #-}

98{-# INLINE nil #-}

112−nil :: Zipper m a

99+nil :: Zipper a

113−nil = Zipper [] [] [] K.nil

114−

115−-- | Create a zipper from a stream.

116−--

117−-- /Internal/

118−--

119−{-# INLINE fromStream #-}

120−fromStream :: Stream m a -> Zipper m a

121−fromStream = Zipper [] [] []

100+nil = Zipper [] [] []

122

101

123-- | Create a zipper from a list.

102-- | Create a zipper from a list.

124--

103--

125-- /Internal/

104-- /Internal/

126--

105--

127{-# INLINE fromList #-}

106{-# INLINE fromList #-}

128−fromList :: [a] -> Zipper m a

107+fromList :: [a] -> Zipper a

129−fromList xs = Zipper [] [] xs K.nil

108+fromList xs = Zipper [] [] xs

130−

131−-------------------------------------------------------------------------------

132−-- Updating

133−-------------------------------------------------------------------------------

134−

135−-- | Add an element at the tail of the Zipper.

136−--

137−-- /Internal/

138−--

139−{-# INLINE append #-}

140−append :: a -> Zipper m a -> Zipper m a

141−append x (Zipper checkpoints backward forward stream) =

142− Zipper checkpoints backward forward (stream <> K.yield x)

143

109

144-------------------------------------------------------------------------------

110-------------------------------------------------------------------------------

145-- Checkpointing

111-- Checkpointing

@@ -151,8 +117,8 @@ append x (Zipper checkpoints backward forward stream) =

151-- /Internal/

117-- /Internal/

152--

118--

153{-# INLINE checkpoint #-}

119{-# INLINE checkpoint #-}

154−checkpoint :: Zipper m a -> Zipper m a

120+checkpoint :: Zipper a -> Zipper a

155−checkpoint (Zipper cps xs ys stream) = Zipper (0:cps) xs ys stream

121+checkpoint (Zipper cps xs ys) = Zipper (0:cps) xs ys

156

122

157-- | Release the latest checkpoint, releases any values held by the checkpoint.

123-- | Release the latest checkpoint, releases any values held by the checkpoint.

158-- Note that the values may still be held by other checkpoints in the stack of

124-- Note that the values may still be held by other checkpoints in the stack of

@@ -161,13 +127,13 @@ checkpoint (Zipper cps xs ys stream) = Zipper (0:cps) xs ys stream

161-- /Internal/

127-- /Internal/

162--

128--

163{-# INLINE release #-}

129{-# INLINE release #-}

164−release :: Zipper m a -> Zipper m a

130+release :: Zipper a -> Zipper a

165−release (Zipper [] _ _ _) = error "Bug: release, no checkpoint exists!"

131+release (Zipper [] _ _ ) = error "Bug: release, no checkpoint exists!"

166−release (Zipper (n:cps) xs ys stream) =

132+release (Zipper (n:cps) xs ys) =

167 assert (n <= length xs) $

133 assert (n <= length xs) $

168 case cps of

134 case cps of

169− [] -> assert (n == length xs) $ Zipper [] [] ys stream

135+ [] -> assert (n == length xs) $ Zipper [] [] ys

170− cp:rest -> Zipper ((cp + n) : rest) xs ys stream

136+ cp:rest -> Zipper ((cp + n) : rest) xs ys

171

137

172-- XXX recheck this, and unify with the definition in StreamD and ParserK

138-- XXX recheck this, and unify with the definition in StreamD and ParserK

173--

139--

@@ -192,10 +158,10 @@ splitAt n ls

192-- /Internal/

158-- /Internal/

193--

159--

194{-# INLINE restore #-}

160{-# INLINE restore #-}

195−restore :: Zipper m a -> Zipper m a

161+restore :: Zipper a -> Zipper a

196−restore (Zipper [] _ _ _) = error "Bug: restore, no checkpoint exists!"

162+restore (Zipper [] _ _) = error "Bug: restore, no checkpoint exists!"

197−restore (Zipper (n:cps) xs ys stream) =

163+restore (Zipper (n:cps) xs ys) =

198 assert (n <= length xs) $

164 assert (n <= length xs) $

199 let (src0, buf1) = splitAt n xs

165 let (src0, buf1) = splitAt n xs

200 src = Prelude.reverse src0

166 src = Prelude.reverse src0

201− in Zipper cps buf1 (src ++ ys) stream

167+ in Zipper cps buf1 (src ++ ys)

src/Streamly/Internal/Prelude.hs+2−13

@@ -525,7 +525,7 @@ where

525import Control.Concurrent (threadDelay)

526import Control.Exception (Exception, assert)

527import Control.Monad (void)

528−import Control.Monad.Catch (MonadCatch, MonadThrow, throwM)

528+import Control.Monad.Catch (MonadCatch, MonadThrow)

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

530import Control.Monad.Trans.Reader (ReaderT)

531import Control.Monad.Trans.State.Strict (StateT)

@@ -593,7 +593,6 @@ import qualified Streamly.Internal.Data.Stream.Parallel as Par

593import qualified Streamly.Internal.Data.Stream.Zip as Z

594import qualified Streamly.Internal.Data.Parser.ParserK.Types as PRK

595import qualified Streamly.Internal.Data.Parser.ParserD as PRD

596−import qualified Streamly.Internal.Data.Zipper as ZR

597

596

598------------------------------------------------------------------------------

597------------------------------------------------------------------------------

599-- Deconstruction

598-- Deconstruction

@@ -1367,15 +1366,7 @@ parseD (PRD.Parser step initial extract) = P.parselMx' step initial extract

1367

1366

1368{-# INLINE parseK #-}

1367{-# INLINE parseK #-}

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

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

1370−parseK parser xs = do

1369+parseK = parse

1371− let yieldk _ (PRK.Done b) = return $ PRK.Stop b

1372− yieldk _ PRK.Continue = error "Bug: fromParserK: got Continue"

1373− yieldk _ (PRK.Error e) = return $ PRK.Failed e

1374− r <- PRK.runParser parser (ZR.fromStream $ K.toStream xs) yieldk

1375− case r of

1376− PRK.Stop b -> return b

1377− PRK.Failed err -> throwM (PRD.ParseError err)

1378− PRK.Pause cont -> PRK.extractParse cont

1379

1370

1380-- | Parse a stream using the supplied 'Parser'.

1371-- | Parse a stream using the supplied 'Parser'.

1381--

1372--

@@ -1384,8 +1375,6 @@ parseK parser xs = do

1384{-# INLINE [3] parse #-}

1375{-# INLINE [3] parse #-}

1385parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b

1376parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b

1386parse = parseD . PRD.fromParserK

1377parse = parseD . PRD.fromParserK

1387−{-# RULES "parse fallback to CPS" [2]

1388− forall a. parseD (PRD.fromParserK a) = parseK a #-}

1389

1378

1390------------------------------------------------------------------------------

1379------------------------------------------------------------------------------

1391-- Specialized folds

1380-- Specialized folds