Skip to content

Commit 136792b

Browse files
safesparrowsafesparrow
committed
Some speed improvements
1 parent 3e4cd99 commit 136792b

9 files changed

Lines changed: 96 additions & 38 deletions

File tree

‎FSharp.sln‎

Lines changed: 0 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -107,8 +107,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution
107107
src\Compiler\FSComp.txt = src\Compiler\FSComp.txt
108108
EndProjectSection
109109
EndProject
110-
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "DiamondTest", "tests\DiamondTest\DiamondTest.fsproj", "{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}"
111-
EndProject
112110
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ParallelTypeCheckingTests", "tests\ParallelTypeCheckingTests\ParallelTypeCheckingTests.fsproj", "{59C31D40-97E0-4A69-ABD9-D316BD798ED8}"
113111
EndProject
114112
Global
@@ -433,18 +431,6 @@ Global
433431
{9C7523BA-7AB2-4604-A5FD-653E82C2BAD1}.Release|Any CPU.Build.0 = Release|Any CPU
434432
{9C7523BA-7AB2-4604-A5FD-653E82C2BAD1}.Release|x86.ActiveCfg = Release|Any CPU
435433
{9C7523BA-7AB2-4604-A5FD-653E82C2BAD1}.Release|x86.Build.0 = Release|Any CPU
436-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
437-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Debug|Any CPU.Build.0 = Debug|Any CPU
438-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Debug|x86.ActiveCfg = Debug|Any CPU
439-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Debug|x86.Build.0 = Debug|Any CPU
440-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Proto|Any CPU.ActiveCfg = Debug|Any CPU
441-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Proto|Any CPU.Build.0 = Debug|Any CPU
442-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Proto|x86.ActiveCfg = Debug|Any CPU
443-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Proto|x86.Build.0 = Debug|Any CPU
444-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Release|Any CPU.ActiveCfg = Release|Any CPU
445-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Release|Any CPU.Build.0 = Release|Any CPU
446-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Release|x86.ActiveCfg = Release|Any CPU
447-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC}.Release|x86.Build.0 = Release|Any CPU
448434
{59C31D40-97E0-4A69-ABD9-D316BD798ED8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
449435
{59C31D40-97E0-4A69-ABD9-D316BD798ED8}.Debug|Any CPU.Build.0 = Debug|Any CPU
450436
{59C31D40-97E0-4A69-ABD9-D316BD798ED8}.Debug|x86.ActiveCfg = Debug|Any CPU
@@ -489,7 +475,6 @@ Global
489475
{209C7D37-8C01-413C-8698-EC25F4C86976} = {B8DDA694-7939-42E3-95E5-265C2217C142}
490476
{BEC6E796-7E53-4888-AAFC-B8FD55C425DF} = {CE70D631-C5DC-417E-9CDA-B16097BEF1AC}
491477
{9C7523BA-7AB2-4604-A5FD-653E82C2BAD1} = {CE70D631-C5DC-417E-9CDA-B16097BEF1AC}
492-
{B7C957CB-9E64-44CF-BC73-152BFC6E5BCC} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449}
493478
{59C31D40-97E0-4A69-ABD9-D316BD798ED8} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449}
494479
EndGlobalSection
495480
GlobalSection(ExtensibilityGlobals) = postSolution

‎src/Compiler/Driver/ParseAndCheckInputs.fs‎

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -758,18 +758,26 @@ let ParseInputFilesInParallel (tcConfig: TcConfig, lexResourceManager, sourceFil
758758

759759
for fileName in sourceFiles do
760760
checkInputFile tcConfig fileName
761-
761+
762+
let sourceFiles =
763+
sourceFiles
764+
|> List.mapi (fun i f -> i, f)
765+
|> List.sortBy (fun (_i, f) -> -FileInfo(f).Length)
766+
762767
let sourceFiles = List.zip sourceFiles isLastCompiland
763768

764769
UseMultipleDiagnosticLoggers (sourceFiles, delayLogger, None) (fun sourceFilesWithDelayLoggers ->
765770
sourceFilesWithDelayLoggers
766-
|> ListParallel.map (fun ((fileName, isLastCompiland), delayLogger) ->
771+
|> ListParallel.map (fun (((idx, fileName), isLastCompiland), delayLogger) ->
767772
let directoryName = Path.GetDirectoryName fileName
768773

769774
let input =
770775
parseInputFileAux (tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayLogger, retryLocked)
771776

772-
(input, directoryName)))
777+
idx, (input, directoryName))
778+
|> List.sortBy fst
779+
|> List.map snd
780+
)
773781

774782
let ParseInputFilesSequential (tcConfig: TcConfig, lexResourceManager, sourceFiles, diagnosticsLogger: DiagnosticsLogger, retryLocked) =
775783
let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint

‎tests/ParallelTypeCheckingTests/Code/DependencyResolution.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -265,7 +265,7 @@ module internal DependencyResolution =
265265
let analyseEfficiency (result: DepsResult) : unit =
266266
let graph = result.Graph
267267
let edgeCount = graph |> Seq.sumBy (fun (KeyValue (_k, v)) -> v.Length)
268-
let t = graph |> Graph.transitive
268+
let t = graph |> Graph.transitiveOpt
269269
let edgeCountTransitive = t |> Seq.sumBy (fun (KeyValue (_k, v)) -> v.Length)
270270

271271
log $"Non-transitive edge count: {edgeCount}, transitive edge count: {edgeCountTransitive}"

‎tests/ParallelTypeCheckingTests/Code/Graph.fs‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,24 @@ module Graph =
4343

4444
addIfMissing missingNodes graph
4545

46+
47+
/// Create a transitive closure of the graph
48+
let transitiveOpt<'Node when 'Node: equality> (graph: Graph<'Node>) : Graph<'Node> =
49+
let go (node: 'Node) =
50+
let visited = HashSet<'Node>()
51+
let rec dfs (node: 'Node) =
52+
graph[node]
53+
|> Array.filter visited.Add
54+
|> Array.iter dfs
55+
dfs node
56+
visited
57+
|> Seq.toArray
58+
59+
graph.Keys
60+
|> Seq.toArray
61+
|> Array.Parallel.map (fun node -> node, go node)
62+
|> readOnlyDict
63+
4664
/// Create a transitive closure of the graph
4765
let transitive<'Node when 'Node: equality> (graph: Graph<'Node>) : Graph<'Node> =
4866
let rec calcTransitiveEdges =
@@ -89,3 +107,8 @@ module Graph =
89107
let json = JsonConvert.SerializeObject(graph, Formatting.Indented)
90108
printfn $"Serialising graph as JSON in {path}"
91109
File.WriteAllText(path, json)
110+
111+
module FileGraph =
112+
// open GiGraph.Dot
113+
let makeDotFile (_path : string) (_graph : Graph<File>) : unit =
114+
()

‎tests/ParallelTypeCheckingTests/Code/GraphProcessing.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -146,7 +146,7 @@ let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item: equality a
146146
(includeInFinalState: 'Item -> bool)
147147
(parallelism: int)
148148
: 'FinalFileResult[] * 'State =
149-
let transitiveDeps = graph |> Graph.transitive
149+
let transitiveDeps = graph |> Graph.transitiveOpt
150150
let dependants = graph |> Graph.reverse
151151

152152
let makeNode (item: 'Item) : Node<'Item, StateWrapper<'Item, 'State>, ResultWrapper<'Item, 'Result>> =

‎tests/ParallelTypeCheckingTests/Code/ParallelTypeChecking.fs‎

Lines changed: 22 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -113,19 +113,35 @@ let CheckMultipleInputsInParallel
113113
else
114114
graph
115115

116-
graph.Graph |> Graph.print
117-
118-
let graphDumpPath =
116+
let find (s : string) =
117+
let matches (f : File) = f.Name.Contains(s, StringComparison.InvariantCultureIgnoreCase)
118+
let files = graph.Files |> Array.filter (fun f -> matches f.File)
119+
let d =
120+
graph.Graph
121+
|> Seq.filter (fun (KeyValue(f, _deps)) -> matches f)
122+
|> Seq.map (fun (KeyValue(f, deps)) -> f, deps)
123+
|> dict
124+
125+
files
126+
|> Array.map (fun f -> f, d[f.File])
127+
128+
let _a = find "PostInferenceChecks.fsi"
129+
let _b = find "ConstraintSolver"
130+
131+
// graph.Graph |> Graph.print
132+
133+
let _graphDumpPath =
119134
let graphDumpName =
120135
tcConfig.outputFile
121136
|> Option.map Path.GetFileName
122137
|> Option.defaultValue "project"
123138

124139
$"{graphDumpName}.deps.json"
140+
125141

126-
graph.Graph
127-
|> Graph.map (fun n -> n.Name)
128-
|> Graph.serialiseToJson graphDumpPath
142+
// graph.Graph
143+
// |> Graph.map (fun n -> n.Name)
144+
// |> Graph.serialiseToJson graphDumpPath
129145

130146
let _ = ctok // TODO Use
131147
let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger

‎tests/ParallelTypeCheckingTests/Tests/TestCompilationFromCmdlineArgs.fs‎

Lines changed: 14 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -89,14 +89,22 @@ let internal codebaseToConfig code method =
8989
WorkingDir = Some code.WorkDir
9090
}
9191

92-
/// Before running these tests, you must prepare the codebase by running the script 'FCS.prepare.ps1'
9392
[<TestCaseSource(nameof (codebases))>]
94-
let ``Test graph-based type-checking`` (code: Codebase) =
95-
let config = codebaseToConfig code Method.Graph
93+
[<Explicit("Slow, only useful as a sanity check that the test codebase is sound and type-checks using the old method")>]
94+
let ``1. Test sequential type-checking`` (code: Codebase) =
95+
let config = codebaseToConfig code Method.Sequential
9696
TestCompilerFromArgs config
9797

98+
/// Before running these tests, you must prepare the codebase by running the script 'FCS.prepare.ps1'
9899
[<TestCaseSource(nameof (codebases))>]
99-
[<Explicit("Slow, only useful as a sanity check that the test codebase is sound and type-checks using the old method")>]
100-
let ``Test sequential type-checking`` (code: Codebase) =
101-
let config = codebaseToConfig code Method.Sequential
100+
// [<Explicit("Slow, only useful as a sanity check that the test codebase is sound and type-checks using the parallel-fs method")>]
101+
let ``2. Test parallelfs type-checking`` (code: Codebase) =
102+
let config = codebaseToConfig code Method.ParallelCheckingOfBackedImplFiles
102103
TestCompilerFromArgs config
104+
105+
/// Before running these tests, you must prepare the codebase by running the script 'FCS.prepare.ps1'
106+
[<TestCaseSource(nameof (codebases))>]
107+
let ``3. Test graph-based type-checking`` (code: Codebase) =
108+
let config = codebaseToConfig code Method.Graph
109+
TestCompilerFromArgs config
110+

‎tests/ParallelTypeCheckingTests/Tests/TestDependencyResolution.fs‎

Lines changed: 21 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -55,14 +55,13 @@ let ``Another failing FCS test`` () =
5555
let files =
5656
[|
5757
"A.fsi", """
58-
namespace FSharp.Compiler.CodeAnalysis
59-
type LegacyReferenceResolver = X of int
58+
namespace A.B.C
59+
type X = X of int
6060
"""
6161
"B.fsi", """
62-
[<System.Obsolete("This module is not for external use and may be removed in a future release of FSharp.Compiler.Service")>]
63-
module public FSharp.Compiler.CodeAnalysis.LegacyMSBuildReferenceResolver
64-
65-
val getResolver: unit -> LegacyReferenceResolver
62+
[<System.Obsolete("This is enough for the algorithm to consider this module AutoOpen")>]
63+
module public A.B.C.D
64+
val x: X
6665
"""
6766
|] |> buildFiles
6867

@@ -338,12 +337,26 @@ let analyseResult (result: DepsResult) =
338337
v |> Array.map (fun d -> result.Graph[d].Length) |> Array.max)
339338

340339
printfn $"TotalDeps: {totalDeps}, topFirstDeps: {topFirstDeps}"
340+
//
341+
// open GiGraph.Dot.Extensions
342+
// open GiGraph.Dot.Output.Options
343+
// let makeDotFile (path : string) (graph : Graph<File>) : unit =
344+
// let g = DotGraph(directed=true)
345+
// g.Layout.Direction <- DotLayoutDirection.LeftToRight
346+
// let name (f : File) = $"{f.QualifiedName}.{Path.GetExtension(f.Name)}"
347+
// graph
348+
// |> Graph.collectEdges
349+
// |> Array.iter (fun (a, b) -> g.Edges.Add(name a, name b) |> ignore)
350+
// let _options = DotFormattingOptions()
351+
// printfn $"{g.Build()}"
352+
// g.SaveToFile(path)
341353

342354
[<Test>]
343355
let ``Analyse hardcoded files`` () =
344356
let deps = DependencyResolution.detectFileDependencies sampleFiles
345357
printfn "Detected file dependencies:"
346358
deps.Graph |> Graph.print
359+
// makeDotFile "graph.dot" deps.Graph
347360

348361
let private parseProjectAndGetSourceFiles (projectFile: string) =
349362
//let cacheDir = "."
@@ -407,3 +420,5 @@ let ``Analyse whole projects and print statistics`` (projectFile: string) =
407420
v |> Array.map (fun d -> graph.Graph[d].Length) |> Array.max)
408421

409422
printfn $"TotalDeps: {totalDeps}, topFirstDeps: {topFirstDeps}, diff: {totalDeps - topFirstDeps}"
423+
424+
// makeDotFile "FCS.deps.dot" graph.Graph

‎tests/benchmarks/FCSBenchmarks/BenchmarkComparison/HistoricalBenchmark.fsproj‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,9 @@
6666
<HintPath>$(FSharpCoreDllPath)</HintPath>
6767
</Reference>
6868
</ItemGroup>
69+
<ItemGroup>
70+
<Content Include="runner.ipynb" />
71+
</ItemGroup>
6972

7073
<Target Name="FakeBuild" BeforeTargets="Build">
7174
<Message Text="Type=$(FcsReferenceType) FcsDllPath=$(FcsDllPath)" />

0 commit comments

Comments
 (0)