[Haskell-cafe] Expression parsing problem
leledumbo
leledumbo_cool at yahoo.co.id
Tue May 19 02:28:41 EDT 2009
I'm writing a paper as a replacement for writing exam and decided to write
a simple compiler (got a little experience with it). However, I got trouble
in parsing expression.
The grammar:
expression = "get" | [ "+" | "-" ] term { ( "+" | "-" ) term }
term = factor { ( "*" | "/" ) factor }
factor = IDENTIFIER | VALUE | "(" expression ")"
I can't make term parse, for instance "1 * 2 / 3" (the number is not
important,
identifier is also accepted). It stops after parsing 2, i.e. only the first
multiplication is parsed. Interchanging * and / gives the same result, only
differs in operation. Whichever got encountered first will be parsed.
The same problem also arises from expression, where it can't parse "1 + 2 -
3".
Both problems are identical, but I can't figure out what's wrong (don't
count
the optional +/- before term in expression, I haven't done it yet).
Sorry, but I'm lack of knowledge about Monad. I know it can be done better
with it,
but I need to learn a lot about it, while I don't have enough time (only 2
weeks).
Below are necessary definitions for the parser (some taken from the
scanner).
For testing purpose, please try:
expression
[("1",Value),("+",Plus),("2",Value),("-",Minus),("3",Value),("EOF",EOF)]
term
[("1",Value),("*",Times),("2",Value),("/",Slash),("3",Value),("EOF",EOF)]
expression
[("1",Value),("-",Minus),("2",Value),("+",Plus),("3",Value),("EOF",EOF)]
term
[("1",Value),("/",Slash),("2",Value),("*",Times),("3",Value),("EOF",EOF)]
> data Token = Identifier | OpenBlock | CloseBlock | SemiColon | Slash |
> Equals | OpenBrace | CloseBrace | Minus | Times |
> Plus | Nil | Value | Var | Const |
> Put | Get | Comma | EOF
> deriving (Show,Eq)
> type Symbol = (String,Token)
> type ASL = [Symbol]
> type ParseFunc = ASL -> (ASL,[String])
> expression :: ParseFunc
> expression (h:s)
> | snd h == Get = (s,["IN"])
> | op `elem` [Plus,Minus] = (s2,r1 ++ r2 ++ [operation op])
> | otherwise = (s1,r1)
> where (s1,r1) = term (h:s)
> (s2,r2) = term $ tail s1
> op = if s1 /= [] then snd $ head s1 else Nil
> expression s = (s,[])
> term :: ParseFunc
> term s = if op `elem` [Times,Slash]
> then (s2,r1 ++ r2 ++ [operation op])
> else (s1,r1)
> where (s1,r1) = factor s
> (s2,r2) = factor $ tail s1
> op = if s1 /= [] then snd $ head s1 else Nil
> factor :: ParseFunc
> factor ((id,Identifier):s) = (s,["LOAD " ++ id])
> factor ((val,Value):s) = (s,["PUSH " ++ val])
> factor (("(",OpenBrace):s) = if head s1 == (")",CloseBrace)
> then (tail s1,r1)
> else error $ "\")\" expected, got" ++ (show $ fst $ head s1)
> where (s1,r1) = expression s
> factor s = (s,[])
--
View this message in context: http://www.nabble.com/Expression-parsing-problem-tp23610457p23610457.html
Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
More information about the Haskell-Cafe
mailing list