composewell/streamly
1
1
Fork 0
mirror of https://github.com/composewell/streamly.git synced 2024-09-11 11:37:22 +03:00
Code Issues Packages Projects Releases Wiki Activity

Combine Yield and YieldB constructors

Browse Source 
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:
Harendra Kumar 2020-06-23 16:01:19 +05:30
parent 55d49bd50c
commit 60d322812b
6 changed files with 54 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bin/bench-exec-one.sh
View File

@ -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" ;;

7
src/Streamly/Internal/Data/Parser/ParserD.hs
View File

@ -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

30
src/Streamly/Internal/Data/Parser/ParserD/Tee.hs
View File

@ -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))

48
src/Streamly/Internal/Data/Parser/ParserD/Types.hs
View File

@ -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

45
src/Streamly/Internal/Data/Stream/StreamD.hs
View File

@ -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

23
src/Streamly/Internal/Data/Zipper.hs
View File

@ -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