Skip to content

Commit 7fc73e0

Browse files
safesparrowsafesparrow
committed
changes
1 parent b5d3367 commit 7fc73e0

File tree

1 file changed

+84
-66
lines changed

1 file changed

+84
-66
lines changed

‎src/Compiler/Driver/ParseAndCheckInputs.fs‎

Lines changed: 84 additions & 66 deletions
Original file line numberDiff line numberDiff line change
@@ -1549,6 +1549,13 @@ let CheckMultipleInputsInParallel
15491549

15501550
type State = TcState * bool
15511551

1552+
type WorkInput =
1553+
{
1554+
FileIndex : int
1555+
ParsedInput : ParsedInput
1556+
Logger : DiagnosticsLogger
1557+
}
1558+
15521559
/// Use parallel checking of implementation files that have signature files
15531560
let CheckMultipleInputsInParallel2
15541561
(
@@ -1608,7 +1615,7 @@ let CheckMultipleInputsInParallel2
16081615
set [ 0; 2; 4 ]
16091616
|]
16101617

1611-
let partialResults, ((tcState, _) : State) =
1618+
let partialResults, (state : State) =
16121619
let lastIndex = inputsWithLoggers.Length - 1
16131620
let amap = tcImports.GetImportMap()
16141621

@@ -1621,7 +1628,8 @@ let CheckMultipleInputsInParallel2
16211628
// This function will type check all the files where it knows all the dependent file have already been seen.
16221629
// The `freeFiles` are a set of file indexes that have been type checked in a previous run.
16231630
// `processedFiles` stores the result of a typed checked file in a mutable fashion.
1624-
let rec visit ((currentTcState: TcState, currentPriorErrors: bool) as state : State) (freeFiles: Set<int>) (processedFiles: _ array) =
1631+
let rec visit (state : State) (freeFiles: Set<int>) (processedFiles: PartialResult array): PartialResult array * State =
1632+
let (currentTcState, currentPriorErrors) = state
16251633
// Find files that still needs processing.
16261634
let unprocessedFiles = freeFiles |> Set.difference (set [| 0..lastIndex |])
16271635

@@ -1630,7 +1638,7 @@ let CheckMultipleInputsInParallel2
16301638
processedFiles, state
16311639
else
16321640
// What files can we type check from the files that are left to type check.
1633-
let nextFreeIndexes =
1641+
let nextFreeIndexes: (int * (ParsedInput * DiagnosticsLogger))[] =
16341642
unprocessedFiles
16351643
|> Seq.choose (fun fileIndex ->
16361644
let isFreeFile =
@@ -1642,78 +1650,87 @@ let CheckMultipleInputsInParallel2
16421650
None)
16431651
|> Seq.toArray
16441652

1653+
let processFile ((input, logger) : ParsedInput * 'c)
1654+
: State -> PartialResult * State =
1655+
cancellable {
1656+
use _ = UseDiagnosticsLogger logger
1657+
// Is it OK that we don't update 'priorErrors' after processing batches?
1658+
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
1659+
1660+
// this is taken mostly from CheckOneInputAux, the case where the impl has no signature file
1661+
let file =
1662+
match input with
1663+
| ParsedInput.ImplFile file -> file
1664+
| ParsedInput.SigFile _ -> failwith "not expecting a signature file for now"
1665+
1666+
let tcSink = TcResultsSink.NoSink
1667+
1668+
// Typecheck the implementation file
1669+
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
1670+
CheckOneImplFile(
1671+
tcGlobals,
1672+
amap,
1673+
currentTcState.tcsCcu,
1674+
currentTcState.tcsImplicitOpenDeclarations,
1675+
checkForErrors2,
1676+
conditionalDefines,
1677+
TcResultsSink.NoSink,
1678+
tcConfig.internalTestSpanStackReferring,
1679+
currentTcState.tcsTcImplEnv,
1680+
None,
1681+
file
1682+
)
1683+
1684+
return
1685+
(fun (state : State) ->
1686+
let tcState, _priorErrors = state
1687+
let tcState =
1688+
{ tcState with
1689+
tcsCreatesGeneratedProvidedTypes =
1690+
tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
1691+
}
1692+
1693+
let ccuSigForFile, updatedTcState =
1694+
let results =
1695+
tcGlobals,
1696+
amap,
1697+
false,
1698+
prefixPathOpt,
1699+
tcSink,
1700+
tcState.tcsTcImplEnv,
1701+
input.QualifiedName,
1702+
implFile.Signature
1703+
1704+
AddCheckResultsToTcState results tcState
1705+
1706+
let partialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
1707+
let hasErrors = logger.ErrorCount > 0
1708+
let priorOrCurrentErrors = priorErrors || hasErrors
1709+
let state = updatedTcState, priorOrCurrentErrors
1710+
1711+
partialResult, state
1712+
)
1713+
}
1714+
|> Cancellable.runWithoutCancellation
1715+
1716+
let go ((fileIndex : int), (input, logger)) : State -> int * (PartialResult * State) =
1717+
let r = processFile (input, logger)
1718+
fun state ->
1719+
fileIndex, r state
1720+
16451721
// The next batch of files we can process in parallel
16461722
let next =
16471723
nextFreeIndexes
1648-
|> ArrayParallel.map (fun (fileIndex, (input, logger)) ->
1649-
cancellable {
1650-
use _ = UseDiagnosticsLogger logger
1651-
// Is it OK that we don't update 'priorErrors' after processing batches?
1652-
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
1653-
1654-
// this is taken mostly from CheckOneInputAux, the case where the impl has no signature file
1655-
let file =
1656-
match input with
1657-
| ParsedInput.ImplFile file -> file
1658-
| ParsedInput.SigFile _ -> failwith "not expecting a signature file for now"
1659-
1660-
let tcSink = TcResultsSink.NoSink
1661-
1662-
// Typecheck the implementation file
1663-
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
1664-
CheckOneImplFile(
1665-
tcGlobals,
1666-
amap,
1667-
currentTcState.tcsCcu,
1668-
currentTcState.tcsImplicitOpenDeclarations,
1669-
checkForErrors2,
1670-
conditionalDefines,
1671-
TcResultsSink.NoSink,
1672-
tcConfig.internalTestSpanStackReferring,
1673-
currentTcState.tcsTcImplEnv,
1674-
None,
1675-
file
1676-
)
1677-
1678-
return
1679-
(fun (tcState, _priorErrors : bool) ->
1680-
let tcState =
1681-
{ tcState with
1682-
tcsCreatesGeneratedProvidedTypes =
1683-
tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
1684-
}
1685-
1686-
let ccuSigForFile, updatedTcState =
1687-
let results =
1688-
tcGlobals,
1689-
amap,
1690-
false,
1691-
prefixPathOpt,
1692-
tcSink,
1693-
tcState.tcsTcImplEnv,
1694-
input.QualifiedName,
1695-
implFile.Signature
1696-
1697-
AddCheckResultsToTcState results tcState
1698-
1699-
let partialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
1700-
let hasErrors = logger.ErrorCount > 0
1701-
let priorOrCurrentErrors = priorErrors || hasErrors
1702-
let state = updatedTcState, priorOrCurrentErrors
1703-
1704-
fileIndex, partialResult, state
1705-
)
1706-
}
1707-
|> Cancellable.runWithoutCancellation)
1724+
|> ArrayParallel.map go
17081725
|> fun results ->
17091726
((currentTcState, currentPriorErrors), results)
17101727
||> Array.fold (fun state result ->
17111728
// the `result` callback ensure that the TcState is synced correctly after a batch of file has been type checked in parallel.
17121729
// I believe this bit cannot be done in parallel, yet the order in which we fold the state does not matter.
1713-
let fileIndex, partialResult, state = result state
1730+
let fileIndex, (partialResult, state) = result state
17141731
// Yikes!
17151732
// Nah, it's okay.
1716-
processedFiles.[fileIndex] <- partialResult
1733+
processedFiles[fileIndex] <- partialResult
17171734
state
17181735
)
17191736

@@ -1729,7 +1746,8 @@ let CheckMultipleInputsInParallel2
17291746
visit next nextFreeIndexes processedFiles
17301747

17311748
visit (tcState, priorErrors) Set.empty (Array.zeroCreate inputsWithLoggers.Length)
1732-
1749+
1750+
let tcState, _errors = state
17331751
let partialResults = partialResults |> Array.toList
17341752
partialResults, tcState
17351753
)

0 commit comments

Comments
 (0)