Merge branch 'main' into jabolol/function-call

app/Main.hs

@@ -7,6 +7,7 @@ import qualified Codegen.Codegen as C
 import qualified Control.Monad as M
 import qualified Control.Monad.IO.Class as IO
 import qualified Control.Monad.Trans.Except as E
+import qualified Data.Maybe as DM
 import qualified Data.Text.Lazy as TL
 import qualified LLVM.Pretty as LLVM
 import qualified Options.Applicative as O
@@ -57,9 +58,9 @@ optionsInfo =
         <> O.header "Scheme-to-LLVM Compiler"
     )
 
-compile :: String -> Bool -> E.ExceptT CompileError IO String
-compile input verbose = do
-  ast <- case P.parse input of
+compile :: String -> String -> Bool -> E.ExceptT CompileError IO String
+compile input source verbose = do
+  ast <- case P.parse input source of
     Left err -> E.throwE $ ParseError err
     Right res -> return res
 
@@ -88,7 +89,7 @@ main = do
   source <- readInput input
 
   logMsg verbose "Starting compilation..."
-  result <- E.runExceptT $ compile source verbose
+  result <- E.runExceptT $ compile (DM.fromMaybe "stdin" input) source verbose
 
   case result of
     Left (ParseError err) -> handleError "parsing" err verbose

glados.cabal

@@ -22,6 +22,7 @@ library
   import: warnings
   exposed-modules:
     Ast.Parser
+    Ast.Env
     Ast.Types
     Codegen.Codegen
     Codegen.Utils
@@ -59,6 +60,7 @@ test-suite glados-test
   type: exitcode-stdio-1.0
   other-modules:
     Ast.ParserSpec
+    Ast.TypesSpec
     Misc.MiscSpec
 
   hs-source-dirs: test

lib/Ast/Env.hs

@@ -0,0 +1,54 @@
+module Ast.Env (Env (..), emptyEnv, insertVar, insertFn, lookupVar, lookupFn) where
+
+import Ast.Types (Expr)
+import qualified Data.Map as Map
+
+-- | The `Env` data type represents an environment that stores mappings
+-- of variable names to their values and function names to their definitions.
+data Env = Env
+  { fn :: Map.Map String Expr,
+    var :: Map.Map String Expr
+  }
+
+-- | Creates an empty environment with no variables or functions.
+-- `emptyEnv` returns an `Env` instance with empty mappings for both variables and functions.
+emptyEnv :: Env
+emptyEnv = Env {fn = Map.empty, var = Map.empty}
+
+-- | Inserts a variable into the environment.
+-- `insertVar` takes as parameters:
+-- - `String`: The name of the variable.
+-- - `Expr`: The value of the variable.
+-- - `Env`: The current environment.
+-- And returns a new `Env` with the variable added to the `var` mapping.
+insertVar :: String -> Expr -> Env -> Env
+insertVar name value env = env {var = Map.insert name value (var env)}
+
+-- | Inserts a function into the environment.
+-- `insertFn` takes as parameters:
+-- - `String`: The name of the function.
+-- - `Expr`: The definition of the function (usually a lambda expression).
+-- - `Env`: The current environment.
+-- and returns a new `Env` with the function added to the `fn` mapping.
+insertFn :: String -> Expr -> Env -> Env
+insertFn name lambda env = env {fn = Map.insert name lambda (fn env)}
+
+-- | Looks up a variable in the environment by its name.
+-- `lookupVar` takes as parameters:
+-- - `String`: The name of the variable.
+-- - `Env`: The current environment.
+-- and returns:
+-- - `Just Expr`: The value of the variable if it exists in the `var` mapping.
+-- - `Nothing`: If the variable does not exist in the environment.
+lookupVar :: String -> Env -> Maybe Expr
+lookupVar name env = Map.lookup name (var env)
+
+-- | Looks up a function in the environment by its name.
+-- `lookupFn` takes as parameters:
+-- - `String`: The name of the function.
+-- - `Env`: The current environment.
+-- and returns:
+-- - `Just Expr`: The definition of the function if it exists in the `fn` mapping.
+-- - `Nothing`: If the function does not exist in the environment.
+lookupFn :: String -> Env -> Maybe Expr
+lookupFn name env = Map.lookup name (fn env)

lib/Ast/Parser.hs

@@ -1,48 +1,47 @@
-module Ast.Parser (parse) where
+module Ast.Parser (parse, ParseErrorCustom (..)) where
 
+import qualified Ast.Env as E
 import Ast.Types (AST (..), Expr (..), Literal (..), Operation (..))
 import Control.Applicative (Alternative (..))
-import qualified Control.Monad as M
+import qualified Control.Monad as CM
+import qualified Control.Monad.State as S
 import qualified Text.Megaparsec as M
 import qualified Text.Megaparsec.Char as MC
 import qualified Text.Megaparsec.Char.Lexer as ML
 
-type Parser = M.Parsec ParseErrorCustom String
+type Parser = M.ParsecT ParseErrorCustom String (S.State E.Env)
 
 -- | Custom error type for the parser, representing specific cases of invalid syntax.
 data ParseErrorCustom
-  = InvalidDefineExpression Expr
-  | InvalidArgsForDefine Expr
-  | InvalidLambdaExpression Expr
-  | InvalidArgsForLambda Expr
+  = UndefinedLambdaReference String
   | ReservedKeywordUsed String
+  | UndefinedVarReference String
+  | InvalidVarName String
   deriving (Show, Ord, Eq)
 
 -- | Implements a custom error message component for the parser.
 instance M.ShowErrorComponent ParseErrorCustom where
-  showErrorComponent (InvalidDefineExpression e) =
-    "Invalid define expression: expected a variable or a function definition, but got: " ++ show e
-  showErrorComponent (InvalidArgsForDefine e) =
-    "Invalid arguments in define: expected all arguments to be variables, but got: " ++ show e
-  showErrorComponent (InvalidLambdaExpression e) =
-    "Invalid lambda expression: expected a function definition, but got: " ++ show e
-  showErrorComponent (InvalidArgsForLambda e) =
-    "Invalid arguments in lambda: expected all arguments to be variables, but got: " ++ show e
+  showErrorComponent (UndefinedLambdaReference n) =
+    "Undefined lambda referenced: expected lambda \"" ++ n ++ "\" to be defined"
   showErrorComponent (ReservedKeywordUsed kw) =
     "Reserved keyword used as function name: \"" ++ kw ++ "\""
+  showErrorComponent (UndefinedVarReference n) =
+    "Undefined var referenced: expected var \"" ++ n ++ "\" to be defined"
+  showErrorComponent (InvalidVarName n) =
+    "Invalid var name: \"" ++ n ++ "\" is not valid"
 
 ops :: [(String, Operation)]
-ops = [("+", Add), ("-", Sub), ("*", Mult), ("div", Div), ("mod", Mod), (">", Gt), ("<", Lt), (">=", Gte), ("<=", Lte), ("==", Equal), ("/=", Ne), ("&&", And), ("||", Or)]
+ops = [("+", Add), ("-", Sub), ("*", Mult), ("div", Div), ("mod", Mod), (">=", Gte), ("<=", Lte), (">", Gt), ("<", Lt), ("==", Equal), ("/=", Ne), ("&&", And), ("||", Or)]
 
 keywords :: [String]
 keywords = ["define", "lambda", "if"] ++ map fst ops
 
 -- | Parses a string into an abstract syntax tree (AST).
--- The `parse` function takes a String as a parameter and returns either an AST or an error message.
-parse :: String -> Either String AST
-parse input = case M.parse parseProgram "" input of
-  Left err -> Left (M.errorBundlePretty err)
-  Right tokens -> Right tokens
+-- 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 AST
+parse filename input = case S.runState (M.runParserT parseProgram filename input) E.emptyEnv of
+  (Left err, _) -> Left (M.errorBundlePretty err)
+  (Right tokens, _) -> Right tokens
 
 -- | Parses the top-level structure of a program.
 -- Returns an `AST` object containing a list of parsed expressions.
@@ -78,37 +77,35 @@ parseList = Seq <$> list (M.many parseExpr)
 parseDefine :: Parser Expr
 parseDefine = do
   _ <- symbol "define"
-  e <- lexeme parseExpr
+  M.choice [parseVariableDefine, parseFunctionDefine]
+
+parseVariableDefine :: Parser Expr
+parseVariableDefine = do
+  name <- lexeme parseVarName
   value <- parseExpr
-  case e of
-    (Var name) -> return $ Define name value
-    (Call (Var name) (Seq es)) -> case extractVarNames es of
-      (Just args) -> return $ Define name $ Lambda args value
-      _ -> M.customFailure $ InvalidArgsForDefine $ Seq es
-    _ -> M.customFailure $ InvalidDefineExpression e
+  S.modify $ E.insertVar name value
+  return $ Define name value
+
+parseFunctionDefine :: Parser Expr
+parseFunctionDefine = do
+  (name, args) <- list $ do
+    name <- lexeme parseVarName
+    args <- M.many $ parseVarName <* M.optional sc
+    return (name, args)
+  mapM_ (\arg -> S.modify $ E.insertVar arg $ Var arg) args
+  value <- parseExpr
+  let lambda = Lambda args value
+  S.modify $ E.insertFn name lambda
+  return $ Define name lambda
 
 -- | Parses a `lambda` expression for defining functions.
 -- Returns an `Expr` representing the parsed `lambda` construct.
 parseLambda :: Parser Expr
 parseLambda = do
   _ <- symbol "lambda"
-  e <- parseExpr
-  value <- parseExpr
-  case e of
-    (Seq es) -> case extractVarNames es of
-      (Just params) -> return $ Lambda params value
-      _ -> M.customFailure $ InvalidArgsForLambda $ Seq es
-    (Call (Var n) (Seq es)) -> case extractVarNames es of
-      (Just params) -> return $ Lambda (n : params) value
-      _ -> M.customFailure $ InvalidArgsForLambda $ Seq $ Var n : es
-    _ -> M.customFailure $ InvalidLambdaExpression e
-
-extractVarNames :: [Expr] -> Maybe [String]
-extractVarNames = mapM extractVarName
-  where
-    extractVarName :: Expr -> Maybe String
-    extractVarName (Var name) = Just name
-    extractVarName _ = Nothing
+  params <- list $ M.many $ parseVarName <* M.optional sc
+  mapM_ (\p -> S.modify $ E.insertVar p $ Var p) params
+  Lambda params <$> parseExpr
 
 -- | Parses an `if` expression with a condition, true branch, and false branch.
 -- Returns an `Expr` of type `If`.
@@ -137,9 +134,12 @@ parseOpeartor = M.choice $ (\(o, c) -> c <$ symbol o) <$> ops
 parseCall :: Parser Expr
 parseCall = do
   name <- lexeme parseVarName
-  M.when (name `elem` keywords) $ M.customFailure $ ReservedKeywordUsed name
-  args <- M.some $ parseExpr <* M.optional sc
-  return $ Call (Var name) $ Seq args
+  env <- S.get
+  case E.lookupFn name env of
+    Just (Lambda _ _) -> do
+      args <- M.many $ parseExpr <* M.optional sc
+      return $ Call (Var name) $ Seq args
+    _ -> M.customFailure $ UndefinedLambdaReference name
 
 -- | Parses a literal value (integer or boolean).
 -- Returns an `Expr` of type `Lit`.
@@ -159,12 +159,22 @@ parseBool = LBool True <$ symbol "#t" <|> LBool False <$ symbol "#f"
 -- | Parses a variable expression by matching valid variable names.
 -- Returns an `Expr` of type `Var`.
 parseVar :: Parser Expr
-parseVar = Var <$> parseVarName
+parseVar = do
+  name <- parseVarName
+  env <- S.get
+  case E.lookupVar name env of
+    Just _ -> do
+      return $ Var name
+    _ -> M.customFailure $ UndefinedVarReference name
 
 -- | Parses a variable name consisting of alphanumeric characters and underscores.
 -- Returns a `String` representing the variable name.
 parseVarName :: Parser String
-parseVarName = M.some (MC.alphaNumChar <|> M.oneOf "_")
+parseVarName = do
+  name <- M.some (MC.alphaNumChar <|> M.oneOf "_$")
+  CM.when (name `elem` keywords) $ M.customFailure $ ReservedKeywordUsed name
+  CM.when (all (`elem` ['0' .. '9']) name) $ M.customFailure $ InvalidVarName name
+  return name
 
 -- | Skips whitespace and comments during parsing.
 -- Used to ensure parsers handle spacing correctly.