Skip to content

Commit

Permalink
Track the absolute position in the drivers of Parser
Browse files Browse the repository at this point in the history
  • Loading branch information
@adithyaov
adithyaov committed Oct 8, 2024
1 parent bbac52d commit 38f5c2c
Show file tree
Hide file tree
Showing 12 changed files with 277 additions and 273 deletions.
2 changes: 1 addition & 1 deletion benchmark/Streamly/Benchmark/Data/Parser.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
2 changes: 1 addition & 1 deletion benchmark/Streamly/Benchmark/Data/ParserK.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
2 changes: 1 addition & 1 deletion benchmark/Streamly/Benchmark/Unicode/Parser.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
48 changes: 24 additions & 24 deletions core/src/Streamly/Internal/Data/Array.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 #-}
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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) =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
5 changes: 3 additions & 2 deletions core/src/Streamly/Internal/Data/Parser/Type.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading

0 comments on commit 38f5c2c

Please sign in to comment.