Skip to content

Commit 9f83dc3

Browse files
safesparrowsafesparrow
committed
* Treat type abbreviations same as module abbreviations - assume file depends on everything
* Add more tests * Add an edge case * Force add fs -> fsi edges to the graph * Short-circuit compilation with a flag for testing * Use concurrent dicts to avoid race conditions
1 parent b2879cf commit 9f83dc3

17 files changed

Lines changed: 184 additions & 168 deletions

‎src/Compiler/Driver/ParseAndCheckInputs.fs‎

Lines changed: 10 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
module internal FSharp.Compiler.ParseAndCheckInputs
55

66
open System
7+
open System.Collections.Concurrent
78
open System.Diagnostics
89
open System.IO
910
open System.Collections.Generic
@@ -1394,13 +1395,11 @@ let CheckOneInput
13941395
)
13951396
}
13961397

1397-
type FsiBackedInfo =
1398-
Import.ImportMap * string list option * ModuleOrNamespaceType *
1399-
bool * ParsedImplFileInput * TcState * ModuleOrNamespaceType
1398+
type FsiBackedInfo = ModuleOrNamespaceType
14001399

1401-
let mutable asts = Dictionary<string, ParsedInput>()
1400+
let mutable asts = ConcurrentDictionary<string, ParsedInput>()
14021401

1403-
let mutable fsiBackedInfos = Dictionary<string, FsiBackedInfo>()
1402+
let mutable fsiBackedInfos = ConcurrentDictionary<string, ModuleOrNamespaceType>()
14041403

14051404
/// Typecheck a single file (or interactive entry into F# Interactive)
14061405
let CheckOneInputAux'
@@ -1463,6 +1462,11 @@ let CheckOneInputAux'
14631462
let m = qualNameOfFile.Range
14641463
TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcEnv (prefixPath, m)
14651464

1465+
1466+
// Save info needed for type-checking .fs file later on
1467+
printfn $"[{Thread.CurrentThread.ManagedThreadId}] Saving fsiBackedInfos for {file.FileName}"
1468+
fsiBackedInfos[file.FileName] <- sigFileType
1469+
14661470
printfn $"Finished Processing Sig {file.FileName}"
14671471
return fun tcState ->
14681472
printfn $"Applying Sig {file.FileName}"
@@ -1482,56 +1486,8 @@ let CheckOneInputAux'
14821486
tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
14831487
}
14841488
partialResult, tcState
1485-
1486-
// Create dedicated state & some data for the .fs file type-checking later on - save it in a dict
1487-
let fsTcState =
1488-
// let hadSig = true
1489-
// Add dummy .fs results
1490-
// Adjust the TcState as if it has been checked, which makes the signature for the file available later
1491-
// in the compilation order.
1492-
let tcStateForImplFile = tcState
1493-
let fsName = file.FileName.TrimEnd('i')
1494-
// let fsQualifiedName = asts[fsName].QualifiedName
1495-
// let qualNameOfFile = fsQualifiedName
1496-
let priorErrors = checkForErrors ()
1497-
//
1498-
// // Add dummy TcState so that others can use this file through the .fsi stuff, without type-checking .fs
1499-
// // Don't use it for this file's type-checking - it will cause duplicates
1500-
// let ccuSigForFile, tcState =
1501-
// AddCheckResultsToTcState
1502-
// (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, sigFileType)
1503-
// tcState
1504-
1505-
// Save info needed for type-checking .fs file later on
1506-
// TODO Remove most of this
1507-
let fsiBackedInfo: FsiBackedInfo =
1508-
let ast = asts[fsName]
1509-
let file =
1510-
match ast with
1511-
| ParsedInput.ImplFile parsedImplFileInput -> parsedImplFileInput
1512-
| ParsedInput.SigFile _ -> failwith "Unexpected SigFile"
1513-
amap, conditionalDefines, sigFileType, priorErrors, file, tcStateForImplFile, sigFileType
1514-
1515-
fsiBackedInfos[file.FileName] <- fsiBackedInfo
1516-
1517-
printfn $"Finished Applying Sig {file.FileName}"
1518-
tcState
1519-
//
1520-
// let _, finalTcState =
1521-
// match dummyFsPartialResult with
1522-
// | amap, _conditionalDefines, rootSig, _priorErrors, file, tcStateForImplFile, _ccuSigForFile ->
1523-
// AddDummyCheckResultsToTcState(
1524-
// tcGlobals,
1525-
// amap,
1526-
// file.QualifiedName,
1527-
// prefixPathOpt,
1528-
// tcSink,
1529-
// fsTcState,
1530-
// tcStateForImplFile,
1531-
// rootSig
1532-
// )
15331489

1534-
fsiPartialResult, fsTcState
1490+
fsiPartialResult, tcState
15351491

15361492
| ParsedInput.ImplFile file ->
15371493
printfn $"Processing Impl {file.FileName}"

‎src/Compiler/Driver/ParseAndCheckInputs.fsi‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -151,11 +151,9 @@ val AddCheckResultsToTcState :
151151

152152
type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType
153153

154-
type FsiBackedInfo =
155-
Import.ImportMap * string list option * ModuleOrNamespaceType *
156-
bool * ParsedImplFileInput * TcState * ModuleOrNamespaceType
154+
type FsiBackedInfo = ModuleOrNamespaceType
157155

158-
val mutable fsiBackedInfos : System.Collections.Generic.Dictionary<string, FsiBackedInfo>
156+
val mutable fsiBackedInfos : System.Collections.Concurrent.ConcurrentDictionary<string, ModuleOrNamespaceType>
159157

160158
type CheckArgs = CompilationThreadToken * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list
161159

@@ -178,7 +176,7 @@ val CheckOneInput:
178176
skipImplIfSigExists: bool ->
179177
Cancellable<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState>
180178

181-
val mutable asts : System.Collections.Generic.Dictionary<string, ParsedInput>
179+
val mutable asts : System.Collections.Concurrent.ConcurrentDictionary<string, ParsedInput>
182180

183181
/// Check one input, returned as an Eventually computation
184182
val CheckOneInput':

‎src/Compiler/Driver/fsc.fs‎

Lines changed: 45 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -139,7 +139,7 @@ type ConsoleLoggerProvider() =
139139
/// Notify the exiter if any error has occurred
140140
let AbortOnError (diagnosticsLogger: DiagnosticsLogger, exiter: Exiter) =
141141
if diagnosticsLogger.ErrorCount > 0 then
142-
exiter.Exit 1
142+
exiter.Exit diagnosticsLogger.ErrorCount
143143

144144
let TypeCheck
145145
(
@@ -690,28 +690,30 @@ let main1
690690

691691
let tcState, topAttrs, typedAssembly, _tcEnvAtEnd =
692692
TypeCheck(ctok, tcConfig, tcImports, tcGlobals, diagnosticsLogger, assemblyName, tcEnv0, openDecls0, inputs, exiter)
693-
694-
AbortOnError(diagnosticsLogger, exiter)
693+
694+
let args =
695+
Args(
696+
ctok,
697+
tcGlobals,
698+
tcImports,
699+
frameworkTcImports,
700+
tcState.Ccu,
701+
typedAssembly,
702+
topAttrs,
703+
tcConfig,
704+
outfile,
705+
pdbfile,
706+
assemblyName,
707+
diagnosticsLogger,
708+
exiter,
709+
ilSourceDocs
710+
)
695711
ReportTime tcConfig "Typechecked"
696-
697712
typeCheck.Dispose()
698713

699-
Args(
700-
ctok,
701-
tcGlobals,
702-
tcImports,
703-
frameworkTcImports,
704-
tcState.Ccu,
705-
typedAssembly,
706-
topAttrs,
707-
tcConfig,
708-
outfile,
709-
pdbfile,
710-
assemblyName,
711-
diagnosticsLogger,
712-
exiter,
713-
ilSourceDocs
714-
)
714+
AbortOnError(diagnosticsLogger, exiter)
715+
args
716+
715717

716718
/// Second phase of compilation.
717719
/// - Write the signature file, check some attributes
@@ -1192,7 +1194,8 @@ let CompileFromCommandLineArguments
11921194
exiter: Exiter,
11931195
loggerProvider,
11941196
tcImportsCapture,
1195-
dynamicAssemblyCreator
1197+
dynamicAssemblyCreator,
1198+
abortOnError: bool
11961199
) =
11971200

11981201
use disposables = new DisposablesTracker()
@@ -1207,19 +1210,24 @@ let CompileFromCommandLineArguments
12071210
()
12081211
}
12091212

1210-
main1 (
1211-
ctok,
1212-
argv,
1213-
legacyReferenceResolver,
1214-
bannerAlreadyPrinted,
1215-
reduceMemoryUsage,
1216-
defaultCopyFSharpCore,
1217-
exiter,
1218-
loggerProvider,
1219-
disposables
1220-
)
1221-
|> main2
1222-
|> main3
1223-
|> main4 (tcImportsCapture, dynamicAssemblyCreator)
1224-
|> main5
1225-
|> main6 dynamicAssemblyCreator
1213+
let x =
1214+
main1 (
1215+
ctok,
1216+
argv,
1217+
legacyReferenceResolver,
1218+
bannerAlreadyPrinted,
1219+
reduceMemoryUsage,
1220+
defaultCopyFSharpCore,
1221+
exiter,
1222+
loggerProvider,
1223+
disposables
1224+
)
1225+
if abortOnError then
1226+
x
1227+
|> main2
1228+
|> main3
1229+
|> main4 (tcImportsCapture, dynamicAssemblyCreator)
1230+
|> main5
1231+
|> main6 dynamicAssemblyCreator
1232+
else
1233+
()

‎src/Compiler/Driver/fsc.fsi‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,8 @@ val CompileFromCommandLineArguments:
5353
exiter: Exiter *
5454
loggerProvider: IDiagnosticsLoggerProvider *
5555
tcImportsCapture: (TcImports -> unit) option *
56-
dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option ->
56+
dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option *
57+
abortOnError: bool ->
5758
unit
5859

5960
/// Read the parallelReferenceResolution flag from environment variables

‎src/Compiler/Legacy/LegacyHostedCompilerForTesting.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -99,7 +99,7 @@ type internal InProcCompiler(legacyReferenceResolver) =
9999
ctok, argv, legacyReferenceResolver,
100100
false, ReduceMemoryFlag.Yes,
101101
CopyFSharpCoreFlag.Yes, exiter,
102-
loggerProvider.Provider, None, None
102+
loggerProvider.Provider, None, None, true
103103
)
104104
with
105105
| StopProcessing -> ()

‎src/Compiler/Service/service.fs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,7 +134,8 @@ module CompileHelpers =
134134
exiter,
135135
loggerProvider,
136136
tcImportsCapture,
137-
dynamicAssemblyCreator
137+
dynamicAssemblyCreator,
138+
true
138139
))
139140

140141
diagnostics.ToArray(), result

‎src/fsc/fscmain.fs‎

Lines changed: 11 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -31,9 +31,7 @@ type Timer(name : string) =
3131
member this.Dispose() = this.Dispose()
3232

3333

34-
[<EntryPoint>]
35-
let main (argv) =
36-
34+
let internal mainAux2 (argv : string[], onlyTypeCheck : bool, exiter : Exiter option) : int =
3735
use _ = FSharp.Compiler.Diagnostics.Activity.startNoTags "fscmain"
3836

3937
use _ = new Timer("main")
@@ -89,6 +87,8 @@ let main (argv) =
8987
// Get the handler for legacy resolution of references via MSBuild.
9088
let legacyReferenceResolver = LegacyMSBuildReferenceResolver.getResolver ()
9189

90+
let exiter = exiter |> Option.defaultValue QuitProcessExiter
91+
9292
// Perform the main compilation.
9393
//
9494
// This is the only place where ReduceMemoryFlag.No is set. This is because fsc.exe is not a long-running process and
@@ -102,10 +102,11 @@ let main (argv) =
102102
false,
103103
ReduceMemoryFlag.No,
104104
CopyFSharpCoreFlag.Yes,
105-
QuitProcessExiter,
105+
exiter,
106106
ConsoleLoggerProvider(),
107107
None,
108-
None
108+
None,
109+
not onlyTypeCheck
109110
)
110111

111112
0
@@ -114,3 +115,8 @@ let main (argv) =
114115
// Last-chance error recovery (note, with a poor error range)
115116
errorRecovery e Range.range0
116117
1
118+
119+
120+
[<EntryPoint>]
121+
let main (argv : string[]) : int =
122+
mainAux2 (argv, false, None)

‎tests/ParallelTypeCheckingTests/Code/ASTVisit.fs‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -15,11 +15,7 @@ type Reference =
1515
Kind : ReferenceKind
1616
}
1717

18-
type Abbreviation =
19-
{
20-
Alias : Ident
21-
Target : LongIdent
22-
}
18+
type Abbreviation = Abbreviation of unit
2319

2420
/// Reference to a module or type, found in the AST
2521
type ReferenceOrAbbreviation =
@@ -46,7 +42,7 @@ let rec visitSynModuleDecl (decl : SynModuleDecl) : References =
4642
| SynModuleDecl.Types(synTypeDefns, range) ->
4743
visitSynTypeDefns synTypeDefns
4844
| SynModuleDecl.ModuleAbbrev(ident, longId, range) ->
49-
[ReferenceOrAbbreviation.Abbreviation({Alias = ident; Target = longId})]
45+
[ReferenceOrAbbreviation.Abbreviation (Abbreviation.Abbreviation())]
5046
| SynModuleDecl.NamespaceFragment synModuleOrNamespace ->
5147
visitSynModuleOrNamespace synModuleOrNamespace
5248
| SynModuleDecl.NestedModule(synComponentInfo, isRecursive, synModuleDecls, isContinuing, range, synModuleDeclNestedModuleTrivia) ->
@@ -380,6 +376,8 @@ and visitTypeDefnSimpleRepr (x : SynTypeDefnSimpleRepr) : References =
380376
seq {
381377
yield! visitParserDetail parserDetail
382378
yield! visitType rhsType
379+
// TODO This shouldn't be needed, but for some reason it fixes the 'graph' mode in lib.fs etc.
380+
yield (ReferenceOrAbbreviation.Abbreviation (Abbreviation.Abbreviation()))
383381
}
384382
| SynTypeDefnSimpleRepr.LibraryOnlyILAssembly(ilType, range) ->
385383
[]
@@ -1125,9 +1123,11 @@ let rec topStuffForSynModuleOrNamespace (x : SynModuleOrNamespace) : LongIdent[]
11251123
// Treat it as a type - as soon as the parent module is reachable, consider the file being used
11261124
[|LongIdent.Empty|]
11271125
else
1128-
synModuleDecls
1129-
|> moduleDecls
1130-
|> combine longId
1126+
[|longId|]
1127+
// 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)
1128+
// synModuleDecls
1129+
// |> moduleDecls
1130+
// |> combine longId
11311131

11321132
and moduleDecls (x : SynModuleDecl list) : Eit =
11331133
let emptyState = Eit.Nested [||]

‎tests/ParallelTypeCheckingTests/Code/DepResolving.fs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -149,6 +149,13 @@ module internal AutomatedDependencyResolving =
149149

150150
let processFile (node : FileData) =
151151
let deps =
152+
let fsiDep =
153+
if node.File.FsiBacked then
154+
nodes
155+
|> Array.find (fun x -> x.File.Name = node.File.Name + "i")
156+
|> fun x -> [|x|]
157+
else
158+
[||]
152159
// Assume that a file with module abbreviations can depend on anything
153160
match node.Data.ContainsModuleAbbreviations with
154161
| true -> nodes |> Array.map (fun n -> n.File)
@@ -226,6 +233,7 @@ module internal AutomatedDependencyResolving =
226233
// For starters: can module abbreviations affect other files?
227234
// If not, then the below is not necessary.
228235
|> Seq.append filesWithModuleAbbreviations
236+
|> Seq.append fsiDep
229237
|> Seq.map (fun f -> f.File)
230238
|> Seq.toArray
231239

‎tests/ParallelTypeCheckingTests/Code/Graph.fs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -61,4 +61,11 @@ module Graph =
6161
| false, _ -> idx, [||]
6262
)
6363
|> readOnlyDict
64+
65+
let print (graph : Graph<'Node>) : unit =
66+
printfn "Graph:"
67+
let join (xs : string[]) =
68+
System.String.Join(", ", xs)
69+
graph
70+
|> Seq.iter (fun (KeyValue(file, deps)) -> printfn $"{file} -> {deps |> Array.map (fun d -> d.ToString()) |> join}")
6471

0 commit comments

Comments
 (0)