Implement support for file includes

src/Visp.Compiler/CoreParser.fs

@@ -29,10 +29,77 @@ type ParserOptions =
 
 
 module CoreParser =
+    open Visp.Compiler.Syntax
+    open System.Collections.Generic
+
     let getLibFilePath name =
         let src_dir = __SOURCE_DIRECTORY__
         Path.Combine(src_dir, "..", "..", "visp", "lib", name) |> Path.GetFullPath
 
+    let parseFile filePath (options: ParserOptions) =
+        let (stream, reader, lexbuf) = UnicodeFileAsLexbuf(filePath, None)
+
+        use _ = stream
+        use _ = reader
+
+        let tokenizer = ParseUtils.mkTokenizer options.DebugTokens
+
+        try
+            let mutable res = start tokenizer lexbuf
+
+            if options.DebugParse then
+                eprintfn "%A" res
+
+            if options.ReturnLast then
+                res <- Transforms.LastExpressionUpdater.update res
+
+            res
+        with :? ParseHelpers.SyntaxError as syn ->
+            outputSyntaxError syn
+
+            reraise ()
+
+    let pathsToFile = Dictionary<string, ParsedFile>()
+
+    let includeFiles = Dictionary<string, SynModuleDecl list>()
+
+    let rec readIncludeFiles (ParsedFile _ as file) =
+        let rec readFilePath rootPath (FilePath(path, range) as fp) =
+            let path = System.IO.Path.Combine(rootPath, path.Path) |> System.IO.Path.GetFullPath
+
+            let nestedDecls =
+                match dictTryFind path includeFiles with
+                | Some(it) -> it
+                | None ->
+                    let parsed = parseFile path ParserOptions.Library |> readIncludeFiles
+                    pathsToFile.Add(path, parsed)
+                    let (ParsedFile fragments) = parsed
+
+                    let nestedDecls =
+                        fragments
+                        |> List.collect (fun (ParsedFileFragment.AnonModule(decls, _)) -> decls)
+
+                    includeFiles.Add(path, nestedDecls)
+
+                    nestedDecls
+
+            SynModuleDecl.IncludedModule(fp, nestedDecls, range)
+
+        and readInclude =
+            function
+            | SynModuleDecl.Include(paths, range) as _ ->
+
+                let filePath =
+                    System.IO.Path.GetDirectoryName range.FileName |> System.IO.Path.GetFullPath
+
+                let includedModules = paths |> List.map (readFilePath filePath)
+
+                SynModuleDecl.ModuleList(includedModules, range)
+
+            | it -> it
+
+        Transforms.Helpers.transformSynModuleDecls readInclude file
+
     let private tfs =
         [| Transforms.SyntaxMacros.expand
            Transforms.QuasiquoteExpander.expand
@@ -44,6 +111,7 @@ module CoreParser =
 
     let transformFile file =
         file
+        |> readIncludeFiles
         |> Transforms.StringLifter.liftLiteralStrings
         |> Transforms.Helpers.transformParsedFile expandExpr
 
@@ -94,36 +162,6 @@ let state = { Todo = () }
             eprintfn "Message: %A" ctx.Message
         | _ -> ()
 
-    let parseFile filePath (options: ParserOptions) =
-        let (stream, reader, lexbuf) = UnicodeFileAsLexbuf(filePath, None)
-
-        use _ = stream
-        use _ = reader
-
-        let tokenizer = ParseUtils.mkTokenizer options.DebugTokens
-
-        try
-            let mutable res = start tokenizer lexbuf
-
-            if options.DebugParse then
-                eprintfn "%A" res
-
-            // eprintfn "%s" (res.Pretty())
-
-            if options.ReturnLast then
-                res <- Transforms.LastExpressionUpdater.update res
-            // eprintfn "%A" res
-
-            // use outputStream = new StringWriter()
-            // writeToStreamNew res outputStream filePath
-            // printfn "%s" (outputStream.ToString())
-
-            res
-        with :? ParseHelpers.SyntaxError as syn ->
-            outputSyntaxError syn
-
-            reraise ()
-
     let debugLexFile filePath =
         let (stream, reader, lexbuf) = UnicodeFileAsLexbuf(filePath, None)
         use _ = stream

src/Visp.Compiler/Parser.fsy

@@ -40,7 +40,7 @@ let mkRecoveryPat s = Syntax.parserRecoveryPat (lhs s)
 %token OPEN MODULE
 %token FN FNSTAR LET USE VAL STATIC LET_BANG USE_BANG DO_BANG LETSTAR MUT SET DOT NEW NEWOBJ DOT_BRACKET DOT_PLUS IF_KW BEGIN_KW DO_KW QUOTE_KW UNQUOTE_KW SPLICE_UNQUOTE_KW QUASIQUOTE_KW
 %token ATOM_KW DEREF_KW WHILE TYPE TYPEALIAS INTERFACE RECORD MEMBER MEMBERS MEMBERFN MEMBER_GET MEMBER_SET OVERRIDE MACRO MATCH WHEN REQUIRE
-%token THREAD_FIRST THREAD_LAST SYNTAX_MACRO SEQ UNION
+%token THREAD_FIRST THREAD_LAST SYNTAX_MACRO SEQ UNION INCLUDE
 %token INLINE REC RINIT
 %token <bool> YIELD
 %token <bool> RETURN
@@ -246,6 +246,30 @@ module_help:
     | REQUIRE symbol STRING
         { let (raw, _, _) = $3
           SynModuleDecl.Require($2, raw, lhs parseState) }
+    | INCLUDE file_path
+        { SynModuleDecl.Include([$2], lhs parseState) }
+    | INCLUDE file_path file_path_list
+        { SynModuleDecl.Include($2 :: $3, lhs parseState) }
+
+file_path:
+    | STRING
+        { let (raw, _, _) = $1
+          FilePath (NormalizedPath(raw), rhs parseState 1) }
+
+file_path_list: rev_file_path_list { List.rev $1 }
+rev_file_path_list:
+    | file_path { [$1] }
+    | rev_file_path_list file_path { $2 :: $1 }
+
+syn_string:
+    | STRING
+        { let (raw, kind, _) = $1
+          SynString (raw, kind, rhs parseState 1) }
+
+string_list: rev_string_list { List.rev $1 }
+rev_string_list:
+    | syn_string { [$1] }
+    | rev_string_list syn_string { $2 :: $1 }
 
 syn_symbol:
     | SYMBOL {Syntax.mkSynSymbol $1 (rhs parseState 1)}