git.iko.soy/streamly
on master help sign in
Fix the backtrack buffer management for fromParserK
ec97cecHarendra Kumar
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+6−6
compare with master
unifiedsplit
@@ -62,18 +62,18 @@ benchIOSink value name f =
62-------------------------------------------------------------------------------
62-------------------------------------------------------------------------------
63
63
64#ifdef FROM_PARSERK
64#ifdef FROM_PARSERK
65−#define PARSE_OP (IP.parseD . PRD.fromParserK)
65+#define PARSE_OP (IP.parseD . PR.fromParserK)
66#else
66#else
67#define PARSE_OP IP.parseK
67#define PARSE_OP IP.parseK
68#endif
68#endif
69
69
70{-# INLINE satisfy #-}
70{-# INLINE satisfy #-}
71satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
71satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
72−satisfy = PRD.toParserK . PRD.satisfy
72+satisfy = PR.toParserK . PRD.satisfy
73
73
74{-# INLINE any #-}
74{-# INLINE any #-}
75any :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
75any :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
76−any = PRD.toParserK . PRD.any
76+any = PR.toParserK . PRD.any
77
77
78{-# INLINE anyK #-}
78{-# INLINE anyK #-}
79anyK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
79anyK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
@@ -81,7 +81,7 @@ anyK value = PARSE_OP (any (> value))
81
81
82{-# INLINE all #-}
82{-# INLINE all #-}
83all :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
83all :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
84−all = PRD.toParserK . PRD.all
84+all = PR.toParserK . PRD.all
85
85
86{-# INLINE allK #-}
86{-# INLINE allK #-}
87allK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
87allK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
@@ -89,7 +89,7 @@ allK value = PARSE_OP (all (<= value))
89
89
90{-# INLINE take #-}
90{-# INLINE take #-}
91take :: MonadCatch m => Int -> PR.Parser m a ()
91take :: MonadCatch m => Int -> PR.Parser m a ()
92−take value = PRD.toParserK $ PRD.take value FL.drain
92+take value = PR.toParserK $ PRD.take value FL.drain
93
93
94{-# INLINE takeK #-}
94{-# INLINE takeK #-}
95takeK :: MonadCatch m => Int -> SerialT m a -> m ()
95takeK :: MonadCatch m => Int -> SerialT m a -> m ()
@@ -97,7 +97,7 @@ takeK value = PARSE_OP (take value)
97
97
98{-# INLINE takeWhile #-}
98{-# INLINE takeWhile #-}
99takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
99takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
100−takeWhile p = PRD.toParserK $ PRD.takeWhile p FL.drain
100+takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain
101
101
102{-# INLINE takeWhileK #-}
102{-# INLINE takeWhileK #-}
103takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()
103takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()
bin/bench-exec-one.sh+6
@@ -70,6 +70,12 @@ bench_rts_opts_specific () {
70 Data.Parser/o-1-space/some) echo -n "-K8M" ;;
70 Data.Parser/o-1-space/some) echo -n "-K8M" ;;
71 Data.Parser.ParserD/o-1-space/manyTill) echo -n "-K4M" ;;
71 Data.Parser.ParserD/o-1-space/manyTill) echo -n "-K4M" ;;
72 Data.Parser/o-1-space/manyTill) echo -n "-K4M" ;;
72 Data.Parser/o-1-space/manyTill) echo -n "-K4M" ;;
73+ Data.Parser/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;
74+ Data.Parser/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;
75+ Data.Parser.ParserK/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;
76+ Data.Parser.ParserK/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;
77+ Data.Parser.ParserK/o-n-heap/sequence) echo -n "-M64M";;
78+ Data.Parser.ParserK/o-n-heap/sequenceA) echo -n "-M64M";;
73
79
74 Data.SmallArray/o-1-sp*) echo -n "-K128K" ;;
80 Data.SmallArray/o-1-sp*) echo -n "-K128K" ;;
75 *) echo -n "" ;;
81 *) echo -n "" ;;
src/Streamly/Internal/Data/Parser.hs+41−41
@@ -219,7 +219,7 @@ import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
219--
219--
220{-# INLINE fromFold #-}
220{-# INLINE fromFold #-}
221fromFold :: MonadCatch m => Fold m a b -> Parser m a b
221fromFold :: MonadCatch m => Fold m a b -> Parser m a b
222−fromFold = D.toParserK . D.fromFold
222+fromFold = K.toParserK . D.fromFold
223
223
224-------------------------------------------------------------------------------
224-------------------------------------------------------------------------------
225-- Terminating but not failing folds
225-- Terminating but not failing folds
@@ -231,7 +231,7 @@ fromFold = D.toParserK . D.fromFold
231--
231--
232{-# INLINE any #-}
232{-# INLINE any #-}
233any :: MonadCatch m => (a -> Bool) -> Parser m a Bool
233any :: MonadCatch m => (a -> Bool) -> Parser m a Bool
234−any = D.toParserK . D.any
234+any = K.toParserK . D.any
235
235
236-- |
236-- |
237-- >>> S.parse (PR.all (== 0)) $ S.fromList [1,0,1]
237-- >>> S.parse (PR.all (== 0)) $ S.fromList [1,0,1]
@@ -239,7 +239,7 @@ any = D.toParserK . D.any
239--
239--
240{-# INLINE all #-}
240{-# INLINE all #-}
241all :: MonadCatch m => (a -> Bool) -> Parser m a Bool
241all :: MonadCatch m => (a -> Bool) -> Parser m a Bool
242−all = D.toParserK . D.all
242+all = K.toParserK . D.all
243
243
244-- This is the dual of stream "yield".
244-- This is the dual of stream "yield".
245--
245--
@@ -249,9 +249,9 @@ all = D.toParserK . D.all
249--
249--
250{-# INLINE [3] yield #-}
250{-# INLINE [3] yield #-}
251yield :: MonadCatch m => b -> Parser m a b
251yield :: MonadCatch m => b -> Parser m a b
252−yield = D.toParserK . D.yield
252+yield = K.toParserK . D.yield
253{-# RULES "yield fallback to CPS" [2]
253{-# RULES "yield fallback to CPS" [2]
254− forall a. D.toParserK (D.yield a) = K.yield a #-}
254+ forall a. K.toParserK (D.yield a) = K.yield a #-}
255
255
256-- This is the dual of stream "yieldM".
256-- This is the dual of stream "yieldM".
257--
257--
@@ -262,7 +262,7 @@ yield = D.toParserK . D.yield
262--
262--
263{-# INLINE yieldM #-}
263{-# INLINE yieldM #-}
264yieldM :: MonadCatch m => m b -> Parser m a b
264yieldM :: MonadCatch m => m b -> Parser m a b
265−yieldM = D.toParserK . D.yieldM
265+yieldM = K.toParserK . D.yieldM
266
266
267-- This is the dual of "nil".
267-- This is the dual of "nil".
268--
268--
@@ -273,9 +273,9 @@ yieldM = D.toParserK . D.yieldM
273--
273--
274{-# INLINE [3] die #-}
274{-# INLINE [3] die #-}
275die :: MonadCatch m => String -> Parser m a b
275die :: MonadCatch m => String -> Parser m a b
276−die = D.toParserK . D.die
276+die = K.toParserK . D.die
277{-# RULES "die fallback to CPS" [2]
277{-# RULES "die fallback to CPS" [2]
278− forall a. D.toParserK (D.die a) = K.die a #-}
278+ forall a. K.toParserK (D.die a) = K.die a #-}
279
279
280-- This is the dual of "nilM".
280-- This is the dual of "nilM".
281--
281--
@@ -286,7 +286,7 @@ die = D.toParserK . D.die
286--
286--
287{-# INLINE dieM #-}
287{-# INLINE dieM #-}
288dieM :: MonadCatch m => m String -> Parser m a b
288dieM :: MonadCatch m => m String -> Parser m a b
289−dieM = D.toParserK . D.dieM
289+dieM = K.toParserK . D.dieM
290
290
291-------------------------------------------------------------------------------
291-------------------------------------------------------------------------------
292-- Failing Parsers
292-- Failing Parsers
@@ -306,7 +306,7 @@ dieM = D.toParserK . D.dieM
306--
306--
307{-# INLINE peek #-}
307{-# INLINE peek #-}
308peek :: MonadCatch m => Parser m a a
308peek :: MonadCatch m => Parser m a a
309−peek = D.toParserK D.peek
309+peek = K.toParserK D.peek
310
310
311-- | Succeeds if we are at the end of input, fails otherwise.
311-- | Succeeds if we are at the end of input, fails otherwise.
312--
312--
@@ -317,7 +317,7 @@ peek = D.toParserK D.peek
317--
317--
318{-# INLINE eof #-}
318{-# INLINE eof #-}
319eof :: MonadCatch m => Parser m a ()
319eof :: MonadCatch m => Parser m a ()
320−eof = D.toParserK D.eof
320+eof = K.toParserK D.eof
321
321
322-- | Returns the next element if it passes the predicate, fails otherwise.
322-- | Returns the next element if it passes the predicate, fails otherwise.
323--
323--
@@ -328,7 +328,7 @@ eof = D.toParserK D.eof
328--
328--
329{-# INLINE satisfy #-}
329{-# INLINE satisfy #-}
330satisfy :: MonadCatch m => (a -> Bool) -> Parser m a a
330satisfy :: MonadCatch m => (a -> Bool) -> Parser m a a
331−satisfy = D.toParserK . D.satisfy
331+satisfy = K.toParserK . D.satisfy
332
332
333-------------------------------------------------------------------------------
333-------------------------------------------------------------------------------
334-- Taking elements
334-- Taking elements
@@ -355,7 +355,7 @@ satisfy = D.toParserK . D.satisfy
355{-# INLINE takeBetween #-}
355{-# INLINE takeBetween #-}
356takeBetween :: -- MonadCatch m =>
356takeBetween :: -- MonadCatch m =>
357 Int -> Int -> Fold m a b -> Parser m a b
357 Int -> Int -> Fold m a b -> Parser m a b
358−takeBetween _m _n = undefined -- D.toParserK . D.takeBetween m n
358+takeBetween _m _n = undefined -- K.toParserK . D.takeBetween m n
359
359
360--
360--
361-- $take
361-- $take
@@ -384,7 +384,7 @@ takeBetween _m _n = undefined -- D.toParserK . D.takeBetween m n
384--
384--
385{-# INLINE take #-}
385{-# INLINE take #-}
386take :: MonadCatch m => Int -> Fold m a b -> Parser m a b
386take :: MonadCatch m => Int -> Fold m a b -> Parser m a b
387−take n = D.toParserK . D.take n
387+take n = K.toParserK . D.take n
388
388
389-- | Stops after taking exactly @n@ input elements.
389-- | Stops after taking exactly @n@ input elements.
390--
390--
@@ -398,7 +398,7 @@ take n = D.toParserK . D.take n
398--
398--
399{-# INLINE takeEQ #-}
399{-# INLINE takeEQ #-}
400takeEQ :: MonadCatch m => Int -> Fold m a b -> Parser m a b
400takeEQ :: MonadCatch m => Int -> Fold m a b -> Parser m a b
401−takeEQ n = D.toParserK . D.takeEQ n
401+takeEQ n = K.toParserK . D.takeEQ n
402
402
403-- | Take at least @n@ input elements, but can collect more.
403-- | Take at least @n@ input elements, but can collect more.
404--
404--
@@ -415,7 +415,7 @@ takeEQ n = D.toParserK . D.takeEQ n
415--
415--
416{-# INLINE takeGE #-}
416{-# INLINE takeGE #-}
417takeGE :: MonadCatch m => Int -> Fold m a b -> Parser m a b
417takeGE :: MonadCatch m => Int -> Fold m a b -> Parser m a b
418−takeGE n = D.toParserK . D.takeGE n
418+takeGE n = K.toParserK . D.takeGE n
419
419
420-- $takeWhile
420-- $takeWhile
421-- Note: This is called @takeWhileP@ and @munch@ in some parser libraries.
421-- Note: This is called @takeWhileP@ and @munch@ in some parser libraries.
@@ -439,7 +439,7 @@ takeGE n = D.toParserK . D.takeGE n
439{-# INLINE takeWhileP #-}
439{-# INLINE takeWhileP #-}
440takeWhileP :: -- MonadCatch m =>
440takeWhileP :: -- MonadCatch m =>
441 (a -> Bool) -> Parser m a b -> Parser m a b
441 (a -> Bool) -> Parser m a b -> Parser m a b
442−takeWhileP _cond = undefined -- D.toParserK . D.takeWhileP cond
442+takeWhileP _cond = undefined -- K.toParserK . D.takeWhileP cond
443
443
444-- | Collect stream elements until an element fails the predicate. The element
444-- | Collect stream elements until an element fails the predicate. The element
445-- on which the predicate fails is returned back to the input stream.
445-- on which the predicate fails is returned back to the input stream.
@@ -460,7 +460,7 @@ takeWhileP _cond = undefined -- D.toParserK . D.takeWhileP cond
460--
460--
461{-# INLINE takeWhile #-}
461{-# INLINE takeWhile #-}
462takeWhile :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
462takeWhile :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
463−takeWhile cond = D.toParserK . D.takeWhile cond
463+takeWhile cond = K.toParserK . D.takeWhile cond
464
464
465-- | Like 'takeWhile' but takes at least one element otherwise fails.
465-- | Like 'takeWhile' but takes at least one element otherwise fails.
466--
466--
@@ -468,7 +468,7 @@ takeWhile cond = D.toParserK . D.takeWhile cond
468--
468--
469{-# INLINE takeWhile1 #-}
469{-# INLINE takeWhile1 #-}
470takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
470takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
471−takeWhile1 cond = D.toParserK . D.takeWhile1 cond
471+takeWhile1 cond = K.toParserK . D.takeWhile1 cond
472
472
473-- | Like 'sliceSepBy' but uses a 'Parser' instead of a 'Fold' to collect the
473-- | Like 'sliceSepBy' but uses a 'Parser' instead of a 'Fold' to collect the
474-- input. @sliceSepByP cond parser@ parses a slice of the input using @parser@
474-- input. @sliceSepByP cond parser@ parses a slice of the input using @parser@
@@ -487,7 +487,7 @@ takeWhile1 cond = D.toParserK . D.takeWhile1 cond
487{-# INLINABLE sliceSepByP #-}
487{-# INLINABLE sliceSepByP #-}
488sliceSepByP :: -- MonadCatch m =>
488sliceSepByP :: -- MonadCatch m =>
489 (a -> Bool) -> Parser m a b -> Parser m a b
489 (a -> Bool) -> Parser m a b -> Parser m a b
490−sliceSepByP _cond = undefined -- D.toParserK . D.sliceSepByP cond
490+sliceSepByP _cond = undefined -- K.toParserK . D.sliceSepByP cond
491
491
492-- Note: Keep this consistent with S.splitOn. In fact we should eliminate
492-- Note: Keep this consistent with S.splitOn. In fact we should eliminate
493-- S.splitOn in favor of the parser.
493-- S.splitOn in favor of the parser.
@@ -536,7 +536,7 @@ sliceSepByP _cond = undefined -- D.toParserK . D.sliceSepByP cond
536-- /Internal/
536-- /Internal/
537{-# INLINABLE sliceSepBy #-}
537{-# INLINABLE sliceSepBy #-}
538sliceSepBy :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
538sliceSepBy :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b
539−sliceSepBy cond = D.toParserK . D.sliceSepBy cond
539+sliceSepBy cond = K.toParserK . D.sliceSepBy cond
540
540
541-- | Like 'sliceSepBy' but does not drop the separator element, instead
541-- | Like 'sliceSepBy' but does not drop the separator element, instead
542-- separator is emitted as a separate element in the output.
542-- separator is emitted as a separate element in the output.
@@ -545,7 +545,7 @@ sliceSepBy cond = D.toParserK . D.sliceSepBy cond
545{-# INLINABLE sliceSepWith #-}
545{-# INLINABLE sliceSepWith #-}
546sliceSepWith :: -- MonadCatch m =>
546sliceSepWith :: -- MonadCatch m =>
547 (a -> Bool) -> Fold m a b -> Parser m a b
547 (a -> Bool) -> Fold m a b -> Parser m a b
548−sliceSepWith _cond = undefined -- D.toParserK . D.sliceSepBy cond
548+sliceSepWith _cond = undefined -- K.toParserK . D.sliceSepBy cond
549
549
550-- | Collect stream elements until an element succeeds the predicate. Also take
550-- | Collect stream elements until an element succeeds the predicate. Also take
551-- the element on which the predicate succeeded. The succeeding element is
551-- the element on which the predicate succeeded. The succeeding element is
@@ -619,7 +619,7 @@ sliceBeginWith = undefined
619{-# INLINABLE sliceSepByMax #-}
619{-# INLINABLE sliceSepByMax #-}
620sliceSepByMax :: MonadCatch m
620sliceSepByMax :: MonadCatch m
621 => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
621 => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
622−sliceSepByMax cond cnt = D.toParserK . D.sliceSepByMax cond cnt
622+sliceSepByMax cond cnt = K.toParserK . D.sliceSepByMax cond cnt
623
623
624-- | Like 'sliceSepBy' but the separator elements can be escaped using an
624-- | Like 'sliceSepBy' but the separator elements can be escaped using an
625-- escape char determined by the second predicate.
625-- escape char determined by the second predicate.
@@ -629,7 +629,7 @@ sliceSepByMax cond cnt = D.toParserK . D.sliceSepByMax cond cnt
629escapedSliceSepBy :: -- MonadCatch m =>
629escapedSliceSepBy :: -- MonadCatch m =>
630 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
630 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
631escapedSliceSepBy _cond _esc = undefined
631escapedSliceSepBy _cond _esc = undefined
632− -- D.toParserK . D.escapedSliceSepBy cond esc
632+ -- K.toParserK . D.escapedSliceSepBy cond esc
633
633
634-- | @escapedFrameBy begin end escape@ parses a string framed using @begin@ and
634-- | @escapedFrameBy begin end escape@ parses a string framed using @begin@ and
635-- @end@ as the frame begin and end marker elements and @escape@ as an escaping
635-- @end@ as the frame begin and end marker elements and @escape@ as an escaping
@@ -655,7 +655,7 @@ escapedSliceSepBy _cond _esc = undefined
655escapedFrameBy :: -- MonadCatch m =>
655escapedFrameBy :: -- MonadCatch m =>
656 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
656 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
657escapedFrameBy _begin _end _escape _p = undefined
657escapedFrameBy _begin _end _escape _p = undefined
658− -- D.toParserK . D.frameBy begin end escape p
658+ -- K.toParserK . D.frameBy begin end escape p
659
659
660-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
660-- | Like 'splitOn' but strips leading, trailing, and repeated separators.
661-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
661-- Therefore, @".a..b."@ having '.' as the separator would be parsed as
@@ -710,7 +710,7 @@ groupBy = undefined
710--
710--
711{-# INLINE eqBy #-}
711{-# INLINE eqBy #-}
712eqBy :: MonadCatch m => (a -> a -> Bool) -> [a] -> Parser m a ()
712eqBy :: MonadCatch m => (a -> a -> Bool) -> [a] -> Parser m a ()
713−eqBy cmp = D.toParserK . D.eqBy cmp
713+eqBy cmp = K.toParserK . D.eqBy cmp
714
714
715-------------------------------------------------------------------------------
715-------------------------------------------------------------------------------
716-- nested parsers
716-- nested parsers
@@ -742,7 +742,7 @@ eqBy cmp = D.toParserK . D.eqBy cmp
742splitWith :: MonadCatch m
742splitWith :: MonadCatch m
743 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
743 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
744splitWith f p1 p2 =
744splitWith f p1 p2 =
745− D.toParserK $ D.splitWith f (D.fromParserK p1) (D.fromParserK p2)
745+ K.toParserK $ D.splitWith f (K.fromParserK p1) (K.fromParserK p2)
746
746
747-- | Sequential parser application ignoring the output of the first parser.
747-- | Sequential parser application ignoring the output of the first parser.
748-- Apply two parsers sequentially to an input stream. The input is provided to
748-- Apply two parsers sequentially to an input stream. The input is provided to
@@ -764,7 +764,7 @@ splitWith f p1 p2 =
764--
764--
765{-# INLINE split_ #-}
765{-# INLINE split_ #-}
766split_ :: MonadCatch m => Parser m x a -> Parser m x b -> Parser m x b
766split_ :: MonadCatch m => Parser m x a -> Parser m x b -> Parser m x b
767−split_ p1 p2 = D.toParserK $ D.split_ (D.fromParserK p1) (D.fromParserK p2)
767+split_ p1 p2 = K.toParserK $ D.split_ (K.fromParserK p1) (K.fromParserK p2)
768
768
769-- | @teeWith f p1 p2@ distributes its input to both @p1@ and @p2@ until both
769-- | @teeWith f p1 p2@ distributes its input to both @p1@ and @p2@ until both
770-- of them succeed or anyone of them fails and combines their output using @f@.
770-- of them succeed or anyone of them fails and combines their output using @f@.
@@ -776,7 +776,7 @@ split_ p1 p2 = D.toParserK $ D.split_ (D.fromParserK p1) (D.fromParserK p2)
776teeWith :: MonadCatch m
776teeWith :: MonadCatch m
777 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
777 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
778teeWith f p1 p2 =
778teeWith f p1 p2 =
779− D.toParserK $ D.teeWith f (D.fromParserK p1) (D.fromParserK p2)
779+ K.toParserK $ D.teeWith f (K.fromParserK p1) (K.fromParserK p2)
780
780
781-- | Like 'teeWith' but ends parsing and zips the results, if available,
781-- | Like 'teeWith' but ends parsing and zips the results, if available,
782-- whenever the first parser ends.
782-- whenever the first parser ends.
@@ -787,7 +787,7 @@ teeWith f p1 p2 =
787teeWithFst :: MonadCatch m
787teeWithFst :: MonadCatch m
788 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
788 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
789teeWithFst f p1 p2 =
789teeWithFst f p1 p2 =
790− D.toParserK $ D.teeWithFst f (D.fromParserK p1) (D.fromParserK p2)
790+ K.toParserK $ D.teeWithFst f (K.fromParserK p1) (K.fromParserK p2)
791
791
792-- | Like 'teeWith' but ends parsing and zips the results, if available,
792-- | Like 'teeWith' but ends parsing and zips the results, if available,
793-- whenever any of the parsers ends or fails.
793-- whenever any of the parsers ends or fails.
@@ -798,7 +798,7 @@ teeWithFst f p1 p2 =
798teeWithMin :: MonadCatch m
798teeWithMin :: MonadCatch m
799 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
799 => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c
800teeWithMin f p1 p2 =
800teeWithMin f p1 p2 =
801− D.toParserK $ D.teeWithMin f (D.fromParserK p1) (D.fromParserK p2)
801+ K.toParserK $ D.teeWithMin f (K.fromParserK p1) (K.fromParserK p2)
802
802
803-- | Sequential alternative. Apply the input to the first parser and return the
803-- | Sequential alternative. Apply the input to the first parser and return the
804-- result if the parser succeeds. If the first parser fails then backtrack and
804-- result if the parser succeeds. If the first parser fails then backtrack and
@@ -818,7 +818,7 @@ teeWithMin f p1 p2 =
818--
818--
819{-# INLINE alt #-}
819{-# INLINE alt #-}
820alt :: MonadCatch m => Parser m x a -> Parser m x a -> Parser m x a
820alt :: MonadCatch m => Parser m x a -> Parser m x a -> Parser m x a
821−alt p1 p2 = D.toParserK $ D.alt (D.fromParserK p1) (D.fromParserK p2)
821+alt p1 p2 = K.toParserK $ D.alt (K.fromParserK p1) (K.fromParserK p2)
822
822
823-- | Shortest alternative. Apply both parsers in parallel but choose the result
823-- | Shortest alternative. Apply both parsers in parallel but choose the result
824-- from the one which consumed least input i.e. take the shortest succeeding
824-- from the one which consumed least input i.e. take the shortest succeeding
@@ -829,7 +829,7 @@ alt p1 p2 = D.toParserK $ D.alt (D.fromParserK p1) (D.fromParserK p2)
829{-# INLINE shortest #-}
829{-# INLINE shortest #-}
830shortest :: MonadCatch m
830shortest :: MonadCatch m
831 => Parser m x a -> Parser m x a -> Parser m x a
831 => Parser m x a -> Parser m x a -> Parser m x a
832−shortest p1 p2 = D.toParserK $ D.shortest (D.fromParserK p1) (D.fromParserK p2)
832+shortest p1 p2 = K.toParserK $ D.shortest (K.fromParserK p1) (K.fromParserK p2)
833
833
834-- | Longest alternative. Apply both parsers in parallel but choose the result
834-- | Longest alternative. Apply both parsers in parallel but choose the result
835-- from the one which consumed more input i.e. take the longest succeeding
835-- from the one which consumed more input i.e. take the longest succeeding
@@ -840,7 +840,7 @@ shortest p1 p2 = D.toParserK $ D.shortest (D.fromParserK p1) (D.fromParserK p2)
840{-# INLINE longest #-}
840{-# INLINE longest #-}
841longest :: MonadCatch m
841longest :: MonadCatch m
842 => Parser m x a -> Parser m x a -> Parser m x a
842 => Parser m x a -> Parser m x a -> Parser m x a
843−longest p1 p2 = D.toParserK $ D.longest (D.fromParserK p1) (D.fromParserK p2)
843+longest p1 p2 = K.toParserK $ D.longest (K.fromParserK p1) (K.fromParserK p2)
844
844
845-- | Run a parser without consuming the input.
845-- | Run a parser without consuming the input.
846--
846--
@@ -848,7 +848,7 @@ longest p1 p2 = D.toParserK $ D.longest (D.fromParserK p1) (D.fromParserK p2)
848--
848--
849{-# INLINE lookAhead #-}
849{-# INLINE lookAhead #-}
850lookAhead :: MonadCatch m => Parser m a b -> Parser m a b
850lookAhead :: MonadCatch m => Parser m a b -> Parser m a b
851−lookAhead p = D.toParserK $ D.lookAhead $ D.fromParserK p
851+lookAhead p = K.toParserK $ D.lookAhead $ K.fromParserK p
852
852
853-------------------------------------------------------------------------------
853-------------------------------------------------------------------------------
854-- Interleaving
854-- Interleaving
@@ -915,7 +915,7 @@ sequence _f _p = undefined
915{-# INLINE concatMap #-}
915{-# INLINE concatMap #-}
916concatMap :: MonadCatch m
916concatMap :: MonadCatch m
917 => (b -> Parser m a c) -> Parser m a b -> Parser m a c
917 => (b -> Parser m a c) -> Parser m a b -> Parser m a c
918−concatMap f p = D.toParserK $ D.concatMap (D.fromParserK . f) (D.fromParserK p)
918+concatMap f p = K.toParserK $ D.concatMap (K.fromParserK . f) (K.fromParserK p)
919
919
920-------------------------------------------------------------------------------
920-------------------------------------------------------------------------------
921-- Alternative Collection
921-- Alternative Collection
@@ -951,7 +951,7 @@ choice _ps = undefined
951{-# INLINE manyP #-}
951{-# INLINE manyP #-}
952manyP :: -- MonadCatch m =>
952manyP :: -- MonadCatch m =>
953 Parser m b c -> Parser m a b -> Parser m a c
953 Parser m b c -> Parser m a b -> Parser m a c
954−manyP _f _p = undefined -- D.toParserK $ D.manyP f (D.fromParserK p)
954+manyP _f _p = undefined -- K.toParserK $ D.manyP f (K.fromParserK p)
955
955
956-- | Collect zero or more parses. Apply the parser repeatedly on the input
956-- | Collect zero or more parses. Apply the parser repeatedly on the input
957-- stream, stop when the parser fails, accumulate zero or more parse results
957-- stream, stop when the parser fails, accumulate zero or more parse results
@@ -964,7 +964,7 @@ manyP _f _p = undefined -- D.toParserK $ D.manyP f (D.fromParserK p)
964--
964--
965{-# INLINE many #-}
965{-# INLINE many #-}
966many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
966many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
967−many f p = D.toParserK $ D.many f (D.fromParserK p)
967+many f p = K.toParserK $ D.many f (K.fromParserK p)
968-- many = countBetween 0 maxBound
968-- many = countBetween 0 maxBound
969
969
970-- | Collect one or more parses. Apply the supplied parser repeatedly on the
970-- | Collect one or more parses. Apply the supplied parser repeatedly on the
@@ -978,7 +978,7 @@ many f p = D.toParserK $ D.many f (D.fromParserK p)
978--
978--
979{-# INLINE some #-}
979{-# INLINE some #-}
980some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
980some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
981−some f p = D.toParserK $ D.some f (D.fromParserK p)
981+some f p = K.toParserK $ D.some f (K.fromParserK p)
982-- some f p = manyP (takeGE 1 f) p
982-- some f p = manyP (takeGE 1 f) p
983-- many = countBetween 1 maxBound
983-- many = countBetween 1 maxBound
984
984
@@ -1023,7 +1023,7 @@ count n = countBetween n n
1023manyTillP :: -- MonadCatch m =>
1023manyTillP :: -- MonadCatch m =>
1024 Parser m b c -> Parser m a b -> Parser m a x -> Parser m a c
1024 Parser m b c -> Parser m a b -> Parser m a x -> Parser m a c
1025manyTillP _f _p1 _p2 = undefined
1025manyTillP _f _p1 _p2 = undefined
1026− -- D.toParserK $ D.manyTillP f (D.fromParserK p1) (D.fromParserK p2)
1026+ -- K.toParserK $ D.manyTillP f (K.fromParserK p1) (K.fromParserK p2)
1027
1027
1028-- | @manyTill f collect test@ tries the parser @test@ on the input, if @test@
1028-- | @manyTill f collect test@ tries the parser @test@ on the input, if @test@
1029-- fails it backtracks and tries @collect@, after @collect@ succeeds @test@ is
1029-- fails it backtracks and tries @collect@, after @collect@ succeeds @test@ is
@@ -1037,7 +1037,7 @@ manyTillP _f _p1 _p2 = undefined
1037manyTill :: MonadCatch m
1037manyTill :: MonadCatch m
1038 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1038 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
1039manyTill f p1 p2 =
1039manyTill f p1 p2 =
1040− D.toParserK $ D.manyTill f (D.fromParserK p1) (D.fromParserK p2)
1040+ K.toParserK $ D.manyTill f (K.fromParserK p1) (K.fromParserK p2)
1041
1041
1042-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
1042-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and
1043-- collects the output in the supplied fold. If the the parser @collect@ fails,
1043-- collects the output in the supplied fold. If the the parser @collect@ fails,
src/Streamly/Internal/Data/Parser/ParserD.hs+1−77
@@ -19,8 +19,6 @@ module Streamly.Internal.Data.Parser.ParserD
19 -- First order parsers
19 -- First order parsers
20 -- * Accumulators
20 -- * Accumulators
21 , fromFold
21 , fromFold
22− , toParserK
23− , fromParserK
24 , any
22 , any
25 , all
23 , all
26 , yield
24 , yield
@@ -160,14 +158,9 @@ where
160
158
161import Control.Exception (assert)
159import Control.Exception (assert)
162import Control.Monad.Catch (MonadCatch, MonadThrow(..))
160import Control.Monad.Catch (MonadCatch, MonadThrow(..))
163−import Prelude
164− hiding (any, all, take, takeWhile, sequence, concatMap)
161+import Prelude hiding (any, all, take, takeWhile, sequence, concatMap)
165−
166import Streamly.Internal.Data.Fold.Types (Fold(..))
162import Streamly.Internal.Data.Fold.Types (Fold(..))
167
163
168−import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
169−import qualified Streamly.Internal.Data.Zipper as Z
170−
171import Streamly.Internal.Data.Parser.ParserD.Tee
164import Streamly.Internal.Data.Parser.ParserD.Tee
172import Streamly.Internal.Data.Parser.ParserD.Types
165import Streamly.Internal.Data.Parser.ParserD.Types
173import Streamly.Internal.Data.Strict
166import Streamly.Internal.Data.Strict
@@ -188,75 +181,6 @@ fromFold (Fold fstep finitial fextract) = Parser step finitial fextract
188
181
189 step s a = Partial 0 <$> fstep s a
182 step s a = Partial 0 <$> fstep s a
190
183
191−-------------------------------------------------------------------------------
192−-- Convert to and from CPS style parser representation
193−-------------------------------------------------------------------------------
194−
195−-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.
196−--
197−-- /Internal/
198−--
199−{-# INLINE_LATE toParserK #-}
200−toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b
201−toParserK (Parser step initial extract) =
202− K.MkParser $ K.parse step initial extract
203−
204−-- XXX The CPS style parsers use a zipper buffering the data, if a parserD is
205−-- driving the parserK then it would also be buffering the same data. For
206−-- ParserD, instead of maintaining the buffer in the common driver, each parser
207−-- can have its own buffering and we can return the unconsumed buffer in the
208−-- end. That way the zipper is maintained by the parser. If the parser fails
209−-- then it has to return all of the input. It is anyway maintained by
210−-- intermediate level parsers in a composition, so the only difference would be
211−-- that even the leaf levels parsers would do it. If we abstract the zipper
212−-- maintainance then it may not be too unwieldy.
213−--
214−-- | Convert a CPS style 'K.Parser' to a direct style 'Parser'.
215−--
216−-- /Unimplemented/
217−--
218−{-# INLINE_LATE fromParserK #-}
219−fromParserK :: MonadThrow m => K.Parser m a b -> Parser m a b
220−fromParserK parser = Parser step initial extract
221−
222− where
223−
224− initial = return Nothing
225−
226− step Nothing a = do
227− let yieldk _ (K.Done b) = return $ K.Stop b
228− yieldk _ (K.Error e) = return $ K.Failed e
229− r <- K.runParser parser (Z.Zipper [] [] [a]) yieldk
230− case r of
231− -- XXX it should return the leftover count
232− K.Stop b -> return $ Done 0 b
233− K.Failed e -> return $ Error e
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
243− step (Just cont) a = do
244− r <- cont (Just a)
245− case r of
246− K.Stop b -> return $ Done 0 b
247− K.Failed e -> return $ Error e
248− K.Partial cont1 -> return $ Partial 0 $ Just cont1
249−
250− extract Nothing = throwM $ ParseError "end of input"
251− extract (Just cont) = K.extractParse cont
252−
253−#ifndef DISABLE_FUSION
254−{-# RULES "fromParserK/toParserK fusion" [2]
255− forall s. toParserK (fromParserK s) = s #-}
256−{-# RULES "toParserK/fromParserK fusion" [2]
257− forall s. fromParserK (toParserK s) = s #-}
258−#endif
259−
260-------------------------------------------------------------------------------
184-------------------------------------------------------------------------------
261-- Terminating but not failing folds
185-- Terminating but not failing folds
262-------------------------------------------------------------------------------
186-------------------------------------------------------------------------------
src/Streamly/Internal/Data/Parser/ParserK/Types.hs+301−198
@@ -20,15 +20,13 @@
20
20
21module Streamly.Internal.Data.Parser.ParserK.Types
21module Streamly.Internal.Data.Parser.ParserK.Types
22 (
22 (
23− Parse (..)
24− , Driver (..)
25− , Parser (..)
23+ Parser (..)
26− , extractParse
27 , yield
24 , yield
28 , die
25 , die
29
26
30− -- * Parsing
27+ -- * Conversion
31− , parse
28+ , toParserK
29+ , fromParserK
32 )
30 )
33where
31where
34
32
@@ -46,7 +44,7 @@ import Streamly.Internal.Data.Zipper (Zipper (..))
46import Prelude hiding (splitAt)
44import Prelude hiding (splitAt)
47
45
48import qualified Streamly.Internal.Data.Zipper as Z
46import qualified Streamly.Internal.Data.Zipper as Z
49−import qualified Streamly.Internal.Data.Parser.ParserD.Types as PD
47+import qualified Streamly.Internal.Data.Parser.ParserD.Types as D
50
48
51-- | The parse driver result. The driver may stop with a final result, pause
49-- | The parse driver result. The driver may stop with a final result, pause
52-- with a continuation to resume, or fail with an error.
50-- with a continuation to resume, or fail with an error.
@@ -54,15 +52,17 @@ import qualified Streamly.Internal.Data.Parser.ParserD.Types as PD
54-- /Internal/
52-- /Internal/
55--
53--
56data Driver m a r =
54data Driver m a r =
57− Stop r
55+ Stop !Int r
58 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.
56 -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.
59 -- measure if that works any better.
57 -- measure if that works any better.
60 | Partial (Maybe a -> m (Driver m a r))
58 | Partial (Maybe a -> m (Driver m a r))
59+ | Continue (Maybe a -> m (Driver m a r))
61 | Failed String
60 | Failed String
62
61
63instance Functor m => Functor (Driver m a) where
62instance Functor m => Functor (Driver m a) where
64− fmap f (Stop r) = Stop (f r)
63+ fmap f (Stop n r) = Stop n (f r)
65 fmap f (Partial yld) = Partial (fmap (fmap f) . yld)
64 fmap f (Partial yld) = Partial (fmap (fmap f) . yld)
65+ fmap f (Continue yld) = Continue (fmap (fmap f) . yld)
66 fmap _ (Failed e) = Failed e
66 fmap _ (Failed e) = Failed e
67
67
68-- The parser's result.
68-- The parser's result.
@@ -89,6 +89,220 @@ newtype Parser m a b = MkParser
89 -> m (Driver m a r)
89 -> m (Driver m a r)
90 }
90 }
91
91
92+-------------------------------------------------------------------------------
93+-- Convert direct style 'D.Parser' to CPS style 'Parser'
94+-------------------------------------------------------------------------------
95+
96+-- Inlined definition. Without the inline "serially/parser/take" benchmark
97+-- degrades and splitParse does not fuse. Even using "inline" at the callsite
98+-- does not help.
99+{-# INLINE splitAt #-}
100+splitAt :: Int -> [a] -> ([a],[a])
101+splitAt n ls
102+ | n <= 0 = ([], ls)
103+ | otherwise = splitAt' n ls
104+ where
105+ splitAt' :: Int -> [a] -> ([a], [a])
106+ splitAt' _ [] = ([], [])
107+ splitAt' 1 (x:xs) = ([x], xs)
108+ splitAt' m (x:xs) = (x:xs', xs'')
109+ where
110+ (xs', xs'') = splitAt' (m - 1) xs
111+
112+-- XXX Unlike the direct style folds/parsers, the initial action in CPS parsers
113+-- is not performed when the fold is initialized. It is performed when the
114+-- first element is processed by the fold or if no elements are processed then
115+-- at the extraction. We should either make the direct folds like this or make
116+-- the CPS folds behavior also like the direct ones.
117+--
118+-- | Parse a stream zipper using a direct style parser's @step@, @initial@ and
119+-- @extract@ functions.
120+--
121+{-# INLINE_NORMAL parse #-}
122+parse
123+ :: MonadCatch m
124+ => (s -> a -> m (D.Step s b))
125+ -> m s
126+ -> (s -> m b)
127+ -> Zipper a
128+ -> (Zipper a -> Parse b -> m (Driver m a r))
129+ -> m (Driver m a r)
130+
131+-- The case when no checkpoints exist
132+parse pstep initial extract (Zipper [] backward forward) cont =
133+ case forward of
134+ [] -> return $ Continue (parseCont backward initial)
135+ _ -> goBuf backward forward initial
136+
137+ where
138+
139+ parseCont back acc (Just x) = goSingle back x acc
140+ parseCont back acc Nothing = do
141+ pst <- acc
142+ r <- try $ extract pst
143+ -- NOTE: Any data held in the backtrack buffer is considered as unused
144+ -- data if we extract the parser result without the parser finishing.
145+ let z = Zipper [] back []
146+ case r of
147+ Left (e :: D.ParseError) ->
148+ cont z (Error (displayException e))
149+ Right b -> cont z (Done b)
150+
151+ {-# INLINE goSingle #-}
152+ goSingle back x !pst = do
153+ r <- pst
154+ pRes <- pstep r x
155+ case pRes of
156+ D.Partial 0 pst1 -> return $ Partial (parseCont [] (return pst1))
157+ D.Partial n pst1 -> do
158+ assert (n <= length (x:back)) (return ())
159+ let src0 = Prelude.take n (x:back)
160+ src = Prelude.reverse src0
161+ goBuf [] src (return pst1)
162+ D.Continue 0 pst1 ->
163+ return $ Continue (parseCont (x:back) (return pst1))
164+ D.Continue n pst1 -> do
165+ assert (n <= length (x:back)) (return ())
166+ let (src0, buf1) = splitAt n (x:back)
167+ src = Prelude.reverse src0
168+ goBuf buf1 src (return pst1)
169+ D.Done n b -> do
170+ assert (n <= length (x:back)) (return ())
171+ let (src0, buf1) = splitAt n (x:back)
172+ src = Prelude.reverse src0
173+ cont (Zipper [] buf1 src) (Done b)
174+ D.Error err -> cont (Zipper [] (x:back) []) (Error err)
175+
176+ goBuf back [] !acc = return $ Continue (parseCont back acc)
177+ goBuf back (x:xs) !pst = do
178+ r <- pst
179+ pRes <- pstep r x
180+ case pRes of
181+ D.Partial 0 pst1 ->
182+ goBuf [] xs (return pst1)
183+ D.Partial n pst1 -> do
184+ assert (n <= length (x:back)) (return ())
185+ let src0 = Prelude.take n (x:back)
186+ src = Prelude.reverse src0
187+ goBuf [] (src ++ xs) (return pst1)
188+ D.Continue 0 pst1 -> goBuf (x:back) xs (return pst1)
189+ D.Continue n pst1 -> do
190+ assert (n <= length (x:back)) (return ())
191+ let (src0, buf1) = splitAt n (x:back)
192+ src = Prelude.reverse src0 ++ xs
193+ goBuf buf1 src (return pst1)
194+ D.Done n b -> do
195+ assert (n <= length (x:back)) (return ())
196+ let (src0, buf1) = splitAt n (x:back)
197+ src = Prelude.reverse src0 ++ xs
198+ cont (Zipper [] buf1 src) (Done b)
199+ D.Error err -> cont (Zipper [] (x:back) xs) (Error err)
200+
201+-- The case when checkpoints exist
202+-- XXX code duplication alert!
203+parse pstep initial extract (Zipper (cp:cps) backward forward) cont =
204+ case forward of
205+ [] -> return $ Continue (parseCont 0 backward initial)
206+ _ -> goBuf 0 backward forward initial
207+
208+ where
209+
210+ parseCont cnt back acc (Just x) = goSingle cnt back x acc
211+ parseCont cnt back acc Nothing = do
212+ pst <- acc
213+ r <- try $ extract pst
214+ let z = Zipper (cp + cnt : cps) back []
215+ case r of
216+ Left (e :: D.ParseError) ->
217+ cont z (Error (displayException e))
218+ Right b -> cont z (Done b)
219+
220+ {-# INLINE goSingle #-}
221+ goSingle cnt back x !pst = do
222+ r <- pst
223+ pRes <- pstep r x
224+ let cnt1 = cnt + 1
225+ case pRes of
226+ D.Partial 0 pst1 ->
227+ return $ Partial (parseCont cnt1 [] (return pst1))
228+ D.Partial n pst1 -> do
229+ assert (n <= length (x:back)) (return ())
230+ let src0 = Prelude.take n (x:back)
231+ src = Prelude.reverse src0
232+ goBuf (cnt1 - n) [] src (return pst1)
233+ D.Continue 0 pst1 ->
234+ return $ Continue (parseCont cnt1 (x:back) (return pst1))
235+ D.Continue n pst1 -> do
236+ assert (n <= length (x:back)) (return ())
237+ let (src0, buf1) = splitAt n (x:back)
238+ src = Prelude.reverse src0
239+ assert (cnt1 - n >= 0) (return ())
240+ goBuf (cnt1 - n) buf1 src (return pst1)
241+ D.Done n b -> do
242+ assert (n <= length (x:back)) (return ())
243+ let (src0, buf1) = splitAt n (x:back)
244+ src = Prelude.reverse src0
245+ assert (cp + cnt1 - n >= 0) (return ())
246+ cont (Zipper (cp + cnt1 - n : cps) buf1 src) (Done b)
247+ D.Error err ->
248+ cont (Zipper (cp + cnt1 : cps) (x:back) []) (Error err)
249+
250+ goBuf cnt back [] !acc = return $ Continue (parseCont cnt back acc)
251+ goBuf cnt back (x:xs) !pst = do
252+ r <- pst
253+ pRes <- pstep r x
254+ let cnt1 = cnt + 1
255+ case pRes of
256+ D.Partial 0 pst1 ->
257+ goBuf cnt1 [] xs (return pst1)
258+ D.Partial n pst1 -> do
259+ assert (n <= length (x:back)) (return ())
260+ let src0 = Prelude.take n (x:back)
261+ src = Prelude.reverse src0
262+ goBuf (cnt1 - n) [] (src ++ xs) (return pst1)
263+ D.Continue 0 pst1 -> goBuf cnt1 (x:back) xs (return pst1)
264+ D.Continue n pst1 -> do
265+ assert (n <= length (x:back)) (return ())
266+ let (src0, buf1) = splitAt n (x:back)
267+ src = Prelude.reverse src0 ++ xs
268+ assert (cnt1 - n >= 0) (return ())
269+ goBuf (cnt1 - n) buf1 src (return pst1)
270+ D.Done n b -> do
271+ assert (n <= length (x:back)) (return ())
272+ let (src0, buf1) = splitAt n (x:back)
273+ src = Prelude.reverse src0 ++ xs
274+ assert (cp + cnt1 - n >= 0) (return ())
275+ cont (Zipper (cp + cnt1 - n : cps) buf1 src) (Done b)
276+ D.Error err ->
277+ cont (Zipper (cp + cnt1 : cps) (x:back) xs) (Error err)
278+
279+-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.
280+--
281+-- /Internal/
282+--
283+{-# INLINE_LATE toParserK #-}
284+toParserK :: MonadCatch m => D.Parser m a b -> Parser m a b
285+toParserK (D.Parser step initial extract) =
286+ MkParser $ parse step initial extract
287+
288+-------------------------------------------------------------------------------
289+-- Convert CPS style 'Parser' to direct style 'D.Parser'
290+-------------------------------------------------------------------------------
291+
292+-- | A continuation to extract the result when a CPS parser is done.
293+{-# INLINE parserDone #-}
294+parserDone :: Monad m => Zipper a -> Parse b -> m (Driver m a b)
295+parserDone (Z.Zipper [] bwd fwd) (Done b) =
296+ -- When the parser is Done, we consider the data in the
297+ -- backtracking buffer as well as in the forward buffer as
298+ -- unconsumed input.
299+ -- XXX Will it be more efficient/worth it to maintain a count
300+ -- in the Zipper?
301+ return $ Stop (length bwd + length fwd) b
302+parserDone (Z.Zipper cps _ _) (Done _) =
303+ error $ "Bug: fromParserK: when checkpoints exist: " ++ show cps
304+parserDone _ (Error e) = return $ Failed e
305+
92-- | When there is no more input to feed, extract the result from the Parser.
306-- | When there is no more input to feed, extract the result from the Parser.
93--
307--
94-- /Internal/
308-- /Internal/
@@ -97,9 +311,66 @@ extractParse :: MonadThrow m => (Maybe a -> m (Driver m a b)) -> m b
97extractParse cont = do
311extractParse cont = do
98 r <- cont Nothing
312 r <- cont Nothing
99 case r of
313 case r of
100− Stop b -> return b
314+ Stop _ b -> return b
101 Partial _ -> error "Bug: extractParse got Partial"
315 Partial _ -> error "Bug: extractParse got Partial"
316+ Continue _ -> error "Bug: extractParse got Continue"
102− Failed e -> throwM $ PD.ParseError e
317+ Failed e -> throwM $ D.ParseError e
318+
319+-- XXX The CPS style parsers use a zipper buffering the data, if a parserD is
320+-- driving the parserK then it would also be buffering the same data. For
321+-- ParserD, instead of maintaining the buffer in the common driver, each parser
322+-- can have its own buffering and we can return the unconsumed buffer in the
323+-- end. That way the zipper is maintained by the parser. If the parser fails
324+-- then it has to return all of the input. It is anyway maintained by
325+-- intermediate level parsers in a composition, so the only difference would be
326+-- that even the leaf levels parsers would do it. If we abstract the zipper
327+-- maintainance then it may not be too unwieldy.
328+
329+data FromParserK b e c = FPKDone !b | FPKError !e | FPKCont c
330+
331+-- | Convert a CPS style 'Parser' to a direct style 'D.Parser'.
332+--
333+-- /Internal/
334+--
335+{-# INLINE_LATE fromParserK #-}
336+fromParserK :: MonadThrow m => Parser m a b -> D.Parser m a b
337+fromParserK parser = D.Parser step initial extract
338+
339+ where
340+
341+ initial = do
342+ r <- runParser parser Z.nil parserDone
343+ return $ case r of
344+ Stop 0 b -> FPKDone b
345+ Stop _ _ -> error "Bug: fromParserK: Stop n in initial"
346+ Failed e -> FPKError e
347+ Partial cont -> FPKCont cont -- XXX can we get this?
348+ Continue cont -> FPKCont cont
349+
350+ step (FPKDone b) _ = return $ D.Done 1 b
351+ step (FPKError e) _ = return $ D.Error e
352+ step (FPKCont cont) a = do
353+ r <- cont (Just a)
354+ return $ case r of
355+ Stop n b -> D.Done n b
356+ Failed e -> D.Error e
357+ Partial cont1 -> D.Partial 0 (FPKCont cont1)
358+ Continue cont1 -> D.Continue 0 (FPKCont cont1)
359+
360+ extract (FPKDone b) = return b
361+ extract (FPKError e) = throwM $ D.ParseError e
362+ extract (FPKCont cont) = extractParse cont
363+
364+#ifndef DISABLE_FUSION
365+{-# RULES "fromParserK/toParserK fusion" [2]
366+ forall s. toParserK (fromParserK s) = s #-}
367+{-# RULES "toParserK/fromParserK fusion" [2]
368+ forall s. fromParserK (toParserK s) = s #-}
369+#endif
370+
371+-------------------------------------------------------------------------------
372+-- Functor
373+-------------------------------------------------------------------------------
103
374
104-- | Maps a function over the output of the parser.
375-- | Maps a function over the output of the parser.
105--
376--
@@ -109,7 +380,13 @@ instance Functor m => Functor (Parser m a) where
109 let yld z res = yieldk z (fmap f res)
380 let yld z res = yieldk z (fmap f res)
110 in runParser parser zipper yld
381 in runParser parser zipper yld
111
382
112−-- | See 'Streamly.Internal.Data.Parser.yield'.
383+-------------------------------------------------------------------------------
384+-- Sequential applicative
385+-------------------------------------------------------------------------------
386+
387+-- This is the dual of stream "yield".
388+--
389+-- | A parser that always yields a pure value without consuming any input.
113--
390--
114-- /Internal/
391-- /Internal/
115--
392--
@@ -117,10 +394,6 @@ instance Functor m => Functor (Parser m a) where
117yield :: b -> Parser m a b
394yield :: b -> Parser m a b
118yield b = MkParser (\zipper yieldk -> yieldk zipper (Done b))
395yield b = MkParser (\zipper yieldk -> yieldk zipper (Done b))
119
396
120−-------------------------------------------------------------------------------
121−-- Sequential applicative
122−-------------------------------------------------------------------------------
123−
124-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.splitWith'. Note that
397-- | 'Applicative' form of 'Streamly.Internal.Data.Parser.splitWith'. Note that
125-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.splitWith'
398-- this operation does not fuse, use 'Streamly.Internal.Data.Parser.splitWith'
126-- when fusion is important.
399-- when fusion is important.
@@ -145,7 +418,14 @@ instance Monad m => Applicative (Parser m a) where
145 yield1 z (Error e) = yieldk z (Error e)
418 yield1 z (Error e) = yieldk z (Error e)
146 in runParser m1 zipper yield1
419 in runParser m1 zipper yield1
147
420
148−-- | See 'Streamly.Internal.Data.Parser.die'.
421+-------------------------------------------------------------------------------
422+-- Monad
423+-------------------------------------------------------------------------------
424+
425+-- This is the dual of "nil".
426+--
427+-- | A parser that always fails with an error message without consuming
428+-- any input.
149--
429--
150-- /Internal/
430-- /Internal/
151--
431--
@@ -219,6 +499,10 @@ instance Monad m => Fail.MonadFail (Parser m a) where
219 fail = die
499 fail = die
220#endif
500#endif
221
501
502+-------------------------------------------------------------------------------
503+-- Alternative
504+-------------------------------------------------------------------------------
505+
222-- XXX one way to backtrack is to ask the input driver to create and release
506-- 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
507-- 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
508-- zipper itself. Currently in the direct style code we manage the checkpoints
@@ -279,184 +563,3 @@ instance Monad m => MonadPlus (Parser m a) where
279
563
280 {-# INLINE mplus #-}
564 {-# INLINE mplus #-}
281 mplus = (<|>)
565 mplus = (<|>)
282−
283−-------------------------------------------------------------------------------
284−-- Parse driver for a Zipper
285−-------------------------------------------------------------------------------
286−
287−-- Inlined definition. Without the inline "serially/parser/take" benchmark
288−-- degrades and splitParse does not fuse. Even using "inline" at the callsite
289−-- does not help.
290−{-# INLINE splitAt #-}
291−splitAt :: Int -> [a] -> ([a],[a])
292−splitAt n ls
293− | n <= 0 = ([], ls)
294− | otherwise = splitAt' n ls
295− where
296− splitAt' :: Int -> [a] -> ([a], [a])
297− splitAt' _ [] = ([], [])
298− splitAt' 1 (x:xs) = ([x], xs)
299− splitAt' m (x:xs) = (x:xs', xs'')
300− where
301− (xs', xs'') = splitAt' (m - 1) xs
302−
303−-- | Parse a stream zipper using a direct style parser's @step@, @initial@ and
304−-- @extract@ functions.
305−--
306−{-# INLINE_NORMAL parse #-}
307−parse
308− :: MonadCatch m
309− => (s -> a -> m (PD.Step s b))
310− -> m s
311− -> (s -> m b)
312− -> Zipper a
313− -> (Zipper a -> Parse b -> m (Driver m a r))
314− -> m (Driver m a r)
315−
316−-- The case when no checkpoints exist
317−parse pstep initial extract (Zipper [] backward forward) cont =
318− case forward of
319− [] -> return $ Partial (parseCont backward initial)
320− _ -> goBuf backward forward initial
321−
322− where
323−
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
362− r <- pst
363− pRes <- pstep r x
364− case pRes of
365− PD.Partial 0 pst1 ->
366− goBuf [] xs (return pst1)
367− PD.Partial n pst1 -> do
368− assert (n <= length (x:back)) (return ())
369− let src0 = Prelude.take n (x:back)
370− src = Prelude.reverse src0
371− goBuf [] (src ++ xs) (return pst1)
372− PD.Continue 0 pst1 -> goBuf (x:back) xs (return pst1)
373− PD.Continue n pst1 -> do
374− assert (n <= length (x:back)) (return ())
375− let (src0, buf1) = splitAt n (x:back)
376− src = Prelude.reverse src0 ++ xs
377− goBuf buf1 src (return pst1)
378− PD.Done n b -> do
379− assert (n <= length (x:back)) (return ())
380− let (src0, buf1) = splitAt n (x:back)
381− src = Prelude.reverse src0 ++ xs
382− cont (Zipper [] buf1 src) (Done b)
383− PD.Error err -> cont (Zipper [] (x:back) xs) (Error err)
384−
385−-- The case when checkpoints exist
386−-- XXX code duplication alert!
387−parse pstep initial extract (Zipper (cp:cps) backward forward) cont =
388− case forward of
389− [] -> return $ Partial (parseCont 0 backward initial)
390− _ -> goBuf 0 backward forward initial
391−
392− where
393−
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
437− r <- pst
438− pRes <- pstep r x
439− let cnt1 = cnt + 1
440− case pRes of
441− PD.Partial 0 pst1 ->
442− goBuf cnt1 [] xs (return pst1)
443− PD.Partial n pst1 -> do
444− assert (n <= length (x:back)) (return ())
445− let src0 = Prelude.take n (x:back)
446− src = Prelude.reverse src0
447− goBuf (cnt1 - n) [] (src ++ xs) (return pst1)
448− PD.Continue 0 pst1 -> goBuf cnt1 (x:back) xs (return pst1)
449− PD.Continue n pst1 -> do
450− assert (n <= length (x:back)) (return ())
451− let (src0, buf1) = splitAt n (x:back)
452− src = Prelude.reverse src0 ++ xs
453− assert (cnt1 - n >= 0) (return ())
454− goBuf (cnt1 - n) buf1 src (return pst1)
455− PD.Done n b -> do
456− assert (n <= length (x:back)) (return ())
457− let (src0, buf1) = splitAt n (x:back)
458− src = Prelude.reverse src0 ++ xs
459− assert (cp + cnt1 - n >= 0) (return ())
460− cont (Zipper (cp + cnt1 - n : cps) buf1 src) (Done b)
461− PD.Error err ->
462− cont (Zipper (cp + cnt1 : cps) (x:back) xs) (Error err)
src/Streamly/Internal/Prelude.hs+3−3
@@ -1374,7 +1374,7 @@ parseK = parse
1374--
1374--
1375{-# INLINE [3] parse #-}
1375{-# INLINE [3] parse #-}
1376parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b
1376parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b
1377−parse = parseD . PRD.fromParserK
1377+parse = parseD . PRK.fromParserK
1378
1378
1379------------------------------------------------------------------------------
1379------------------------------------------------------------------------------
1380-- Specialized folds
1380-- Specialized folds
@@ -3494,7 +3494,7 @@ parseMany
3494 -> t m a
3494 -> t m a
3495 -> t m b
3495 -> t m b
3496parseMany p m =
3496parseMany p m =
3497− D.fromStreamD $ D.parseMany (PRD.fromParserK p) (D.toStreamD m)
3497+ D.fromStreamD $ D.parseMany (PRK.fromParserK p) (D.toStreamD m)
3498
3498
3499-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,
3499-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,
3500-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds
3500-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds
@@ -3533,7 +3533,7 @@ parseIterate
3533 -> t m a
3533 -> t m a
3534 -> t m b
3534 -> t m b
3535parseIterate f i m = D.fromStreamD $
3535parseIterate f i m = D.fromStreamD $
3536− D.parseIterate (PRD.fromParserK . f) i (D.toStreamD m)
3536+ D.parseIterate (PRK.fromParserK . f) i (D.toStreamD m)
3537
3537
3538------------------------------------------------------------------------------
3538------------------------------------------------------------------------------
3539-- Grouping/Splitting
3539-- Grouping/Splitting