Stack overflow with ReadP

Dear Haskell gurus, There has to be something very simple that I am misunderstanding here. I have tried sticking in trace statement, using the ghci debugger, but it just makes no sense to me. Please tell me what I am missing. Best wishes, Henry Laxen -------------------------------------------------------------------------------- module S where import Text.ParserCombinators.ReadP import Data.Char data Exp = Num Int | Add Exp Exp deriving (Eq, Show) expr :: ReadP Exp expr = do e <- (parseNumber +++ parseAdd) return e parseAdd :: ReadP Exp parseAdd = do e1 <- expr _ <- char '+' e2 <- expr return (Add e1 e2) parseNumber :: ReadP Exp parseNumber = do ds <- (munch1 isDigit) return . Num . read $ ds parse s = let parses = (readP_to_S expr) s in case parses of (p : _) -> fst (last parses) _ -> error "parse error" main = do print $ parse "1" λ> main *** Exception: stack overflow λ> parse "1+2" *** Exception: stack overflow -------------------------------------------------------------------------------- -- Nadine and Henry Laxen The rest is silence Villa Alta #6 Calle Gaviota #10 Never try to teach a pig to sing Chapala It wastes your time +52 (376) 765-3181 And it annoys the pig

Your parseAdd parser is left recursive which causes infinite recursion. Maybe this wikipedia article can help: https://en.wikipedia.org/wiki/Left_recursion#Removing_left_recursion On 25-09-2019 16:56, Henry Laxen wrote:
Dear Haskell gurus,
There has to be something very simple that I am misunderstanding here. I have tried sticking in trace statement, using the ghci debugger, but it just makes no sense to me. Please tell me what I am missing.
Best wishes, Henry Laxen --------------------------------------------------------------------------------
module S where
import Text.ParserCombinators.ReadP import Data.Char
data Exp = Num Int | Add Exp Exp deriving (Eq, Show)
expr :: ReadP Exp expr = do e <- (parseNumber +++ parseAdd) return e
parseAdd :: ReadP Exp parseAdd = do e1 <- expr _ <- char '+' e2 <- expr return (Add e1 e2)
parseNumber :: ReadP Exp parseNumber = do ds <- (munch1 isDigit) return . Num . read $ ds
parse s = let parses = (readP_to_S expr) s in case parses of (p : _) -> fst (last parses) _ -> error "parse error" main = do print $ parse "1"
λ> main *** Exception: stack overflow λ> parse "1+2" *** Exception: stack overflow
--------------------------------------------------------------------------------

This is going to do expr -> parseAdd -> expr -> parseAdd -> ... . You need
to factor your parser to avoid this kind of left recursion.
And (+++) is going to try both parsers even though the left-hand one
succeeds, because it's symmetric. You may want to use (<++) to make it take
the left-hand parser when it succeeds without trying the right-hand.
On Wed, Sep 25, 2019 at 10:56 AM Henry Laxen
Dear Haskell gurus,
There has to be something very simple that I am misunderstanding here. I have tried sticking in trace statement, using the ghci debugger, but it just makes no sense to me. Please tell me what I am missing.
Best wishes, Henry Laxen
--------------------------------------------------------------------------------
module S where
import Text.ParserCombinators.ReadP import Data.Char
data Exp = Num Int | Add Exp Exp deriving (Eq, Show)
expr :: ReadP Exp expr = do e <- (parseNumber +++ parseAdd) return e
parseAdd :: ReadP Exp parseAdd = do e1 <- expr _ <- char '+' e2 <- expr return (Add e1 e2)
parseNumber :: ReadP Exp parseNumber = do ds <- (munch1 isDigit) return . Num . read $ ds
parse s = let parses = (readP_to_S expr) s in case parses of (p : _) -> fst (last parses) _ -> error "parse error" main = do print $ parse "1"
λ> main *** Exception: stack overflow λ> parse "1+2" *** Exception: stack overflow
--------------------------------------------------------------------------------
-- Nadine and Henry Laxen The rest is silence Villa Alta #6 Calle Gaviota #10 Never try to teach a pig to sing Chapala It wastes your time +52 (376) 765-3181 And it annoys the pig _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
-- brandon s allbery kf8nh allbery.b@gmail.com

You have "unguarded" recursion between expr and parseAdd. When you try to
parse an expression, one option is to parse an addition. When you go to do
that, you look to parse an expression followed by other stuff. Thanks to
the structure of ReadP, I *believe* this will actually work ... if you just
take the first result. But if you keep going, you will definitely find
yourself stuck.
On Wed, Sep 25, 2019, 10:56 AM Henry Laxen
Dear Haskell gurus,
There has to be something very simple that I am misunderstanding here. I have tried sticking in trace statement, using the ghci debugger, but it just makes no sense to me. Please tell me what I am missing.
Best wishes, Henry Laxen
--------------------------------------------------------------------------------
module S where
import Text.ParserCombinators.ReadP import Data.Char
data Exp = Num Int | Add Exp Exp deriving (Eq, Show)
expr :: ReadP Exp expr = do e <- (parseNumber +++ parseAdd) return e
parseAdd :: ReadP Exp parseAdd = do e1 <- expr _ <- char '+' e2 <- expr return (Add e1 e2)
parseNumber :: ReadP Exp parseNumber = do ds <- (munch1 isDigit) return . Num . read $ ds
parse s = let parses = (readP_to_S expr) s in case parses of (p : _) -> fst (last parses) _ -> error "parse error" main = do print $ parse "1"
λ> main *** Exception: stack overflow λ> parse "1+2" *** Exception: stack overflow
--------------------------------------------------------------------------------
-- Nadine and Henry Laxen The rest is silence Villa Alta #6 Calle Gaviota #10 Never try to teach a pig to sing Chapala It wastes your time +52 (376) 765-3181 And it annoys the pig _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

Dear Nadine, apparently you are new to parser combinators. I am attaching some code I have used in the past for our first year students as part of our lecture notes on FP. They use the applicatiev style, which I think is to be preferred. I hope you find them instructive. We build a pocket calculator in a numer of steps. In daily life I use my uu-parsinglib, since it comes with fewer surprises for beginning users. If you have any questions do not hesitate to ask me. Succes, Doaitse Swierstra
On 25 Sep 2019, at 16:56, Henry Laxen
wrote: Dear Haskell gurus,
There has to be something very simple that I am misunderstanding here. I have tried sticking in trace statement, using the ghci debugger, but it just makes no sense to me. Please tell me what I am missing.
Best wishes, Henry Laxen --------------------------------------------------------------------------------
module S where
import Text.ParserCombinators.ReadP import Data.Char
data Exp = Num Int | Add Exp Exp deriving (Eq, Show)
expr :: ReadP Exp expr = do e <- (parseNumber +++ parseAdd) return e
parseAdd :: ReadP Exp parseAdd = do e1 <- expr _ <- char '+' e2 <- expr return (Add e1 e2)
parseNumber :: ReadP Exp parseNumber = do ds <- (munch1 isDigit) return . Num . read $ ds
parse s = let parses = (readP_to_S expr) s in case parses of (p : _) -> fst (last parses) _ -> error "parse error" main = do print $ parse "1"
λ> main *** Exception: stack overflow λ> parse "1+2" *** Exception: stack overflow
--------------------------------------------------------------------------------
-- Nadine and Henry Laxen The rest is silence Villa Alta #6 Calle Gaviota #10 Never try to teach a pig to sing Chapala It wastes your time +52 (376) 765-3181 And it annoys the pig _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
participants (5)
-
Brandon Allbery
-
David Feuer
-
Doaitse Swierstra
-
Henry Laxen
-
Jaro Reinders