From 212eecfdf7aac3475c93fbd8b3ba2fec5232ea94 Mon Sep 17 00:00:00 2001
From: VegOwOtenks <vegowotenks@jossco.de>
Date: Sat, 18 Jan 2025 22:23:43 +0100
Subject: [PATCH] Expression Parser and Parser Config

---
 src/Ubc/Parse/Config.hs     | 16 +++++++
 src/Ubc/Parse/Expression.hs | 95 +++++++++++++++++++++++++++++++++++++
 src/Ubc/Parse/Language.hs   |  8 ++--
 3 files changed, 115 insertions(+), 4 deletions(-)
 create mode 100644 src/Ubc/Parse/Config.hs
 create mode 100644 src/Ubc/Parse/Expression.hs

diff --git a/src/Ubc/Parse/Config.hs b/src/Ubc/Parse/Config.hs
new file mode 100644
index 0000000..7579be4
--- /dev/null
+++ b/src/Ubc/Parse/Config.hs
@@ -0,0 +1,16 @@
+module Ubc.Parse.Config
+( Config(..)
+, defaultConfig
+)
+where
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+data Config = Config
+        { includePaths :: Set FilePath
+        }
+
+defaultConfig :: Config
+defaultConfig = Config (Set.singleton ".")
+
diff --git a/src/Ubc/Parse/Expression.hs b/src/Ubc/Parse/Expression.hs
new file mode 100644
index 0000000..657f7dd
--- /dev/null
+++ b/src/Ubc/Parse/Expression.hs
@@ -0,0 +1,95 @@
+module Ubc.Parse.Expression
+( Expression(..)
+, BinaryOperator(..)
+, expressionParser
+)
+where
+import Control.Monad ( (<$!>) )
+import Data.Functor
+import Text.Parsec.Expr (Operator(Infix), Assoc (AssocLeft), buildExpressionParser)
+import qualified Ubc.Parse.Language as UbcLanguage
+import Text.Parsec (ParsecT, (<|>), (<?>), choice, option)
+
+data Expression = Binary BinaryOperator Expression Expression
+        | ConstantInteger Integer
+        | FunctionCall String [Expression]
+        | Variable String
+        | If Expression Expression (Maybe Expression)
+        deriving (Show)
+data BinaryOperator = Plus
+        | Minus
+        | Multiply
+        | Divide
+        | Modulo
+        | ShiftLeft
+        | ShiftRight
+        | LessThan
+        | GreaterThan
+        | LessEqual
+        | GreaterEqual
+        | Equal
+        | NotEqual
+        | BitAnd
+        | BitOr
+        | BitXor
+        deriving (Show)
+
+operatorTable :: Monad m => [[Operator String u m Expression]]
+operatorTable =
+        [
+                [ Infix (UbcLanguage.reservedOperator "*" >> return (Binary Multiply)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator "/" >> return (Binary Divide)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator "%" >> return (Binary Modulo)) AssocLeft
+                ]
+        ,
+                [ Infix (UbcLanguage.reservedOperator "+" >> return (Binary Plus)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator "-" >> return (Binary Minus)) AssocLeft
+                ]
+        ,
+                [ Infix (UbcLanguage.reservedOperator "<<" >> return (Binary ShiftLeft)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator ">>" >> return (Binary ShiftRight)) AssocLeft
+                ]
+        ,
+                [ Infix (UbcLanguage.reservedOperator ">=" >> return (Binary GreaterEqual)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator "<=" >> return (Binary LessEqual)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator "<" >> return (Binary LessThan)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator ">" >> return (Binary GreaterThan)) AssocLeft
+                ]
+        ,
+                [ Infix (UbcLanguage.reservedOperator "==" >> return (Binary Equal)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator "!=" >> return (Binary NotEqual)) AssocLeft
+                ]
+        ,
+                [ Infix (UbcLanguage.reservedOperator "&" >> return (Binary BitAnd)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator "|" >> return (Binary BitOr)) AssocLeft
+                , Infix (UbcLanguage.reservedOperator "^" >> return (Binary BitXor)) AssocLeft
+                ]
+        ]
+
+expressionParser :: (Monad m) => ParsecT String u m Expression
+expressionParser = buildExpressionParser operatorTable termParser <?> "expression"
+
+termParser :: Monad m => ParsecT String u m Expression
+termParser = UbcLanguage.parens expressionParser
+        <|> fmap ConstantInteger UbcLanguage.integer
+        <|> expressionIf
+        <|> functionCallOrVariable
+
+expressionIf :: Monad m => ParsecT String u m Expression
+expressionIf = do
+        _ <- UbcLanguage.reserved "if"
+        condition <- expressionParser
+        _ <- UbcLanguage.reserved "then"
+        then_ <- expressionParser
+        else_ <- option Nothing (UbcLanguage.reserved "else" >> expressionParser <&> Just)
+
+        return $ If condition then_ else_
+
+functionCallOrVariable :: Monad m => ParsecT String u m Expression
+functionCallOrVariable = do
+        name <- UbcLanguage.identifier
+        choice
+                [ FunctionCall name <$!> UbcLanguage.parens (UbcLanguage.commaSeparated expressionParser)
+                , return $ Variable name
+                ]
+
diff --git a/src/Ubc/Parse/Language.hs b/src/Ubc/Parse/Language.hs
index faba1a9..4574b55 100644
--- a/src/Ubc/Parse/Language.hs
+++ b/src/Ubc/Parse/Language.hs
@@ -53,10 +53,10 @@ languageDef = LanguageDef {
         , nestedComments = True
         , identStart = letter <|> char '_'
         , identLetter = alphaNum <|> char '_'
-        , opStart = oneOf "+-*/"
-        , opLetter = oneOf "+-*/"
-        , reservedNames = [ "struct", "u32", "i32", "f32" ]
-        , reservedOpNames = [ "+", "-", "*", "/" ]
+        , opStart = oneOf "+-*/%"
+        , opLetter = oneOf "+-*/%"
+        , reservedNames = [ "struct", "u32", "i32", "f32", "if", "then", "else" ]
+        , reservedOpNames = [ "+", "-", "*", "/", "%" ]
         , caseSensitive = True
         }