Added Binary Operation Parser and fixed precedence issues

Author: vijayphoenix

src/AST.hs

@@ -8,6 +8,7 @@ module AST (
     ArgList,
     Args,
     Declaration(..),
+    BinOpCall(..),
     FuncCall(..)
 ) where 
 
@@ -57,6 +58,7 @@ data Func
 data Expr
     = DeclarationStmt   Declaration
     | FuncCallStmt      FuncCall
+    | BinOpCallStmt     BinOpCall
     | LiteralStmt       Literal 
     deriving (Show)
 
@@ -99,16 +101,18 @@ data Declaration
 
 
 data FuncCall
-    = Call {
+    = FuncCall {
         callee :: Name ,
         args   :: Args
     }
-    | BinOpCall {
+    deriving (Show)
+
+data BinOpCall 
+    = BinOpCall {
         op     :: Op ,
         lhs    :: Expr,
         rhs    :: Expr
-    }
-    deriving (Show)
+    } deriving (Show)
 
 
 -- | For Debugging Purposes
@@ -118,37 +122,37 @@ data FuncCall
  -- instance Show Declaration where 
  --    show c@(ExternDecl a) = show 
 
-argListPrint :: ArgList -> String 
-argListPrint [] = ""
-argListPrint (x:farr) = (show $ fst x) ++ " " ++ (snd x) ++ ", " ++ (argListPrint farr)
+-- argListPrint :: ArgList -> String 
+-- argListPrint [] = ""
+-- argListPrint (x:farr) = (show $ fst x) ++ " " ++ (snd x) ++ ", " ++ (argListPrint farr)
 
 
-vListPrint :: VList -> String 
-vListPrint [] = ""
-vListPrint (x:fx) = x ++ ", " ++ (vListPrint fx)
+-- vListPrint :: VList -> String 
+-- vListPrint [] = ""
+-- vListPrint (x:fx) = x ++ ", " ++ (vListPrint fx)
 
 
--- instance Show 
+-- -- instance Show 
 
--- argsPrint :: Args -> String 
--- argsPrint [] = ""
--- argsPrint (x:fx) = (exprPrint x) ++ ", " ++ (argsPrint fx)
+-- -- argsPrint :: Args -> String 
+-- -- argsPrint [] = ""
+-- -- argsPrint (x:fx) = (exprPrint x) ++ ", " ++ (argsPrint fx)
 
-argsPrint :: Args -> String
-argsPrint = show 
-showExpr :: Expr -> String
-showExpr = show
+-- argsPrint :: Args -> String
+-- argsPrint = show 
+-- showExpr :: Expr -> String
+-- showExpr = show
 
-externDeclPrint (ExternDecl f a _) = "extern " ++ f ++ " -> " ++ (argListPrint a)
-varDeclPrint (VarDecl t l) = (show t) ++ " " ++ (vListPrint l)
+-- externDeclPrint (ExternDecl f a _) = "extern " ++ f ++ " -> " ++ (argListPrint a)
+-- varDeclPrint (VarDecl t l) = (show t) ++ " " ++ (vListPrint l)
 
 
-callPrint (Call c a) = "call " ++ (show c) ++ " -> " ++ (argsPrint a)
-binOpCallPrint (BinOpCall op l r) = (show op) ++ " -> " ++ (showExpr l) ++ " " ++ (showExpr r)
+-- callPrint (Call c a) = "call " ++ (show c) ++ " -> " ++ (argsPrint a)
+-- binOpCallPrint (BinOpCall op l r) = (show op) ++ " -> " ++ (showExpr l) ++ " " ++ (showExpr r)
 
--- Tests
-externDecl  = ExternDecl "sin" [(IntC, "arg1")]
-varDecl     = VarDecl StringC ["arg1", "arg2"]
-literal     = StrLiteral "adf"
-literalStmt = LiteralStmt literal
-call        = Call "func" [literalStmt]
+-- -- Tests
+-- externDecl  = ExternDecl "sin" [(IntC, "arg1")]
+-- varDecl     = VarDecl StringC ["arg1", "arg2"]
+-- literal     = StrLiteral "adf"
+-- literalStmt = LiteralStmt literal
+-- call        = Call "func" [literalStmt]

src/Lexer.hs

@@ -5,6 +5,7 @@ module Lexer (
     reservedOp,
     stringLiteral,
     integer,
+    paren,
     Parser(..),
     parse
 ) where 
@@ -38,3 +39,6 @@ stringLiteral = Tok.stringLiteral lexer
 --  Returns the value of the number.
 integer :: Parser Integer 
 integer = Tok.integer lexer
+
+paren :: Parser a -> Parser a 
+paren = Tok.parens lexer

src/Parser.hs

@@ -6,82 +6,60 @@ import Text.Parsec.Combinator
 import Text.Parsec.Char
 import Text.Parsec
 import qualified Text.Parsec.Token as Tok
+import qualified Data.Map as Map 
 import AST 
 
--- literalParser :: Type -> Parser Literal 
--- literalParser IntC = do 
---     val <- integer
---     return (IntLiteral val)
--- literalParser StringC = do 
---     val <- stringLiteral
---     return (StrLiteral val)
-
--- strP = literalParser StringC
-
--- topParser :: Parser Module
--- topParser = commandParser <|> funcParser
-
--- commandParser :: Parser Module 
--- commandParser = do 
---     spaces
---     exp <- exprParser
---     char ';'
---     spaces
---     return $ Command exp
-
 
+precedenceTable = Map.fromList[("Plus",20),("Minus",20),("Mul",40),("Divide",40)]
 
 exprParser :: Parser Expr
-exprParser = literalStmtParser
-           <|> declarationStmtParser
-           <|> funcCallStmtParser
-           <|> (Tok.parens lexer exprParser)
-
--- declStmtParser :: Parser Expr 
--- declStmtParser = do
---     decl <- declParser
---     return $ DeclarationStmt decl
-
--- declParser :: Parser Declaration
--- declParser = externDeclParser <|> varDeclParser
-
--- externDeclParser :: Parser Declaration
--- externDeclParser = do
---     spaces
---     string "extern"
---     name <- nameParser
---     argList <- argListParser
---     ret <- typeParser
---     spaces
---     return $ ExternDecl name argList ret 
-
--- varDeclParser :: Parser Declaration
--- varDeclParser = do 
---     spaces
---     type <- typeParser
---     nameList <- vListParser
---     spaces
---     return $ VarDecl type nameList
+exprParser = try binOpCallStmtParser
+           <|> try factor
+           <|> try declarationStmtParser
 
+factor :: Parser Expr 
+factor = try (paren exprParser)
+        <|> try funcCallStmtParser
+        <|> literalStmtParser
 
 -- | Parsing type related stuffs. ----
 -- NSS
 typeParser :: Parser Type 
-typeParser = intTParser <|> stringTParser
+typeParser = try intTParser <|> stringTParser
 
 -- NSS
 intTParser = do 
     reserved "int"
-    spaces
     return IntC
 
 -- NSS
 stringTParser = do
     reserved "string"
-    spaces
     return StringC
 -------------------------------------
 
+opParser :: Parser Op
+opParser =  try plusParser 
+    <|> try minusParser 
+    <|> try mulParser 
+    <|> divideParser
+
+plusParser = do
+    reservedOp "+"
+    return Plus
+
+minusParser = do
+    reservedOp "-"
+    return Minus
+
+mulParser = do
+    reservedOp "*"
+    return Mul
+
+divideParser = do
+    reservedOp "/"
+    return Divide
+
 -- | Variable Names and identifier -----
 -- NSS
 nameParser :: Parser Name 
@@ -144,18 +122,28 @@ funcCallStmtParser = do
     res <- funcCallParser 
     return $ FuncCallStmt res
 
-funcCallParser :: Parser FuncCall 
-funcCallParser = callParser {-<|> binOpCall-}
+binOpCallStmtParser :: Parser Expr 
+binOpCallStmtParser = do
+    res <- binOpCallParser
+    return $ BinOpCallStmt res
 
-callParser :: Parser FuncCall
-callParser = do 
+
+funcCallParser :: Parser FuncCall
+funcCallParser = do 
     callee <- nameParser
     (spaces >> (char '(') >> spaces)
     args <- argsParser
     (spaces >> (char ')') >> spaces)
-    return $ Call callee args
-
+    return $ FuncCall callee args
 
+binOpCallParser :: Parser BinOpCall
+binOpCallParser = do 
+    lhs <- factor
+    spaces
+    op <- opParser
+    spaces
+    rhs <- exprParser
+    return $ BinOpCall op lhs rhs
 
 -------------------------------------------------------
 -- | Declaration Stuff
@@ -190,9 +178,6 @@ varDeclParser = do
 
 ---------------------------------------------------------
 
--- funcCallParser :: Parser 
-
-
 mainTest = do
     str <- getLine
     if str == "quit"