[add] Type Parser custom types

glados.cabal

@@ -24,6 +24,7 @@ library
     Ast.Parser
     Ast.Types
     Ast.Utils
+    Ast.Parser.Env
     Ast.Parser.Literal
     Ast.Parser.Operation
     Ast.Parser.UnaryOperation
@@ -79,3 +80,4 @@ test-suite glados-test
     hspec,
     hspec-discover,
     megaparsec >=9.7.0,
+    mtl >=2.2.2 && <2.3

lib/Ast/Parser.hs

@@ -1,15 +1,18 @@
 module Ast.Parser where
 
+import qualified Ast.Parser.Env as E
 import qualified Ast.Types as AT
 import qualified Ast.Utils as AU
+import qualified Control.Monad.State as S
 import qualified Text.Megaparsec as M
 
 -- | Parses a string into an abstract syntax tree (AST).
 -- The `parse` function takes a filename `String`, and an input `String` as a parameter and returns either an AST or an error message.
 parse :: String -> String -> Either String AT.Program
-parse filename input = case M.runParser parseProgram filename input of
-  (Left err) -> Left (M.errorBundlePretty err)
-  (Right program) -> Right program
+parse filename input =
+  case S.runState (M.runParserT parseProgram filename input) E.emptyEnv of
+    (Left err, _) -> Left (M.errorBundlePretty err)
+    (Right program, _) -> Right program
 
 -- | Parses the top-level structure of a program.
 -- Returns an `AST` object containing a list of parsed expressions.

lib/Ast/Parser/Env.hs

@@ -0,0 +1,19 @@
+module Ast.Parser.Env where
+
+import qualified Ast.Types as AT
+
+-- | The environment for storing custom type definitions.
+newtype Env = Env [(String, AT.Type)]
+
+-- | Creates an empty environment.
+emptyEnv :: Env
+emptyEnv = Env []
+
+-- | Inserts a custom type into the environment.
+-- If the type already exists, it overwrites it.
+insertType :: String -> AT.Type -> Env -> Env
+insertType name ty (Env env) = Env ((name, ty) : filter ((/= name) . fst) env)
+
+-- | Looks up a custom type in the environment by its name.
+lookupType :: String -> Env -> Maybe AT.Type
+lookupType name (Env env) = lookup name env

lib/Ast/Parser/Type.hs

@@ -1,7 +1,9 @@
 module Ast.Parser.Type where
 
+import qualified Ast.Parser.Env as E
 import qualified Ast.Types as AT
 import qualified Ast.Utils as AU
+import qualified Control.Monad.State as S
 import Data.Functor (($>))
 import Text.Megaparsec ((<|>))
 import qualified Text.Megaparsec as M
@@ -11,7 +13,7 @@ import qualified Text.Megaparsec.Char.Lexer as ML
 -- | Parse a general type. This function combines multiple specific type parsers.
 -- It tries to match typedefs, structs, unions, functions, mutable types, pointers, and base types.
 parseType :: AU.Parser AT.Type
-parseType = AU.triedChoice [structType, unionType, typedefType, functionType, mutableType, arrayType, pointerType, baseType]
+parseType = AU.triedChoice [structType, unionType, typedefType, functionType, mutableType, arrayType, pointerType, baseType, customType]
 
 -- | A list of predefined base types along with their associated keywords.
 -- These include basic types such as int, float, double, char, bool, and void.
@@ -59,7 +61,9 @@ structType = do
   name <- identifier
   _ <- AU.symbol "::" <* AU.symbol "struct"
   fields <- M.between (MC.char '{') (MC.char '}') $ M.many (AU.sc *> parseField)
-  return $ AT.TStruct {AT.structName = name, AT.fields = fields}
+  let structType = AT.TStruct {AT.structName = name, AT.fields = fields}
+  S.modify (E.insertType name structType)
+  return structType
 
 -- | Parses a union type definition.
 -- A union is defined with the "union" keyword followed by an optional name and a list of variants enclosed in braces.
@@ -69,7 +73,9 @@ unionType = do
   name <- identifier
   _ <- AU.symbol "::" <* AU.symbol "union"
   variants <- M.between (MC.char '{') (MC.char '}') $ M.many (AU.sc *> parseField)
-  return $ AT.TUnion {AT.unionName = name, AT.variants = variants}
+  let unionType = AT.TUnion {AT.unionName = name, AT.variants = variants}
+  S.modify (E.insertType name unionType)
+  return unionType
 
 -- | Parses a typedef.
 -- A typedef associates a new name with an existing type using the "::" syntax.
@@ -78,7 +84,10 @@ typedefType :: AU.Parser AT.Type
 typedefType = do
   name <- identifier
   _ <- AU.symbol "::"
-  AT.TTypedef name <$> parseType
+  baseType <- parseType
+  let typedef = AT.TTypedef name baseType
+  S.modify (E.insertType name typedef)
+  return typedef
 
 -- | Parses a function type.
 -- A function type is defined by its parameter types separated by spaces, followed by "->" and the return type.
@@ -91,6 +100,14 @@ functionType = do
   returnType <- parseType
   return $ AT.TFunction {AT.returnType = returnType, AT.paramTypes = paramTypes, AT.isVariadic = False}
 
+customType :: AU.Parser AT.Type
+customType = do
+  name <- identifier
+  env <- S.get
+  case E.lookupType name env of
+    Just ty -> return ty
+    Nothing -> fail $ "Unknown type: " ++ name
+
 identifier :: AU.Parser String
 identifier = AU.lexeme ((:) <$> MC.letterChar <*> M.many MC.alphaNumChar)
 

lib/Ast/Utils.hs

@@ -1,12 +1,14 @@
 module Ast.Utils where
 
+import qualified Ast.Parser.Env as E
+import qualified Control.Monad.State as S
 import Data.Void (Void)
 import qualified Text.Megaparsec as M
 import qualified Text.Megaparsec.Char as MC
 import qualified Text.Megaparsec.Char.Lexer as ML
 
 -- | A type alias for the parser, based on `Parsec` with `Void` error type and `String` input.
-type Parser = M.Parsec Void String
+type Parser = M.ParsecT Void String (S.State E.Env)
 
 -- | Skips whitespace and comments (starting with `%`). Ensures proper handling of spacing in parsers.
 sc :: Parser ()

test/Ast/Parser/LiteralSpec.hs

@@ -1,66 +1,71 @@
 module Ast.Parser.LiteralSpec (spec) where
 
+import qualified Ast.Parser.Env as E
 import qualified Ast.Parser.Literal as AL
 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
 
 spec :: Spec
 spec = do
+  let initialEnv = E.emptyEnv
+  let parseWithEnv input = fst $ S.runState (M.runParserT AL.parseLiteral "" input) initialEnv
+
   describe "parseInt" $ do
     it "parses positive integers" $ do
-      M.parse AL.parseLiteral "" "123" `shouldBe` Right (AT.LInt 123)
+      parseWithEnv "123" `shouldBe` Right (AT.LInt 123)
 
     it "parses negative integers" $ do
-      M.parse AL.parseLiteral "" "-456" `shouldBe` Right (AT.LInt (-456))
+      parseWithEnv "-456" `shouldBe` Right (AT.LInt (-456))
 
     it "fails on non-integer input" $ do
-      isLeft (M.parse AL.parseLiteral "" "abc") `shouldBe` True
+      isLeft (parseWithEnv "abc") `shouldBe` True
 
   describe "parseFloat" $ do
     it "parses positive floats" $ do
-      M.parse AL.parseLiteral "" "123.45" `shouldBe` Right (AT.LFloat 123.45)
+      parseWithEnv "123.45" `shouldBe` Right (AT.LFloat 123.45)
 
     it "parses negative floats" $ do
-      M.parse AL.parseLiteral "" "-67.89" `shouldBe` Right (AT.LFloat (-67.89))
+      parseWithEnv "-67.89" `shouldBe` Right (AT.LFloat (-67.89))
 
     it "fails on non-float input" $ do
-      isLeft (M.parse AL.parseLiteral "" "abc") `shouldBe` True
+      isLeft (parseWithEnv "abc") `shouldBe` True
 
   describe "parseBool" $ do
     it "parses true" $ do
-      M.parse AL.parseLiteral "" "true" `shouldBe` Right (AT.LBool True)
+      parseWithEnv "true" `shouldBe` Right (AT.LBool True)
 
     it "parses false" $ do
-      M.parse AL.parseLiteral "" "false" `shouldBe` Right (AT.LBool False)
+      parseWithEnv "false" `shouldBe` Right (AT.LBool False)
 
     it "fails on invalid input" $ do
-      isLeft (M.parse AL.parseLiteral "" "maybe") `shouldBe` True
+      isLeft (parseWithEnv "maybe") `shouldBe` True
 
   describe "parseChar" $ do
     it "parses a single character" $ do
-      M.parse AL.parseLiteral "" "'a'" `shouldBe` Right (AT.LChar 'a')
+      parseWithEnv "'a'" `shouldBe` Right (AT.LChar 'a')
 
     it "fails on invalid input" $ do
-      isLeft (M.parse AL.parseLiteral "" "'abc'") `shouldBe` True
+      isLeft (parseWithEnv "'abc'") `shouldBe` True
 
   describe "parseArray" $ do
     it "parses an array of integers" $ do
-      M.parse AL.parseLiteral "" "[1,2,3]" `shouldBe` Right (AT.LArray [AT.LInt 1, AT.LInt 2, AT.LInt 3])
+      parseWithEnv "[1,2,3]" `shouldBe` Right (AT.LArray [AT.LInt 1, AT.LInt 2, AT.LInt 3])
 
     it "parses an array of mixed literals" $ do
-      M.parse AL.parseLiteral "" "[true,'a',123]" `shouldBe` Right (AT.LArray [AT.LBool True, AT.LChar 'a', AT.LInt 123])
+      parseWithEnv "[true,'a',123]" `shouldBe` Right (AT.LArray [AT.LBool True, AT.LChar 'a', AT.LInt 123])
 
     it "parses a string literal as an array of characters" $ do
-      M.parse AL.parseLiteral "" "\"hello\"" `shouldBe` Right (AT.LArray (map AT.LChar "hello"))
+      parseWithEnv "\"hello\"" `shouldBe` Right (AT.LArray (map AT.LChar "hello"))
 
     it "fails on invalid input" $ do
-      isLeft (M.parse AL.parseLiteral "" "[1,true,]") `shouldBe` True
+      isLeft (parseWithEnv "[1,true,]") `shouldBe` True
 
   describe "parseNull" $ do
     it "parses null" $ do
-      M.parse AL.parseLiteral "" "null" `shouldBe` Right AT.LNull
+      parseWithEnv "null" `shouldBe` Right AT.LNull
 
     it "fails on non-null input" $ do
-      isLeft (M.parse AL.parseLiteral "" "none") `shouldBe` True
+      isLeft (parseWithEnv "none") `shouldBe` True

test/Ast/Parser/OperationSpec.hs

@@ -1,76 +1,82 @@
 module Ast.Parser.OperationSpec where
 
+import qualified Ast.Parser.Env as E
 import qualified Ast.Parser.Operation as AO
 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
 
 spec :: Spec
 spec = do
+  let initialEnv = E.emptyEnv
+  let parseWithEnv input = fst $ S.runState (M.runParserT AO.parseOperation "" input) initialEnv
+
   describe "parseOperation" $ do
     it "parses addition operator" $ do
-      M.parse AO.parseOperation "" "+" `shouldBe` Right AT.Add
+      parseWithEnv "+" `shouldBe` Right AT.Add
 
     it "parses subtraction operator" $ do
-      M.parse AO.parseOperation "" "-" `shouldBe` Right AT.Sub
+      parseWithEnv "-" `shouldBe` Right AT.Sub
 
     it "parses multiplication operator" $ do
-      M.parse AO.parseOperation "" "*" `shouldBe` Right AT.Mul
+      parseWithEnv "*" `shouldBe` Right AT.Mul
 
     it "parses division operator" $ do
-      M.parse AO.parseOperation "" "/" `shouldBe` Right AT.Div
+      parseWithEnv "/" `shouldBe` Right AT.Div
 
     it "parses modulo operator" $ do
-      M.parse AO.parseOperation "" "mod" `shouldBe` Right AT.Mod
+      parseWithEnv "mod" `shouldBe` Right AT.Mod
 
     it "parses bitwise AND operator" $ do
-      M.parse AO.parseOperation "" "&" `shouldBe` Right AT.BitAnd
+      parseWithEnv "&" `shouldBe` Right AT.BitAnd
 
     it "parses bitwise OR operator" $ do
-      M.parse AO.parseOperation "" "|" `shouldBe` Right AT.BitOr
+      parseWithEnv "|" `shouldBe` Right AT.BitOr
 
     it "parses bitwise XOR operator" $ do
-      M.parse AO.parseOperation "" "^" `shouldBe` Right AT.BitXor
+      parseWithEnv "^" `shouldBe` Right AT.BitXor
 
     it "parses left shift operator" $ do
-      M.parse AO.parseOperation "" "<<" `shouldBe` Right AT.BitShl
+      parseWithEnv "<<" `shouldBe` Right AT.BitShl
 
     it "parses right shift operator" $ do
-      M.parse AO.parseOperation "" ">>" `shouldBe` Right AT.BitShr
+      parseWithEnv ">>" `shouldBe` Right AT.BitShr
 
     it "parses less than operator" $ do
-      M.parse AO.parseOperation "" "<" `shouldBe` Right AT.Lt
+      parseWithEnv "<" `shouldBe` Right AT.Lt
 
     it "parses greater than operator" $ do
-      M.parse AO.parseOperation "" ">" `shouldBe` Right AT.Gt
+      parseWithEnv ">" `shouldBe` Right AT.Gt
 
     it "parses less than or equal to operator" $ do
-      M.parse AO.parseOperation "" "<=" `shouldBe` Right AT.Lte
+      parseWithEnv "<=" `shouldBe` Right AT.Lte
 
     it "parses greater than or equal to operator" $ do
-      M.parse AO.parseOperation "" ">=" `shouldBe` Right AT.Gte
+      parseWithEnv ">=" `shouldBe` Right AT.Gte
 
     it "parses equality operator" $ do
-      M.parse AO.parseOperation "" "==" `shouldBe` Right AT.Eq
+      parseWithEnv "==" `shouldBe` Right AT.Eq
 
     it "parses 'is' equality operator" $ do
-      M.parse AO.parseOperation "" "is" `shouldBe` Right AT.Eq
+      parseWithEnv "is" `shouldBe` Right AT.Eq
 
     it "parses inequality operator" $ do
-      M.parse AO.parseOperation "" "!=" `shouldBe` Right AT.Ne
+      parseWithEnv "!=" `shouldBe` Right AT.Ne
 
     it "parses logical AND operator" $ do
-      M.parse AO.parseOperation "" "&&" `shouldBe` Right AT.And
+      parseWithEnv "&&" `shouldBe` Right AT.And
 
     it "parses 'and' logical operator" $ do
-      M.parse AO.parseOperation "" "and" `shouldBe` Right AT.And
+      parseWithEnv "and" `shouldBe` Right AT.And
 
     it "parses logical OR operator" $ do
-      M.parse AO.parseOperation "" "||" `shouldBe` Right AT.And
+      parseWithEnv "||" `shouldBe` Right AT.Or
 
     it "parses 'or' logical operator" $ do
-      M.parse AO.parseOperation "" "or" `shouldBe` Right AT.And
+      parseWithEnv "or" `shouldBe` Right AT.Or
 
     it "returns error for invalid operator" $ do
-      M.parse AO.parseOperation "" "invalid" `shouldSatisfy` isLeft
+      let result = parseWithEnv "invalid"
+      isLeft result `shouldBe` True