[Haskell-cafe] Expression parsing problem
Ryan Ingram
ryani.spam at gmail.com
Tue May 19 04:41:16 EDT 2009
Why is Symbol = (String, Token)? A more sensible token type would
include values in the Value constructor and string identifiers in the
Identifier constructor; the strings in everything else seem redundant.
A more pure/monadic parser would have a type like this:
data Result a = Error String | OK [a]
newtype Parser a = Parser (ASL -> Result (ASL, a))
Try to write these functions:
return :: a -> Parser a
(>>=) :: Parser a -> (a -> Parser b) -> Parser b
Next write some simple state modification:
token :: Parser Token
(or, if you insist on your symbol type)
token :: Parser Symbol
expect :: Token -> Parser ()
Then build on these to write:
expression :: Parser Expression
term :: Parser Expression
factor :: Parser Expression
for some suitable type Expression
Good luck, sounds like a tough but interesting project!
-- ryan
On Mon, May 18, 2009 at 11:28 PM, leledumbo <leledumbo_cool at yahoo.co.id> wrote:
>
> 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.
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
More information about the Haskell-Cafe
mailing list