git.iko.soy/streamly
on master help sign in
Remove the stream component from the Zipper

Earlier we had the whole input stream in the Zipper and when running ParserK we could consume from the stream as we needed. Now we drive ParserK just like ParserD one element at a time in a loop. The stream consumption now happens in this outer loop instead of inside parserK. This makes the "parse" function in ParserK simpler and ParserD and ParserK are more or less similarly driven.

commit8a37cd8b9dd1ff53a5bd306220491aad2d197a49 authorHarendra Kumar <harendra@composewell.com> dateTue 21 Jul 2020, 00:23 (6 years ago) parentd80d5e0
4 files changed+146−194
compare with master
unifiedsplit
src/Streamly/Internal/Data/Parser/ParserD.hs+13−9 src/Streamly/Internal/Data/Parser/ParserK/Types.hs+113−120 src/Streamly/Internal/Data/Zipper.hs+18−52 src/Streamly/Internal/Prelude.hs+2−13
src/Streamly/Internal/Data/Parser/ParserD.hs+13−9
@@ -224,24 +224,28 @@ fromParserK parser = Parser step initial extract
224224 initial = return Nothing
225225
226226 step Nothing a = do
227− let yieldk _ (K.Done 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"
227+ let yieldk _ (K.Done b) = return $ K.Stop b
231228 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
233230 case r of
231+ -- XXX it should return the leftover count
234232 K.Stop b -> return $ Done 0 b
235233 K.Failed e -> return $ Error e
236− -- XXX we can use the zipper state here to pare down the driver
237− -- buffer
238− K.Pause cont -> return $ Partial 0 $ Just cont
234+ -- XXX when it pauses it may not have the result available, so it
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.
242+ K.Partial cont -> return $ Partial 0 $ Just cont
239243 step (Just cont) a = do
240244 r <- cont (Just a)
241245 case r of
242246 K.Stop b -> return $ Done 0 b
243247 K.Failed e -> return $ Error e
244− K.Pause cont1 -> return $ Partial 0 $ Just cont1
248+ K.Partial cont1 -> return $ Partial 0 $ Just cont1
245249
246250 extract Nothing = throwM $ ParseError "end of input"
247251 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
4343import Data.Semigroup ((<>))
4444#endif
4545import Streamly.Internal.Data.Zipper (Zipper (..))
46−import Streamly.Internal.Data.SVar (defState)
4746import Prelude hiding (splitAt)
4847
4948import qualified Streamly.Internal.Data.Zipper as Z
5049import qualified Streamly.Internal.Data.Parser.ParserD.Types as PD
51−import qualified Streamly.Internal.Data.Stream.StreamK as K
5250
5351-- | The parse driver result. The driver may stop with a final result, pause
5452-- with a continuation to resume, or fail with an error.
@@ -59,12 +57,12 @@ data Driver m a r =
5957 Stop r
6058 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.
6159 -- measure if that works any better.
62− | Pause (Maybe a -> m (Driver m a r))
60+ | Partial (Maybe a -> m (Driver m a r))
6361 | Failed String
6462
6563instance Functor m => Functor (Driver m a) where
6664 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)
6866 fmap _ (Failed e) = Failed e
6967
7068-- The parser's result.
@@ -73,12 +71,10 @@ instance Functor m => Functor (Driver m a) where
7371--
7472data Parse b =
7573 Done !b -- Done, no more input needed
76− | Continue -- No result, need more input
7774 | Error !String -- Failed
7875
7976instance Functor Parse where
8077 fmap f (Done b) = Done (f b)
81− fmap _ Continue = Continue
8278 fmap _ (Error e) = Error e
8379
8480-- | A continuation passing style parser representation. The parser is supplied
@@ -88,8 +84,8 @@ instance Functor Parse where
8884--
8985newtype Parser m a b = MkParser
9086 { runParser :: forall r.
91− Zipper m a
92− -> (Zipper m a -> Parse b -> m (Driver m a r))
87+ Zipper a
88+ -> (Zipper a -> Parse b -> m (Driver m a r))
9389 -> m (Driver m a r)
9490 }
9591
@@ -102,7 +98,7 @@ extractParse cont = do
10298 r <- cont Nothing
10399 case r of
104100 Stop b -> return b
105− Pause _ -> error "Bug: extractParse got Pause"
101+ Partial _ -> error "Bug: extractParse got Partial"
106102 Failed e -> throwM $ PD.ParseError e
107103
108104-- | Maps a function over the output of the parser.
@@ -139,7 +135,6 @@ instance Monad m => Applicative (Parser m a) where
139135 {-# INLINE (*>) #-}
140136 m1 *> m2 = MkParser $ \zipper yieldk ->
141137 let yield1 z (Done _) = runParser m2 z yieldk
142− yield1 z Continue = yieldk z Continue
143138 yield1 z (Error e) = yieldk z (Error e)
144139 in runParser m1 zipper yield1
145140
@@ -147,7 +142,6 @@ instance Monad m => Applicative (Parser m a) where
147142 m1 <* m2 = MkParser $ \zipper yieldk ->
148143 let
149144 yield1 z (Done b) = runParser m2 z $ \z1 _ -> yieldk z1 (Done b)
150− yield1 z Continue = yieldk z Continue
151145 yield1 z (Error e) = yieldk z (Error e)
152146 in runParser m1 zipper yield1
153147
@@ -209,7 +203,6 @@ instance Monad m => Monad (Parser m a) where
209203 m >>= k = MkParser $ \zipper yieldk ->
210204 let
211205 yield1 z (Done b) = runParser (k b) z yieldk
212− yield1 z Continue = yieldk z Continue
213206 yield1 z (Error e) = yieldk z (Error e)
214207 in runParser m zipper yield1
215208
@@ -226,6 +219,13 @@ instance Monad m => Fail.MonadFail (Parser m a) where
226219 fail = die
227220#endif
228221
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+--
229229-- | 'Alternative' form of 'Streamly.Internal.Data.Parser.alt'. Backtrack and
230230-- run the second parser if the first one fails.
231231--
@@ -246,7 +246,6 @@ instance Monad m => Alternative (Parser m a) where
246246 {-# INLINE (<|>) #-}
247247 m1 <|> m2 = MkParser $ \zipper yieldk ->
248248 let yield1 z (Done b) = yieldk (Z.release z) (Done b)
249− yield1 z Continue = yieldk z Continue
250249 yield1 z (Error _) = runParser m2 (Z.restore z) yieldk
251250 in runParser m1 (Z.checkpoint zipper) yield1
252251
@@ -310,160 +309,154 @@ parse
310309 => (s -> a -> m (PD.Step s b))
311310 -> m s
312311 -> (s -> m b)
313− -> Zipper m a
314− -> (Zipper m a -> Parse b -> m (Driver m a r))
312+ -> Zipper a
313+ -> (Zipper a -> Parse b -> m (Driver m a r))
315314 -> m (Driver m a r)
316315
317316-- 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 =
319318 case forward of
320− -- Stop if stream is nil
321− [] -> goStream stream backward initial
322− _ -> goBuf stream backward forward initial
319+ [] -> return $ Partial (parseCont backward initial)
320+ _ -> goBuf backward forward initial
323321
324322 where
325323
326− -- Pauses if no input was generated by the stream and returns a
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
335− pst <- acc
336− r <- try $ extract pst
337− case r of
338− Left (e :: PD.ParseError) ->
339− cont Z.nil (Error (displayException e))
340− Right b -> cont Z.nil (Done b)
341− stop = return $ Pause parseCont
342− single x = yieldk x K.nil
343− yieldk x r = do
344− acc1 <- acc >>= \b -> pstep b x
345− case acc1 of
346− PD.Partial 0 pst1 -> goStream r [] (return pst1)
347− PD.Partial n pst1 -> do
348− assert (n <= length (x:back)) (return ())
349− let src0 = Prelude.take n (x:back)
350− src = Prelude.reverse src0
351− goBuf r [] src (return pst1)
352− PD.Continue 0 pst1 -> goStream r (x:back) (return pst1)
353− PD.Continue n pst1 -> do
354− assert (n <= length (x:back)) (return ())
355− let (src0, buf1) = splitAt n (x:back)
356− src = Prelude.reverse src0
357− goBuf r buf1 src (return pst1)
358− PD.Done n b -> do
359− assert (n <= length (x:back)) (return ())
360− let (src0, buf1) = splitAt n (x:back)
361− src = Prelude.reverse src0
362− cont (Zipper [] buf1 src r) (Done b)
363− PD.Error err -> cont (Zipper [] (x:back) [] r) (Error err)
364− in K.foldStream defState yieldk single stop st
365−
366− goBuf s back [] !pst = goStream s back pst
367− goBuf s back (x:xs) !pst = do
324+ parseCont back acc (Just x) = goSingle back x acc
325+ parseCont back acc Nothing = do
326+ pst <- acc
327+ r <- try $ extract pst
328+ let z = Zipper [] back []
329+ case r of
330+ Left (e :: PD.ParseError) ->
331+ cont z (Error (displayException e))
332+ Right b -> cont z (Done b)
333+
334+ {-# INLINE goSingle #-}
335+ goSingle back x !pst = do
336+ r <- pst
337+ pRes <- pstep r x
338+ case pRes of
339+ -- XXX return Partial pause
340+ PD.Partial 0 pst1 -> return $ Partial (parseCont [] (return pst1))
341+ PD.Partial n pst1 -> do
342+ assert (n <= length (x:back)) (return ())
343+ let src0 = Prelude.take n (x:back)
344+ src = Prelude.reverse src0
345+ goBuf [] src (return pst1)
346+ PD.Continue 0 pst1 ->
347+ return $ Partial (parseCont (x:back) (return pst1))
348+ PD.Continue n pst1 -> do
349+ assert (n <= length (x:back)) (return ())
350+ let (src0, buf1) = splitAt n (x:back)
351+ src = Prelude.reverse src0
352+ goBuf buf1 src (return pst1)
353+ PD.Done n b -> do
354+ assert (n <= length (x:back)) (return ())
355+ let (src0, buf1) = splitAt n (x:back)
356+ src = Prelude.reverse src0
357+ cont (Zipper [] buf1 src) (Done b)
358+ PD.Error err -> cont (Zipper [] (x:back) []) (Error err)
359+
360+ goBuf back [] !acc = return $ Partial (parseCont back acc)
361+ goBuf back (x:xs) !pst = do
368362 r <- pst
369363 pRes <- pstep r x
370364 case pRes of
371365 PD.Partial 0 pst1 ->
372− goBuf s [] xs (return pst1)
366+ goBuf [] xs (return pst1)
373367 PD.Partial n pst1 -> do
374368 assert (n <= length (x:back)) (return ())
375369 let src0 = Prelude.take n (x:back)
376370 src = Prelude.reverse src0
377− goBuf s [] (src ++ xs) (return pst1)
378− PD.Continue 0 pst1 -> goBuf s (x:back) xs (return pst1)
371+ goBuf [] (src ++ xs) (return pst1)
372+ PD.Continue 0 pst1 -> goBuf (x:back) xs (return pst1)
379373 PD.Continue n pst1 -> do
380374 assert (n <= length (x:back)) (return ())
381375 let (src0, buf1) = splitAt n (x:back)
382376 src = Prelude.reverse src0 ++ xs
383− goBuf s buf1 src (return pst1)
377+ goBuf buf1 src (return pst1)
384378 PD.Done n b -> do
385379 assert (n <= length (x:back)) (return ())
386380 let (src0, buf1) = splitAt n (x:back)
387381 src = Prelude.reverse src0 ++ xs
388− cont (Zipper [] buf1 src s) (Done b)
389− PD.Error err -> cont (Zipper [] (x:back) xs s) (Error err)
382+ cont (Zipper [] buf1 src) (Done b)
383+ PD.Error err -> cont (Zipper [] (x:back) xs) (Error err)
390384
391385-- The case when checkpoints exist
392386-- 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 =
394388 case forward of
395− [] -> goStream 0 stream backward initial
396− _ -> goBuf 0 stream backward forward initial
389+ [] -> return $ Partial (parseCont 0 backward initial)
390+ _ -> goBuf 0 backward forward initial
397391
398392 where
399393
400− {-# INLINE goStream #-}
401− goStream cnt st back !acc =
402− let parseCont (Just x) = goStream cnt (K.yield x) back acc
403− parseCont Nothing = do
404− pst <- acc
405− r <- try $ extract pst
406− case r of
407− Left (e :: PD.ParseError) ->
408− cont Z.nil (Error (displayException e))
409− Right b -> cont Z.nil (Done b)
410− stop = return $ Pause parseCont
411− single x = yieldk x K.nil
412− yieldk x r = do
413− acc1 <- acc >>= \b -> pstep b x
414− let cnt1 = cnt + 1
415− case acc1 of
416− PD.Partial 0 pst1 ->
417− goStream cnt1 r [] (return pst1)
418− PD.Partial n pst1 -> do
419− assert (n <= length (x:back)) (return ())
420− let src0 = Prelude.take n (x:back)
421− src = Prelude.reverse src0
422− goBuf (cnt1 - n) r [] src (return pst1)
423− PD.Continue 0 pst1 -> goStream cnt1 r (x:back) (return pst1)
424− PD.Continue n pst1 -> do
425− assert (n <= length (x:back)) (return ())
426− let (src0, buf1) = splitAt n (x:back)
427− src = Prelude.reverse src0
428− assert (cnt1 - n >= 0) (return ())
429− goBuf (cnt1 - n) r buf1 src (return pst1)
430− PD.Done n b -> do
431− assert (n <= length (x:back)) (return ())
432− let (src0, buf1) = splitAt n (x:back)
433− src = Prelude.reverse src0
434− assert (cp + cnt1 - n >= 0) (return ())
435− cont (Zipper (cp + cnt1 - n : cps) buf1 src r)
436− (Done b)
437− PD.Error err ->
438− cont (Zipper (cp + cnt1 : cps) (x:back) [] r)
439− (Error err)
440− in K.foldStream defState yieldk single stop st
441−
442− goBuf cnt s back [] !pst = goStream cnt s back pst
443− goBuf cnt s back (x:xs) !pst = do
394+ parseCont cnt back acc (Just x) = goSingle cnt back x acc
395+ parseCont _ back acc Nothing = do
396+ pst <- acc
397+ r <- try $ extract pst
398+ let z = Zipper [] back []
399+ case r of
400+ Left (e :: PD.ParseError) ->
401+ cont z (Error (displayException e))
402+ Right b -> cont z (Done b)
403+
404+ {-# INLINE goSingle #-}
405+ goSingle cnt back x !pst = do
406+ r <- pst
407+ pRes <- pstep r x
408+ let cnt1 = cnt + 1
409+ case pRes of
410+ -- XXX return Partial pause
411+ PD.Partial 0 pst1 ->
412+ return $ Partial (parseCont cnt1 [] (return pst1))
413+ PD.Partial n pst1 -> do
414+ assert (n <= length (x:back)) (return ())
415+ let src0 = Prelude.take n (x:back)
416+ src = Prelude.reverse src0
417+ goBuf (cnt1 - n) [] src (return pst1)
418+ PD.Continue 0 pst1 ->
419+ return $ Partial (parseCont cnt1 (x:back) (return pst1))
420+ PD.Continue n pst1 -> do
421+ assert (n <= length (x:back)) (return ())
422+ let (src0, buf1) = splitAt n (x:back)
423+ src = Prelude.reverse src0
424+ assert (cnt1 - n >= 0) (return ())
425+ goBuf (cnt1 - n) buf1 src (return pst1)
426+ PD.Done n b -> do
427+ assert (n <= length (x:back)) (return ())
428+ let (src0, buf1) = splitAt n (x:back)
429+ src = Prelude.reverse src0
430+ assert (cp + cnt1 - n >= 0) (return ())
431+ cont (Zipper (cp + cnt1 - n : cps) buf1 src) (Done b)
432+ PD.Error err ->
433+ cont (Zipper (cp + cnt1 : cps) (x:back) []) (Error err)
434+
435+ goBuf cnt back [] !acc = return $ Partial (parseCont cnt back acc)
436+ goBuf cnt back (x:xs) !pst = do
444437 r <- pst
445438 pRes <- pstep r x
446439 let cnt1 = cnt + 1
447440 case pRes of
448441 PD.Partial 0 pst1 ->
449− goBuf cnt1 s [] xs (return pst1)
442+ goBuf cnt1 [] xs (return pst1)
450443 PD.Partial n pst1 -> do
451444 assert (n <= length (x:back)) (return ())
452445 let src0 = Prelude.take n (x:back)
453446 src = Prelude.reverse src0
454− goBuf (cnt1 - n) s [] (src ++ xs) (return pst1)
455− PD.Continue 0 pst1 -> goBuf cnt1 s (x:back) xs (return pst1)
447+ goBuf (cnt1 - n) [] (src ++ xs) (return pst1)
448+ PD.Continue 0 pst1 -> goBuf cnt1 (x:back) xs (return pst1)
456449 PD.Continue n pst1 -> do
457450 assert (n <= length (x:back)) (return ())
458451 let (src0, buf1) = splitAt n (x:back)
459452 src = Prelude.reverse src0 ++ xs
460453 assert (cnt1 - n >= 0) (return ())
461− goBuf (cnt1 - n) s buf1 src (return pst1)
454+ goBuf (cnt1 - n) buf1 src (return pst1)
462455 PD.Done n b -> do
463456 assert (n <= length (x:back)) (return ())
464457 let (src0, buf1) = splitAt n (x:back)
465458 src = Prelude.reverse src0 ++ xs
466459 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)
468461 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
4949
5050 -- * Construction
5151 , nil
52− , fromStream
5352 , fromList
5453
55− -- * Updating
56− , append
57−
5854 -- * Checkpointing
5955 , checkpoint
6056 , release
@@ -63,15 +59,8 @@ module Streamly.Internal.Data.Zipper
6359where
6460
6561import Control.Exception (assert)
66−#if !(MIN_VERSION_base(4,13,0))
67−import Data.Semigroup ((<>))
68−#endif
6962import Prelude hiding (splitAt)
7063
71−import Streamly.Internal.Data.Stream.StreamK.Type (Stream(..))
72−
73−import qualified Streamly.Internal.Data.Stream.StreamK as K
74−
7564-------------------------------------------------------------------------------
7665-- Zipper type
7766-------------------------------------------------------------------------------
@@ -79,8 +68,7 @@ import qualified Streamly.Internal.Data.Stream.StreamK as K
7968-- | @Zipper checkpoints lefts rights tail@. The focus is on the first element
8069-- of @rights@. @lefts@ is buffered data on the right of the cursor. Note that
8170-- @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
83−-- cursor moves past @rights@.
71+-- list quickly.
8472--
8573-- @checkpoints@ is a stack of checkpoints. A new checkpoint is created by a
8674-- @checkpoint@ operation. A checkpoint consists of a count that tracks how
@@ -94,11 +82,10 @@ import qualified Streamly.Internal.Data.Stream.StreamK as K
9482--
9583-- /Internal/
9684--
97−data Zipper m a = Zipper
85+data Zipper a = Zipper
9886 [Int] -- checkpoints
99− [a] -- past buffered inputs (for backtracking)
87+ [a] -- past buffered inputs in reverse order (for backtracking)
10088 [a] -- future buffered inputs (created by backtracking)
101− (Stream m a) -- stream input to use after buffer is over
10289
10390-------------------------------------------------------------------------------
10491-- Construction
@@ -109,37 +96,16 @@ data Zipper m a = Zipper
10996-- /Internal/
11097--
11198{-# INLINE nil #-}
112−nil :: Zipper m 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 [] [] []
99+nil :: Zipper a
100+nil = Zipper [] [] []
122101
123102-- | Create a zipper from a list.
124103--
125104-- /Internal/
126105--
127106{-# INLINE fromList #-}
128−fromList :: [a] -> Zipper m a
129−fromList xs = Zipper [] [] xs K.nil
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)
107+fromList :: [a] -> Zipper a
108+fromList xs = Zipper [] [] xs
143109
144110-------------------------------------------------------------------------------
145111-- Checkpointing
@@ -151,8 +117,8 @@ append x (Zipper checkpoints backward forward stream) =
151117-- /Internal/
152118--
153119{-# INLINE checkpoint #-}
154−checkpoint :: Zipper m a -> Zipper m a
155−checkpoint (Zipper cps xs ys stream) = Zipper (0:cps) xs ys stream
120+checkpoint :: Zipper a -> Zipper a
121+checkpoint (Zipper cps xs ys) = Zipper (0:cps) xs ys
156122
157123-- | Release the latest checkpoint, releases any values held by the checkpoint.
158124-- 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
161127-- /Internal/
162128--
163129{-# INLINE release #-}
164−release :: Zipper m a -> Zipper m a
165−release (Zipper [] _ _ _) = error "Bug: release, no checkpoint exists!"
166−release (Zipper (n:cps) xs ys stream) =
130+release :: Zipper a -> Zipper a
131+release (Zipper [] _ _ ) = error "Bug: release, no checkpoint exists!"
132+release (Zipper (n:cps) xs ys) =
167133 assert (n <= length xs) $
168134 case cps of
169− [] -> assert (n == length xs) $ Zipper [] [] ys stream
170− cp:rest -> Zipper ((cp + n) : rest) xs ys stream
135+ [] -> assert (n == length xs) $ Zipper [] [] ys
136+ cp:rest -> Zipper ((cp + n) : rest) xs ys
171137
172138-- XXX recheck this, and unify with the definition in StreamD and ParserK
173139--
@@ -192,10 +158,10 @@ splitAt n ls
192158-- /Internal/
193159--
194160{-# INLINE restore #-}
195−restore :: Zipper m a -> Zipper m a
196−restore (Zipper [] _ _ _) = error "Bug: restore, no checkpoint exists!"
197−restore (Zipper (n:cps) xs ys stream) =
161+restore :: Zipper a -> Zipper a
162+restore (Zipper [] _ _) = error "Bug: restore, no checkpoint exists!"
163+restore (Zipper (n:cps) xs ys) =
198164 assert (n <= length xs) $
199165 let (src0, buf1) = splitAt n xs
200166 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
525525import Control.Concurrent (threadDelay)
526526import Control.Exception (Exception, assert)
527527import Control.Monad (void)
528−import Control.Monad.Catch (MonadCatch, MonadThrow, throwM)
528+import Control.Monad.Catch (MonadCatch, MonadThrow)
529529import Control.Monad.IO.Class (MonadIO(..))
530530import Control.Monad.Trans.Reader (ReaderT)
531531import Control.Monad.Trans.State.Strict (StateT)
@@ -593,7 +593,6 @@ import qualified Streamly.Internal.Data.Stream.Parallel as Par
593593import qualified Streamly.Internal.Data.Stream.Zip as Z
594594import qualified Streamly.Internal.Data.Parser.ParserK.Types as PRK
595595import qualified Streamly.Internal.Data.Parser.ParserD as PRD
596−import qualified Streamly.Internal.Data.Zipper as ZR
597596
598597------------------------------------------------------------------------------
599598-- Deconstruction
@@ -1367,15 +1366,7 @@ parseD (PRD.Parser step initial extract) = P.parselMx' step initial extract
13671366
13681367{-# INLINE parseK #-}
13691368parseK :: MonadThrow m => PRK.Parser m a b -> SerialT m a -> m b
1370−parseK parser xs = do
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
1369+parseK = parse
13791370
13801371-- | Parse a stream using the supplied 'Parser'.
13811372--
@@ -1384,8 +1375,6 @@ parseK parser xs = do
13841375{-# INLINE [3] parse #-}
13851376parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b
13861377parse = parseD . PRD.fromParserK
1387−{-# RULES "parse fallback to CPS" [2]
1388− forall a. parseD (PRD.fromParserK a) = parseK a #-}
13891378
13901379------------------------------------------------------------------------------
13911380-- Specialized folds