Skip to content

Commit 4a9e2e6

Browse files
committed
Track the absolute position in the drivers of Parser
1 parent ddfe7ae commit 4a9e2e6

13 files changed

Lines changed: 336 additions & 329 deletions

File tree

benchmark/Streamly/Benchmark/Data/Parser.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -709,7 +709,7 @@ moduleName = "Data.Parser"
709709

710710
instance NFData ParseError where
711711
{-# INLINE rnf #-}
712-
rnf (ParseError x) = rnf x
712+
rnf (ParseError i x) = rnf i `seq` rnf x
713713

714714
o_1_space_serial :: Int -> [Benchmark]
715715
o_1_space_serial value =

benchmark/Streamly/Benchmark/Data/ParserK.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -370,7 +370,7 @@ moduleName = MODULE_NAME
370370

371371
instance NFData ParseError where
372372
{-# INLINE rnf #-}
373-
rnf (ParseError x) = rnf x
373+
rnf (ParseError i x) = rnf i `seq` rnf x
374374

375375
o_1_space_serial :: Int -> [Benchmark]
376376
o_1_space_serial value =

benchmark/Streamly/Benchmark/Unicode/Parser.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,7 @@ moduleName = "Unicode.Parser"
7272

7373
instance NFData ParseError where
7474
{-# INLINE rnf #-}
75-
rnf (ParseError x) = rnf x
75+
rnf (ParseError i x) = rnf i `seq` rnf x
7676

7777
o_n_heap_serial :: Int -> [Benchmark]
7878
o_n_heap_serial value =

core/src/Streamly/Internal/Data/Array.hs

Lines changed: 24 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -907,9 +907,9 @@ parseBreakChunksK ::
907907
parseBreakChunksK (Parser pstep initial extract) stream = do
908908
res <- initial
909909
case res of
910-
IPartial s -> go s stream []
910+
IPartial s -> go s stream [] 0
911911
IDone b -> return (Right b, stream)
912-
IError err -> return (Left (ParseError err), stream)
912+
IError err -> return (Left (ParseError 0 err), stream)
913913

914914
where
915915

@@ -919,37 +919,37 @@ parseBreakChunksK (Parser pstep initial extract) stream = do
919919
-- XXX currently we are using a dumb list based approach for backtracking
920920
-- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
921921
-- That will allow us more efficient random back and forth movement.
922-
go !pst st backBuf = do
923-
let stop = goStop pst backBuf -- (, K.nil) <$> extract pst
922+
go !pst st backBuf i = do
923+
let stop = goStop pst backBuf i -- (, K.nil) <$> extract pst
924924
single a = yieldk a StreamK.nil
925-
yieldk arr r = goArray pst backBuf r arr
925+
yieldk arr r = goArray pst backBuf r arr i
926926
in StreamK.foldStream defState yieldk single stop st
927927

928928
-- Use strictness on "cur" to keep it unboxed
929-
goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf
930-
goArray !pst backBuf st (Array contents cur end) = do
929+
goArray !pst backBuf st (Array _ cur end) i | cur == end = go pst st backBuf i
930+
goArray !pst backBuf st (Array contents cur end) i = do
931931
x <- liftIO $ peekAt cur contents
932932
pRes <- pstep pst x
933933
let next = INDEX_NEXT(cur,a)
934934
case pRes of
935935
Parser.Partial 0 s ->
936-
goArray s [] st (Array contents next end)
936+
goArray s [] st (Array contents next end) (i + 1)
937937
Parser.Partial n s -> do
938938
assert (n <= Prelude.length (x:backBuf)) (return ())
939939
let src0 = Prelude.take n (x:backBuf)
940940
arr0 = fromListN n (Prelude.reverse src0)
941941
arr1 = Array contents next end
942942
src = arr0 <> arr1
943-
goArray s [] st src
943+
goArray s [] st src (i + 1 - n)
944944
Parser.Continue 0 s ->
945-
goArray s (x:backBuf) st (Array contents next end)
945+
goArray s (x:backBuf) st (Array contents next end) (i + 1)
946946
Parser.Continue n s -> do
947947
assert (n <= Prelude.length (x:backBuf)) (return ())
948948
let (src0, buf1) = Prelude.splitAt n (x:backBuf)
949949
arr0 = fromListN n (Prelude.reverse src0)
950950
arr1 = Array contents next end
951951
src = arr0 <> arr1
952-
goArray s buf1 st src
952+
goArray s buf1 st src (i + 1 - n)
953953
Parser.Done 0 b -> do
954954
let arr = Array contents next end
955955
return (Right b, StreamK.cons arr st)
@@ -967,34 +967,34 @@ parseBreakChunksK (Parser pstep initial extract) stream = do
967967
arr0 = fromListN n (Prelude.reverse backBuf)
968968
arr1 = Array contents cur end
969969
str = StreamK.cons arr0 (StreamK.cons arr1 st)
970-
return (Left (ParseError err), str)
970+
return (Left (ParseError (i + 1) err), str)
971971

972972
-- This is a simplified goArray
973-
goExtract !pst backBuf (Array _ cur end)
974-
| cur == end = goStop pst backBuf
975-
goExtract !pst backBuf (Array contents cur end) = do
973+
goExtract !pst backBuf (Array _ cur end) i
974+
| cur == end = goStop pst backBuf i
975+
goExtract !pst backBuf (Array contents cur end) i = do
976976
x <- liftIO $ peekAt cur contents
977977
pRes <- pstep pst x
978978
let next = INDEX_NEXT(cur,a)
979979
case pRes of
980980
Parser.Partial 0 s ->
981-
goExtract s [] (Array contents next end)
981+
goExtract s [] (Array contents next end) (i + 1)
982982
Parser.Partial n s -> do
983983
assert (n <= Prelude.length (x:backBuf)) (return ())
984984
let src0 = Prelude.take n (x:backBuf)
985985
arr0 = fromListN n (Prelude.reverse src0)
986986
arr1 = Array contents next end
987987
src = arr0 <> arr1
988-
goExtract s [] src
988+
goExtract s [] src (i + 1 - n)
989989
Parser.Continue 0 s ->
990-
goExtract s backBuf (Array contents next end)
990+
goExtract s backBuf (Array contents next end) (i + 1)
991991
Parser.Continue n s -> do
992992
assert (n <= Prelude.length (x:backBuf)) (return ())
993993
let (src0, buf1) = Prelude.splitAt n (x:backBuf)
994994
arr0 = fromListN n (Prelude.reverse src0)
995995
arr1 = Array contents next end
996996
src = arr0 <> arr1
997-
goExtract s buf1 src
997+
goExtract s buf1 src (i + 1 - n)
998998
Parser.Done 0 b -> do
999999
let arr = Array contents next end
10001000
return (Right b, StreamK.fromPure arr)
@@ -1012,21 +1012,21 @@ parseBreakChunksK (Parser pstep initial extract) stream = do
10121012
arr0 = fromListN n (Prelude.reverse backBuf)
10131013
arr1 = Array contents cur end
10141014
str = StreamK.cons arr0 (StreamK.fromPure arr1)
1015-
return (Left (ParseError err), str)
1015+
return (Left (ParseError (i + 1) err), str)
10161016

10171017
-- This is a simplified goExtract
10181018
{-# INLINE goStop #-}
1019-
goStop !pst backBuf = do
1019+
goStop !pst backBuf i = do
10201020
pRes <- extract pst
10211021
case pRes of
10221022
Parser.Partial _ _ -> error "Bug: parseBreak: Partial in extract"
10231023
Parser.Continue 0 s ->
1024-
goStop s backBuf
1024+
goStop s backBuf i
10251025
Parser.Continue n s -> do
10261026
assert (n <= Prelude.length backBuf) (return ())
10271027
let (src0, buf1) = Prelude.splitAt n backBuf
10281028
arr = fromListN n (Prelude.reverse src0)
1029-
goExtract s buf1 arr
1029+
goExtract s buf1 arr (i - n)
10301030
Parser.Done 0 b ->
10311031
return (Right b, StreamK.nil)
10321032
Parser.Done n b -> do
@@ -1039,4 +1039,4 @@ parseBreakChunksK (Parser pstep initial extract) stream = do
10391039
Parser.Error err -> do
10401040
let n = Prelude.length backBuf
10411041
arr0 = fromListN n (Prelude.reverse backBuf)
1042-
return (Left (ParseError err), StreamK.fromPure arr0)
1042+
return (Left (ParseError i err), StreamK.fromPure arr0)

core/src/Streamly/Internal/Data/Array/Stream.hs

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -321,7 +321,7 @@ runArrayParserDBreak
321321
case res of
322322
PRD.IPartial s -> go SPEC state (List []) s
323323
PRD.IDone b -> return (Right b, stream)
324-
PRD.IError err -> return (Left (ParseError err), stream)
324+
PRD.IError err -> return (Left (ParseError (-1) err), stream)
325325

326326
where
327327

@@ -374,7 +374,7 @@ runArrayParserDBreak
374374
let src0 = x:getList backBuf
375375
src = Prelude.reverse src0 ++ x:xs
376376
strm = D.append (D.fromList src) (D.Stream step s)
377-
return (Left (ParseError err), strm)
377+
return (Left (ParseError (-1) err), strm)
378378

379379
-- This is a simplified gobuf
380380
goExtract _ [] backBuf !pst = goStop backBuf pst
@@ -411,7 +411,7 @@ runArrayParserDBreak
411411
PR.Error err -> do
412412
let src0 = getList backBuf
413413
src = Prelude.reverse src0 ++ x:xs
414-
return (Left (ParseError err), D.fromList src)
414+
return (Left (ParseError (-1) err), D.fromList src)
415415

416416
-- This is a simplified goExtract
417417
{-# INLINE goStop #-}
@@ -439,7 +439,7 @@ runArrayParserDBreak
439439
PR.Error err -> do
440440
let src0 = getList backBuf
441441
src = Prelude.reverse src0
442-
return (Left (ParseError err), D.fromList src)
442+
return (Left (ParseError (-1) err), D.fromList src)
443443

444444
{-
445445
-- | Parse an array stream using the supplied 'Parser'. Returns the parse
@@ -517,7 +517,7 @@ runArrayFoldManyD
517517
let next = ParseChunksInitLeftOver []
518518
return
519519
$ D.Skip
520-
$ ParseChunksYield (Left (ParseError err)) next
520+
$ ParseChunksYield (Left (ParseError (-1) err)) next
521521
D.Skip s -> return $ D.Skip $ ParseChunksInit [] s
522522
D.Stop -> return D.Stop
523523

@@ -534,7 +534,7 @@ runArrayFoldManyD
534534
let next = ParseChunksInitLeftOver []
535535
return
536536
$ D.Skip
537-
$ ParseChunksYield (Left (ParseError err)) next
537+
$ ParseChunksYield (Left (ParseError (-1) err)) next
538538

539539
-- This is a simplified ParseChunksInit
540540
stepOuter _ (ParseChunksInitBuf src) = do
@@ -549,7 +549,7 @@ runArrayFoldManyD
549549
let next = ParseChunksInitLeftOver []
550550
return
551551
$ D.Skip
552-
$ ParseChunksYield (Left (ParseError err)) next
552+
$ ParseChunksYield (Left (ParseError (-1) err)) next
553553

554554
-- XXX we just discard any leftover input at the end
555555
stepOuter _ (ParseChunksInitLeftOver _) = return D.Stop
@@ -596,7 +596,7 @@ runArrayFoldManyD
596596
let next = ParseChunksInitLeftOver []
597597
return
598598
$ D.Skip
599-
$ ParseChunksYield (Left (ParseError err)) next
599+
$ ParseChunksYield (Left (ParseError (-1) err)) next
600600

601601
D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst
602602
D.Stop -> return $ D.Skip $ ParseChunksStop backBuf pst
@@ -638,7 +638,7 @@ runArrayFoldManyD
638638
let next = ParseChunksInitLeftOver []
639639
return
640640
$ D.Skip
641-
$ ParseChunksYield (Left (ParseError err)) next
641+
$ ParseChunksYield (Left (ParseError (-1) err)) next
642642

643643
-- This is a simplified ParseChunksBuf
644644
stepOuter _ (ParseChunksExtract [] buf pst) =
@@ -676,7 +676,7 @@ runArrayFoldManyD
676676
let next = ParseChunksInitLeftOver []
677677
return
678678
$ D.Skip
679-
$ ParseChunksYield (Left (ParseError err)) next
679+
$ ParseChunksYield (Left (ParseError (-1) err)) next
680680

681681

682682
-- This is a simplified ParseChunksExtract
@@ -706,7 +706,7 @@ runArrayFoldManyD
706706
let next = ParseChunksInitLeftOver []
707707
return
708708
$ D.Skip
709-
$ ParseChunksYield (Left (ParseError err)) next
709+
$ ParseChunksYield (Left (ParseError (-1) err)) next
710710

711711
stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next
712712

core/src/Streamly/Internal/Data/Parser/Type.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -455,11 +455,12 @@ data Fold m a b =
455455
--
456456
-- /Pre-release/
457457
--
458-
newtype ParseError = ParseError String
458+
data ParseError = ParseError Int String
459459
deriving (Eq, Show)
460460

461461
instance Exception ParseError where
462-
displayException (ParseError err) = err
462+
-- XXX Append the index in the error message here?
463+
displayException (ParseError _ err) = err
463464

464465
-- | Map a function on the result i.e. on @b@ in @Parser a m b@.
465466
instance Functor m => Functor (Parser a m) where

0 commit comments

Comments
 (0)