wip: parse imports

app/Main.hs

@@ -61,7 +61,8 @@ optionsInfo =
 
 compile :: String -> String -> Bool -> E.ExceptT CompileError IO String
 compile input source verbose = do
-  ast <- case P.parse input source of
+  result <- IO.liftIO $ P.parse input source
+  ast <- case result of
     Left err -> E.throwE $ ParseError err
     Right res -> return res
 

glados.cabal

@@ -23,6 +23,7 @@ library
   exposed-modules:
     Ast.Parser
     Ast.Parser.Expr
+    Ast.Parser.Import
     Ast.Parser.Literal
     Ast.Parser.Program
     Ast.Parser.State
@@ -40,7 +41,8 @@ library
     llvm-hs-pure >=9.0.0 && <9.1,
     megaparsec >=9.7.0,
     mtl >=2.2.2 && <2.3,
-    parser-combinators >= 1.3.0
+    parser-combinators >= 1.3.0,
+    http-conduit >= 2.3.9
 
   hs-source-dirs: lib
   default-language: Haskell2010

lib/Ast/Parser.hs

@@ -8,8 +8,9 @@ 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 sourceFile input =
-  case S.runState (M.runParserT (PP.parseProgram sourceFile) sourceFile input) PS.parserState of
-    (Left err, _) -> Left (M.errorBundlePretty err)
-    (Right program, _) -> Right program
+parse :: String -> String -> IO (Either String AT.Program)
+parse sourceFile input = do
+  (result, _) <- S.runStateT (M.runParserT (PP.parseProgram sourceFile) sourceFile input) PS.parserState
+  case result of
+    (Left err) -> return $ Left (M.errorBundlePretty err)
+    (Right program) -> return $ Right program

lib/Ast/Parser/Import.hs

@@ -0,0 +1,45 @@
+module Ast.Parser.Import where
+
+import qualified Ast.Parser.State as PS
+import qualified Ast.Parser.Utils as PU
+import qualified Control.Monad.IO.Class as IO
+import qualified Control.Monad.State as S
+import qualified Network.HTTP.Simple as N
+import qualified Text.Megaparsec as M
+
+parseImport :: PU.Parser String -> PU.Parser String
+parseImport p = do
+  import' <- PU.symbol "import" *> M.between (PU.symbol "\"") (PU.symbol "\"") (M.some M.anySingle)
+  state <- S.get
+  let visited = PS.lookupImport import' state
+      depth = PS.getImportDepth state
+
+  if visited
+    then return ""
+    else
+      if depth >= maxDepth
+        then fail "Maximum depth exceeded"
+        else do
+          S.modify $ PS.insertImport import'
+          S.modify $ PS.setImportDepth $ depth + 1
+          source <- case import' of
+            ('.' : '/' : _) -> IO.liftIO $ localImport import'
+            _ -> IO.liftIO $ externalImport import'
+          input <- M.getInput
+          M.setInput $ source ++ input
+          source' <- p
+          S.modify $ PS.setImportDepth depth
+          return source'
+  where
+    maxDepth = 25
+
+localImport :: String -> IO String
+localImport = readFile
+
+externalImport :: String -> IO String
+externalImport url = do
+  req <- case N.parseRequest url of
+    Left err -> fail ("Invalid URL: " ++ show err)
+    Right req -> return req
+  res <- N.httpBS req
+  return $ show $ N.getResponseBody res

lib/Ast/Parser/Program.hs

@@ -1,17 +1,37 @@
 module Ast.Parser.Program where
 
 import qualified Ast.Parser.Expr as PE
+import qualified Ast.Parser.Import as PI
+import qualified Ast.Parser.State as PS
 import qualified Ast.Parser.TypeDefinition as PT
 import qualified Ast.Parser.Utils as PU
 import qualified Ast.Types as AT
+import qualified Control.Monad.State as S
 import qualified Text.Megaparsec as M
 
 parseProgram :: String -> PU.Parser AT.Program
 parseProgram sourceFile = do
   _ <- PU.sc
-  types <- M.many $ M.try $ PU.lexeme PT.parseTypeDefinition
-  exprs <- M.many PE.parseExpr
-  return $ AT.Program {AT.globals = map globalExpr exprs, AT.types = map globalType types, AT.sourceFile = sourceFile}
+  S.modify $ PS.insertImport sourceFile
+  source <- preprocess
+  M.setInput source
+  components <- M.many $ M.choice [M.try parseTypeDefinition, parseExpr]
+  return $ AT.Program (concatMap AT.globals components) (concatMap AT.types components) sourceFile
+
+preprocess :: PU.Parser String
+preprocess = do
+  sources <- M.many $ M.choice [PI.parseImport preprocess, (: []) <$> M.anySingle]
+  return $ concat sources
+
+parseTypeDefinition :: PU.Parser AT.Program
+parseTypeDefinition = do
+  type' <- PU.lexeme PT.parseTypeDefinition
+  return $ AT.Program [] [globalType type'] ""
+
+parseExpr :: PU.Parser AT.Program
+parseExpr = do
+  expr <- PE.parseExpr
+  return $ AT.Program [globalExpr expr] [] ""
 
 globalExpr :: AT.Expr -> (String, AT.Expr)
 globalExpr e@(AT.Function {AT.funcName = name}) = (name, e)

lib/Ast/Parser/State.hs

@@ -1,18 +1,25 @@
 module Ast.Parser.State where
 
 import qualified Ast.Types as AT
+import qualified Data.Set as Set
 
 type TypeState = [(String, AT.Type)]
 
 type VarState = [(String, AT.Type)]
 
+data ImportState = ImportState
+  { visitedImports :: Set.Set String,
+    recursionDepth :: Int
+  }
+
 data ParserState = ParserState
   { typeState :: TypeState,
-    varState :: VarState
+    varState :: VarState,
+    importState :: ImportState
   }
 
 parserState :: ParserState
-parserState = ParserState {typeState = [], varState = []}
+parserState = ParserState [] [] (ImportState Set.empty 0)
 
 -- | Inserts a custom type into the environment.
 -- If the type already exists, it overwrites it.
@@ -21,10 +28,24 @@ insertType name t s = s {typeState = (name, t) : typeState s}
 
 -- | Looks up a custom type in the environment by its name.
 lookupType :: String -> ParserState -> Maybe AT.Type
-lookupType name (ParserState types _) = lookup name types
+lookupType name (ParserState {typeState = types}) = lookup name types
 
 insertVar :: String -> AT.Type -> ParserState -> ParserState
 insertVar name t s = s {varState = (name, t) : varState s}
 
 lookupVar :: String -> ParserState -> Maybe AT.Type
-lookupVar name (ParserState _ vars) = lookup name vars
+lookupVar name (ParserState {varState = vars}) = lookup name vars
+
+insertImport :: String -> ParserState -> ParserState
+insertImport i s@(ParserState _ _ (ImportState vi r)) = s {importState = ImportState (Set.insert i vi) r}
+
+lookupImport :: String -> ParserState -> Bool
+lookupImport i (ParserState _ _ (ImportState vi _))
+  | Set.member i vi = True
+  | otherwise = False
+
+setImportDepth :: Int -> ParserState -> ParserState
+setImportDepth d s@(ParserState _ _ (ImportState vi _)) = s {importState = ImportState vi d}
+
+getImportDepth :: ParserState -> Int
+getImportDepth (ParserState _ _ (ImportState _ d)) = d

lib/Ast/Parser/Utils.hs

@@ -10,7 +10,7 @@ import qualified Text.Megaparsec.Char.Lexer as ML
 import qualified Text.Megaparsec.Pos as MP
 
 -- | A type alias for the parser, based on `Parsec` with `Void` error type and `String` input.
-type Parser = M.ParsecT ParseErrorCustom String (S.State PS.ParserState)
+type Parser = M.ParsecT ParseErrorCustom String (S.StateT PS.ParserState IO)
 
 data ParseErrorCustom
   = UnknownType String