Function Loop in string too long

Question

i have these functions:

item :: Parser Char
item  = Parser i
        where i []     = []
              i (x:xs) = [(x,xs)] 

many  :: Eq a=> Parser a -> Parser [a]
many p = many1 p +++ return []

many1  :: Eq a=> Parser a -> Parser [a]
many1 p = do v  <- p
             vs <- many p
             returns (v:vs)

Im getting strange results applying differents strings. If i execute:

parse (many item) "x:=0"

i get

[('x',0)]

while if i use another string longer like "if x=0 then x:=0 else x:=1" it looks like go in loop. Doing some attempts it seems that if the string is longer more than 19 chars the function doesnt end. It's strange because on other string long less 19 chars it works good. What it could be?

Other definitions:

newtype Parser a = Parser { parse :: String -> [(a, String)] }


instance Monad Parser where
    return t = Parser $ \s -> [(t, s)]
    m >>= k  = Parser $ \s -> [(x, y) | (u, v) <- parse m s, (x, y) <- parse (k u) v]

(+++) :: Eq a => Parser a -> Parser a -> Parser a
p +++ q = Parser $ \s -> if((parse p s)==[]) then parse q s else parse p s

Answer 1

Your implementation of (+++) doesn’t do what you think it does. In particular, it will only return successful parsed from one of its arguments, rather than from both. Here is how to do what you want:

(+++) :: Parser a -> Parser a -> Parser a
p +++ q = Parser $ \s -> parse p s ++ parse q s

Although this doesn’t remove duplicates so be warned that you can end up with an explosion of parses by doing eg many (many item).

Answer 2

Your code works fine, it's just that you've written your parser to have infinite backtracking and therefore O(2^n) runtime. Every character you add doubles the time it takes to complete:

$ time hugs foo.hs <<< 'parse (many item) "if x=0 then x:=0 els"'
[...]
Main> [("if x=0 then x:=0 els","")]
Main> [Leaving Hugs]

real    0m11.076s
user    0m10.578s
sys     0m0.016s

vs

$ time hugs foo.hs <<< 'parse (many item) "if x=0 then x:=0 else"'
[...]
Main> [("if x=0 then x:=0 else","")]
Main> [Leaving Hugs]

real    0m22.346s
user    0m22.048s
sys     0m0.036s