mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
Combine Yield and YieldB constructors
Yield 0: now means a partial result is available Yield n: means a partial result is available, and we need to backtrack by n elements.
This commit is contained in:
parent
55d49bd50c
commit
60d322812b
@ -64,8 +64,8 @@ bench_rts_opts_specific () {
|
||||
Prelude.WAsync/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
|
||||
|
||||
# XXX need to investigate these, taking too much stack
|
||||
Data.Parser.ParserD/o-1-space/some) echo -n "-K1M" ;;
|
||||
Data.Parser/o-1-space/some) echo -n "-K1M" ;;
|
||||
Data.Parser.ParserD/o-1-space/some) echo -n "-K8M" ;;
|
||||
Data.Parser/o-1-space/some) echo -n "-K8M" ;;
|
||||
Data.Parser.ParserD/o-1-space/manyTill) echo -n "-K4M" ;;
|
||||
Data.Parser/o-1-space/manyTill) echo -n "-K4M" ;;
|
||||
|
||||
|
@ -588,8 +588,7 @@ lookAhead (Parser step1 initial1 _) =
|
||||
r <- step1 st a
|
||||
let cnt1 = cnt + 1
|
||||
return $ case r of
|
||||
Yield _ s -> Skip 0 (Tuple' cnt1 s)
|
||||
YieldB n s -> Skip n (Tuple' (cnt1 - n) s)
|
||||
Yield n s -> Skip n (Tuple' (cnt1 - n) s)
|
||||
Skip n s -> Skip n (Tuple' (cnt1 - n) s)
|
||||
Stop _ b -> Stop cnt1 b
|
||||
Error err -> Error err
|
||||
@ -713,7 +712,6 @@ manyTill (Fold fstep finitial fextract)
|
||||
r <- stepR st a
|
||||
case r of
|
||||
Yield n s -> return $ Yield n (ManyTillR 0 fs s)
|
||||
YieldB n s -> return $ YieldB n (ManyTillR 0 fs s)
|
||||
Skip n s -> do
|
||||
assert (cnt + 1 - n >= 0) (return ())
|
||||
return $ Skip n (ManyTillR (cnt + 1 - n) fs s)
|
||||
@ -728,12 +726,11 @@ manyTill (Fold fstep finitial fextract)
|
||||
r <- stepL st a
|
||||
case r of
|
||||
Yield n s -> return $ Yield n (ManyTillL fs s)
|
||||
YieldB n s -> return $ YieldB n (ManyTillL fs s)
|
||||
Skip n s -> return $ Skip n (ManyTillL fs s)
|
||||
Stop n b -> do
|
||||
fs1 <- fstep fs b
|
||||
l <- initialR
|
||||
return $ YieldB n (ManyTillR 0 fs1 l)
|
||||
return $ Yield n (ManyTillR 0 fs1 l)
|
||||
Error err -> return $ Error err
|
||||
|
||||
extract (ManyTillL fs sR) = extractL sR >>= fstep fs >>= fextract
|
||||
|
@ -137,10 +137,10 @@ teeWith zf (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
|
||||
useStream buf inp1 inp2 stp st y = do
|
||||
(buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y
|
||||
case r of
|
||||
Yield 0 s ->
|
||||
let state = ([], StepState s, inp11, inp21)
|
||||
in return (state, Yld 0)
|
||||
Yield n s ->
|
||||
let state = (Prelude.take n buf1, StepState s, inp11, inp21)
|
||||
in assert (n <= length buf1) (return (state, Yld n))
|
||||
YieldB n s ->
|
||||
let src0 = Prelude.take n buf1
|
||||
src = Prelude.reverse src0
|
||||
state = ([], StepState s, src ++ inp11, inp21)
|
||||
@ -261,10 +261,10 @@ teeWithFst zf (Parser stepL initialL extractL)
|
||||
useStream buf inp1 inp2 stp st y = do
|
||||
(buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y
|
||||
case r of
|
||||
Yield n s ->
|
||||
let state = (Prelude.take n buf1, StepState s, inp11, inp21)
|
||||
in assert (n <= length buf1) (return (state, Yld n))
|
||||
YieldB _ _ -> undefined
|
||||
Yield 0 s ->
|
||||
let state = ([], StepState s, inp11, inp21)
|
||||
in return (state, Yld 0)
|
||||
Yield n _ -> return (undefined, Yld n) -- Not implemented
|
||||
Stop n b ->
|
||||
let state = (Prelude.take n buf1, StepResult b, inp11, inp21)
|
||||
in assert (n <= length buf1) (return (state, Stp n))
|
||||
@ -383,10 +383,10 @@ shortest (Parser stepL initialL extractL) (Parser stepR initialR _) =
|
||||
useStream buf inp1 inp2 stp st y = do
|
||||
(buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y
|
||||
case r of
|
||||
Yield n s ->
|
||||
let state = (Prelude.take n buf1, StepState s, inp11, inp21)
|
||||
in assert (n <= length buf1) (return (state, Yld n))
|
||||
YieldB _ _ -> undefined
|
||||
Yield 0 s ->
|
||||
let state = ([], StepState s, inp11, inp21)
|
||||
in return (state, Yld 0)
|
||||
Yield n _ -> return (undefined, Yld n) -- Not implemented
|
||||
Stop n b ->
|
||||
let state = (Prelude.take n buf1, StepResult b, inp11, inp21)
|
||||
in assert (n <= length buf1) (return (state, Stp n))
|
||||
@ -460,10 +460,10 @@ longest (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
|
||||
useStream buf inp1 inp2 stp st y = do
|
||||
(buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y
|
||||
case r of
|
||||
Yield n s ->
|
||||
let state = (Prelude.take n buf1, StepState s, inp11, inp21)
|
||||
in assert (n <= length buf1) (return (state, Yld n))
|
||||
YieldB _ _ -> undefined
|
||||
Yield 0 s ->
|
||||
let state = ([], StepState s, inp11, inp21)
|
||||
in return (state, Yld 0)
|
||||
Yield n _ -> return (undefined, Yld n) -- Not implemented
|
||||
Stop n b ->
|
||||
let state = (Prelude.take n buf1, StepResult b, inp11, inp21)
|
||||
in assert (n <= length buf1) (return (state, Stp n))
|
||||
|
@ -161,20 +161,13 @@ import Streamly.Internal.Data.Strict (Tuple3'(..))
|
||||
--
|
||||
{-# ANN type Step Fuse #-}
|
||||
data Step s b =
|
||||
Yield Int s
|
||||
-- ^ Trim the backtracking buffer keeping only most recent @n@ items.
|
||||
Yield Int s
|
||||
-- ^ Go back by @n@ items in the input buffer and drop the rest.
|
||||
-- @Yield n state@ indicates that the parser has yielded a new result
|
||||
-- which is a point of no return. The result can be extracted using
|
||||
-- @extract@. The driver drops the buffer except @n@ most recent
|
||||
-- elements. The rule is that if a parser has yielded at least once it
|
||||
-- cannot return a failure result.
|
||||
|
||||
| YieldB Int s
|
||||
-- ^ Go back by @n@ items in the input buffer and drop the rest.
|
||||
-- @YieldB n state@ indicates that the parser has yielded a new result
|
||||
-- which is a point of no return. The result can be extracted using
|
||||
-- @extract@. The driver moves back the current position of the cursor by
|
||||
-- @n@ elements and drops any buffer before that.
|
||||
-- @n@ elements and drops any buffer before that. The rule is that if a
|
||||
-- parser has yielded at least once it cannot return a failure result.
|
||||
|
||||
-- only rewind
|
||||
| Skip Int s
|
||||
@ -202,7 +195,6 @@ data Step s b =
|
||||
instance Functor (Step s) where
|
||||
{-# INLINE fmap #-}
|
||||
fmap _ (Yield n s) = Yield n s
|
||||
fmap _ (YieldB n s) = YieldB n s
|
||||
fmap _ (Skip n s) = Skip n s
|
||||
fmap f (Stop n b) = Stop n (f b)
|
||||
fmap _ (Error err) = Error err
|
||||
@ -303,8 +295,7 @@ splitWith func (Parser stepL initialL extractL)
|
||||
-- e.g. in ((,) <$> p1 <*> p2) <|> p3, if p2 fails we have to
|
||||
-- backtrack and start running p3. So we need to keep the input
|
||||
-- buffered until we know that the applicative cannot fail.
|
||||
Yield _ s -> return $ Skip 0 (SeqParseL s)
|
||||
YieldB n s -> return $ Skip n (SeqParseL s)
|
||||
Yield n s -> return $ Skip n (SeqParseL s)
|
||||
Skip n s -> return $ Skip n (SeqParseL s)
|
||||
Stop n b -> Skip n <$> (SeqParseR (func b) <$> initialR)
|
||||
Error err -> return $ Error err
|
||||
@ -313,7 +304,6 @@ splitWith func (Parser stepL initialL extractL)
|
||||
r <- stepR st a
|
||||
return $ case r of
|
||||
Yield n s -> Yield n (SeqParseR f s)
|
||||
YieldB n s -> YieldB n (SeqParseR f s)
|
||||
Skip n s -> Skip n (SeqParseR f s)
|
||||
Stop n b -> Stop n (f b)
|
||||
Error err -> Error err
|
||||
@ -348,8 +338,7 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
|
||||
(\r i -> case r of
|
||||
-- Note: this leads to buffering even if we are not in an
|
||||
-- Alternative composition.
|
||||
Yield _ s -> Skip 0 (SeqAL s)
|
||||
YieldB n s -> Skip n (SeqAL s)
|
||||
Yield n s -> Skip n (SeqAL s)
|
||||
Skip n s -> Skip n (SeqAL s)
|
||||
Stop n _ -> Skip n (SeqAR i)
|
||||
-- XXX should we sequence initialR monadically?
|
||||
@ -358,7 +347,6 @@ split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
|
||||
step (SeqAR st) a = do
|
||||
(\r -> case r of
|
||||
Yield n s -> Yield n (SeqAR s)
|
||||
YieldB n s -> YieldB n (SeqAR s)
|
||||
Skip n s -> Skip n (SeqAR s)
|
||||
Stop n b -> Stop n b
|
||||
Error err -> Error err) <$> stepR st a
|
||||
@ -413,7 +401,6 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
|
||||
r <- stepL st a
|
||||
case r of
|
||||
Yield n s -> return $ Yield n (AltParseL 0 s)
|
||||
YieldB n s -> return $ YieldB n (AltParseL 0 s)
|
||||
Skip n s -> do
|
||||
assert (cnt + 1 - n >= 0) (return ())
|
||||
return $ Skip n (AltParseL (cnt + 1 - n) s)
|
||||
@ -426,7 +413,6 @@ alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =
|
||||
r <- stepR st a
|
||||
return $ case r of
|
||||
Yield n s -> Yield n (AltParseR s)
|
||||
YieldB n s -> YieldB n (AltParseR s)
|
||||
Skip n s -> Skip n (AltParseR s)
|
||||
Stop n b -> Stop n b
|
||||
Error err -> Error err
|
||||
@ -455,8 +441,7 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
|
||||
r <- step1 st a
|
||||
let cnt1 = cnt + 1
|
||||
case r of
|
||||
Yield _ s -> return $ Skip 0 (Tuple3' s cnt1 fs)
|
||||
YieldB n s -> do
|
||||
Yield n s -> do
|
||||
assert (cnt1 - n >= 0) (return ())
|
||||
return $ Skip n (Tuple3' s (cnt1 - n) fs)
|
||||
Skip n s -> do
|
||||
@ -465,7 +450,7 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
|
||||
Stop n b -> do
|
||||
s <- initial1
|
||||
fs1 <- fstep fs b
|
||||
return $ YieldB n (Tuple3' s 0 fs1)
|
||||
return $ Yield n (Tuple3' s 0 fs1)
|
||||
Error _ -> do
|
||||
xs <- fextract fs
|
||||
return $ Stop cnt1 xs
|
||||
@ -497,29 +482,27 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =
|
||||
step (Tuple3' st _ (Left fs)) a = do
|
||||
r <- step1 st a
|
||||
case r of
|
||||
Yield _ s -> return $ Skip 0 (Tuple3' s undefined (Left fs))
|
||||
YieldB n s -> return $ Skip n (Tuple3' s undefined (Left fs))
|
||||
Yield n s -> return $ Skip n (Tuple3' s undefined (Left fs))
|
||||
Skip n s -> return $ Skip n (Tuple3' s undefined (Left fs))
|
||||
Stop n b -> do
|
||||
s <- initial1
|
||||
fs1 <- fstep fs b
|
||||
return $ YieldB n (Tuple3' s 0 (Right fs1))
|
||||
return $ Yield n (Tuple3' s 0 (Right fs1))
|
||||
Error err -> return $ Error err
|
||||
step (Tuple3' st cnt (Right fs)) a = do
|
||||
r <- step1 st a
|
||||
let cnt1 = cnt + 1
|
||||
case r of
|
||||
Yield _ s -> return $ Yield 0 (Tuple3' s cnt1 (Right fs))
|
||||
YieldB n s -> do
|
||||
Yield n s -> do
|
||||
assert (cnt1 - n >= 0) (return ())
|
||||
return $ YieldB n (Tuple3' s (cnt1 - n) (Right fs))
|
||||
return $ Yield n (Tuple3' s (cnt1 - n) (Right fs))
|
||||
Skip n s -> do
|
||||
assert (cnt1 - n >= 0) (return ())
|
||||
return $ Skip n (Tuple3' s (cnt1 - n) (Right fs))
|
||||
Stop n b -> do
|
||||
s <- initial1
|
||||
fs1 <- fstep fs b
|
||||
return $ YieldB n (Tuple3' s 0 (Right fs1))
|
||||
return $ Yield n (Tuple3' s 0 (Right fs1))
|
||||
Error _ -> Stop cnt1 <$> fextract fs
|
||||
|
||||
-- XXX The "try" may impact performance if this parser is used as a scan
|
||||
@ -598,8 +581,7 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract
|
||||
step (ConcatParseL st) a = do
|
||||
r <- stepL st a
|
||||
return $ case r of
|
||||
Yield _ s -> Skip 0 (ConcatParseL s)
|
||||
YieldB n s -> Skip n (ConcatParseL s)
|
||||
Yield n s -> Skip n (ConcatParseL s)
|
||||
Skip n s -> Skip n (ConcatParseL s)
|
||||
Stop n b -> Skip n (ConcatParseR (func b))
|
||||
Error err -> Error err
|
||||
@ -610,8 +592,6 @@ concatMap func (Parser stepL initialL extractL) = Parser step initial extract
|
||||
return $ case r of
|
||||
Yield n s ->
|
||||
Yield n (ConcatParseR (Parser stepR (return s) extractR))
|
||||
YieldB n s ->
|
||||
YieldB n (ConcatParseR (Parser stepR (return s) extractR))
|
||||
Skip n s ->
|
||||
Skip n (ConcatParseR (Parser stepR (return s) extractR))
|
||||
Stop n b -> Stop n b
|
||||
|
@ -998,11 +998,8 @@ parselMx' pstep initial extract (Stream step state) = do
|
||||
Yield x s -> do
|
||||
pRes <- pstep pst x
|
||||
case pRes of
|
||||
-- PR.Yield 0 pst1 -> go SPEC s [] pst1
|
||||
PR.Yield 0 pst1 -> go SPEC s [] pst1
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
go SPEC s (Prelude.take n (x:buf)) pst1
|
||||
PR.YieldB n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0
|
||||
@ -1022,11 +1019,9 @@ parselMx' pstep initial extract (Stream step state) = do
|
||||
gobuf !_ s buf (x:xs) !pst = do
|
||||
pRes <- pstep pst x
|
||||
case pRes of
|
||||
-- PR.Yield 0 pst1 -> go SPEC s [] pst1
|
||||
PR.Yield 0 pst1 ->
|
||||
gobuf SPEC s [] xs pst1
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
gobuf SPEC s (Prelude.take n (x:buf)) xs pst1
|
||||
PR.YieldB n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0 ++ xs
|
||||
@ -1082,12 +1077,9 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) =
|
||||
Yield x s -> do
|
||||
pRes <- pstep pst x
|
||||
case pRes of
|
||||
-- PR.Yield 0 pst1 -> go SPEC s [] pst1
|
||||
PR.Yield 0 pst1 ->
|
||||
return $ Skip $ ParseChunksStream s [] pst1
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let buf1 = Prelude.take n (x:buf)
|
||||
return $ Skip $ ParseChunksStream s buf1 pst1
|
||||
PR.YieldB n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0
|
||||
@ -1121,12 +1113,9 @@ parseMany (PRD.Parser pstep initial extract) (Stream step state) =
|
||||
stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do
|
||||
pRes <- pstep pst x
|
||||
case pRes of
|
||||
-- PR.Yield 0 pst1 ->
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let buf1 = Prelude.take n (x:buf)
|
||||
return $ Skip $ ParseChunksBuf xs s buf1 pst1
|
||||
PR.YieldB n pst1 -> do
|
||||
PR.Yield 0 pst1 ->
|
||||
return $ Skip $ ParseChunksBuf xs s [] pst1
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0 ++ xs
|
||||
@ -1190,13 +1179,10 @@ parseIterate func seed (Stream step state) =
|
||||
pst <- initial
|
||||
pRes <- pstep pst x
|
||||
case pRes of
|
||||
-- PR.Yield 0 pst1 -> go SPEC s [] pst1
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let buf1 = Prelude.take n (x:buf)
|
||||
return $ Skip $ ConcatParseStream s buf1
|
||||
PR.Yield 0 pst1 ->
|
||||
return $ Skip $ ConcatParseStream s []
|
||||
(PRD.Parser pstep (return pst1) extract)
|
||||
PR.YieldB n pst1 -> do
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0
|
||||
@ -1235,13 +1221,10 @@ parseIterate func seed (Stream step state) =
|
||||
pst <- initial
|
||||
pRes <- pstep pst x
|
||||
case pRes of
|
||||
-- PR.Yield 0 pst1 ->
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let buf1 = Prelude.take n (x:buf)
|
||||
return $ Skip $ ConcatParseBuf xs s buf1
|
||||
PR.Yield 0 pst1 ->
|
||||
return $ Skip $ ConcatParseBuf xs s []
|
||||
(PRD.Parser pstep (return pst1) extract)
|
||||
PR.YieldB n pst1 -> do
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0 ++ xs
|
||||
|
@ -221,11 +221,8 @@ parse pstep initial extract (Zipper [] ls rs stream) =
|
||||
yieldk x r = do
|
||||
acc1 <- acc >>= \b -> pstep b x
|
||||
case acc1 of
|
||||
-- PR.Yield 0 pst1 -> go SPEC s [] pst1
|
||||
PR.Yield 0 pst1 -> go r [] (return pst1)
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
go r (Prelude.take n (x:buf)) (return pst1)
|
||||
PR.YieldB n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0
|
||||
@ -250,11 +247,9 @@ parse pstep initial extract (Zipper [] ls rs stream) =
|
||||
r <- pst
|
||||
pRes <- pstep r x
|
||||
case pRes of
|
||||
-- PR.Yield 0 pst1 -> go SPEC s [] pst1
|
||||
PR.Yield 0 pst1 ->
|
||||
gobuf s [] xs (return pst1)
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
gobuf s (Prelude.take n (x:buf)) xs (return pst1)
|
||||
PR.YieldB n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0
|
||||
@ -296,11 +291,9 @@ parse pstep initial extract (Zipper (cp:cps) ls rs stream) =
|
||||
acc1 <- acc >>= \b -> pstep b x
|
||||
let cnt1 = cnt + 1
|
||||
case acc1 of
|
||||
-- PR.Yield 0 pst1 -> go SPEC s [] pst1
|
||||
PR.Yield 0 pst1 ->
|
||||
go cnt1 r [] (return pst1)
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
go cnt1 r (x:buf) (return pst1)
|
||||
PR.YieldB n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0
|
||||
@ -332,11 +325,9 @@ parse pstep initial extract (Zipper (cp:cps) ls rs stream) =
|
||||
pRes <- pstep r x
|
||||
let cnt1 = cnt + 1
|
||||
case pRes of
|
||||
-- PR.Yield 0 pst1 -> go SPEC s [] pst1
|
||||
PR.Yield 0 pst1 ->
|
||||
gobuf cnt1 s [] xs (return pst1)
|
||||
PR.Yield n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
gobuf cnt1 s (x:buf) xs (return pst1)
|
||||
PR.YieldB n pst1 -> do
|
||||
assert (n <= length (x:buf)) (return ())
|
||||
let src0 = Prelude.take n (x:buf)
|
||||
src = Prelude.reverse src0
|
||||
|
Loading…
Reference in New Issue
Block a user