Skip to content

Commit d82c543

Browse files
safesparrowsafesparrow
committed
changes
1 parent ae722fe commit d82c543

3 files changed

Lines changed: 187 additions & 73 deletions

File tree

‎src/Compiler/Driver/ParseAndCheckInputs.fs‎

Lines changed: 166 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1073,6 +1073,8 @@ type TcState =
10731073
tcsCreatesGeneratedProvidedTypes = y
10741074
}
10751075

1076+
type State = TcState * bool
1077+
10761078
/// Create the initial type checking state for compiling an assembly
10771079
let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcImports, tcEnv0, openDecls0) =
10781080
ignore tcImports
@@ -1230,9 +1232,14 @@ let CheckOneInputAux
12301232
let m = inp.Range
12311233
let amap = tcImports.GetImportMap()
12321234

1235+
let conditionalDefines =
1236+
if tcConfig.noConditionalErasure then
1237+
None
1238+
else
1239+
Some tcConfig.conditionalDefines
1240+
12331241
match inp with
12341242
| ParsedInput.SigFile file ->
1235-
12361243
let qualNameOfFile = file.QualifiedName
12371244

12381245
// Check if we've seen this top module signature before.
@@ -1243,12 +1250,6 @@ let CheckOneInputAux
12431250
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
12441251
errorR (Error(FSComp.SR.buildImplementationAlreadyGivenDetail (qualNameOfFile.Text), m))
12451252

1246-
let conditionalDefines =
1247-
if tcConfig.noConditionalErasure then
1248-
None
1249-
else
1250-
Some tcConfig.conditionalDefines
1251-
12521253
// Typecheck the signature file
12531254
let! tcEnv, sigFileType, createsGeneratedProvidedTypes =
12541255
CheckOneSigFile
@@ -1295,12 +1296,6 @@ let CheckOneInputAux
12951296
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
12961297
errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m))
12971298

1298-
let conditionalDefines =
1299-
if tcConfig.noConditionalErasure then
1300-
None
1301-
else
1302-
Some tcConfig.conditionalDefines
1303-
13041299
let hadSig = rootSigOpt.IsSome
13051300

13061301
match rootSigOpt with
@@ -1360,17 +1355,17 @@ let CheckOneInputAux
13601355
/// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true
13611356
/// then implementations with signature files give empty results.
13621357
let CheckOneInput
1363-
(
1364-
checkForErrors,
1358+
((checkForErrors,
13651359
tcConfig: TcConfig,
13661360
tcImports: TcImports,
13671361
tcGlobals,
13681362
prefixPathOpt,
13691363
tcSink,
13701364
tcState: TcState,
13711365
input: ParsedInput,
1372-
skipImplIfSigExists: bool
1373-
) =
1366+
skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool)
1367+
: Cancellable<PartialResult * TcState>
1368+
=
13741369
cancellable {
13751370
let! partialResult, tcState =
13761371
CheckOneInputAux(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, skipImplIfSigExists)
@@ -1391,6 +1386,159 @@ let CheckOneInput
13911386
)
13921387
}
13931388

1389+
1390+
1391+
1392+
/// Typecheck a single file (or interactive entry into F# Interactive)
1393+
let CheckOneInputAux'
1394+
((checkForErrors,
1395+
tcConfig: TcConfig,
1396+
tcImports: TcImports,
1397+
tcGlobals,
1398+
prefixPathOpt,
1399+
tcSink,
1400+
tcState: TcState,
1401+
inp: ParsedInput,
1402+
_skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool)
1403+
: Cancellable<TcState -> PartialResult * TcState>
1404+
=
1405+
1406+
cancellable {
1407+
try
1408+
CheckSimulateException tcConfig
1409+
1410+
let m = inp.Range
1411+
let amap = tcImports.GetImportMap()
1412+
1413+
let conditionalDefines =
1414+
if tcConfig.noConditionalErasure then
1415+
None
1416+
else
1417+
Some tcConfig.conditionalDefines
1418+
1419+
match inp with
1420+
| ParsedInput.SigFile file ->
1421+
let qualNameOfFile = file.QualifiedName
1422+
1423+
// Check if we've seen this top module signature before.
1424+
if Zmap.mem qualNameOfFile tcState.tcsRootSigs then
1425+
errorR (Error(FSComp.SR.buildSignatureAlreadySpecified (qualNameOfFile.Text), m.StartRange))
1426+
1427+
// Check if the implementation came first in compilation order
1428+
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
1429+
errorR (Error(FSComp.SR.buildImplementationAlreadyGivenDetail (qualNameOfFile.Text), m))
1430+
1431+
// Typecheck the signature file
1432+
let! tcEnv, sigFileType, createsGeneratedProvidedTypes =
1433+
CheckOneSigFile
1434+
(tcGlobals,
1435+
amap,
1436+
tcState.tcsCcu,
1437+
checkForErrors,
1438+
conditionalDefines,
1439+
tcSink,
1440+
tcConfig.internalTestSpanStackReferring)
1441+
tcState.tcsTcSigEnv
1442+
file
1443+
1444+
return fun tcState ->
1445+
let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs
1446+
1447+
// Add the signature to the signature env (unless it had an explicit signature)
1448+
let ccuSigForFile = CombineCcuContentFragments [ sigFileType; tcState.tcsCcuSig ]
1449+
1450+
// Open the prefixPath for fsi.exe
1451+
let tcEnv, _openDecls1 =
1452+
match prefixPathOpt with
1453+
| None -> tcEnv, []
1454+
| Some prefixPath ->
1455+
let m = qualNameOfFile.Range
1456+
TcOpenModuleOrNamespaceDecl tcSink tcGlobals amap m tcEnv (prefixPath, m)
1457+
1458+
let partialResult = tcEnv, EmptyTopAttrs, None, ccuSigForFile
1459+
1460+
let tcState =
1461+
{ tcState with
1462+
tcsTcSigEnv = tcEnv
1463+
tcsTcImplEnv = tcState.tcsTcImplEnv
1464+
tcsRootSigs = rootSigs
1465+
tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
1466+
}
1467+
1468+
partialResult, tcState
1469+
1470+
| ParsedInput.ImplFile file ->
1471+
let qualNameOfFile = file.QualifiedName
1472+
1473+
// Check if we've got an interface for this fragment
1474+
let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile
1475+
1476+
// Check if we've already seen an implementation for this fragment
1477+
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
1478+
errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m))
1479+
1480+
let hadSig = rootSigOpt.IsSome
1481+
1482+
// Typecheck the implementation file
1483+
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
1484+
CheckOneImplFile(
1485+
tcGlobals,
1486+
amap,
1487+
tcState.tcsCcu,
1488+
tcState.tcsImplicitOpenDeclarations,
1489+
checkForErrors,
1490+
conditionalDefines,
1491+
tcSink,
1492+
tcConfig.internalTestSpanStackReferring,
1493+
tcState.tcsTcImplEnv,
1494+
rootSigOpt,
1495+
file
1496+
)
1497+
1498+
return fun tcState ->
1499+
let ccuSigForFile, tcState =
1500+
AddCheckResultsToTcState
1501+
(tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, implFile.Signature)
1502+
tcState
1503+
1504+
let partialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
1505+
1506+
let tcState =
1507+
{ tcState with
1508+
tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
1509+
}
1510+
1511+
partialResult, tcState
1512+
1513+
with e ->
1514+
errorRecovery e range0
1515+
return fun tcState -> (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState
1516+
}
1517+
1518+
1519+
/// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true
1520+
/// then implementations with signature files give empty results.
1521+
let CheckOneInput'
1522+
((checkForErrors,
1523+
tcConfig: TcConfig,
1524+
tcImports: TcImports,
1525+
tcGlobals,
1526+
prefixPathOpt,
1527+
tcSink,
1528+
tcState: TcState,
1529+
input: ParsedInput,
1530+
skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool)
1531+
: Cancellable<TcState -> PartialResult * TcState>
1532+
=
1533+
cancellable {
1534+
let! f =
1535+
CheckOneInputAux'(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, skipImplIfSigExists)
1536+
// TODO Handle skipImplIfSigExists
1537+
return f
1538+
}
1539+
1540+
1541+
13941542
// Within a file, equip loggers to locally filter w.r.t. scope pragmas in each input
13951543
let DiagnosticsLoggerForInput (tcConfig: TcConfig, input: ParsedInput, oldLogger) =
13961544
GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, oldLogger)
@@ -1559,9 +1707,7 @@ let CheckMultipleInputsInParallel
15591707
}
15601708

15611709
results, tcState)
1562-
1563-
type State = TcState * bool
1564-
1710+
15651711
type WorkInput =
15661712
{
15671713
FileIndex : int

‎src/Compiler/Driver/ParseAndCheckInputs.fsi‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -166,6 +166,20 @@ val CheckOneInput:
166166
skipImplIfSigExists: bool ->
167167
Cancellable<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState>
168168

169+
/// Check one input, returned as an Eventually computation
170+
val CheckOneInput':
171+
checkForErrors: (unit -> bool) *
172+
tcConfig: TcConfig *
173+
tcImports: TcImports *
174+
tcGlobals: TcGlobals *
175+
prefixPathOpt: LongIdent option *
176+
tcSink: NameResolution.TcResultsSink *
177+
tcState: TcState *
178+
input: ParsedInput *
179+
skipImplIfSigExists: bool ->
180+
Cancellable<TcState -> PartialResult * TcState>
181+
182+
169183
/// Finish the checking of multiple inputs
170184
val CheckMultipleInputsFinish:
171185
(TcEnv * TopAttribs * 'T option * 'U) list * TcState -> (TcEnv * TopAttribs * 'T list * 'U list) * TcState

‎tests/FSharp.Compiler.Service.Tests2/ParallelTypeChecking.fs‎

Lines changed: 7 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -88,31 +88,19 @@ module internal Real =
8888
// In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
8989
// somewhere in the files processed prior to each one, or in the processing of this particular file.
9090
let priorErrors = checkForErrors ()
91-
let amap = tcImports.GetImportMap()
92-
let conditionalDefines =
93-
if tcConfig.noConditionalErasure then
94-
None
95-
else
96-
Some tcConfig.conditionalDefines
9791

9892
let processFile
9993
((input, logger) : ParsedInput * DiagnosticsLogger)
100-
((currentTcState, _) : State)
94+
((currentTcState, currentPriorErrors) : State)
10195
: State -> PartialResult * State =
10296
cancellable {
10397
use _ = UseDiagnosticsLogger logger
10498
// Is it OK that we don't update 'priorErrors' after processing batches?
10599
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
106100

107-
// this is taken mostly from CheckOneInputAux, the case where the impl has no signature file
108-
let file =
109-
match input with
110-
| ParsedInput.ImplFile file -> file
111-
| ParsedInput.SigFile _ -> failwith "not expecting a signature file for now"
112-
113101
let tcSink = TcResultsSink.NoSink
114102

115-
let! tuple, tcState = CheckOneInput(
103+
let! f = CheckOneInput'(
116104
checkForErrors2,
117105
tcConfig,
118106
tcImports,
@@ -121,50 +109,18 @@ module internal Real =
121109
tcSink,
122110
currentTcState,
123111
input,
124-
false // skipImpFiles...
112+
false // skipImpFiles...
125113
)
126-
127-
// Typecheck the implementation file
128-
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
129-
CheckOneImplFile(
130-
tcGlobals,
131-
amap,
132-
currentTcState.Ccu,
133-
currentTcState.TcsImplicitOpenDeclarations,
134-
checkForErrors2,
135-
conditionalDefines,
136-
TcResultsSink.NoSink,
137-
tcConfig.internalTestSpanStackReferring,
138-
currentTcState.TcEnvFromImpls,
139-
None,
140-
file
141-
)
142114

143115
return
144116
(fun (state : State) ->
145-
let tcState, _priorErrors = state
146-
let tcState =
147-
tcState.WithCreatesGeneratedProvidedTypes
148-
(tcState.CreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes)
117+
let tcState, priorErrors = state
118+
let (partialResult : PartialResult, tcState) = f tcState
149119

150-
let ccuSigForFile, updatedTcState =
151-
let results =
152-
tcGlobals,
153-
amap,
154-
false,
155-
prefixPathOpt,
156-
tcSink,
157-
tcState.TcEnvFromImpls,
158-
input.QualifiedName,
159-
implFile.Signature
160-
161-
AddCheckResultsToTcState results tcState
162-
163-
let partialResult : PartialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
164120
let hasErrors = logger.ErrorCount > 0
121+
// TODO Should we use local _priorErrors or global priorErrors?
165122
let priorOrCurrentErrors = priorErrors || hasErrors
166-
let state : State = updatedTcState, priorOrCurrentErrors
167-
123+
let state : State = tcState, priorOrCurrentErrors
168124
partialResult, state
169125
)
170126
}
@@ -199,8 +155,6 @@ module internal Real =
199155
partialResults |> Array.toList, tcState
200156
)
201157

202-
CheckMultipleInputsInParallel2 <- CheckMultipleInputsInParallelMy
203-
204158

205159
let typeCheckGraph (graph : FileGraph) : FinalFileResult[] * State =
206160
let parallelism = 4 // cpu count?

0 commit comments

Comments
 (0)