module Decaf.Parser where

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import qualified Text.ParserCombinators.Parsec.Token as T
import Text.ParserCombinators.Parsec.Language

type DecafParser = Parser ()

decafDef :: T.LanguageDef ()
decafDef = emptyDef
           { commentLine     = "//"
           , reservedNames   = ["boolean", "break", "callout",
                                "class", "continue", "else",
                                "false", "for", "if",
                                "int", "return", "true", "void"]
           }

decafParser :: T.TokenParser ()
decafParser = T.makeTokenParser decafDef

program :: DecafParser
program = do reserved "class"
             reserved "Program"
             braces $ do fields <- many $ try fieldDecl
                         methods <- many methodDecl
                         return ()
             lexeme $ eof
             return ()

fieldDecl :: DecafParser
fieldDecl = do typ <- decafType
               commaSep1 (do name <- identifier
                             optional $ do reservedOp "["
                                           integer
                                           reservedOp "]"
                                           return ())
               semi
               return ()

decafType :: DecafParser
decafType = do reserved "int" <|> reserved "boolean"
               return ()

methodDecl :: DecafParser
methodDecl = do spaces
                typ <- (decafType <|> (reserved "void" >> return ()))
                name <- identifier
                args <- parens $ commaSep $ do typ <- decafType
                                               name <- identifier
                                               return ()
                body <- block
                return ()

block :: DecafParser
block = braces block'

block' :: DecafParser
block' = do locals <- many (try varDecl <?> "variable declaration")
            body   <- many statement
            return ()

varDecl :: DecafParser
varDecl = do typ <- decafType
             commaSep identifier
             semi
             return ()

statement :: DecafParser
statement = do (    (try assignment)
                <|> (try call_expr)
                <|> if_stmt
                <|> for_stmt
                <|> (reserved "return" >> semi >> return () )
                <|> (reserved "break" >> semi >> return () )
                <|> (reserved "continue" >> semi >> return () )) <?> "statement"
               return ()

assignment :: DecafParser
assignment = do lhs <- location
                (try $ reservedOp "=") <|> (reservedOp "+=")
                rhs <- expression
                return ()

call_expr :: DecafParser
call_expr = do (try method_call) <|> callout_expr
               return ()

method_call :: DecafParser
method_call = do method <- identifier
                 parens $ commaSep $ expression
                 return ()

callout_expr :: DecafParser
callout_expr = do reserved "callout"
                  parens $ commaSep $ (expression <|> (stringLiteral >> return ()))
                  return ()

if_stmt :: DecafParser
if_stmt = do reserved "if"
             parens expression
             block
             optional $ reserved "else" >> block
             return ()

for_stmt :: DecafParser
for_stmt = do reserved "for"
              var <- identifier
              reservedOp "="
              start <- expression
              reservedOp ","
              end <- expression
              block
              return ()

location :: DecafParser
location = do var <- identifier
              optional $ brackets $ expression

expression :: DecafParser
expression = do buildExpressionParser decafOps primExpr <?> "expression"
                return ()

decafOps = [[Prefix ((reservedOp "-") >> (return id))]
           ,[Prefix ((reservedOp "!") >> (return id))]
           ,[op "*", op "/", op "%"]
           ,[op "+", op "-"]
           ,[op "<<", op ">>"]
           ,[op "<", op "<=", op ">=", op ">"]
           ,[op "==", op "!="]
           ,[op "&&", op "||"]]
    where op str = Infix (do{reservedOp str; return $ \a b -> ()}) AssocLeft

primExpr :: DecafParser
primExpr = do (    location
               <|> method_call
               <|> literal)
              return ()

literal :: DecafParser
literal = do integer
             return ()

identifier    = T.identifier decafParser
reserved      = T.reserved decafParser
operator      = T.operator decafParser
reservedOp    = T.reservedOp decafParser
charLiteral   = T.charLiteral decafParser
stringLiteral = T.stringLiteral decafParser
natural       = T.natural decafParser
integer       = T.integer decafParser
float         = T.float decafParser
naturalOrFloat = T.naturalOrFloat decafParser
decimal       = T.decimal decafParser
hexadecimal   = T.hexadecimal decafParser
octal         = T.octal decafParser
symbol        = T.symbol decafParser
lexeme        = T.lexeme decafParser
whiteSpace    = T.whiteSpace decafParser
parens        = T.parens decafParser
braces        = T.braces decafParser
angles        = T.angles decafParser
brackets      = T.brackets decafParser
semi          = T.semi decafParser
comma         = T.comma decafParser
colon         = T.colon decafParser
dot           = T.dot decafParser
semiSep       = T.semiSep decafParser
semiSep1      = T.semiSep1 decafParser
commaSep      = T.commaSep decafParser
commaSep1     = T.commaSep1 decafParser