Merge pull request dotnet#17 from safesparrow/speed

.fantomasignore

@@ -12,7 +12,7 @@ artifacts/
 
 # Explicitly formatted Tests/ subdirectories (with exceptions)
 !tests/ParallelTypeCheckingTests/
-*/.checkouts/
+*/.fcs_test/
 
 # Explicitly unformatted implementation files
 

FSharp.sln

@@ -107,8 +107,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution
 		src\Compiler\FSComp.txt = src\Compiler\FSComp.txt
 	EndProjectSection
 EndProject
-Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "DiamondTest", "tests\DiamondTest\DiamondTest.fsproj", "{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}"
-EndProject
 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ParallelTypeCheckingTests", "tests\ParallelTypeCheckingTests\ParallelTypeCheckingTests.fsproj", "{59C31D40-97E0-4A69-ABD9-D316BD798ED8}"
 EndProject
 Global
@@ -433,18 +431,6 @@ Global
 		{9C7523BA-7AB2-4604-A5FD-653E82C2BAD1}.Release|Any CPU.Build.0 = Release|Any CPU
 		{9C7523BA-7AB2-4604-A5FD-653E82C2BAD1}.Release|x86.ActiveCfg = Release|Any CPU
 		{9C7523BA-7AB2-4604-A5FD-653E82C2BAD1}.Release|x86.Build.0 = Release|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Debug|Any CPU.Build.0 = Debug|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Debug|x86.ActiveCfg = Debug|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Debug|x86.Build.0 = Debug|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Proto|Any CPU.ActiveCfg = Debug|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Proto|Any CPU.Build.0 = Debug|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Proto|x86.ActiveCfg = Debug|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Proto|x86.Build.0 = Debug|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Release|Any CPU.ActiveCfg = Release|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Release|Any CPU.Build.0 = Release|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Release|x86.ActiveCfg = Release|Any CPU
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Release|x86.Build.0 = Release|Any CPU
 		{59C31D40-97E0-4A69-ABD9-D316BD798ED8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
 		{59C31D40-97E0-4A69-ABD9-D316BD798ED8}.Debug|Any CPU.Build.0 = Debug|Any CPU
 		{59C31D40-97E0-4A69-ABD9-D316BD798ED8}.Debug|x86.ActiveCfg = Debug|Any CPU
@@ -489,7 +475,6 @@ Global
 		{209C7D37-8C01-413C-8698-EC25F4C86976} = {B8DDA694-7939-42E3-95E5-265C2217C142}
 		{BEC6E796-7E53-4888-AAFC-B8FD55C425DF} = {CE70D631-C5DC-417E-9CDA-B16097BEF1AC}
 		{9C7523BA-7AB2-4604-A5FD-653E82C2BAD1} = {CE70D631-C5DC-417E-9CDA-B16097BEF1AC}
-		{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449}
 		{59C31D40-97E0-4A69-ABD9-D316BD798ED8} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449}
 	EndGlobalSection
 	GlobalSection(ExtensibilityGlobals) = postSolution

src/Compiler/Driver/CompilerConfig.fsi

@@ -205,8 +205,11 @@ type ParallelReferenceResolution =
 
 [<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>]

src/Compiler/Driver/CompilerOptions.fs

@@ -1392,6 +1392,11 @@ let testFlag tcConfigB =
                     { tcConfigB.typeCheckingConfig with
                         Mode = TypeCheckingMode.ParallelCheckingOfBackedImplFiles
                     }
+            | "GraphBasedChecking" ->
+                tcConfigB.typeCheckingConfig <-
+                    { tcConfigB.typeCheckingConfig with
+                        Mode = TypeCheckingMode.Graph
+                    }
 #if DEBUG
             | "ShowParserStackOnParseError" -> showParserStackOnParseError <- true
 #endif

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -759,17 +759,31 @@ let ParseInputFilesInParallel (tcConfig: TcConfig, lexResourceManager, sourceFil
     for fileName in sourceFiles do
         checkInputFile tcConfig fileName
 
+
+    // Order files to be parsed by size (descending). The idea is to process big files first,
+    // so that near the end when only some nodes are still processing items, it's the smallest items,
+    // which should reduce the period of time where only some nodes are busy.
+    // This requires some empirical evidence.        
+    let sourceFiles =
+        sourceFiles
+        |> List.mapi (fun i f -> i, f)
+        |> List.sortBy (fun (_i, f) -> -FileInfo(f).Length)
+
     let sourceFiles = List.zip sourceFiles isLastCompiland
 
     UseMultipleDiagnosticLoggers (sourceFiles, delayLogger, None) (fun sourceFilesWithDelayLoggers ->
         sourceFilesWithDelayLoggers
-        |> ListParallel.map (fun ((fileName, isLastCompiland), delayLogger) ->
+        |> ListParallel.map (fun (((idx, fileName), isLastCompiland), delayLogger) ->
             let directoryName = Path.GetDirectoryName fileName
 
             let input =
                 parseInputFileAux (tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayLogger, retryLocked)
 
-            (input, directoryName)))
+            idx, (input, directoryName))
+        // Bring back index-based order
+        |> List.sortBy fst
+        |> List.map snd
+    )
 
 let ParseInputFilesSequential (tcConfig: TcConfig, lexResourceManager, sourceFiles, diagnosticsLogger: DiagnosticsLogger, retryLocked) =
     let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint
@@ -1729,7 +1743,7 @@ let mutable typeCheckingMode: TypeCheckingMode = TypeCheckingMode.Sequential
 let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) =
     // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions
     let results, tcState =
-        match typeCheckingMode with
+        match tcConfig.typeCheckingConfig.Mode with
         | TypeCheckingMode.Sequential ->
             CheckMultipleInputsSequential(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs)
         | TypeCheckingMode.ParallelCheckingOfBackedImplFiles ->

tests/ParallelTypeCheckingTests/Code/ASTVisit.fs

@@ -1254,18 +1254,20 @@ module TopModulesExtraction =
                                 synAccessOption,
                                 range,
                                 synModuleOrNamespaceTrivia) ->
-            if mightHaveAutoOpen synAttributeLists then
-                // Contents of a module that's potentially AutoOpen are available from its parent without a prefix.
-                // Stay safe and as soon as the parent module is reachable, consider this module reachable as well
-                [| LongIdent.Empty |]
-            else
-            // 'module A.B' is equivalent to 'namespace A; module B', meaning that 'A' is opened implicitly
             if
-                synModuleOrNamespaceKind.IsModule && longId.Length > 1
+                mightHaveAutoOpen synAttributeLists && synModuleOrNamespaceKind.IsModule
             then
+                // Contents of a module that's potentially AutoOpen are available from its parent without a prefix.
+                // Stay safe and as soon as the parent module is reachable, consider this module reachable as well
                 [| longId.GetSlice(None, Some <| longId.Length - 2); longId |]
             else
-                [| longId |]
+                // 'module A.B' is equivalent to 'namespace A; module B', meaning that 'A' is opened implicitly
+                if
+                    synModuleOrNamespaceKind.IsModule && longId.Length > 1
+                then
+                    [| longId.GetSlice(None, Some <| longId.Length - 2); longId |]
+                else
+                    [| longId |]
     // TODO Temporarily disabled digging into the file's structure to avoid edge cases where another file depends on this file's namespace existing (but nothing else)
     // synModuleDecls
     // |> moduleDecls
@@ -1307,6 +1309,8 @@ module TopModulesExtraction =
                                 synAccessOption,
                                 range) ->
                 let idents =
+                    // TODO Fix this by making it similar to what happens in other places where we detect AutoOpen modules
+                    // Currently it doesn't matter, since we don't look within modules.
                     if mightHaveAutoOpen synAttributeLists then
                         // Contents of a module that's potentially AutoOpen are available everywhere, so treat it as if it had no name ('root' module).
                         [| LongIdent.Empty |]
@@ -1326,11 +1330,20 @@ module TopModulesExtraction =
                                    synAccessOption,
                                    range,
                                    synModuleOrNamespaceTrivia) ->
-            if mightHaveAutoOpen synAttributeLists then
-                // Contents of a module that's potentially AutoOpen are available everywhere, so treat it as if it had no name ('root' module).
-                [| LongIdent.Empty |]
+            if
+                mightHaveAutoOpen synAttributeLists && synModuleOrNamespaceKind.IsModule
+            then
+                // Contents of a module that's potentially AutoOpen are available from its parent without a prefix.
+                // Stay safe and as soon as the parent module is reachable, consider this module reachable as well
+                [| longId.GetSlice(None, Some <| longId.Length - 2); longId |]
             else
-                synModuleDecls |> moduleSigDecls |> combine longId
+                // 'module A.B' is equivalent to 'namespace A; module B', meaning that 'A' is opened implicitly
+                if
+                    synModuleOrNamespaceKind.IsModule && longId.Length > 1
+                then
+                    [| longId.GetSlice(None, Some <| longId.Length - 2); longId |]
+                else
+                    [| longId |]
 
     and moduleSigDecls (x: SynModuleSigDecl list) : Eit =
         let emptyState = Eit.Nested [||]

tests/ParallelTypeCheckingTests/Code/DependencyResolution.fs

@@ -260,31 +260,31 @@ module internal DependencyResolution =
         }
 
 /// <summary>
-/// Calculate and print some stats about the expected parallelism factor of a dependency graph
+/// Calculate and print some statistics about the expected parallelism factor of a dependency graph
 /// </summary>
 let analyseEfficiency (result: DepsResult) : unit =
     let graph = result.Graph
-    let totalSize1 = graph |> Seq.sumBy (fun (KeyValue (_k, v)) -> v.Length)
-    let t = graph |> Graph.transitive
-    let totalSize2 = t |> Seq.sumBy (fun (KeyValue (_k, v)) -> v.Length)
+    let edgeCount = graph |> Seq.sumBy (fun (KeyValue (_k, v)) -> v.Length)
+    let t = graph |> Graph.transitiveOpt
+    let edgeCountTransitive = t |> Seq.sumBy (fun (KeyValue (_k, v)) -> v.Length)
 
-    printfn $"Non-transitive size: {totalSize1}, transitive size: {totalSize2}"
+    log $"Non-transitive edge count: {edgeCount}, transitive edge count: {edgeCountTransitive}"
 
-    let totalFileSize = result.Files |> Array.sumBy (fun file -> int64 (file.CodeSize))
+    let fileCount = result.Files.Length
 
-    // Use depth-first search to calculate 'depth' of each file
+    // Use depth-first search to calculate 'depth' of a file
     let rec depthDfs =
         Utils.memoize (fun (file: File) ->
             let deepestChild =
                 match result.Graph[file] with
-                | [||] -> 0L
+                | [||] -> 0
                 | d -> d |> Array.map depthDfs |> Array.max
 
-            let depth = int64 (file.CodeSize) + deepestChild
+            let depth = 1 + deepestChild
             depth)
 
     // Run DFS for every file node, collect the maximum depth found
     let maxDepth = result.Files |> Array.map (fun f -> depthDfs f.File) |> Array.max
 
     log
-        $"Total file size: {totalFileSize}. Max depth: {maxDepth}. Max Depth/Size = %.1f{100.0 * double (maxDepth) / double (totalFileSize)}%%"
+        $"File count: {fileCount}. Longest path: {maxDepth}. Longest path/File count (a weak proxy for level of parallelism) = %.1f{100.0 * double maxDepth / double fileCount}%%"

tests/ParallelTypeCheckingTests/Code/FileInfoGathering.fs

@@ -23,7 +23,6 @@ let internal gatherBackingInfo (files: SourceFiles) : Files =
 
         {
             Idx = FileIdx.make i
-            Code = "no code here" // TODO
             AST = ASTOrFsix.AST f.AST
             FsiBacked = fsiBacked
         })

tests/ParallelTypeCheckingTests/Code/Graph.fs

@@ -42,6 +42,23 @@ module Graph =
             graph.Values |> Seq.toArray |> Array.concat |> Array.except graph.Keys
 
         addIfMissing missingNodes graph
+
+    /// Create a transitive closure of the graph
+    let transitiveOpt<'Node when 'Node: equality> (graph: Graph<'Node>) : Graph<'Node> =
+        let go (node: 'Node) =
+            let visited = HashSet<'Node>()
+            let rec dfs (node: 'Node) =
+                graph[node]
+                |> Array.filter visited.Add
+                |> Array.iter dfs
+            dfs node
+            visited
+            |> Seq.toArray
+
+        graph.Keys
+        |> Seq.toArray
+        |> Array.Parallel.map (fun node -> node, go node)
+        |> readOnlyDict
 
     /// Create a transitive closure of the graph
     let transitive<'Node when 'Node: equality> (graph: Graph<'Node>) : Graph<'Node> =

tests/ParallelTypeCheckingTests/Code/GraphProcessing.fs

@@ -104,6 +104,7 @@ let combineResults
     (deps: Node<'Item, 'State, 'Result>[])
     (transitiveDeps: Node<'Item, 'State, 'Result>[])
     (folder: 'State -> 'Result -> 'State)
+    (_foldingOrderer: 'Item -> int)
     : 'State =
     match deps with
     | [||] -> emptyState
@@ -127,7 +128,8 @@ let combineResults
             // Sort it by effectively file index.
             // For some reason this is needed, otherwise gives 'missing namespace' and other errors when using the resulting state.
             // Does this make sense? Should the results be foldable in any order?
-            |> Array.sortBy (fun d -> d.Info.Item)
+            // TODO Use _foldingOrderer
+            |> Array.sortBy (fun node -> node.Info.Item)
             |> Array.filter (fun dep -> included.Contains dep.Info.Item = false)
             |> Array.distinctBy (fun dep -> dep.Info.Item)
             |> Array.map (fun dep -> dep.Result |> orFail |> snd)
@@ -140,11 +142,12 @@ let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item: equality a
     (graph: Graph<'Item>)
     (doWork: 'Item -> 'State -> 'Result)
     (folder: 'State -> 'Result -> 'FinalFileResult * 'State)
+    (foldingOrderer: 'Item -> int)
     (emptyState: 'State)
     (includeInFinalState: 'Item -> bool)
     (parallelism: int)
     : 'FinalFileResult[] * 'State =
-    let transitiveDeps = graph |> Graph.transitive
+    let transitiveDeps = graph |> Graph.transitiveOpt
     let dependants = graph |> Graph.reverse
 
     let makeNode (item: 'Item) : Node<'Item, StateWrapper<'Item, 'State>, ResultWrapper<'Item, 'Result>> =
@@ -208,7 +211,7 @@ let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item: equality a
         let folder x y = folder x y |> snd
         let deps = lookupMany node.Info.Deps
         let transitiveDeps = lookupMany node.Info.TransitiveDeps
-        let inputState = combineResults emptyState deps transitiveDeps folder
+        let inputState = combineResults emptyState deps transitiveDeps folder foldingOrderer
         node.InputState <- Some inputState
         let singleRes = doWork node.Info.Item inputState.State