Parallel type-checking in compilation (behind a feature flag)

src/Compiler/Driver/CompilerConfig.fs

@@ -47,6 +47,9 @@ let FSharpScriptFileSuffixes = [ ".fsscript"; ".fsx" ]
 let FSharpIndentationAwareSyntaxFileSuffixes =
     [ ".fs"; ".fsscript"; ".fsx"; ".fsi" ]
 
+let FsharpExperimentalFeaturesEnabledAutomatically =
+    Environment.GetEnvironmentVariable("FSHARP_EXPERIMENTAL_FEATURES") |> isNotNull
+
 //--------------------------------------------------------------------------
 // General file name resolver
 //--------------------------------------------------------------------------
@@ -393,6 +396,15 @@ type ParallelReferenceResolution =
     | On
     | Off
 
+[<RequireQualifiedAccess>]
+type TypeCheckingMode =
+    | Sequential
+    | ParallelCheckingOfBackedImplFiles
+    | Graph
+
+[<RequireQualifiedAccess>]
+type TypeCheckingConfig = { Mode: TypeCheckingMode }
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     {
@@ -507,7 +519,6 @@ type TcConfigBuilder =
         mutable emitTailcalls: bool
         mutable deterministic: bool
         mutable concurrentBuild: bool
-        mutable parallelCheckingWithSignatureFiles: bool
         mutable emitMetadataAssembly: MetadataAssemblyGeneration
         mutable preferredUiLang: string option
         mutable lcid: int option
@@ -588,6 +599,8 @@ type TcConfigBuilder =
         mutable exiter: Exiter
 
         mutable parallelReferenceResolution: ParallelReferenceResolution
+
+        mutable typeCheckingConfig: TypeCheckingConfig
     }
 
     // Directories to start probing in
@@ -734,7 +747,6 @@ type TcConfigBuilder =
             emitTailcalls = true
             deterministic = false
             concurrentBuild = true
-            parallelCheckingWithSignatureFiles = false
             emitMetadataAssembly = MetadataAssemblyGeneration.None
             preferredUiLang = None
             lcid = None
@@ -777,6 +789,14 @@ type TcConfigBuilder =
             xmlDocInfoLoader = None
             exiter = QuitProcessExiter
             parallelReferenceResolution = ParallelReferenceResolution.Off
+            typeCheckingConfig =
+                {
+                    TypeCheckingConfig.Mode =
+                        if FsharpExperimentalFeaturesEnabledAutomatically then
+                            TypeCheckingMode.Graph
+                        else
+                            TypeCheckingMode.Sequential
+                }
         }
 
     member tcConfigB.FxResolver =
@@ -1288,7 +1308,6 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.emitTailcalls = data.emitTailcalls
     member _.deterministic = data.deterministic
     member _.concurrentBuild = data.concurrentBuild
-    member _.parallelCheckingWithSignatureFiles = data.parallelCheckingWithSignatureFiles
     member _.emitMetadataAssembly = data.emitMetadataAssembly
     member _.pathMap = data.pathMap
     member _.langVersion = data.langVersion
@@ -1322,6 +1341,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.xmlDocInfoLoader = data.xmlDocInfoLoader
     member _.exiter = data.exiter
     member _.parallelReferenceResolution = data.parallelReferenceResolution
+    member _.typeCheckingConfig = data.typeCheckingConfig
 
     static member Create(builder, validate) =
         use _ = UseBuildPhase BuildPhase.Parameter

src/Compiler/Driver/CompilerConfig.fsi

@@ -203,6 +203,18 @@ type ParallelReferenceResolution =
     | On
     | Off
 
+[<RequireQualifiedAccess>]
+type TypeCheckingMode =
+    /// Default mode where all source files are processed sequentially in compilation order.
+    | Sequential
+    /// Signature files and implementation files without backing files are processed sequentially, then backed implementation files are processed in parallel.
+    | ParallelCheckingOfBackedImplFiles
+    /// Parallel type-checking that uses automated file-to-file dependency detection to construct a highly-parallelisable file graph.
+    | Graph
+
+[<RequireQualifiedAccess>]
+type TypeCheckingConfig = { Mode: TypeCheckingMode }
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     {
@@ -412,8 +424,6 @@ type TcConfigBuilder =
 
         mutable concurrentBuild: bool
 
-        mutable parallelCheckingWithSignatureFiles: bool
-
         mutable emitMetadataAssembly: MetadataAssemblyGeneration
 
         mutable preferredUiLang: string option
@@ -491,6 +501,8 @@ type TcConfigBuilder =
         mutable exiter: Exiter
 
         mutable parallelReferenceResolution: ParallelReferenceResolution
+
+        mutable typeCheckingConfig: TypeCheckingConfig
     }
 
     static member CreateNew:
@@ -734,8 +746,6 @@ type TcConfig =
 
     member concurrentBuild: bool
 
-    member parallelCheckingWithSignatureFiles: bool
-
     member emitMetadataAssembly: MetadataAssemblyGeneration
 
     member pathMap: PathMap
@@ -858,6 +868,8 @@ type TcConfig =
 
     member parallelReferenceResolution: ParallelReferenceResolution
 
+    member typeCheckingConfig: TypeCheckingConfig
+
 /// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig,
 /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder.
 [<Sealed>]

src/Compiler/Driver/CompilerOptions.fs

@@ -1393,7 +1393,16 @@ let testFlag tcConfigB =
             | "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true
             | "ContinueAfterParseFailure" -> tcConfigB.continueAfterParseFailure <- true
             | "ParallelOff" -> tcConfigB.concurrentBuild <- false
-            | "ParallelCheckingWithSignatureFilesOn" -> tcConfigB.parallelCheckingWithSignatureFiles <- true
+            | "ParallelCheckingWithSignatureFilesOn" ->
+                tcConfigB.typeCheckingConfig <-
+                    { tcConfigB.typeCheckingConfig with
+                        Mode = TypeCheckingMode.ParallelCheckingOfBackedImplFiles
+                    }
+            | "GraphBasedChecking" ->
+                tcConfigB.typeCheckingConfig <-
+                    { tcConfigB.typeCheckingConfig with
+                        Mode = TypeCheckingMode.Graph
+                    }
 #if DEBUG
             | "ShowParserStackOnParseError" -> showParserStackOnParseError <- true
 #endif

src/Compiler/Driver/GraphChecking/Continuation.fs

@@ -0,0 +1,7 @@
+[<RequireQualifiedAccess>]
+module internal Continuation
+
+let rec sequence<'a, 'ret> (recursions: (('a -> 'ret) -> 'ret) list) (finalContinuation: 'a list -> 'ret) : 'ret =
+    match recursions with
+    | [] -> [] |> finalContinuation
+    | recurse :: recurses -> recurse (fun ret -> sequence recurses (fun rets -> ret :: rets |> finalContinuation))

src/Compiler/Driver/GraphChecking/DependencyResolution.fs

@@ -0,0 +1,218 @@
+module internal FSharp.Compiler.GraphChecking.DependencyResolution
+
+open FSharp.Compiler.Syntax
+
+// This code just looks for a path in the trie
+// It could be cached and is easy to reason about.
+let queryTrie (trie: TrieNode) (path: ModuleSegment list) : QueryTrieNodeResult =
+    let rec visit (currentNode: TrieNode) (path: ModuleSegment list) =
+        match path with
+        | [] -> failwith "path should not be empty"
+        | [ lastNodeFromPath ] ->
+            match currentNode.Children.TryGetValue(lastNodeFromPath) with
+            | false, _ -> QueryTrieNodeResult.NodeDoesNotExist
+            | true, childNode ->
+                if Set.isEmpty childNode.Files then
+                    QueryTrieNodeResult.NodeDoesNotExposeData
+                else
+                    QueryTrieNodeResult.NodeExposesData(childNode.Files)
+        | currentPath :: restPath ->
+            match currentNode.Children.TryGetValue(currentPath) with
+            | false, _ -> QueryTrieNodeResult.NodeDoesNotExist
+            | true, childNode -> visit childNode restPath
+
+    visit trie path
+
+let queryTrieMemoized (trie: TrieNode) : QueryTrie =
+    Internal.Utilities.Library.Tables.memoize (queryTrie trie)
+
+// Now how to detect the deps between files?
+// Process the content of each file using some state
+
+let processOwnNamespace (queryTrie: QueryTrie) (path: ModuleSegment list) (state: FileContentQueryState) : FileContentQueryState =
+    let queryResult = queryTrie path
+
+    match queryResult with
+    | QueryTrieNodeResult.NodeDoesNotExist -> state
+    | QueryTrieNodeResult.NodeDoesNotExposeData -> state.AddOwnNamespace path
+    | QueryTrieNodeResult.NodeExposesData files -> state.AddOwnNamespace(path, files)
+
+// Helper function to process a open statement
+// The statement could link to files and/or should be tracked as an open namespace
+let processOpenPath (queryTrie: QueryTrie) (path: ModuleSegment list) (state: FileContentQueryState) : FileContentQueryState =
+    let queryResult = queryTrie path
+
+    match queryResult with
+    | QueryTrieNodeResult.NodeDoesNotExist -> state
+    | QueryTrieNodeResult.NodeDoesNotExposeData -> state.AddOpenNamespace path
+    | QueryTrieNodeResult.NodeExposesData files -> state.AddOpenNamespace(path, files)
+
+// Helper function to process an identifier
+let processIdentifier (queryTrie: QueryTrie) (path: ModuleSegment list) (state: FileContentQueryState) : FileContentQueryState =
+    let queryResult = queryTrie path
+
+    match queryResult with
+    | QueryTrieNodeResult.NodeDoesNotExist -> state
+    | QueryTrieNodeResult.NodeDoesNotExposeData ->
+        // This can occur when you have a file that uses a known namespace (for example namespace System).
+        // When any other code uses that System namespace it won't find anything in the user code.
+        state
+    | QueryTrieNodeResult.NodeExposesData files -> state.AddDependencies files
+
+// Typically used to folder FileContentEntry items over a FileContentQueryState
+let rec processStateEntry (queryTrie: QueryTrie) (state: FileContentQueryState) (entry: FileContentEntry) : FileContentQueryState =
+    match entry with
+    | FileContentEntry.TopLevelNamespace (topLevelPath, content) ->
+        let state =
+            match topLevelPath with
+            | [] -> state
+            | _ -> processOwnNamespace queryTrie topLevelPath state
+
+        List.fold (processStateEntry queryTrie) state content
+
+    | FileContentEntry.OpenStatement path ->
+        // An open statement can directly reference file or be a partial open statement
+        // Both cases need to be processed.
+        let stateAfterFullOpenPath = processOpenPath queryTrie path state
+
+        // Any existing open statement could be extended with the current path (if that node where to exists in the trie)
+        // The extended path could add a new link (in case of a module or namespace with types)
+        // It might also not add anything at all (in case it the extended path is still a partial one)
+        (stateAfterFullOpenPath, state.OpenNamespaces)
+        ||> Set.fold (fun acc openNS -> processOpenPath queryTrie [ yield! openNS; yield! path ] acc)
+
+    | FileContentEntry.PrefixedIdentifier path ->
+        match path with
+        | [] ->
+            // should not be possible though
+            state
+        | _ ->
+            // path could consist out of multiple segments
+            (state, [| 1 .. path.Length |])
+            ||> Array.fold (fun state takeParts ->
+                let path = List.take takeParts path
+                // process the name was if it were a FQN
+                let stateAfterFullIdentifier = processIdentifier queryTrie path state
+
+                // Process the name in combination with the existing open namespaces
+                (stateAfterFullIdentifier, state.OpenNamespaces)
+                ||> Set.fold (fun acc openNS -> processIdentifier queryTrie [ yield! openNS; yield! path ] acc))
+
+    | FileContentEntry.NestedModule (nestedContent = nestedContent) ->
+        // We don't want our current state to be affect by any open statements in the nested module
+        let nestedState = List.fold (processStateEntry queryTrie) state nestedContent
+        // Afterward we are only interested in the found dependencies in the nested module
+        let foundDependencies =
+            Set.union state.FoundDependencies nestedState.FoundDependencies
+
+        { state with
+            FoundDependencies = foundDependencies
+        }
+
+let getFileNameBefore (files: FileWithAST array) idx =
+    files[0 .. (idx - 1)] |> Array.map (fun f -> f.Idx) |> Set.ofArray
+
+/// Returns files contain in any node of the given Trie
+let indicesUnderNode (node: TrieNode) : Set<int> =
+    let rec collect (node: TrieNode) (continuation: int list -> int list) : int list =
+        let continuations: ((int list -> int list) -> int list) list =
+            [
+                for node in node.Children.Values do
+                    yield collect node
+            ]
+
+        let finalContinuation indexes =
+            continuation [ yield! node.Files; yield! List.collect id indexes ]
+
+        Continuation.sequence continuations finalContinuation
+
+    Set.ofList (collect node id)
+
+/// <summary>
+/// For a given file's content, find all missing ("ghost") file dependencies that are required to satisfy the type-checker.
+/// </summary>
+/// <remarks>
+/// A "ghost" dependency is a link between files that actually should be avoided.
+/// The user has a partial namespace or opens a namespace that does not produce anything.
+/// In order to still be able to compile the current file, the given namespace should be known to the file.
+/// We did not find it via the trie, because there are no files that contribute to this namespace.
+/// </remarks>
+let collectGhostDependencies (fileIndex: int) (trie: TrieNode) (queryTrie: QueryTrie) (result: FileContentQueryState) =
+    // Go over all open namespaces, and assert all those links eventually went anywhere
+    Set.toArray result.OpenedNamespaces
+    |> Array.collect (fun path ->
+        match queryTrie path with
+        | QueryTrieNodeResult.NodeExposesData _
+        | QueryTrieNodeResult.NodeDoesNotExist -> Array.empty
+        | QueryTrieNodeResult.NodeDoesNotExposeData ->
+            // At this point we are following up if an open namespace really lead nowhere.
+            let node =
+                let rec visit (node: TrieNode) (path: ModuleSegment list) =
+                    match path with
+                    | [] -> node
+                    | head :: tail -> visit node.Children[head] tail
+
+                visit trie path
+
+            let children = indicesUnderNode node |> Set.filter (fun idx -> idx < fileIndex)
+            let intersection = Set.intersect result.FoundDependencies children
+
+            if Set.isEmpty intersection then
+                // The partial open did not lead to anything
+                // In order for it to exist in the current file we need to link it
+                // to some file that introduces the namespace in the trie.
+                if Set.isEmpty children then
+                    // In this case not a single file is contributing to the opened namespace.
+                    // As a last resort we assume all files are dependent, in order to preserve valid code.
+                    [| 0 .. (fileIndex - 1) |]
+                else
+                    [| Seq.head children |]
+            else
+                // The partial open did eventually lead to a link in a file
+                Array.empty)
+
+let mkGraph (filePairs: FilePairMap) (files: FileWithAST array) : Graph<int> =
+    // Implementation files backed by signatures should be excluded to construct the trie.
+    let trieInput =
+        Array.choose
+            (fun f ->
+                match f.AST with
+                | ParsedInput.SigFile _ -> Some f
+                | ParsedInput.ImplFile _ -> if filePairs.HasSignature f.Idx then None else Some f)
+            files
+
+    let trie = TrieMapping.mkTrie trieInput
+    let queryTrie: QueryTrie = queryTrieMemoized trie
+
+    let fileContents = Array.Parallel.map FileContentMapping.mkFileContent files
+
+    let findDependencies (file: FileWithAST) : int * int array =
+        let fileContent = fileContents[file.Idx]
+        let knownFiles = getFileNameBefore files file.Idx
+        let filesFromRoot = trie.Files |> Set.filter (fun rootIdx -> rootIdx < file.Idx)
+
+        // Process all entries of a file and query the trie when required to find the dependent files.
+        let result =
+            // Seq is faster than List in this case.
+            Seq.fold (processStateEntry queryTrie) (FileContentQueryState.Create file.Idx knownFiles filesFromRoot) fileContent
+
+        // after processing the file we should verify if any of the open statements are found in the trie but do not yield any file link.
+        let ghostDependencies = collectGhostDependencies file.Idx trie queryTrie result
+
+        // Automatically add a link from an implementation to its signature file (if present)
+        let signatureDependency =
+            match filePairs.TryGetSignatureIndex file.Idx with
+            | None -> Array.empty
+            | Some sigIdx -> Array.singleton sigIdx
+
+        let allDependencies =
+            [|
+                yield! result.FoundDependencies
+                yield! ghostDependencies
+                yield! signatureDependency
+            |]
+            |> Array.distinct
+
+        file.Idx, allDependencies
+
+    Array.Parallel.map findDependencies files |> readOnlyDict