Merge pull request #106 from EpitechPromo2027/103-parse-expr

parse `Expr`

glados.cabal

@@ -71,6 +71,7 @@ test-suite glados-test
     Ast.Parser.TypeDefinitionSpec
     Ast.Parser.TypeSpec
     Ast.Parser.UnaryOperationSpec
+    Ast.Parser.ExprSpec
     Ast.ParserSpec
     Codegen.CodegenSpec
 

lib/Ast/Parser/Env.hs

@@ -7,6 +7,7 @@ data Env = Env
   { types :: [(String, AT.Type)],
     vars :: [(String, AT.Type)]
   }
+  deriving (Show, Eq)
 
 -- | Creates an empty environment.
 emptyEnv :: Env

lib/Ast/Parser/Expr.hs

@@ -13,7 +13,22 @@ import qualified Text.Megaparsec.Pos as MP
 
 -- TODO: rethink order
 parseExpr :: PU.Parser AT.Expr
-parseExpr = PU.triedChoice [parseLit, parseVar, parseFunction, parseDeclaration, parseAssignment, parseCall, parseIf, parseBlock, parseOp]
+parseExpr =
+  M.choice
+    [ parseIf,
+      parseReturn,
+      parseBlock,
+      M.try parseFunction,
+      M.try parseDeclaration,
+      M.try parseCall,
+      parseLit,
+      M.try parseAssignment,
+      parseVar,
+      -- parseUnaryOp,
+      parseOp
+    ]
+
+-- parseExpr = M.choice [parseIf, parseReturn, parseDeclaration, parseFunction, parseBlock, parseCall, parseLit, parseVar, parseOp, parseUnaryOp, parseAssignment]
 
 parseLit :: PU.Parser AT.Expr
 parseLit = do
@@ -35,7 +50,7 @@ parseFunction :: PU.Parser AT.Expr
 parseFunction = do
   name <- PU.identifier
   t <- PU.symbol ":" *> PT.parseType
-  params <- PU.symbol "=" *> M.many PU.identifier
+  params <- PU.symbol "=" *> M.many (PU.lexeme PU.identifier)
   (AT.Block exprs) <- parseBlock
   srcLoc <- parseSrcLoc
   body <- case last exprs of
@@ -46,7 +61,7 @@ parseFunction = do
 
 parseDeclaration :: PU.Parser AT.Expr
 parseDeclaration = do
-  name <- PU.lexeme PU.identifier
+  name <- PU.identifier
   t <- PU.symbol ":" *> PT.parseType
   value <- M.optional $ PU.symbol "=" *> parseExpr
   srcLoc <- parseSrcLoc
@@ -55,7 +70,7 @@ parseDeclaration = do
 
 parseAssignment :: PU.Parser AT.Expr
 parseAssignment = do
-  target <- parseExpr <* PU.symbol "="
+  target <- parseVar <* PU.symbol "="
   value <- parseExpr
   srcLoc <- parseSrcLoc
   return $ AT.Assignment {AT.assignLoc = srcLoc, AT.assignTarget = target, AT.assignValue = value}
@@ -80,7 +95,7 @@ parseIf = do
 
 parseBlock :: PU.Parser AT.Expr
 parseBlock = do
-  es <- M.between (PU.symbol "{") (PU.symbol "}") $ M.many parseExpr
+  es <- M.between (PU.symbol "{") (PU.symbol "}") $ M.many $ PU.lexeme parseExpr
   return $ AT.Block es
 
 parseReturn :: PU.Parser AT.Expr
@@ -91,26 +106,17 @@ parseReturn = do
 
 parseOp :: PU.Parser AT.Expr
 parseOp = do
-  e1 <- parseExpr
   op <- PO.parseOperation
+  e1 <- parseExpr
   e2 <- parseExpr
   srcLoc <- parseSrcLoc
   return $ AT.Op srcLoc op e1 e2
 
 parseUnaryOp :: PU.Parser AT.Expr
 parseUnaryOp = do
-  uoType <- PUO.unaryOperationType parseExpr
-  case uoType of
-    PUO.Pre -> do
-      uo <- PUO.parseUnaryOperation uoType
-      e <- parseExpr
-      srcLoc <- parseSrcLoc
-      return $ AT.UnaryOp srcLoc uo e
-    PUO.Post -> do
-      e <- parseExpr
-      uo <- PUO.parseUnaryOperation uoType
-      srcLoc <- parseSrcLoc
-      return $ AT.UnaryOp srcLoc uo e
+  (uo, e) <- PUO.parseUnaryOperation parseExpr
+  srcLoc <- parseSrcLoc
+  return $ AT.UnaryOp srcLoc uo e
 
 parseSrcLoc :: PU.Parser AT.SrcLoc
 parseSrcLoc = do

lib/Ast/Parser/UnaryOperation.hs

@@ -4,8 +4,6 @@ import qualified Ast.Parser.Utils as PU
 import qualified Ast.Types as AT
 import qualified Text.Megaparsec as M
 
-data UnaryOperationType = Pre | Post
-
 -- | Defines unary operator symbols that precede the operand, mapped to their AST representation.
 -- Examples: `++x`, `--x`, `!x`.
 preUnaryOperations :: [(String, AT.UnaryOperation)]
@@ -27,23 +25,27 @@ postUnaryOperations =
     ("--", AT.PostDec)
   ]
 
-unaryOperationType :: PU.Parser a -> PU.Parser UnaryOperationType
-unaryOperationType operandParser =
-  M.choice
-    [ Pre <$ parseUnaryOperation' preUnaryOperations <* M.lookAhead operandParser,
-      Post <$ M.lookAhead (operandParser *> parseUnaryOperation' postUnaryOperations)
-    ]
-
 -- | Parses a unary operator and determines whether it appears before or after the operand.
 --
 -- The function uses lookahead to avoid consuming the operand during parsing.
 -- - Pre-unary operators are parsed if they appear before the operand.
 -- - Post-unary operators are parsed if they appear after the operand.
 --
 -- `operandParser`: A parser for the operand, used to determine the position of the operator.
-parseUnaryOperation :: UnaryOperationType -> PU.Parser AT.UnaryOperation
-parseUnaryOperation Pre = parseUnaryOperation' preUnaryOperations
-parseUnaryOperation Post = parseUnaryOperation' postUnaryOperations
+parseUnaryOperation :: PU.Parser a -> PU.Parser (AT.UnaryOperation, a)
+parseUnaryOperation p = M.choice [parsePreUnaryOperation p, parsePostUnaryOperation p]
+
+parsePreUnaryOperation :: PU.Parser a -> PU.Parser (AT.UnaryOperation, a)
+parsePreUnaryOperation p = do
+  uo <- parseUnaryOperation' preUnaryOperations
+  x <- p
+  return (uo, x)
+
+parsePostUnaryOperation :: PU.Parser a -> PU.Parser (AT.UnaryOperation, a)
+parsePostUnaryOperation p = do
+  x <- p
+  uo <- parseUnaryOperation' postUnaryOperations
+  return (uo, x)
 
 parseUnaryOperation' :: [(String, AT.UnaryOperation)] -> PU.Parser AT.UnaryOperation
 parseUnaryOperation' ops = M.choice $ (\(o, c) -> c <$ PU.symbol o) <$> ops

test/Ast/Parser/ExprSpec.hs

@@ -0,0 +1,119 @@
+module Ast.Parser.ExprSpec (spec) where
+
+import qualified Ast.Parser.Env as E
+import qualified Ast.Parser.Expr as PE
+import qualified Ast.Types as AT
+import qualified Control.Monad.State as S
+import Test.Hspec
+import qualified Text.Megaparsec as M
+
+spec :: Spec
+spec = do
+  let initialEnv = E.emptyEnv
+  let parseWithEnv input =
+        fst $ S.runState (M.runParserT PE.parseExpr "" input) initialEnv
+
+  describe "parseExpr" $ do
+    it "parses a literal expression" $ do
+      parseWithEnv "123" `shouldBe` Right (AT.Lit (AT.SrcLoc "" 1 4) (AT.LInt 123))
+
+    it "parses a variable expression" $ do
+      let env = E.insertVar "x" (AT.TInt 32) initialEnv
+      fst (S.runState (M.runParserT PE.parseExpr "" "x") env)
+        `shouldBe` Right (AT.Var (AT.SrcLoc "" 1 2) "x" (AT.TInt 32))
+
+    it "fails for an undefined variable" $ do
+      let result = parseWithEnv "y"
+      case result of
+        Left _ -> True `shouldBe` True
+        _ -> error "Expected failure"
+
+    it "parses a function declaration" $ do
+      let input = "add: (int int) -> (int) = x y { return 1 }"
+      let expected =
+            AT.Function
+              (AT.SrcLoc "" 0 0)
+              "add"
+              (AT.TFunction {AT.returnType = AT.TInt 32, AT.paramTypes = [AT.TInt 32, AT.TInt 32], AT.isVariadic = False})
+              ["x", "y"]
+              (AT.Block [AT.Return (AT.SrcLoc "" 0 0) (Just (AT.Lit (AT.SrcLoc "" 0 0) (AT.LInt 1)))])
+      let result = normalizeExpr <$> parseWithEnv input
+      result `shouldBe` Right (normalizeExpr expected)
+
+    it "parses fibonacci" $ do
+      let input = "add: (int int) -> (int) = x y { return 1 }"
+      let expected =
+            AT.Function
+              (AT.SrcLoc "" 0 0)
+              "add"
+              (AT.TFunction {AT.returnType = AT.TInt 32, AT.paramTypes = [AT.TInt 32, AT.TInt 32], AT.isVariadic = False})
+              ["x", "y"]
+              (AT.Block [AT.Return (AT.SrcLoc "" 0 0) (Just (AT.Lit (AT.SrcLoc "" 0 0) (AT.LInt 1)))])
+      let result = normalizeExpr <$> parseWithEnv input
+      result `shouldBe` Right (normalizeExpr expected)
+
+    it "parses a variable declaration with initialization" $ do
+      let input = "x : int = 42"
+      let expected =
+            AT.Declaration
+              { AT.declLoc = AT.SrcLoc "" 0 0,
+                AT.declName = "x",
+                AT.declType = AT.TInt 32,
+                AT.declInit = Just (AT.Lit (AT.SrcLoc "" 0 00) (AT.LInt 42))
+              }
+      normalizeExpr <$> parseWithEnv input `shouldBe` Right (normalizeExpr expected)
+
+    it "parses an assignment expression" $ do
+      let input = "x = 42"
+      let env = E.insertVar "x" (AT.TInt 0) initialEnv
+      normalizeExpr <$> fst (S.runState (M.runParserT PE.parseExpr "" input) env)
+        `shouldBe` Right (AT.Assignment (AT.SrcLoc "" 0 0) (AT.Var (AT.SrcLoc "" 0 0) "x" (AT.TInt 0)) (AT.Lit (AT.SrcLoc "" 0 0) (AT.LInt 42)))
+
+    it "parses a function call" $ do
+      let env = E.insertVar "foo" (AT.TFunction {AT.returnType = AT.TVoid, AT.paramTypes = [AT.TInt 0], AT.isVariadic = False}) initialEnv
+      let input = "foo(123)"
+      normalizeExpr <$> fst (S.runState (M.runParserT PE.parseExpr "" input) env)
+        `shouldBe` Right
+          (AT.Call (AT.SrcLoc "" 0 0) (AT.Var (AT.SrcLoc "" 0 0) "foo" (AT.TFunction {AT.returnType = AT.TVoid, AT.paramTypes = [AT.TInt 0], AT.isVariadic = False})) [AT.Lit (AT.SrcLoc "" 0 0) (AT.LInt 123)])
+
+    it "parses an if-else expression" $ do
+      let input = "if x { return 1 } else { return 0 }"
+      let env = E.insertVar "x" AT.TBoolean initialEnv
+      normalizeExpr <$> fst (S.runState (M.runParserT PE.parseExpr "" input) env)
+        `shouldBe` Right
+          ( AT.If
+              (AT.SrcLoc "" 0 0)
+              (AT.Var (AT.SrcLoc "" 0 0) "x" AT.TBoolean)
+              (AT.Block [AT.Return (AT.SrcLoc "" 0 0) (Just (AT.Lit (AT.SrcLoc "" 0 0) (AT.LInt 1)))])
+              (Just (AT.Block [AT.Return (AT.SrcLoc "" 0 0) (Just (AT.Lit (AT.SrcLoc "" 0 0) (AT.LInt 0)))]))
+          )
+
+normalizeLoc :: AT.SrcLoc
+normalizeLoc = AT.SrcLoc "" 0 0
+
+normalizeExpr :: AT.Expr -> AT.Expr
+normalizeExpr (AT.Lit _ lit) = AT.Lit normalizeLoc lit
+normalizeExpr (AT.Var _ name t) = AT.Var normalizeLoc name t
+normalizeExpr (AT.Function _ name t params body) =
+  AT.Function normalizeLoc name t params (normalizeExpr body)
+normalizeExpr (AT.Declaration _ name t initVal) =
+  AT.Declaration normalizeLoc name t (fmap normalizeExpr initVal)
+normalizeExpr (AT.Assignment _ target value) =
+  AT.Assignment normalizeLoc (normalizeExpr target) (normalizeExpr value)
+normalizeExpr (AT.Call _ func args) =
+  AT.Call normalizeLoc (normalizeExpr func) (map normalizeExpr args)
+normalizeExpr (AT.If _ cond thenBranch elseBranch) =
+  AT.If normalizeLoc (normalizeExpr cond) (normalizeExpr thenBranch) (fmap normalizeExpr elseBranch)
+normalizeExpr (AT.Block exprs) = AT.Block (map normalizeExpr exprs)
+normalizeExpr (AT.Return _ value) = AT.Return normalizeLoc (fmap normalizeExpr value)
+normalizeExpr (AT.Op _ op e1 e2) =
+  AT.Op normalizeLoc op (normalizeExpr e1) (normalizeExpr e2)
+normalizeExpr (AT.UnaryOp _ op e) =
+  AT.UnaryOp normalizeLoc op (normalizeExpr e)
+normalizeExpr (AT.For _ i c s b) = AT.For normalizeLoc i c s b
+normalizeExpr (AT.While _ c b) = AT.While normalizeLoc c b
+normalizeExpr (AT.Continue _) = AT.Continue normalizeLoc
+normalizeExpr (AT.Break _) = AT.Break normalizeLoc
+normalizeExpr (AT.StructAccess _ e s) = AT.StructAccess normalizeLoc e s
+normalizeExpr (AT.ArrayAccess _ e1 e2) = AT.ArrayAccess normalizeLoc e1 e2
+normalizeExpr (AT.Cast _ t e) = AT.Cast normalizeLoc t e

test/Ast/Parser/UnaryOperationSpec.hs

@@ -2,46 +2,95 @@ module Ast.Parser.UnaryOperationSpec where
 
 import qualified Ast.Parser.Env as E
 import qualified Ast.Parser.UnaryOperation as AUO
+import qualified Ast.Parser.Utils as PU
 import qualified Ast.Types as AT
 import qualified Control.Monad.State as S
 import Data.Either (isLeft)
 import Test.Hspec
 import qualified Text.Megaparsec as M
 
+-- Assuming PU.identifier parses an identifier like "x"
+-- If not, you can define a simple operand parser as follows:
+-- operandParser :: PU.Parser String
+-- operandParser = PU.symbol "x" >> return "x"
+
 spec :: Spec
 spec = do
   let initialEnv = E.emptyEnv
-  let parseWithEnv input opType =
-        fst $ S.runState (M.runParserT (AUO.parseUnaryOperation opType) "" input) initialEnv
+
+  -- Define an operand parser. Replace PU.identifier with your actual identifier parser.
+  let operandParser = PU.identifier
+
+  -- Helper function to run the parser with the initial environment
+  let parseWithEnv parser input =
+        S.runState (M.runParserT parser "" input) initialEnv
 
   describe "parseUnaryOperation" $ do
-    it "parses logical NOT" $ do
-      parseWithEnv "!" AUO.Pre `shouldBe` Right AT.Not
+    context "Pre-unary operators" $ do
+      it "parses logical NOT '!x'" $ do
+        let input = "!x"
+            parser = AUO.parsePreUnaryOperation operandParser
+            result = parseWithEnv parser input
+        result `shouldBe` (Right (AT.Not, "x"), initialEnv)
+
+      it "parses 'notx'" $ do
+        let input = "notx"
+            parser = AUO.parsePreUnaryOperation operandParser
+            result = parseWithEnv parser input
+        result `shouldBe` (Right (AT.Not, "x"), initialEnv)
 
-    it "parses 'not' logical unary operator" $ do
-      parseWithEnv "not" AUO.Pre `shouldBe` Right AT.Not
+      it "parses bitwise NOT '~x'" $ do
+        let input = "~x"
+            parser = AUO.parsePreUnaryOperation operandParser
+            result = parseWithEnv parser input
+        result `shouldBe` (Right (AT.BitNot, "x"), initialEnv)
 
-    it "parses bitwise NOT" $ do
-      parseWithEnv "~" AUO.Pre `shouldBe` Right AT.BitNot
+      it "parses address-of operator '&x'" $ do
+        let input = "&x"
+            parser = AUO.parsePreUnaryOperation operandParser
+            result = parseWithEnv parser input
+        result `shouldBe` (Right (AT.AddrOf, "x"), initialEnv)
 
-    it "parses address-of operator" $ do
-      parseWithEnv "&" AUO.Pre `shouldBe` Right AT.AddrOf
+      it "parses pre-unary increment '++x'" $ do
+        let input = "++x"
+            parser = AUO.parsePreUnaryOperation operandParser
+            result = parseWithEnv parser input
+        result `shouldBe` (Right (AT.PreInc, "x"), initialEnv)
 
-    it "parses pre-unary increment" $ do
-      parseWithEnv "++" AUO.Pre `shouldBe` Right AT.PreInc
+      it "parses pre-unary decrement '--x'" $ do
+        let input = "--x"
+            parser = AUO.parsePreUnaryOperation operandParser
+            result = parseWithEnv parser input
+        result `shouldBe` (Right (AT.PreDec, "x"), initialEnv)
 
-    it "parses pre-unary decrement" $ do
-      parseWithEnv "--" AUO.Pre `shouldBe` Right AT.PreDec
+    context "Post-unary operators" $ do
+      it "parses dereference operator 'x.'" $ do
+        let input = "x."
+            parser = AUO.parsePostUnaryOperation operandParser
+            result = parseWithEnv parser input
+        result `shouldBe` (Right (AT.Deref, "x"), initialEnv)
 
-    it "parses dereference operator" $ do
-      parseWithEnv "." AUO.Post `shouldBe` Right AT.Deref
+      it "parses post-unary increment 'x++'" $ do
+        let input = "x++"
+            parser = AUO.parsePostUnaryOperation operandParser
+            result = parseWithEnv parser input
+        result `shouldBe` (Right (AT.PostInc, "x"), initialEnv)
 
-    it "parses post-unary increment" $ do
-      parseWithEnv "++" AUO.Post `shouldBe` Right AT.PostInc
+      it "parses post-unary decrement 'x--'" $ do
+        let input = "x--"
+            parser = AUO.parsePostUnaryOperation operandParser
+            result = parseWithEnv parser input
+        result `shouldBe` (Right (AT.PostDec, "x"), initialEnv)
 
-    it "parses post-unary decrement" $ do
-      parseWithEnv "--" AUO.Post `shouldBe` Right AT.PostDec
+    context "Invalid operators" $ do
+      it "returns error for invalid pre-unary operator 'invalidx'" $ do
+        let input = "invalidx"
+            parser = AUO.parsePreUnaryOperation operandParser
+            result = parseWithEnv parser input
+        fst result `shouldSatisfy` isLeft
 
-    it "returns error for invalid operator" $ do
-      let result = parseWithEnv "invalid" AUO.Pre
-      isLeft result `shouldBe` True
+      it "returns error for invalid post-unary operator 'xinvalid'" $ do
+        let input = "xinvalid"
+            parser = AUO.parsePostUnaryOperation operandParser
+            result = parseWithEnv parser input
+        fst result `shouldSatisfy` isLeft