Skip to content

Commit 18c6d1f

Browse files
adithyaovharendra-kumar
adithyaov
authored and
harendra-kumar
committed
Track the absolute position in the drivers of Parser
1 parent 0ddbd48 commit 18c6d1f

File tree

18 files changed

+348
-333
lines changed

18 files changed

+348
-333
lines changed

‎benchmark/Streamly/Benchmark/Data/Parser.hs‎

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

709709
instance NFData ParseError where
710710
{-# INLINE rnf #-}
711-
rnf (ParseError x) = rnf x
711+
rnf (ParseError i x) = rnf i `seq` rnf x
712712

713713
o_1_space_serial :: Int -> [Benchmark]
714714
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
@@ -374,7 +374,7 @@ moduleName = MODULE_NAME
374374

375375
instance NFData ParseError where
376376
{-# INLINE rnf #-}
377-
rnf (ParseError x) = rnf x
377+
rnf (ParseError i x) = rnf i `seq` rnf x
378378

379379
o_1_space_serial :: Int -> [Benchmark]
380380
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: 21 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1066,92 +1066,92 @@ parseBreak
10661066
-> m (Either ParseError b, StreamK m (Array a))
10671067
parseBreak parser input = do
10681068
let parserk = ParserK.runParser parser ParserK.parserDone 0 0
1069-
in go [] parserk input
1069+
in go 0 [] parserk input
10701070

10711071
where
10721072

10731073
{-# INLINE goStop #-}
1074-
goStop backBuf parserk = do
1074+
goStop absPos backBuf parserk = do
10751075
pRes <- parserk ParserK.None
10761076
case pRes of
10771077
-- If we stop in an alternative, it will try calling the next
10781078
-- parser, the next parser may call initial returning Partial and
10791079
-- then immediately we have to call extract on it.
10801080
ParserK.Partial 0 cont1 ->
1081-
go [] cont1 StreamK.nil
1081+
go absPos [] cont1 StreamK.nil
10821082
ParserK.Partial n cont1 -> do
10831083
let n1 = negate n
10841084
assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf))
10851085
let (s1, backBuf1) = backtrack n1 backBuf StreamK.nil
1086-
in go backBuf1 cont1 s1
1086+
in go (absPos + n) backBuf1 cont1 s1
10871087
ParserK.Continue 0 cont1 ->
1088-
go backBuf cont1 StreamK.nil
1088+
go absPos backBuf cont1 StreamK.nil
10891089
ParserK.Continue n cont1 -> do
10901090
let n1 = negate n
10911091
assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf))
10921092
let (s1, backBuf1) = backtrack n1 backBuf StreamK.nil
1093-
in go backBuf1 cont1 s1
1093+
in go (absPos + n) backBuf1 cont1 s1
10941094
ParserK.Done 0 b ->
10951095
return (Right b, StreamK.nil)
10961096
ParserK.Done n b -> do
10971097
let n1 = negate n
10981098
assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf))
10991099
let (s1, _) = backtrack n1 backBuf StreamK.nil
11001100
in return (Right b, s1)
1101-
ParserK.Error _ err -> do
1101+
ParserK.Error n err -> do
11021102
let s1 = Prelude.foldl (flip StreamK.cons) StreamK.nil backBuf
1103-
return (Left (ParseError err), s1)
1103+
return (Left (ParseError (absPos + n) err), s1)
11041104

11051105
seekErr n len =
11061106
error $ "parseBreak: Partial: forward seek not implemented n = "
11071107
++ show n ++ " len = " ++ show len
11081108

1109-
yieldk backBuf parserk arr stream = do
1109+
yieldk absPos backBuf parserk arr stream = do
11101110
pRes <- parserk (ParserK.Chunk arr)
11111111
let len = length arr
11121112
case pRes of
11131113
ParserK.Partial n cont1 ->
11141114
case compare n len of
1115-
EQ -> go [] cont1 stream
1115+
EQ -> go (absPos + n) [] cont1 stream
11161116
LT -> do
11171117
if n >= 0
1118-
then yieldk [] cont1 arr stream
1118+
then yieldk (absPos + n) [] cont1 arr stream
11191119
else do
11201120
let n1 = negate n
11211121
bufLen = sum (Prelude.map length backBuf)
11221122
s = StreamK.cons arr stream
11231123
assertM(n1 >= 0 && n1 <= bufLen)
11241124
let (s1, _) = backtrack n1 backBuf s
1125-
go [] cont1 s1
1125+
go (absPos + n) [] cont1 s1
11261126
GT -> seekErr n len
11271127
ParserK.Continue n cont1 ->
11281128
case compare n len of
1129-
EQ -> go (arr:backBuf) cont1 stream
1129+
EQ -> go (absPos + n) (arr:backBuf) cont1 stream
11301130
LT -> do
11311131
if n >= 0
1132-
then yieldk backBuf cont1 arr stream
1132+
then yieldk (absPos + n) backBuf cont1 arr stream
11331133
else do
11341134
let n1 = negate n
11351135
bufLen = sum (Prelude.map length backBuf)
11361136
s = StreamK.cons arr stream
11371137
assertM(n1 >= 0 && n1 <= bufLen)
11381138
let (s1, backBuf1) = backtrack n1 backBuf s
1139-
go backBuf1 cont1 s1
1139+
go (absPos + n) backBuf1 cont1 s1
11401140
GT -> seekErr n len
11411141
ParserK.Done n b -> do
11421142
let n1 = len - n
11431143
assertM(n1 <= sum (Prelude.map length (arr:backBuf)))
11441144
let (s1, _) = backtrack n1 (arr:backBuf) stream
11451145
in return (Right b, s1)
1146-
ParserK.Error _ err -> do
1146+
ParserK.Error n err -> do
11471147
let s1 = Prelude.foldl (flip StreamK.cons) stream (arr:backBuf)
1148-
return (Left (ParseError err), s1)
1148+
return (Left (ParseError (absPos + n + 1) err), s1)
11491149

1150-
go backBuf parserk stream = do
1151-
let stop = goStop backBuf parserk
1152-
single a = yieldk backBuf parserk a StreamK.nil
1150+
go absPos backBuf parserk stream = do
1151+
let stop = goStop absPos backBuf parserk
1152+
single a = yieldk absPos backBuf parserk a StreamK.nil
11531153
in StreamK.foldStream
1154-
defState (yieldk backBuf parserk) single stop stream
1154+
defState (yieldk absPos backBuf parserk) single stop stream
11551155

11561156
{-# INLINE parse #-}
11571157
parse :: (Monad m, Unbox a) =>

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

Lines changed: 27 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -428,110 +428,113 @@ parseBreak
428428
-> m (Either ParseError b, StreamK m (Array a))
429429
parseBreak parser input = do
430430
let parserk = ParserK.runParser parser ParserK.parserDone 0 0
431-
in go [] parserk input
431+
in go 0 [] parserk input
432432

433433
where
434434

435435
{-# INLINE goStop #-}
436436
goStop
437-
:: [Array a]
437+
:: Int
438+
-> [Array a]
438439
-> (ParserK.Input (Array a)
439440
-> m (ParserK.Step (Array a) m b))
440441
-> m (Either ParseError b, StreamK m (Array a))
441-
goStop backBuf parserk = do
442+
goStop absPos backBuf parserk = do
442443
pRes <- parserk ParserK.None
443444
case pRes of
444445
-- If we stop in an alternative, it will try calling the next
445446
-- parser, the next parser may call initial returning Partial and
446447
-- then immediately we have to call extract on it.
447448
ParserK.Partial 0 cont1 ->
448-
go [] cont1 StreamK.nil
449+
go absPos [] cont1 StreamK.nil
449450
ParserK.Partial n cont1 -> do
450451
let n1 = negate n
451452
assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf))
452453
let (s1, backBuf1) = backtrack n1 backBuf StreamK.nil
453-
in go backBuf1 cont1 s1
454+
in go (absPos + n) backBuf1 cont1 s1
454455
ParserK.Continue 0 cont1 ->
455-
go backBuf cont1 StreamK.nil
456+
go absPos backBuf cont1 StreamK.nil
456457
ParserK.Continue n cont1 -> do
457458
let n1 = negate n
458459
assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf))
459460
let (s1, backBuf1) = backtrack n1 backBuf StreamK.nil
460-
in go backBuf1 cont1 s1
461+
in go (absPos + n) backBuf1 cont1 s1
461462
ParserK.Done 0 b ->
462463
return (Right b, StreamK.nil)
463464
ParserK.Done n b -> do
464465
let n1 = negate n
465466
assertM(n1 >= 0 && n1 <= sum (Prelude.map length backBuf))
466467
let (s1, _) = backtrack n1 backBuf StreamK.nil
467468
in return (Right b, s1)
468-
ParserK.Error _ err ->
469+
ParserK.Error n err ->
469470
let strm = Prelude.foldl (flip StreamK.cons) StreamK.nil backBuf
470-
in return (Left (ParseError err), strm)
471+
in return (Left (ParseError (absPos + n) err), strm)
471472

472473
seekErr n len =
473474
error $ "parseBreak: Partial: forward seek not implemented n = "
474475
++ show n ++ " len = " ++ show len
475476

476477
yieldk
477-
:: [Array a]
478+
:: Int
479+
-> [Array a]
478480
-> (ParserK.Input (Array a)
479481
-> m (ParserK.Step (Array a) m b))
480482
-> Array a
481483
-> StreamK m (Array a)
482484
-> m (Either ParseError b, StreamK m (Array a))
483-
yieldk backBuf parserk arr stream = do
485+
yieldk absPos backBuf parserk arr stream = do
484486
pRes <- parserk (ParserK.Chunk arr)
485487
let len = length arr
486488
case pRes of
487489
ParserK.Partial n cont1 ->
488490
case compare n len of
489-
EQ -> go [] cont1 stream
491+
EQ -> go (absPos + n) [] cont1 stream
490492
LT -> do
491493
if n >= 0
492-
then yieldk [] cont1 arr stream
494+
then yieldk (absPos + n) [] cont1 arr stream
493495
else do
494496
let n1 = negate n
495497
bufLen = sum (Prelude.map length backBuf)
496498
s = StreamK.cons arr stream
497499
assertM(n1 >= 0 && n1 <= bufLen)
498500
let (s1, _) = backtrack n1 backBuf s
499-
go [] cont1 s1
501+
go (absPos + n) [] cont1 s1
500502
GT -> seekErr n len
501503
ParserK.Continue n cont1 ->
502504
case compare n len of
503-
EQ -> go (arr:backBuf) cont1 stream
505+
EQ -> go (absPos + n) (arr:backBuf) cont1 stream
504506
LT -> do
505507
if n >= 0
506-
then yieldk backBuf cont1 arr stream
508+
then yieldk (absPos + n) backBuf cont1 arr stream
507509
else do
508510
let n1 = negate n
509511
bufLen = sum (Prelude.map length backBuf)
510512
s = StreamK.cons arr stream
511513
assertM(n1 >= 0 && n1 <= bufLen)
512514
let (s1, backBuf1) = backtrack n1 backBuf s
513-
go backBuf1 cont1 s1
515+
go (absPos + n) backBuf1 cont1 s1
514516
GT -> seekErr n len
515517
ParserK.Done n b -> do
516518
let n1 = len - n
517519
assertM(n1 <= sum (Prelude.map length (arr:backBuf)))
518520
let (s1, _) = backtrack n1 (arr:backBuf) stream
519521
in return (Right b, s1)
520-
ParserK.Error _ err ->
522+
ParserK.Error n err ->
521523
let strm = Prelude.foldl (flip StreamK.cons) stream (arr:backBuf)
522-
in return (Left (ParseError err), strm)
524+
in return (Left (ParseError (absPos + n + 1) err), strm)
523525

524526
go
525-
:: [Array a]
527+
:: Int
528+
-> [Array a]
526529
-> (ParserK.Input (Array a)
527530
-> m (ParserK.Step (Array a) m b))
528531
-> StreamK m (Array a)
529532
-> m (Either ParseError b, StreamK m (Array a))
530-
go backBuf parserk stream = do
531-
let stop = goStop backBuf parserk
532-
single a = yieldk backBuf parserk a StreamK.nil
533+
go absPos backBuf parserk stream = do
534+
let stop = goStop absPos backBuf parserk
535+
single a = yieldk absPos backBuf parserk a StreamK.nil
533536
in StreamK.foldStream
534-
defState (yieldk backBuf parserk) single stop stream
537+
defState (yieldk absPos backBuf parserk) single stop stream
535538

536539
{-# INLINE parse #-}
537540
parse ::

‎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

0 commit comments

Comments
 (0)