Skip to content

Fix stack safety of alt and bind #178

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Apr 3, 2022
Merged

Fix stack safety of alt and bind #178

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 8 additions & 12 deletions bench/Main.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -207,9 +207,8 @@ main = do
$ \_ -> runParser string23_1000 $ sepByRec anyChar (char '3')

log "<th><h2>sepBy 10000</h2></th>"
-- sepBy not stack-safe
-- htmlTableWrap "runParser sepBy 10000" $ benchWith 50
-- $ \_ -> runParser string23_10000 $ sepBy anyChar (char '3')
htmlTableWrap "runParser sepBy 10000" $ benchWith 50
$ \_ -> runParser string23_10000 $ sepBy anyChar (char '3')
htmlTableWrap "runParser sepByRec 10000" $ benchWith 50
$ \_ -> runParser string23_10000 $ sepByRec anyChar (char '3')

Expand All @@ -226,9 +225,8 @@ main = do
$ \_ -> runParser string23_1000 $ chainrRec anyChar (pure const) 'x'

log "<th><h2>chainr 10000</h2></th>"
-- chainr not stack-safe
-- htmlTableWrap "runParser chainr 10000" $ benchWith 5
-- $ \_ -> runParser string23_10000 $ chainr anyChar (pure const) 'x'
htmlTableWrap "runParser chainr 10000" $ benchWith 5
$ \_ -> runParser string23_10000 $ chainr anyChar (pure const) 'x'
htmlTableWrap "runParser chainrRec 10000" $ benchWith 5
$ \_ -> runParser string23_10000 $ chainrRec anyChar (pure const) 'x'

Expand All @@ -243,14 +241,12 @@ main = do
$ \_ -> runParser string23_1000x $ manyTillRec_ anyChar (char 'x')

log "<th><h2>manyTill 10000</h2></th>"
-- manyTill not stack-safe
-- htmlTableWrap "runParser manyTill 10000" $ benchWith 50
-- $ \_ -> runParser string23_10000x $ manyTill anyChar (char 'x')
htmlTableWrap "runParser manyTill 10000" $ benchWith 50
$ \_ -> runParser string23_10000x $ manyTill anyChar (char 'x')
htmlTableWrap "runParser manyTillRec 10000" $ benchWith 50
$ \_ -> runParser string23_10000x $ manyTillRec anyChar (char 'x')
-- manyTill_ not stack-safe
-- htmlTableWrap "runParser manyTill_ 10000" $ benchWith 50
-- $ \_ -> runParser string23_10000x $ manyTill_ anyChar (char 'x')
htmlTableWrap "runParser manyTill_ 10000" $ benchWith 50
$ \_ -> runParser string23_10000x $ manyTill_ anyChar (char 'x')
htmlTableWrap "runParser manyTillRec_ 10000" $ benchWith 50
$ \_ -> runParser string23_10000x $ manyTillRec_ anyChar (char 'x')

Expand Down
16 changes: 9 additions & 7 deletions src/Parsing.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -220,9 +220,10 @@ instance Bind (ParserT s m) where
( mkFn5 \state1 more lift throw done ->
more \_ ->
runFn5 k1 state1 more lift throw
( mkFn2 \state2 a -> do
let (ParserT k2) = next a
runFn5 k2 state2 more lift throw done
( mkFn2 \state2 a ->
more \_ -> do
let (ParserT k2) = next a
runFn5 k2 state2 more lift throw done
)
)

Expand Down Expand Up @@ -317,10 +318,11 @@ instance Alt (ParserT s m) where
more \_ ->
runFn5 k1 (ParseState input pos false) more lift
( mkFn2 \state2@(ParseState _ _ consumed) err ->
if consumed then
runFn2 throw state2 err
else
runFn5 k2 state1 more lift throw done
more \_ ->
if consumed then
runFn2 throw state2 err
else
runFn5 k2 state1 more lift throw done
)
done
)
Expand Down