From 57238e941d5e73269c0aad901a338b42189d1ee3 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Sun, 6 Oct 2024 18:08:06 +0530 Subject: [PATCH] Track the absolute position in the drivers of Parser --- benchmark/Streamly/Benchmark/Data/Parser.hs | 2 +- benchmark/Streamly/Benchmark/Data/ParserK.hs | 2 +- .../Streamly/Benchmark/Unicode/Parser.hs | 2 +- core/src/Streamly/Internal/Data/Array.hs | 48 ++-- .../Streamly/Internal/Data/Array/Stream.hs | 22 +- core/src/Streamly/Internal/Data/Parser.hs | 20 +- .../src/Streamly/Internal/Data/Parser/Type.hs | 5 +- .../Streamly/Internal/Data/Producer/Source.hs | 56 ++-- .../Internal/Data/Stream/Eliminate.hs | 78 +++--- .../Streamly/Internal/Data/Stream/Nesting.hs | 250 +++++++++--------- core/src/Streamly/Internal/Data/StreamK.hs | 180 +++++++------ core/src/Streamly/Internal/Unicode/Parser.hs | 6 +- .../module-structure-and-quick-examples.md | 6 +- .../Data/Stream/IsStream/Eliminate.hs | 2 +- test/Streamly/Test/Data/Parser.hs | 4 +- test/Streamly/Test/Unicode/Parser.hs | 10 +- test/lib/Streamly/Test/Parser/Common.hs | 28 +- 17 files changed, 365 insertions(+), 356 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Parser.hs b/benchmark/Streamly/Benchmark/Data/Parser.hs index f4ed6da2a5..a20a8a07d7 100644 --- a/benchmark/Streamly/Benchmark/Data/Parser.hs +++ b/benchmark/Streamly/Benchmark/Data/Parser.hs @@ -709,7 +709,7 @@ moduleName = "Data.Parser" instance NFData ParseError where {-# INLINE rnf #-} - rnf (ParseError x) = rnf x + rnf (ParseError i x) = rnf i `seq` rnf x o_1_space_serial :: Int -> [Benchmark] o_1_space_serial value = diff --git a/benchmark/Streamly/Benchmark/Data/ParserK.hs b/benchmark/Streamly/Benchmark/Data/ParserK.hs index cc44c7c75e..be4bb6c40d 100644 --- a/benchmark/Streamly/Benchmark/Data/ParserK.hs +++ b/benchmark/Streamly/Benchmark/Data/ParserK.hs @@ -370,7 +370,7 @@ moduleName = MODULE_NAME instance NFData ParseError where {-# INLINE rnf #-} - rnf (ParseError x) = rnf x + rnf (ParseError i x) = rnf i `seq` rnf x o_1_space_serial :: Int -> [Benchmark] o_1_space_serial value = diff --git a/benchmark/Streamly/Benchmark/Unicode/Parser.hs b/benchmark/Streamly/Benchmark/Unicode/Parser.hs index 88c7db94b9..9283df1507 100644 --- a/benchmark/Streamly/Benchmark/Unicode/Parser.hs +++ b/benchmark/Streamly/Benchmark/Unicode/Parser.hs @@ -72,7 +72,7 @@ moduleName = "Unicode.Parser" instance NFData ParseError where {-# INLINE rnf #-} - rnf (ParseError x) = rnf x + rnf (ParseError i x) = rnf i `seq` rnf x o_n_heap_serial :: Int -> [Benchmark] o_n_heap_serial value = diff --git a/core/src/Streamly/Internal/Data/Array.hs b/core/src/Streamly/Internal/Data/Array.hs index 29143e86ca..d6bc642d41 100644 --- a/core/src/Streamly/Internal/Data/Array.hs +++ b/core/src/Streamly/Internal/Data/Array.hs @@ -904,9 +904,9 @@ parseBreakChunksK :: parseBreakChunksK (Parser pstep initial extract) stream = do res <- initial case res of - IPartial s -> go s stream [] + IPartial s -> go s stream [] 0 IDone b -> return (Right b, stream) - IError err -> return (Left (ParseError err), stream) + IError err -> return (Left (ParseError 0 err), stream) where @@ -916,37 +916,37 @@ parseBreakChunksK (Parser pstep initial extract) stream = do -- XXX currently we are using a dumb list based approach for backtracking -- buffer. This can be replaced by a sliding/ring buffer using Data.Array. -- That will allow us more efficient random back and forth movement. - go !pst st backBuf = do - let stop = goStop pst backBuf -- (, K.nil) <$> extract pst + go !pst st backBuf i = do + let stop = goStop pst backBuf i -- (, K.nil) <$> extract pst single a = yieldk a StreamK.nil - yieldk arr r = goArray pst backBuf r arr + yieldk arr r = goArray pst backBuf r arr i in StreamK.foldStream defState yieldk single stop st -- Use strictness on "cur" to keep it unboxed - goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf - goArray !pst backBuf st (Array contents cur end) = do + goArray !pst backBuf st (Array _ cur end) i | cur == end = go pst st backBuf i + goArray !pst backBuf st (Array contents cur end) i = do x <- liftIO $ peekAt cur contents pRes <- pstep pst x let next = INDEX_NEXT(cur,a) case pRes of Parser.Partial 0 s -> - goArray s [] st (Array contents next end) + goArray s [] st (Array contents next end) (i + 1) Parser.Partial n s -> do 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 + goArray s [] st src (i + 1 - n) Parser.Continue 0 s -> - goArray s (x:backBuf) st (Array contents next end) + goArray s (x:backBuf) st (Array contents next end) (i + 1) Parser.Continue n s -> do 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 + goArray s buf1 st src (i + 1 - n) Parser.Done 0 b -> do let arr = Array contents next end return (Right b, StreamK.cons arr st) @@ -964,34 +964,34 @@ parseBreakChunksK (Parser pstep initial extract) stream = do arr0 = fromListN n (Prelude.reverse backBuf) arr1 = Array contents cur end str = StreamK.cons arr0 (StreamK.cons arr1 st) - return (Left (ParseError err), str) + return (Left (ParseError (i + 1) err), str) -- This is a simplified goArray - goExtract !pst backBuf (Array _ cur end) - | cur == end = goStop pst backBuf - goExtract !pst backBuf (Array contents cur end) = do + goExtract !pst backBuf (Array _ cur end) i + | cur == end = goStop pst backBuf i + goExtract !pst backBuf (Array contents cur end) i = do x <- liftIO $ peekAt cur contents pRes <- pstep pst x let next = INDEX_NEXT(cur,a) case pRes of Parser.Partial 0 s -> - goExtract s [] (Array contents next end) + goExtract s [] (Array contents next end) (i + 1) Parser.Partial n s -> do 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 + goExtract s [] src (i + 1 - n) Parser.Continue 0 s -> - goExtract s backBuf (Array contents next end) + goExtract s backBuf (Array contents next end) (i + 1) Parser.Continue n s -> do 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 + goExtract s buf1 src (i + 1 - n) Parser.Done 0 b -> do let arr = Array contents next end return (Right b, StreamK.fromPure arr) @@ -1009,21 +1009,21 @@ parseBreakChunksK (Parser pstep initial extract) stream = do arr0 = fromListN n (Prelude.reverse backBuf) arr1 = Array contents cur end str = StreamK.cons arr0 (StreamK.fromPure arr1) - return (Left (ParseError err), str) + return (Left (ParseError (i + 1) err), str) -- This is a simplified goExtract {-# INLINE goStop #-} - goStop !pst backBuf = do + goStop !pst backBuf i = do pRes <- extract pst case pRes of Parser.Partial _ _ -> error "Bug: parseBreak: Partial in extract" Parser.Continue 0 s -> - goStop s backBuf + goStop s backBuf i Parser.Continue n s -> do assert (n <= Prelude.length backBuf) (return ()) let (src0, buf1) = Prelude.splitAt n backBuf arr = fromListN n (Prelude.reverse src0) - goExtract s buf1 arr + goExtract s buf1 arr (i - n) Parser.Done 0 b -> return (Right b, StreamK.nil) Parser.Done n b -> do @@ -1036,4 +1036,4 @@ parseBreakChunksK (Parser pstep initial extract) stream = do Parser.Error err -> do let n = Prelude.length backBuf arr0 = fromListN n (Prelude.reverse backBuf) - return (Left (ParseError err), StreamK.fromPure arr0) + return (Left (ParseError i err), StreamK.fromPure arr0) diff --git a/core/src/Streamly/Internal/Data/Array/Stream.hs b/core/src/Streamly/Internal/Data/Array/Stream.hs index 6d22f61915..552897d6d8 100644 --- a/core/src/Streamly/Internal/Data/Array/Stream.hs +++ b/core/src/Streamly/Internal/Data/Array/Stream.hs @@ -321,7 +321,7 @@ runArrayParserDBreak case res of PRD.IPartial s -> go SPEC state (List []) s PRD.IDone b -> return (Right b, stream) - PRD.IError err -> return (Left (ParseError err), stream) + PRD.IError err -> return (Left (ParseError (-1) err), stream) where @@ -374,7 +374,7 @@ runArrayParserDBreak let src0 = x:getList backBuf src = Prelude.reverse src0 ++ x:xs strm = D.append (D.fromList src) (D.Stream step s) - return (Left (ParseError err), strm) + return (Left (ParseError (-1) err), strm) -- This is a simplified gobuf goExtract _ [] backBuf !pst = goStop backBuf pst @@ -411,7 +411,7 @@ runArrayParserDBreak PR.Error err -> do let src0 = getList backBuf src = Prelude.reverse src0 ++ x:xs - return (Left (ParseError err), D.fromList src) + return (Left (ParseError (-1) err), D.fromList src) -- This is a simplified goExtract {-# INLINE goStop #-} @@ -439,7 +439,7 @@ runArrayParserDBreak PR.Error err -> do let src0 = getList backBuf src = Prelude.reverse src0 - return (Left (ParseError err), D.fromList src) + return (Left (ParseError (-1) err), D.fromList src) {- -- | Parse an array stream using the supplied 'Parser'. Returns the parse @@ -517,7 +517,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next D.Skip s -> return $ D.Skip $ ParseChunksInit [] s D.Stop -> return D.Stop @@ -534,7 +534,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next -- This is a simplified ParseChunksInit stepOuter _ (ParseChunksInitBuf src) = do @@ -549,7 +549,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next -- XXX we just discard any leftover input at the end stepOuter _ (ParseChunksInitLeftOver _) = return D.Stop @@ -596,7 +596,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst D.Stop -> return $ D.Skip $ ParseChunksStop backBuf pst @@ -638,7 +638,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next -- This is a simplified ParseChunksBuf stepOuter _ (ParseChunksExtract [] buf pst) = @@ -676,7 +676,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next -- This is a simplified ParseChunksExtract @@ -706,7 +706,7 @@ runArrayFoldManyD let next = ParseChunksInitLeftOver [] return $ D.Skip - $ ParseChunksYield (Left (ParseError err)) next + $ ParseChunksYield (Left (ParseError (-1) err)) next stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next diff --git a/core/src/Streamly/Internal/Data/Parser.hs b/core/src/Streamly/Internal/Data/Parser.hs index bfe0a4eb5e..0899ed57ea 100644 --- a/core/src/Streamly/Internal/Data/Parser.hs +++ b/core/src/Streamly/Internal/Data/Parser.hs @@ -619,7 +619,7 @@ data Tuple'Fused a b = Tuple'Fused !a !b deriving Show -- Right [1,2] -- -- >>> takeBetween' 2 4 [1] --- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1") +-- Left (ParseError 1 "takeBetween: Expecting alteast 2 elements, got 1") -- -- >>> takeBetween' 0 0 [1, 2] -- Right [] @@ -721,7 +721,7 @@ takeBetween low high (Fold fstep finitial _ ffinal) = -- Right [1,0] -- -- >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1] --- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3") +-- Left (ParseError 3 "takeEQ: Expecting exactly 4 elements, input terminated on 3") -- {-# INLINE takeEQ #-} takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b @@ -782,7 +782,7 @@ data TakeGEState s = -- elements. -- -- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1] --- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3") +-- Left (ParseError 3 "takeGE: Expecting at least 4 elements, input terminated on 3") -- -- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1] -- Right [1,0,1,0,1] @@ -1294,7 +1294,7 @@ takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond -- >>> p = Parser.takeBeginBy (== ',') Fold.toList -- >>> leadingComma = Stream.parse p . Stream.fromList -- >>> leadingComma "a,b" --- Left (ParseError "takeBeginBy: missing frame start") +-- Left (ParseError 1 "takeBeginBy: missing frame start") -- ... -- >>> leadingComma ",," -- Right "," @@ -1372,7 +1372,7 @@ RENAME(takeStartBy_,takeBeginBy_) -- >>> Stream.parse p $ Stream.fromList "{hello \\{world}" -- Right "hello {world" -- >>> Stream.parse p $ Stream.fromList "{hello {world}" --- Left (ParseError "takeFramedByEsc_: missing frame end") +-- Left (ParseError 14 "takeFramedByEsc_: missing frame end") -- -- /Pre-release/ {-# INLINE takeFramedByEsc_ #-} @@ -2115,7 +2115,7 @@ groupByRollingEither -- Right "string" -- -- >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match" --- Left (ParseError "streamEqBy: mismtach occurred") +-- Left (ParseError 2 "streamEqBy: mismtach occurred") -- {-# INLINE listEqBy #-} listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a] @@ -2406,7 +2406,7 @@ spanByRolling eq f1 f2 = -- Right [1,2] -- -- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5] --- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4") +-- Left (ParseError 4 "takeEQ: Expecting exactly 5 elements, input terminated on 4") -- -- /Internal/ {-# INLINE takeP #-} @@ -2563,7 +2563,7 @@ data DeintercalateAllState fs sp ss = -- >>> Stream.parse p $ Stream.fromList "1" -- Right [Left "1"] -- >>> Stream.parse p $ Stream.fromList "1+" --- Left (ParseError "takeWhile1: end of input") +-- Left (ParseError 2 "takeWhile1: end of input") -- >>> Stream.parse p $ Stream.fromList "1+2+3" -- Right [Left "1",Right '+',Left "2",Right '+',Left "3"] -- @@ -2839,7 +2839,7 @@ data Deintercalate1State b fs sp ss = -- >>> p2 = Parser.satisfy (== '+') -- >>> p = Parser.deintercalate1 p1 p2 Fold.toList -- >>> Stream.parse p $ Stream.fromList "" --- Left (ParseError "takeWhile1: end of input") +-- Left (ParseError 0 "takeWhile1: end of input") -- >>> Stream.parse p $ Stream.fromList "1" -- Right [Left "1"] -- >>> Stream.parse p $ Stream.fromList "1+" @@ -3140,7 +3140,7 @@ sepBy1 p sep sink = do -- >>> p2 = Parser.satisfy (== '+') -- >>> p = Parser.sepBy1 p1 p2 Fold.toList -- >>> Stream.parse p $ Stream.fromList "" --- Left (ParseError "takeWhile1: end of input") +-- Left (ParseError 0 "takeWhile1: end of input") -- >>> Stream.parse p $ Stream.fromList "1" -- Right ["1"] -- >>> Stream.parse p $ Stream.fromList "1+" diff --git a/core/src/Streamly/Internal/Data/Parser/Type.hs b/core/src/Streamly/Internal/Data/Parser/Type.hs index 8a9e56a518..8fbf9b872c 100644 --- a/core/src/Streamly/Internal/Data/Parser/Type.hs +++ b/core/src/Streamly/Internal/Data/Parser/Type.hs @@ -455,11 +455,12 @@ data Fold m a b = -- -- /Pre-release/ -- -newtype ParseError = ParseError String +data ParseError = ParseError Int String deriving (Eq, Show) instance Exception ParseError where - displayException (ParseError err) = err + -- XXX Append the index in the error message here? + displayException (ParseError _ err) = err -- | Map a function on the result i.e. on @b@ in @Parser a m b@. instance Functor m => Functor (Parser a m) where diff --git a/core/src/Streamly/Internal/Data/Producer/Source.hs b/core/src/Streamly/Internal/Data/Producer/Source.hs index 62e7a8bfb2..052dc494fb 100644 --- a/core/src/Streamly/Internal/Data/Producer/Source.hs +++ b/core/src/Streamly/Internal/Data/Producer/Source.hs @@ -125,33 +125,33 @@ parse case res of ParserD.IPartial s -> do state <- uinject seed - go SPEC state (List []) s + go SPEC state (List []) s 0 ParserD.IDone b -> return (Right b, seed) - ParserD.IError err -> return (Left (ParseError err), seed) + ParserD.IError err -> return (Left (ParseError 0 err), seed) where -- XXX currently we are using a dumb list based approach for backtracking -- buffer. This can be replaced by a sliding/ring buffer using Data.Array. -- That will allow us more efficient random back and forth movement. - go !_ st buf !pst = do + go !_ st buf !pst i = do r <- ustep st case r of Yield x s -> do pRes <- pstep pst x case pRes of - Partial 0 pst1 -> go SPEC s (List []) pst1 + Partial 0 pst1 -> go SPEC s (List []) pst1 i Partial n pst1 -> do 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 + gobuf SPEC s (List []) (List src) pst1 (i + 1 - n) + Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1 (i + 1) Continue n pst1 -> do 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 + gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n) Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -162,30 +162,30 @@ parse s1 <- uextract s let src = Prelude.reverse (getList buf) return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , unread (src ++ [x]) s1 ) - Skip s -> go SPEC s buf pst - Stop -> goStop buf pst + Skip s -> go SPEC s buf pst i + Stop -> goStop buf pst i - gobuf !_ s buf (List []) !pst = go SPEC s buf pst - gobuf !_ s buf (List (x:xs)) !pst = do + gobuf !_ s buf (List []) !pst i = go SPEC s buf pst i + gobuf !_ s buf (List (x:xs)) !pst i = do pRes <- pstep pst x case pRes of Partial 0 pst1 -> - gobuf SPEC s (List []) (List xs) pst1 + gobuf SPEC s (List []) (List xs) pst1 (i + 1) Partial n pst1 -> do 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 + gobuf SPEC s (List []) (List src) pst1 (i + 1 - n) Continue 0 pst1 -> - gobuf SPEC s (List (x:getList buf)) (List xs) pst1 + gobuf SPEC s (List (x:getList buf)) (List xs) pst1 (i + 1) Continue n pst1 -> do 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 + gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n) Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -196,29 +196,29 @@ parse s1 <- uextract s let src = Prelude.reverse (getList buf) return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , unread (src ++ (x:xs)) s1 ) -- This is a simplified gobuf - goExtract !_ buf (List []) !pst = goStop buf pst - goExtract !_ buf (List (x:xs)) !pst = do + goExtract !_ buf (List []) !pst i = goStop buf pst i + goExtract !_ buf (List (x:xs)) !pst i = do pRes <- pstep pst x case pRes of Partial 0 pst1 -> - goExtract SPEC (List []) (List xs) pst1 + goExtract SPEC (List []) (List xs) pst1 (i + 1) Partial n pst1 -> do 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 + goExtract SPEC (List []) (List src) pst1 (i + 1 - n) Continue 0 pst1 -> - goExtract SPEC (List (x:getList buf)) (List xs) pst1 + goExtract SPEC (List (x:getList buf)) (List xs) pst1 (i + 1) Continue n pst1 -> do 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 + goExtract SPEC (List buf1) (List src) pst1 (i + 1 - n) Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -227,23 +227,23 @@ parse Error err -> do let src = Prelude.reverse (getList buf) return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , unread (src ++ (x:xs)) (source Nothing) ) -- This is a simplified goExtract {-# INLINE goStop #-} - goStop buf pst = do + goStop buf pst i = do pRes <- extract pst case pRes of Partial _ _ -> error "Bug: parseD: Partial in extract" Continue 0 pst1 -> - goStop buf pst1 + goStop buf pst1 i Continue n pst1 -> do assert (n <= length (getList buf)) (return ()) let (src0, buf1) = splitAt n (getList buf) src = Prelude.reverse src0 - goExtract SPEC (List buf1) (List src) pst1 + goExtract SPEC (List buf1) (List src) pst1 (i - n) Done 0 b -> return (Right b, source Nothing) Done n b -> do assert (n <= length (getList buf)) (return ()) @@ -252,7 +252,7 @@ parse return (Right b, unread src (source Nothing)) Error err -> do let src = Prelude.reverse (getList buf) - return (Left (ParseError err), unread src (source Nothing)) + return (Left (ParseError i err), unread src (source Nothing)) {- -- | Parse a buffered source using a parser, returning the parsed value and the diff --git a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs index 95bc957a02..de9de6cb9b 100644 --- a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs +++ b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs @@ -151,7 +151,7 @@ parseD parser strm = do -- error. For example: -- -- >>> Stream.parse (Parser.takeEQ 1 Fold.drain) Stream.nil --- Left (ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0") +-- Left (ParseError 0 "takeEQ: Expecting exactly 1 elements, input terminated on 0") -- -- Note: @parse p@ is not the same as @head . parseMany p@ on an empty stream. -- @@ -176,9 +176,9 @@ parseBreakD parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do res <- initial case res of - PRD.IPartial s -> go SPEC state (List []) s + PRD.IPartial s -> go SPEC state (List []) s 0 PRD.IDone b -> return (Right b, stream) - PRD.IError err -> return (Left (ParseError err), stream) + PRD.IError err -> return (Left (ParseError 0 err), stream) where @@ -188,26 +188,26 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do -- XXX currently we are using a dumb list based approach for backtracking -- buffer. This can be replaced by a sliding/ring buffer using Data.Array. -- That will allow us more efficient random back and forth movement. - go !_ st buf !pst = do + go !_ st buf !pst i = do r <- step defState st case r of 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 0 pst1 -> go SPEC s (List []) pst1 (i + 1) + PR.Partial 1 pst1 -> go1 SPEC s x pst1 i PR.Partial n pst1 -> do 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 + gobuf SPEC s (List []) (List src) pst1 (i + 1 - n) + PR.Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1 (i + 1) + PR.Continue 1 pst1 -> gobuf SPEC s buf (List [x]) pst1 i PR.Continue n pst1 -> do 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 + gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n) PR.Done 0 b -> return (Right b, Stream step s) PR.Done n b -> do assert (n <= length (x:getList buf)) (return ()) @@ -221,26 +221,26 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do PR.Error err -> do let src = Prelude.reverse $ x:getList buf return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , Nesting.append (fromList src) (Stream step s) ) - Skip s -> go SPEC s buf pst - Stop -> goStop SPEC buf pst + Skip s -> go SPEC s buf pst i + Stop -> goStop SPEC buf pst i - go1 _ s x !pst = do + go1 _ s x !pst i = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - go SPEC s (List []) pst1 + go SPEC s (List []) pst1 (i + 1) PR.Partial 1 pst1 -> do - go1 SPEC s x pst1 + go1 SPEC s x pst1 i PR.Partial n _ -> error $ "parseBreak: parser bug, go1: Partial n = " ++ show n PR.Continue 0 pst1 -> - go SPEC s (List [x]) pst1 + go SPEC s (List [x]) pst1 (i + 1) PR.Continue 1 pst1 -> - go1 SPEC s x pst1 + go1 SPEC s x pst1 i PR.Continue n _ -> do error $ "parseBreak: parser bug, go1: Continue n = " ++ show n PR.Done 0 b -> do @@ -251,30 +251,30 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do error $ "parseBreak: parser bug, go1: Done n = " ++ show n PR.Error err -> return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , Nesting.append (fromPure x) (Stream step s) ) - gobuf !_ s buf (List []) !pst = go SPEC s buf pst - gobuf !_ s buf (List (x:xs)) !pst = do + gobuf !_ s buf (List []) !pst i = go SPEC s buf pst i + gobuf !_ s buf (List (x:xs)) !pst i = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - gobuf SPEC s (List []) (List xs) pst1 + gobuf SPEC s (List []) (List xs) pst1 (i + 1) PR.Partial n pst1 -> do 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 + gobuf SPEC s (List []) (List src) pst1 (i + 1 - n) PR.Continue 0 pst1 -> - gobuf SPEC s (List (x:getList buf)) (List xs) pst1 + gobuf SPEC s (List (x:getList buf)) (List xs) pst1 (i + 1) PR.Continue 1 pst1 -> - gobuf SPEC s buf (List (x:xs)) pst1 + gobuf SPEC s buf (List (x:xs)) pst1 i PR.Continue n pst1 -> do 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 + gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n) PR.Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -283,31 +283,31 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do PR.Error err -> do let src = Prelude.reverse (getList buf) ++ x:xs return - ( Left (ParseError err) + ( Left (ParseError (i + 1) err) , Nesting.append (fromList src) (Stream step s) ) -- This is simplified gobuf - goExtract !_ buf (List []) !pst = goStop SPEC buf pst - goExtract !_ buf (List (x:xs)) !pst = do + goExtract !_ buf (List []) !pst i = goStop SPEC buf pst i + goExtract !_ buf (List (x:xs)) !pst i = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - goExtract SPEC (List []) (List xs) pst1 + goExtract SPEC (List []) (List xs) pst1 (i + 1) PR.Partial n pst1 -> do 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 + goExtract SPEC (List []) (List src) pst1 (i + 1 - n) PR.Continue 0 pst1 -> - goExtract SPEC (List (x:getList buf)) (List xs) pst1 + goExtract SPEC (List (x:getList buf)) (List xs) pst1 (i + 1) PR.Continue 1 pst1 -> - goExtract SPEC buf (List (x:xs)) pst1 + goExtract SPEC buf (List (x:xs)) pst1 i PR.Continue n pst1 -> do 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 + goExtract SPEC (List buf1) (List src) pst1 (i + 1 - n) PR.Done n b -> do assert (n <= length (x:getList buf)) (return ()) let src0 = Prelude.take n (x:getList buf) @@ -315,21 +315,21 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do return (Right b, fromList src) PR.Error err -> do let src = Prelude.reverse (getList buf) ++ x:xs - return (Left (ParseError err), fromList src) + return (Left (ParseError (i + 1) err), fromList src) -- This is simplified goExtract -- XXX Use SPEC? {-# INLINE goStop #-} - goStop _ buf pst = do + goStop _ buf pst i = 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 0 pst1 -> goStop SPEC buf pst1 i PR.Continue n pst1 -> do assert (n <= length (getList buf)) (return ()) let (src0, buf1) = splitAt n (getList buf) src = Prelude.reverse src0 - goExtract SPEC (List buf1) (List src) pst1 + goExtract SPEC (List buf1) (List src) pst1 (i - n) PR.Done 0 b -> return (Right b, StreamD.nil) PR.Done n b -> do assert (n <= length (getList buf)) (return ()) @@ -338,7 +338,7 @@ parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do return (Right b, fromList src) PR.Error err -> do let src = Prelude.reverse $ getList buf - return (Left (ParseError err), fromList src) + return (Left (ParseError i err), fromList src) -- | Parse a stream using the supplied 'Parser'. -- diff --git a/core/src/Streamly/Internal/Data/Stream/Nesting.hs b/core/src/Streamly/Internal/Data/Stream/Nesting.hs index c2a3be8509..b9f13b167f 100644 --- a/core/src/Streamly/Internal/Data/Stream/Nesting.hs +++ b/core/src/Streamly/Internal/Data/Stream/Nesting.hs @@ -1554,13 +1554,13 @@ foldIterateM func seed0 (Stream step state) = {-# ANN type ParseChunksState Fuse #-} data ParseChunksState x inpBuf st pst = - ParseChunksInit inpBuf st - | ParseChunksInitBuf inpBuf - | ParseChunksInitLeftOver inpBuf - | ParseChunksStream st inpBuf !pst - | ParseChunksStop inpBuf !pst - | ParseChunksBuf inpBuf st inpBuf !pst - | ParseChunksExtract inpBuf inpBuf !pst + ParseChunksInit Int inpBuf st + | ParseChunksInitBuf Int inpBuf + | ParseChunksInitLeftOver Int inpBuf + | ParseChunksStream Int st inpBuf !pst + | ParseChunksStop Int inpBuf !pst + | ParseChunksBuf Int inpBuf st inpBuf !pst + | ParseChunksExtract Int inpBuf inpBuf !pst | ParseChunksYield x (ParseChunksState x inpBuf st pst) -- XXX return the remaining stream as part of the error. @@ -1588,208 +1588,208 @@ parseMany -> Stream m a -> Stream m (Either ParseError b) parseMany (PRD.Parser pstep initial extract) (Stream step state) = - Stream stepOuter (ParseChunksInit [] state) + Stream stepOuter (ParseChunksInit 0 [] state) where {-# INLINE_LATE stepOuter #-} -- Buffer is empty, get the first element from the stream, initialize the -- fold and then go to stream processing loop. - stepOuter gst (ParseChunksInit [] st) = do + stepOuter gst (ParseChunksInit i [] st) = do r <- step (adaptState gst) st case r of Yield x s -> do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ParseChunksBuf [x] s [] ps + return $ Skip $ ParseChunksBuf i [x] s [] ps PRD.IDone pb -> - let next = ParseChunksInit [x] s + let next = ParseChunksInit i [x] s in return $ Skip $ ParseChunksYield (Right pb) next PRD.IError err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) - Skip s -> return $ Skip $ ParseChunksInit [] s + (Left (ParseError i err)) + (ParseChunksInitLeftOver i []) + Skip s -> return $ Skip $ ParseChunksInit i [] s Stop -> return Stop -- Buffer is not empty, go to buffered processing loop - stepOuter _ (ParseChunksInit src st) = do + stepOuter _ (ParseChunksInit i src st) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ParseChunksBuf src st [] ps + return $ Skip $ ParseChunksBuf i src st [] ps PRD.IDone pb -> - let next = ParseChunksInit src st + let next = ParseChunksInit i src st in return $ Skip $ ParseChunksYield (Right pb) next PRD.IError err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError i err)) + (ParseChunksInitLeftOver i []) -- This is simplified ParseChunksInit - stepOuter _ (ParseChunksInitBuf src) = do + stepOuter _ (ParseChunksInitBuf i src) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ParseChunksExtract src [] ps + return $ Skip $ ParseChunksExtract i src [] ps PRD.IDone pb -> - let next = ParseChunksInitBuf src + let next = ParseChunksInitBuf i src in return $ Skip $ ParseChunksYield (Right pb) next PRD.IError err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError i err)) + (ParseChunksInitLeftOver i []) -- XXX we just discard any leftover input at the end - stepOuter _ (ParseChunksInitLeftOver _) = return Stop + stepOuter _ (ParseChunksInitLeftOver _ _) = return Stop -- Buffer is empty, process elements from the stream - stepOuter gst (ParseChunksStream st buf pst) = do + stepOuter gst (ParseChunksStream i st buf pst) = do r <- step (adaptState gst) st case r of Yield x s -> do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ParseChunksStream s [] pst1 + return $ Skip $ ParseChunksStream (i + 1) s [] pst1 PR.Partial n pst1 -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 - return $ Skip $ ParseChunksBuf src s [] pst1 + return $ Skip $ ParseChunksBuf (i + 1 - n) src s [] pst1 PR.Continue 0 pst1 -> - return $ Skip $ ParseChunksStream s (x:buf) pst1 + return $ Skip $ ParseChunksStream (i + 1) s (x:buf) pst1 PR.Continue n pst1 -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 - return $ Skip $ ParseChunksBuf src s buf1 pst1 + return $ Skip $ ParseChunksBuf (i + 1 - n) src s buf1 pst1 PR.Done 0 b -> do return $ Skip $ - ParseChunksYield (Right b) (ParseChunksInit [] s) + ParseChunksYield (Right b) (ParseChunksInit (i + 1) [] s) PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) return $ Skip $ - ParseChunksYield (Right b) (ParseChunksInit src s) + ParseChunksYield (Right b) (ParseChunksInit (i + 1 - n) src s) PR.Error err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) - Skip s -> return $ Skip $ ParseChunksStream s buf pst - Stop -> return $ Skip $ ParseChunksStop buf pst + (Left (ParseError (i + 1) err)) + (ParseChunksInitLeftOver (i + 1) []) + Skip s -> return $ Skip $ ParseChunksStream i s buf pst + Stop -> return $ Skip $ ParseChunksStop i buf pst -- go back to stream processing mode - stepOuter _ (ParseChunksBuf [] s buf pst) = - return $ Skip $ ParseChunksStream s buf pst + stepOuter _ (ParseChunksBuf i [] s buf pst) = + return $ Skip $ ParseChunksStream i s buf pst -- buffered processing loop - stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do + stepOuter _ (ParseChunksBuf i (x:xs) s buf pst) = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ParseChunksBuf xs s [] pst1 + return $ Skip $ ParseChunksBuf (i + 1) xs s [] pst1 PR.Partial n pst1 -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ParseChunksBuf src s [] pst1 + return $ Skip $ ParseChunksBuf (i + 1 - n) src s [] pst1 PR.Continue 0 pst1 -> - return $ Skip $ ParseChunksBuf xs s (x:buf) pst1 + return $ Skip $ ParseChunksBuf (i + 1) xs s (x:buf) pst1 PR.Continue n pst1 -> do 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 + return $ Skip $ ParseChunksBuf (i + 1 - n) src s buf1 pst1 PR.Done 0 b -> return $ Skip - $ ParseChunksYield (Right b) (ParseChunksInit xs s) + $ ParseChunksYield (Right b) (ParseChunksInit (i + 1) xs s) PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return $ Skip - $ ParseChunksYield (Right b) (ParseChunksInit src s) + $ ParseChunksYield (Right b) (ParseChunksInit (i + 1 - n) src s) PR.Error err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError (i + 1) err)) + (ParseChunksInitLeftOver (i + 1) []) -- This is simplified ParseChunksBuf - stepOuter _ (ParseChunksExtract [] buf pst) = - return $ Skip $ ParseChunksStop buf pst + stepOuter _ (ParseChunksExtract i [] buf pst) = + return $ Skip $ ParseChunksStop i buf pst - stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do + stepOuter _ (ParseChunksExtract i (x:xs) buf pst) = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ParseChunksExtract xs [] pst1 + return $ Skip $ ParseChunksExtract (i + 1) xs [] pst1 PR.Partial n pst1 -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ParseChunksExtract src [] pst1 + return $ Skip $ ParseChunksExtract (i + 1 - n) src [] pst1 PR.Continue 0 pst1 -> - return $ Skip $ ParseChunksExtract xs (x:buf) pst1 + return $ Skip $ ParseChunksExtract (i + 1) xs (x:buf) pst1 PR.Continue n pst1 -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs - return $ Skip $ ParseChunksExtract src buf1 pst1 + return $ Skip $ ParseChunksExtract (i + 1 - n) src buf1 pst1 PR.Done 0 b -> return $ Skip - $ ParseChunksYield (Right b) (ParseChunksInitBuf xs) + $ ParseChunksYield (Right b) (ParseChunksInitBuf (i + 1) xs) PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return $ Skip - $ ParseChunksYield (Right b) (ParseChunksInitBuf src) + $ ParseChunksYield (Right b) (ParseChunksInitBuf (i + 1 - n) src) PR.Error err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError (i + 1) err)) + (ParseChunksInitLeftOver (i + 1) []) -- This is simplified ParseChunksExtract - stepOuter _ (ParseChunksStop buf pst) = do + stepOuter _ (ParseChunksStop i buf pst) = do pRes <- extract pst case pRes of PR.Partial _ _ -> error "Bug: parseMany: Partial in extract" PR.Continue 0 pst1 -> - return $ Skip $ ParseChunksStop buf pst1 + return $ Skip $ ParseChunksStop i buf pst1 PR.Continue n pst1 -> do assert (n <= length buf) (return ()) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 - return $ Skip $ ParseChunksExtract src buf1 pst1 + return $ Skip $ ParseChunksExtract (i - n) src buf1 pst1 PR.Done 0 b -> do return $ Skip $ - ParseChunksYield (Right b) (ParseChunksInitLeftOver []) + ParseChunksYield (Right b) (ParseChunksInitLeftOver i []) PR.Done n b -> do assert (n <= length buf) (return ()) let src = Prelude.reverse (Prelude.take n buf) return $ Skip $ - ParseChunksYield (Right b) (ParseChunksInitBuf src) + ParseChunksYield (Right b) (ParseChunksInitBuf (i - n) src) PR.Error err -> return $ Skip $ ParseChunksYield - (Left (ParseError err)) - (ParseChunksInitLeftOver []) + (Left (ParseError i err)) + (ParseChunksInitLeftOver i []) stepOuter _ (ParseChunksYield a next) = return $ Yield a next @@ -1836,16 +1836,16 @@ parseManyTill = undefined {-# ANN type ConcatParseState Fuse #-} data ConcatParseState c b inpBuf st p m a = - ConcatParseInit inpBuf st p - | ConcatParseInitBuf inpBuf p - | ConcatParseInitLeftOver inpBuf - | forall s. ConcatParseStop + ConcatParseInit Int inpBuf st p + | ConcatParseInitBuf Int inpBuf p + | ConcatParseInitLeftOver Int inpBuf + | forall s. ConcatParseStop Int inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b)) - | forall s. ConcatParseStream + | forall s. ConcatParseStream Int st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b)) - | forall s. ConcatParseBuf + | forall s. ConcatParseBuf Int inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b)) - | forall s. ConcatParseExtract + | forall s. ConcatParseExtract Int inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b)) | ConcatParseYield c (ConcatParseState c b inpBuf st p m a) @@ -1873,194 +1873,194 @@ parseIterate -> Stream m a -> Stream m (Either ParseError b) parseIterate func seed (Stream step state) = - Stream stepOuter (ConcatParseInit [] state (func seed)) + Stream stepOuter (ConcatParseInit 0 [] state (func seed)) where {-# INLINE_LATE stepOuter #-} -- Buffer is empty, go to stream processing loop - stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do + stepOuter _ (ConcatParseInit i [] st (PRD.Parser pstep initial extract)) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ConcatParseStream st [] pstep ps extract + return $ Skip $ ConcatParseStream i st [] pstep ps extract PRD.IDone pb -> - let next = ConcatParseInit [] st (func pb) + let next = ConcatParseInit i [] st (func pb) in return $ Skip $ ConcatParseYield (Right pb) next PRD.IError err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError i err)) + (ConcatParseInitLeftOver i []) -- Buffer is not empty, go to buffered processing loop - stepOuter _ (ConcatParseInit src st + stepOuter _ (ConcatParseInit i src st (PRD.Parser pstep initial extract)) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ConcatParseBuf src st [] pstep ps extract + return $ Skip $ ConcatParseBuf i src st [] pstep ps extract PRD.IDone pb -> - let next = ConcatParseInit src st (func pb) + let next = ConcatParseInit i src st (func pb) in return $ Skip $ ConcatParseYield (Right pb) next PRD.IError err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError i err)) + (ConcatParseInitLeftOver i []) -- This is simplified ConcatParseInit - stepOuter _ (ConcatParseInitBuf src + stepOuter _ (ConcatParseInitBuf i src (PRD.Parser pstep initial extract)) = do res <- initial case res of PRD.IPartial ps -> - return $ Skip $ ConcatParseExtract src [] pstep ps extract + return $ Skip $ ConcatParseExtract i src [] pstep ps extract PRD.IDone pb -> - let next = ConcatParseInitBuf src (func pb) + let next = ConcatParseInitBuf i src (func pb) in return $ Skip $ ConcatParseYield (Right pb) next PRD.IError err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError i err)) + (ConcatParseInitLeftOver i []) -- XXX we just discard any leftover input at the end - stepOuter _ (ConcatParseInitLeftOver _) = return Stop + stepOuter _ (ConcatParseInitLeftOver _ _) = return Stop -- Buffer is empty process elements from the stream - stepOuter gst (ConcatParseStream st buf pstep pst extract) = do + stepOuter gst (ConcatParseStream i st buf pstep pst extract) = do r <- step (adaptState gst) st case r of Yield x s -> do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ConcatParseStream s [] pstep pst1 extract + return $ Skip $ ConcatParseStream (i + 1) s [] pstep pst1 extract PR.Partial n pst1 -> do 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 + return $ Skip $ ConcatParseBuf (i + 1 - n) src s [] pstep pst1 extract -- PR.Continue 0 pst1 -> -- return $ Skip $ ConcatParseStream s (x:buf) pst1 PR.Continue n pst1 -> do 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 + return $ Skip $ ConcatParseBuf (i + 1 - n) src s buf1 pstep pst1 extract -- XXX Specialize for Stop 0 common case? PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) return $ Skip $ - ConcatParseYield (Right b) (ConcatParseInit src s (func b)) + ConcatParseYield (Right b) (ConcatParseInit (i + 1 - n) src s (func b)) PR.Error err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) - Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract - Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract + (Left (ParseError (i + 1) err)) + (ConcatParseInitLeftOver (i + 1) []) + Skip s -> return $ Skip $ ConcatParseStream i s buf pstep pst extract + Stop -> return $ Skip $ ConcatParseStop i buf pstep pst extract -- go back to stream processing mode - stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) = - return $ Skip $ ConcatParseStream s buf pstep ps extract + stepOuter _ (ConcatParseBuf i [] s buf pstep ps extract) = + return $ Skip $ ConcatParseStream i s buf pstep ps extract -- buffered processing loop - stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do + stepOuter _ (ConcatParseBuf i (x:xs) s buf pstep pst extract) = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract + return $ Skip $ ConcatParseBuf (i + 1) xs s [] pstep pst1 extract PR.Partial n pst1 -> do 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 + return $ Skip $ ConcatParseBuf (i + 1 - n) src s [] pstep pst1 extract -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1 PR.Continue n pst1 -> do 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 + return $ Skip $ ConcatParseBuf (i + 1 - n) src s buf1 pstep pst1 extract -- XXX Specialize for Stop 0 common case? PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs return $ Skip $ ConcatParseYield (Right b) - (ConcatParseInit src s (func b)) + (ConcatParseInit (i + 1 - n) src s (func b)) PR.Error err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError (i + 1) err)) + (ConcatParseInitLeftOver (i + 1) []) -- This is simplified ConcatParseBuf - stepOuter _ (ConcatParseExtract [] buf pstep pst extract) = - return $ Skip $ ConcatParseStop buf pstep pst extract + stepOuter _ (ConcatParseExtract i [] buf pstep pst extract) = + return $ Skip $ ConcatParseStop i buf pstep pst extract - stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do + stepOuter _ (ConcatParseExtract i (x:xs) buf pstep pst extract) = do pRes <- pstep pst x case pRes of PR.Partial 0 pst1 -> - return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract + return $ Skip $ ConcatParseExtract (i + 1) xs [] pstep pst1 extract PR.Partial n pst1 -> do 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 + return $ Skip $ ConcatParseExtract (i + 1 - n) src [] pstep pst1 extract PR.Continue 0 pst1 -> - return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract + return $ Skip $ ConcatParseExtract (i + 1) xs (x:buf) pstep pst1 extract PR.Continue n pst1 -> do 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 + return $ Skip $ ConcatParseExtract (i + 1 - n) src buf1 pstep pst1 extract PR.Done 0 b -> - return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b)) + return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf (i + 1) xs (func b)) PR.Done n b -> do 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)) + return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf (i + 1 - n) src (func b)) PR.Error err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError (i + 1) err)) + (ConcatParseInitLeftOver (i + 1) []) -- This is simplified ConcatParseExtract - stepOuter _ (ConcatParseStop buf pstep pst extract) = do + stepOuter _ (ConcatParseStop i buf pstep pst extract) = do pRes <- extract pst case pRes of PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract" PR.Continue 0 pst1 -> - return $ Skip $ ConcatParseStop buf pstep pst1 extract + return $ Skip $ ConcatParseStop i buf pstep pst1 extract PR.Continue n pst1 -> do assert (n <= length buf) (return ()) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 - return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract + return $ Skip $ ConcatParseExtract (i - n) src buf1 pstep pst1 extract PR.Done 0 b -> do return $ Skip $ - ConcatParseYield (Right b) (ConcatParseInitLeftOver []) + ConcatParseYield (Right b) (ConcatParseInitLeftOver i []) PR.Done n b -> do assert (n <= length buf) (return ()) let src = Prelude.reverse (Prelude.take n buf) return $ Skip $ - ConcatParseYield (Right b) (ConcatParseInitBuf src (func b)) + ConcatParseYield (Right b) (ConcatParseInitBuf (i - n) src (func b)) PR.Error err -> return $ Skip $ ConcatParseYield - (Left (ParseError err)) - (ConcatParseInitLeftOver []) + (Left (ParseError i err)) + (ConcatParseInitLeftOver i []) stepOuter _ (ConcatParseYield a next) = return $ Yield a next diff --git a/core/src/Streamly/Internal/Data/StreamK.hs b/core/src/Streamly/Internal/Data/StreamK.hs index 8a48d0f48d..ad188be032 100644 --- a/core/src/Streamly/Internal/Data/StreamK.hs +++ b/core/src/Streamly/Internal/Data/StreamK.hs @@ -1182,9 +1182,9 @@ parseDBreak parseDBreak (PR.Parser pstep initial extract) stream = do res <- initial case res of - PR.IPartial s -> goStream stream [] s + PR.IPartial s -> goStream stream [] s 0 PR.IDone b -> return (Right b, stream) - PR.IError err -> return (Left (ParseError err), stream) + PR.IError err -> return (Left (ParseError 0 err), stream) where @@ -1194,41 +1194,41 @@ parseDBreak (PR.Parser pstep initial extract) stream = do -- XXX currently we are using a dumb list based approach for backtracking -- buffer. This can be replaced by a sliding/ring buffer using Data.Array. -- That will allow us more efficient random back and forth movement. - goStream st buf !pst = + goStream st buf !pst i = let stop = do r <- extract pst case r of PR.Error err -> do let src = Prelude.reverse buf - return (Left (ParseError err), fromList src) + return (Left (ParseError i err), fromList src) PR.Done n b -> do 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 0 s -> goStream nil buf s i PR.Continue n s -> do assertM(n <= length buf) let (src0, buf1) = splitAt n buf src = Prelude.reverse src0 - goBuf nil buf1 src s + goBuf nil buf1 src s (i - n) single x = yieldk x nil yieldk x r = do res <- pstep pst x case res of - PR.Partial 0 s -> goStream r [] s + PR.Partial 0 s -> goStream r [] s (i + 1) PR.Partial n s -> do 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 + goBuf r [] src s (i + 1 - n) + PR.Continue 0 s -> goStream r (x:buf) s (i + 1) PR.Continue n s -> do assertM(n <= length (x:buf)) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 - goBuf r buf1 src s + goBuf r buf1 src s (i + 1 - n) PR.Done 0 b -> return (Right b, r) PR.Done n b -> do assertM(n <= length (x:buf)) @@ -1237,25 +1237,25 @@ parseDBreak (PR.Parser pstep initial extract) stream = do return (Right b, append (fromList src) r) PR.Error err -> do let src = Prelude.reverse (x:buf) - return (Left (ParseError err), append (fromList src) r) + return (Left (ParseError (i + 1) err), append (fromList src) r) in foldStream defState yieldk single stop st - goBuf st buf [] !pst = goStream st buf pst - goBuf st buf (x:xs) !pst = do + goBuf st buf [] !pst i = goStream st buf pst i + goBuf st buf (x:xs) !pst i = do pRes <- pstep pst x case pRes of - PR.Partial 0 s -> goBuf st [] xs s + PR.Partial 0 s -> goBuf st [] xs s (i + 1) PR.Partial n s -> do 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 + goBuf st [] src s (i + 1 - n) + PR.Continue 0 s -> goBuf st (x:buf) xs s (i + 1) PR.Continue n s -> do assert (n <= length (x:buf)) (return ()) let (src0, buf1) = splitAt n (x:buf) src = Prelude.reverse src0 ++ xs - goBuf st buf1 src s + goBuf st buf1 src s (i + 1 - n) PR.Done n b -> do assert (n <= length (x:buf)) (return ()) let src0 = Prelude.take n (x:buf) @@ -1263,7 +1263,7 @@ parseDBreak (PR.Parser pstep initial extract) stream = do return (Right b, append (fromList src) st) PR.Error err -> do let src = Prelude.reverse buf ++ x:xs - return (Left (ParseError err), append (fromList src) st) + return (Left (ParseError (i + 1) err), append (fromList src) st) -- Using ParserD or ParserK on StreamK may not make much difference. We should -- perhaps use only chunked parsing on StreamK. We can always convert a stream @@ -1326,31 +1326,31 @@ parseBreakChunks -> m (Either ParseError b, StreamK m (Array a)) parseBreakChunks parser input = do let parserk = ParserK.runParser parser parserDone 0 0 - in go [] parserk input + in go 0 [] parserk input where {-# INLINE goStop #-} - goStop backBuf parserk = do + goStop absPos backBuf parserk = do pRes <- parserk ParserK.None case pRes of -- If we stop in an alternative, it will try calling the next -- parser, the next parser may call initial returning Partial and -- then immediately we have to call extract on it. ParserK.Partial 0 cont1 -> - go [] cont1 nil + go absPos [] cont1 nil ParserK.Partial n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf)) let (s1, backBuf1) = backTrack n1 backBuf nil - in go backBuf1 cont1 s1 + in go (absPos + n) backBuf1 cont1 s1 ParserK.Continue 0 cont1 -> - go backBuf cont1 nil + go absPos backBuf cont1 nil ParserK.Continue n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf)) let (s1, backBuf1) = backTrack n1 backBuf nil - in go backBuf1 cont1 s1 + in go (absPos + n) backBuf1 cont1 s1 ParserK.Done 0 b -> return (Right b, nil) ParserK.Done n b -> do @@ -1358,60 +1358,60 @@ parseBreakChunks parser input = do assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf)) let (s1, _) = backTrack n1 backBuf nil in return (Right b, s1) - ParserK.Error _ err -> do + ParserK.Error n err -> do let (s1, _) = backTrack maxBound backBuf nil - return (Left (ParseError err), s1) + return (Left (ParseError (absPos + n) err), s1) seekErr n len = error $ "parseBreak: Partial: forward seek not implemented n = " ++ show n ++ " len = " ++ show len - yieldk backBuf parserk arr stream = do + yieldk absPos backBuf parserk arr stream = do pRes <- parserk (ParserK.Chunk arr) let len = Array.length arr case pRes of ParserK.Partial n cont1 -> case compare n len of - EQ -> go [] cont1 stream + EQ -> go (absPos + n) [] cont1 stream LT -> do if n >= 0 - then yieldk [] cont1 arr stream + then yieldk (absPos + n) [] cont1 arr stream else do let n1 = negate n bufLen = sum (Prelude.map Array.length backBuf) s = cons arr stream assertM(n1 >= 0 && n1 <= bufLen) let (s1, _) = backTrack n1 backBuf s - go [] cont1 s1 + go (absPos + n) [] cont1 s1 GT -> seekErr n len ParserK.Continue n cont1 -> case compare n len of - EQ -> go (arr:backBuf) cont1 stream + EQ -> go (absPos + n) (arr:backBuf) cont1 stream LT -> do if n >= 0 - then yieldk backBuf cont1 arr stream + then yieldk (absPos + n) backBuf cont1 arr stream else do let n1 = negate n bufLen = sum (Prelude.map Array.length backBuf) s = cons arr stream assertM(n1 >= 0 && n1 <= bufLen) let (s1, backBuf1) = backTrack n1 backBuf s - go backBuf1 cont1 s1 + go (absPos + n) backBuf1 cont1 s1 GT -> seekErr n len ParserK.Done n b -> do let n1 = len - n assertM(n1 <= sum (Prelude.map Array.length (arr:backBuf))) let (s1, _) = backTrack n1 (arr:backBuf) stream in return (Right b, s1) - ParserK.Error _ err -> do + ParserK.Error n err -> do let (s1, _) = backTrack maxBound (arr:backBuf) stream - return (Left (ParseError err), s1) + return (Left (ParseError (absPos + n + 1) err), s1) - go backBuf parserk stream = do - let stop = goStop backBuf parserk - single a = yieldk backBuf parserk a nil + go absPos backBuf parserk stream = do + let stop = goStop absPos backBuf parserk + single a = yieldk absPos backBuf parserk a nil in foldStream - defState (yieldk backBuf parserk) single stop stream + defState (yieldk absPos backBuf parserk) single stop stream {-# INLINE parseChunks #-} parseChunks :: (Monad m, Unbox a) => @@ -1445,35 +1445,36 @@ parseBreak -> m (Either ParseError b, StreamK m a) parseBreak parser input = do let parserk = ParserK.runParser parser parserDone 0 0 - in go [] parserk input + in go 0 [] parserk input where {-# INLINE goStop #-} goStop - :: [a] + :: Int + -> [a] -> (ParserK.Input a -> m (ParserK.Step a m b)) -> m (Either ParseError b, StreamK m a) - goStop backBuf parserk = do + goStop absPos backBuf parserk = do pRes <- parserk ParserK.None case pRes of -- If we stop in an alternative, it will try calling the next -- parser, the next parser may call initial returning Partial and -- then immediately we have to call extract on it. ParserK.Partial 0 cont1 -> - go [] cont1 nil + go absPos [] cont1 nil ParserK.Partial n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= length backBuf) let (s1, backBuf1) = backTrackSingular n1 backBuf nil - in go backBuf1 cont1 s1 + in go (absPos + n) backBuf1 cont1 s1 ParserK.Continue 0 cont1 -> - go backBuf cont1 nil + go absPos 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 - in go backBuf1 cont1 s1 + in go (absPos + n) backBuf1 cont1 s1 ParserK.Done 0 b -> return (Right b, nil) ParserK.Done n b -> do @@ -1481,27 +1482,28 @@ parseBreak parser input = do assertM(n1 >= 0 && n1 <= length backBuf) let (s1, _) = backTrackSingular n1 backBuf nil in return (Right b, s1) - ParserK.Error _ err -> + ParserK.Error n err -> let strm = fromList (Prelude.reverse backBuf) - in return (Left (ParseError err), strm) + in return (Left (ParseError (absPos + n) err), strm) seekErr n = error $ "parseBreak: Partial: forward seek not implemented n = " ++ show n yieldk - :: [a] + :: Int + -> [a] -> (ParserK.Input a -> m (ParserK.Step a m b)) -> a -> StreamK m a -> m (Either ParseError b, StreamK m a) - yieldk backBuf parserk element stream = do + yieldk absPos backBuf parserk element stream = do pRes <- parserk (ParserK.Chunk element) -- NOTE: factoring out "cons element stream" in a let statement here -- cause big alloc regression. case pRes of - ParserK.Partial 1 cont1 -> go [] cont1 stream - ParserK.Partial 0 cont1 -> go [] cont1 (cons element stream) + ParserK.Partial 1 cont1 -> go (absPos + 1) [] cont1 stream + ParserK.Partial 0 cont1 -> go absPos [] cont1 (cons element stream) ParserK.Partial n _ | n > 1 -> seekErr n ParserK.Partial n cont1 -> do -- n < 0 case let n1 = negate n @@ -1509,10 +1511,10 @@ parseBreak parser input = do s = cons element stream assertM(n1 >= 0 && n1 <= bufLen) let (s1, _) = backTrackSingular n1 backBuf s - go [] cont1 s1 - ParserK.Continue 1 cont1 -> go (element:backBuf) cont1 stream + go (absPos + n) [] cont1 s1 + ParserK.Continue 1 cont1 -> go (absPos + 1) (element:backBuf) cont1 stream ParserK.Continue 0 cont1 -> - go backBuf cont1 (cons element stream) + go absPos backBuf cont1 (cons element stream) ParserK.Continue n _ | n > 1 -> seekErr n ParserK.Continue n cont1 -> do let n1 = negate n @@ -1520,7 +1522,7 @@ parseBreak parser input = do s = cons element stream assertM(n1 >= 0 && n1 <= bufLen) let (s1, backBuf1) = backTrackSingular n1 backBuf s - go backBuf1 cont1 s1 + go (absPos + n) 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 @@ -1531,23 +1533,24 @@ parseBreak parser input = do assertM(n1 >= 0 && n1 <= bufLen) let (s1, _) = backTrackSingular n1 backBuf s pure (Right b, s1) - ParserK.Error _ err -> + ParserK.Error n err -> let strm = append (fromList (Prelude.reverse backBuf)) (cons element stream) - in return (Left (ParseError err), strm) + in return (Left (ParseError (absPos + n + 1) err), strm) go - :: [a] + :: Int + -> [a] -> (ParserK.Input a -> m (ParserK.Step a m b)) -> StreamK m a -> m (Either ParseError b, StreamK m a) - go backBuf parserk stream = do - let stop = goStop backBuf parserk - single a = yieldk backBuf parserk a nil + go absPos backBuf parserk stream = do + let stop = goStop absPos backBuf parserk + single a = yieldk absPos backBuf parserk a nil in foldStream - defState (yieldk backBuf parserk) single stop stream + defState (yieldk absPos backBuf parserk) single stop stream -- | Run a 'ParserK' over a 'StreamK'. Please use 'parseChunks' where possible, -- for better performance. @@ -1592,36 +1595,37 @@ parseBreakChunksGeneric -> m (Either ParseError b, StreamK m (GenArr.Array a)) parseBreakChunksGeneric parser input = do let parserk = ParserK.runParser parser parserDone 0 0 - in go [] parserk input + in go 0 [] parserk input where {-# INLINE goStop #-} goStop - :: [GenArr.Array a] + :: Int + -> [GenArr.Array a] -> (ParserK.Input (GenArr.Array a) -> m (ParserK.Step (GenArr.Array a) m b)) -> m (Either ParseError b, StreamK m (GenArr.Array a)) - goStop backBuf parserk = do + goStop absPos backBuf parserk = do pRes <- parserk ParserK.None case pRes of -- If we stop in an alternative, it will try calling the next -- parser, the next parser may call initial returning Partial and -- then immediately we have to call extract on it. ParserK.Partial 0 cont1 -> - go [] cont1 nil + go absPos [] cont1 nil ParserK.Partial n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map GenArr.length backBuf)) let (s1, backBuf1) = backTrackGenericChunks n1 backBuf nil - in go backBuf1 cont1 s1 + in go (absPos + n) backBuf1 cont1 s1 ParserK.Continue 0 cont1 -> - go backBuf cont1 nil + go absPos backBuf cont1 nil ParserK.Continue n cont1 -> do let n1 = negate n assertM(n1 >= 0 && n1 <= sum (Prelude.map GenArr.length backBuf)) let (s1, backBuf1) = backTrackGenericChunks n1 backBuf nil - in go backBuf1 cont1 s1 + in go (absPos + n) backBuf1 cont1 s1 ParserK.Done 0 b -> return (Right b, nil) ParserK.Done n b -> do @@ -1629,76 +1633,78 @@ parseBreakChunksGeneric parser input = do assertM(n1 >= 0 && n1 <= sum (Prelude.map GenArr.length backBuf)) let (s1, _) = backTrackGenericChunks n1 backBuf nil in return (Right b, s1) - ParserK.Error _ err -> + ParserK.Error n err -> let strm = fromList (Prelude.reverse backBuf) - in return (Left (ParseError err), strm) + in return (Left (ParseError (absPos + n) err), strm) seekErr n len = error $ "parseBreak: Partial: forward seek not implemented n = " ++ show n ++ " len = " ++ show len yieldk - :: [GenArr.Array a] + :: Int + -> [GenArr.Array a] -> (ParserK.Input (GenArr.Array a) -> m (ParserK.Step (GenArr.Array a) m b)) -> GenArr.Array a -> StreamK m (GenArr.Array a) -> m (Either ParseError b, StreamK m (GenArr.Array a)) - yieldk backBuf parserk arr stream = do + yieldk absPos backBuf parserk arr stream = do pRes <- parserk (ParserK.Chunk arr) let len = GenArr.length arr case pRes of ParserK.Partial n cont1 -> case compare n len of - EQ -> go [] cont1 stream + EQ -> go (absPos + n) [] cont1 stream LT -> do if n >= 0 - then yieldk [] cont1 arr stream + then yieldk (absPos + n) [] cont1 arr stream else do let n1 = negate n bufLen = sum (Prelude.map GenArr.length backBuf) s = cons arr stream assertM(n1 >= 0 && n1 <= bufLen) let (s1, _) = backTrackGenericChunks n1 backBuf s - go [] cont1 s1 + go (absPos + n) [] cont1 s1 GT -> seekErr n len ParserK.Continue n cont1 -> case compare n len of - EQ -> go (arr:backBuf) cont1 stream + EQ -> go (absPos + n) (arr:backBuf) cont1 stream LT -> do if n >= 0 - then yieldk backBuf cont1 arr stream + then yieldk (absPos + n) backBuf cont1 arr stream else do let n1 = negate n bufLen = sum (Prelude.map GenArr.length backBuf) s = cons arr stream assertM(n1 >= 0 && n1 <= bufLen) let (s1, backBuf1) = backTrackGenericChunks n1 backBuf s - go backBuf1 cont1 s1 + go (absPos + n) backBuf1 cont1 s1 GT -> seekErr n len ParserK.Done n b -> do let n1 = len - n assertM(n1 <= sum (Prelude.map GenArr.length (arr:backBuf))) let (s1, _) = backTrackGenericChunks n1 (arr:backBuf) stream in return (Right b, s1) - ParserK.Error _ err -> + ParserK.Error n err -> let strm = append (fromList (Prelude.reverse backBuf)) (cons arr stream) - in return (Left (ParseError err), strm) + in return (Left (ParseError (absPos + n + 1) err), strm) go - :: [GenArr.Array a] + :: Int + -> [GenArr.Array a] -> (ParserK.Input (GenArr.Array a) -> m (ParserK.Step (GenArr.Array a) m b)) -> StreamK m (GenArr.Array a) -> m (Either ParseError b, StreamK m (GenArr.Array a)) - go backBuf parserk stream = do - let stop = goStop backBuf parserk - single a = yieldk backBuf parserk a nil + go absPos backBuf parserk stream = do + let stop = goStop absPos backBuf parserk + single a = yieldk absPos backBuf parserk a nil in foldStream - defState (yieldk backBuf parserk) single stop stream + defState (yieldk absPos backBuf parserk) single stop stream {-# INLINE parseChunksGeneric #-} parseChunksGeneric :: diff --git a/core/src/Streamly/Internal/Unicode/Parser.hs b/core/src/Streamly/Internal/Unicode/Parser.hs index 1e85c7d4ed..491cfd2f28 100644 --- a/core/src/Streamly/Internal/Unicode/Parser.hs +++ b/core/src/Streamly/Internal/Unicode/Parser.hs @@ -614,13 +614,13 @@ mkDouble mantissa power = -- Error cases: -- -- >>> p "" --- Left (ParseError "number: expecting sign or decimal digit, got end of input") +-- Left (ParseError 0 "number: expecting sign or decimal digit, got end of input") -- -- >>> p ".1" --- Left (ParseError "number: expecting sign or decimal digit, got '.'") +-- Left (ParseError 1 "number: expecting sign or decimal digit, got '.'") -- -- >>> p "+" --- Left (ParseError "number: expecting decimal digit, got end of input") +-- Left (ParseError 1 "number: expecting decimal digit, got end of input") -- {-# INLINE double #-} double :: Monad m => Parser Char m Double diff --git a/docs/User/Tutorials/module-structure-and-quick-examples.md b/docs/User/Tutorials/module-structure-and-quick-examples.md index c3dd722e85..d2b033e4a0 100644 --- a/docs/User/Tutorials/module-structure-and-quick-examples.md +++ b/docs/User/Tutorials/module-structure-and-quick-examples.md @@ -129,7 +129,7 @@ For example, to parse a sequence of digits: >>> Stream.parse decimal $ Stream.fromList "1234 is the number" Right "1234" >>> Stream.parse decimal $ Stream.fromList "this is the number" -Left (ParseError "takeWhile1: predicate failed on first element") +Left (ParseError 1 "takeWhile1: predicate failed on first element") ``` On failure we can return a default value: @@ -143,7 +143,7 @@ See "Streamly.Data.Parser" module. ## Arrays -