<div dir="ltr">This is going to do expr -> parseAdd -> expr -> parseAdd -> ... . You need to factor your parser to avoid this kind of left recursion.<div><br></div><div>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.</div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Wed, Sep 25, 2019 at 10:56 AM Henry Laxen <<a href="mailto:nadine.and.henry@pobox.com">nadine.and.henry@pobox.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex"><br>
Dear Haskell gurus,<br>
<br>
There has to be something very simple that I am misunderstanding here.  I have<br>
tried sticking in trace statement, using the ghci debugger, but it just makes<br>
no sense to me.  Please tell me what I am missing.<br>
<br>
Best wishes,<br>
Henry Laxen<br>
--------------------------------------------------------------------------------<br>
<br>
module S where<br>
<br>
import Text.ParserCombinators.ReadP<br>
import Data.Char<br>
<br>
data Exp = Num Int | Add Exp Exp<br>
  deriving (Eq, Show)<br>
<br>
expr :: ReadP Exp<br>
expr = do <br>
  e <-  (parseNumber +++ parseAdd)<br>
  return e<br>
<br>
parseAdd  :: ReadP Exp<br>
parseAdd = do <br>
  e1 <- expr<br>
  _ <-  char '+'<br>
  e2 <- expr<br>
  return (Add e1 e2)<br>
<br>
parseNumber  :: ReadP Exp<br>
parseNumber = do<br>
  ds <- (munch1 isDigit)<br>
  return . Num . read $ ds<br>
<br>
parse s = let parses = (readP_to_S expr) s in<br>
              case parses of<br>
                (p : _) -> fst (last parses)<br>
                _ -> error "parse error"<br>
main = do<br>
  print $ parse "1"<br>
<br>
λ> main<br>
*** Exception: stack overflow<br>
λ> parse "1+2"<br>
*** Exception: stack overflow<br>
<br>
--------------------------------------------------------------------------------<br>
<br>
-- <br>
Nadine and Henry Laxen   The rest is silence<br>
Villa Alta #6            <br>
Calle Gaviota #10        Never try to teach a pig to sing<br>
Chapala                  It wastes your time  <br>
+52 (376) 765-3181       And it annoys the pig<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div><br clear="all"><div><br></div>-- <br><div dir="ltr" class="gmail_signature"><div dir="ltr"><div><div dir="ltr"><div>brandon s allbery kf8nh</div><div><a href="mailto:allbery.b@gmail.com" target="_blank">allbery.b@gmail.com</a></div></div></div></div></div>