Completed Binary Op parsing

Author: vijayphoenix

src/AST.hs

@@ -68,7 +68,7 @@ data Op
     | Minus
     | Mul 
     | Divide
-    deriving (Show)
+    deriving (Show,Eq,Ord)
 
 data Type 
     = IntC 

src/Parser.hs

@@ -10,7 +10,7 @@ import qualified Data.Map as Map
 import AST 
 
 
-precedenceTable = Map.fromList[("Plus",20),("Minus",20),("Mul",40),("Divide",40)]
+precedenceTable = Map.fromList[(Plus,200),(Minus,200),(Mul,400),(Divide,400)]
 
 exprParser :: Parser Expr
 exprParser = try binOpCallStmtParser
@@ -136,15 +136,127 @@ funcCallParser = do
     (spaces >> (char ')') >> spaces)
     return $ FuncCall callee args
 
+-- binOpCallParser :: Parser BinOpCall
+-- binOpCallParser = do 
+--     lhs <- factor
+--     spaces
+--     op <- opParser
+--     spaces
+--     rhs <- exprParser
+--     return $ BinOpCall op lhs rhs
+
+-- binOpCallParser :: Parser BinOpCall
+-- binOpCallParser = do 
+--     temp <- factor
+--     spaces
+--     op <- opParser
+--     spaces
+--     let tokPrec = (Map.lookup op precedenceTable)
+--     lhs <- rest (Just 0) tokPrec temp op
+--     rhs <- exprParser
+--     return $ BinOpCall op lhs rhs
+
+-- rest:: (Maybe Int) -> (Maybe Int) -> Expr -> Op-> Parser Expr
+-- rest expPrec tokPrec lhs op = (do
+--             if comp tokPrec expPrec 
+--                 then return lhs
+--                 else do
+--                     rhs <- factor
+--                     spaces
+--                     nextOp <- opParser
+--                     spaces
+--                     let nextPrec = (Map.lookup nextOp precedenceTable)
+--                     if comp tokPrec nextPrec 
+--                         then do
+--                                 hi <- rest (Just 0) nextPrec rhs nextOp
+--                                 let out = BinOpCallStmt (BinOpCall nextOp rhs hi)
+--                                 return $BinOpCallStmt (BinOpCall op lhs out)
+--                         else do
+--                             hii <- return $ BinOpCallStmt (BinOpCall op lhs rhs)
+--                             next <- rest (inc tokPrec) nextPrec hii nextOp
+--                             return $BinOpCallStmt (BinOpCall nextOp hii next)
+--             )
+
+
 binOpCallParser :: Parser BinOpCall
 binOpCallParser = do 
-    lhs <- factor
-    spaces
-    op <- opParser
+    temp <- factor
     spaces
+    lhs <- rest (Just 0) temp
+    res <- try (optionalParse lhs) <|> (singleParse lhs)
+    return res
+
+
+zero :: Expr
+zero = (LiteralStmt (IntLiteral 0))
+
+optionalParse :: Expr -> Parser BinOpCall
+optionalParse lhs = do
+    op <- opParser 
     rhs <- exprParser
     return $ BinOpCall op lhs rhs
 
+singleParse :: Expr -> Parser BinOpCall
+singleParse lhs = return $ BinOpCall Plus lhs zero
+
+-- rest:: (Maybe Int) -> Expr -> Parser Expr
+-- rest expPrec lhs= try (do
+--         lop <- (lookAhead opParser)
+--         let tokPrec = getTokPrec lop
+--         if comp tokPrec expPrec 
+--             then return lhs
+--             else do
+--                 op <- opParser
+--                 spaces
+--                 temp <- factor
+--                 spaces
+--                 try(do
+--                     nop <-(lookAhead opParser)
+--                     let nextPrec = getTokPrec nop
+--                     if comp tokPrec nextPrec 
+--                         then do
+--                                 rhs <- rest (inc tokPrec) temp
+--                                 return $ BinOpCallStmt (BinOpCall op lhs rhs)
+--                         else return $ BinOpCallStmt (BinOpCall op lhs temp)
+--                     )<|>return $ BinOpCallStmt (BinOpCall op lhs temp)
+--                 ) <|> return lhs
+
+getTokPrec op = (Map.lookup op precedenceTable)
+
+
+rest:: (Maybe Int) -> Expr -> Parser Expr
+rest expPrec lhs= try (do
+        lop <- (lookAhead opParser)
+        let tokPrec = getTokPrec lop
+        if comp tokPrec expPrec 
+            then return lhs
+            else do
+                op <- opParser
+                spaces
+                temp <- factor
+                spaces
+                res <- try (firstP tokPrec temp lhs op )
+                         <|> (return $ BinOpCallStmt (BinOpCall op lhs temp))
+                return res
+            ) <|> return lhs
+
+-- firstP :: (Maybe a) -> 
+firstP tokPrec temp lhs op = do
+        nop <-(lookAhead opParser)
+        let nextPrec = getTokPrec nop
+        if comp tokPrec nextPrec 
+            then do
+                rhs <- rest (inc tokPrec) temp
+                return $ BinOpCallStmt (BinOpCall op lhs rhs)
+            else return $ BinOpCallStmt (BinOpCall op lhs temp)
+
+
+inc :: (Num a, Ord a)=> (Maybe a) -> (Maybe a)
+inc (Just x) = Just (x+1)
+
+comp :: Ord a => (Maybe a) -> (Maybe a) -> Bool
+comp (Just x) (Just y) = (x < y)
+
 -------------------------------------------------------
 -- | Declaration Stuff