Skip to content

Commit

Permalink
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Track the absolute position in the drivers of Parser
Browse files Browse the repository at this point in the history
adithyaov committed Oct 11, 2024
1 parent ddfe7ae commit 0719551
Showing 17 changed files with 363 additions and 354 deletions.
2 changes: 1 addition & 1 deletion benchmark/Streamly/Benchmark/Data/Parser.hs
Original file line number Diff line number Diff line change
@@ -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 =
2 changes: 1 addition & 1 deletion benchmark/Streamly/Benchmark/Data/ParserK.hs
Original file line number Diff line number Diff line change
@@ -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 =
2 changes: 1 addition & 1 deletion benchmark/Streamly/Benchmark/Unicode/Parser.hs
Original file line number Diff line number Diff line change
@@ -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 =
48 changes: 24 additions & 24 deletions core/src/Streamly/Internal/Data/Array.hs
Original file line number Diff line number Diff line change
@@ -907,9 +907,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

@@ -919,37 +919,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)
@@ -967,34 +967,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)
@@ -1012,21 +1012,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
@@ -1039,4 +1039,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)
22 changes: 11 additions & 11 deletions core/src/Streamly/Internal/Data/Array/Stream.hs
Original file line number Diff line number Diff line change
@@ -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

20 changes: 10 additions & 10 deletions core/src/Streamly/Internal/Data/Parser.hs
Original file line number Diff line number Diff line change
@@ -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 1 "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 1 "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+"
5 changes: 3 additions & 2 deletions core/src/Streamly/Internal/Data/Parser/Type.hs
Original file line number Diff line number Diff line change
@@ -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
56 changes: 28 additions & 28 deletions core/src/Streamly/Internal/Data/Producer/Source.hs
Original file line number Diff line number Diff line change
@@ -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
78 changes: 39 additions & 39 deletions core/src/Streamly/Internal/Data/Stream/Eliminate.hs
Original file line number Diff line number Diff line change
@@ -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,53 +283,53 @@ 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)
src = Prelude.reverse src0 ++ xs
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'.
--
250 changes: 125 additions & 125 deletions core/src/Streamly/Internal/Data/Stream/Nesting.hs

Large diffs are not rendered by default.

180 changes: 93 additions & 87 deletions core/src/Streamly/Internal/Data/StreamK.hs

Large diffs are not rendered by default.

6 changes: 3 additions & 3 deletions core/src/Streamly/Internal/Unicode/Parser.hs
Original file line number Diff line number Diff line change
@@ -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
6 changes: 3 additions & 3 deletions docs/User/Tutorials/module-structure-and-quick-examples.md
Original file line number Diff line number Diff line change
@@ -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

<!-- TODO Add pinning and unpinning examples
<!-- TODO Add pinning and unpinning examples
See the
[streamly-bytestring](https://github.com/psibi/streamly-bytestring)
repository.
@@ -336,7 +336,7 @@ See `Streamly.Data.Fold.Prelude` module.
## Console IO

The `Streamly.Console.Stdio` module provides facilities to read a stream
from stdin and to write a stream to stdout and stderr.
from stdin and to write a stream to stdout and stderr.

Implementation of a console echo program:

2 changes: 1 addition & 1 deletion src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs
Original file line number Diff line number Diff line change
@@ -392,7 +392,7 @@ parseK p = parse (PRK.toParser p)
-- result in an 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:
--
4 changes: 1 addition & 3 deletions test/Streamly/Test/Data/Parser.hs
Original file line number Diff line number Diff line change
@@ -112,7 +112,7 @@ parserFail =
property $
case runIdentity $ S.parse (Fail.fail err) (S.fromList [0 :: Int]) of
Right _ -> False
Left (ParseError e) -> err == e
Left (ParseError _ e) -> err == e
where
err = "Testing MonadFail.fail."

@@ -1312,8 +1312,6 @@ TODO:
Add sanity tests for
- Producer.parse
- Producer.parseMany
- Stream.parseMany
- Stream.parseIterate
-}

sanityParseBreak :: [Move] -> SpecWith ()
10 changes: 5 additions & 5 deletions test/Streamly/Test/Unicode/Parser.hs
Original file line number Diff line number Diff line change
@@ -80,7 +80,7 @@ double s d = monadicIO $ do
Right val -> if val == d
then assert (val == d)
else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d))
Left (ParseError _) -> assert False
Left (ParseError _ _) -> assert False

numberP :: Monad m => Parser Char m Double
numberP = uncurry Parser.mkDouble <$> Parser.number
@@ -95,16 +95,16 @@ number s d = monadicIO $ do
Right val -> if val == d
then assert (val == d)
else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d))
Left (ParseError _) -> assert False
Left (ParseError _ _) -> assert False

doubleErr :: (String -> IO (Either ParseError Double)) -> String -> String -> Property
doubleErr f s msg = monadicIO $ do
x <- run $ f s
case x of
Right _ -> assert False
Left (ParseError err) -> if err == msg
then assert (err == msg)
else trace err (assert (err == msg))
Left (ParseError _ err) -> if err == msg
then assert (err == msg)
else trace err (assert (err == msg))

remainingStreamDouble :: String -> [String]
remainingStreamDouble x =
24 changes: 14 additions & 10 deletions test/lib/Streamly/Test/Parser/Common.hs
Original file line number Diff line number Diff line change
@@ -74,7 +74,7 @@ expectedResult moves inp = go 0 0 [] moves
-- j = Minimum index of inp head
go i j ys [] = (Right ys, slice_ (max i j) inp)
go i j ys ((Consume n):xs)
| i + n > inpLen = (Left (ParseError "INCOMPLETE"), drop j inp)
| i + n > inpLen = (Left (ParseError inpLen "INCOMPLETE"), drop j inp)
| otherwise =
go (i + n) j (ys ++ slice i n inp) xs
go i j ys ((Custom step):xs)
@@ -86,22 +86,26 @@ expectedResult moves inp = go 0 0 [] moves
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.Error err -> (Left (ParseError err), slice_ j inp)
P.Error err -> (Left (ParseError i 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.Error err -> (Left (ParseError err), slice_ j inp)
P.Error err -> (Left (ParseError (i + 1) err), slice_ j inp)

expectedResultMany :: [Move] -> [Int] -> [Either ParseError [Int]]
expectedResultMany _ [] = []
expectedResultMany moves inp =
let (res, rest) = expectedResult moves inp
in
case res of
Left err -> [Left err]
Right val -> Right val : expectedResultMany moves rest
expectedResultMany = go 0
where
go _ _ [] = []
go off moves inp =
let (res, rest) = expectedResult moves inp
consumed = length inp - length rest
in
case res of
Left (ParseError relOff err) ->
[Left (ParseError (off + relOff) err)]
Right val -> Right val : go (off + consumed) moves rest

createPaths :: [a] -> [[a]]
createPaths xs =

0 comments on commit 0719551

Please sign in to comment.