Merge branch 'main' of github.com:EpitechPromo2027/B-FUN-500-BAR-5-2-…

…glados-oriol.linan into 117-handle-nested-structs

lib/Ast/Parser/Expr.hs

@@ -16,7 +16,12 @@ parseExpr = CE.makeExprParser (PU.lexeme parseTerm) operationTable
 
 operationTable :: [[CE.Operator PU.Parser AT.Expr]]
 operationTable =
-  [ [ PU.prefix "!" (`AT.UnaryOp` AT.Not),
+  [ [ PU.postfix ".*" (`AT.UnaryOp` AT.Deref),
+      PU.postfix "++" (`AT.UnaryOp` AT.PostInc),
+      PU.postfix "--" (`AT.UnaryOp` AT.PostDec),
+      parseCall
+    ],
+    [ PU.prefix "!" (`AT.UnaryOp` AT.Not),
       PU.prefix "not" (`AT.UnaryOp` AT.Not),
       PU.prefix "~" (`AT.UnaryOp` AT.BitNot),
       PU.prefix "&" (`AT.UnaryOp` AT.AddrOf),
@@ -43,18 +48,14 @@ operationTable =
       PU.binary ">=" (`AT.Op` AT.Gte),
       PU.binary "<" (`AT.Op` AT.Lt),
       PU.binary ">" (`AT.Op` AT.Gt),
+      parseAssignment,
       parseArrayAccess,
       parseStructAccess
     ],
     [ PU.binary "&&" (`AT.Op` AT.And),
       PU.binary "and" (`AT.Op` AT.And),
       PU.binary "||" (`AT.Op` AT.Or),
       PU.binary "or" (`AT.Op` AT.Or)
-    ],
-    [ PU.postfix "." (`AT.UnaryOp` AT.Deref),
-      PU.postfix "++" (`AT.UnaryOp` AT.PostInc),
-      PU.postfix "--" (`AT.UnaryOp` AT.PostDec),
-      parseCall
     ]
   ]
 
@@ -64,9 +65,14 @@ parseCall = CE.Postfix $ do
   args <- M.between (PU.symbol "(") (PU.symbol ")") $ M.many parseExpr
   return (\func -> AT.Call srcLoc func args)
 
+parseAssignment :: CE.Operator PU.Parser AT.Expr
+parseAssignment = CE.InfixL $ do
+  srcLoc <- PU.parseSrcLoc <* PU.symbol "="
+  return $ \target value -> AT.Assignment srcLoc target value
+
 parseArrayAccess :: CE.Operator PU.Parser AT.Expr
 parseArrayAccess = CE.InfixL $ do
-  srcLoc <- PU.parseSrcLoc <* PU.symbol "."
+  srcLoc <- PU.parseSrcLoc <* PU.symbol ".#"
   return $ \value pos -> AT.ArrayAccess srcLoc value pos
 
 parseStructAccess :: CE.Operator PU.Parser AT.Expr
@@ -87,8 +93,8 @@ parseTerm =
       parseCast,
       parseLit,
       M.try parseFunction,
+      M.try parseForeignFunction,
       M.try parseDeclaration,
-      M.try parseAssignment,
       parseVar,
       parseParenExpr
     ]
@@ -122,10 +128,27 @@ parseFunction = do
       return $ AT.Function {AT.funcLoc = srcLoc, AT.funcName = name, AT.funcType = ft, AT.funcParams = params, AT.funcBody = body}
     _ -> M.customFailure $ AU.InvalidFunctionType name ft
 
+parseForeignFunction :: PU.Parser AT.Expr
+parseForeignFunction = do
+  srcLoc <- PU.parseSrcLoc
+  name <- PU.identifier
+  ft <- PU.symbol ":" *> PU.symbol "foreign" *> PU.lexeme PT.parseType
+  case ft of
+    t@(AT.TFunction {}) -> do
+      S.modify (PS.insertVar name t)
+      return $
+        AT.ForeignFunction
+          { AT.funcLoc = srcLoc,
+            AT.funcName = name,
+            AT.funcType = t
+          }
+    _ -> M.customFailure $ AU.InvalidFunctionType name ft
+
 implicitReturn :: AT.Expr -> AT.Expr
 implicitReturn e@(AT.Lit loc _) = AT.Return loc $ Just e
 implicitReturn e@(AT.Var loc _ _) = AT.Return loc $ Just e
 implicitReturn e@(AT.Function loc _ _ _ _) = AT.Return loc $ Just e
+implicitReturn e@(AT.ForeignFunction loc _ _) = AT.Return loc $ Just e
 implicitReturn e@(AT.Declaration loc _ _ _) = AT.Return loc $ Just e
 implicitReturn e@(AT.Assignment loc _ _) = AT.Return loc $ Just e
 implicitReturn e@(AT.Call loc _ _) = AT.Return loc $ Just e
@@ -152,13 +175,6 @@ parseDeclaration = do
   S.modify (PS.insertVar name t)
   return $ AT.Declaration {AT.declLoc = srcLoc, AT.declName = name, AT.declType = t, AT.declInit = value}
 
-parseAssignment :: PU.Parser AT.Expr
-parseAssignment = do
-  srcLoc <- PU.parseSrcLoc
-  target <- parseVar <* PU.symbol "="
-  value <- parseExpr
-  return $ AT.Assignment {AT.assignLoc = srcLoc, AT.assignTarget = target, AT.assignValue = value}
-
 parseIf :: PU.Parser AT.Expr
 parseIf = do
   srcLoc <- PU.parseSrcLoc

lib/Ast/Parser/Program.hs

@@ -14,6 +14,7 @@ parseProgram sourceFile = do
 
 globalExpr :: AT.Expr -> (String, AT.Expr)
 globalExpr e@(AT.Function {AT.funcName = name}) = (name, e)
+globalExpr e@(AT.ForeignFunction {AT.funcName = name}) = (name, e)
 globalExpr e@(AT.Declaration {AT.declName = name}) = (name, e)
 globalExpr e@(AT.Assignment {AT.assignTarget = (AT.Var _ name _)}) = (name, e)
 globalExpr _ = error "invalid global expr"

lib/Ast/Parser/Type.hs

@@ -33,7 +33,8 @@ baseTypes =
     ("double", AT.TDouble),
     ("char", AT.TChar),
     ("bool", AT.TBoolean),
-    ("never", AT.TVoid)
+    ("never", AT.TVoid),
+    ("byte", AT.TInt 8)
   ]
 
 -- | Parses a user-defined integer size.
@@ -52,7 +53,9 @@ baseType = M.choice $ (\(kw, ty) -> ty <$ PU.symbol kw) <$> baseTypes
 -- A pointer type is denoted by a '*' followed by another type.
 -- Example: "*int" results in a pointer to an integer.
 pointerType :: PU.Parser AT.Type
-pointerType = AT.TPointer <$> (MC.char '*' *> parseType)
+pointerType = do
+  _ <- MC.char '*'
+  AT.TPointer <$> parseTermType
 
 -- | Parses a mutable type.
 -- A mutable type is prefixed by the keyword "mut" followed by the type.

lib/Ast/Types.hs

@@ -65,6 +65,11 @@ data Expr
         funcParams :: [String],
         funcBody :: Expr
       }
+  | ForeignFunction
+      { funcLoc :: SrcLoc,
+        funcName :: String,
+        funcType :: Type
+      }
   | Declaration
       { declLoc :: SrcLoc,
         declName :: String,

lib/Codegen/Codegen.hs

@@ -153,6 +153,7 @@ codegen program =
 generateGlobal :: (MonadCodegen m) => AT.Expr -> m ()
 generateGlobal expr = case expr of
   AT.Function {} -> CM.void $ generateFunction expr
+  AT.ForeignFunction {} -> CM.void $ generateForeignFunction expr
   _ -> E.throwError $ CodegenError (U.getLoc expr) $ UnsupportedTopLevel expr
 
 -- | Generate LLVM code for an expression.
@@ -164,6 +165,7 @@ instance ExprGen AT.Expr where
     AT.Lit {} -> generateLiteral expr
     AT.Var {} -> generateVar expr
     AT.Function {} -> generateFunction expr
+    AT.ForeignFunction {} -> generateForeignFunction expr
     AT.Declaration {} -> generateDeclaration expr
     AT.If {} -> generateIf expr
     AT.Block {} -> generateBlock expr
@@ -357,6 +359,20 @@ generateFunction (AT.Function _ name (AT.TFunction ret params False) paramNames
 generateFunction expr =
   E.throwError $ CodegenError (U.getLoc expr) $ UnsupportedDefinition expr
 
+-- | Generate LLVM code for foreign function definitions.
+generateForeignFunction :: (MonadCodegen m) => AT.Expr -> m AST.Operand
+generateForeignFunction (AT.ForeignFunction _ name (AT.TFunction ret params False)) = do
+  let funcType = T.ptr $ T.FunctionType (toLLVM ret) (map toLLVM params) False
+      funcName = AST.Name $ U.stringToByteString name
+
+  _ <- M.extern funcName (map toLLVM params) (toLLVM ret)
+
+  addGlobalVar name $ AST.ConstantOperand $ C.GlobalReference funcType funcName
+
+  pure $ AST.ConstantOperand $ C.GlobalReference funcType funcName
+generateForeignFunction expr =
+  E.throwError $ CodegenError (U.getLoc expr) $ UnsupportedDefinition expr
+
 -- | Generate LLVM code for declarations.
 generateDeclaration :: (MonadCodegen m) => AT.Expr -> m AST.Operand
 generateDeclaration (AT.Declaration _ name typ mInitExpr) = do

lib/Codegen/Utils.hs

@@ -37,4 +37,5 @@ getLoc expr = case expr of
   AT.Assignment loc _ _ -> loc
   AT.Op loc _ _ _ -> loc
   AT.Function loc _ _ _ _ -> loc
+  AT.ForeignFunction loc _ _ -> loc
   AT.Block exprs -> getLoc $ head exprs

test/Ast/Parser/ExprSpec.hs

@@ -259,7 +259,7 @@ spec = do
       result `shouldBe` expected
 
     it "parses an array access" $ do
-      let input = "myArray.1"
+      let input = "myArray.#1"
       let arrayType = AT.TArray AT.TChar Nothing
       let env = PS.insertVar "myArray" arrayType PS.parserState
       let result = normalizeExpr <$> fst (S.runState (M.runParserT PE.parseExpr "" input) env)
@@ -272,7 +272,7 @@ spec = do
       result `shouldBe` expected
 
     it "parses an nested array access" $ do
-      let input = "myArray.1.1"
+      let input = "myArray.#1.#1"
       let arrayType = AT.TArray (AT.TArray AT.TChar Nothing) Nothing
       let env = PS.insertVar "myArray" arrayType PS.parserState
       let result = normalizeExpr <$> fst (S.runState (M.runParserT PE.parseExpr "" input) env)
@@ -401,6 +401,85 @@ spec = do
                 )
       result `shouldBe` expected
 
+    it "parses a prefix operator" $ do
+      let input = "++x"
+      let env = PS.insertVar "x" (AT.TInt 32) PS.parserState
+      let result = normalizeExpr <$> fst (S.runState (M.runParserT PE.parseExpr "" input) env)
+      let expected =
+            Right $
+              AT.UnaryOp normalizeLoc AT.PreInc (AT.Var normalizeLoc "x" $ AT.TInt 32)
+      result `shouldBe` expected
+
+    it "parses a postfix operator" $ do
+      let input = "x++"
+      let env = PS.insertVar "x" (AT.TInt 32) PS.parserState
+      let result = normalizeExpr <$> fst (S.runState (M.runParserT PE.parseExpr "" input) env)
+      let expected =
+            Right $
+              AT.UnaryOp normalizeLoc AT.PostInc (AT.Var normalizeLoc "x" $ AT.TInt 32)
+      result `shouldBe` expected
+
+    it "parses a deref operator" $ do
+      let input = "x.*"
+      let varType = AT.TPointer $ AT.TInt 32
+      let env = PS.insertVar "x" varType PS.parserState
+      let result = normalizeExpr <$> fst (S.runState (M.runParserT PE.parseExpr "" input) env)
+      let expected =
+            Right $
+              AT.UnaryOp normalizeLoc AT.Deref (AT.Var normalizeLoc "x" varType)
+      result `shouldBe` expected
+
+    it "parses a deref assignment" $ do
+      let input = "x.* = 1"
+      let varType = AT.TPointer $ AT.TInt 32
+      let env = PS.insertVar "x" varType PS.parserState
+      let result = normalizeExpr <$> fst (S.runState (M.runParserT PE.parseExpr "" input) env)
+      let expected =
+            Right $
+              AT.Assignment
+                normalizeLoc
+                (AT.UnaryOp normalizeLoc AT.Deref (AT.Var normalizeLoc "x" varType))
+                (AT.Lit normalizeLoc $ AT.LInt 1)
+      result `shouldBe` expected
+
+    it "parses a foreign function" $ do
+      let input = "print: foreign int -> never"
+      let result = normalizeExpr <$> parseWithEnv input
+      let expected =
+            Right $
+              AT.ForeignFunction
+                normalizeLoc
+                "print"
+                (AT.TFunction AT.TVoid [AT.TInt 32] False)
+      result `shouldBe` expected
+
+    it "parses a foreign function with a function declaration after it" $
+      do
+        let input = "free: foreign *byte -> never\nmain: never -> int = { free(0) 0 }"
+        let result = normalizeExpr . AT.Block <$> fst (S.runState (M.runParserT (M.many PE.parseExpr) "" input) PS.parserState)
+        let expected =
+              Right $
+                AT.Block
+                  [ AT.ForeignFunction
+                      normalizeLoc
+                      "free"
+                      (AT.TFunction AT.TVoid [AT.TPointer (AT.TInt 8)] False),
+                    AT.Function
+                      normalizeLoc
+                      "main"
+                      (AT.TFunction (AT.TInt 32) [AT.TVoid] False)
+                      []
+                      ( AT.Block
+                          [ AT.Call
+                              normalizeLoc
+                              (AT.Var normalizeLoc "free" (AT.TFunction AT.TVoid [AT.TPointer (AT.TInt 8)] False))
+                              [AT.Lit normalizeLoc (AT.LInt 0)],
+                            AT.Return normalizeLoc (Just (AT.Lit normalizeLoc (AT.LInt 0)))
+                          ]
+                      )
+                  ]
+        result `shouldBe` expected
+
 normalizeLoc :: AT.SrcLoc
 normalizeLoc = AT.SrcLoc "" 0 0
 
@@ -423,3 +502,4 @@ normalizeExpr (AT.Break _) = AT.Break normalizeLoc
 normalizeExpr (AT.StructAccess _ e s) = AT.StructAccess normalizeLoc (normalizeExpr e) s
 normalizeExpr (AT.ArrayAccess _ e1 e2) = AT.ArrayAccess normalizeLoc (normalizeExpr e1) (normalizeExpr e2)
 normalizeExpr (AT.Cast _ t e) = AT.Cast normalizeLoc t (normalizeExpr e)
+normalizeExpr (AT.ForeignFunction _ n t) = AT.ForeignFunction normalizeLoc n t