From fd4eea2532880f77b6f06501057d601d001788b9 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Mon, 29 Jul 2024 16:53:55 +0530 Subject: [PATCH 01/20] Add Parser patterns for backward compatibility --- .../src/Streamly/Internal/Data/Parser/Type.hs | 37 +++++++++++++++++-- 1 file changed, 33 insertions(+), 4 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index e0ac6bb2a6..5cb5bd1fbf 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE NoMonoLocalBinds #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} -- | -- Module : Streamly.Internal.Data.Parser.ParserD.Type -- Copyright : (c) 2020 Composewell Technologies @@ -178,7 +180,8 @@ module Streamly.Internal.Data.Parser.Type ( -- * Types Initial (..) - , Step (..) + -- (..) does not seem to export patterns yet the compiler complains it does. + , Step(Partial, Continue, Done, SPartial, SContinue, SDone, Error) , extractStep , bimapOverrideCount , Parser (..) @@ -322,7 +325,7 @@ instance Functor (Initial s) where -- {-# ANN type Step Fuse #-} data Step s b = - Partial !Int !s + SPartial !Int !s -- ^ @Partial count state@. The following hold on Partial result: -- -- 1. @extract@ on @state@ would succeed and give a result. @@ -330,7 +333,7 @@ data Step s b = -- 3. All input before the new position is dropped. The parser can -- never backtrack beyond this position. - | Continue !Int !s + | SContinue !Int !s -- ^ @Continue count state@. The following hold on a Continue result: -- -- 1. If there was a 'Partial' result in past, @extract@ on @state@ would @@ -339,7 +342,7 @@ data Step s b = -- 2. Input stream position is reset to @current position - count@. -- 3. the input is retained in a backtrack buffer. - | Done !Int !b + | SDone !Int !b -- ^ Done with leftover input count and result. -- -- @Done count result@ means the parser has finished, it will accept no @@ -353,6 +356,32 @@ data Step s b = -- alternative. deriving (Show) +-------------------------------------------------------------------------------- +-- Custom Patterns +-------------------------------------------------------------------------------- + +negateDirection :: Step s b -> Step s b +negateDirection (SPartial i s) = SPartial (1 - i) s +negateDirection (SContinue i s) = SContinue (1 - i) s +negateDirection (SDone i b) = SDone (1 - i) b +negateDirection (Error s) = Error s + +pattern Partial :: Int -> s -> Step s b +pattern Partial i s <- (negateDirection -> SPartial i s) + where Partial i s = SPartial (1 - i) s + +pattern Continue :: Int -> s -> Step s b +pattern Continue i s <- (negateDirection -> SContinue i s) + where Continue i s = SContinue (1 - i) s + +pattern Done :: Int -> b -> Step s b +pattern Done i b <- (negateDirection -> SDone i b) + where Done i b = SDone (1 - i) b + +-------------------------------------------------------------------------------- +-- Code +-------------------------------------------------------------------------------- + -- | Map first function over the state and second over the result. instance Bifunctor Step where {-# INLINE bimap #-} From a5139cea34b9ed757aa333db20442ec6faf73d92 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Mon, 29 Jul 2024 21:08:44 +0530 Subject: [PATCH 02/20] Update the parser drivers - Stream.parse - Producer.parse - Stream.parseMany - StreamK.parseD - Array.parseBreakChunksK --- core/src/Streamly/Internal/Data/Array.hs | 42 ++++--- .../Streamly/Internal/Data/Producer/Source.hs | 51 ++++---- .../Internal/Data/Stream/Eliminate.hs | 85 ++++++++------ .../Streamly/Internal/Data/Stream/Nesting.hs | 110 +++++++++++------- core/src/Streamly/Internal/Data/StreamK.hs | 38 +++--- 5 files changed, 193 insertions(+), 133 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index 3ee5986611..97924c0312 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -891,28 +891,31 @@ parseBreakChunksK (Parser pstep initial extract) stream = do pRes <- pstep pst x let next = INDEX_NEXT(cur,a) case pRes of - Parser.Partial 0 s -> + Parser.SPartial 1 s -> goArray s [] st (Array contents next end) - Parser.Partial n s -> do + Parser.SPartial m s -> do + let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let src0 = Prelude.take n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 goArray s [] st src - Parser.Continue 0 s -> + Parser.SContinue 1 s -> goArray s (x:backBuf) st (Array contents next end) - Parser.Continue n s -> do + Parser.SContinue m s -> do + let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let (src0, buf1) = Prelude.splitAt n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 goArray s buf1 st src - Parser.Done 0 b -> do + Parser.SDone 1 b -> do let arr = Array contents next end return (Right b, StreamK.cons arr st) - Parser.Done n b -> do + Parser.SDone m b -> do + let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let src0 = Prelude.take n (x:backBuf) -- XXX Use fromListRevN once implemented @@ -936,28 +939,31 @@ parseBreakChunksK (Parser pstep initial extract) stream = do pRes <- pstep pst x let next = INDEX_NEXT(cur,a) case pRes of - Parser.Partial 0 s -> + Parser.SPartial 1 s -> goExtract s [] (Array contents next end) - Parser.Partial n s -> do + Parser.SPartial m s -> do + let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let src0 = Prelude.take n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 goExtract s [] src - Parser.Continue 0 s -> + Parser.SContinue 1 s -> goExtract s backBuf (Array contents next end) - Parser.Continue n s -> do + Parser.SContinue m s -> do + let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let (src0, buf1) = Prelude.splitAt n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 goExtract s buf1 src - Parser.Done 0 b -> do + Parser.SDone 1 b -> do let arr = Array contents next end return (Right b, StreamK.fromPure arr) - Parser.Done n b -> do + Parser.SDone m b -> do + let n = 1 - m assert (n <= Prelude.length backBuf) (return ()) let src0 = Prelude.take n (x:backBuf) -- XXX Use fromListRevN once implemented @@ -978,17 +984,19 @@ parseBreakChunksK (Parser pstep initial extract) stream = do goStop !pst backBuf = do pRes <- extract pst case pRes of - Parser.Partial _ _ -> error "Bug: parseBreak: Partial in extract" - Parser.Continue 0 s -> + Parser.SPartial _ _ -> error "Bug: parseBreak: Partial in extract" + Parser.SContinue 1 s -> goStop s backBuf - Parser.Continue n s -> do + Parser.SContinue m s -> do + let n = 1 - m assert (n <= Prelude.length backBuf) (return ()) let (src0, buf1) = Prelude.splitAt n backBuf arr = fromListN n (Prelude.reverse src0) goExtract s buf1 arr - Parser.Done 0 b -> + Parser.SDone 1 b -> return (Right b, StreamK.nil) - Parser.Done n b -> do + Parser.SDone m b -> do + let n = 1 - m assert (n <= Prelude.length backBuf) (return ()) let src0 = Prelude.take n backBuf -- XXX Use fromListRevN once implemented diff --git a/core/src/Streamly/Internal/Data/Producer/Source.hs b/core/src/Streamly/Internal/Data/Producer/Source.hs index 62e7a8bfb2..2858030683 100644 --- a/core/src/Streamly/Internal/Data/Producer/Source.hs +++ b/core/src/Streamly/Internal/Data/Producer/Source.hs @@ -140,19 +140,22 @@ parse Yield x s -> do pRes <- pstep pst x case pRes of - Partial 0 pst1 -> go SPEC s (List []) pst1 - Partial n pst1 -> do + SPartial 1 pst1 -> go SPEC s (List []) pst1 + SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 gobuf SPEC s (List []) (List src) pst1 - Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1 - Continue n pst1 -> do + SContinue 1 pst1 -> go SPEC s (List (x:getList buf)) pst1 + SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 gobuf SPEC s (List buf1) (List src) pst1 - Done n b -> do + SDone m b -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 @@ -172,21 +175,24 @@ parse gobuf !_ s buf (List (x:xs)) !pst = do pRes <- pstep pst x case pRes of - Partial 0 pst1 -> + SPartial 1 pst1 -> gobuf SPEC s (List []) (List xs) pst1 - Partial n pst1 -> do + SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs gobuf SPEC s (List []) (List src) pst1 - Continue 0 pst1 -> + SContinue 1 pst1 -> gobuf SPEC s (List (x:getList buf)) (List xs) pst1 - Continue n pst1 -> do + SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 ++ xs gobuf SPEC s (List buf1) (List src) pst1 - Done n b -> do + SDone m b -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 @@ -205,21 +211,24 @@ parse goExtract !_ buf (List (x:xs)) !pst = do pRes <- pstep pst x case pRes of - Partial 0 pst1 -> + SPartial 1 pst1 -> goExtract SPEC (List []) (List xs) pst1 - Partial n pst1 -> do + SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs goExtract SPEC (List []) (List src) pst1 - Continue 0 pst1 -> + SContinue 1 pst1 -> goExtract SPEC (List (x:getList buf)) (List xs) pst1 - Continue n pst1 -> do + SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 ++ xs goExtract SPEC (List buf1) (List src) pst1 - Done n b -> do + SDone m b -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 @@ -236,16 +245,18 @@ parse goStop buf pst = do pRes <- extract pst case pRes of - Partial _ _ -> error "Bug: parseD: Partial in extract" - Continue 0 pst1 -> + SPartial _ _ -> error "Bug: parseD: Partial in extract" + SContinue 1 pst1 -> goStop buf pst1 - Continue n pst1 -> do + SContinue m pst1 -> do + let n = 1 - m assert (n <= length (getList buf)) (return ()) let (src0, buf1) = splitAt n (getList buf) src = Prelude.reverse src0 goExtract SPEC (List buf1) (List src) pst1 - Done 0 b -> return (Right b, source Nothing) - Done n b -> do + SDone 1 b -> return (Right b, source Nothing) + SDone m b -> do + let n = 1 - m assert (n <= length (getList buf)) (return ()) let src0 = Prelude.take n (getList buf) src = Prelude.reverse src0 diff --git a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs index 08a92758ed..b7a263dba6 100644 --- a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs +++ b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs @@ -192,22 +192,25 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do Yield x s -> do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> go SPEC s (List []) pst1 - PR.Partial 1 pst1 -> go1 SPEC s x pst1 - PR.Partial n pst1 -> do + PR.SPartial 1 pst1 -> go SPEC s (List []) pst1 + PR.SPartial 0 pst1 -> go1 SPEC s x pst1 + PR.SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 gobuf SPEC s (List []) (List src) pst1 - PR.Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1 - PR.Continue 1 pst1 -> gobuf SPEC s buf (List [x]) pst1 - PR.Continue n pst1 -> do + PR.SContinue 1 pst1 -> go SPEC s (List (x:getList buf)) pst1 + PR.SContinue 0 pst1 -> gobuf SPEC s buf (List [x]) pst1 + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 gobuf SPEC s (List buf1) (List src) pst1 - PR.Done 0 b -> return (Right b, Stream step s) - PR.Done n b -> do + PR.SDone 1 b -> return (Right b, Stream step s) + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 @@ -229,24 +232,24 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do go1 _ s x !pst = do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> + PR.SPartial 1 pst1 -> go SPEC s (List []) pst1 - PR.Partial 1 pst1 -> do + PR.SPartial 0 pst1 -> do go1 SPEC s x pst1 - PR.Partial n _ -> - error $ "parseBreak: parser bug, go1: Partial n = " ++ show n - PR.Continue 0 pst1 -> + PR.SPartial m _ -> + error $ "parseBreak: parser bug, go1: SPartial m = " ++ show m + PR.SContinue 1 pst1 -> go SPEC s (List [x]) pst1 - PR.Continue 1 pst1 -> + PR.SContinue 0 pst1 -> go1 SPEC s x pst1 - PR.Continue n _ -> do - error $ "parseBreak: parser bug, go1: Continue n = " ++ show n - PR.Done 0 b -> do + PR.SContinue m _ -> do + error $ "parseBreak: parser bug, go1: SContinue m = " ++ show m + PR.SDone 1 b -> do return (Right b, Stream step s) - PR.Done 1 b -> do + PR.SDone 0 b -> do return (Right b, StreamD.cons x (Stream step s)) - PR.Done n _ -> do - error $ "parseBreak: parser bug, go1: Done n = " ++ show n + PR.SDone m _ -> do + error $ "parseBreak: parser bug, go1: SDone m = " ++ show m PR.Error err -> return ( Left (ParseError err) @@ -257,23 +260,26 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do gobuf !_ s buf (List (x:xs)) !pst = do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> + PR.SPartial 1 pst1 -> gobuf SPEC s (List []) (List xs) pst1 - PR.Partial n pst1 -> do + PR.SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs gobuf SPEC s (List []) (List src) pst1 - PR.Continue 0 pst1 -> + PR.SContinue 1 pst1 -> gobuf SPEC s (List (x:getList buf)) (List xs) pst1 - PR.Continue 1 pst1 -> + PR.SContinue 0 pst1 -> gobuf SPEC s buf (List (x:xs)) pst1 - PR.Continue n pst1 -> do + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 ++ xs gobuf SPEC s (List buf1) (List src) pst1 - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs @@ -290,23 +296,26 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do goExtract !_ buf (List (x:xs)) !pst = do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> + PR.SPartial 1 pst1 -> goExtract SPEC (List []) (List xs) pst1 - PR.Partial n pst1 -> do + PR.SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs goExtract SPEC (List []) (List src) pst1 - PR.Continue 0 pst1 -> + PR.SContinue 1 pst1 -> goExtract SPEC (List (x:getList buf)) (List xs) pst1 - PR.Continue 1 pst1 -> + PR.SContinue 0 pst1 -> goExtract SPEC buf (List (x:xs)) pst1 - PR.Continue n pst1 -> do + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 ++ xs goExtract SPEC (List buf1) (List src) pst1 - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs @@ -321,15 +330,17 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do goStop _ buf pst = do pRes <- extract pst case pRes of - PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract" - PR.Continue 0 pst1 -> goStop SPEC buf pst1 - PR.Continue n pst1 -> do + PR.SPartial _ _ -> error "Bug: parseBreak: Partial in extract" + PR.SContinue 1 pst1 -> goStop SPEC buf pst1 + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (getList buf)) (return ()) let (src0, buf1) = splitAt n (getList buf) src = Prelude.reverse src0 goExtract SPEC (List buf1) (List src) pst1 - PR.Done 0 b -> return (Right b, StreamD.nil) - PR.Done n b -> do + PR.SDone 1 b -> return (Right b, StreamD.nil) + PR.SDone m b -> do + let n = 1 - m assert (n <= length (getList buf)) (return ()) let src0 = Prelude.take n (getList buf) src = Prelude.reverse src0 diff --git a/core/src/Streamly/Internal/Data/Stream/Nesting.hs b/core/src/Streamly/Internal/Data/Stream/Nesting.hs index ce15394233..8d8e863c31 100644 --- a/core/src/Streamly/Internal/Data/Stream/Nesting.hs +++ b/core/src/Streamly/Internal/Data/Stream/Nesting.hs @@ -1659,24 +1659,27 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) = Yield x s -> do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> + PR.SPartial 1 pst1 -> return $ Skip $ ParseChunksStream s [] pst1 - PR.Partial n pst1 -> do + PR.SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 return $ Skip $ ParseChunksBuf src s [] pst1 - PR.Continue 0 pst1 -> + PR.SContinue 1 pst1 -> return $ Skip $ ParseChunksStream s (x:buf) pst1 - PR.Continue n pst1 -> do + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 return $ Skip $ ParseChunksBuf src s buf1 pst1 - PR.Done 0 b -> do + PR.SDone 1 b -> do return $ Skip $ ParseChunksYield (Right b) (ParseChunksInit [] s) - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) return $ Skip $ @@ -1698,25 +1701,28 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) = stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> + PR.SPartial 1 pst1 -> return $ Skip $ ParseChunksBuf xs s [] pst1 - PR.Partial n pst1 -> do + PR.SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs return $ Skip $ ParseChunksBuf src s [] pst1 - PR.Continue 0 pst1 -> + PR.SContinue 1 pst1 -> return $ Skip $ ParseChunksBuf xs s (x:buf) pst1 - PR.Continue n pst1 -> do + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs return $ Skip $ ParseChunksBuf src s buf1 pst1 - PR.Done 0 b -> + PR.SDone 1 b -> return $ Skip $ ParseChunksYield (Right b) (ParseChunksInit xs s) - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return $ Skip @@ -1735,25 +1741,28 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) = stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> + PR.SPartial 1 pst1 -> return $ Skip $ ParseChunksExtract xs [] pst1 - PR.Partial n pst1 -> do + PR.SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs return $ Skip $ ParseChunksExtract src [] pst1 - PR.Continue 0 pst1 -> + PR.SContinue 1 pst1 -> return $ Skip $ ParseChunksExtract xs (x:buf) pst1 - PR.Continue n pst1 -> do + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs return $ Skip $ ParseChunksExtract src buf1 pst1 - PR.Done 0 b -> + PR.SDone 1 b -> return $ Skip $ ParseChunksYield (Right b) (ParseChunksInitBuf xs) - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return @@ -1770,18 +1779,20 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) = stepOuter _ (ParseChunksStop buf pst) = do pRes <- extract pst case pRes of - PR.Partial _ _ -> error "Bug: parseMany: Partial in extract" - PR.Continue 0 pst1 -> + PR.SPartial _ _ -> error "Bug: parseMany: Partial in extract" + PR.SContinue 1 pst1 -> return $ Skip $ ParseChunksStop buf pst1 - PR.Continue n pst1 -> do + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length buf) (return ()) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 return $ Skip $ ParseChunksExtract src buf1 pst1 - PR.Done 0 b -> do + PR.SDone 1 b -> do return $ Skip $ ParseChunksYield (Right b) (ParseChunksInitLeftOver []) - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length buf) (return ()) let src = Prelude.reverse (Prelude.take n buf) return $ Skip $ @@ -1940,22 +1951,25 @@ parseIterate func seed (Stream step state) = Yield x s -> do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> + PR.SPartial 1 pst1 -> return $ Skip $ ConcatParseStream s [] pstep pst1 extract - PR.Partial n pst1 -> do + PR.SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract - -- PR.Continue 0 pst1 -> + -- PR.SContinue 1 pst1 -> -- return $ Skip $ ConcatParseStream s (x:buf) pst1 - PR.Continue n pst1 -> do + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract -- XXX Specialize for Stop 0 common case? - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) return $ Skip $ @@ -1977,21 +1991,24 @@ parseIterate func seed (Stream step state) = stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> + PR.SPartial 1 pst1 -> return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract - PR.Partial n pst1 -> do + PR.SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract - -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1 - PR.Continue n pst1 -> do + -- PR.SContinue 1 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1 + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract -- XXX Specialize for Stop 0 common case? - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return $ Skip $ ConcatParseYield (Right b) @@ -2010,23 +2027,26 @@ parseIterate func seed (Stream step state) = stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do pRes <- pstep pst x case pRes of - PR.Partial 0 pst1 -> + PR.SPartial 1 pst1 -> return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract - PR.Partial n pst1 -> do + PR.SPartial m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs return $ Skip $ ConcatParseExtract src [] pstep pst1 extract - PR.Continue 0 pst1 -> + PR.SContinue 1 pst1 -> return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract - PR.Continue n pst1 -> do + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract - PR.Done 0 b -> + PR.SDone 1 b -> return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b)) - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b)) @@ -2041,18 +2061,20 @@ parseIterate func seed (Stream step state) = stepOuter _ (ConcatParseStop buf pstep pst extract) = do pRes <- extract pst case pRes of - PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract" - PR.Continue 0 pst1 -> + PR.SPartial _ _ -> error "Bug: parseIterate: Partial in extract" + PR.SContinue 1 pst1 -> return $ Skip $ ConcatParseStop buf pstep pst1 extract - PR.Continue n pst1 -> do + PR.SContinue m pst1 -> do + let n = 1 - m assert (n <= length buf) (return ()) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract - PR.Done 0 b -> do + PR.SDone 1 b -> do return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitLeftOver []) - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length buf) (return ()) let src = Prelude.reverse (Prelude.take n buf) return $ Skip $ diff --git a/core/src/Streamly/Internal/Data/StreamK.hs b/core/src/Streamly/Internal/Data/StreamK.hs index 65dab750d6..c77d96f6cb 100644 --- a/core/src/Streamly/Internal/Data/StreamK.hs +++ b/core/src/Streamly/Internal/Data/StreamK.hs @@ -1196,14 +1196,16 @@ parseDBreak (PR.Parser pstep initial extract) stream = do PR.Error err -> do let src = Prelude.reverse buf return (Left (ParseError err), fromList src) - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assertM(n <= length buf) let src0 = Prelude.take n buf src = Prelude.reverse src0 return (Right b, fromList src) - PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract" - PR.Continue 0 s -> goStream nil buf s - PR.Continue n s -> do + PR.SPartial _ _ -> error "Bug: parseBreak: Partial in extract" + PR.SContinue 1 s -> goStream nil buf s + PR.SContinue m s -> do + let n = 1 - m assertM(n <= length buf) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 @@ -1212,20 +1214,23 @@ parseDBreak (PR.Parser pstep initial extract) stream = do yieldk x r = do res <- pstep pst x case res of - PR.Partial 0 s -> goStream r [] s - PR.Partial n s -> do + PR.SPartial 1 s -> goStream r [] s + PR.SPartial m s -> do + let n = 1 - m assertM(n <= length (x:buf)) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 goBuf r [] src s - PR.Continue 0 s -> goStream r (x:buf) s - PR.Continue n s -> do + PR.SContinue 1 s -> goStream r (x:buf) s + PR.SContinue m s -> do + let n = 1 - m assertM(n <= length (x:buf)) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 goBuf r buf1 src s - PR.Done 0 b -> return (Right b, r) - PR.Done n b -> do + PR.SDone 1 b -> return (Right b, r) + PR.SDone m b -> do + let n = 1 - m assertM(n <= length (x:buf)) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 @@ -1239,19 +1244,22 @@ parseDBreak (PR.Parser pstep initial extract) stream = do goBuf st buf (x:xs) !pst = do pRes <- pstep pst x case pRes of - PR.Partial 0 s -> goBuf st [] xs s - PR.Partial n s -> do + PR.SPartial 1 s -> goBuf st [] xs s + PR.SPartial m s -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs goBuf st [] src s - PR.Continue 0 s -> goBuf st (x:buf) xs s - PR.Continue n s -> do + PR.SContinue 1 s -> goBuf st (x:buf) xs s + PR.SContinue m s -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs goBuf st buf1 src s - PR.Done n b -> do + PR.SDone m b -> do + let n = 1 - m assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs From b52101a9a107a8458ddd2b046d158bf4f66a29a3 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Mon, 29 Jul 2024 21:43:23 +0530 Subject: [PATCH 03/20] Update the parser implementors --- .../Streamly/Internal/Data/Binary/Parser.hs | 24 ++-- .../Streamly/Internal/Data/MutArray/Type.hs | 12 +- core/src/Streamly/Internal/Unicode/Parser.hs | 116 +++++++++--------- core/src/Streamly/Internal/Unicode/Stream.hs | 18 +-- 4 files changed, 85 insertions(+), 85 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Binary/Parser.hs b/core/src/Streamly/Internal/Data/Binary/Parser.hs index efc8b57d06..234489e8d4 100644 --- a/core/src/Streamly/Internal/Data/Binary/Parser.hs +++ b/core/src/Streamly/Internal/Data/Binary/Parser.hs @@ -149,9 +149,9 @@ word16beD = PRD.Parser step initial extract step Nothing' a = -- XXX We can use a non-failing parser or a fold so that we do not -- have to buffer for backtracking which is inefficient. - return $ PRD.Continue 0 (Just' (fromIntegral a `unsafeShiftL` 8)) + return $ PRD.SContinue 1 (Just' (fromIntegral a `unsafeShiftL` 8)) step (Just' w) a = - return $ PRD.Done 0 (w .|. fromIntegral a) + return $ PRD.SDone 1 (w .|. fromIntegral a) extract _ = return $ PRD.Error "word16be: end of input" @@ -174,9 +174,9 @@ word16leD = PRD.Parser step initial extract initial = return $ PRD.IPartial Nothing' step Nothing' a = - return $ PRD.Continue 0 (Just' (fromIntegral a)) + return $ PRD.SContinue 1 (Just' (fromIntegral a)) step (Just' w) a = - return $ PRD.Done 0 (w .|. fromIntegral a `unsafeShiftL` 8) + return $ PRD.SDone 1 (w .|. fromIntegral a `unsafeShiftL` 8) extract _ = return $ PRD.Error "word16le: end of input" @@ -202,8 +202,8 @@ word32beD = PRD.Parser step initial extract if sh /= 0 then let w1 = w .|. (fromIntegral a `unsafeShiftL` sh) - in PRD.Continue 0 (Tuple' w1 (sh - 8)) - else PRD.Done 0 (w .|. fromIntegral a) + in PRD.SContinue 1 (Tuple' w1 (sh - 8)) + else PRD.SDone 1 (w .|. fromIntegral a) extract _ = return $ PRD.Error "word32beD: end of input" @@ -228,8 +228,8 @@ word32leD = PRD.Parser step initial extract step (Tuple' w sh) a = return $ let w1 = w .|. (fromIntegral a `unsafeShiftL` sh) in if sh /= 24 - then PRD.Continue 0 (Tuple' w1 (sh + 8)) - else PRD.Done 0 w1 + then PRD.SContinue 1 (Tuple' w1 (sh + 8)) + else PRD.SDone 1 w1 extract _ = return $ PRD.Error "word32leD: end of input" @@ -255,8 +255,8 @@ word64beD = PRD.Parser step initial extract if sh /= 0 then let w1 = w .|. (fromIntegral a `unsafeShiftL` sh) - in PRD.Continue 0 (Tuple' w1 (sh - 8)) - else PRD.Done 0 (w .|. fromIntegral a) + in PRD.SContinue 1 (Tuple' w1 (sh - 8)) + else PRD.SDone 1 (w .|. fromIntegral a) extract _ = return $ PRD.Error "word64beD: end of input" @@ -281,8 +281,8 @@ word64leD = PRD.Parser step initial extract step (Tuple' w sh) a = return $ let w1 = w .|. (fromIntegral a `unsafeShiftL` sh) in if sh /= 56 - then PRD.Continue 0 (Tuple' w1 (sh + 8)) - else PRD.Done 0 w1 + then PRD.SContinue 1 (Tuple' w1 (sh + 8)) + else PRD.SDone 1 w1 extract _ = return $ PRD.Error "word64leD: end of input" diff --git a/core/src/Streamly/Internal/Data/MutArray/Type.hs b/core/src/Streamly/Internal/Data/MutArray/Type.hs index e5daf17bcc..37d5b27fc1 100644 --- a/core/src/Streamly/Internal/Data/MutArray/Type.hs +++ b/core/src/Streamly/Internal/Data/MutArray/Type.hs @@ -3722,13 +3722,13 @@ pCompactLeAs ps maxElems = Parser step initial extract return $ let len = byteLength arr in if len >= maxBytes - then Parser.Done 0 arr - else Parser.Partial 0 (Just arr) + then Parser.SDone 1 arr + else Parser.SPartial 1 (Just arr) -- XXX Split the last array to use the space more compactly. step (Just buf) arr = let len = byteLength buf + byteLength arr in if len > maxBytes - then return $ Parser.Done 1 buf + then return $ Parser.SDone 0 buf else do buf1 <- if byteCapacity buf < maxBytes @@ -3736,10 +3736,10 @@ pCompactLeAs ps maxElems = Parser step initial extract ps (SIZE_OF(a)) maxBytes buf else return buf buf2 <- unsafeSplice buf1 arr - return $ Parser.Partial 0 (Just buf2) + return $ Parser.SPartial 1 (Just buf2) - extract Nothing = return $ Parser.Done 0 nil - extract (Just buf) = return $ Parser.Done 0 buf + extract Nothing = return $ Parser.SDone 1 nil + extract (Just buf) = return $ Parser.SDone 1 buf -- | Parser @createCompactMax maxElems@ coalesces adjacent arrays in the -- input stream only if the combined size would be less than or equal to diff --git a/core/src/Streamly/Internal/Unicode/Parser.hs b/core/src/Streamly/Internal/Unicode/Parser.hs index 1e85c7d4ed..6146689ee5 100644 --- a/core/src/Streamly/Internal/Unicode/Parser.hs +++ b/core/src/Streamly/Internal/Unicode/Parser.hs @@ -339,87 +339,87 @@ number = Parser (\s a -> return $ step s a) initial (return . extract) {-# INLINE step #-} step SPInitial val = case val of - '+' -> Continue 0 (SPSign 1) - '-' -> Continue 0 (SPSign (-1)) + '+' -> SContinue 1 (SPSign 1) + '-' -> SContinue 1 (SPSign (-1)) _ -> do let num = ord val - 48 if num >= 0 && num <= 9 - then Partial 0 $ SPAfterSign 1 (intToInteger num) + then SPartial 1 $ SPAfterSign 1 (intToInteger num) else Error $ exitSPInitial $ show val step (SPSign multiplier) val = let num = ord val - 48 in if num >= 0 && num <= 9 - then Partial 0 $ SPAfterSign multiplier (intToInteger num) + then SPartial 1 $ SPAfterSign multiplier (intToInteger num) else Error $ exitSPSign $ show val step (SPAfterSign multiplier buf) val = case val of - '.' -> Continue 0 $ SPDot multiplier buf - 'e' -> Continue 0 $ SPExponent multiplier buf 0 - 'E' -> Continue 0 $ SPExponent multiplier buf 0 + '.' -> SContinue 1 $ SPDot multiplier buf + 'e' -> SContinue 1 $ SPExponent multiplier buf 0 + 'E' -> SContinue 1 $ SPExponent multiplier buf 0 _ -> let num = ord val - 48 in if num >= 0 && num <= 9 then - Partial 0 + SPartial 1 $ SPAfterSign multiplier (combineNum buf (intToInteger num)) - else Done 1 $ exitSPAfterSign multiplier buf + else SDone 0 $ exitSPAfterSign multiplier buf step (SPDot multiplier buf) val = let num = ord val - 48 in if num >= 0 && num <= 9 - then Partial 0 $ SPAfterDot multiplier (combineNum buf (intToInteger num)) 1 - else Done 2 $ exitSPAfterSign multiplier buf + then SPartial 1 $ SPAfterDot multiplier (combineNum buf (intToInteger num)) 1 + else SDone (-1) $ exitSPAfterSign multiplier buf step (SPAfterDot multiplier buf decimalPlaces) val = case val of - 'e' -> Continue 0 $ SPExponent multiplier buf decimalPlaces - 'E' -> Continue 0 $ SPExponent multiplier buf decimalPlaces + 'e' -> SContinue 1 $ SPExponent multiplier buf decimalPlaces + 'E' -> SContinue 1 $ SPExponent multiplier buf decimalPlaces _ -> let num = ord val - 48 in if num >= 0 && num <= 9 then - Partial 0 + SPartial 1 $ SPAfterDot multiplier (combineNum buf (intToInteger num)) (decimalPlaces + 1) - else Done 1 $ exitSPAfterDot multiplier buf decimalPlaces + else SDone 0 $ exitSPAfterDot multiplier buf decimalPlaces step (SPExponent multiplier buf decimalPlaces) val = case val of - '+' -> Continue 0 (SPExponentWithSign multiplier buf decimalPlaces 1) - '-' -> Continue 0 (SPExponentWithSign multiplier buf decimalPlaces (-1)) + '+' -> SContinue 1 (SPExponentWithSign multiplier buf decimalPlaces 1) + '-' -> SContinue 1 (SPExponentWithSign multiplier buf decimalPlaces (-1)) _ -> do let num = ord val - 48 if num >= 0 && num <= 9 - then Partial 0 $ SPAfterExponent multiplier buf decimalPlaces 1 num - else Done 2 $ exitSPAfterDot multiplier buf decimalPlaces + then SPartial 1 $ SPAfterExponent multiplier buf decimalPlaces 1 num + else SDone (-1) $ exitSPAfterDot multiplier buf decimalPlaces step (SPExponentWithSign mult buf decimalPlaces powerMult) val = let num = ord val - 48 in if num >= 0 && num <= 9 - then Partial 0 $ SPAfterExponent mult buf decimalPlaces powerMult num - else Done 3 $ exitSPAfterDot mult buf decimalPlaces + then SPartial 1 $ SPAfterExponent mult buf decimalPlaces powerMult num + else SDone (-2) $ exitSPAfterDot mult buf decimalPlaces step (SPAfterExponent mult num decimalPlaces powerMult buf) val = let n = ord val - 48 in if n >= 0 && n <= 9 then - Partial 0 + SPartial 1 $ SPAfterExponent mult num decimalPlaces powerMult (combineNum buf n) else - Done 1 + SDone 0 $ exitSPAfterExponent mult num decimalPlaces powerMult buf {-# INLINE extract #-} extract SPInitial = Error $ exitSPInitial "end of input" extract (SPSign _) = Error $ exitSPSign "end of input" - extract (SPAfterSign mult num) = Done 0 $ exitSPAfterSign mult num - extract (SPDot mult num) = Done 1 $ exitSPAfterSign mult num + extract (SPAfterSign mult num) = SDone 1 $ exitSPAfterSign mult num + extract (SPDot mult num) = SDone 0 $ exitSPAfterSign mult num extract (SPAfterDot mult num decimalPlaces) = - Done 0 $ exitSPAfterDot mult num decimalPlaces + SDone 1 $ exitSPAfterDot mult num decimalPlaces extract (SPExponent mult num decimalPlaces) = - Done 1 $ exitSPAfterDot mult num decimalPlaces + SDone 0 $ exitSPAfterDot mult num decimalPlaces extract (SPExponentWithSign mult num decimalPlaces _) = - Done 2 $ exitSPAfterDot mult num decimalPlaces + SDone (-1) $ exitSPAfterDot mult num decimalPlaces extract (SPAfterExponent mult num decimalPlaces powerMult powerNum) = - Done 0 $ exitSPAfterExponent mult num decimalPlaces powerMult powerNum + SDone 1 $ exitSPAfterExponent mult num decimalPlaces powerMult powerNum type MantissaInt = Int type OverflowPower = Int @@ -480,84 +480,84 @@ doubleParser = Parser (\s a -> return $ step s a) initial (return . extract) {-# INLINE step #-} step DPInitial val = case val of - '+' -> Continue 0 (DPSign 1) - '-' -> Continue 0 (DPSign (-1)) + '+' -> SContinue 1 (DPSign 1) + '-' -> SContinue 1 (DPSign (-1)) _ -> do let num = ord val - 48 if num >= 0 && num <= 9 - then Partial 0 $ DPAfterSign 1 num 0 + then SPartial 1 $ DPAfterSign 1 num 0 else Error $ exitDPInitial $ show val step (DPSign multiplier) val = let num = ord val - 48 in if num >= 0 && num <= 9 - then Partial 0 $ DPAfterSign multiplier num 0 + then SPartial 1 $ DPAfterSign multiplier num 0 else Error $ exitDPSign $ show val step (DPAfterSign multiplier buf opower) val = case val of - '.' -> Continue 0 $ DPDot multiplier buf opower - 'e' -> Continue 0 $ DPExponent multiplier buf opower - 'E' -> Continue 0 $ DPExponent multiplier buf opower + '.' -> SContinue 1 $ DPDot multiplier buf opower + 'e' -> SContinue 1 $ DPExponent multiplier buf opower + 'E' -> SContinue 1 $ DPExponent multiplier buf opower _ -> let num = ord val - 48 in if num >= 0 && num <= 9 then let (buf1, power1) = combineNum buf opower num - in Partial 0 + in SPartial 1 $ DPAfterSign multiplier buf1 power1 - else Done 1 $ exitDPAfterSign multiplier buf opower + else SDone 0 $ exitDPAfterSign multiplier buf opower step (DPDot multiplier buf opower) val = let num = ord val - 48 in if num >= 0 && num <= 9 then let (buf1, power1) = combineNum buf opower num - in Partial 0 $ DPAfterDot multiplier buf1 (power1 - 1) - else Done 2 $ exitDPAfterSign multiplier buf opower + in SPartial 1 $ DPAfterDot multiplier buf1 (power1 - 1) + else SDone (-1) $ exitDPAfterSign multiplier buf opower step (DPAfterDot multiplier buf opower) val = case val of - 'e' -> Continue 0 $ DPExponent multiplier buf opower - 'E' -> Continue 0 $ DPExponent multiplier buf opower + 'e' -> SContinue 1 $ DPExponent multiplier buf opower + 'E' -> SContinue 1 $ DPExponent multiplier buf opower _ -> let num = ord val - 48 in if num >= 0 && num <= 9 then let (buf1, power1) = combineNum buf opower num - in Partial 0 $ DPAfterDot multiplier buf1 (power1 - 1) - else Done 1 $ exitDPAfterDot multiplier buf opower + in SPartial 1 $ DPAfterDot multiplier buf1 (power1 - 1) + else SDone 0 $ exitDPAfterDot multiplier buf opower step (DPExponent multiplier buf opower) val = case val of - '+' -> Continue 0 (DPExponentWithSign multiplier buf opower 1) - '-' -> Continue 0 (DPExponentWithSign multiplier buf opower (-1)) + '+' -> SContinue 1 (DPExponentWithSign multiplier buf opower 1) + '-' -> SContinue 1 (DPExponentWithSign multiplier buf opower (-1)) _ -> do let num = ord val - 48 if num >= 0 && num <= 9 - then Partial 0 $ DPAfterExponent multiplier buf opower 1 num - else Done 2 $ exitDPAfterDot multiplier buf opower + then SPartial 1 $ DPAfterExponent multiplier buf opower 1 num + else SDone (-1) $ exitDPAfterDot multiplier buf opower step (DPExponentWithSign mult buf opower powerMult) val = let num = ord val - 48 in if num >= 0 && num <= 9 - then Partial 0 $ DPAfterExponent mult buf opower powerMult num - else Done 3 $ exitDPAfterDot mult buf opower + then SPartial 1 $ DPAfterExponent mult buf opower powerMult num + else SDone (-2) $ exitDPAfterDot mult buf opower step (DPAfterExponent mult num opower powerMult buf) val = let n = ord val - 48 in if n >= 0 && n <= 9 then - Partial 0 + SPartial 1 $ DPAfterExponent mult num opower powerMult (buf * 10 + n) - else Done 1 $ exitDPAfterExponent mult num opower powerMult buf + else SDone 0 $ exitDPAfterExponent mult num opower powerMult buf {-# INLINE extract #-} extract DPInitial = Error $ exitDPInitial "end of input" extract (DPSign _) = Error $ exitDPSign "end of input" - extract (DPAfterSign mult num opow) = Done 0 $ exitDPAfterSign mult num opow - extract (DPDot mult num opow) = Done 1 $ exitDPAfterSign mult num opow + extract (DPAfterSign mult num opow) = SDone 1 $ exitDPAfterSign mult num opow + extract (DPDot mult num opow) = SDone 0 $ exitDPAfterSign mult num opow extract (DPAfterDot mult num opow) = - Done 0 $ exitDPAfterDot mult num opow + SDone 1 $ exitDPAfterDot mult num opow extract (DPExponent mult num opow) = - Done 1 $ exitDPAfterDot mult num opow + SDone 0 $ exitDPAfterDot mult num opow extract (DPExponentWithSign mult num opow _) = - Done 2 $ exitDPAfterDot mult num opow + SDone (-1) $ exitDPAfterDot mult num opow extract (DPAfterExponent mult num opow powerMult powerNum) = - Done 0 $ exitDPAfterExponent mult num opow powerMult powerNum + SDone 1 $ exitDPAfterExponent mult num opow powerMult powerNum -- XXX We can have a `realFloat` parser instead to parse any RealFloat value. -- And a integral parser to read any integral value. diff --git a/core/src/Streamly/Internal/Unicode/Stream.hs b/core/src/Streamly/Internal/Unicode/Stream.hs index f91ebc091c..657c582029 100644 --- a/core/src/Streamly/Internal/Unicode/Stream.hs +++ b/core/src/Streamly/Internal/Unicode/Stream.hs @@ -496,12 +496,12 @@ parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract ErrorOnCodingFailure -> ParserD.Error err TransliterateCodingFailure -> case souldBackTrack of - True -> ParserD.Done 1 replacementChar - False -> ParserD.Done 0 replacementChar + True -> ParserD.SDone 0 replacementChar + False -> ParserD.SDone 1 replacementChar DropOnCodingFailure -> case souldBackTrack of - True -> ParserD.Continue 1 UTF8CharDecodeInit - False -> ParserD.Continue 0 UTF8CharDecodeInit + True -> ParserD.SContinue 0 UTF8CharDecodeInit + False -> ParserD.SContinue 1 UTF8CharDecodeInit {-# INLINE step' #-} step' table UTF8CharDecodeInit x = @@ -511,7 +511,7 @@ parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract -- change with the compiler versions, we need a more reliable -- "likely" primitive to control branch predication. return $ case x > 0x7f of - False -> ParserD.Done 0 $ unsafeChr $ fromIntegral x + False -> ParserD.SDone 1 $ unsafeChr $ fromIntegral x True -> let (Tuple' sv cp) = decode0 table x in case sv of @@ -520,12 +520,12 @@ parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract ++ "Invalid first UTF8 byte" ++ show x in handleError msg False 0 -> error $ prefix ++ "unreachable state" - _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp) + _ -> ParserD.SContinue 1 (UTF8CharDecoding sv cp) step' table (UTF8CharDecoding statePtr codepointPtr) x = return $ let (Tuple' sv cp) = decode1 table statePtr codepointPtr x in case sv of - 0 -> ParserD.Done 0 $ unsafeChr cp + 0 -> ParserD.SDone 1 $ unsafeChr cp 12 -> let msg = prefix ++ "Invalid subsequent UTF8 byte" @@ -535,7 +535,7 @@ parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract ++ "accumulated value" ++ show codepointPtr in handleError msg True - _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp) + _ -> ParserD.SContinue 1 (UTF8CharDecoding sv cp) {-# INLINE extract #-} extract UTF8CharDecodeInit = error $ prefix ++ "Not enough input" @@ -544,7 +544,7 @@ parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract ErrorOnCodingFailure -> return $ ParserD.Error $ prefix ++ "Not enough input" TransliterateCodingFailure -> - return (ParserD.Done 0 replacementChar) + return (ParserD.SDone 1 replacementChar) -- XXX We shouldn't error out here. There is no way to represent an -- empty parser result unless we return a "Maybe" type. DropOnCodingFailure -> error $ prefix ++ "Not enough input" From 8cd976685603a255e60453151ec6011a086871cb Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Mon, 29 Jul 2024 21:43:51 +0530 Subject: [PATCH 04/20] Update the parser combinators --- core/src/Streamly/Internal/Data/Parser.hs | 694 +++++++++--------- .../src/Streamly/Internal/Data/Parser/Type.hs | 342 ++++----- 2 files changed, 518 insertions(+), 518 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Parser.hs b/core/src/Streamly/Internal/Data/Parser.hs index c986e8846c..65d93a8365 100644 --- a/core/src/Streamly/Internal/Data/Parser.hs +++ b/core/src/Streamly/Internal/Data/Parser.hs @@ -299,20 +299,20 @@ toFold (Parser pstep pinitial pextract) = Fold step initial extract final IError err -> error $ "toFold: parser throws error in initial" ++ err - perror n = error $ "toFold: parser backtracks in Partial: " ++ show n - cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n - derror n = error $ "toFold: parser backtracks in Done: " ++ show n + perror n = error $ "toFold: parser backtracks in SPartial: " ++ show n + cerror n = error $ "toFold: parser backtracks in SContinue: " ++ show n + derror n = error $ "toFold: parser backtracks in SDone: " ++ show n eerror err = error $ "toFold: parser throws error: " ++ err step st a = do r <- pstep st a case r of - Partial 0 s -> return $ FL.Partial s - Continue 0 s -> return $ FL.Partial s - Done 0 b -> return $ FL.Done b - Partial n _ -> perror n - Continue n _ -> cerror n - Done n _ -> derror n + SPartial 1 s -> return $ FL.Partial s + SContinue 1 s -> return $ FL.Partial s + SDone 1 b -> return $ FL.Done b + SPartial n _ -> perror n + SContinue n _ -> cerror n + SDone n _ -> derror n Error err -> eerror err extract = error "toFold: parser cannot be used for scanning" @@ -320,10 +320,10 @@ toFold (Parser pstep pinitial pextract) = Fold step initial extract final final st = do r <- pextract st case r of - Done 0 b -> return b - Partial n _ -> perror n - Continue n _ -> cerror n - Done n _ -> derror n + SDone 1 b -> return b + SPartial n _ -> perror n + SContinue n _ -> cerror n + SDone n _ -> derror n Error err -> eerror err ------------------------------------------------------------------------------- @@ -350,10 +350,10 @@ fromFold (Fold fstep finitial _ ffinal) = Parser step initial extract res <- fstep s a return $ case res of - FL.Partial s1 -> Partial 0 s1 - FL.Done b -> Done 0 b + FL.Partial s1 -> SPartial 1 s1 + FL.Done b -> SDone 1 b - extract = fmap (Done 0) . ffinal + extract = fmap (SDone 1) . ffinal -- | Convert a Maybe returning fold to an error returning parser. The first -- argument is the error message that the parser would return when the fold @@ -382,16 +382,16 @@ fromFoldMaybe errMsg (Fold fstep finitial _ ffinal) = res <- fstep s a return $ case res of - FL.Partial s1 -> Partial 0 s1 + FL.Partial s1 -> SPartial 1 s1 FL.Done b -> case b of - Just x -> Done 0 x + Just x -> SDone 1 x Nothing -> Error errMsg extract s = do res <- ffinal s case res of - Just x -> return $ Done 0 x + Just x -> return $ SDone 1 x Nothing -> return $ Error errMsg ------------------------------------------------------------------------------- @@ -416,7 +416,7 @@ peek = Parser step initial extract initial = return $ IPartial () - step () a = return $ Done 1 a + step () a = return $ SDone 0 a extract () = return $ Error "peek: end of input" @@ -435,7 +435,7 @@ eof = Parser step initial extract step () _ = return $ Error "eof: not at end of input" - extract () = return $ Done 0 () + extract () = return $ SDone 1 () -- | Return the next element of the input. Returns 'Nothing' -- on end of input. Also known as 'head'. @@ -451,9 +451,9 @@ next = Parser step initial extract initial = pure $ IPartial () - step () a = pure $ Done 0 (Just a) + step () a = pure $ SDone 1 (Just a) - extract () = pure $ Done 0 Nothing + extract () = pure $ SDone 1 Nothing -- | Map an 'Either' returning function on the next element in the stream. If -- the function returns 'Left err', the parser fails with the error message @@ -471,7 +471,7 @@ either f = Parser step initial extract step () a = return $ case f a of - Right b -> Done 0 b + Right b -> SDone 1 b Left err -> Error err extract () = return $ Error "end of input" @@ -498,7 +498,7 @@ maybe parserF = Parser step initial extract step () a = return $ case parserF a of - Just b -> Done 0 b + Just b -> SDone 1 b Nothing -> Error "maybe: predicate failed" extract () = return $ Error "maybe: end of input" @@ -522,7 +522,7 @@ satisfy predicate = Parser step initial extract step () a = return $ if predicate a - then Done 0 a + then SDone 1 a else Error "satisfy: predicate failed" extract () = return $ Error "satisfy: end of input" @@ -694,20 +694,20 @@ takeBetween low high (Fold fstep finitial _ ffinal) = FL.Partial s -> do let s1 = Tuple'Fused i1 s if i1 < low - then return $ Continue 0 s1 + then return $ SContinue 1 s1 else if i1 < high - then return $ Partial 0 s1 - else fmap (Done 0) (ffinal s) + then return $ SPartial 1 s1 + else fmap (SDone 1) (ffinal s) FL.Done b -> return $ if i1 >= low - then Done 0 b + then SDone 1 b else Error (foldErr i1) step (Tuple'Fused i s) a = fstep s a >>= snext i extract f (Tuple'Fused i s) - | i >= low && i <= high = fmap (Done 0) (ffinal s) + | i >= low && i <= high = fmap (SDone 1) (ffinal s) | otherwise = return $ Error (f i) -- XXX Need to make Initial return type Step to deduplicate this @@ -754,14 +754,14 @@ takeEQ n (Fold fstep finitial _ ffinal) = Parser step initial extract then return $ case res of - FL.Partial s -> Continue 0 $ Tuple'Fused (i1 + 1) s + FL.Partial s -> SContinue 1 $ Tuple'Fused (i1 + 1) s FL.Done _ -> Error $ "takeEQ: Expecting exactly " ++ show n ++ " elements, fold terminated on " ++ show i1 else -- assert (n == i1) - Done 0 + SDone 1 <$> case res of FL.Partial s -> ffinal s FL.Done b -> return b @@ -820,7 +820,7 @@ takeGE n (Fold fstep finitial _ ffinal) = Parser step initial extract then return $ case res of - FL.Partial s -> Continue 0 $ TakeGELT (i1 + 1) s + FL.Partial s -> SContinue 1 $ TakeGELT (i1 + 1) s FL.Done _ -> Error $ "takeGE: Expecting at least " ++ show n @@ -829,21 +829,21 @@ takeGE n (Fold fstep finitial _ ffinal) = Parser step initial extract -- assert (n <= i1) return $ case res of - FL.Partial s -> Partial 0 $ TakeGEGE s - FL.Done b -> Done 0 b + FL.Partial s -> SPartial 1 $ TakeGEGE s + FL.Done b -> SDone 1 b step (TakeGEGE r) a = do res <- fstep r a return $ case res of - FL.Partial s -> Partial 0 $ TakeGEGE s - FL.Done b -> Done 0 b + FL.Partial s -> SPartial 1 $ TakeGEGE s + FL.Done b -> SDone 1 b extract (TakeGELT i _) = return $ Error $ "takeGE: Expecting at least " ++ show n ++ " elements, input terminated on " ++ show (i - 1) - extract (TakeGEGE r) = fmap (Done 0) $ ffinal r + extract (TakeGEGE r) = fmap (SDone 1) $ ffinal r ------------------------------------------------------------------------------- -- Conditional splitting @@ -880,9 +880,9 @@ takeWhileP predicate (Parser pstep pinitial pextract) = -- XXX need a map on count case r of Error err -> return $ Error err - Done n s1 -> return $ Done (n + 1) s1 - Partial _ _ -> error "Bug: takeWhileP: Partial in extract" - Continue n s1 -> return $ Continue (n + 1) s1 + SDone n s1 -> return $ SDone (n - 1) s1 + SPartial _ _ -> error "Bug: takeWhileP: SPartial in extract" + SContinue n s1 -> return $ SContinue (n - 1) s1 -- | Collect stream elements until an element fails the predicate. The element -- on which the predicate fails is returned back to the input stream. @@ -921,11 +921,11 @@ takeWhile predicate (Fold fstep finitial _ ffinal) = fres <- fstep s a return $ case fres of - FL.Partial s1 -> Partial 0 s1 - FL.Done b -> Done 0 b - else Done 1 <$> ffinal s + FL.Partial s1 -> SPartial 1 s1 + FL.Done b -> SDone 1 b + else SDone 0 <$> ffinal s - extract s = fmap (Done 0) (ffinal s) + extract s = fmap (SDone 1) (ffinal s) {- -- XXX This may not be composable because of the b argument. We can instead @@ -964,8 +964,8 @@ takeWhile1 predicate (Fold fstep finitial _ ffinal) = res <- fstep s a return $ case res of - FL.Partial s1 -> Partial 0 (Right' s1) - FL.Done b -> Done 0 b + FL.Partial s1 -> SPartial 1 (Right' s1) + FL.Done b -> SDone 1 b step (Left' s) a = if predicate a @@ -976,10 +976,10 @@ takeWhile1 predicate (Fold fstep finitial _ ffinal) = then process s a else do b <- ffinal s - return $ Done 1 b + return $ SDone 0 b extract (Left' _) = return $ Error "takeWhile1: end of input" - extract (Right' s) = fmap (Done 0) (ffinal s) + extract (Right' s) = fmap (SDone 1) (ffinal s) -- | Drain the input as long as the predicate succeeds, running the effects and -- discarding the results. @@ -1027,8 +1027,8 @@ takeFramedByGeneric esc begin end (Fold fstep finitial _ ffinal) = res <- fstep s a return $ case res of - FL.Partial s1 -> Continue 0 (FrameEscGo s1 n) - FL.Done b -> Done 0 b + FL.Partial s1 -> SContinue 1 (FrameEscGo s1 n) + FL.Done b -> SDone 1 b {-# INLINE processNoEsc #-} processNoEsc s a n = @@ -1040,20 +1040,20 @@ takeFramedByGeneric esc begin end (Fold fstep finitial _ ffinal) = if isEnd a then if n == 0 - then Done 0 <$> ffinal s + then SDone 1 <$> ffinal s else process s a (n - 1) else let n1 = if isBegin a then n + 1 else n in process s a n1 Nothing -> -- takeEndBy case if isEnd a - then Done 0 <$> ffinal s + then SDone 1 <$> ffinal s else process s a n Nothing -> -- takeBeginBy case case begin of Just isBegin -> if isBegin a - then Done 0 <$> ffinal s + then SDone 1 <$> ffinal s else process s a n Nothing -> error $ "takeFramedByGeneric: " @@ -1064,7 +1064,7 @@ takeFramedByGeneric esc begin end (Fold fstep finitial _ ffinal) = case esc of Just isEsc -> if isEsc a - then return $ Partial 0 $ FrameEscEsc s n + then return $ SPartial 1 $ FrameEscEsc s n else processNoEsc s a n Nothing -> processNoEsc s a n @@ -1072,13 +1072,13 @@ takeFramedByGeneric esc begin end (Fold fstep finitial _ ffinal) = case begin of Just isBegin -> if isBegin a - then return $ Partial 0 (FrameEscGo s 0) + then return $ SPartial 1 (FrameEscGo s 0) else return $ Error "takeFramedByGeneric: missing frame start" Nothing -> case end of Just isEnd -> if isEnd a - then Done 0 <$> ffinal s + then SDone 1 <$> ffinal s else processCheckEsc s a 0 Nothing -> error "Both begin and end frame predicate missing" @@ -1093,7 +1093,7 @@ takeFramedByGeneric esc begin end (Fold fstep finitial _ ffinal) = case begin of Just _ -> case end of - Nothing -> fmap (Done 0) $ ffinal s + Nothing -> fmap (SDone 1) $ ffinal s Just _ -> err "takeFramedByGeneric: missing frame end" Nothing -> err "takeFramedByGeneric: missing closing frame" extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape" @@ -1150,19 +1150,19 @@ blockWithQuotes isEsc isQuote bopen bclose res <- fstep s a return $ case res of - FL.Partial s1 -> Continue 0 (nextState s1) - FL.Done b -> Done 0 b + FL.Partial s1 -> SContinue 1 (nextState s1) + FL.Done b -> SDone 1 b step (BlockInit s) a = return $ if a == bopen - then Continue 0 $ BlockUnquoted 1 s + then SContinue 1 $ BlockUnquoted 1 s else Error "blockWithQuotes: missing block start" step (BlockUnquoted level s) a | a == bopen = process s a (BlockUnquoted (level + 1)) | a == bclose = if level == 1 - then fmap (Done 0) (ffinal s) + then fmap (SDone 1) (ffinal s) else process s a (BlockUnquoted (level - 1)) | isQuote a = process s a (BlockQuoted level) | otherwise = process s a (BlockUnquoted level) @@ -1176,7 +1176,7 @@ blockWithQuotes isEsc isQuote bopen bclose err = return . Error - extract (BlockInit s) = fmap (Done 0) $ ffinal s + extract (BlockInit s) = fmap (SDone 1) $ ffinal s extract (BlockUnquoted level _) = err $ "blockWithQuotes: finished at block nest level " ++ show level extract (BlockQuoted level _) = @@ -1238,7 +1238,7 @@ takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) = step (Left' s) a = do if isEsc a - then return $ Partial 0 $ Right' s + then return $ SPartial 1 $ Right' s else do res <- pstep s a if not (isSep a) @@ -1330,8 +1330,8 @@ takeBeginBy cond (Fold fstep finitial _ ffinal) = res <- fstep s a return $ case res of - FL.Partial s1 -> Partial 0 (Right' s1) - FL.Done b -> Done 0 b + FL.Partial s1 -> SPartial 1 (Right' s1) + FL.Done b -> SDone 1 b step (Left' s) a = if cond a @@ -1340,10 +1340,10 @@ takeBeginBy cond (Fold fstep finitial _ ffinal) = step (Right' s) a = if not (cond a) then process s a - else Done 1 <$> ffinal s + else SDone 0 <$> ffinal s - extract (Left' s) = fmap (Done 0) $ ffinal s - extract (Right' s) = fmap (Done 0) $ ffinal s + extract (Left' s) = fmap (SDone 1) $ ffinal s + extract (Right' s) = fmap (SDone 1) $ ffinal s RENAME(takeStartBy,takeBeginBy) @@ -1403,16 +1403,16 @@ takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial _ ffinal ) = res <- fstep s a return $ case res of - FL.Partial s1 -> Continue 0 (FrameEscGo s1 n) - FL.Done b -> Done 0 b + FL.Partial s1 -> SContinue 1 (FrameEscGo s1 n) + FL.Done b -> SDone 1 b step (FrameEscInit s) a = if isBegin a - then return $ Partial 0 (FrameEscGo s 0) + then return $ SPartial 1 (FrameEscGo s 0) else return $ Error "takeFramedByEsc_: missing frame start" step (FrameEscGo s n) a = if isEsc a - then return $ Partial 0 $ FrameEscEsc s n + then return $ SPartial 1 $ FrameEscEsc s n else do if not (isEnd a) then @@ -1420,7 +1420,7 @@ takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial _ ffinal ) = in process s a n1 else if n == 0 - then Done 0 <$> ffinal s + then SDone 1 <$> ffinal s else process s a (n - 1) step (FrameEscEsc s n) a = process s a n @@ -1461,18 +1461,18 @@ takeFramedBy_ isBegin isEnd (Fold fstep finitial _ ffinal) = res <- fstep s a return $ case res of - FL.Partial s1 -> Continue 0 (FrameGo s1 n) - FL.Done b -> Done 0 b + FL.Partial s1 -> SContinue 1 (FrameGo s1 n) + FL.Done b -> SDone 1 b step (FrameInit s) a = if isBegin a - then return $ Continue 0 (FrameGo s 0) + then return $ SContinue 1 (FrameGo s 0) else return $ Error "takeFramedBy_: missing frame start" step (FrameGo s n) a | not (isEnd a) = let n1 = if isBegin a then n + 1 else n in process s a n1 - | n == 0 = Done 0 <$> ffinal s + | n == 0 = SDone 1 <$> ffinal s | otherwise = process s a (n - 1) err = return . Error @@ -1516,8 +1516,8 @@ wordBy predicate (Fold fstep finitial _ ffinal) = Parser step initial extract res <- fstep s a return $ case res of - FL.Partial s1 -> Partial 0 $ WBWord s1 - FL.Done b -> Done 0 b + FL.Partial s1 -> SPartial 1 $ WBWord s1 + FL.Done b -> SDone 1 b initial = do res <- finitial @@ -1529,22 +1529,22 @@ wordBy predicate (Fold fstep finitial _ ffinal) = Parser step initial extract step (WBLeft s) a = if not (predicate a) then worder s a - else return $ Partial 0 $ WBLeft s + else return $ SPartial 1 $ WBLeft s step (WBWord s) a = if not (predicate a) then worder s a else do b <- ffinal s - return $ Partial 0 $ WBRight b + return $ SPartial 1 $ WBRight b step (WBRight b) a = return $ if not (predicate a) - then Done 1 b - else Partial 0 $ WBRight b + then SDone 0 b + else SPartial 1 $ WBRight b - extract (WBLeft s) = fmap (Done 0) $ ffinal s - extract (WBWord s) = fmap (Done 0) $ ffinal s - extract (WBRight b) = return (Done 0 b) + extract (WBLeft s) = fmap (SDone 1) $ ffinal s + extract (WBWord s) = fmap (SDone 1) $ ffinal s + extract (WBRight b) = return (SDone 1 b) data WordFramedState s b = WordFramedSkipPre !s @@ -1598,21 +1598,21 @@ wordFramedBy isEsc isBegin isEnd isSep res <- fstep s a return $ case res of - FL.Partial s1 -> Continue 0 (WordFramedWord s1 n) - FL.Done b -> Done 0 b + FL.Partial s1 -> SContinue 1 (WordFramedWord s1 n) + FL.Done b -> SDone 1 b step (WordFramedSkipPre s) a - | isEsc a = return $ Continue 0 $ WordFramedEsc s 0 - | isSep a = return $ Partial 0 $ WordFramedSkipPre s - | isBegin a = return $ Continue 0 $ WordFramedWord s 1 + | isEsc a = return $ SContinue 1 $ WordFramedEsc s 0 + | isSep a = return $ SPartial 1 $ WordFramedSkipPre s + | isBegin a = return $ SContinue 1 $ WordFramedWord s 1 | isEnd a = return $ Error "wordFramedBy: missing frame start" | otherwise = process s a 0 step (WordFramedWord s n) a - | isEsc a = return $ Continue 0 $ WordFramedEsc s n + | isEsc a = return $ SContinue 1 $ WordFramedEsc s n | n == 0 && isSep a = do b <- ffinal s - return $ Partial 0 $ WordFramedSkipPost b + return $ SPartial 1 $ WordFramedSkipPost b | otherwise = do -- We need to use different order for checking begin and end for -- the n == 0 and n == 1 case so that when the begin and end @@ -1621,7 +1621,7 @@ wordFramedBy isEsc isBegin isEnd isSep then -- Need to check isBegin first if isBegin a - then return $ Continue 0 $ WordFramedWord s 1 + then return $ SContinue 1 $ WordFramedWord s 1 else if isEnd a then return $ Error "wordFramedBy: missing frame start" else process s a n @@ -1630,7 +1630,7 @@ wordFramedBy isEsc isBegin isEnd isSep if isEnd a then if n == 1 - then return $ Continue 0 $ WordFramedWord s 0 + then return $ SContinue 1 $ WordFramedWord s 0 else process s a (n - 1) else if isBegin a then process s a (n + 1) @@ -1639,19 +1639,19 @@ wordFramedBy isEsc isBegin isEnd isSep step (WordFramedSkipPost b) a = return $ if not (isSep a) - then Done 1 b - else Partial 0 $ WordFramedSkipPost b + then SDone 0 b + else SPartial 1 $ WordFramedSkipPost b err = return . Error - extract (WordFramedSkipPre s) = fmap (Done 0) $ ffinal s + extract (WordFramedSkipPre s) = fmap (SDone 1) $ ffinal s extract (WordFramedWord s n) = if n == 0 - then fmap (Done 0) $ ffinal s + then fmap (SDone 1) $ ffinal s else err "wordFramedBy: missing frame end" extract (WordFramedEsc _ _) = err "wordFramedBy: trailing escape" - extract (WordFramedSkipPost b) = return (Done 0 b) + extract (WordFramedSkipPost b) = return (SDone 1 b) data WordQuotedState s b a = WordQuotedSkipPre !s @@ -1758,16 +1758,16 @@ wordWithQuotes keepQuotes tr escChar toRight isSep res <- fstep s a return $ case res of - FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr) - FL.Done b -> Done 0 b + FL.Partial s1 -> SContinue 1 (WordQuotedWord s1 n ql qr) + FL.Done b -> SDone 1 b {-# INLINE processUnquoted #-} processUnquoted s a = do res <- fstep s a return $ case res of - FL.Partial s1 -> Continue 0 (WordUnquotedWord s1) - FL.Done b -> Done 0 b + FL.Partial s1 -> SContinue 1 (WordUnquotedWord s1) + FL.Done b -> SDone 1 b {-# INLINE checkRightQuoteAndProcess #-} checkRightQuoteAndProcess s a n ql qr @@ -1775,46 +1775,46 @@ wordWithQuotes keepQuotes tr escChar toRight isSep if n == 1 then if keepQuotes then processUnquoted s a - else return $ Continue 0 $ WordUnquotedWord s + else return $ SContinue 1 $ WordUnquotedWord s else processQuoted s a (n - 1) ql qr | a == ql = processQuoted s a (n + 1) ql qr | otherwise = processQuoted s a n ql qr step (WordQuotedSkipPre s) a - | isEsc a = return $ Continue 0 $ WordUnquotedEsc s - | isSep a = return $ Partial 0 $ WordQuotedSkipPre s + | isEsc a = return $ SContinue 1 $ WordUnquotedEsc s + | isSep a = return $ SPartial 1 $ WordQuotedSkipPre s | otherwise = case toRight a of Just qr -> if keepQuotes then processQuoted s a 1 a qr - else return $ Continue 0 $ WordQuotedWord s 1 a qr + else return $ SContinue 1 $ WordQuotedWord s 1 a qr Nothing | isInvalid a -> return $ Error "wordKeepQuotes: invalid unquoted char" | otherwise -> processUnquoted s a step (WordUnquotedWord s) a - | isEsc a = return $ Continue 0 $ WordUnquotedEsc s + | isEsc a = return $ SContinue 1 $ WordUnquotedEsc s | isSep a = do b <- ffinal s - return $ Partial 0 $ WordQuotedSkipPost b + return $ SPartial 1 $ WordQuotedSkipPost b | otherwise = do case toRight a of Just qr -> if keepQuotes then processQuoted s a 1 a qr - else return $ Continue 0 $ WordQuotedWord s 1 a qr + else return $ SContinue 1 $ WordQuotedWord s 1 a qr Nothing -> if isInvalid a then return $ Error "wordKeepQuotes: invalid unquoted char" else processUnquoted s a step (WordQuotedWord s n ql qr) a - | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr + | isEsc a = return $ SContinue 1 $ WordQuotedEsc s n ql qr {- -- XXX Will this ever occur? Will n ever be 0? | n == 0 && isSep a = do b <- fextract s - return $ Partial 0 $ WordQuotedSkipPost b + return $ SPartial 1 $ WordQuotedSkipPost b -} | otherwise = checkRightQuoteAndProcess s a n ql qr step (WordUnquotedEsc s) a = processUnquoted s a @@ -1824,27 +1824,27 @@ wordWithQuotes keepQuotes tr escChar toRight isSep res <- fstep s escChar case res of FL.Partial s1 -> checkRightQuoteAndProcess s1 a n ql qr - FL.Done b -> return $ Done 0 b + FL.Done b -> return $ SDone 1 b Just x -> processQuoted s x n ql qr step (WordQuotedSkipPost b) a = return $ if not (isSep a) - then Done 1 b - else Partial 0 $ WordQuotedSkipPost b + then SDone 0 b + else SPartial 1 $ WordQuotedSkipPost b err = return . Error - extract (WordQuotedSkipPre s) = fmap (Done 0) $ ffinal s - extract (WordUnquotedWord s) = fmap (Done 0) $ ffinal s + extract (WordQuotedSkipPre s) = fmap (SDone 1) $ ffinal s + extract (WordUnquotedWord s) = fmap (SDone 1) $ ffinal s extract (WordQuotedWord s n _ _) = if n == 0 - then fmap (Done 0) $ ffinal s + then fmap (SDone 1) $ ffinal s else err "wordWithQuotes: missing frame end" extract WordQuotedEsc {} = err "wordWithQuotes: trailing escape" extract (WordUnquotedEsc _) = err "wordWithQuotes: trailing escape" - extract (WordQuotedSkipPost b) = return (Done 0 b) + extract (WordQuotedSkipPost b) = return (SDone 1 b) -- | 'wordWithQuotes' without processing the quotes and escape function -- supplied to escape the quote char within a quote. Can be used to parse words @@ -1925,8 +1925,8 @@ groupBy eq (Fold fstep finitial _ ffinal) = Parser step initial extract res <- fstep s a return $ case res of - FL.Done b -> Done 0 b - FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1) + FL.Done b -> SDone 1 b + FL.Partial s1 -> SPartial 1 (GroupByGrouping a0 s1) initial = do res <- finitial @@ -1939,10 +1939,10 @@ groupBy eq (Fold fstep finitial _ ffinal) = Parser step initial extract step (GroupByGrouping a0 s) a = if eq a0 a then grouper s a0 a - else Done 1 <$> ffinal s + else SDone 0 <$> ffinal s - extract (GroupByInit s) = fmap (Done 0) $ ffinal s - extract (GroupByGrouping _ s) = fmap (Done 0) $ ffinal s + extract (GroupByInit s) = fmap (SDone 1) $ ffinal s + extract (GroupByGrouping _ s) = fmap (SDone 1) $ ffinal s -- | Unlike 'groupBy' this combinator performs a rolling comparison of two -- successive elements in the input stream. Assuming the input stream @@ -1985,8 +1985,8 @@ groupByRolling eq (Fold fstep finitial _ ffinal) = Parser step initial extract res <- fstep s a return $ case res of - FL.Done b -> Done 0 b - FL.Partial s1 -> Partial 0 (GroupByGrouping a s1) + FL.Done b -> SDone 1 b + FL.Partial s1 -> SPartial 1 (GroupByGrouping a s1) initial = do res <- finitial @@ -1999,10 +1999,10 @@ groupByRolling eq (Fold fstep finitial _ ffinal) = Parser step initial extract step (GroupByGrouping a0 s) a = if eq a0 a then grouper s a - else Done 1 <$> ffinal s + else SDone 0 <$> ffinal s - extract (GroupByInit s) = fmap (Done 0) $ ffinal s - extract (GroupByGrouping _ s) = fmap (Done 0) $ ffinal s + extract (GroupByInit s) = fmap (SDone 1) $ ffinal s + extract (GroupByGrouping _ s) = fmap (SDone 1) $ ffinal s {-# ANN type GroupByStatePair Fuse #-} data GroupByStatePair a s1 s2 @@ -2033,21 +2033,21 @@ groupByRollingEither {-# INLINE grouper #-} grouper s1 s2 a = do - return $ Continue 0 (GroupByGroupingPair a s1 s2) + return $ SContinue 1 (GroupByGroupingPair a s1 s2) {-# INLINE grouperL2 #-} grouperL2 s1 s2 a = do res <- fstep1 s1 a return $ case res of - FL.Done b -> Done 0 (Left b) - FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2) + FL.Done b -> SDone 1 (Left b) + FL.Partial s11 -> SPartial 1 (GroupByGroupingPairL a s11 s2) {-# INLINE grouperL #-} grouperL s1 s2 a0 a = do res <- fstep1 s1 a0 case res of - FL.Done b -> return $ Done 0 (Left b) + FL.Done b -> return $ SDone 1 (Left b) FL.Partial s11 -> grouperL2 s11 s2 a {-# INLINE grouperR2 #-} @@ -2055,14 +2055,14 @@ groupByRollingEither res <- fstep2 s2 a return $ case res of - FL.Done b -> Done 0 (Right b) - FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21) + FL.Done b -> SDone 1 (Right b) + FL.Partial s21 -> SPartial 1 (GroupByGroupingPairR a s1 s21) {-# INLINE grouperR #-} grouperR s1 s2 a0 a = do res <- fstep2 s2 a0 case res of - FL.Done b -> return $ Done 0 (Right b) + FL.Done b -> return $ SDone 1 (Right b) FL.Partial s21 -> grouperR2 s1 s21 a initial = do @@ -2086,21 +2086,21 @@ groupByRollingEither step (GroupByGroupingPairL a0 s1 s2) a = if not (eq a0 a) then grouperL2 s1 s2 a - else Done 1 . Left <$> ffinal1 s1 + else SDone 0 . Left <$> ffinal1 s1 step (GroupByGroupingPairR a0 s1 s2) a = if eq a0 a then grouperR2 s1 s2 a - else Done 1 . Right <$> ffinal2 s2 + else SDone 0 . Right <$> ffinal2 s2 - extract (GroupByInitPair s1 _) = Done 0 . Left <$> ffinal1 s1 - extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> ffinal1 s1 - extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> ffinal2 s2 + extract (GroupByInitPair s1 _) = SDone 1 . Left <$> ffinal1 s1 + extract (GroupByGroupingPairL _ s1 _) = SDone 1 . Left <$> ffinal1 s1 + extract (GroupByGroupingPairR _ _ s2) = SDone 1 . Right <$> ffinal2 s2 extract (GroupByGroupingPair a s1 _) = do res <- fstep1 s1 a case res of - FL.Done b -> return $ Done 0 (Left b) - FL.Partial s11 -> Done 0 . Left <$> ffinal1 s11 + FL.Done b -> return $ SDone 1 (Left b) + FL.Partial s11 -> SDone 1 . Left <$> ffinal1 s11 -- XXX use an Unfold instead of a list? -- XXX custom combinators for matching list, array and stream? @@ -2132,16 +2132,16 @@ listEqBy cmp str = Parser step initial extract -- XXX Should return IDone in initial for [] case initial = return $ IPartial str - step [] _ = return $ Done 0 str + step [] _ = return $ SDone 1 str step [x] a = return $ if x `cmp` a - then Done 0 str + then SDone 1 str else Error "listEqBy: failed, yet to match the last element" step (x:xs) a = return $ if x `cmp` a - then Continue 0 xs + then SContinue 1 xs else Error $ "listEqBy: failed, yet to match " ++ show (length xs + 1) ++ " elements" @@ -2173,9 +2173,9 @@ streamEqByInternal cmp (D.Stream sstep state) = Parser step initial extract r <- sstep defState st return $ case r of - D.Yield x1 s -> Continue 0 (Just' x1, s) - D.Stop -> Done 0 () - D.Skip s -> Continue 1 (Nothing', s) + D.Yield x1 s -> SContinue 1 (Just' x1, s) + D.Stop -> SDone 1 () + D.Skip s -> SContinue 0 (Nothing', s) else return $ Error "streamEqBy: mismtach occurred" step (Nothing', st) a = do r <- sstep defState st @@ -2183,10 +2183,10 @@ streamEqByInternal cmp (D.Stream sstep state) = Parser step initial extract $ case r of D.Yield x s -> do if x `cmp` a - then Continue 0 (Nothing', s) + then SContinue 1 (Nothing', s) else Error "streamEqBy: mismatch occurred" - D.Stop -> Done 1 () - D.Skip s -> Continue 1 (Nothing', s) + D.Stop -> SDone 0 () + D.Skip s -> SContinue 0 (Nothing', s) extract _ = return $ Error "streamEqBy: end of input" @@ -2279,12 +2279,12 @@ zipWithM zf (D.Stream sstep state) (Fold fstep finitial _ ffinal) = FL.Partial fs1 -> do r <- sstep defState st case r of - D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1) + D.Yield x1 s -> return $ SContinue 1 (Just' x1, s, fs1) D.Stop -> do x <- ffinal fs1 - return $ Done 0 x - D.Skip s -> return $ Continue 1 (Nothing', s, fs1) - FL.Done x -> return $ Done 0 x + return $ SDone 1 x + D.Skip s -> return $ SContinue 0 (Nothing', s, fs1) + FL.Done x -> return $ SDone 1 x step (Nothing', st, fs) b = do r <- sstep defState st case r of @@ -2293,12 +2293,12 @@ zipWithM zf (D.Stream sstep state) (Fold fstep finitial _ ffinal) = fres <- fstep fs c case fres of FL.Partial fs1 -> - return $ Continue 0 (Nothing', s, fs1) - FL.Done x -> return $ Done 0 x + return $ SContinue 1 (Nothing', s, fs1) + FL.Done x -> return $ SDone 1 x D.Stop -> do x <- ffinal fs - return $ Done 1 x - D.Skip s -> return $ Continue 1 (Nothing', s, fs) + return $ SDone 0 x + D.Skip s -> return $ SContinue 0 (Nothing', s, fs) extract _ = return $ Error "zipWithM: end of input" @@ -2434,53 +2434,53 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract res <- pstep r a let cnt1 = cnt + 1 case res of - Partial 0 s -> do + SPartial 1 s -> do assertM(cnt1 >= 0) if cnt1 < lim - then return $ Partial 0 $ Tuple' cnt1 s + then return $ SPartial 1 $ Tuple' cnt1 s else do r1 <- pextract s return $ case r1 of - Done n b -> Done n b - Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1) + SDone n b -> SDone n b + SContinue n s1 -> SContinue n (Tuple' (cnt1 + n - 1) s1) Error err -> Error err - Partial _ _ -> error "takeP: Partial in extract" + SPartial _ _ -> error "takeP: SPartial in extract" - Continue 0 s -> do + SContinue 1 s -> do assertM(cnt1 >= 0) if cnt1 < lim - then return $ Continue 0 $ Tuple' cnt1 s + then return $ SContinue 1 $ Tuple' cnt1 s else do r1 <- pextract s return $ case r1 of - Done n b -> Done n b - Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1) + SDone n b -> SDone n b + SContinue n s1 -> SContinue n (Tuple' (cnt1 + n - 1) s1) Error err -> Error err - Partial _ _ -> error "takeP: Partial in extract" - Partial n s -> do - let taken = cnt1 - n + SPartial _ _ -> error "takeP: SPartial in extract" + SPartial n s -> do + let taken = cnt1 + n - 1 assertM(taken >= 0) - return $ Partial n $ Tuple' taken s - Continue n s -> do - let taken = cnt1 - n + return $ SPartial n $ Tuple' taken s + SContinue n s -> do + let taken = cnt1 + n - 1 assertM(taken >= 0) - return $ Continue n $ Tuple' taken s - Done n b -> return $ Done n b + return $ SContinue n $ Tuple' taken s + SDone n b -> return $ SDone n b Error str -> return $ Error str extract (Tuple' cnt r) = do r1 <- pextract r return $ case r1 of - Done n b -> Done n b - Continue n s1 -> Continue n (Tuple' (cnt - n) s1) + SDone n b -> SDone n b + SContinue n s1 -> SContinue n (Tuple' (cnt + n - 1) s1) Error err -> Error err - Partial _ _ -> error "takeP: Partial in extract" + SPartial _ _ -> error "takeP: SPartial in extract" -- XXX Need to make the Initial type Step to remove this iextract s = do r <- pextract s return $ case r of - Done _ b -> IDone b + SDone _ b -> IDone b Error err -> IError err _ -> error "Bug: takeP invalid state in initial" @@ -2504,9 +2504,9 @@ lookAhead (Parser step1 initial1 _) = Parser step initial extract let cnt1 = cnt + 1 return $ case r of - Partial n s -> Continue n (Tuple'Fused (cnt1 - n) s) - Continue n s -> Continue n (Tuple'Fused (cnt1 - n) s) - Done _ b -> Done cnt1 b + SPartial n s -> SContinue n (Tuple'Fused (cnt1 + n - 1) s) + SContinue n s -> SContinue n (Tuple'Fused (cnt1 + n - 1) s) + SDone _ b -> SDone (1 - cnt1) b Error err -> Error err -- XXX returning an error let's us backtrack. To implement it in a way so @@ -2598,16 +2598,16 @@ deintercalateAll processL foldAction n nextState = do fres <- foldAction case fres of - FL.Partial fs1 -> return $ Partial n (nextState fs1) - FL.Done c -> return $ Done n c + FL.Partial fs1 -> return $ SPartial n (nextState fs1) + FL.Done c -> return $ SDone n c {-# INLINE runStepL #-} runStepL fs sL a = do r <- stepL sL a case r of - Partial n s -> return $ Partial n (DeintercalateAllL fs s) - Continue n s -> return $ Continue n (DeintercalateAllL fs s) - Done n b -> + SPartial n s -> return $ SPartial n (DeintercalateAllL fs s) + SContinue n s -> return $ SContinue n (DeintercalateAllL fs s) + SDone n b -> processL (fstep fs (Left b)) n DeintercalateAllInitR Error err -> return $ Error err @@ -2618,18 +2618,18 @@ deintercalateAll FL.Partial fs1 -> do res <- initialL case res of - IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps) + IPartial ps -> return $ SPartial n (DeintercalateAllL fs1 ps) IDone _ -> errMsg "left" "succeed" IError _ -> errMsg "left" "fail" - FL.Done c -> return $ Done n c + FL.Done c -> return $ SDone n c {-# INLINE runStepR #-} runStepR fs sR a = do r <- stepR sR a case r of - Partial n s -> return $ Partial n (DeintercalateAllR fs s) - Continue n s -> return $ Continue n (DeintercalateAllR fs s) - Done n b -> processR (fstep fs (Right b)) n + SPartial n s -> return $ SPartial n (DeintercalateAllR fs s) + SContinue n s -> return $ SContinue n (DeintercalateAllR fs s) + SDone n b -> processR (fstep fs (Right b)) n Error err -> return $ Error err step (DeintercalateAllInitL fs) a = do @@ -2651,17 +2651,17 @@ deintercalateAll extractResult n fs r = do res <- fstep fs r case res of - FL.Partial fs1 -> fmap (Done n) $ ffinal fs1 - FL.Done c -> return (Done n c) - extract (DeintercalateAllInitL fs) = fmap (Done 0) $ ffinal fs + FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 + FL.Done c -> return (SDone n c) + extract (DeintercalateAllInitL fs) = fmap (SDone 1) $ ffinal fs extract (DeintercalateAllL fs sL) = do r <- extractL sL case r of - Done n b -> extractResult n fs (Left b) + SDone n b -> extractResult n fs (Left b) Error err -> return $ Error err - Continue n s -> return $ Continue n (DeintercalateAllL fs s) - Partial _ _ -> error "Partial in extract" - extract (DeintercalateAllInitR fs) = fmap (Done 0) $ ffinal fs + SContinue n s -> return $ SContinue n (DeintercalateAllL fs s) + SPartial _ _ -> error "SPartial in extract" + extract (DeintercalateAllInitR fs) = fmap (SDone 1) $ ffinal fs extract (DeintercalateAllR _ _) = return $ Error "deintercalateAll: input ended at 'Right' value" @@ -2722,27 +2722,27 @@ deintercalate processL foldAction n nextState = do fres <- foldAction case fres of - FL.Partial fs1 -> return $ Partial n (nextState fs1) - FL.Done c -> return $ Done n c + FL.Partial fs1 -> return $ SPartial n (nextState fs1) + FL.Done c -> return $ SDone n c {-# INLINE runStepL #-} runStepL cnt fs sL a = do let cnt1 = cnt + 1 r <- stepL sL a case r of - Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s) - Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s) - Done n b -> + SPartial n s -> return $ SContinue n (DeintercalateL (cnt1 + n - 1) fs s) + SContinue n s -> return $ SContinue n (DeintercalateL (cnt1 + n - 1) fs s) + SDone n b -> processL (fstep fs (Left b)) n DeintercalateInitR Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs {-# INLINE processR #-} processR cnt b fs n = do res <- initialL case res of - IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps) + IPartial ps -> return $ SContinue n (DeintercalateRL cnt b fs ps) IDone _ -> errMsg "left" "succeed" IError _ -> errMsg "left" "fail" @@ -2751,12 +2751,12 @@ deintercalate let cnt1 = cnt + 1 r <- stepR sR a case r of - Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s) - Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s) - Done n b -> processR (cnt1 - n) b fs n + SPartial n s -> return $ SContinue n (DeintercalateR (cnt1 + n - 1) fs s) + SContinue n s -> return $ SContinue n (DeintercalateR (cnt1 + n - 1) fs s) + SDone n b -> processR (cnt1 + n - 1) b fs n Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs step (DeintercalateInitL fs) a = do res <- initialL @@ -2776,55 +2776,55 @@ deintercalate let cnt1 = cnt + 1 r <- stepL sL a case r of - Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s) - Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s) - Done n bL -> do + SPartial n s -> return $ SContinue n (DeintercalateRL (cnt1 + n - 1) bR fs s) + SContinue n s -> return $ SContinue n (DeintercalateRL (cnt1 + n - 1) bR fs s) + SDone n bL -> do res <- fstep fs (Right bR) case res of FL.Partial fs1 -> do fres <- fstep fs1 (Left bL) case fres of FL.Partial fs2 -> - return $ Partial n (DeintercalateInitR fs2) - FL.Done c -> return $ Done n c + return $ SPartial n (DeintercalateInitR fs2) + FL.Done c -> return $ SDone n c -- XXX We could have the fold accept pairs of (bR, bL) FL.Done _ -> error "Fold terminated consuming partial input" Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs {-# INLINE extractResult #-} extractResult n fs r = do res <- fstep fs r case res of - FL.Partial fs1 -> fmap (Done n) $ ffinal fs1 - FL.Done c -> return (Done n c) + FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 + FL.Done c -> return (SDone n c) - extract (DeintercalateInitL fs) = fmap (Done 0) $ ffinal fs + extract (DeintercalateInitL fs) = fmap (SDone 1) $ ffinal fs extract (DeintercalateL cnt fs sL) = do r <- extractL sL case r of - Done n b -> extractResult n fs (Left b) - Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s) - Partial _ _ -> error "Partial in extract" + SDone n b -> extractResult n fs (Left b) + SContinue n s -> return $ SContinue n (DeintercalateL (cnt + n - 1) fs s) + SPartial _ _ -> error "SPartial in extract" Error _ -> do xs <- ffinal fs - return $ Done cnt xs - extract (DeintercalateInitR fs) = fmap (Done 0) $ ffinal fs - extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ ffinal fs + return $ SDone (1 - cnt) xs + extract (DeintercalateInitR fs) = fmap (SDone 1) $ ffinal fs + extract (DeintercalateR cnt fs _) = fmap (SDone (1 - cnt)) $ ffinal fs extract (DeintercalateRL cnt bR fs sL) = do r <- extractL sL case r of - Done n bL -> do + SDone n bL -> do res <- fstep fs (Right bR) case res of FL.Partial fs1 -> extractResult n fs1 (Left bL) FL.Done _ -> error "Fold terminated consuming partial input" - Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s) - Partial _ _ -> error "Partial in extract" + SContinue n s -> return $ SContinue n (DeintercalateRL (cnt + n - 1) bR fs s) + SPartial _ _ -> error "SPartial in extract" Error _ -> do xs <- ffinal fs - return $ Done cnt xs + return $ SDone (1 - cnt) xs {-# ANN type Deintercalate1State Fuse #-} data Deintercalate1State b fs sp ss = @@ -2883,17 +2883,17 @@ deintercalate1 processL foldAction n nextState = do fres <- foldAction case fres of - FL.Partial fs1 -> return $ Partial n (nextState fs1) - FL.Done c -> return $ Done n c + FL.Partial fs1 -> return $ SPartial n (nextState fs1) + FL.Done c -> return $ SDone n c {-# INLINE runStepInitL #-} runStepInitL cnt fs sL a = do let cnt1 = cnt + 1 r <- stepL sL a case r of - Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s) - Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s) - Done n b -> + SPartial n s -> return $ SContinue n (Deintercalate1InitL (cnt1 + n - 1) fs s) + SContinue n s -> return $ SContinue n (Deintercalate1InitL (cnt1 + n - 1) fs s) + SDone n b -> processL (fstep fs (Left b)) n Deintercalate1InitR Error err -> return $ Error err @@ -2901,7 +2901,7 @@ deintercalate1 processR cnt b fs n = do res <- initialL case res of - IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps) + IPartial ps -> return $ SContinue n (Deintercalate1RL cnt b fs ps) IDone _ -> errMsg "left" "succeed" IError _ -> errMsg "left" "fail" @@ -2910,12 +2910,12 @@ deintercalate1 let cnt1 = cnt + 1 r <- stepR sR a case r of - Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s) - Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s) - Done n b -> processR (cnt1 - n) b fs n + SPartial n s -> return $ SContinue n (Deintercalate1R (cnt1 + n - 1) fs s) + SContinue n s -> return $ SContinue n (Deintercalate1R (cnt1 + n - 1) fs s) + SDone n b -> processR (cnt1 + n - 1) b fs n Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a step (Deintercalate1InitR fs) a = do @@ -2929,52 +2929,52 @@ deintercalate1 let cnt1 = cnt + 1 r <- stepL sL a case r of - Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s) - Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s) - Done n bL -> do + SPartial n s -> return $ SContinue n (Deintercalate1RL (cnt1 + n - 1) bR fs s) + SContinue n s -> return $ SContinue n (Deintercalate1RL (cnt1 + n - 1) bR fs s) + SDone n bL -> do res <- fstep fs (Right bR) case res of FL.Partial fs1 -> do fres <- fstep fs1 (Left bL) case fres of FL.Partial fs2 -> - return $ Partial n (Deintercalate1InitR fs2) - FL.Done c -> return $ Done n c + return $ SPartial n (Deintercalate1InitR fs2) + FL.Done c -> return $ SDone n c -- XXX We could have the fold accept pairs of (bR, bL) FL.Done _ -> error "Fold terminated consuming partial input" Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs {-# INLINE extractResult #-} extractResult n fs r = do res <- fstep fs r case res of - FL.Partial fs1 -> fmap (Done n) $ ffinal fs1 - FL.Done c -> return (Done n c) + FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 + FL.Done c -> return (SDone n c) extract (Deintercalate1InitL cnt fs sL) = do r <- extractL sL case r of - Done n b -> extractResult n fs (Left b) - Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s) - Partial _ _ -> error "Partial in extract" + SDone n b -> extractResult n fs (Left b) + SContinue n s -> return $ SContinue n (Deintercalate1InitL (cnt + n - 1) fs s) + SPartial _ _ -> error "SPartial in extract" Error err -> return $ Error err - extract (Deintercalate1InitR fs) = fmap (Done 0) $ ffinal fs - extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ ffinal fs + extract (Deintercalate1InitR fs) = fmap (SDone 1) $ ffinal fs + extract (Deintercalate1R cnt fs _) = fmap (SDone (1 - cnt)) $ ffinal fs extract (Deintercalate1RL cnt bR fs sL) = do r <- extractL sL case r of - Done n bL -> do + SDone n bL -> do res <- fstep fs (Right bR) case res of FL.Partial fs1 -> extractResult n fs1 (Left bL) FL.Done _ -> error "Fold terminated consuming partial input" - Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s) - Partial _ _ -> error "Partial in extract" + SContinue n s -> return $ SContinue n (Deintercalate1RL (cnt + n - 1) bR fs s) + SPartial _ _ -> error "SPartial in extract" Error _ -> do xs <- ffinal fs - return $ Done cnt xs + return $ SDone (1 - cnt) xs {-# ANN type SepByState Fuse #-} data SepByState fs sp ss = @@ -3034,27 +3034,27 @@ sepBy processL foldAction n nextState = do fres <- foldAction case fres of - FL.Partial fs1 -> return $ Partial n (nextState fs1) - FL.Done c -> return $ Done n c + FL.Partial fs1 -> return $ SPartial n (nextState fs1) + FL.Done c -> return $ SDone n c {-# INLINE runStepL #-} runStepL cnt fs sL a = do let cnt1 = cnt + 1 r <- stepL sL a case r of - Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s) - Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s) - Done n b -> + SPartial n s -> return $ SContinue n (SepByL (cnt1 + n - 1) fs s) + SContinue n s -> return $ SContinue n (SepByL (cnt1 + n - 1) fs s) + SDone n b -> processL (fstep fs b) n SepByInitR Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs {-# INLINE processR #-} processR cnt fs n = do res <- initialL case res of - IPartial ps -> return $ Continue n (SepByL cnt fs ps) + IPartial ps -> return $ SContinue n (SepByL cnt fs ps) IDone _ -> errMsg "left" "succeed" IError _ -> errMsg "left" "fail" @@ -3063,12 +3063,12 @@ sepBy let cnt1 = cnt + 1 r <- stepR sR a case r of - Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s) - Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s) - Done n _ -> processR (cnt1 - n) fs n + SPartial n s -> return $ SContinue n (SepByR (cnt1 + n - 1) fs s) + SContinue n s -> return $ SContinue n (SepByR (cnt1 + n - 1) fs s) + SDone n _ -> processR (cnt1 + n - 1) fs n Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs step (SepByInitL fs) a = do res <- initialL @@ -3089,21 +3089,21 @@ sepBy extractResult n fs r = do res <- fstep fs r case res of - FL.Partial fs1 -> fmap (Done n) $ ffinal fs1 - FL.Done c -> return (Done n c) + FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 + FL.Done c -> return (SDone n c) - extract (SepByInitL fs) = fmap (Done 0) $ ffinal fs + extract (SepByInitL fs) = fmap (SDone 1) $ ffinal fs extract (SepByL cnt fs sL) = do r <- extractL sL case r of - Done n b -> extractResult n fs b - Continue n s -> return $ Continue n (SepByL (cnt - n) fs s) - Partial _ _ -> error "Partial in extract" + SDone n b -> extractResult n fs b + SContinue n s -> return $ SContinue n (SepByL (cnt + n - 1) fs s) + SPartial _ _ -> error "Partial in extract" Error _ -> do xs <- ffinal fs - return $ Done cnt xs - extract (SepByInitR fs) = fmap (Done 0) $ ffinal fs - extract (SepByR cnt fs _) = fmap (Done cnt) $ ffinal fs + return $ SDone (1 - cnt) xs + extract (SepByInitR fs) = fmap (SDone 1) $ ffinal fs + extract (SepByR cnt fs _) = fmap (SDone (1 - cnt)) $ ffinal fs -- | Non-backtracking version of sepBy. Several times faster. {-# INLINE sepByAll #-} @@ -3181,17 +3181,17 @@ sepBy1 processL foldAction n nextState = do fres <- foldAction case fres of - FL.Partial fs1 -> return $ Partial n (nextState fs1) - FL.Done c -> return $ Done n c + FL.Partial fs1 -> return $ SPartial n (nextState fs1) + FL.Done c -> return $ SDone n c {-# INLINE runStepInitL #-} runStepInitL cnt fs sL a = do let cnt1 = cnt + 1 r <- stepL sL a case r of - Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s) - Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s) - Done n b -> + SPartial n s -> return $ SContinue n (SepBy1InitL (cnt1 + n - 1) fs s) + SContinue n s -> return $ SContinue n (SepBy1InitL (cnt1 + n - 1) fs s) + SDone n b -> processL (fstep fs b) n SepBy1InitR Error err -> return $ Error err @@ -3200,19 +3200,19 @@ sepBy1 let cnt1 = cnt + 1 r <- stepL sL a case r of - Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s) - Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s) - Done n b -> + SPartial n s -> return $ SContinue n (SepBy1L (cnt1 + n - 1) fs s) + SContinue n s -> return $ SContinue n (SepBy1L (cnt1 + n - 1) fs s) + SDone n b -> processL (fstep fs b) n SepBy1InitR Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs {-# INLINE processR #-} processR cnt fs n = do res <- initialL case res of - IPartial ps -> return $ Continue n (SepBy1L cnt fs ps) + IPartial ps -> return $ SContinue n (SepBy1L cnt fs ps) IDone _ -> errMsg "left" "succeed" IError _ -> errMsg "left" "fail" @@ -3221,12 +3221,12 @@ sepBy1 let cnt1 = cnt + 1 r <- stepR sR a case r of - Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s) - Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s) - Done n _ -> processR (cnt1 - n) fs n + SPartial n s -> return $ SContinue n (SepBy1R (cnt1 + n - 1) fs s) + SContinue n s -> return $ SContinue n (SepBy1R (cnt1 + n - 1) fs s) + SDone n _ -> processR (cnt1 - n) fs n Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a @@ -3242,27 +3242,27 @@ sepBy1 extractResult n fs r = do res <- fstep fs r case res of - FL.Partial fs1 -> fmap (Done n) $ ffinal fs1 - FL.Done c -> return (Done n c) + FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 + FL.Done c -> return (SDone n c) extract (SepBy1InitL cnt fs sL) = do r <- extractL sL case r of - Done n b -> extractResult n fs b - Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s) - Partial _ _ -> error "Partial in extract" + SDone n b -> extractResult n fs b + SContinue n s -> return $ SContinue n (SepBy1InitL (cnt + n - 1) fs s) + SPartial _ _ -> error "SPartial in extract" Error err -> return $ Error err extract (SepBy1L cnt fs sL) = do r <- extractL sL case r of - Done n b -> extractResult n fs b - Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s) - Partial _ _ -> error "Partial in extract" + SDone n b -> extractResult n fs b + SContinue n s -> return $ SContinue n (SepBy1L (cnt + n - 1) fs s) + SPartial _ _ -> error "SPartial in extract" Error _ -> do xs <- ffinal fs - return $ Done cnt xs - extract (SepBy1InitR fs) = fmap (Done 0) $ ffinal fs - extract (SepBy1R cnt fs _) = fmap (Done cnt) $ ffinal fs + return $ SDone (1 - cnt) xs + extract (SepBy1InitR fs) = fmap (SDone 1) $ ffinal fs + extract (SepBy1R cnt fs _) = fmap (SDone (1 - cnt)) $ ffinal fs ------------------------------------------------------------------------------- -- Interleaving a collection of parsers @@ -3308,11 +3308,11 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial _ ffinal) = step (Nothing', ss, fs) _ = do sres <- sstep defState ss case sres of - D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs) + D.Yield p ss1 -> return $ SContinue 0 (Just' p, ss1, fs) D.Stop -> do c <- ffinal fs - return $ Done 1 c - D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs) + return $ SDone 0 c + D.Skip ss1 -> return $ SContinue 0 (Nothing', ss1, fs) -- state holds a parser that may or may not have been -- initialized. pinit holds the initial parser state @@ -3323,49 +3323,49 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial _ ffinal) = IPartial ps1 -> do pres <- pstep ps1 a case pres of - Partial n ps2 -> + SPartial n ps2 -> let newP = Just' $ Parser pstep (return $ IPartial ps2) pextr - in return $ Partial n (newP, ss, fs) - Continue n ps2 -> + in return $ SPartial n (newP, ss, fs) + SContinue n ps2 -> let newP = Just' $ Parser pstep (return $ IPartial ps2) pextr - in return $ Continue n (newP, ss, fs) - Done n b -> do + in return $ SContinue n (newP, ss, fs) + SDone n b -> do fres <- fstep fs b case fres of FL.Partial fs1 -> - return $ Partial n (Nothing', ss, fs1) - FL.Done c -> return $ Done n c + return $ SPartial n (Nothing', ss, fs1) + FL.Done c -> return $ SDone n c Error msg -> return $ Error msg IDone b -> do fres <- fstep fs b case fres of FL.Partial fs1 -> - return $ Partial 1 (Nothing', ss, fs1) - FL.Done c -> return $ Done 1 c + return $ SPartial 0 (Nothing', ss, fs1) + FL.Done c -> return $ SDone 0 c IError err -> return $ Error err - extract (Nothing', _, fs) = fmap (Done 0) $ ffinal fs + extract (Nothing', _, fs) = fmap (SDone 1) $ ffinal fs extract (Just' (Parser pstep pinit pextr), ss, fs) = do ps <- pinit case ps of IPartial ps1 -> do r <- pextr ps1 case r of - Done n b -> do + SDone n b -> do res <- fstep fs b case res of - FL.Partial fs1 -> fmap (Done n) $ ffinal fs1 - FL.Done c -> return (Done n c) + FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 + FL.Done c -> return (SDone n c) Error err -> return $ Error err - Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs) - Partial _ _ -> error "Partial in extract" + SContinue n s -> return $ SContinue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs) + SPartial _ _ -> error "SPartial in extract" IDone b -> do fres <- fstep fs b case fres of - FL.Partial fs1 -> fmap (Done 0) $ ffinal fs1 - FL.Done c -> return (Done 0 c) + FL.Partial fs1 -> fmap (SDone 1) $ ffinal fs1 + FL.Done c -> return (SDone 1 c) IError err -> return $ Error err ------------------------------------------------------------------------------- @@ -3533,18 +3533,18 @@ manyTill (Parser stepL initialL extractL) step (ManyTillR cnt fs st) a = do r <- stepR st a case r of - Partial n s -> return $ Partial n (ManyTillR 0 fs s) - Continue n s -> do + SPartial n s -> return $ SPartial n (ManyTillR 0 fs s) + SContinue n s -> do assertM(cnt + 1 - n >= 0) - return $ Continue n (ManyTillR (cnt + 1 - n) fs s) - Done n _ -> do + return $ SContinue n (ManyTillR (cnt + n) fs s) + SDone n _ -> do b <- ffinal fs - return $ Done n b + return $ SDone n b Error _ -> do resL <- initialL case resL of IPartial sl -> - return $ Continue (cnt + 1) (ManyTillL fs sl) + return $ SContinue (negate cnt) (ManyTillL fs sl) IDone bl -> do fr <- fstep fs bl let cnt1 = cnt + 1 @@ -3552,37 +3552,37 @@ manyTill (Parser stepL initialL extractL) FL.Partial fs1 -> scrutR fs1 - (Partial cnt1) - (Continue cnt1) - (Done cnt1) + (SPartial cnt1) + (SContinue cnt1) + (SDone cnt1) Error - FL.Done fb -> return $ Done cnt1 fb + FL.Done fb -> return $ SDone cnt1 fb IError err -> return $ Error err step (ManyTillL fs st) a = do r <- stepL st a case r of - Partial n s -> return $ Partial n (ManyTillL fs s) - Continue n s -> return $ Continue n (ManyTillL fs s) - Done n b -> do + SPartial n s -> return $ SPartial n (ManyTillL fs s) + SContinue n s -> return $ SContinue n (ManyTillL fs s) + SDone n b -> do fs1 <- fstep fs b case fs1 of FL.Partial s -> - scrutR s (Partial n) (Continue n) (Done n) Error - FL.Done b1 -> return $ Done n b1 + scrutR s (SPartial n) (SContinue n) (SDone n) Error + FL.Done b1 -> return $ SDone n b1 Error err -> return $ Error err extract (ManyTillL fs sR) = do res <- extractL sR case res of - Done n b -> do + SDone n b -> do r <- fstep fs b case r of - FL.Partial fs1 -> fmap (Done n) $ ffinal fs1 - FL.Done c -> return (Done n c) + FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 + FL.Done c -> return (SDone n c) Error err -> return $ Error err - Continue n s -> return $ Continue n (ManyTillL fs s) - Partial _ _ -> error "Partial in extract" - extract (ManyTillR _ fs _) = fmap (Done 0) $ ffinal fs + SContinue n s -> return $ SContinue n (ManyTillL fs s) + SPartial _ _ -> error "SPartial in extract" + extract (ManyTillR _ fs _) = fmap (SDone 1) $ ffinal fs -- | @manyThen f collect recover@ repeats the parser @collect@ on the input and -- collects the output in the supplied fold. If the the parser @collect@ fails, diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index 5cb5bd1fbf..d52e2e5401 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -387,18 +387,18 @@ instance Bifunctor Step where {-# INLINE bimap #-} bimap f g step = case step of - Partial n s -> Partial n (f s) - Continue n s -> Continue n (f s) - Done n b -> Done n (g b) + SPartial n s -> SPartial n (f s) + SContinue n s -> SContinue n (f s) + SDone n b -> SDone n (g b) Error err -> Error err -- | Bimap discarding the count, and using the supplied count instead. bimapOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1 bimapOverrideCount n f g step = case step of - Partial _ s -> Partial n (f s) - Continue _ s -> Continue n (f s) - Done _ b -> Done n (g b) + SPartial _ s -> SPartial n (f s) + SContinue _ s -> SContinue n (f s) + SDone _ b -> SDone n (g b) Error err -> Error err -- | fmap = second @@ -410,9 +410,9 @@ instance Functor (Step s) where assertStepCount :: Int -> Step s b -> Step s b assertStepCount i step = case step of - Partial n _ -> assert (i == n) step - Continue n _ -> assert (i == n) step - Done n _ -> assert (i == n) step + SPartial n _ -> assert (i == n) step + SContinue n _ -> assert (i == n) step + SDone n _ -> assert (i == n) step Error _ -> step -- | Map an extract function over the state of Step @@ -421,9 +421,9 @@ assertStepCount i step = extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b) extractStep f res = case res of - Partial n s1 -> assertStepCount n <$> f s1 - Done n b -> return $ Done n b - Continue n s1 -> assertStepCount n <$> f s1 + SPartial n s1 -> assertStepCount n <$> f s1 + SDone n b -> return $ SDone n b + SContinue n s1 -> assertStepCount n <$> f s1 Error err -> return $ Error err -- | Map a monadic function over the result @b@ in @Step s b@. @@ -433,9 +433,9 @@ extractStep f res = mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b) mapMStep f res = case res of - Partial n s -> pure $ Partial n s - Done n b -> Done n <$> f b - Continue n s -> pure $ Continue n s + SPartial n s -> pure $ SPartial n s + SDone n b -> SDone n <$> f b + SContinue n s -> pure $ SContinue n s Error err -> pure $ Error err -- | A parser is a fold that can fail and is represented as @Parser step @@ -624,15 +624,15 @@ splitWith func (Parser stepL initialL extractL) -- e.g. in ((,) <$> p1 <*> p2) <|> p3, if p2 fails we have to -- backtrack and start running p3. So we need to keep the input -- buffered until we know that the applicative cannot fail. - Partial n s -> return $ Continue n (SeqParseL s) - Continue n s -> return $ Continue n (SeqParseL s) - Done n b -> do + SPartial n s -> return $ SContinue n (SeqParseL s) + SContinue n s -> return $ SContinue n (SeqParseL s) + SDone n b -> do -- XXX Use bimap if we make this a Step type -- fmap (bimap (SeqParseR (func b)) (func b)) initialR initR <- initialR return $ case initR of - IPartial sr -> Continue n $ SeqParseR (func b) sr - IDone br -> Done n (func b br) + IPartial sr -> SContinue n $ SeqParseR (func b) sr + IDone br -> SDone n (func b br) IError err -> Error err Error err -> return $ Error err @@ -643,7 +643,7 @@ splitWith func (Parser stepL initialL extractL) -- XXX Use bimap here rL <- extractL sL case rL of - Done n bL -> do + SDone n bL -> do -- XXX Use bimap here if we use Step type in Initial iR <- initialR case iR of @@ -651,11 +651,11 @@ splitWith func (Parser stepL initialL extractL) fmap (bimap (SeqParseR (func bL)) (func bL)) (extractR sR) - IDone bR -> return $ Done n $ func bL bR + IDone bR -> return $ SDone n $ func bL bR IError err -> return $ Error err Error err -> return $ Error err - Partial _ _ -> error "Bug: splitWith extract 'Partial'" - Continue n s -> return $ Continue n (SeqParseL s) + SPartial _ _ -> error "Bug: splitWith extract 'Partial'" + SContinue n s -> return $ SContinue n (SeqParseL s) ------------------------------------------------------------------------------- -- Sequential applicative for backtracking folds @@ -697,20 +697,20 @@ noErrorUnsafeSplitWith func (Parser stepL initialL extractL) IError err -> errMsg err -- Note: For the composed parse to terminate, the left parser has to be - -- a terminating parser returning a Done at some point. + -- a terminating parser returning a SDone at some point. step (SeqParseL st) a = do r <- stepL st a case r of -- Assume that the parser can never fail, therefore, we do not -- need to keep the input for backtracking. - Partial n s -> return $ Partial n (SeqParseL s) - Continue n s -> return $ Continue n (SeqParseL s) - Done n b -> do + SPartial n s -> return $ SPartial n (SeqParseL s) + SContinue n s -> return $ SContinue n (SeqParseL s) + SDone n b -> do res <- initialR return $ case res of - IPartial sr -> Partial n $ SeqParseR (func b) sr - IDone br -> Done n (func b br) + IPartial sr -> SPartial n $ SeqParseR (func b) sr + IDone br -> SDone n (func b br) IError err -> errMsg err Error err -> errMsg err @@ -721,7 +721,7 @@ noErrorUnsafeSplitWith func (Parser stepL initialL extractL) extract (SeqParseL sL) = do rL <- extractL sL case rL of - Done n bL -> do + SDone n bL -> do iR <- initialR case iR of IPartial sR -> do @@ -729,11 +729,11 @@ noErrorUnsafeSplitWith func (Parser stepL initialL extractL) return $ bimapOverrideCount n (SeqParseR (func bL)) (func bL) rR - IDone bR -> return $ Done n $ func bL bR + IDone bR -> return $ SDone n $ func bL bR IError err -> errMsg err Error err -> errMsg err - Partial _ _ -> errMsg "Partial" - Continue n s -> return $ Continue n (SeqParseL s) + SPartial _ _ -> errMsg "Partial" + SContinue n s -> return $ SContinue n (SeqParseL s) {-# ANN type SeqAState Fuse #-} data SeqAState sl sr = SeqAL !sl | SeqAR !sr @@ -774,7 +774,7 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) = IError err -> return $ IError err -- Note: For the composed parse to terminate, the left parser has to be - -- a terminating parser returning a Done at some point. + -- a terminating parser returning a SDone at some point. step (SeqAL st) a = do -- Important: Do not use Applicative here. Applicative somehow caused -- the right action to run many times, not sure why though. @@ -782,13 +782,13 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) = case resL of -- Note: this leads to buffering even if we are not in an -- Alternative composition. - Partial n s -> return $ Continue n (SeqAL s) - Continue n s -> return $ Continue n (SeqAL s) - Done n _ -> do + SPartial n s -> return $ SContinue n (SeqAL s) + SContinue n s -> return $ SContinue n (SeqAL s) + SDone n _ -> do initR <- initialR return $ case initR of - IPartial s -> Continue n (SeqAR s) - IDone b -> Done n b + IPartial s -> SContinue n (SeqAR s) + IDone b -> SDone n b IError err -> Error err Error err -> return $ Error err @@ -798,17 +798,17 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) = extract (SeqAL sL) = do rL <- extractL sL case rL of - Done n _ -> do + SDone n _ -> do iR <- initialR -- XXX For initial we can have a bimap with leftover. case iR of IPartial sR -> fmap (bimapOverrideCount n SeqAR id) (extractR sR) - IDone bR -> return $ Done n bR + IDone bR -> return $ SDone n bR IError err -> return $ Error err Error err -> return $ Error err - Partial _ _ -> error "split_: Partial" - Continue n s -> return $ Continue n (SeqAL s) + SPartial _ _ -> error "split_: Partial" + SContinue n s -> return $ SContinue n (SeqAL s) -- | Better performance 'split_' for non-failing parsers. -- @@ -836,20 +836,20 @@ noErrorUnsafeSplit_ IError err -> errMsg err -- Note: For the composed parse to terminate, the left parser has to be - -- a terminating parser returning a Done at some point. + -- a terminating parser returning a SDone at some point. step (SeqAL st) a = do -- Important: Please do not use Applicative here. Applicative somehow -- caused the next action to run many times in the "tar" parsing code, -- not sure why though. resL <- stepL st a case resL of - Partial n s -> return $ Partial n (SeqAL s) - Continue n s -> return $ Continue n (SeqAL s) - Done n _ -> do + SPartial n s -> return $ SPartial n (SeqAL s) + SContinue n s -> return $ SContinue n (SeqAL s) + SDone n _ -> do initR <- initialR return $ case initR of - IPartial s -> Partial n (SeqAR s) - IDone b -> Done n b + IPartial s -> SPartial n (SeqAR s) + IDone b -> SDone n b IError err -> errMsg err Error err -> errMsg err @@ -859,16 +859,16 @@ noErrorUnsafeSplit_ extract (SeqAL sL) = do rL <- extractL sL case rL of - Done n _ -> do + SDone n _ -> do iR <- initialR case iR of IPartial sR -> do fmap (bimapOverrideCount n SeqAR id) (extractR sR) - IDone bR -> return $ Done n bR + IDone bR -> return $ SDone n bR IError err -> errMsg err Error err -> errMsg err - Partial _ _ -> error "split_: Partial" - Continue n s -> return $ Continue n (SeqAL s) + SPartial _ _ -> error "split_: Partial" + SContinue n s -> return $ SContinue n (SeqAL s) -- | READ THE CAVEATS in 'splitWith' before using this instance. -- @@ -952,25 +952,25 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) = step (AltParseL cnt st) a = do r <- stepL st a case r of - Partial n s -> return $ Partial n (AltParseL 0 s) - Continue n s -> do - assertM(cnt + 1 - n >= 0) - return $ Continue n (AltParseL (cnt + 1 - n) s) - Done n b -> return $ Done n b + SPartial n s -> return $ SPartial n (AltParseL 0 s) + SContinue n s -> do + assertM(cnt + n >= 0) + return $ SContinue n (AltParseL (cnt + n) s) + SDone n b -> return $ SDone n b Error _ -> do res <- initialR return $ case res of - IPartial rR -> Continue (cnt + 1) (AltParseR rR) - IDone b -> Done (cnt + 1) b + IPartial rR -> SContinue (negate cnt) (AltParseR rR) + IDone b -> SDone (negate cnt) b IError err -> Error err step (AltParseR st) a = do r <- stepR st a return $ case r of - Partial n s -> Partial n (AltParseR s) - Continue n s -> Continue n (AltParseR s) - Done n b -> Done n b + SPartial n s -> SPartial n (AltParseR s) + SContinue n s -> SContinue n (AltParseR s) + SDone n b -> SDone n b Error err -> Error err extract (AltParseR sR) = fmap (first AltParseR) (extractR sR) @@ -978,18 +978,18 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) = extract (AltParseL cnt sL) = do rL <- extractL sL case rL of - Done n b -> return $ Done n b + SDone n b -> return $ SDone n b Error _ -> do res <- initialR return $ case res of - IPartial rR -> Continue cnt (AltParseR rR) - IDone b -> Done cnt b + IPartial rR -> SContinue (1 - cnt) (AltParseR rR) + IDone b -> SDone (1 - cnt) b IError err -> Error err - Partial _ _ -> error "Bug: alt: extractL 'Partial'" - Continue n s -> do - assertM(n == cnt) - return $ Continue n (AltParseL 0 s) + SPartial _ _ -> error "Bug: alt: extractL 'Partial'" + SContinue n s -> do + assertM(n == 1 - cnt) + return $ SContinue n (AltParseL 0 s) {-# ANN type Fused3 Fuse #-} data Fused3 a b c = Fused3 !a !b !c @@ -1030,34 +1030,34 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) = r <- step1 st a let cnt1 = cnt + 1 case r of - Partial n s -> do - assertM(cnt1 - n >= 0) - return $ Continue n (Fused3 s (cnt1 - n) fs) - Continue n s -> do - assertM(cnt1 - n >= 0) - return $ Continue n (Fused3 s (cnt1 - n) fs) - Done n b -> do - assertM(cnt1 - n >= 0) - fstep fs b >>= handleCollect (Partial n) (Done n) + SPartial n s -> do + assertM(cnt1 >= 1 - n) + return $ SContinue n (Fused3 s (cnt1 + n - 1) fs) + SContinue n s -> do + assertM(cnt1 >= 1 - n) + return $ SContinue n (Fused3 s (cnt1 + n - 1) fs) + SDone n b -> do + assertM(cnt1 >= 1 - n) + fstep fs b >>= handleCollect (SPartial n) (SDone n) Error _ -> do xs <- ffinal fs - return $ Done cnt xs + return $ SDone (1 - cnt) xs - extract (Fused3 _ 0 fs) = fmap (Done 0) (ffinal fs) + extract (Fused3 _ 0 fs) = fmap (SDone 1) (ffinal fs) extract (Fused3 s cnt fs) = do r <- extract1 s case r of - Error _ -> fmap (Done cnt) (ffinal fs) - Done n b -> do - assertM(n <= cnt) + Error _ -> fmap (SDone (1 - cnt)) (ffinal fs) + SDone n b -> do + assertM(1 - n <= cnt) fs1 <- fstep fs b case fs1 of - FL.Partial s1 -> fmap (Done n) (ffinal s1) - FL.Done b1 -> return (Done n b1) - Partial _ _ -> error "splitMany: Partial in extract" - Continue n s1 -> do - assertM(n == cnt) - return (Continue n (Fused3 s1 0 fs)) + FL.Partial s1 -> fmap (SDone n) (ffinal s1) + FL.Done b1 -> return (SDone n b1) + SPartial _ _ -> error "splitMany: SPartial in extract" + SContinue n s1 -> do + assertM(1 - n == cnt) + return (SContinue n (Fused3 s1 0 fs)) -- | Like splitMany, but inner fold emits an output at the end even if no input -- is received. @@ -1094,33 +1094,33 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) = r <- step1 st a let cnt1 = cnt + 1 case r of - Partial n s -> do - assertM(cnt1 - n >= 0) - return $ Continue n (Fused3 s (cnt1 - n) fs) - Continue n s -> do - assertM(cnt1 - n >= 0) - return $ Continue n (Fused3 s (cnt1 - n) fs) - Done n b -> do - assertM(cnt1 - n >= 0) - fstep fs b >>= handleCollect (Partial n) (Done n) + SPartial n s -> do + assertM(cnt1 >= 1 - n) + return $ SContinue n (Fused3 s (cnt1 + n - 1) fs) + SContinue n s -> do + assertM(cnt1 >= 1 - n) + return $ SContinue n (Fused3 s (cnt1 + n - 1) fs) + SDone n b -> do + assertM(cnt1 >= 1 - n) + fstep fs b >>= handleCollect (SPartial n) (SDone n) Error _ -> do xs <- ffinal fs - return $ Done cnt1 xs + return $ SDone (1 - cnt1) xs extract (Fused3 s cnt fs) = do r <- extract1 s case r of - Error _ -> fmap (Done cnt) (ffinal fs) - Done n b -> do - assertM(n <= cnt) + Error _ -> fmap (SDone (1 - cnt)) (ffinal fs) + SDone n b -> do + assertM(1 - n <= cnt) fs1 <- fstep fs b case fs1 of - FL.Partial s1 -> fmap (Done n) (ffinal s1) - FL.Done b1 -> return (Done n b1) - Partial _ _ -> error "splitMany: Partial in extract" - Continue n s1 -> do - assertM(n == cnt) - return (Continue n (Fused3 s1 0 fs)) + FL.Partial s1 -> fmap (SDone n) (ffinal s1) + FL.Done b1 -> return (SDone n b1) + SPartial _ _ -> error "splitMany: SPartial in extract" + SContinue n s1 -> do + assertM(1 - n == cnt) + return (SContinue n (Fused3 s1 0 fs)) -- | See documentation of 'Streamly.Internal.Data.Parser.some'. -- @@ -1171,59 +1171,59 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) = -- In the Left state, count is used only for the assert let cnt1 = cnt + 1 case r of - Partial n s -> do - assertM(cnt1 - n >= 0) - return $ Continue n (Fused3 s (cnt1 - n) (Left fs)) - Continue n s -> do - assertM(cnt1 - n >= 0) - return $ Continue n (Fused3 s (cnt1 - n) (Left fs)) - Done n b -> do - assertM(cnt1 - n >= 0) - fstep fs b >>= handleCollect (Partial n) (Done n) + SPartial n s -> do + assertM(cnt1 >= 1 - n) + return $ SContinue n (Fused3 s (cnt1 + n - 1) (Left fs)) + SContinue n s -> do + assertM(cnt1 >= 1 - n) + return $ SContinue n (Fused3 s (cnt1 + n - 1) (Left fs)) + SDone n b -> do + assertM(cnt1 >= 1 - n) + fstep fs b >>= handleCollect (SPartial n) (SDone n) Error err -> return $ Error err step (Fused3 st cnt (Right fs)) a = do r <- step1 st a let cnt1 = cnt + 1 case r of - Partial n s -> do - assertM(cnt1 - n >= 0) - return $ Partial n (Fused3 s (cnt1 - n) (Right fs)) - Continue n s -> do - assertM(cnt1 - n >= 0) - return $ Continue n (Fused3 s (cnt1 - n) (Right fs)) - Done n b -> do - assertM(cnt1 - n >= 0) - fstep fs b >>= handleCollect (Partial n) (Done n) - Error _ -> Done cnt1 <$> ffinal fs + SPartial n s -> do + assertM(cnt1 >= 1 - n) + return $ SPartial n (Fused3 s (cnt1 + n - 1) (Right fs)) + SContinue n s -> do + assertM(cnt1 >= 1 - n) + return $ SContinue n (Fused3 s (cnt1 + n - 1) (Right fs)) + SDone n b -> do + assertM(cnt1 >= 1 - n) + fstep fs b >>= handleCollect (SPartial n) (SDone n) + Error _ -> SDone (1 - cnt1) <$> ffinal fs extract (Fused3 s cnt (Left fs)) = do r <- extract1 s case r of Error err -> return (Error err) - Done n b -> do - assertM(n <= cnt) + SDone n b -> do + assertM(1 - n <= cnt) fs1 <- fstep fs b case fs1 of - FL.Partial s1 -> fmap (Done n) (ffinal s1) - FL.Done b1 -> return (Done n b1) - Partial _ _ -> error "splitSome: Partial in extract" - Continue n s1 -> do - assertM(n == cnt) - return (Continue n (Fused3 s1 0 (Left fs))) + FL.Partial s1 -> fmap (SDone n) (ffinal s1) + FL.Done b1 -> return (SDone n b1) + SPartial _ _ -> error "splitSome: SPartial in extract" + SContinue n s1 -> do + assertM(1 - n == cnt) + return (SContinue n (Fused3 s1 0 (Left fs))) extract (Fused3 s cnt (Right fs)) = do r <- extract1 s case r of - Error _ -> fmap (Done cnt) (ffinal fs) - Done n b -> do - assertM(n <= cnt) + Error _ -> fmap (SDone (1 - cnt)) (ffinal fs) + SDone n b -> do + assertM(1 - n <= cnt) fs1 <- fstep fs b case fs1 of - FL.Partial s1 -> fmap (Done n) (ffinal s1) - FL.Done b1 -> return (Done n b1) - Partial _ _ -> error "splitSome: Partial in extract" - Continue n s1 -> do - assertM(n == cnt) - return (Continue n (Fused3 s1 0 (Right fs))) + FL.Partial s1 -> fmap (SDone n) (ffinal s1) + FL.Done b1 -> return (SDone n b1) + SPartial _ _ -> error "splitSome: SPartial in extract" + SContinue n s1 -> do + assertM(1 - n == cnt) + return (SContinue n (Fused3 s1 0 (Right fs))) -- | A parser that always fails with an error message without consuming -- any input. @@ -1308,24 +1308,24 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract initializeRL n (Parser stepR initialR extractR) = do resR <- initialR return $ case resR of - IPartial sr -> Continue n $ ConcatParseR stepR sr extractR - IDone br -> Done n br + IPartial sr -> SContinue n $ ConcatParseR stepR sr extractR + IDone br -> SDone n br IError err -> Error err step (ConcatParseL st) a = do r <- stepL st a case r of - Partial n s -> return $ Continue n (ConcatParseL s) - Continue n s -> return $ Continue n (ConcatParseL s) - Done n b -> initializeRL n (func b) + SPartial n s -> return $ SContinue n (ConcatParseL s) + SContinue n s -> return $ SContinue n (ConcatParseL s) + SDone n b -> initializeRL n (func b) Error err -> return $ Error err step (ConcatParseR stepR st extractR) a = do r <- stepR st a return $ case r of - Partial n s -> Partial n $ ConcatParseR stepR s extractR - Continue n s -> Continue n $ ConcatParseR stepR s extractR - Done n b -> Done n b + SPartial n s -> SPartial n $ ConcatParseR stepR s extractR + SContinue n s -> SContinue n $ ConcatParseR stepR s extractR + SDone n b -> SDone n b Error err -> Error err {-# INLINE extractP #-} @@ -1336,7 +1336,7 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s) - IDone b -> return (Done n b) + IDone b -> return (SDone n b) IError err -> return $ Error err extract (ConcatParseR stepR s extractR) = @@ -1345,9 +1345,9 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract rL <- extractL sL case rL of Error err -> return $ Error err - Done n b -> extractP n $ func b - Partial _ _ -> error "concatMap: extract Partial" - Continue n s -> return $ Continue n (ConcatParseL s) + SDone n b -> extractP n $ func b + SPartial _ _ -> error "concatMap: extract Partial" + SContinue n s -> return $ SContinue n (ConcatParseL s) -- | Better performance 'concatMap' for non-failing parsers. -- @@ -1382,24 +1382,24 @@ noErrorUnsafeConcatMap func (Parser stepL initialL extractL) = initializeRL n (Parser stepR initialR extractR) = do resR <- initialR return $ case resR of - IPartial sr -> Partial n $ ConcatParseR stepR sr extractR - IDone br -> Done n br + IPartial sr -> SPartial n $ ConcatParseR stepR sr extractR + IDone br -> SDone n br IError err -> Error err step (ConcatParseL st) a = do r <- stepL st a case r of - Partial n s -> return $ Partial n (ConcatParseL s) - Continue n s -> return $ Continue n (ConcatParseL s) - Done n b -> initializeRL n (func b) + SPartial n s -> return $ SPartial n (ConcatParseL s) + SContinue n s -> return $ SContinue n (ConcatParseL s) + SDone n b -> initializeRL n (func b) Error err -> return $ Error err step (ConcatParseR stepR st extractR) a = do r <- stepR st a return $ case r of - Partial n s -> Partial n $ ConcatParseR stepR s extractR - Continue n s -> Continue n $ ConcatParseR stepR s extractR - Done n b -> Done n b + SPartial n s -> SPartial n $ ConcatParseR stepR s extractR + SContinue n s -> SContinue n $ ConcatParseR stepR s extractR + SDone n b -> SDone n b Error err -> Error err {-# INLINE extractP #-} @@ -1410,7 +1410,7 @@ noErrorUnsafeConcatMap func (Parser stepL initialL extractL) = fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s) - IDone b -> return (Done n b) + IDone b -> return (SDone n b) IError err -> return $ Error err extract (ConcatParseR stepR s extractR) = @@ -1419,9 +1419,9 @@ noErrorUnsafeConcatMap func (Parser stepL initialL extractL) = rL <- extractL sL case rL of Error err -> return $ Error err - Done n b -> extractP n $ func b - Partial _ _ -> error "concatMap: extract Partial" - Continue n s -> return $ Continue n (ConcatParseL s) + SDone n b -> extractP n $ func b + SPartial _ _ -> error "concatMap: extract Partial" + SContinue n s -> return $ SContinue n (ConcatParseL s) -- Note: The monad instance has quadratic performance complexity. It works fine -- for small number of compositions but for a scalable implementation we need a @@ -1502,7 +1502,7 @@ filter f (Parser step initial extract) = Parser step1 initial extract where - step1 x a = if f a then step x a else return $ Partial 0 x + step1 x a = if f a then step x a else return $ SPartial 1 x -- XXX move this to ParserD.Transformer From 4ce962dbcf0a4a11f1e72dffe582f2b86fee53e0 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Mon, 29 Jul 2024 23:23:15 +0530 Subject: [PATCH 05/20] Update the parser converters --- .../Streamly/Internal/Data/ParserK/Type.hs | 55 ++++++++++--------- 1 file changed, 30 insertions(+), 25 deletions(-) diff --git a/core/src/Streamly/Internal/Data/ParserK/Type.hs b/core/src/Streamly/Internal/Data/ParserK/Type.hs index 41da376ee3..34b2826a42 100644 --- a/core/src/Streamly/Internal/Data/ParserK/Type.hs +++ b/core/src/Streamly/Internal/Data/ParserK/Type.hs @@ -410,28 +410,31 @@ adaptWith pstep initial extract cont !relPos !usedCount !input = do r <- pstep pst x case r of -- Done, call the next continuation - ParserD.Done 0 b -> + ParserD.SDone 1 b -> cont (Success 1 b) (count + 1) (Chunk x) - ParserD.Done 1 b -> + ParserD.SDone 0 b -> cont (Success 0 b) count (Chunk x) - ParserD.Done n b -> -- n > 1 - cont (Success (1 - n) b) (count + 1 - n) (Chunk x) + ParserD.SDone m b -> -- n > 1 + let n = 1 - m + in cont (Success (1 - n) b) (count + 1 - n) (Chunk x) -- Not done yet, return the parseCont continuation - ParserD.Partial 0 pst1 -> + ParserD.SPartial 1 pst1 -> pure $ Partial 1 (parseCont (count + 1) pst1) - ParserD.Partial 1 pst1 -> + ParserD.SPartial 0 pst1 -> -- XXX recurse or call the driver? go SPEC pst1 - ParserD.Partial n pst1 -> -- n > 0 - pure $ Partial (1 - n) (parseCont (count + 1 - n) pst1) - ParserD.Continue 0 pst1 -> + ParserD.SPartial m pst1 -> -- n > 0 + let n = 1 - m + in pure $ Partial (1 - n) (parseCont (count + 1 - n) pst1) + ParserD.SContinue 1 pst1 -> pure $ Continue 1 (parseCont (count + 1) pst1) - ParserD.Continue 1 pst1 -> + ParserD.SContinue 0 pst1 -> -- XXX recurse or call the driver? go SPEC pst1 - ParserD.Continue n pst1 -> -- n > 0 - pure $ Continue (1 - n) (parseCont (count + 1 - n) pst1) + ParserD.SContinue m pst1 -> -- n > 0 + let n = 1 - m + in pure $ Continue (1 - n) (parseCont (count + 1 - n) pst1) -- Error case ParserD.Error err -> @@ -444,17 +447,19 @@ adaptWith pstep initial extract cont !relPos !usedCount !input = do -- IMPORTANT: the n here is from the byte stream parser, that means -- it is the backtrack element count and not the stream position -- index into the current input chunk. - ParserD.Done n b -> - assert (n >= 0) - (cont (Success (- n) b) (count - n) None) - ParserD.Continue n pst1 -> - assert (n >= 0) - (return $ Continue (- n) (parseCont (count - n) pst1)) + ParserD.SDone m b -> + let n = 1 - m + in assert (n >= 0) + (cont (Success (- n) b) (count - n) None) + ParserD.SContinue m pst1 -> + let n = 1 - m + in assert (n >= 0) + (return $ Continue (- n) (parseCont (count - n) pst1)) ParserD.Error err -> -- XXX It is called only when there is no input chunk. So using -- 0 as the position is correct? cont (Failure 0 err) count None - ParserD.Partial _ _ -> error "Bug: adaptWith Partial unreachable" + ParserD.SPartial _ _ -> error "Bug: adaptWith Partial unreachable" -- XXX Maybe we can use two separate continuations instead of using -- Just/Nothing cases here. That may help in avoiding the parseContJust @@ -503,21 +508,21 @@ toParser parser = ParserD.Parser step initial extract step cont a = do r <- cont (Chunk a) return $ case r of - Done n b -> assert (n <= 1) (ParserD.Done (1 - n) b) + Done n b -> assert (n <= 1) (ParserD.SDone n b) Error _ e -> ParserD.Error e - Partial n cont1 -> assert (n <= 1) (ParserD.Partial (1 - n) cont1) - Continue n cont1 -> assert (n <= 1) (ParserD.Continue (1 - n) cont1) + Partial n cont1 -> assert (n <= 1) (ParserD.SPartial n cont1) + Continue n cont1 -> assert (n <= 1) (ParserD.SContinue n cont1) extract cont = do r <- cont None case r of -- This is extract so no input has been given, therefore, the - -- translation here is (0 - n) rather than (1 - n). - Done n b -> assert (n <= 0) (return $ ParserD.Done (negate n) b) + -- translation here is (n + 1) rather than n. + Done n b -> assert (n <= 0) (return $ ParserD.SDone (n + 1) b) Error _ e -> return $ ParserD.Error e Partial _ cont1 -> extract cont1 Continue n cont1 -> - assert (n <= 0) (return $ ParserD.Continue (negate n) cont1) + assert (n <= 0) (return $ ParserD.SContinue (n + 1) cont1) {-# RULES "fromParser/toParser fusion" [2] forall s. toParser (parserK s) = s #-} From d9401a2115b825303cb354eaba3f75f0bb42c1c2 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Mon, 29 Jul 2024 23:19:51 +0530 Subject: [PATCH 06/20] Ignore warnings in deprecated modules --- core/src/Streamly/Internal/Data/Array/Stream.hs | 1 + core/src/Streamly/Internal/Data/Fold/Chunked.hs | 3 +++ 2 files changed, 4 insertions(+) diff --git a/core/src/Streamly/Internal/Data/Array/Stream.hs b/core/src/Streamly/Internal/Data/Array/Stream.hs index 6d22f61915..b36fae5a7b 100644 --- a/core/src/Streamly/Internal/Data/Array/Stream.hs +++ b/core/src/Streamly/Internal/Data/Array/Stream.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} -- | -- Module : Streamly.Internal.Data.Array.Stream -- Copyright : (c) 2019 Composewell Technologies diff --git a/core/src/Streamly/Internal/Data/Fold/Chunked.hs b/core/src/Streamly/Internal/Data/Fold/Chunked.hs index 541a2d41e4..a0e140ac1a 100644 --- a/core/src/Streamly/Internal/Data/Fold/Chunked.hs +++ b/core/src/Streamly/Internal/Data/Fold/Chunked.hs @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + -- | -- Module : Streamly.Internal.Data.Fold.Chunked -- Copyright : (c) 2021 Composewell Technologies From 642df1bba49c474c732a56bcd52f78e8a0542e3c Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Mon, 4 Nov 2024 20:00:02 +0530 Subject: [PATCH 07/20] Update the parser driver sanity tests --- test/lib/Streamly/Test/Parser/Common.hs | 78 ++++++++++++------------- 1 file changed, 39 insertions(+), 39 deletions(-) diff --git a/test/lib/Streamly/Test/Parser/Common.hs b/test/lib/Streamly/Test/Parser/Common.hs index 60713eeea9..3fd91dab0d 100644 --- a/test/lib/Streamly/Test/Parser/Common.hs +++ b/test/lib/Streamly/Test/Parser/Common.hs @@ -32,25 +32,25 @@ jumpParser jumps = P.Parser step initial done where initial = pure $ P.IPartial (jumps, []) - step ([], buf) _ = pure $ P.Done 1 (reverse buf) + step ([], buf) _ = pure $ P.SDone 0 (reverse buf) step (action:xs, buf) a = case action of Consume n - | n == 1 -> pure $ P.Continue 0 (xs, a:buf) - | n > 0 -> pure $ P.Continue 0 (Consume (n - 1) : xs, a:buf) + | n == 1 -> pure $ P.SContinue 1 (xs, a:buf) + | n > 0 -> pure $ P.SContinue 1 (Consume (n - 1) : xs, a:buf) | otherwise -> error "Cannot consume <= 0" - Custom (P.Partial i ()) -> pure $ P.Partial i (xs, buf) - Custom (P.Continue i ()) -> pure $ P.Continue i (xs, buf) - Custom (P.Done i ()) -> pure $ P.Done i (reverse buf) + Custom (P.SPartial i ()) -> pure $ P.SPartial i (xs, buf) + Custom (P.SContinue i ()) -> pure $ P.SContinue i (xs, buf) + Custom (P.SDone i ()) -> pure $ P.SDone i (reverse buf) Custom (P.Error err) -> pure $ P.Error err - done ([], buf) = pure $ P.Done 0 (reverse buf) + done ([], buf) = pure $ P.SDone 1 (reverse buf) done (action:xs, buf) = case action of Consume _ -> pure $ P.Error "INCOMPLETE" - Custom (P.Partial i ()) -> pure $ P.Partial i (xs, buf) - Custom (P.Continue i ()) -> pure $ P.Continue i (xs, buf) - Custom (P.Done i ()) -> pure $ P.Done i (reverse buf) + Custom (P.SPartial i ()) -> pure $ P.SPartial i (xs, buf) + Custom (P.SContinue i ()) -> pure $ P.SContinue i (xs, buf) + Custom (P.SDone i ()) -> pure $ P.SDone i (reverse buf) Custom (P.Error err) -> pure $ P.Error err chunkedTape :: [[Int]] @@ -83,15 +83,15 @@ expectedResult moves inp = go 0 0 [] moves -- Where there is no input we do not move forward by default. -- Hence it is (i - n) and not (i + 1 - n) case step of - P.Partial n () -> go (i - n) (max j (i - n)) ys xs - P.Continue n () -> go (i - n) j ys xs - P.Done n () -> (Right ys, slice_ (max (i - n) j) inp) + P.SPartial n () -> go (i + n - 1) (max j (i + n - 1)) ys xs + P.SContinue n () -> go (i + n - 1) j ys xs + P.SDone n () -> (Right ys, slice_ (max (i + n - 1) j) inp) P.Error err -> (Left (ParseError err), slice_ j inp) | otherwise = case step of - P.Partial n () -> go (i + 1 - n) (max j (i + 1 - n)) ys xs - P.Continue n () -> go (i + 1 - n) j ys xs - P.Done n () -> (Right ys, slice_ (max (i - n + 1) j) inp) + P.SPartial n () -> go (i + n) (max j (i + n)) ys xs + P.SContinue n () -> go (i + n) j ys xs + P.SDone n () -> (Right ys, slice_ (max (i + n) j) inp) P.Error err -> (Left (ParseError err), slice_ j inp) expectedResultMany :: [Move] -> [Int] -> [Either ParseError [Int]] @@ -121,62 +121,62 @@ parserSanityTests desc testRunner = Prelude.mapM_ testRunner $ createPaths [ Consume 10 - , Custom (P.Partial 0 ()) + , Custom (P.SPartial 1 ()) , Consume 10 - , Custom (P.Partial 1 ()) + , Custom (P.SPartial 0 ()) , Consume 10 - , Custom (P.Partial 11 ()) + , Custom (P.SPartial (-10) ()) , Consume 10 - , Custom (P.Continue 0 ()) + , Custom (P.SContinue 1 ()) , Consume 10 - , Custom (P.Continue 1 ()) + , Custom (P.SContinue 0 ()) , Consume 10 - , Custom (P.Continue 11 ()) + , Custom (P.SContinue (-10) ()) , Custom (P.Error "Message1") ] Prelude.mapM_ testRunner $ createPaths [ Consume 10 - , Custom (P.Continue 0 ()) + , Custom (P.SContinue 1 ()) , Consume 10 - , Custom (P.Continue 1 ()) + , Custom (P.SContinue 0 ()) , Consume 10 - , Custom (P.Continue 11 ()) + , Custom (P.SContinue (-10) ()) , Consume 10 - , Custom (P.Done 0 ()) + , Custom (P.SDone 1 ()) ] Prelude.mapM_ testRunner $ createPaths [ Consume 20 - , Custom (P.Continue 0 ()) - , Custom (P.Continue 11 ()) - , Custom (P.Done 1 ()) + , Custom (P.SContinue 1 ()) + , Custom (P.SContinue (-10) ()) + , Custom (P.SDone 0 ()) ] Prelude.mapM_ testRunner $ createPaths [ Consume 20 - , Custom (P.Continue 0 ()) - , Custom (P.Continue 11 ()) + , Custom (P.SContinue 1 ()) + , Custom (P.SContinue (-10) ()) , Custom (P.Error "Message2") ] Prelude.mapM_ testRunner $ createPaths [ Consume 20 - , Custom (P.Continue 0 ()) - , Custom (P.Continue 11 ()) - , Custom (P.Done 5 ()) + , Custom (P.SContinue 1 ()) + , Custom (P.SContinue (-10) ()) + , Custom (P.SDone (-4) ()) ] Prelude.mapM_ testRunner $ createPaths [ Consume tapeLen - , Custom (P.Continue 0 ()) - , Custom (P.Continue 10 ()) - , Custom (P.Done 5 ()) + , Custom (P.SContinue 1 ()) + , Custom (P.SContinue (-9) ()) + , Custom (P.SDone (-4) ()) ] Prelude.mapM_ testRunner $ createPaths [ Consume tapeLen - , Custom (P.Continue 0 ()) - , Custom (P.Continue 10 ()) + , Custom (P.SContinue 1 ()) + , Custom (P.SContinue (-9) ()) , Custom (P.Error "Message3") ] From 6b4ca5ac869193f369fd84e25651b04d11dacc20 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Mon, 4 Nov 2024 20:04:04 +0530 Subject: [PATCH 08/20] Deprecate Partial, Continue, and Done patterns --- core/src/Streamly/Internal/Data/Parser/Type.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index d52e2e5401..9fe17cb659 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -366,14 +366,17 @@ negateDirection (SContinue i s) = SContinue (1 - i) s negateDirection (SDone i b) = SDone (1 - i) b negateDirection (Error s) = Error s +{-# DEPRECATED Partial "Please use @SPartial (1 - n)@ instead of @Partial n@" #-} pattern Partial :: Int -> s -> Step s b pattern Partial i s <- (negateDirection -> SPartial i s) where Partial i s = SPartial (1 - i) s +{-# DEPRECATED Continue "Please use @SContinue (1 - n)@ instead of @Continue n@" #-} pattern Continue :: Int -> s -> Step s b pattern Continue i s <- (negateDirection -> SContinue i s) where Continue i s = SContinue (1 - i) s +{-# DEPRECATED Done "Please use @SDone (1 - n)@ instead of @Done n@" #-} pattern Done :: Int -> b -> Step s b pattern Done i b <- (negateDirection -> SDone i b) where Done i b = SDone (1 - i) b From a1b37e01ea2f8f8ca935228fb5fa3541e96fe512 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sat, 24 May 2025 02:48:34 +0530 Subject: [PATCH 09/20] Merge adaptC and adaptCG --- core/src/Streamly/Internal/Data/Array.hs | 43 +++++++++++-------- .../Streamly/Internal/Data/Array/Generic.hs | 43 +++++++++++-------- 2 files changed, 48 insertions(+), 38 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index 97924c0312..3a8836f9f0 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -1218,24 +1218,27 @@ adaptCWith pstep initial extract cont !offset0 !usedCount !input = do -- The "n" here is stream position index wrt the array start, and -- not the backtrack count as returned by byte stream parsers. case pRes of - ParserD.Done 0 b -> + ParserD.SDone 1 b -> onDone nextOff b - ParserD.Done 1 b -> + ParserD.SDone 0 b -> onDone curOff b - ParserD.Done n b -> - onDone ((back n - start) `div` elemSize) b - ParserD.Partial 0 pst1 -> + ParserD.SDone m b -> + let n = 1 - m + in onDone ((back n - start) `div` elemSize) b + ParserD.SPartial 1 pst1 -> go SPEC next pst1 - ParserD.Partial 1 pst1 -> + ParserD.SPartial 0 pst1 -> go SPEC cur pst1 - ParserD.Partial n pst1 -> - onBack (back n) elemSize onPartial pst1 - ParserD.Continue 0 pst1 -> + ParserD.SPartial m pst1 -> + let n = 1 - m + in onBack (back n) elemSize onPartial pst1 + ParserD.SContinue 1 pst1 -> go SPEC next pst1 - ParserD.Continue 1 pst1 -> + ParserD.SContinue 0 pst1 -> go SPEC cur pst1 - ParserD.Continue n pst1 -> - onBack (back n) elemSize onContinue pst1 + ParserD.SContinue m pst1 -> + let n = 1 - m + in onBack (back n) elemSize onContinue pst1 ParserD.Error err -> onError curOff err @@ -1246,17 +1249,19 @@ adaptCWith pstep initial extract cont !offset0 !usedCount !input = do -- IMPORTANT: the n here is from the byte stream parser, that means -- it is the backtrack element count and not the stream position -- index into the current input array. - ParserD.Done n b -> - assert (n >= 0) - (cont (Success (- n) b) (count - n) None) - ParserD.Continue n pst1 -> - assert (n >= 0) - (return $ Continue (- n) (parseCont (count - n) pst1)) + ParserD.SDone m b -> + let n = 1 - m + in assert (n >= 0) + (cont (Success (- n) b) (count - n) None) + ParserD.SContinue m pst1 -> + let n = 1 - m + in assert (n >= 0) + (return $ Continue (- n) (parseCont (count - n) pst1)) ParserD.Error err -> -- XXX It is called only when there is no input arr. So using 0 -- as the position is correct? cont (Failure 0 err) count None - ParserD.Partial _ _ -> error "Bug: adaptCWith Partial unreachable" + ParserD.SPartial _ _ -> error "Bug: adaptCWith Partial unreachable" -- XXX Maybe we can use two separate continuations instead of using -- Just/Nothing cases here. That may help in avoiding the parseContJust diff --git a/core/src/Streamly/Internal/Data/Array/Generic.hs b/core/src/Streamly/Internal/Data/Array/Generic.hs index c0c4c5a31f..0b61db2c08 100644 --- a/core/src/Streamly/Internal/Data/Array/Generic.hs +++ b/core/src/Streamly/Internal/Data/Array/Generic.hs @@ -603,24 +603,27 @@ adaptCGWith pstep initial extract cont !offset0 !usedCount !input = do -- The "n" here is stream position index wrt the array start, and -- not the backtrack count as returned by byte stream parsers. case pRes of - ParserD.Done 0 b -> + ParserD.SDone 1 b -> onDone nextOff b - ParserD.Done 1 b -> + ParserD.SDone 0 b -> onDone curOff b - ParserD.Done n b -> - onDone (back n - start) b - ParserD.Partial 0 pst1 -> + ParserD.SDone m b -> + let n = 1 - m + in onDone (back n - start) b + ParserD.SPartial 1 pst1 -> go SPEC next pst1 - ParserD.Partial 1 pst1 -> + ParserD.SPartial 0 pst1 -> go SPEC cur pst1 - ParserD.Partial n pst1 -> - onBack (back n) onPartial pst1 - ParserD.Continue 0 pst1 -> + ParserD.SPartial m pst1 -> + let n = 1 - m + in onBack (back n) onPartial pst1 + ParserD.SContinue 1 pst1 -> go SPEC next pst1 - ParserD.Continue 1 pst1 -> + ParserD.SContinue 0 pst1 -> go SPEC cur pst1 - ParserD.Continue n pst1 -> - onBack (back n) onContinue pst1 + ParserD.SContinue m pst1 -> + let n = 1 - m + in onBack (back n) onContinue pst1 ParserD.Error err -> onError curOff err @@ -631,17 +634,19 @@ adaptCGWith pstep initial extract cont !offset0 !usedCount !input = do -- IMPORTANT: the n here is from the byte stream parser, that means -- it is the backtrack element count and not the stream position -- index into the current input array. - ParserD.Done n b -> - assert (n >= 0) - (cont (Success (- n) b) (count - n) None) - ParserD.Continue n pst1 -> - assert (n >= 0) - (return $ Continue (- n) (parseCont (count - n) pst1)) + ParserD.SDone m b -> + let n = 1 - m + in assert (n >= 0) + (cont (Success (- n) b) (count - n) None) + ParserD.SContinue m pst1 -> + let n = 1 - m + in assert (n >= 0) + (return $ Continue (- n) (parseCont (count - n) pst1)) ParserD.Error err -> -- XXX It is called only when there is no input arr. So using 0 -- as the position is correct? cont (Failure 0 err) count None - ParserD.Partial _ _ -> error "Bug: adaptCGWith Partial unreachable" + ParserD.SPartial _ _ -> error "Bug: adaptCGWith Partial unreachable" {-# INLINE parseCont #-} parseCont !cnt !pst (Chunk arr) = parseContChunk cnt 0 pst arr From 2851959abc2e7a5431462f67dd34f40ffe030ba3 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Tue, 12 Nov 2024 22:34:51 +0530 Subject: [PATCH 10/20] Fix deprecations in the benchmarks --- benchmark/Streamly/Benchmark/Data/ParserK.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/ParserK.hs b/benchmark/Streamly/Benchmark/Data/ParserK.hs index 68b99caab1..de636b76d3 100644 --- a/benchmark/Streamly/Benchmark/Data/ParserK.hs +++ b/benchmark/Streamly/Benchmark/Data/ParserK.hs @@ -234,11 +234,11 @@ takeWhileFailD predicate (Fold fstep finitial _ ffinal) = fres <- fstep s a return $ case fres of - Fold.Partial s1 -> Partial 0 s1 - Fold.Done b -> Done 0 b + Fold.Partial s1 -> SPartial 1 s1 + Fold.Done b -> SDone 1 b else return $ Error "fail" - extract s = fmap (Done 0) (ffinal s) + extract s = fmap (SDone 1) (ffinal s) {-# INLINE takeWhileFail #-} takeWhileFail :: CONSTRAINT => From e8d6b988d2625ee1c3c3149b4c05672629f146df Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Thu, 14 Nov 2024 01:57:22 +0530 Subject: [PATCH 11/20] Update changelog --- core/docs/Changelog.md | 5 +++++ docs/User/Project/Changelog.md | 1 + 2 files changed, 6 insertions(+) diff --git a/core/docs/Changelog.md b/core/docs/Changelog.md index c9cdeab162..4e5137f06a 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -7,6 +7,11 @@ ### Enhancements * Add several concurrent combinators for folds in `Streamly.Data.Fold.Prelude`. +* In the `Streamly.Data.Parser` module, the constructors `Partial n`, + `Continue n`, `Done n` have been changed to `SPartial (1-n)`, `SContinue + (1-n)` and `SDone (1-n)`. The semantics of the constructor argument + has changed, the argument can now be positive or negative and it now + means the relative change in the current position of the stream. * Split the `Fold` type in two, `Fold` and `Scanl`. `Streamly.Data.Scanl` module is added for the new `Scanl` type. * Add `Streamly.FileSystem.DirIO` and `Streamly.FileSystem.FileIO` diff --git a/docs/User/Project/Changelog.md b/docs/User/Project/Changelog.md index f2315b7af7..87ea88965f 100644 --- a/docs/User/Project/Changelog.md +++ b/docs/User/Project/Changelog.md @@ -4,6 +4,7 @@ ## Unreleased +* Add several concurrent combinators for folds in `Streamly.Data.Fold.Prelude`. * Fix rate control for ordered streams. ## 0.10.1 (Jan 2024) From a0997fd4efbe643d9f22580dbd01e9463dc8aae4 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Thu, 14 Nov 2024 05:17:45 +0530 Subject: [PATCH 12/20] Update docs --- .../src/Streamly/Internal/Data/Parser/Type.hs | 79 ++++++++++--------- 1 file changed, 41 insertions(+), 38 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index 9fe17cb659..5aedff4c79 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -296,58 +296,61 @@ instance Functor (Initial s) where -- | The return type of a 'Parser' step. -- --- The parse operation feeds the input stream to the parser one element at a --- time, representing a parse 'Step'. The parser may or may not consume the --- item and returns a result. If the result is 'Partial' we can either extract --- the result or feed more input to the parser. If the result is 'Continue', we --- must feed more input in order to get a result. If the parser returns 'Done' --- then the parser can no longer take any more input. --- --- If the result is 'Continue', the parse operation retains the input in a --- backtracking buffer, in case the parser may ask to backtrack in future. --- Whenever a 'Partial n' result is returned we first backtrack by @n@ elements --- in the input and then release any remaining backtracking buffer. Similarly, --- 'Continue n' backtracks to @n@ elements before the current position and --- starts feeding the input from that point for future invocations of the --- parser. +-- The parser driver feeds the input stream to the parser one element at a +-- time, representing a parse 'Step'. If the step result is 'SPartial' then a +-- parse result is available, we can extract the result and feed more input to +-- the parser. If the result is 'SContinue', we must feed more input in order +-- to get a result. If the parser returns 'SDone' then the parser can no longer +-- take any more input. +-- +-- The first argument of `SPartial`, `Scontinue` and `SDone` is an integer +-- representing adjustment to the current stream position. The stream position +-- is adjusted by that amount and the next step would use an input from the new +-- position. If n is positive we go forward in the stream, if it is negative we +-- go backward. If it is 0 we stay put at the same position and the same input +-- is used for the next step. +-- +-- If the result is 'SContinue', the parser driver retains the input in a +-- backtracking buffer, in case of failure the parser can backtrack up to the +-- length of the backtracking buffer. Whenever the result is `SPartial` the +-- current backtracking buffer is released i.e. we cannot backtrack beyond this +-- point in the stream. The parser must ensure that the backtrack position is +-- always within the bounds of the backtracking buffer. -- -- If parser is not yet done, we can use the @extract@ operation on the @state@ -- of the parser to extract a result. If the parser has not yet yielded a --- result, the operation fails with a 'ParseError' exception. If the parser --- yielded a 'Partial' result in the past the last partial result is returned. +-- result, @extract@ fails with a 'ParseError' exception. If the parser yielded +-- a 'Partial' result in the past then the latest partial result is returned. -- Therefore, if a parser yields a partial result once it cannot fail later on. -- --- The parser can never backtrack beyond the position where the last partial --- result left it at. The parser must ensure that the backtrack position is --- always after that. --- -- /Pre-release/ -- {-# ANN type Step Fuse #-} data Step s b = SPartial !Int !s - -- ^ @Partial count state@. The following hold on Partial result: + -- ^ @SPartial count state@. The following statements hold on an SPartial + -- result: -- -- 1. @extract@ on @state@ would succeed and give a result. - -- 2. Input stream position is reset to @current position - count@. - -- 3. All input before the new position is dropped. The parser can - -- never backtrack beyond this position. + -- 2. Input stream position is updated to @current position + count@. + -- 3. All buffered input before the new position is dropped. The parser can + -- never backtrack before this position. | SContinue !Int !s - -- ^ @Continue count state@. The following hold on a Continue result: + -- ^ @SContinue count state@. The following statements hold on an SContinue + -- result: -- - -- 1. If there was a 'Partial' result in past, @extract@ on @state@ would - -- give that result as 'Done' otherwise it may return 'Error' or - -- 'Continue'. - -- 2. Input stream position is reset to @current position - count@. - -- 3. the input is retained in a backtrack buffer. + -- 1. If 'SPartial' result was returned in the past, @extract@ on @state@ + -- would give that result otherwise it will return 'Error' or 'SContinue'. + -- 2. Input stream position is updated to @current position + count@. + -- 3. the previous input is retained in a backtrack buffer. | SDone !Int !b -- ^ Done with leftover input count and result. -- - -- @Done count result@ means the parser has finished, it will accept no - -- more input, last @count@ elements from the input are unused and the - -- result of the parser is in @result@. + -- @SDone count result@ means the parser has finished, it will not accept + -- any more input, the final stream position must be set to @current + -- position + count@ and the result of the parser is in @result@. | Error !String -- ^ Parser failed without generating any output. @@ -456,12 +459,12 @@ mapMStep f res = data Parser a m b = forall s. Parser (s -> a -> m (Step s b)) - -- Initial cannot return "Partial/Done n" or "Continue". Continue 0 is - -- same as Partial 0. In other words it cannot backtrack. + -- Initial cannot backtrack. (m (Initial s b)) - -- Extract can only return Partial or Continue n. In other words it can - -- only backtrack or return partial result/error. But we do not return - -- result in Partial, therefore, we have to use Done instead of Partial. + -- Extract can only return SPartial or SContinue n. In other words it + -- can only backtrack or return partial result/error. But we do not + -- return result in SPartial, therefore, we have to use SDone instead of + -- SPartial. (s -> m (Step s b)) {- From cf177a7eaca4215746cb56bce85b00aa5ce6c2f5 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Thu, 14 Nov 2024 20:35:29 +0530 Subject: [PATCH 13/20] Add some asserts and comments --- core/src/Streamly/Internal/Data/Array.hs | 8 ++++++++ core/src/Streamly/Internal/Data/Parser/Type.hs | 5 +++++ 2 files changed, 13 insertions(+) diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index 3a8836f9f0..c576c7573e 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -894,6 +894,7 @@ parseBreakChunksK (Parser pstep initial extract) stream = do Parser.SPartial 1 s -> goArray s [] st (Array contents next end) Parser.SPartial m s -> do + assertM(m <= 1) let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let src0 = Prelude.take n (x:backBuf) @@ -904,6 +905,7 @@ parseBreakChunksK (Parser pstep initial extract) stream = do Parser.SContinue 1 s -> goArray s (x:backBuf) st (Array contents next end) Parser.SContinue m s -> do + assertM(m <= 1) let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let (src0, buf1) = Prelude.splitAt n (x:backBuf) @@ -915,6 +917,7 @@ parseBreakChunksK (Parser pstep initial extract) stream = do let arr = Array contents next end return (Right b, StreamK.cons arr st) Parser.SDone m b -> do + assertM(m <= 1) let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let src0 = Prelude.take n (x:backBuf) @@ -942,6 +945,7 @@ parseBreakChunksK (Parser pstep initial extract) stream = do Parser.SPartial 1 s -> goExtract s [] (Array contents next end) Parser.SPartial m s -> do + assertM(m <= 1) let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let src0 = Prelude.take n (x:backBuf) @@ -952,6 +956,7 @@ parseBreakChunksK (Parser pstep initial extract) stream = do Parser.SContinue 1 s -> goExtract s backBuf (Array contents next end) Parser.SContinue m s -> do + assertM(m <= 1) let n = 1 - m assert (n <= Prelude.length (x:backBuf)) (return ()) let (src0, buf1) = Prelude.splitAt n (x:backBuf) @@ -963,6 +968,7 @@ parseBreakChunksK (Parser pstep initial extract) stream = do let arr = Array contents next end return (Right b, StreamK.fromPure arr) Parser.SDone m b -> do + assertM(m <= 1) let n = 1 - m assert (n <= Prelude.length backBuf) (return ()) let src0 = Prelude.take n (x:backBuf) @@ -988,6 +994,7 @@ parseBreakChunksK (Parser pstep initial extract) stream = do Parser.SContinue 1 s -> goStop s backBuf Parser.SContinue m s -> do + assertM(m <= 1) let n = 1 - m assert (n <= Prelude.length backBuf) (return ()) let (src0, buf1) = Prelude.splitAt n backBuf @@ -996,6 +1003,7 @@ parseBreakChunksK (Parser pstep initial extract) stream = do Parser.SDone 1 b -> return (Right b, StreamK.nil) Parser.SDone m b -> do + assertM(m <= 1) let n = 1 - m assert (n <= Prelude.length backBuf) (return ()) let src0 = Prelude.take n backBuf diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index 5aedff4c79..41d182fe24 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -294,6 +294,11 @@ instance Functor (Initial s) where -- -- Folds can only return the right values. Parsers can also return lefts. +-- XXX If we assume that the current position of the stream includes the +-- element being processed then we can use 'SPartial 0' in the common cases, no +-- change from current, and the change required would be just inverting the +-- sign of the arguments. + -- | The return type of a 'Parser' step. -- -- The parser driver feeds the input stream to the parser one element at a From 2748dcb8663fa25ffdd51edc6fb631334a8cc3b3 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sat, 24 May 2025 06:27:12 +0530 Subject: [PATCH 14/20] Fix benchmark deprecation warnings --- benchmark/Streamly/Benchmark/Data/Parser.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Parser.hs b/benchmark/Streamly/Benchmark/Data/Parser.hs index 4039917977..5fe3da53eb 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser.hs @@ -364,11 +364,11 @@ takeWhileFail predicate (Fold fstep finitial _ ffinal) = fres <- fstep s a return $ case fres of - Fold.Partial s1 -> Partial 0 s1 - Fold.Done b -> Done 0 b + Fold.Partial s1 -> SPartial 1 s1 + Fold.Done b -> SDone 1 b else return $ Error "fail" - extract s = fmap (Done 0) (ffinal s) + extract s = fmap (SDone 1) (ffinal s) {-# INLINE alt2 #-} alt2 :: Monad m From be2e0408db3bfe348c15044e7a4c3f8f46766e27 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Sat, 24 May 2025 20:03:30 +0530 Subject: [PATCH 15/20] Simplify the driver processing --- core/src/Streamly/Internal/Data/Array.hs | 30 ++++++-------- .../Streamly/Internal/Data/Array/Generic.hs | 40 +++++++++---------- 2 files changed, 32 insertions(+), 38 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index c576c7573e..77865ab9d0 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -1220,7 +1220,7 @@ adaptCWith pstep initial extract cont !offset0 !usedCount !input = do pRes <- pstep pst x let elemSize = SIZE_OF(a) next = INDEX_NEXT(cur,a) - back n = next - n * elemSize + move n = cur + n * elemSize curOff = (cur - start) `div` elemSize nextOff = (next - start) `div` elemSize -- The "n" here is stream position index wrt the array start, and @@ -1230,23 +1230,20 @@ adaptCWith pstep initial extract cont !offset0 !usedCount !input = do onDone nextOff b ParserD.SDone 0 b -> onDone curOff b - ParserD.SDone m b -> - let n = 1 - m - in onDone ((back n - start) `div` elemSize) b + ParserD.SDone n b -> + onDone ((move n - start) `div` elemSize) b ParserD.SPartial 1 pst1 -> go SPEC next pst1 ParserD.SPartial 0 pst1 -> go SPEC cur pst1 - ParserD.SPartial m pst1 -> - let n = 1 - m - in onBack (back n) elemSize onPartial pst1 + ParserD.SPartial n pst1 -> + onBack (move n) elemSize onPartial pst1 ParserD.SContinue 1 pst1 -> go SPEC next pst1 ParserD.SContinue 0 pst1 -> go SPEC cur pst1 - ParserD.SContinue m pst1 -> - let n = 1 - m - in onBack (back n) elemSize onContinue pst1 + ParserD.SContinue n pst1 -> + onBack (move n) elemSize onContinue pst1 ParserD.Error err -> onError curOff err @@ -1257,14 +1254,11 @@ adaptCWith pstep initial extract cont !offset0 !usedCount !input = do -- IMPORTANT: the n here is from the byte stream parser, that means -- it is the backtrack element count and not the stream position -- index into the current input array. - ParserD.SDone m b -> - let n = 1 - m - in assert (n >= 0) - (cont (Success (- n) b) (count - n) None) - ParserD.SContinue m pst1 -> - let n = 1 - m - in assert (n >= 0) - (return $ Continue (- n) (parseCont (count - n) pst1)) + ParserD.SDone n b -> + assert (n <= 1) (cont (Success (n - 1) b) (count + n - 1) None) + ParserD.SContinue n pst1 -> + assert (n <= 1) + (return $ Continue (n - 1) (parseCont (count + n - 1) pst1)) ParserD.Error err -> -- XXX It is called only when there is no input arr. So using 0 -- as the position is correct? diff --git a/core/src/Streamly/Internal/Data/Array/Generic.hs b/core/src/Streamly/Internal/Data/Array/Generic.hs index 0b61db2c08..bc4f903ff1 100644 --- a/core/src/Streamly/Internal/Data/Array/Generic.hs +++ b/core/src/Streamly/Internal/Data/Array/Generic.hs @@ -597,33 +597,32 @@ adaptCGWith pstep initial extract cont !offset0 !usedCount !input = do let !x = unsafeInlineIO $ MArray.unsafeGetIndexWith contents cur pRes <- pstep pst x let next = cur + 1 - back n = next - n + -- XXX Change this to moveOff and remove curOff and nextOff + move n = cur + n curOff = cur - start nextOff = next - start - -- The "n" here is stream position index wrt the array start, and - -- not the backtrack count as returned by byte stream parsers. + -- The "n" here is how many items have been consumed by the parser + -- from the array i.e. which is the same as the stream position + -- index wrt the array start. case pRes of ParserD.SDone 1 b -> onDone nextOff b ParserD.SDone 0 b -> onDone curOff b - ParserD.SDone m b -> - let n = 1 - m - in onDone (back n - start) b + ParserD.SDone n b -> + onDone (move n - start) b ParserD.SPartial 1 pst1 -> go SPEC next pst1 ParserD.SPartial 0 pst1 -> go SPEC cur pst1 - ParserD.SPartial m pst1 -> - let n = 1 - m - in onBack (back n) onPartial pst1 + ParserD.SPartial n pst1 -> + onBack (move n) onPartial pst1 ParserD.SContinue 1 pst1 -> go SPEC next pst1 ParserD.SContinue 0 pst1 -> go SPEC cur pst1 - ParserD.SContinue m pst1 -> - let n = 1 - m - in onBack (back n) onContinue pst1 + ParserD.SContinue n pst1 -> + onBack (move n) onContinue pst1 ParserD.Error err -> onError curOff err @@ -634,14 +633,15 @@ adaptCGWith pstep initial extract cont !offset0 !usedCount !input = do -- IMPORTANT: the n here is from the byte stream parser, that means -- it is the backtrack element count and not the stream position -- index into the current input array. - ParserD.SDone m b -> - let n = 1 - m - in assert (n >= 0) - (cont (Success (- n) b) (count - n) None) - ParserD.SContinue m pst1 -> - let n = 1 - m - in assert (n >= 0) - (return $ Continue (- n) (parseCont (count - n) pst1)) + -- XXX in extract we do not supply any input. So 0 means stay put. + -- So extract will usually be different than step, because step has + -- an input it would usually return Done 1, and extract would + -- always be Done 0. + ParserD.SDone n b -> + assert (n <= 1) (cont (Success (n - 1) b) (count + n - 1) None) + ParserD.SContinue n pst1 -> + assert (n <= 1) + (return $ Continue (n - 1) (parseCont (count + n - 1) pst1)) ParserD.Error err -> -- XXX It is called only when there is no input arr. So using 0 -- as the position is correct? From 510d4e95fedb752c40165b82fcbb6b668278a3fc Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 28 May 2025 00:10:44 +0530 Subject: [PATCH 16/20] Fix the semantics of extract function --- .../Streamly/Benchmark/Data/Array/Stream.hs | 6 +- benchmark/Streamly/Benchmark/Data/Parser.hs | 2 +- benchmark/Streamly/Benchmark/Data/ParserK.hs | 2 +- core/docs/Changelog.md | 20 +- core/src/Streamly/Internal/Data/Array.hs | 88 +++--- .../Streamly/Internal/Data/Array/Generic.hs | 59 ++-- .../Streamly/Internal/Data/Array/Stream.hs | 3 +- .../Streamly/Internal/Data/MutArray/Type.hs | 4 +- core/src/Streamly/Internal/Data/Parser.hs | 270 +++++++++--------- .../src/Streamly/Internal/Data/Parser/Type.hs | 157 +++++----- .../Streamly/Internal/Data/ParserK/Type.hs | 31 +- .../Streamly/Internal/Data/Producer/Source.hs | 18 +- .../Internal/Data/Stream/Eliminate.hs | 30 +- .../Streamly/Internal/Data/Stream/Nesting.hs | 27 +- .../src/Streamly/Internal/Data/Stream/Type.hs | 43 ++- core/src/Streamly/Internal/Data/StreamK.hs | 61 ++-- core/src/Streamly/Internal/Unicode/Parser.hs | 24 +- core/src/Streamly/Internal/Unicode/Stream.hs | 2 +- test/Streamly/Test/Data/Array/Stream.hs | 2 +- test/Streamly/Test/Data/Parser.hs | 12 +- test/Streamly/Test/Data/ParserK.hs | 1 + test/lib/Streamly/Test/Parser/Common.hs | 17 +- 22 files changed, 484 insertions(+), 395 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs index d05f60d81a..af3b36b01c 100644 --- a/benchmark/Streamly/Benchmark/Data/Array/Stream.hs +++ b/benchmark/Streamly/Benchmark/Data/Array/Stream.hs @@ -239,7 +239,9 @@ fold s = void $ Array.foldBreak Fold.drain $ StreamK.fromStream s {-# INLINE parse #-} parse :: Int -> Stream IO (Array.Array Int) -> IO () parse value s = - void $ Array.parseBreakChunksK (drainWhile (< value)) $ StreamK.fromStream s + void $ Array.parseBreak + (Array.parserK (drainWhile (< value))) + (StreamK.fromStream s) {-# INLINE foldBreak #-} foldBreak :: StreamK IO (Array.Array Int) -> IO () @@ -250,7 +252,7 @@ foldBreak s = do {-# INLINE parseBreak #-} parseBreak :: StreamK IO (Array.Array Int) -> IO () parseBreak s = do - r <- Array.parseBreakChunksK Parser.one s + r <- Array.parseBreak (Array.parserK Parser.one) s case r of (Left _, _) -> return () (Right _, s1) -> parseBreak s1 diff --git a/benchmark/Streamly/Benchmark/Data/Parser.hs b/benchmark/Streamly/Benchmark/Data/Parser.hs index 5fe3da53eb..3e18d1d02e 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser.hs @@ -368,7 +368,7 @@ takeWhileFail predicate (Fold fstep finitial _ ffinal) = Fold.Done b -> SDone 1 b else return $ Error "fail" - extract s = fmap (SDone 1) (ffinal s) + extract s = fmap (SDone 0) (ffinal s) {-# INLINE alt2 #-} alt2 :: Monad m diff --git a/benchmark/Streamly/Benchmark/Data/ParserK.hs b/benchmark/Streamly/Benchmark/Data/ParserK.hs index de636b76d3..90d616b295 100644 --- a/benchmark/Streamly/Benchmark/Data/ParserK.hs +++ b/benchmark/Streamly/Benchmark/Data/ParserK.hs @@ -238,7 +238,7 @@ takeWhileFailD predicate (Fold fstep finitial _ ffinal) = Fold.Done b -> SDone 1 b else return $ Error "fail" - extract s = fmap (SDone 1) (ffinal s) + extract s = fmap (SDone 0) (ffinal s) {-# INLINE takeWhileFail #-} takeWhileFail :: CONSTRAINT => diff --git a/core/docs/Changelog.md b/core/docs/Changelog.md index 4e5137f06a..54cf47e0b2 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -4,14 +4,24 @@ ### Breaking Changes +* In the `Streamly.Data.Parser` module, constructors `Partial`, + `Continue`, `Done` have been deprecated and replaced by `SPartial`, + `SContinue` and `SDone`. Old code can be changed to use new + constructors as follows: + + * In the step function of a parser, constructor `Partial n` should + be replaced by `SPartial (1-n)`, `Continue n` by `SContinue (1-n)` + and `Done n` by `SDone (1-n)`. A pattern match `SPartial n` can be + replaced by `SPartial m -> let n = 1 - m; ... ` and so on. + * In the extract function `Contine n` should be replaced by `Continue (-n)` + and `Done n` by `Done (-n)`. + + If the `n` returned by these constructors is used in making some decisions, + that will have to be modified accordingly. See the docs for more details. + ### Enhancements * Add several concurrent combinators for folds in `Streamly.Data.Fold.Prelude`. -* In the `Streamly.Data.Parser` module, the constructors `Partial n`, - `Continue n`, `Done n` have been changed to `SPartial (1-n)`, `SContinue - (1-n)` and `SDone (1-n)`. The semantics of the constructor argument - has changed, the argument can now be positive or negative and it now - means the relative change in the current position of the stream. * Split the `Fold` type in two, `Fold` and `Scanl`. `Streamly.Data.Scanl` module is added for the new `Scanl` type. * Add `Streamly.FileSystem.DirIO` and `Streamly.FileSystem.FileIO` diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index 77865ab9d0..a5bad2011e 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -74,7 +74,7 @@ module Streamly.Internal.Data.Array , foldBreakChunks -- Uses Stream, bad perf on break , foldChunks , foldBreak - , parseBreakChunksK -- XXX uses Parser. parseBreak is better? + -- , parseBreakChunksK -- XXX uses Parser. parseBreak is better? , parserK , parseBreak , parse @@ -128,7 +128,7 @@ import Prelude hiding (length, null, last, map, (!!), read, concat) import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..), MutByteArray) import Streamly.Internal.Data.Serialize.Type (Serialize) import Streamly.Internal.Data.Fold.Type (Fold(..)) -import Streamly.Internal.Data.Parser (Parser(..), Initial(..), ParseError(..)) +import Streamly.Internal.Data.Parser (ParseError(..)) import Streamly.Internal.Data.ParserK.Type (ParserK, ParseResult(..), Input(..), Step(..)) import Streamly.Internal.Data.Stream (Stream(..)) @@ -143,7 +143,6 @@ import qualified Streamly.Internal.Data.Serialize.Type as Serialize import qualified Streamly.Internal.Data.MutByteArray.Type as MBA import qualified Streamly.Internal.Data.MutArray as MA import qualified Streamly.Internal.Data.RingArray as RB -import qualified Streamly.Internal.Data.Parser as Parser import qualified Streamly.Internal.Data.Parser.Type as ParserD import qualified Streamly.Internal.Data.ParserK.Type as ParserK import qualified Streamly.Internal.Data.Stream as D @@ -844,7 +843,6 @@ parseBreakD str = D.cons arr0 (D.cons arr1 (D.Stream step s)) return (b, str) PR.Error err -> throwM $ ParseError err --} -- | Parse an array stream using the supplied 'Parser'. Returns the parse -- result and the unconsumed stream. Throws 'ParseError' if the parse fails. @@ -862,7 +860,6 @@ parseBreakChunksK :: => Parser a m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a)) --- parseBreakStreamK p = StreamK.parseBreakChunks (ParserK.adaptC p) parseBreakChunksK (Parser pstep initial extract) stream = do res <- initial case res of @@ -942,34 +939,34 @@ parseBreakChunksK (Parser pstep initial extract) stream = do pRes <- pstep pst x let next = INDEX_NEXT(cur,a) case pRes of - Parser.SPartial 1 s -> + Parser.SPartial 0 s -> goExtract s [] (Array contents next end) Parser.SPartial m s -> do - assertM(m <= 1) - let n = 1 - m + assertM(m <= 0) + let n = negate m assert (n <= Prelude.length (x:backBuf)) (return ()) let src0 = Prelude.take n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 goExtract s [] src - Parser.SContinue 1 s -> + Parser.SContinue 0 s -> goExtract s backBuf (Array contents next end) Parser.SContinue m s -> do - assertM(m <= 1) - let n = 1 - m + assertM(m <= 0) + let n = negate m assert (n <= Prelude.length (x:backBuf)) (return ()) let (src0, buf1) = Prelude.splitAt n (x:backBuf) arr0 = fromListN n (Prelude.reverse src0) arr1 = Array contents next end src = arr0 <> arr1 goExtract s buf1 src - Parser.SDone 1 b -> do + Parser.SDone 0 b -> do let arr = Array contents next end return (Right b, StreamK.fromPure arr) Parser.SDone m b -> do - assertM(m <= 1) - let n = 1 - m + assertM(m <= 0) + let n = negate m assert (n <= Prelude.length backBuf) (return ()) let src0 = Prelude.take n (x:backBuf) -- XXX Use fromListRevN once implemented @@ -991,20 +988,20 @@ parseBreakChunksK (Parser pstep initial extract) stream = do pRes <- extract pst case pRes of Parser.SPartial _ _ -> error "Bug: parseBreak: Partial in extract" - Parser.SContinue 1 s -> + Parser.SContinue 0 s -> goStop s backBuf Parser.SContinue m s -> do - assertM(m <= 1) - let n = 1 - m + assertM(m <= 0) + let n = negate m assert (n <= Prelude.length backBuf) (return ()) let (src0, buf1) = Prelude.splitAt n backBuf arr = fromListN n (Prelude.reverse src0) goExtract s buf1 arr - Parser.SDone 1 b -> + Parser.SDone 0 b -> return (Right b, StreamK.nil) Parser.SDone m b -> do - assertM(m <= 1) - let n = 1 - m + assertM(m <= 0) + let n = negate m assert (n <= Prelude.length backBuf) (return ()) let src0 = Prelude.take n backBuf -- XXX Use fromListRevN once implemented @@ -1015,22 +1012,26 @@ parseBreakChunksK (Parser pstep initial extract) stream = do let n = Prelude.length backBuf arr0 = fromListN n (Prelude.reverse backBuf) return (Left (ParseError err), StreamK.fromPure arr0) +-} -- The backracking buffer consists of arrays in the most-recent-first order. We -- want to take a total of n array elements from this buffer. Note: when we -- have to take an array partially, we must take the last part of the array. -{-# INLINE backTrack #-} -backTrack :: forall m a. Unbox a => +{-# INLINE backtrack #-} +backtrack :: forall m a. Unbox a => Int -> [Array a] -> StreamK m (Array a) -> (StreamK m (Array a), [Array a]) -backTrack = go +backtrack count buf inp + | count < 0 = seekOver count + -- XXX this is handled at the call site, so we can assert that here. + | count == 0 = (inp, buf) + | otherwise = go count buf inp where - go _ [] stream = (stream, []) - go n xs stream | n <= 0 = (stream, xs) + go n [] _ = seekUnder count n go n (x:xs) stream = let len = length x in if n > len @@ -1043,6 +1044,18 @@ backTrack = go arr2 = Array contents start start1 in (StreamK.cons arr1 stream, arr2:xs) + seekOver x = + error $ "Array.parseBreak: bug in parser, seeking [" + ++ show (negate x) + ++ "] elements in future" + + seekUnder x y = + error $ "Array.parseBreak: bug in parser, backtracking [" + ++ show x + ++ "] elements. Goes [" + ++ show y + ++ "] elements beyond backtrack buffer" + -- | Run a 'ParserK' over a 'StreamK' of Arrays and return the parse result and -- the remaining Stream. {-# INLINE_NORMAL parseBreak #-} @@ -1069,24 +1082,24 @@ parseBreak parser input = do ParserK.Partial n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf)) - let (s1, backBuf1) = backTrack n1 backBuf StreamK.nil + let (s1, backBuf1) = backtrack n1 backBuf StreamK.nil in go backBuf1 cont1 s1 ParserK.Continue 0 cont1 -> go backBuf cont1 StreamK.nil ParserK.Continue n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf)) - let (s1, backBuf1) = backTrack n1 backBuf StreamK.nil + let (s1, backBuf1) = backtrack n1 backBuf StreamK.nil in go backBuf1 cont1 s1 ParserK.Done 0 b -> return (Right b, StreamK.nil) ParserK.Done n b -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf)) - let (s1, _) = backTrack n1 backBuf StreamK.nil + let (s1, _) = backtrack n1 backBuf StreamK.nil in return (Right b, s1) ParserK.Error _ err -> do - let (s1, _) = backTrack maxBound backBuf StreamK.nil + let s1 = Prelude.foldl (flip StreamK.cons) StreamK.nil backBuf return (Left (ParseError err), s1) seekErr n len = @@ -1108,7 +1121,7 @@ parseBreak parser input = do bufLen = sum (Prelude.map length backBuf) s = StreamK.cons arr stream assertM(n1 >= 0 && n1 <= bufLen) - let (s1, _) = backTrack n1 backBuf s + let (s1, _) = backtrack n1 backBuf s go [] cont1 s1 GT -> seekErr n len ParserK.Continue n cont1 -> @@ -1122,16 +1135,16 @@ parseBreak parser input = do bufLen = sum (Prelude.map length backBuf) s = StreamK.cons arr stream assertM(n1 >= 0 && n1 <= bufLen) - let (s1, backBuf1) = backTrack n1 backBuf s + let (s1, backBuf1) = backtrack n1 backBuf s go backBuf1 cont1 s1 GT -> seekErr n len ParserK.Done n b -> do let n1 = len - n assertM(n1 <= sum (Prelude.map length (arr:backBuf))) - let (s1, _) = backTrack n1 (arr:backBuf) stream + let (s1, _) = backtrack n1 (arr:backBuf) stream in return (Right b, s1) ParserK.Error _ err -> do - let (s1, _) = backTrack maxBound (arr:backBuf) stream + let s1 = Prelude.foldl (flip StreamK.cons) stream (arr:backBuf) return (Left (ParseError err), s1) go backBuf parserk stream = do @@ -1251,14 +1264,11 @@ adaptCWith pstep initial extract cont !offset0 !usedCount !input = do parseContNothing !count !pst = do r <- extract pst case r of - -- IMPORTANT: the n here is from the byte stream parser, that means - -- it is the backtrack element count and not the stream position - -- index into the current input array. ParserD.SDone n b -> - assert (n <= 1) (cont (Success (n - 1) b) (count + n - 1) None) + assert (n <= 0) (cont (Success n b) (count + n) None) ParserD.SContinue n pst1 -> - assert (n <= 1) - (return $ Continue (n - 1) (parseCont (count + n - 1) pst1)) + assert (n <= 0) + (return $ Continue n (parseCont (count + n) pst1)) ParserD.Error err -> -- XXX It is called only when there is no input arr. So using 0 -- as the position is correct? diff --git a/core/src/Streamly/Internal/Data/Array/Generic.hs b/core/src/Streamly/Internal/Data/Array/Generic.hs index bc4f903ff1..62d00bd599 100644 --- a/core/src/Streamly/Internal/Data/Array/Generic.hs +++ b/core/src/Streamly/Internal/Data/Array/Generic.hs @@ -99,6 +99,7 @@ import qualified Streamly.Internal.Data.StreamK.Type as StreamK import qualified Text.ParserCombinators.ReadPrec as ReadPrec import Prelude hiding (Foldable(..), read) +import Prelude (foldl) ------------------------------------------------------------------------------- -- Array Data Type @@ -383,18 +384,20 @@ RENAME(getIndexUnsafe,unsafeGetIndex) -- ParserK Chunked Generic ------------------------------------------------------------------------------- -{-# INLINE backTrackGenericChunks #-} -backTrackGenericChunks :: +{-# INLINE backtrack #-} +backtrack :: Int -> [Array a] -> StreamK m (Array a) -> (StreamK m (Array a), [Array a]) -backTrackGenericChunks = go +backtrack count buf inp + | count < 0 = seekOver count + | count == 0 = (inp, buf) + | otherwise = go count buf inp where - go _ [] stream = (stream, []) - go n xs stream | n <= 0 = (stream, xs) + go n [] _ = seekUnder count n go n (x:xs) stream = let len = length x in if n > len @@ -405,6 +408,18 @@ backTrackGenericChunks = go arr2 = unsafeSliceOffLen 0 (len - n) x in (StreamK.cons arr1 stream, arr2:xs) + seekOver x = + error $ "Array.Generic.parseBreak: bug in parser, seeking [" + ++ show (negate x) + ++ "] elements in future" + + seekUnder x y = + error $ "Array.Generic.parseBreak: bug in parser, backtracking [" + ++ show x + ++ "] elements. Goes [" + ++ show y + ++ "] elements beyond backtrack buffer" + {-# INLINE_NORMAL parseBreak #-} parseBreak :: forall m a b. Monad m @@ -434,24 +449,24 @@ parseBreak parser input = do ParserK.Partial n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf)) - let (s1, backBuf1) = backTrackGenericChunks n1 backBuf StreamK.nil + let (s1, backBuf1) = backtrack n1 backBuf StreamK.nil in go backBuf1 cont1 s1 ParserK.Continue 0 cont1 -> go backBuf cont1 StreamK.nil ParserK.Continue n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf)) - let (s1, backBuf1) = backTrackGenericChunks n1 backBuf StreamK.nil + let (s1, backBuf1) = backtrack n1 backBuf StreamK.nil in go backBuf1 cont1 s1 ParserK.Done 0 b -> return (Right b, StreamK.nil) ParserK.Done n b -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf)) - let (s1, _) = backTrackGenericChunks n1 backBuf StreamK.nil + let (s1, _) = backtrack n1 backBuf StreamK.nil in return (Right b, s1) ParserK.Error _ err -> - let strm = StreamK.fromList (Prelude.reverse backBuf) + let strm = Prelude.foldl (flip StreamK.cons) StreamK.nil backBuf in return (Left (ParseError err), strm) seekErr n len = @@ -480,7 +495,7 @@ parseBreak parser input = do bufLen = sum (Prelude.map length backBuf) s = StreamK.cons arr stream assertM(n1 >= 0 && n1 <= bufLen) - let (s1, _) = backTrackGenericChunks n1 backBuf s + let (s1, _) = backtrack n1 backBuf s go [] cont1 s1 GT -> seekErr n len ParserK.Continue n cont1 -> @@ -494,19 +509,16 @@ parseBreak parser input = do bufLen = sum (Prelude.map length backBuf) s = StreamK.cons arr stream assertM(n1 >= 0 && n1 <= bufLen) - let (s1, backBuf1) = backTrackGenericChunks n1 backBuf s + let (s1, backBuf1) = backtrack n1 backBuf s go backBuf1 cont1 s1 GT -> seekErr n len ParserK.Done n b -> do let n1 = len - n assertM(n1 <= sum (Prelude.map length (arr:backBuf))) - let (s1, _) = backTrackGenericChunks n1 (arr:backBuf) stream + let (s1, _) = backtrack n1 (arr:backBuf) stream in return (Right b, s1) ParserK.Error _ err -> - let strm = - StreamK.append - (StreamK.fromList (Prelude.reverse backBuf)) - (StreamK.cons arr stream) + let strm = Prelude.foldl (flip StreamK.cons) stream (arr:backBuf) in return (Left (ParseError err), strm) go @@ -602,8 +614,8 @@ adaptCGWith pstep initial extract cont !offset0 !usedCount !input = do curOff = cur - start nextOff = next - start -- The "n" here is how many items have been consumed by the parser - -- from the array i.e. which is the same as the stream position - -- index wrt the array start. + -- from the array which is the same as the stream position index + -- wrt the array start. case pRes of ParserD.SDone 1 b -> onDone nextOff b @@ -630,18 +642,11 @@ adaptCGWith pstep initial extract cont !offset0 !usedCount !input = do parseContNothing !count !pst = do r <- extract pst case r of - -- IMPORTANT: the n here is from the byte stream parser, that means - -- it is the backtrack element count and not the stream position - -- index into the current input array. - -- XXX in extract we do not supply any input. So 0 means stay put. - -- So extract will usually be different than step, because step has - -- an input it would usually return Done 1, and extract would - -- always be Done 0. ParserD.SDone n b -> - assert (n <= 1) (cont (Success (n - 1) b) (count + n - 1) None) + assert (n <= 0) (cont (Success n b) (count + n) None) ParserD.SContinue n pst1 -> assert (n <= 1) - (return $ Continue (n - 1) (parseCont (count + n - 1) pst1)) + (return $ Continue n (parseCont (count + n) pst1)) ParserD.Error err -> -- XXX It is called only when there is no input arr. So using 0 -- as the position is correct? diff --git a/core/src/Streamly/Internal/Data/Array/Stream.hs b/core/src/Streamly/Internal/Data/Array/Stream.hs index b36fae5a7b..5ec0c46ed4 100644 --- a/core/src/Streamly/Internal/Data/Array/Stream.hs +++ b/core/src/Streamly/Internal/Data/Array/Stream.hs @@ -294,8 +294,7 @@ parseBreak :: parseBreak p s = fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s) -} -parseBreak = Array.parseBreakChunksK --- parseBreak p = K.parseBreakChunks (ParserK.adaptC p) +parseBreak p = Array.parseBreak (Array.parserK p) ------------------------------------------------------------------------------- -- Elimination - Running Array Folds and parsers diff --git a/core/src/Streamly/Internal/Data/MutArray/Type.hs b/core/src/Streamly/Internal/Data/MutArray/Type.hs index 37d5b27fc1..27449ced39 100644 --- a/core/src/Streamly/Internal/Data/MutArray/Type.hs +++ b/core/src/Streamly/Internal/Data/MutArray/Type.hs @@ -3738,8 +3738,8 @@ pCompactLeAs ps maxElems = Parser step initial extract buf2 <- unsafeSplice buf1 arr return $ Parser.SPartial 1 (Just buf2) - extract Nothing = return $ Parser.SDone 1 nil - extract (Just buf) = return $ Parser.SDone 1 buf + extract Nothing = return $ Parser.SDone 0 nil + extract (Just buf) = return $ Parser.SDone 0 buf -- | Parser @createCompactMax maxElems@ coalesces adjacent arrays in the -- input stream only if the combined size would be less than or equal to diff --git a/core/src/Streamly/Internal/Data/Parser.hs b/core/src/Streamly/Internal/Data/Parser.hs index 65d93a8365..be60323cd6 100644 --- a/core/src/Streamly/Internal/Data/Parser.hs +++ b/core/src/Streamly/Internal/Data/Parser.hs @@ -320,7 +320,7 @@ toFold (Parser pstep pinitial pextract) = Fold step initial extract final final st = do r <- pextract st case r of - SDone 1 b -> return b + SDone 0 b -> return b SPartial n _ -> perror n SContinue n _ -> cerror n SDone n _ -> derror n @@ -353,7 +353,7 @@ fromFold (Fold fstep finitial _ ffinal) = Parser step initial extract FL.Partial s1 -> SPartial 1 s1 FL.Done b -> SDone 1 b - extract = fmap (SDone 1) . ffinal + extract = fmap (SDone 0) . ffinal -- | Convert a Maybe returning fold to an error returning parser. The first -- argument is the error message that the parser would return when the fold @@ -391,7 +391,7 @@ fromFoldMaybe errMsg (Fold fstep finitial _ ffinal) = extract s = do res <- ffinal s case res of - Just x -> return $ SDone 1 x + Just x -> return $ SDone 0 x Nothing -> return $ Error errMsg ------------------------------------------------------------------------------- @@ -435,7 +435,7 @@ eof = Parser step initial extract step () _ = return $ Error "eof: not at end of input" - extract () = return $ SDone 1 () + extract () = return $ SDone 0 () -- | Return the next element of the input. Returns 'Nothing' -- on end of input. Also known as 'head'. @@ -453,7 +453,7 @@ next = Parser step initial extract step () a = pure $ SDone 1 (Just a) - extract () = pure $ SDone 1 Nothing + extract () = pure $ SDone 0 Nothing -- | Map an 'Either' returning function on the next element in the stream. If -- the function returns 'Left err', the parser fails with the error message @@ -707,7 +707,7 @@ takeBetween low high (Fold fstep finitial _ ffinal) = step (Tuple'Fused i s) a = fstep s a >>= snext i extract f (Tuple'Fused i s) - | i >= low && i <= high = fmap (SDone 1) (ffinal s) + | i >= low && i <= high = fmap (SDone 0) (ffinal s) | otherwise = return $ Error (f i) -- XXX Need to make Initial return type Step to deduplicate this @@ -843,7 +843,7 @@ takeGE n (Fold fstep finitial _ ffinal) = Parser step initial extract $ Error $ "takeGE: Expecting at least " ++ show n ++ " elements, input terminated on " ++ show (i - 1) - extract (TakeGEGE r) = fmap (SDone 1) $ ffinal r + extract (TakeGEGE r) = fmap (SDone 0) $ ffinal r ------------------------------------------------------------------------------- -- Conditional splitting @@ -925,7 +925,7 @@ takeWhile predicate (Fold fstep finitial _ ffinal) = FL.Done b -> SDone 1 b else SDone 0 <$> ffinal s - extract s = fmap (SDone 1) (ffinal s) + extract s = fmap (SDone 0) (ffinal s) {- -- XXX This may not be composable because of the b argument. We can instead @@ -979,7 +979,7 @@ takeWhile1 predicate (Fold fstep finitial _ ffinal) = return $ SDone 0 b extract (Left' _) = return $ Error "takeWhile1: end of input" - extract (Right' s) = fmap (SDone 1) (ffinal s) + extract (Right' s) = fmap (SDone 0) (ffinal s) -- | Drain the input as long as the predicate succeeds, running the effects and -- discarding the results. @@ -1093,7 +1093,7 @@ takeFramedByGeneric esc begin end (Fold fstep finitial _ ffinal) = case begin of Just _ -> case end of - Nothing -> fmap (SDone 1) $ ffinal s + Nothing -> fmap (SDone 0) $ ffinal s Just _ -> err "takeFramedByGeneric: missing frame end" Nothing -> err "takeFramedByGeneric: missing closing frame" extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape" @@ -1176,7 +1176,7 @@ blockWithQuotes isEsc isQuote bopen bclose err = return . Error - extract (BlockInit s) = fmap (SDone 1) $ ffinal s + extract (BlockInit s) = fmap (SDone 0) $ ffinal s extract (BlockUnquoted level _) = err $ "blockWithQuotes: finished at block nest level " ++ show level extract (BlockQuoted level _) = @@ -1218,7 +1218,19 @@ takeEndBy cond (Parser pstep pinitial pextract) = res <- pstep s a if not (cond a) then return res - else extractStep pextract res + else + -- XXX Check if there are any other such cases where we are + -- extracting like this. + + -- If the parser is backtracking we let it backtrack even if the + -- predicate is true. + case res of + SPartial 1 s1 -> mapCount (+1) <$> pextract s1 + SPartial _ _ -> return res + SContinue 1 s1 -> mapCount (+1) <$> pextract s1 + SContinue _ _ -> return res + SDone n b -> return $ SDone n b + Error err -> return $ Error err -- | Like 'takeEndBy' but the separator elements can be escaped using an -- escape char determined by the first predicate. The escape characters are @@ -1243,7 +1255,17 @@ takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) = res <- pstep s a if not (isSep a) then return $ first Left' res - else fmap (first Left') $ extractStep pextract res + -- else fmap (first Left') $ extractStep pextract res + else + -- If the parser is backtracking we let it backtrack even if the + -- predicate is true. + fmap (first Left') $ case res of + SPartial 1 s1 -> mapCount (+1) <$> pextract s1 + SPartial _ _ -> return res + SContinue 1 s1 -> mapCount (+1) <$> pextract s1 + SContinue _ _ -> return res + SDone n b -> return $ SDone n b + Error err -> return $ Error err step (Right' s) a = do res <- pstep s a @@ -1342,8 +1364,8 @@ takeBeginBy cond (Fold fstep finitial _ ffinal) = then process s a else SDone 0 <$> ffinal s - extract (Left' s) = fmap (SDone 1) $ ffinal s - extract (Right' s) = fmap (SDone 1) $ ffinal s + extract (Left' s) = fmap (SDone 0) $ ffinal s + extract (Right' s) = fmap (SDone 0) $ ffinal s RENAME(takeStartBy,takeBeginBy) @@ -1542,9 +1564,9 @@ wordBy predicate (Fold fstep finitial _ ffinal) = Parser step initial extract then SDone 0 b else SPartial 1 $ WBRight b - extract (WBLeft s) = fmap (SDone 1) $ ffinal s - extract (WBWord s) = fmap (SDone 1) $ ffinal s - extract (WBRight b) = return (SDone 1 b) + extract (WBLeft s) = fmap (SDone 0) $ ffinal s + extract (WBWord s) = fmap (SDone 0) $ ffinal s + extract (WBRight b) = return (SDone 0 b) data WordFramedState s b = WordFramedSkipPre !s @@ -1644,14 +1666,14 @@ wordFramedBy isEsc isBegin isEnd isSep err = return . Error - extract (WordFramedSkipPre s) = fmap (SDone 1) $ ffinal s + extract (WordFramedSkipPre s) = fmap (SDone 0) $ ffinal s extract (WordFramedWord s n) = if n == 0 - then fmap (SDone 1) $ ffinal s + then fmap (SDone 0) $ ffinal s else err "wordFramedBy: missing frame end" extract (WordFramedEsc _ _) = err "wordFramedBy: trailing escape" - extract (WordFramedSkipPost b) = return (SDone 1 b) + extract (WordFramedSkipPost b) = return (SDone 0 b) data WordQuotedState s b a = WordQuotedSkipPre !s @@ -1834,17 +1856,17 @@ wordWithQuotes keepQuotes tr escChar toRight isSep err = return . Error - extract (WordQuotedSkipPre s) = fmap (SDone 1) $ ffinal s - extract (WordUnquotedWord s) = fmap (SDone 1) $ ffinal s + extract (WordQuotedSkipPre s) = fmap (SDone 0) $ ffinal s + extract (WordUnquotedWord s) = fmap (SDone 0) $ ffinal s extract (WordQuotedWord s n _ _) = if n == 0 - then fmap (SDone 1) $ ffinal s + then fmap (SDone 0) $ ffinal s else err "wordWithQuotes: missing frame end" extract WordQuotedEsc {} = err "wordWithQuotes: trailing escape" extract (WordUnquotedEsc _) = err "wordWithQuotes: trailing escape" - extract (WordQuotedSkipPost b) = return (SDone 1 b) + extract (WordQuotedSkipPost b) = return (SDone 0 b) -- | 'wordWithQuotes' without processing the quotes and escape function -- supplied to escape the quote char within a quote. Can be used to parse words @@ -1941,8 +1963,8 @@ groupBy eq (Fold fstep finitial _ ffinal) = Parser step initial extract then grouper s a0 a else SDone 0 <$> ffinal s - extract (GroupByInit s) = fmap (SDone 1) $ ffinal s - extract (GroupByGrouping _ s) = fmap (SDone 1) $ ffinal s + extract (GroupByInit s) = fmap (SDone 0) $ ffinal s + extract (GroupByGrouping _ s) = fmap (SDone 0) $ ffinal s -- | Unlike 'groupBy' this combinator performs a rolling comparison of two -- successive elements in the input stream. Assuming the input stream @@ -2001,8 +2023,8 @@ groupByRolling eq (Fold fstep finitial _ ffinal) = Parser step initial extract then grouper s a else SDone 0 <$> ffinal s - extract (GroupByInit s) = fmap (SDone 1) $ ffinal s - extract (GroupByGrouping _ s) = fmap (SDone 1) $ ffinal s + extract (GroupByInit s) = fmap (SDone 0) $ ffinal s + extract (GroupByGrouping _ s) = fmap (SDone 0) $ ffinal s {-# ANN type GroupByStatePair Fuse #-} data GroupByStatePair a s1 s2 @@ -2093,14 +2115,14 @@ groupByRollingEither then grouperR2 s1 s2 a else SDone 0 . Right <$> ffinal2 s2 - extract (GroupByInitPair s1 _) = SDone 1 . Left <$> ffinal1 s1 - extract (GroupByGroupingPairL _ s1 _) = SDone 1 . Left <$> ffinal1 s1 - extract (GroupByGroupingPairR _ _ s2) = SDone 1 . Right <$> ffinal2 s2 + extract (GroupByInitPair s1 _) = SDone 0 . Left <$> ffinal1 s1 + extract (GroupByGroupingPairL _ s1 _) = SDone 0 . Left <$> ffinal1 s1 + extract (GroupByGroupingPairR _ _ s2) = SDone 0 . Right <$> ffinal2 s2 extract (GroupByGroupingPair a s1 _) = do res <- fstep1 s1 a case res of - FL.Done b -> return $ SDone 1 (Left b) - FL.Partial s11 -> SDone 1 . Left <$> ffinal1 s11 + FL.Done b -> return $ SDone 0 (Left b) + FL.Partial s11 -> SDone 0 . Left <$> ffinal1 s11 -- XXX use an Unfold instead of a list? -- XXX custom combinators for matching list, array and stream? @@ -2432,9 +2454,9 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract step (Tuple' cnt r) a = do assertM(cnt < lim) res <- pstep r a - let cnt1 = cnt + 1 case res of SPartial 1 s -> do + let cnt1 = cnt + 1 assertM(cnt1 >= 0) if cnt1 < lim then return $ SPartial 1 $ Tuple' cnt1 s @@ -2442,11 +2464,12 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract r1 <- pextract s return $ case r1 of SDone n b -> SDone n b - SContinue n s1 -> SContinue n (Tuple' (cnt1 + n - 1) s1) + SContinue n s1 -> SContinue n (Tuple' (cnt1 + n) s1) Error err -> Error err SPartial _ _ -> error "takeP: SPartial in extract" SContinue 1 s -> do + let cnt1 = cnt + 1 assertM(cnt1 >= 0) if cnt1 < lim then return $ SContinue 1 $ Tuple' cnt1 s @@ -2454,15 +2477,15 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract r1 <- pextract s return $ case r1 of SDone n b -> SDone n b - SContinue n s1 -> SContinue n (Tuple' (cnt1 + n - 1) s1) + SContinue n s1 -> SContinue n (Tuple' (cnt1 + n) s1) Error err -> Error err SPartial _ _ -> error "takeP: SPartial in extract" SPartial n s -> do - let taken = cnt1 + n - 1 + let taken = cnt + n assertM(taken >= 0) return $ SPartial n $ Tuple' taken s SContinue n s -> do - let taken = cnt1 + n - 1 + let taken = cnt + n assertM(taken >= 0) return $ SContinue n $ Tuple' taken s SDone n b -> return $ SDone n b @@ -2472,7 +2495,7 @@ takeP lim (Parser pstep pinitial pextract) = Parser step initial extract r1 <- pextract r return $ case r1 of SDone n b -> SDone n b - SContinue n s1 -> SContinue n (Tuple' (cnt + n - 1) s1) + SContinue n s1 -> SContinue n (Tuple' (cnt + n) s1) Error err -> Error err SPartial _ _ -> error "takeP: SPartial in extract" @@ -2501,12 +2524,11 @@ lookAhead (Parser step1 initial1 _) = Parser step initial extract step (Tuple'Fused cnt st) a = do r <- step1 st a - let cnt1 = cnt + 1 return $ case r of - SPartial n s -> SContinue n (Tuple'Fused (cnt1 + n - 1) s) - SContinue n s -> SContinue n (Tuple'Fused (cnt1 + n - 1) s) - SDone _ b -> SDone (1 - cnt1) b + SPartial n s -> SContinue n (Tuple'Fused (cnt + n) s) + SContinue n s -> SContinue n (Tuple'Fused (cnt + n) s) + SDone _ b -> SDone (- cnt) b Error err -> Error err -- XXX returning an error let's us backtrack. To implement it in a way so @@ -2653,7 +2675,7 @@ deintercalateAll case res of FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 FL.Done c -> return (SDone n c) - extract (DeintercalateAllInitL fs) = fmap (SDone 1) $ ffinal fs + extract (DeintercalateAllInitL fs) = fmap (SDone 0) $ ffinal fs extract (DeintercalateAllL fs sL) = do r <- extractL sL case r of @@ -2661,7 +2683,7 @@ deintercalateAll Error err -> return $ Error err SContinue n s -> return $ SContinue n (DeintercalateAllL fs s) SPartial _ _ -> error "SPartial in extract" - extract (DeintercalateAllInitR fs) = fmap (SDone 1) $ ffinal fs + extract (DeintercalateAllInitR fs) = fmap (SDone 0) $ ffinal fs extract (DeintercalateAllR _ _) = return $ Error "deintercalateAll: input ended at 'Right' value" @@ -2727,16 +2749,17 @@ deintercalate {-# INLINE runStepL #-} runStepL cnt fs sL a = do - let cnt1 = cnt + 1 r <- stepL sL a case r of - SPartial n s -> return $ SContinue n (DeintercalateL (cnt1 + n - 1) fs s) - SContinue n s -> return $ SContinue n (DeintercalateL (cnt1 + n - 1) fs s) + -- XXX If we subtract instead of adding we do not need to negate + -- when returning cnt. + SPartial n s -> return $ SContinue n (DeintercalateL (cnt + n) fs s) + SContinue n s -> return $ SContinue n (DeintercalateL (cnt + n) fs s) SDone n b -> processL (fstep fs (Left b)) n DeintercalateInitR Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (-cnt) xs {-# INLINE processR #-} processR cnt b fs n = do @@ -2748,15 +2771,14 @@ deintercalate {-# INLINE runStepR #-} runStepR cnt fs sR a = do - let cnt1 = cnt + 1 r <- stepR sR a case r of - SPartial n s -> return $ SContinue n (DeintercalateR (cnt1 + n - 1) fs s) - SContinue n s -> return $ SContinue n (DeintercalateR (cnt1 + n - 1) fs s) - SDone n b -> processR (cnt1 + n - 1) b fs n + SPartial n s -> return $ SContinue n (DeintercalateR (cnt + n) fs s) + SContinue n s -> return $ SContinue n (DeintercalateR (cnt + n) fs s) + SDone n b -> processR (cnt + n) b fs n Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (- cnt) xs step (DeintercalateInitL fs) a = do res <- initialL @@ -2773,11 +2795,10 @@ deintercalate IError _ -> errMsg "right" "fail" step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a step (DeintercalateRL cnt bR fs sL) a = do - let cnt1 = cnt + 1 r <- stepL sL a case r of - SPartial n s -> return $ SContinue n (DeintercalateRL (cnt1 + n - 1) bR fs s) - SContinue n s -> return $ SContinue n (DeintercalateRL (cnt1 + n - 1) bR fs s) + SPartial n s -> return $ SContinue n (DeintercalateRL (cnt + n) bR fs s) + SContinue n s -> return $ SContinue n (DeintercalateRL (cnt + n) bR fs s) SDone n bL -> do res <- fstep fs (Right bR) case res of @@ -2791,7 +2812,7 @@ deintercalate FL.Done _ -> error "Fold terminated consuming partial input" Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (- cnt) xs {-# INLINE extractResult #-} extractResult n fs r = do @@ -2800,18 +2821,18 @@ deintercalate FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 FL.Done c -> return (SDone n c) - extract (DeintercalateInitL fs) = fmap (SDone 1) $ ffinal fs + extract (DeintercalateInitL fs) = fmap (SDone 0) $ ffinal fs extract (DeintercalateL cnt fs sL) = do r <- extractL sL case r of SDone n b -> extractResult n fs (Left b) - SContinue n s -> return $ SContinue n (DeintercalateL (cnt + n - 1) fs s) + SContinue n s -> return $ SContinue n (DeintercalateL (cnt + n) fs s) SPartial _ _ -> error "SPartial in extract" Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt) xs - extract (DeintercalateInitR fs) = fmap (SDone 1) $ ffinal fs - extract (DeintercalateR cnt fs _) = fmap (SDone (1 - cnt)) $ ffinal fs + return $ SDone (- cnt) xs + extract (DeintercalateInitR fs) = fmap (SDone 0) $ ffinal fs + extract (DeintercalateR cnt fs _) = fmap (SDone (- cnt)) $ ffinal fs extract (DeintercalateRL cnt bR fs sL) = do r <- extractL sL case r of @@ -2820,11 +2841,11 @@ deintercalate case res of FL.Partial fs1 -> extractResult n fs1 (Left bL) FL.Done _ -> error "Fold terminated consuming partial input" - SContinue n s -> return $ SContinue n (DeintercalateRL (cnt + n - 1) bR fs s) + SContinue n s -> return $ SContinue n (DeintercalateRL (cnt + n) bR fs s) SPartial _ _ -> error "SPartial in extract" Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt) xs + return $ SDone (- cnt) xs {-# ANN type Deintercalate1State Fuse #-} data Deintercalate1State b fs sp ss = @@ -2888,11 +2909,10 @@ deintercalate1 {-# INLINE runStepInitL #-} runStepInitL cnt fs sL a = do - let cnt1 = cnt + 1 r <- stepL sL a case r of - SPartial n s -> return $ SContinue n (Deintercalate1InitL (cnt1 + n - 1) fs s) - SContinue n s -> return $ SContinue n (Deintercalate1InitL (cnt1 + n - 1) fs s) + SPartial n s -> return $ SContinue n (Deintercalate1InitL (cnt + n) fs s) + SContinue n s -> return $ SContinue n (Deintercalate1InitL (cnt + n) fs s) SDone n b -> processL (fstep fs (Left b)) n Deintercalate1InitR Error err -> return $ Error err @@ -2907,15 +2927,14 @@ deintercalate1 {-# INLINE runStepR #-} runStepR cnt fs sR a = do - let cnt1 = cnt + 1 r <- stepR sR a case r of - SPartial n s -> return $ SContinue n (Deintercalate1R (cnt1 + n - 1) fs s) - SContinue n s -> return $ SContinue n (Deintercalate1R (cnt1 + n - 1) fs s) - SDone n b -> processR (cnt1 + n - 1) b fs n + SPartial n s -> return $ SContinue n (Deintercalate1R (cnt + n) fs s) + SContinue n s -> return $ SContinue n (Deintercalate1R (cnt + n) fs s) + SDone n b -> processR (cnt + n) b fs n Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (- cnt) xs step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a step (Deintercalate1InitR fs) a = do @@ -2926,11 +2945,10 @@ deintercalate1 IError _ -> errMsg "right" "fail" step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a step (Deintercalate1RL cnt bR fs sL) a = do - let cnt1 = cnt + 1 r <- stepL sL a case r of - SPartial n s -> return $ SContinue n (Deintercalate1RL (cnt1 + n - 1) bR fs s) - SContinue n s -> return $ SContinue n (Deintercalate1RL (cnt1 + n - 1) bR fs s) + SPartial n s -> return $ SContinue n (Deintercalate1RL (cnt + n) bR fs s) + SContinue n s -> return $ SContinue n (Deintercalate1RL (cnt + n) bR fs s) SDone n bL -> do res <- fstep fs (Right bR) case res of @@ -2944,7 +2962,7 @@ deintercalate1 FL.Done _ -> error "Fold terminated consuming partial input" Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (- cnt) xs {-# INLINE extractResult #-} extractResult n fs r = do @@ -2957,11 +2975,11 @@ deintercalate1 r <- extractL sL case r of SDone n b -> extractResult n fs (Left b) - SContinue n s -> return $ SContinue n (Deintercalate1InitL (cnt + n - 1) fs s) + SContinue n s -> return $ SContinue n (Deintercalate1InitL (cnt + n) fs s) SPartial _ _ -> error "SPartial in extract" Error err -> return $ Error err - extract (Deintercalate1InitR fs) = fmap (SDone 1) $ ffinal fs - extract (Deintercalate1R cnt fs _) = fmap (SDone (1 - cnt)) $ ffinal fs + extract (Deintercalate1InitR fs) = fmap (SDone 0) $ ffinal fs + extract (Deintercalate1R cnt fs _) = fmap (SDone (- cnt)) $ ffinal fs extract (Deintercalate1RL cnt bR fs sL) = do r <- extractL sL case r of @@ -2970,11 +2988,11 @@ deintercalate1 case res of FL.Partial fs1 -> extractResult n fs1 (Left bL) FL.Done _ -> error "Fold terminated consuming partial input" - SContinue n s -> return $ SContinue n (Deintercalate1RL (cnt + n - 1) bR fs s) + SContinue n s -> return $ SContinue n (Deintercalate1RL (cnt + n) bR fs s) SPartial _ _ -> error "SPartial in extract" Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt) xs + return $ SDone (- cnt) xs {-# ANN type SepByState Fuse #-} data SepByState fs sp ss = @@ -3039,16 +3057,15 @@ sepBy {-# INLINE runStepL #-} runStepL cnt fs sL a = do - let cnt1 = cnt + 1 r <- stepL sL a case r of - SPartial n s -> return $ SContinue n (SepByL (cnt1 + n - 1) fs s) - SContinue n s -> return $ SContinue n (SepByL (cnt1 + n - 1) fs s) + SPartial n s -> return $ SContinue n (SepByL (cnt + n) fs s) + SContinue n s -> return $ SContinue n (SepByL (cnt + n) fs s) SDone n b -> processL (fstep fs b) n SepByInitR Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (- cnt) xs {-# INLINE processR #-} processR cnt fs n = do @@ -3060,15 +3077,14 @@ sepBy {-# INLINE runStepR #-} runStepR cnt fs sR a = do - let cnt1 = cnt + 1 r <- stepR sR a case r of - SPartial n s -> return $ SContinue n (SepByR (cnt1 + n - 1) fs s) - SContinue n s -> return $ SContinue n (SepByR (cnt1 + n - 1) fs s) - SDone n _ -> processR (cnt1 + n - 1) fs n + SPartial n s -> return $ SContinue n (SepByR (cnt + n) fs s) + SContinue n s -> return $ SContinue n (SepByR (cnt + n) fs s) + SDone n _ -> processR (cnt + n) fs n Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (- cnt) xs step (SepByInitL fs) a = do res <- initialL @@ -3092,18 +3108,18 @@ sepBy FL.Partial fs1 -> fmap (SDone n) $ ffinal fs1 FL.Done c -> return (SDone n c) - extract (SepByInitL fs) = fmap (SDone 1) $ ffinal fs + extract (SepByInitL fs) = fmap (SDone 0) $ ffinal fs extract (SepByL cnt fs sL) = do r <- extractL sL case r of SDone n b -> extractResult n fs b - SContinue n s -> return $ SContinue n (SepByL (cnt + n - 1) fs s) + SContinue n s -> return $ SContinue n (SepByL (cnt + n) fs s) SPartial _ _ -> error "Partial in extract" Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt) xs - extract (SepByInitR fs) = fmap (SDone 1) $ ffinal fs - extract (SepByR cnt fs _) = fmap (SDone (1 - cnt)) $ ffinal fs + return $ SDone (- cnt) xs + extract (SepByInitR fs) = fmap (SDone 0) $ ffinal fs + extract (SepByR cnt fs _) = fmap (SDone (- cnt)) $ ffinal fs -- | Non-backtracking version of sepBy. Several times faster. {-# INLINE sepByAll #-} @@ -3186,27 +3202,25 @@ sepBy1 {-# INLINE runStepInitL #-} runStepInitL cnt fs sL a = do - let cnt1 = cnt + 1 r <- stepL sL a case r of - SPartial n s -> return $ SContinue n (SepBy1InitL (cnt1 + n - 1) fs s) - SContinue n s -> return $ SContinue n (SepBy1InitL (cnt1 + n - 1) fs s) + SPartial n s -> return $ SContinue n (SepBy1InitL (cnt + n) fs s) + SContinue n s -> return $ SContinue n (SepBy1InitL (cnt + n) fs s) SDone n b -> processL (fstep fs b) n SepBy1InitR Error err -> return $ Error err {-# INLINE runStepL #-} runStepL cnt fs sL a = do - let cnt1 = cnt + 1 r <- stepL sL a case r of - SPartial n s -> return $ SContinue n (SepBy1L (cnt1 + n - 1) fs s) - SContinue n s -> return $ SContinue n (SepBy1L (cnt1 + n - 1) fs s) + SPartial n s -> return $ SContinue n (SepBy1L (cnt + n) fs s) + SContinue n s -> return $ SContinue n (SepBy1L (cnt + n) fs s) SDone n b -> processL (fstep fs b) n SepBy1InitR Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (- cnt) xs {-# INLINE processR #-} processR cnt fs n = do @@ -3218,15 +3232,15 @@ sepBy1 {-# INLINE runStepR #-} runStepR cnt fs sR a = do - let cnt1 = cnt + 1 r <- stepR sR a case r of - SPartial n s -> return $ SContinue n (SepBy1R (cnt1 + n - 1) fs s) - SContinue n s -> return $ SContinue n (SepBy1R (cnt1 + n - 1) fs s) - SDone n _ -> processR (cnt1 - n) fs n + SPartial n s -> return $ SContinue n (SepBy1R (cnt + n) fs s) + SContinue n s -> return $ SContinue n (SepBy1R (cnt + n) fs s) + -- XXX review, need tests for sepBy1 + SDone n _ -> processR (cnt + n) fs n Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (-cnt) xs step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a @@ -3249,20 +3263,20 @@ sepBy1 r <- extractL sL case r of SDone n b -> extractResult n fs b - SContinue n s -> return $ SContinue n (SepBy1InitL (cnt + n - 1) fs s) + SContinue n s -> return $ SContinue n (SepBy1InitL (cnt + n) fs s) SPartial _ _ -> error "SPartial in extract" Error err -> return $ Error err extract (SepBy1L cnt fs sL) = do r <- extractL sL case r of SDone n b -> extractResult n fs b - SContinue n s -> return $ SContinue n (SepBy1L (cnt + n - 1) fs s) + SContinue n s -> return $ SContinue n (SepBy1L (cnt + n) fs s) SPartial _ _ -> error "SPartial in extract" Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt) xs - extract (SepBy1InitR fs) = fmap (SDone 1) $ ffinal fs - extract (SepBy1R cnt fs _) = fmap (SDone (1 - cnt)) $ ffinal fs + return $ SDone (- cnt) xs + extract (SepBy1InitR fs) = fmap (SDone 0) $ ffinal fs + extract (SepBy1R cnt fs _) = fmap (SDone (- cnt)) $ ffinal fs ------------------------------------------------------------------------------- -- Interleaving a collection of parsers @@ -3346,7 +3360,7 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial _ ffinal) = FL.Done c -> return $ SDone 0 c IError err -> return $ Error err - extract (Nothing', _, fs) = fmap (SDone 1) $ ffinal fs + extract (Nothing', _, fs) = fmap (SDone 0) $ ffinal fs extract (Just' (Parser pstep pinit pextr), ss, fs) = do ps <- pinit case ps of @@ -3364,8 +3378,8 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial _ ffinal) = IDone b -> do fres <- fstep fs b case fres of - FL.Partial fs1 -> fmap (SDone 1) $ ffinal fs1 - FL.Done c -> return (SDone 1 c) + FL.Partial fs1 -> fmap (SDone 0) $ ffinal fs1 + FL.Done c -> return (SDone 0 c) IError err -> return $ Error err ------------------------------------------------------------------------------- @@ -3486,11 +3500,11 @@ data ManyTillState fs sr sl = ManyTillR !Int !fs !sr | ManyTillL !fs !sl --- | @manyTill chunking test f@ tries the parser @test@ on the input, if @test@ --- fails it backtracks and tries @chunking@, after @chunking@ succeeds @test@ is +-- | @manyTill p test f@ tries the parser @test@ on the input, if @test@ +-- fails it backtracks and tries @p@, after @p@ succeeds @test@ is -- tried again and so on. The parser stops when @test@ succeeds. The output of --- @test@ is discarded and the output of @chunking@ is accumulated by the --- supplied fold. The parser fails if @chunking@ fails. +-- @test@ is discarded and the output of @p@ is accumulated by the +-- supplied fold. The parser fails if @p@ fails. -- -- Stops when the fold @f@ stops. -- @@ -3535,7 +3549,7 @@ manyTill (Parser stepL initialL extractL) case r of SPartial n s -> return $ SPartial n (ManyTillR 0 fs s) SContinue n s -> do - assertM(cnt + 1 - n >= 0) + assertM(cnt + n >= 0) return $ SContinue n (ManyTillR (cnt + n) fs s) SDone n _ -> do b <- ffinal fs @@ -3547,16 +3561,16 @@ manyTill (Parser stepL initialL extractL) return $ SContinue (negate cnt) (ManyTillL fs sl) IDone bl -> do fr <- fstep fs bl - let cnt1 = cnt + 1 + -- XXX review, need tests for manyTill case fr of FL.Partial fs1 -> scrutR fs1 - (SPartial cnt1) - (SContinue cnt1) - (SDone cnt1) + (SPartial (-cnt)) + (SContinue (-cnt)) + (SDone (-cnt)) Error - FL.Done fb -> return $ SDone cnt1 fb + FL.Done fb -> return $ SDone (-cnt) fb IError err -> return $ Error err step (ManyTillL fs st) a = do r <- stepL st a @@ -3582,7 +3596,7 @@ manyTill (Parser stepL initialL extractL) Error err -> return $ Error err SContinue n s -> return $ SContinue n (ManyTillL fs s) SPartial _ _ -> error "SPartial in extract" - extract (ManyTillR _ fs _) = fmap (SDone 1) $ ffinal fs + extract (ManyTillR _ fs _) = fmap (SDone 0) $ ffinal fs -- | @manyThen f collect recover@ repeats the parser @collect@ on the input and -- collects the output in the supplied fold. If the the parser @collect@ fails, diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index 41d182fe24..93e07c9237 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -182,7 +182,8 @@ module Streamly.Internal.Data.Parser.Type Initial (..) -- (..) does not seem to export patterns yet the compiler complains it does. , Step(Partial, Continue, Done, SPartial, SContinue, SDone, Error) - , extractStep + -- , extractStep + , mapCount , bimapOverrideCount , Parser (..) , ParseError (..) @@ -308,25 +309,31 @@ instance Functor (Initial s) where -- to get a result. If the parser returns 'SDone' then the parser can no longer -- take any more input. -- --- The first argument of `SPartial`, `Scontinue` and `SDone` is an integer --- representing adjustment to the current stream position. The stream position --- is adjusted by that amount and the next step would use an input from the new --- position. If n is positive we go forward in the stream, if it is negative we --- go backward. If it is 0 we stay put at the same position and the same input --- is used for the next step. --- --- If the result is 'SContinue', the parser driver retains the input in a --- backtracking buffer, in case of failure the parser can backtrack up to the --- length of the backtracking buffer. Whenever the result is `SPartial` the --- current backtracking buffer is released i.e. we cannot backtrack beyond this --- point in the stream. The parser must ensure that the backtrack position is --- always within the bounds of the backtracking buffer. --- --- If parser is not yet done, we can use the @extract@ operation on the @state@ --- of the parser to extract a result. If the parser has not yet yielded a --- result, @extract@ fails with a 'ParseError' exception. If the parser yielded --- a 'Partial' result in the past then the latest partial result is returned. --- Therefore, if a parser yields a partial result once it cannot fail later on. +-- The @n@ in @SPartial n@, @Scontinue n@ and @SDone n@ is an integer +-- representing the number of elements consumed by the parser. If the current +-- input item is consumed then n is 1, if the current input item is rejected +-- then n is 0. If @n@ is less than 0 then the parser backtracks by n elements +-- prior to the current element before processing next input. If @n@ is greater +-- than 1 then it skips n elements in the stream (skipping is currently not +-- supported) including the current element. +-- Essentially, if the input stream position was @pos@ before processing the +-- current element then the new stream position after processing the element +-- would be @pos + n@. +-- +-- If the parser result is 'SContinue', the parser driver retains the input in +-- a backtracking buffer, in case of failure the parser can backtrack maximum +-- up to the length of the backtracking buffer. Whenever the result is +-- `SPartial` the current backtracking buffer is discarded; this means that we +-- cannot backtrack beyond the currrent position in the stream. The parser must +-- ensure that the backtrack position is always within the bounds of the +-- backtracking buffer, otherwise a runtime error will occur. +-- +-- If the parser is not yet done, we can use the @extract@ operation on the +-- @state@ of the parser to extract a result. If the parser never yielded a +-- result in the past, @extract@ fails with a 'ParseError' exception. If the +-- parser yielded a 'Partial' result in the past then the latest partial result +-- is returned. Therefore, if a parser yields a partial result once then it +-- cannot fail later on. -- -- /Pre-release/ -- @@ -374,17 +381,17 @@ negateDirection (SContinue i s) = SContinue (1 - i) s negateDirection (SDone i b) = SDone (1 - i) b negateDirection (Error s) = Error s -{-# DEPRECATED Partial "Please use @SPartial (1 - n)@ instead of @Partial n@" #-} +{-# DEPRECATED Partial "Use @SPartial (1 - n)@ instead of @Partial n@" #-} pattern Partial :: Int -> s -> Step s b pattern Partial i s <- (negateDirection -> SPartial i s) where Partial i s = SPartial (1 - i) s -{-# DEPRECATED Continue "Please use @SContinue (1 - n)@ instead of @Continue n@" #-} +{-# DEPRECATED Continue "Replace @Continue n@ with @SContinue (1 - n)@ in parser step and with @SContinue (-n)@ in parser extract" #-} pattern Continue :: Int -> s -> Step s b pattern Continue i s <- (negateDirection -> SContinue i s) where Continue i s = SContinue (1 - i) s -{-# DEPRECATED Done "Please use @SDone (1 - n)@ instead of @Done n@" #-} +{-# DEPRECATED Done "Replace @Done n@ with @SDone (1 - n)@ in parser step and with @SDone (-n)@ in parser extract" #-} pattern Done :: Int -> b -> Step s b pattern Done i b <- (negateDirection -> SDone i b) where Done i b = SDone (1 - i) b @@ -417,6 +424,7 @@ instance Functor (Step s) where {-# INLINE fmap #-} fmap = second +{- {-# INLINE assertStepCount #-} assertStepCount :: Int -> Step s b -> Step s b assertStepCount i step = @@ -430,12 +438,32 @@ assertStepCount i step = -- {-# INLINE extractStep #-} extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b) -extractStep f res = +extractStep pextract res = case res of + {- SPartial n s1 -> assertStepCount n <$> f s1 SDone n b -> return $ SDone n b SContinue n s1 -> assertStepCount n <$> f s1 Error err -> return $ Error err + -} + SPartial 1 s1 -> pextract s1 + SPartial _ _ -> return res + SContinue 1 s1 -> pextract s1 + SContinue _ _ -> return res + SDone n b -> return $ SDone n b + Error err -> return $ Error err + -} + +-- | Map a function over the count. +-- +{-# INLINE mapCount #-} +mapCount :: (Int -> Int) -> Step s b -> Step s b +mapCount f res = + case res of + SPartial n s -> SPartial (f n) s + SDone n b -> SDone (f n) b + SContinue n s -> SContinue (f n) s + Error err -> Error err -- | Map a monadic function over the result @b@ in @Step s b@. -- @@ -994,12 +1022,12 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) = res <- initialR return $ case res of - IPartial rR -> SContinue (1 - cnt) (AltParseR rR) - IDone b -> SDone (1 - cnt) b + IPartial rR -> SContinue (- cnt) (AltParseR rR) + IDone b -> SDone (- cnt) b IError err -> Error err SPartial _ _ -> error "Bug: alt: extractL 'Partial'" SContinue n s -> do - assertM(n == 1 - cnt) + assertM(n == (- cnt)) return $ SContinue n (AltParseL 0 s) {-# ANN type Fused3 Fuse #-} @@ -1039,35 +1067,35 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) = {-# INLINE step #-} step (Fused3 st cnt fs) a = do r <- step1 st a - let cnt1 = cnt + 1 case r of SPartial n s -> do - assertM(cnt1 >= 1 - n) - return $ SContinue n (Fused3 s (cnt1 + n - 1) fs) + assertM(cnt + n >= 0) + return $ SContinue n (Fused3 s (cnt + n) fs) SContinue n s -> do - assertM(cnt1 >= 1 - n) - return $ SContinue n (Fused3 s (cnt1 + n - 1) fs) + assertM(cnt + n >= 0) + return $ SContinue n (Fused3 s (cnt + n) fs) SDone n b -> do - assertM(cnt1 >= 1 - n) + assertM(cnt + n >= 0) fstep fs b >>= handleCollect (SPartial n) (SDone n) Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt) xs + -- XXX review, need a test for this + return $ SDone (- cnt) xs - extract (Fused3 _ 0 fs) = fmap (SDone 1) (ffinal fs) + extract (Fused3 _ 0 fs) = fmap (SDone 0) (ffinal fs) extract (Fused3 s cnt fs) = do r <- extract1 s case r of - Error _ -> fmap (SDone (1 - cnt)) (ffinal fs) + Error _ -> fmap (SDone (- cnt)) (ffinal fs) SDone n b -> do - assertM(1 - n <= cnt) + assertM((- n) <= cnt) fs1 <- fstep fs b case fs1 of FL.Partial s1 -> fmap (SDone n) (ffinal s1) FL.Done b1 -> return (SDone n b1) SPartial _ _ -> error "splitMany: SPartial in extract" SContinue n s1 -> do - assertM(1 - n == cnt) + assertM((- n) == cnt) return (SContinue n (Fused3 s1 0 fs)) -- | Like splitMany, but inner fold emits an output at the end even if no input @@ -1103,34 +1131,33 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) = {-# INLINE step #-} step (Fused3 st cnt fs) a = do r <- step1 st a - let cnt1 = cnt + 1 case r of SPartial n s -> do - assertM(cnt1 >= 1 - n) - return $ SContinue n (Fused3 s (cnt1 + n - 1) fs) + assertM(cnt + n >= 0) + return $ SContinue n (Fused3 s (cnt + n) fs) SContinue n s -> do - assertM(cnt1 >= 1 - n) - return $ SContinue n (Fused3 s (cnt1 + n - 1) fs) + assertM(cnt + n >= 0) + return $ SContinue n (Fused3 s (cnt + n) fs) SDone n b -> do - assertM(cnt1 >= 1 - n) + assertM(cnt + n >= 0) fstep fs b >>= handleCollect (SPartial n) (SDone n) Error _ -> do xs <- ffinal fs - return $ SDone (1 - cnt1) xs + return $ SDone (- cnt) xs extract (Fused3 s cnt fs) = do r <- extract1 s case r of - Error _ -> fmap (SDone (1 - cnt)) (ffinal fs) + Error _ -> fmap (SDone (- cnt)) (ffinal fs) SDone n b -> do - assertM(1 - n <= cnt) + assertM((- n) <= cnt) fs1 <- fstep fs b case fs1 of FL.Partial s1 -> fmap (SDone n) (ffinal s1) FL.Done b1 -> return (SDone n b1) SPartial _ _ -> error "splitMany: SPartial in extract" SContinue n s1 -> do - assertM(1 - n == cnt) + assertM((- n) == cnt) return (SContinue n (Fused3 s1 0 fs)) -- | See documentation of 'Streamly.Internal.Data.Parser.some'. @@ -1180,60 +1207,58 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) = step (Fused3 st cnt (Left fs)) a = do r <- step1 st a -- In the Left state, count is used only for the assert - let cnt1 = cnt + 1 case r of SPartial n s -> do - assertM(cnt1 >= 1 - n) - return $ SContinue n (Fused3 s (cnt1 + n - 1) (Left fs)) + assertM(cnt + n >= 0) + return $ SContinue n (Fused3 s (cnt + n) (Left fs)) SContinue n s -> do - assertM(cnt1 >= 1 - n) - return $ SContinue n (Fused3 s (cnt1 + n - 1) (Left fs)) + assertM(cnt + n >= 0) + return $ SContinue n (Fused3 s (cnt + n) (Left fs)) SDone n b -> do - assertM(cnt1 >= 1 - n) + assertM(cnt + n >= 0) fstep fs b >>= handleCollect (SPartial n) (SDone n) Error err -> return $ Error err step (Fused3 st cnt (Right fs)) a = do r <- step1 st a - let cnt1 = cnt + 1 case r of SPartial n s -> do - assertM(cnt1 >= 1 - n) - return $ SPartial n (Fused3 s (cnt1 + n - 1) (Right fs)) + assertM(cnt + n >= 0) + return $ SPartial n (Fused3 s (cnt + n) (Right fs)) SContinue n s -> do - assertM(cnt1 >= 1 - n) - return $ SContinue n (Fused3 s (cnt1 + n - 1) (Right fs)) + assertM(cnt + n >= 0) + return $ SContinue n (Fused3 s (cnt + n) (Right fs)) SDone n b -> do - assertM(cnt1 >= 1 - n) + assertM(cnt + n >= 0) fstep fs b >>= handleCollect (SPartial n) (SDone n) - Error _ -> SDone (1 - cnt1) <$> ffinal fs + Error _ -> SDone (- cnt) <$> ffinal fs extract (Fused3 s cnt (Left fs)) = do r <- extract1 s case r of Error err -> return (Error err) SDone n b -> do - assertM(1 - n <= cnt) + assertM((- n) <= cnt) fs1 <- fstep fs b case fs1 of FL.Partial s1 -> fmap (SDone n) (ffinal s1) FL.Done b1 -> return (SDone n b1) SPartial _ _ -> error "splitSome: SPartial in extract" SContinue n s1 -> do - assertM(1 - n == cnt) + assertM((- n) == cnt) return (SContinue n (Fused3 s1 0 (Left fs))) extract (Fused3 s cnt (Right fs)) = do r <- extract1 s case r of - Error _ -> fmap (SDone (1 - cnt)) (ffinal fs) + Error _ -> fmap (SDone (- cnt)) (ffinal fs) SDone n b -> do - assertM(1 - n <= cnt) + assertM((- n) <= cnt) fs1 <- fstep fs b case fs1 of FL.Partial s1 -> fmap (SDone n) (ffinal s1) FL.Done b1 -> return (SDone n b1) SPartial _ _ -> error "splitSome: SPartial in extract" SContinue n s1 -> do - assertM(1 - n == cnt) + assertM((- n) == cnt) return (SContinue n (Fused3 s1 0 (Right fs))) -- | A parser that always fails with an error message without consuming diff --git a/core/src/Streamly/Internal/Data/ParserK/Type.hs b/core/src/Streamly/Internal/Data/ParserK/Type.hs index 34b2826a42..6f9d9d1734 100644 --- a/core/src/Streamly/Internal/Data/ParserK/Type.hs +++ b/core/src/Streamly/Internal/Data/ParserK/Type.hs @@ -444,17 +444,12 @@ adaptWith pstep initial extract cont !relPos !usedCount !input = do parseContNothing !count !pst = do r <- extract pst case r of - -- IMPORTANT: the n here is from the byte stream parser, that means - -- it is the backtrack element count and not the stream position - -- index into the current input chunk. - ParserD.SDone m b -> - let n = 1 - m - in assert (n >= 0) - (cont (Success (- n) b) (count - n) None) - ParserD.SContinue m pst1 -> - let n = 1 - m - in assert (n >= 0) - (return $ Continue (- n) (parseCont (count - n) pst1)) + ParserD.SDone n b -> + assert (n <= 0) + (cont (Success n b) (count + n) None) + ParserD.SContinue n pst1 -> + assert (n <= 0) + (return $ Continue n (parseCont (count + n) pst1)) ParserD.Error err -> -- XXX It is called only when there is no input chunk. So using -- 0 as the position is correct? @@ -487,8 +482,12 @@ RENAME(adapt,parserK) {-# INLINE parserDone #-} parserDone :: Applicative m => ParseResult b -> Int -> Input a -> m (Step a m b) -parserDone (Success n b) _ _ = assert(n <= 1) `seq` pure (Done n b) -parserDone (Failure n e) _ _ = assert(n <= 1) `seq` pure (Error n e) +parserDone (Success n b) _ _ = + -- trace ("parserDone Success n: " ++ show n) $ + assert(n <= 1) `seq` pure (Done n b) +parserDone (Failure n e) _ _ = + -- trace ("parserDone Failure n: " ++ show n) $ + assert(n <= 1) `seq` pure (Error n e) -- XXX Note that this works only for single element parsers and not for Array -- input parsers. The asserts will fail for array parsers. @@ -516,13 +515,11 @@ toParser parser = ParserD.Parser step initial extract extract cont = do r <- cont None case r of - -- This is extract so no input has been given, therefore, the - -- translation here is (n + 1) rather than n. - Done n b -> assert (n <= 0) (return $ ParserD.SDone (n + 1) b) + Done n b -> assert (n <= 0) (return $ ParserD.SDone n b) Error _ e -> return $ ParserD.Error e Partial _ cont1 -> extract cont1 Continue n cont1 -> - assert (n <= 0) (return $ ParserD.SContinue (n + 1) cont1) + assert (n <= 0) (return $ ParserD.SContinue n cont1) {-# RULES "fromParser/toParser fusion" [2] forall s. toParser (parserK s) = s #-} diff --git a/core/src/Streamly/Internal/Data/Producer/Source.hs b/core/src/Streamly/Internal/Data/Producer/Source.hs index 2858030683..f952ad0b65 100644 --- a/core/src/Streamly/Internal/Data/Producer/Source.hs +++ b/core/src/Streamly/Internal/Data/Producer/Source.hs @@ -211,24 +211,24 @@ parse goExtract !_ buf (List (x:xs)) !pst = do pRes <- pstep pst x case pRes of - SPartial 1 pst1 -> + SPartial 0 pst1 -> goExtract SPEC (List []) (List xs) pst1 SPartial m pst1 -> do - let n = 1 - m + let n = (- m) assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 ++ xs goExtract SPEC (List []) (List src) pst1 - SContinue 1 pst1 -> + SContinue 0 pst1 -> goExtract SPEC (List (x:getList buf)) (List xs) pst1 SContinue m pst1 -> do - let n = 1 - m + let n = (- m) assert (n <= length (x:getList buf)) (return ()) let (src0, buf1) = splitAt n (x:getList buf) src = Prelude.reverse src0 ++ xs goExtract SPEC (List buf1) (List src) pst1 SDone m b -> do - let n = 1 - m + let n = (- m) assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) src = Prelude.reverse src0 @@ -246,17 +246,17 @@ parse pRes <- extract pst case pRes of SPartial _ _ -> error "Bug: parseD: Partial in extract" - SContinue 1 pst1 -> + SContinue 0 pst1 -> goStop buf pst1 SContinue m pst1 -> do - let n = 1 - m + let n = (- m) assert (n <= length (getList buf)) (return ()) let (src0, buf1) = splitAt n (getList buf) src = Prelude.reverse src0 goExtract SPEC (List buf1) (List src) pst1 - SDone 1 b -> return (Right b, source Nothing) + SDone 0 b -> return (Right b, source Nothing) SDone m b -> do - let n = 1 - m + let n = (- m) assert (n <= length (getList buf)) (return ()) let src0 = Prelude.take n (getList buf) src = Prelude.reverse src0 diff --git a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs index b7a263dba6..5cddba5f0f 100644 --- a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs +++ b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs @@ -77,6 +77,7 @@ import qualified Streamly.Internal.Data.Array.Type as Array import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as PR import qualified Streamly.Internal.Data.Parser as PRD +import qualified Streamly.Internal.Data.Stream.Type as Stream import qualified Streamly.Internal.Data.Stream.Generate as StreamD import qualified Streamly.Internal.Data.Stream.Nesting as Nesting import qualified Streamly.Internal.Data.Stream.Transform as StreamD @@ -85,7 +86,7 @@ import Prelude hiding ( Foldable(..), all, any, head, last, lookup, mapM, mapM_ , notElem, splitAt, init, tail, (!!)) import Data.Foldable (length) -import Streamly.Internal.Data.Stream.Type +import Streamly.Internal.Data.Stream.Type hiding (splitAt) #include "DocTestDataStream.hs" @@ -109,22 +110,6 @@ foldr1 f m = do -- Parsers ------------------------------------------------------------------------------ --- Inlined definition. Without the inline "serially/parser/take" benchmark --- degrades and parseMany does not fuse. Even using "inline" at the callsite --- does not help. -{-# INLINE splitAt #-} -splitAt :: Int -> [a] -> ([a],[a]) -splitAt n ls - | n <= 0 = ([], ls) - | otherwise = splitAt' n ls - where - splitAt' :: Int -> [a] -> ([a], [a]) - splitAt' _ [] = ([], []) - splitAt' 1 (x:xs) = ([x], xs) - splitAt' m (x:xs) = (x:xs', xs'') - where - (xs', xs'') = splitAt' (m - 1) xs - -- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need -- to make a newtype. {-# ANN type List NoSpecConstr #-} @@ -180,6 +165,9 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do where + {-# INLINE splitAt #-} + splitAt = Stream.splitAt "Data.Stream.parseBreak" + -- "buf" contains last few items in the stream that we may have to -- backtrack to. -- @@ -331,16 +319,16 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do pRes <- extract pst case pRes of PR.SPartial _ _ -> error "Bug: parseBreak: Partial in extract" - PR.SContinue 1 pst1 -> goStop SPEC buf pst1 + PR.SContinue 0 pst1 -> goStop SPEC buf pst1 PR.SContinue m pst1 -> do - let n = 1 - m + let n = (- m) assert (n <= length (getList buf)) (return ()) let (src0, buf1) = splitAt n (getList buf) src = Prelude.reverse src0 goExtract SPEC (List buf1) (List src) pst1 - PR.SDone 1 b -> return (Right b, StreamD.nil) + PR.SDone 0 b -> return (Right b, StreamD.nil) PR.SDone m b -> do - let n = 1 - m + let n = (- m) assert (n <= length (getList buf)) (return ()) let src0 = Prelude.take n (getList buf) src = Prelude.reverse src0 diff --git a/core/src/Streamly/Internal/Data/Stream/Nesting.hs b/core/src/Streamly/Internal/Data/Stream/Nesting.hs index 8d8e863c31..2fc3fa2aae 100644 --- a/core/src/Streamly/Internal/Data/Stream/Nesting.hs +++ b/core/src/Streamly/Internal/Data/Stream/Nesting.hs @@ -205,13 +205,14 @@ import qualified Streamly.Internal.Data.Parser as PR import qualified Streamly.Internal.Data.Parser as PRD import qualified Streamly.Internal.Data.RingArray as RB import qualified Streamly.Internal.Data.Stream.Generate as Stream +import qualified Streamly.Internal.Data.Stream.Type as Stream import qualified Streamly.Internal.Data.Unfold.Type as Unfold import Streamly.Internal.Data.Stream.Transform (intersperse, intersperseEndByM) -import Streamly.Internal.Data.Stream.Type +import Streamly.Internal.Data.Stream.Type hiding (splitAt) -import Prelude hiding (concatMap, mapM, zipWith) +import Prelude hiding (concatMap, mapM, zipWith, splitAt) #include "DocTestDataStream.hs" @@ -1594,6 +1595,9 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) = where + {-# INLINE splitAt #-} + splitAt = Stream.splitAt "Data.StreamK.parseMany" + {-# INLINE_LATE stepOuter #-} -- Buffer is empty, get the first element from the stream, initialize the -- fold and then go to stream processing loop. @@ -1780,19 +1784,19 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) = pRes <- extract pst case pRes of PR.SPartial _ _ -> error "Bug: parseMany: Partial in extract" - PR.SContinue 1 pst1 -> + PR.SContinue 0 pst1 -> return $ Skip $ ParseChunksStop buf pst1 PR.SContinue m pst1 -> do - let n = 1 - m + let n = (- m) assert (n <= length buf) (return ()) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 return $ Skip $ ParseChunksExtract src buf1 pst1 - PR.SDone 1 b -> do + PR.SDone 0 b -> do return $ Skip $ ParseChunksYield (Right b) (ParseChunksInitLeftOver []) PR.SDone m b -> do - let n = 1 - m + let n = (- m) assert (n <= length buf) (return ()) let src = Prelude.reverse (Prelude.take n buf) return $ Skip $ @@ -1890,6 +1894,9 @@ parseIterate func seed (Stream step state) = where + {-# INLINE splitAt #-} + splitAt = Stream.splitAt "Data.StreamK.parseIterate" + {-# INLINE_LATE stepOuter #-} -- Buffer is empty, go to stream processing loop stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do @@ -2062,19 +2069,19 @@ parseIterate func seed (Stream step state) = pRes <- extract pst case pRes of PR.SPartial _ _ -> error "Bug: parseIterate: Partial in extract" - PR.SContinue 1 pst1 -> + PR.SContinue 0 pst1 -> return $ Skip $ ConcatParseStop buf pstep pst1 extract PR.SContinue m pst1 -> do - let n = 1 - m + let n = (- m) assert (n <= length buf) (return ()) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract - PR.SDone 1 b -> do + PR.SDone 0 b -> do return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitLeftOver []) PR.SDone m b -> do - let n = 1 - m + let n = (- m) assert (n <= length buf) (return ()) let src = Prelude.reverse (Prelude.take n buf) return $ Skip $ diff --git a/core/src/Streamly/Internal/Data/Stream/Type.hs b/core/src/Streamly/Internal/Data/Stream/Type.hs index c0067f07f5..0383d35074 100644 --- a/core/src/Streamly/Internal/Data/Stream/Type.hs +++ b/core/src/Streamly/Internal/Data/Stream/Type.hs @@ -153,6 +153,9 @@ module Streamly.Internal.Data.Stream.Type , eqBy , cmpBy + -- * Utilities + , splitAt + -- * Deprecated , sliceOnSuffix , unfoldMany @@ -182,7 +185,7 @@ import GHC.Base (build) import GHC.Exts (IsList(..), IsString(..), oneShot) import GHC.Types (SPEC(..)) import Prelude hiding - (head, map, mapM, take, concatMap, takeWhile, zipWith, concat) + (head, map, mapM, take, concatMap, takeWhile, zipWith, concat, splitAt) import Text.Read ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec , readListPrecDefault) @@ -2314,3 +2317,41 @@ instance MonadTrans CrossStream where instance (MonadThrow m) => MonadThrow (CrossStream m) where throwM = lift . throwM + +------------------------------------------------------------------------------ +-- Utilities +------------------------------------------------------------------------------ + +-- | Inlined definition. Without the inline "serially/parser/take" benchmark +-- degrades and parseMany does not fuse. Even using "inline" at the callsite +-- does not help. +{-# INLINE splitAt #-} +splitAt :: String -> Int -> [a] -> ([a],[a]) +splitAt desc n ls + | n < 0 = seekOver n + | n == 0 = ([], ls) + | otherwise = splitAt' n ls + + where + + splitAt' :: Int -> [a] -> ([a], [a]) + splitAt' 0 [] = ([], []) + splitAt' m [] = seekUnder n m + splitAt' 1 (x:xs) = ([x], xs) + splitAt' m (x:xs) = (x:xs', xs'') + + where + + (xs', xs'') = splitAt' (m - 1) xs + + seekOver x = + error $ desc ++ ": bug in parser, seeking [" + ++ show (negate x) + ++ "] elements in future" + + seekUnder x y = + error $ desc ++ ": bug in parser, backtracking [" + ++ show x + ++ "] elements. Goes [" + ++ show y + ++ "] elements beyond backtrack buffer" diff --git a/core/src/Streamly/Internal/Data/StreamK.hs b/core/src/Streamly/Internal/Data/StreamK.hs index c77d96f6cb..b3f167cfc0 100644 --- a/core/src/Streamly/Internal/Data/StreamK.hs +++ b/core/src/Streamly/Internal/Data/StreamK.hs @@ -1153,20 +1153,6 @@ withCatchError m h = -- Parsing ------------------------------------------------------------------------------- --- Inlined definition. -{-# INLINE splitAt #-} -splitAt :: Int -> [a] -> ([a],[a]) -splitAt n ls - | n <= 0 = ([], ls) - | otherwise = splitAt' n ls - where - splitAt' :: Int -> [a] -> ([a], [a]) - splitAt' _ [] = ([], []) - splitAt' 1 (x:xs) = ([x], xs) - splitAt' m (x:xs) = (x:xs', xs'') - where - (xs', xs'') = splitAt' (m - 1) xs - -- | Run a 'Parser' over a stream and return rest of the Stream. {-# INLINE_NORMAL parseDBreak #-} parseDBreak @@ -1183,6 +1169,9 @@ parseDBreak (PR.Parser pstep initial extract) stream = do where + {-# INLINE splitAt #-} + splitAt = Stream.splitAt "Data.StreamK.parseDBreak" + -- "buf" contains last few items in the stream that we may have to -- backtrack to. -- @@ -1197,15 +1186,15 @@ parseDBreak (PR.Parser pstep initial extract) stream = do let src = Prelude.reverse buf return (Left (ParseError err), fromList src) PR.SDone m b -> do - let n = 1 - m + let n = (- m) assertM(n <= length buf) let src0 = Prelude.take n buf src = Prelude.reverse src0 return (Right b, fromList src) PR.SPartial _ _ -> error "Bug: parseBreak: Partial in extract" - PR.SContinue 1 s -> goStream nil buf s + PR.SContinue 0 s -> goStream nil buf s PR.SContinue m s -> do - let n = 1 - m + let n = (- m) assertM(n <= length buf) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 @@ -1306,19 +1295,6 @@ parseChunks = Array.parse -- ParserK Singular ------------------------------------------------------------------------------- -{-# INLINE backTrackSingular #-} -backTrackSingular :: Int -> [a] -> StreamK m a -> (StreamK m a, [a]) -backTrackSingular = go - - where - - go _ [] stream = (stream, []) - go n xs stream | n <= 0 = (stream, xs) - go n xs stream = - let (appendBuf, newBTBuf) = splitAt n xs - in (append (fromList (Prelude.reverse appendBuf)) stream, newBTBuf) - - -- | Similar to 'parseBreak' but works on singular elements. -- {-# INLINE_NORMAL parseBreak #-} @@ -1333,6 +1309,12 @@ parseBreak parser input = do where + {-# INLINE backtrack #-} + -- backtrack :: Int -> [a] -> StreamK m a -> (StreamK m a, [a]) + backtrack n xs stream = + let (pre, post) = Stream.splitAt "Data.StreamK.parseBreak" n xs + in (append (fromList (Prelude.reverse pre)) stream, post) + {-# INLINE goStop #-} goStop :: [a] @@ -1349,30 +1331,26 @@ parseBreak parser input = do ParserK.Partial n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= length backBuf) - let (s1, backBuf1) = backTrackSingular n1 backBuf nil + let (s1, backBuf1) = backtrack n1 backBuf nil in go backBuf1 cont1 s1 ParserK.Continue 0 cont1 -> go backBuf cont1 nil ParserK.Continue n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= length backBuf) - let (s1, backBuf1) = backTrackSingular n1 backBuf nil + let (s1, backBuf1) = backtrack n1 backBuf nil in go backBuf1 cont1 s1 ParserK.Done 0 b -> return (Right b, nil) ParserK.Done n b -> do let n1 = negate n assertM(n1 >= 0 && n1 <= length backBuf) - let (s1, _) = backTrackSingular n1 backBuf nil + let (s1, _) = backtrack n1 backBuf nil in return (Right b, s1) ParserK.Error _ err -> let strm = fromList (Prelude.reverse backBuf) in return (Left (ParseError err), strm) - seekErr n = - error $ "parseBreak: Partial: forward seek not implemented n = " - ++ show n - yieldk :: [a] -> (ParserK.Input a -> m (ParserK.Step a m b)) @@ -1386,34 +1364,31 @@ parseBreak parser input = do case pRes of ParserK.Partial 1 cont1 -> go [] cont1 stream ParserK.Partial 0 cont1 -> go [] cont1 (cons element stream) - ParserK.Partial n _ | n > 1 -> seekErr n ParserK.Partial n cont1 -> do -- n < 0 case let n1 = negate n bufLen = length backBuf s = cons element stream assertM(n1 >= 0 && n1 <= bufLen) - let (s1, _) = backTrackSingular n1 backBuf s + let (s1, _) = backtrack n1 backBuf s go [] cont1 s1 ParserK.Continue 1 cont1 -> go (element:backBuf) cont1 stream ParserK.Continue 0 cont1 -> go backBuf cont1 (cons element stream) - ParserK.Continue n _ | n > 1 -> seekErr n ParserK.Continue n cont1 -> do let n1 = negate n bufLen = length backBuf s = cons element stream assertM(n1 >= 0 && n1 <= bufLen) - let (s1, backBuf1) = backTrackSingular n1 backBuf s + let (s1, backBuf1) = backtrack n1 backBuf s go backBuf1 cont1 s1 ParserK.Done 1 b -> pure (Right b, stream) ParserK.Done 0 b -> pure (Right b, cons element stream) - ParserK.Done n _ | n > 1 -> seekErr n ParserK.Done n b -> do let n1 = negate n bufLen = length backBuf s = cons element stream assertM(n1 >= 0 && n1 <= bufLen) - let (s1, _) = backTrackSingular n1 backBuf s + let (s1, _) = backtrack n1 backBuf s pure (Right b, s1) ParserK.Error _ err -> let strm = diff --git a/core/src/Streamly/Internal/Unicode/Parser.hs b/core/src/Streamly/Internal/Unicode/Parser.hs index 6146689ee5..f468283995 100644 --- a/core/src/Streamly/Internal/Unicode/Parser.hs +++ b/core/src/Streamly/Internal/Unicode/Parser.hs @@ -410,16 +410,16 @@ number = Parser (\s a -> return $ step s a) initial (return . extract) {-# INLINE extract #-} extract SPInitial = Error $ exitSPInitial "end of input" extract (SPSign _) = Error $ exitSPSign "end of input" - extract (SPAfterSign mult num) = SDone 1 $ exitSPAfterSign mult num - extract (SPDot mult num) = SDone 0 $ exitSPAfterSign mult num + extract (SPAfterSign mult num) = SDone 0 $ exitSPAfterSign mult num + extract (SPDot mult num) = SDone (-1) $ exitSPAfterSign mult num extract (SPAfterDot mult num decimalPlaces) = - SDone 1 $ exitSPAfterDot mult num decimalPlaces - extract (SPExponent mult num decimalPlaces) = SDone 0 $ exitSPAfterDot mult num decimalPlaces - extract (SPExponentWithSign mult num decimalPlaces _) = + extract (SPExponent mult num decimalPlaces) = SDone (-1) $ exitSPAfterDot mult num decimalPlaces + extract (SPExponentWithSign mult num decimalPlaces _) = + SDone (-2) $ exitSPAfterDot mult num decimalPlaces extract (SPAfterExponent mult num decimalPlaces powerMult powerNum) = - SDone 1 $ exitSPAfterExponent mult num decimalPlaces powerMult powerNum + SDone 0 $ exitSPAfterExponent mult num decimalPlaces powerMult powerNum type MantissaInt = Int type OverflowPower = Int @@ -548,16 +548,16 @@ doubleParser = Parser (\s a -> return $ step s a) initial (return . extract) {-# INLINE extract #-} extract DPInitial = Error $ exitDPInitial "end of input" extract (DPSign _) = Error $ exitDPSign "end of input" - extract (DPAfterSign mult num opow) = SDone 1 $ exitDPAfterSign mult num opow - extract (DPDot mult num opow) = SDone 0 $ exitDPAfterSign mult num opow + extract (DPAfterSign mult num opow) = SDone 0 $ exitDPAfterSign mult num opow + extract (DPDot mult num opow) = SDone (-1) $ exitDPAfterSign mult num opow extract (DPAfterDot mult num opow) = - SDone 1 $ exitDPAfterDot mult num opow - extract (DPExponent mult num opow) = SDone 0 $ exitDPAfterDot mult num opow - extract (DPExponentWithSign mult num opow _) = + extract (DPExponent mult num opow) = SDone (-1) $ exitDPAfterDot mult num opow + extract (DPExponentWithSign mult num opow _) = + SDone (-2) $ exitDPAfterDot mult num opow extract (DPAfterExponent mult num opow powerMult powerNum) = - SDone 1 $ exitDPAfterExponent mult num opow powerMult powerNum + SDone 0 $ exitDPAfterExponent mult num opow powerMult powerNum -- XXX We can have a `realFloat` parser instead to parse any RealFloat value. -- And a integral parser to read any integral value. diff --git a/core/src/Streamly/Internal/Unicode/Stream.hs b/core/src/Streamly/Internal/Unicode/Stream.hs index 657c582029..3d0e2d0201 100644 --- a/core/src/Streamly/Internal/Unicode/Stream.hs +++ b/core/src/Streamly/Internal/Unicode/Stream.hs @@ -544,7 +544,7 @@ parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract ErrorOnCodingFailure -> return $ ParserD.Error $ prefix ++ "Not enough input" TransliterateCodingFailure -> - return (ParserD.SDone 1 replacementChar) + return (ParserD.SDone 0 replacementChar) -- XXX We shouldn't error out here. There is no way to represent an -- empty parser result unless we return a "Maybe" type. DropOnCodingFailure -> error $ prefix ++ "Not enough input" diff --git a/test/Streamly/Test/Data/Array/Stream.hs b/test/Streamly/Test/Data/Array/Stream.hs index b758da8dea..45d03d95cb 100644 --- a/test/Streamly/Test/Data/Array/Stream.hs +++ b/test/Streamly/Test/Data/Array/Stream.hs @@ -57,7 +57,7 @@ parseBreak = do $ chunksOf clen (Array.createOf clen) (Stream.fromList ls) parser = Parser.fromFold (Fold.take tlen Fold.toList) - in run $ Array.parseBreakChunksK parser input + in run $ Array.parseBreak (Array.parserK parser) input ls2 <- run $ Stream.fold Fold.toList (Array.concat $ Stream.fromStreamK str) case ls1 of Right x -> listEquals (==) (x ++ ls2) ls diff --git a/test/Streamly/Test/Data/Parser.hs b/test/Streamly/Test/Data/Parser.hs index 171f55fa0f..3e978e035c 100644 --- a/test/Streamly/Test/Data/Parser.hs +++ b/test/Streamly/Test/Data/Parser.hs @@ -1337,6 +1337,7 @@ sanityParseDBreak jumps = it (show jumps) $ do lst <- K.toList rest (val, lst) `shouldBe` (expectedResult jumps tape) +{- sanityParseBreakChunksK :: [Move] -> SpecWith () sanityParseBreakChunksK jumps = it (show jumps) $ do (val, rest) <- @@ -1344,6 +1345,7 @@ sanityParseBreakChunksK jumps = it (show jumps) $ do $ K.fromList $ Prelude.map A.fromList chunkedTape lst <- Prelude.map A.toList <$> K.toList rest (val, concat lst) `shouldBe` (expectedResult jumps tape) +-} sanityParseMany :: [Move] -> SpecWith () sanityParseMany jumps = it (show jumps) $ do @@ -1477,13 +1479,21 @@ mainCommon ptt = do main :: IO () main = +{- + let predicate = (==0) + prsr = P.many (P.satisfy (const True)) FL.toList + S.fold FL.toList + $ S.catRights + $ SI.parseMany2 (P.takeEndBy predicate prsr) $ S.fromList [0 :: Int] + return () + -} hspec $ H.parallel $ modifyMaxSuccess (const maxTestCount) $ do describe moduleName $ do parserSanityTests "Stream.parseBreak" sanityParseBreak parserSanityTests "StreamK.parseDBreak" sanityParseDBreak - parserSanityTests "A.sanityParseBreakChunksK" sanityParseBreakChunksK + -- parserSanityTests "A.sanityParseBreakChunksK" sanityParseBreakChunksK parserSanityTests "Stream.parseMany" sanityParseMany parserSanityTests "Stream.parseIterate" sanityParseIterate describe "Stream parsing" $ do diff --git a/test/Streamly/Test/Data/ParserK.hs b/test/Streamly/Test/Data/ParserK.hs index d140ffc65b..9d0589a803 100644 --- a/test/Streamly/Test/Data/ParserK.hs +++ b/test/Streamly/Test/Data/ParserK.hs @@ -108,6 +108,7 @@ sanityParseBreak jumps = it (show jumps) $ do StreamK.parseBreak (ParserK.parserK (jumpParser jumps)) $ StreamK.fromList tape lst <- StreamK.toList rest + putStrLn $ show (val, lst) (val, lst) `shouldBe` (expectedResult jumps tape) sanityParseBreakChunks :: [Move] -> H.SpecWith () diff --git a/test/lib/Streamly/Test/Parser/Common.hs b/test/lib/Streamly/Test/Parser/Common.hs index 3fd91dab0d..6655d410bc 100644 --- a/test/lib/Streamly/Test/Parser/Common.hs +++ b/test/lib/Streamly/Test/Parser/Common.hs @@ -14,6 +14,7 @@ where -- Imports -------------------------------------------------------------------------------- +import Debug.Trace (trace) import Streamly.Internal.Data.Parser (ParseError(..)) import qualified Streamly.Internal.Data.Parser as P import Test.Hspec @@ -30,21 +31,23 @@ data Move jumpParser :: Monad m => [Move] -> P.Parser Int m [Int] jumpParser jumps = P.Parser step initial done where - initial = pure $ P.IPartial (jumps, []) + initial = trace (show jumps) (pure $ P.IPartial (jumps, [])) step ([], buf) _ = pure $ P.SDone 0 (reverse buf) step (action:xs, buf) a = case action of Consume n - | n == 1 -> pure $ P.SContinue 1 (xs, a:buf) + | n == 1 -> trace ("Consume -- " ++ show a) (pure $ P.SContinue 1 (xs, a:buf)) | n > 0 -> pure $ P.SContinue 1 (Consume (n - 1) : xs, a:buf) | otherwise -> error "Cannot consume <= 0" Custom (P.SPartial i ()) -> pure $ P.SPartial i (xs, buf) - Custom (P.SContinue i ()) -> pure $ P.SContinue i (xs, buf) + Custom (P.SContinue i ()) -> + trace ("SContinue -- " ++ show a) + (pure $ P.SContinue i (xs, buf)) Custom (P.SDone i ()) -> pure $ P.SDone i (reverse buf) Custom (P.Error err) -> pure $ P.Error err - done ([], buf) = pure $ P.SDone 1 (reverse buf) + done ([], buf) = pure $ P.SDone 0 (reverse buf) done (action:xs, buf) = case action of Consume _ -> pure $ P.Error "INCOMPLETE" @@ -79,6 +82,7 @@ expectedResult moves inp = go 0 0 [] moves go (i + n) j (ys ++ slice i n inp) xs go i j ys ((Custom step):xs) | i > inpLen = error "i > inpLen" + {- | i == inpLen = -- Where there is no input we do not move forward by default. -- Hence it is (i - n) and not (i + 1 - n) @@ -87,6 +91,7 @@ expectedResult moves inp = go 0 0 [] moves P.SContinue n () -> go (i + n - 1) j ys xs P.SDone n () -> (Right ys, slice_ (max (i + n - 1) j) inp) P.Error err -> (Left (ParseError err), slice_ j inp) + -} | otherwise = case step of P.SPartial n () -> go (i + n) (max j (i + n)) ys xs @@ -168,14 +173,14 @@ parserSanityTests desc testRunner = ] Prelude.mapM_ testRunner $ createPaths - [ Consume tapeLen + [ Consume (tapeLen - 1) , Custom (P.SContinue 1 ()) , Custom (P.SContinue (-9) ()) , Custom (P.SDone (-4) ()) ] Prelude.mapM_ testRunner $ createPaths - [ Consume tapeLen + [ Consume (tapeLen - 1) , Custom (P.SContinue 1 ()) , Custom (P.SContinue (-9) ()) , Custom (P.Error "Message3") From b8f00c3bc41f4a2755599be05f602fa1c4dfb7f3 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 28 May 2025 11:22:11 +0530 Subject: [PATCH 17/20] Add testcase for Alternative Parser --- core/src/Streamly/Internal/Data/Array.hs | 2 - .../Streamly/Internal/Data/Array/Generic.hs | 3 - core/src/Streamly/Internal/Data/Parser.hs | 39 ++-- .../src/Streamly/Internal/Data/Parser/Type.hs | 36 ---- test/Streamly/Test/Data/Parser.hs | 168 ++++++++++++------ test/Streamly/Test/Data/ParserK.hs | 1 - test/lib/Streamly/Test/Parser/Common.hs | 19 +- 7 files changed, 131 insertions(+), 137 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index a5bad2011e..2fdf584f2d 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -1236,8 +1236,6 @@ adaptCWith pstep initial extract cont !offset0 !usedCount !input = do move n = cur + n * elemSize curOff = (cur - start) `div` elemSize nextOff = (next - start) `div` elemSize - -- The "n" here is stream position index wrt the array start, and - -- not the backtrack count as returned by byte stream parsers. case pRes of ParserD.SDone 1 b -> onDone nextOff b diff --git a/core/src/Streamly/Internal/Data/Array/Generic.hs b/core/src/Streamly/Internal/Data/Array/Generic.hs index 62d00bd599..03ca4dc93b 100644 --- a/core/src/Streamly/Internal/Data/Array/Generic.hs +++ b/core/src/Streamly/Internal/Data/Array/Generic.hs @@ -613,9 +613,6 @@ adaptCGWith pstep initial extract cont !offset0 !usedCount !input = do move n = cur + n curOff = cur - start nextOff = next - start - -- The "n" here is how many items have been consumed by the parser - -- from the array which is the same as the stream position index - -- wrt the array start. case pRes of ParserD.SDone 1 b -> onDone nextOff b diff --git a/core/src/Streamly/Internal/Data/Parser.hs b/core/src/Streamly/Internal/Data/Parser.hs index be60323cd6..0012b6955d 100644 --- a/core/src/Streamly/Internal/Data/Parser.hs +++ b/core/src/Streamly/Internal/Data/Parser.hs @@ -1186,6 +1186,19 @@ blockWithQuotes isEsc isQuote bopen bclose err $ "blockWithQuotes: finished, inside an unfinished quote, " ++ "after an escape char, at block nest level " ++ show level +{-# INLINE takeEndByDone #-} +takeEndByDone :: Monad f => (s -> f (Step s b)) -> Step s b -> f (Step s b) +takeEndByDone pextract res = + -- If the parser is backtracking we let it backtrack even if the + -- predicate is true. + case res of + SPartial 1 s1 -> mapCount (+1) <$> pextract s1 + SPartial _ _ -> return res + SContinue 1 s1 -> mapCount (+1) <$> pextract s1 + SContinue _ _ -> return res + SDone n b -> return $ SDone n b + Error err -> return $ Error err + -- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by -- the supplied predicate. The separator is also taken with the token. -- @@ -1218,19 +1231,7 @@ takeEndBy cond (Parser pstep pinitial pextract) = res <- pstep s a if not (cond a) then return res - else - -- XXX Check if there are any other such cases where we are - -- extracting like this. - - -- If the parser is backtracking we let it backtrack even if the - -- predicate is true. - case res of - SPartial 1 s1 -> mapCount (+1) <$> pextract s1 - SPartial _ _ -> return res - SContinue 1 s1 -> mapCount (+1) <$> pextract s1 - SContinue _ _ -> return res - SDone n b -> return $ SDone n b - Error err -> return $ Error err + else takeEndByDone pextract res -- | Like 'takeEndBy' but the separator elements can be escaped using an -- escape char determined by the first predicate. The escape characters are @@ -1255,17 +1256,7 @@ takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) = res <- pstep s a if not (isSep a) then return $ first Left' res - -- else fmap (first Left') $ extractStep pextract res - else - -- If the parser is backtracking we let it backtrack even if the - -- predicate is true. - fmap (first Left') $ case res of - SPartial 1 s1 -> mapCount (+1) <$> pextract s1 - SPartial _ _ -> return res - SContinue 1 s1 -> mapCount (+1) <$> pextract s1 - SContinue _ _ -> return res - SDone n b -> return $ SDone n b - Error err -> return $ Error err + else fmap (first Left') $ takeEndByDone pextract res step (Right' s) a = do res <- pstep s a diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index 93e07c9237..29992c92e8 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -182,7 +182,6 @@ module Streamly.Internal.Data.Parser.Type Initial (..) -- (..) does not seem to export patterns yet the compiler complains it does. , Step(Partial, Continue, Done, SPartial, SContinue, SDone, Error) - -- , extractStep , mapCount , bimapOverrideCount , Parser (..) @@ -295,11 +294,6 @@ instance Functor (Initial s) where -- -- Folds can only return the right values. Parsers can also return lefts. --- XXX If we assume that the current position of the stream includes the --- element being processed then we can use 'SPartial 0' in the common cases, no --- change from current, and the change required would be just inverting the --- sign of the arguments. - -- | The return type of a 'Parser' step. -- -- The parser driver feeds the input stream to the parser one element at a @@ -424,36 +418,6 @@ instance Functor (Step s) where {-# INLINE fmap #-} fmap = second -{- -{-# INLINE assertStepCount #-} -assertStepCount :: Int -> Step s b -> Step s b -assertStepCount i step = - case step of - SPartial n _ -> assert (i == n) step - SContinue n _ -> assert (i == n) step - SDone n _ -> assert (i == n) step - Error _ -> step - --- | Map an extract function over the state of Step --- -{-# INLINE extractStep #-} -extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b) -extractStep pextract res = - case res of - {- - SPartial n s1 -> assertStepCount n <$> f s1 - SDone n b -> return $ SDone n b - SContinue n s1 -> assertStepCount n <$> f s1 - Error err -> return $ Error err - -} - SPartial 1 s1 -> pextract s1 - SPartial _ _ -> return res - SContinue 1 s1 -> pextract s1 - SContinue _ _ -> return res - SDone n b -> return $ SDone n b - Error err -> return $ Error err - -} - -- | Map a function over the count. -- {-# INLINE mapCount #-} diff --git a/test/Streamly/Test/Data/Parser.hs b/test/Streamly/Test/Data/Parser.hs index 3e978e035c..2e04450435 100644 --- a/test/Streamly/Test/Data/Parser.hs +++ b/test/Streamly/Test/Data/Parser.hs @@ -7,10 +7,13 @@ module Main (main) where import Control.Applicative ((<|>)) import Control.Exception (displayException, try, evaluate, SomeException) +import Control.Monad.IO.Class (MonadIO) import Data.Char (isSpace) import Data.Foldable (for_) import Data.Word (Word8, Word32, Word64) +import Streamly.Internal.Data.Fold (Fold(..)) import Streamly.Internal.Data.MutByteArray (Unbox) +import Streamly.Internal.Data.Parser (Parser(..), Step(..), Initial(..)) import Streamly.Test.Common (listEquals, checkListEqual, chooseInt) import Streamly.Internal.Data.Parser (ParseError(..)) import Test.QuickCheck @@ -771,6 +774,56 @@ altEOF2 producer consumer = Right x -> x == [51] Left _ -> False +{-# INLINE takeWhileFailD #-} +takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b +takeWhileFailD predicate (Fold fstep finitial _ ffinal) = + Parser step initial extract + + where + + initial = do + res <- finitial + return $ case res of + FL.Partial s -> IPartial s + FL.Done b -> IDone b + + step s a = + if predicate a + then do + fres <- fstep s a + return + $ case fres of + FL.Partial s1 -> SContinue 1 s1 + FL.Done b -> SDone 1 b + else return $ Error "fail" + + extract s = fmap (SDone 0) (ffinal s) + +{-# INLINE takeWhileFail #-} +takeWhileFail :: MonadIO m => + (a -> Bool) -> Fold m a b -> PK.ParserK a m b +takeWhileFail p f = PK.parserK (takeWhileFailD p f) + +{-# INLINE takeWhileK #-} +takeWhileK :: MonadIO m => (a -> Bool) -> PK.ParserK a m [a] +takeWhileK p = PK.parserK $ P.takeWhile p FL.toList + +{-# INLINE alt2 #-} +alt2 :: MonadIO m => K.StreamK m Int -> m (Either ParseError [Int]) +alt2 = + K.parse + ( takeWhileFail (<= 5) FL.toList + <|> takeWhileK (<= 7) + ) + +{-# INLINE altD #-} +altD :: MonadIO m => S.Stream m Int -> m (Either P.ParseError [Int]) +altD = + S.parse + ( takeWhileFailD (<= 5) FL.toList + <|> P.takeWhile (<= 7) FL.toList + ) + monad :: ParserTestCase Int (PropertyM IO) ([Int], [Int]) Property monad producer consumer = forAll (listOf (chooseAny :: Gen Int)) $ \ list1 -> @@ -1478,59 +1531,64 @@ mainCommon ptt = do runParserTC ptt takeProperties main :: IO () -main = -{- - let predicate = (==0) - prsr = P.many (P.satisfy (const True)) FL.toList - S.fold FL.toList - $ S.catRights - $ SI.parseMany2 (P.takeEndBy predicate prsr) $ S.fromList [0 :: Int] - return () - -} - hspec $ - H.parallel $ - modifyMaxSuccess (const maxTestCount) $ do - describe moduleName $ do - parserSanityTests "Stream.parseBreak" sanityParseBreak - parserSanityTests "StreamK.parseDBreak" sanityParseDBreak - -- parserSanityTests "A.sanityParseBreakChunksK" sanityParseBreakChunksK - parserSanityTests "Stream.parseMany" sanityParseMany - parserSanityTests "Stream.parseIterate" sanityParseIterate - describe "Stream parsing" $ do - prop "parseMany" parseMany - prop "parseMany2Events" parseMany2Events - prop "parseUnfold" parseUnfold - prop "parserSequence" parserSequence +main = do + -- TODO: convert this test to the same format as other tests. + r <- alt2 (K.fromList [1..20]) + case r of + Right x | x == [1..7] -> putStrLn "K.Alt parse successful" + Right x -> error $ "K.Alt parse got incorrect output " ++ show x + _ -> error $ "K.Alt parse failed" + + r1 <- altD (S.fromList [1..20]) + case r1 of + Right x | x == [1..7] -> putStrLn "Alt parse successful" + Right x -> error $ "Alt parse got incorrect output " ++ show x + _ -> error $ "Alt parse failed" - describe "test for sequence parser" $ do - parseManyWordQuotedBy - prop "P.many == S.parseMany" manyEqParseMany - prop "takeEndBy2" takeEndBy2 - - describe "quotedWordTest" $ do - it "Single quote test" $ do - quotedWordTest "'hello\\\\\"world'" ["hello\\\\\"world"] - quotedWordTest "'hello\\'" ["hello\\"] - it "Double quote test" $ do - quotedWordTest - "\"hello\\\"\\\\w\\'orld\"" - ["hello\"\\w\\'orld"] - - -- We keep Parser and ParserK tests in the same (Parser) executable for 2 - -- reasons: - -- 1. We almost always write Parser tests hence we prioritize Parser over - -- ParserK - -- 2. This results in minimal compilation overhead compared to duplicating - -- or keeping the common part in the library. - -- 2.1. Duplication will result in compilation of this code twice - -- 2.2. Keeping the common part in the library will compile the Parser - -- code even when it's not necessary. For example, if we are running - -- non-parser test suites. - -- - -- One problem is that this module becomes very big for compilation. We can - -- break this further and keep them as a part of "other-modules" in - -- Test.Parser test-suite. - mainCommon TMParserStream - mainCommon TMParserKStreamKChunks - mainCommon TMParserKStreamK - mainCommon TMParserKStreamKChunksGeneric + hspec $ + H.parallel $ + modifyMaxSuccess (const maxTestCount) $ do + describe moduleName $ do + parserSanityTests "Stream.parseBreak" sanityParseBreak + parserSanityTests "StreamK.parseDBreak" sanityParseDBreak + -- parserSanityTests "A.sanityParseBreakChunksK" sanityParseBreakChunksK + parserSanityTests "Stream.parseMany" sanityParseMany + parserSanityTests "Stream.parseIterate" sanityParseIterate + describe "Stream parsing" $ do + prop "parseMany" parseMany + prop "parseMany2Events" parseMany2Events + prop "parseUnfold" parseUnfold + prop "parserSequence" parserSequence + + describe "test for sequence parser" $ do + parseManyWordQuotedBy + prop "P.many == S.parseMany" manyEqParseMany + prop "takeEndBy2" takeEndBy2 + + describe "quotedWordTest" $ do + it "Single quote test" $ do + quotedWordTest "'hello\\\\\"world'" ["hello\\\\\"world"] + quotedWordTest "'hello\\'" ["hello\\"] + it "Double quote test" $ do + quotedWordTest + "\"hello\\\"\\\\w\\'orld\"" + ["hello\"\\w\\'orld"] + + -- We keep Parser and ParserK tests in the same (Parser) executable for 2 + -- reasons: + -- 1. We almost always write Parser tests hence we prioritize Parser over + -- ParserK + -- 2. This results in minimal compilation overhead compared to duplicating + -- or keeping the common part in the library. + -- 2.1. Duplication will result in compilation of this code twice + -- 2.2. Keeping the common part in the library will compile the Parser + -- code even when it's not necessary. For example, if we are running + -- non-parser test suites. + -- + -- One problem is that this module becomes very big for compilation. We can + -- break this further and keep them as a part of "other-modules" in + -- Test.Parser test-suite. + mainCommon TMParserStream + mainCommon TMParserKStreamKChunks + mainCommon TMParserKStreamK + mainCommon TMParserKStreamKChunksGeneric diff --git a/test/Streamly/Test/Data/ParserK.hs b/test/Streamly/Test/Data/ParserK.hs index 9d0589a803..d140ffc65b 100644 --- a/test/Streamly/Test/Data/ParserK.hs +++ b/test/Streamly/Test/Data/ParserK.hs @@ -108,7 +108,6 @@ sanityParseBreak jumps = it (show jumps) $ do StreamK.parseBreak (ParserK.parserK (jumpParser jumps)) $ StreamK.fromList tape lst <- StreamK.toList rest - putStrLn $ show (val, lst) (val, lst) `shouldBe` (expectedResult jumps tape) sanityParseBreakChunks :: [Move] -> H.SpecWith () diff --git a/test/lib/Streamly/Test/Parser/Common.hs b/test/lib/Streamly/Test/Parser/Common.hs index 6655d410bc..13a565491b 100644 --- a/test/lib/Streamly/Test/Parser/Common.hs +++ b/test/lib/Streamly/Test/Parser/Common.hs @@ -14,7 +14,6 @@ where -- Imports -------------------------------------------------------------------------------- -import Debug.Trace (trace) import Streamly.Internal.Data.Parser (ParseError(..)) import qualified Streamly.Internal.Data.Parser as P import Test.Hspec @@ -31,19 +30,17 @@ data Move jumpParser :: Monad m => [Move] -> P.Parser Int m [Int] jumpParser jumps = P.Parser step initial done where - initial = trace (show jumps) (pure $ P.IPartial (jumps, [])) + initial = pure $ P.IPartial (jumps, []) step ([], buf) _ = pure $ P.SDone 0 (reverse buf) step (action:xs, buf) a = case action of Consume n - | n == 1 -> trace ("Consume -- " ++ show a) (pure $ P.SContinue 1 (xs, a:buf)) + | n == 1 -> pure $ P.SContinue 1 (xs, a:buf) | n > 0 -> pure $ P.SContinue 1 (Consume (n - 1) : xs, a:buf) | otherwise -> error "Cannot consume <= 0" Custom (P.SPartial i ()) -> pure $ P.SPartial i (xs, buf) - Custom (P.SContinue i ()) -> - trace ("SContinue -- " ++ show a) - (pure $ P.SContinue i (xs, buf)) + Custom (P.SContinue i ()) -> pure $ P.SContinue i (xs, buf) Custom (P.SDone i ()) -> pure $ P.SDone i (reverse buf) Custom (P.Error err) -> pure $ P.Error err @@ -82,16 +79,6 @@ expectedResult moves inp = go 0 0 [] moves go (i + n) j (ys ++ slice i n inp) xs go i j ys ((Custom step):xs) | i > inpLen = error "i > inpLen" - {- - | i == inpLen = - -- Where there is no input we do not move forward by default. - -- Hence it is (i - n) and not (i + 1 - n) - case step of - P.SPartial n () -> go (i + n - 1) (max j (i + n - 1)) ys xs - P.SContinue n () -> go (i + n - 1) j ys xs - P.SDone n () -> (Right ys, slice_ (max (i + n - 1) j) inp) - P.Error err -> (Left (ParseError err), slice_ j inp) - -} | otherwise = case step of P.SPartial n () -> go (i + n) (max j (i + n)) ys xs From f03ca450cc9f626060f67045b25e18a7875c9c55 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 28 May 2025 11:22:27 +0530 Subject: [PATCH 18/20] Update docs of Parser and ParserK types --- .../src/Streamly/Internal/Data/Parser/Type.hs | 67 ++++++++------- .../Streamly/Internal/Data/ParserK/Type.hs | 84 +++++++++++-------- 2 files changed, 89 insertions(+), 62 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index 29992c92e8..acb25f0589 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -252,6 +252,10 @@ import Prelude hiding (concatMap, filter) -- where the processing in intiial is just a sepcial case of step, see -- takeBetween for example. +-- XXX IPartial indicates that the parser has a default result and cannot fail. +-- Such parsers should rather be written as Parslets? We should use IContinue +-- in initial. + -- | The type of a 'Parser''s initial action. -- -- /Internal/ @@ -296,38 +300,45 @@ instance Functor (Initial s) where -- | The return type of a 'Parser' step. -- --- The parser driver feeds the input stream to the parser one element at a --- time, representing a parse 'Step'. If the step result is 'SPartial' then a --- parse result is available, we can extract the result and feed more input to --- the parser. If the result is 'SContinue', we must feed more input in order --- to get a result. If the parser returns 'SDone' then the parser can no longer --- take any more input. --- --- The @n@ in @SPartial n@, @Scontinue n@ and @SDone n@ is an integer --- representing the number of elements consumed by the parser. If the current --- input item is consumed then n is 1, if the current input item is rejected --- then n is 0. If @n@ is less than 0 then the parser backtracks by n elements --- prior to the current element before processing next input. If @n@ is greater --- than 1 then it skips n elements in the stream (skipping is currently not --- supported) including the current element. +-- /Result types/: The parser driver feeds the input stream to the parser one +-- element at a time, representing a parse 'Step'. If the step result +-- 'SPartial' indicates that a parse result is available and the parser can +-- accept more input, we can extract the result using the parser's extract +-- function and feed more input to the parser. If the result is 'SContinue', we +-- must feed more input in order to get a result. If the parser returns 'SDone' +-- then a result is available and the parser can no longer take any more input. +-- +-- /Stream position/: The @n@ in @SPartial n@, @Scontinue n@ and @SDone n@ is a +-- count by which we adjust the current stream position after this step. If the +-- count is positive we move forward in the stream, if it is 0 then we stay +-- where we are, if it is negative then we move backward in the stream. -- Essentially, if the input stream position was @pos@ before processing the -- current element then the new stream position after processing the element -- would be @pos + n@. -- --- If the parser result is 'SContinue', the parser driver retains the input in --- a backtracking buffer, in case of failure the parser can backtrack maximum --- up to the length of the backtracking buffer. Whenever the result is --- `SPartial` the current backtracking buffer is discarded; this means that we --- cannot backtrack beyond the currrent position in the stream. The parser must --- ensure that the backtrack position is always within the bounds of the --- backtracking buffer, otherwise a runtime error will occur. --- --- If the parser is not yet done, we can use the @extract@ operation on the --- @state@ of the parser to extract a result. If the parser never yielded a --- result in the past, @extract@ fails with a 'ParseError' exception. If the --- parser yielded a 'Partial' result in the past then the latest partial result --- is returned. Therefore, if a parser yields a partial result once then it --- cannot fail later on. +-- We can also think of this count as the number of items consumed by the +-- parser. If the current input item is consumed then n is 1, if the current +-- input item should be presented to the next parser step then n is 0. If @n@ +-- is less than 0 then the parser backtracks by n elements before the current +-- element before the next parsing step is invoked. @n@ is not allowed to be +-- greater than 1 in the regular stream parsers, but it can be more than 1 in +-- an array parser because it can consume more than one elements from the +-- array. +-- +-- /Backtracking/: If the parser result is 'SContinue', the parser driver +-- retains the input in a backtracking buffer, in case of failure the parser +-- can backtrack maximum up to the length of the backtracking buffer. Whenever +-- the result is `SPartial` the current backtracking buffer is discarded; this +-- means that we cannot backtrack beyond the currrent position in the stream. +-- The parser must ensure that the backtrack position is always within the +-- bounds of the backtracking buffer, otherwise a runtime error will occur. +-- +-- /Failure/: If the parser is not yet done, we can use the @extract@ operation +-- on the @state@ of the parser to extract a result. If the parser never +-- yielded a result in the past, @extract@ fails with a 'ParseError' exception. +-- If the parser yielded a 'Partial' result in the past then extract returns +-- the latest partial result. Therefore, if a parser yields a partial result +-- once then it cannot fail later on. -- -- /Pre-release/ -- diff --git a/core/src/Streamly/Internal/Data/ParserK/Type.hs b/core/src/Streamly/Internal/Data/ParserK/Type.hs index 6f9d9d1734..83530bae52 100644 --- a/core/src/Streamly/Internal/Data/ParserK/Type.hs +++ b/core/src/Streamly/Internal/Data/ParserK/Type.hs @@ -104,25 +104,31 @@ import qualified Streamly.Internal.Data.Parser.Type as ParserD -- XXX Rename Chunk to Some. data Input a = None | Chunk a --- XXX Step should be renamed to StepResult. --- XXX and StepParser should be just Step. +-- Note: Step should ideally be called StepResult and StepParser should be just +-- Step, but then it will not be consistent with Parser/Stream. --- | A parsing function that parses a single input. +-- Using "Input" in runParser is not necessary but it avoids making +-- one more function call to get the input. This could be helpful +-- for cases where we process just one element per call. + +-- | A parsing function that parses a single input object. type StepParser a m r = Input a -> m (Step a m r) -- | The intermediate result of running a parser step. The parser driver may --- stop with a final result, pause with a continuation to resume, or fail with --- an error. +-- (1) stop with a final result ('Done') with no more inputs to be accepted, +-- (2) generate an intermediate result ('Partial') and accept more inputs, (3) +-- generate no result but wait for more input ('Continue'), (4) or fail with an +-- error ('Error'). +-- +-- The Int is a count by which the current stream position should be adjusted +-- before calling the next parsing step. -- --- See ParserD docs. This is the same as the ParserD Step except that it uses a --- continuation in Partial and Continue constructors instead of a state in case --- of ParserD. +-- See the documentation of 'Streamly.Data.Parser.Step' for more details, this +-- has the same semantics. -- -- /Pre-release/ -- data Step a m r = - -- The Int is the current stream position index wrt to the start of the - -- array. Done !Int r | Partial !Int (StepParser a m r) | Continue !Int (StepParser a m r) @@ -160,40 +166,48 @@ instance Functor ParseResult where -- -- Use Step itself in place of ParseResult. --- | A continuation passing style parser representation. A continuation of --- 'Step's, each step passes a state and a parse result to the next 'Step'. The --- resulting 'Step' may carry a continuation that consumes input 'a' and --- results in another 'Step'. Essentially, the continuation may either consume --- input without a result or return a result with no further input to be --- consumed. +-- | A continuation passing style parser representation. A parser is a +-- continuation of 'Step's, each step passes a state and a parse result to the +-- next 'Step'. The resulting 'Step' may carry a continuation that consumes +-- input 'a' and results in another 'Step'. Essentially, the continuation may +-- either consume input without a result or return a result with no further +-- input to be consumed. +-- +-- The first argument of runParser is a continuation to be invoked after the +-- parser is done, it is of the following shape: +-- +-- >> ParseResult b -> Int -> StepParser a m r +-- +-- First argument of the continuation is the 'ParseResult'. The current stream +-- position is carried as part of the 'Success' or 'Failure' constructors of +-- 'ParseResult'. The second argument of the continuation is a count of the +-- elements used in the current alterantive of an alternative composition, if +-- the alternative fails we need to backtrack by this amount before invoking +-- the next alternative. +-- +-- The second argument of runParser is the incoming stream position adjustment. +-- The parser needs to adjust the current position of the stream by this amount +-- before consuming any input. A positive value means move forward by that much +-- in the stream and a negative value means backward. See the 'Step' and +-- 'Streamly.Data.Parser.Step' documentation for more details. +-- +-- The third argument is the incoming cumulative used element count for the +-- current alternative, same as described for the continuation above. -- newtype ParserK a m b = MkParser { runParser :: forall r. - -- Using "Input" in runParser is not necessary but it avoids making - -- one more function call to get the input. This could be helpful - -- for cases where we process just one element per call. - -- -- Do not eta reduce the applications of this continuation. - -- - -- The current stream position index is carried as part of 'Success' - -- constructor of 'ParseResult'. The second argument is the used - -- elem count. + -- Continuation to be invoked after the parser is done (ParseResult b -> Int -> StepParser a m r) -- XXX Maintain and pass the original position in the stream. that -- way we can also report better errors. Use a Context structure for -- passing the state. - - -- Stream position index wrt to the current input array start. If - -- negative then backtracking is required before using the array. - -- The parser should use "Continue -n" in this case if it needs to - -- consume input. Negative value cannot be beyond the current - -- backtrack buffer. Positive value cannot be beyond array length. - -- If the parser needs to advance beyond the array length it should - -- use "Continue +n". + -- + -- stream position adjustment before the parser starts. -> Int - -- used elem count, a count of elements consumed by the parser. If - -- an Alternative fails we need to backtrack by this amount. + -- initial used count for the current alternative. -> Int + -- final parse result, when the last continuation is done. -> StepParser a m r } @@ -422,6 +436,8 @@ adaptWith pstep initial extract cont !relPos !usedCount !input = do ParserD.SPartial 1 pst1 -> pure $ Partial 1 (parseCont (count + 1) pst1) ParserD.SPartial 0 pst1 -> + -- XXX if we recurse we are not dropping backtrack buffer + -- on partial. -- XXX recurse or call the driver? go SPEC pst1 ParserD.SPartial m pst1 -> -- n > 0 From 0b8b22c84aa9cd06f25b60cc7198291836322fff Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 28 May 2025 07:18:20 +0530 Subject: [PATCH 19/20] Fix use-streamly-core flag - bench-test-lib dep --- benchmark/streamly-benchmarks.cabal | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index b75df6345f..ef639323cc 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -197,10 +197,11 @@ common bench-depends , tasty-bench >= 0.3 && < 0.5 , tasty >= 1.4.1 && < 1.6 , streamly-core - , bench-test-lib if !flag(use-streamly-core) - build-depends: streamly + build-depends: + streamly + , bench-test-lib if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6) build-depends: From 0ddbd48c5efe0c0bcee79f4552dc9b671fe7b618 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 28 May 2025 11:21:41 +0530 Subject: [PATCH 20/20] Fix Alternative Parser benchmarks --- benchmark/Streamly/Benchmark/Data/ParserK.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/benchmark/Streamly/Benchmark/Data/ParserK.hs b/benchmark/Streamly/Benchmark/Data/ParserK.hs index 90d616b295..c1fc4a9bb8 100644 --- a/benchmark/Streamly/Benchmark/Data/ParserK.hs +++ b/benchmark/Streamly/Benchmark/Data/ParserK.hs @@ -234,7 +234,7 @@ takeWhileFailD predicate (Fold fstep finitial _ ffinal) = fres <- fstep s a return $ case fres of - Fold.Partial s1 -> SPartial 1 s1 + Fold.Partial s1 -> SContinue 1 s1 Fold.Done b -> SDone 1 b else return $ Error "fail"