Skip to content

Commit dffa256

Browse files
harendra-kumarharendra-kumar
committed
Move parseIterate to ParserDrivers module
1 parent 7f57f36 commit dffa256

File tree

3 files changed

+281
-262
lines changed

3 files changed

+281
-262
lines changed

‎core/src/Streamly/Internal/Data/ParserDrivers.h‎

Lines changed: 264 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
#define PARSE_BREAK_CHUNKS parseBreakChunks
44
#define PARSE_BREAK_CHUNKS_GENERIC parseBreakChunksGeneric
55
#define PARSE_MANY parseMany
6+
#define PARSE_ITERATE parseIterate
67
#define OPTIONAL(x)
78
#define DEFAULT(x) 0
89
#else
@@ -25,6 +26,19 @@
2526

2627
#undef PARSE_MANY
2728
#define PARSE_MANY parseManyPos
29+
30+
#define ConcatParseState ConcatParseStatePos
31+
#define ConcatParseInit ConcatParseInitPos
32+
#define ConcatParseInitBuf ConcatParseInitBufPos
33+
#define ConcatParseInitLeftOver ConcatParseInitLeftOverPos
34+
#define ConcatParseStop ConcatParseStopPos
35+
#define ConcatParseStream ConcatParseStreamPos
36+
#define ConcatParseBuf ConcatParseBufPos
37+
#define ConcatParseExtract ConcatParseExtractPos
38+
#define ConcatParseYield ConcatParseYieldPos
39+
40+
#undef PARSE_ITERATE
41+
#define PARSE_ITERATE parseIteratePos
2842
#undef OPTIONAL
2943
#define OPTIONAL(x) (x)
3044
#undef DEFAULT
@@ -273,6 +287,256 @@ PARSE_MANY (PRD.Parser pstep initial extract) (Stream step state) =
273287

274288
stepOuter _ (ParseChunksYield a next) = return $ Yield a next
275289

290+
{-# ANN type ConcatParseState Fuse #-}
291+
data ConcatParseState c b inpBuf st p m a =
292+
ConcatParseInit OPTIONAL(Int) inpBuf st p
293+
| ConcatParseInitBuf OPTIONAL(Int) inpBuf p
294+
| ConcatParseInitLeftOver OPTIONAL(Int) inpBuf
295+
| forall s. ConcatParseStop OPTIONAL(Int)
296+
inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
297+
| forall s. ConcatParseStream OPTIONAL(Int)
298+
st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
299+
| forall s. ConcatParseBuf OPTIONAL(Int)
300+
inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
301+
| forall s. ConcatParseExtract OPTIONAL(Int)
302+
inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
303+
| ConcatParseYield c (ConcatParseState c b inpBuf st p m a)
304+
305+
{-# INLINE_NORMAL PARSE_ITERATE #-}
306+
PARSE_ITERATE
307+
:: Monad m
308+
=> (b -> PRD.Parser a m b)
309+
-> b
310+
-> Stream m a
311+
-> Stream m (Either ParseError b)
312+
PARSE_ITERATE func seed (Stream step state) =
313+
Stream stepOuter (ConcatParseInit OPTIONAL(0) [] state (func seed))
314+
315+
where
316+
317+
{-# INLINE splitAt #-}
318+
splitAt = Stream.splitAt "Data.StreamK.parseIterate"
319+
320+
{-# INLINE_LATE stepOuter #-}
321+
-- Buffer is empty, go to stream processing loop
322+
stepOuter _ (ConcatParseInit OPTIONAL(i) [] st (PRD.Parser pstep initial extract)) = do
323+
res <- initial
324+
case res of
325+
PRD.IPartial ps ->
326+
return $ Skip $ ConcatParseStream OPTIONAL(i) st [] pstep ps extract
327+
PRD.IDone pb ->
328+
let next = ConcatParseInit OPTIONAL(i) [] st (func pb)
329+
in return $ Skip $ ConcatParseYield (Right pb) next
330+
PRD.IError err ->
331+
return
332+
$ Skip
333+
$ ConcatParseYield
334+
(Left (ParseError DEFAULT(i) err))
335+
(ConcatParseInitLeftOver OPTIONAL(i) [])
336+
337+
-- Buffer is not empty, go to buffered processing loop
338+
stepOuter _ (ConcatParseInit OPTIONAL(i) src st
339+
(PRD.Parser pstep initial extract)) = do
340+
res <- initial
341+
case res of
342+
PRD.IPartial ps ->
343+
return $ Skip $ ConcatParseBuf OPTIONAL(i) src st [] pstep ps extract
344+
PRD.IDone pb ->
345+
let next = ConcatParseInit OPTIONAL(i) src st (func pb)
346+
in return $ Skip $ ConcatParseYield (Right pb) next
347+
PRD.IError err ->
348+
return
349+
$ Skip
350+
$ ConcatParseYield
351+
(Left (ParseError DEFAULT(i) err))
352+
(ConcatParseInitLeftOver OPTIONAL(i) [])
353+
354+
-- This is simplified ConcatParseInit
355+
stepOuter _ (ConcatParseInitBuf OPTIONAL(i) src
356+
(PRD.Parser pstep initial extract)) = do
357+
res <- initial
358+
case res of
359+
PRD.IPartial ps ->
360+
return $ Skip $ ConcatParseExtract OPTIONAL(i) src [] pstep ps extract
361+
PRD.IDone pb ->
362+
let next = ConcatParseInitBuf OPTIONAL(i) src (func pb)
363+
in return $ Skip $ ConcatParseYield (Right pb) next
364+
PRD.IError err ->
365+
return
366+
$ Skip
367+
$ ConcatParseYield
368+
(Left (ParseError DEFAULT(i) err))
369+
(ConcatParseInitLeftOver OPTIONAL(i) [])
370+
371+
-- XXX we just discard any leftover input at the end
372+
stepOuter _ (ConcatParseInitLeftOver OPTIONAL(_) _) = return Stop
373+
374+
-- Buffer is empty process elements from the stream
375+
stepOuter gst (ConcatParseStream OPTIONAL(i) st buf pstep pst extract) = do
376+
r <- step (adaptState gst) st
377+
case r of
378+
Yield x s -> do
379+
pRes <- pstep pst x
380+
case pRes of
381+
PR.SPartial 1 pst1 ->
382+
return $ Skip
383+
$ ConcatParseStream OPTIONAL(i + 1) s [] pstep pst1 extract
384+
PR.SPartial m pst1 -> do
385+
let n = 1 - m
386+
assert (n <= length (x:buf)) (return ())
387+
let src0 = Prelude.take n (x:buf)
388+
src = Prelude.reverse src0
389+
return $ Skip
390+
$ ConcatParseBuf
391+
OPTIONAL(i + m) src s [] pstep pst1 extract
392+
-- PR.SContinue 1 pst1 ->
393+
-- return $ Skip $ ConcatParseStream s (x:buf) pst1
394+
PR.SContinue m pst1 -> do
395+
let n = 1 - m
396+
assert (n <= length (x:buf)) (return ())
397+
let (src0, buf1) = splitAt n (x:buf)
398+
src = Prelude.reverse src0
399+
return $ Skip
400+
$ ConcatParseBuf
401+
OPTIONAL(i + m) src s buf1 pstep pst1 extract
402+
-- XXX Specialize for Stop 0 common case?
403+
PR.SDone m b -> do
404+
let n = 1 - m
405+
assert (n <= length (x:buf)) (return ())
406+
let src = Prelude.reverse (Prelude.take n (x:buf))
407+
return $ Skip
408+
$ ConcatParseYield
409+
(Right b)
410+
(ConcatParseInit OPTIONAL(i + m) src s (func b))
411+
PR.Error err ->
412+
return
413+
$ Skip
414+
$ ConcatParseYield
415+
(Left (ParseError (DEFAULT(i) + 1) err))
416+
(ConcatParseInitLeftOver OPTIONAL(i + 1) [])
417+
Skip s ->
418+
return $ Skip $ ConcatParseStream OPTIONAL(i) s buf pstep pst extract
419+
Stop -> return $ Skip $ ConcatParseStop OPTIONAL(i) buf pstep pst extract
420+
421+
-- go back to stream processing mode
422+
stepOuter _ (ConcatParseBuf OPTIONAL(i) [] s buf pstep ps extract) =
423+
return $ Skip $ ConcatParseStream OPTIONAL(i) s buf pstep ps extract
424+
425+
-- buffered processing loop
426+
stepOuter _ (ConcatParseBuf OPTIONAL(i) (x:xs) s buf pstep pst extract) = do
427+
pRes <- pstep pst x
428+
case pRes of
429+
PR.SPartial 1 pst1 ->
430+
return $ Skip
431+
$ ConcatParseBuf OPTIONAL(i + 1) xs s [] pstep pst1 extract
432+
PR.SPartial m pst1 -> do
433+
let n = 1 - m
434+
assert (n <= length (x:buf)) (return ())
435+
let src0 = Prelude.take n (x:buf)
436+
src = Prelude.reverse src0 ++ xs
437+
return $ Skip
438+
$ ConcatParseBuf OPTIONAL(i + m) src s [] pstep pst1 extract
439+
-- PR.SContinue 1 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1
440+
PR.SContinue m pst1 -> do
441+
let n = 1 - m
442+
assert (n <= length (x:buf)) (return ())
443+
let (src0, buf1) = splitAt n (x:buf)
444+
src = Prelude.reverse src0 ++ xs
445+
return $ Skip
446+
$ ConcatParseBuf OPTIONAL(i + m) src s buf1 pstep pst1 extract
447+
-- XXX Specialize for Stop 0 common case?
448+
PR.SDone m b -> do
449+
let n = 1 - m
450+
assert (n <= length (x:buf)) (return ())
451+
let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
452+
return $ Skip
453+
$ ConcatParseYield
454+
(Right b) (ConcatParseInit OPTIONAL(i + m) src s (func b))
455+
PR.Error err ->
456+
return
457+
$ Skip
458+
$ ConcatParseYield
459+
(Left (ParseError (DEFAULT(i) + 1) err))
460+
(ConcatParseInitLeftOver OPTIONAL(i + 1) [])
461+
462+
-- This is simplified ConcatParseBuf
463+
stepOuter _ (ConcatParseExtract OPTIONAL(i) [] buf pstep pst extract) =
464+
return $ Skip $ ConcatParseStop OPTIONAL(i) buf pstep pst extract
465+
466+
stepOuter _ (ConcatParseExtract OPTIONAL(i) (x:xs) buf pstep pst extract) = do
467+
pRes <- pstep pst x
468+
case pRes of
469+
PR.SPartial 1 pst1 ->
470+
return $ Skip
471+
$ ConcatParseExtract OPTIONAL(i + 1) xs [] pstep pst1 extract
472+
PR.SPartial m pst1 -> do
473+
let n = 1 - m
474+
assert (n <= length (x:buf)) (return ())
475+
let src0 = Prelude.take n (x:buf)
476+
src = Prelude.reverse src0 ++ xs
477+
return $ Skip
478+
$ ConcatParseExtract OPTIONAL(i + m) src [] pstep pst1 extract
479+
PR.SContinue 1 pst1 ->
480+
return $ Skip
481+
$ ConcatParseExtract OPTIONAL(i + 1) xs (x:buf) pstep pst1 extract
482+
PR.SContinue m pst1 -> do
483+
let n = 1 - m
484+
assert (n <= length (x:buf)) (return ())
485+
let (src0, buf1) = splitAt n (x:buf)
486+
src = Prelude.reverse src0 ++ xs
487+
return $ Skip
488+
$ ConcatParseExtract OPTIONAL(i + m) src buf1 pstep pst1 extract
489+
PR.SDone 1 b ->
490+
return $ Skip
491+
$ ConcatParseYield
492+
(Right b) (ConcatParseInitBuf OPTIONAL(i + 1) xs (func b))
493+
PR.SDone m b -> do
494+
let n = 1 - m
495+
assert (n <= length (x:buf)) (return ())
496+
let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
497+
return $ Skip
498+
$ ConcatParseYield
499+
(Right b) (ConcatParseInitBuf OPTIONAL(i + m) src (func b))
500+
PR.Error err ->
501+
return
502+
$ Skip
503+
$ ConcatParseYield
504+
(Left (ParseError (DEFAULT(i) + 1) err))
505+
(ConcatParseInitLeftOver OPTIONAL(i + 1) [])
506+
507+
-- This is simplified ConcatParseExtract
508+
stepOuter _ (ConcatParseStop OPTIONAL(i) buf pstep pst extract) = do
509+
pRes <- extract pst
510+
case pRes of
511+
PR.SPartial _ _ -> error "Bug: parseIterate: Partial in extract"
512+
PR.SContinue 0 pst1 ->
513+
return $ Skip $ ConcatParseStop OPTIONAL(i) buf pstep pst1 extract
514+
PR.SContinue m pst1 -> do
515+
let n = (- m)
516+
assert (n <= length buf) (return ())
517+
let (src0, buf1) = splitAt n buf
518+
src = Prelude.reverse src0
519+
return $ Skip
520+
$ ConcatParseExtract OPTIONAL(i + m) src buf1 pstep pst1 extract
521+
PR.SDone 0 b -> do
522+
return $ Skip $
523+
ConcatParseYield (Right b) (ConcatParseInitLeftOver OPTIONAL(i) [])
524+
PR.SDone m b -> do
525+
let n = (- m)
526+
assert (n <= length buf) (return ())
527+
let src = Prelude.reverse (Prelude.take n buf)
528+
return $ Skip $
529+
ConcatParseYield
530+
(Right b) (ConcatParseInitBuf OPTIONAL(i + m) src (func b))
531+
PR.Error err ->
532+
return
533+
$ Skip
534+
$ ConcatParseYield
535+
(Left (ParseError DEFAULT(i) err))
536+
(ConcatParseInitLeftOver OPTIONAL(i) [])
537+
538+
stepOuter _ (ConcatParseYield a next) = return $ Yield a next
539+
276540
{-# INLINE PARSE_BREAK #-}
277541
PARSE_BREAK :: Monad m =>
278542
PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)

‎core/src/Streamly/Internal/Data/ParserDrivers.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,8 @@ module Streamly.Internal.Data.ParserDrivers
1818
, parseBreakChunksGenericPos
1919
, parseMany
2020
, parseManyPos
21+
, parseIterate
22+
, parseIteratePos
2123
)
2224
where
2325

0 commit comments

Comments
 (0)