Skip to content

Commit

Permalink
Type check backed implementation files in parallel in a second phase.
Browse files Browse the repository at this point in the history
  • Loading branch information
@nojaf
nojaf committed Nov 25, 2022
1 parent eb9b882 commit a7cb8c9
Show file tree
Hide file tree
Showing 3 changed files with 146 additions and 51 deletions.
146 changes: 105 additions & 41 deletions src/Compiler/Driver/ParseAndCheckInputs.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1215,6 +1215,11 @@ let AddDummyCheckResultsToTcState

type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType

type PairResultOfImplementInPair =
Import.ImportMap * string list option * ModuleOrNamespaceType * bool * ParsedImplFileInput * TcState * ModuleOrNamespaceType

type PartialTypeCheckResult = Choice<PartialResult, PairResultOfImplementInPair>

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

Expand Down Expand Up @@ -1406,7 +1411,7 @@ let CheckOneInputAux'
tcState: TcState,
inp: ParsedInput,
_skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool)
: Cancellable<TcState -> PartialResult * TcState> =
: Cancellable<TcState -> PartialTypeCheckResult * TcState> =

cancellable {
try
Expand Down Expand Up @@ -1468,7 +1473,7 @@ let CheckOneInputAux'
// Add the signature to the signature env (unless it had an explicit signature)
let ccuSigForFile = CombineCcuContentFragments [ sigFileType; tcState.tcsCcuSig ]

let partialResult = tcEnv, EmptyTopAttrs, None, ccuSigForFile
let partialResult = Choice1Of2(tcEnv, EmptyTopAttrs, None, ccuSigForFile)

let tcState =
{ tcState with
Expand All @@ -1489,55 +1494,76 @@ let CheckOneInputAux'
// Check if we've got an interface for this fragment
let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile

// Typecheck the implementation file not backed by a signature file
match rootSigOpt with
| None ->
// Typecheck the implementation file not backed by a signature file

// Check if we've already seen an implementation for this fragment
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m))
// Check if we've already seen an implementation for this fragment
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m))

let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
CheckOneImplFile(
tcGlobals,
amap,
tcState.tcsCcu,
tcState.tcsImplicitOpenDeclarations,
checkForErrors,
conditionalDefines,
tcSink,
tcConfig.internalTestSpanStackReferring,
tcState.tcsTcImplEnv,
rootSigOpt,
file
)
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
CheckOneImplFile(
tcGlobals,
amap,
tcState.tcsCcu,
tcState.tcsImplicitOpenDeclarations,
checkForErrors,
conditionalDefines,
tcSink,
tcConfig.internalTestSpanStackReferring,
tcState.tcsTcImplEnv,
rootSigOpt,
file
)

// printfn $"Finished Processing Impl {file.FileName}"
return
fun tcState ->
// let backed = rootSigOpt.IsSome
// printfn $"Applying Impl Backed={backed} {file.FileName}"
// printfn $"Finished Processing Impl {file.FileName}"
return
fun tcState ->
// let backed = rootSigOpt.IsSome
// printfn $"Applying Impl Backed={backed} {file.FileName}"

let ccuSigForFile, fsTcState =
AddCheckResultsToTcState
(tcGlobals, amap, false, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, implFile.Signature)
tcState

let ccuSigForFile, fsTcState =
AddCheckResultsToTcState
(tcGlobals, amap, false, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, implFile.Signature)
tcState
// backed impl files must not add results as there are already results from .fsi files
//let fsTcState = if backed then tcState else fsTcState

// backed impl files must not add results as there are already results from .fsi files
//let fsTcState = if backed then tcState else fsTcState
let partialResult = Choice1Of2(tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile)

let partialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
let tcState =
{ fsTcState with
tcsCreatesGeneratedProvidedTypes =
fsTcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
}

// printfn $"Finished applying Impl {file.FileName}"
partialResult, tcState

| Some rootSig ->
// Delay the typecheck the implementation file until the second phase of parallel processing.
// Adjust the TcState as if it has been checked, which makes the signature for the file available later
// in the compilation order.
let tcStateForImplFile = tcState
let qualNameOfFile = file.QualifiedName
let priorErrors = checkForErrors ()

let tcState =
{ fsTcState with
tcsCreatesGeneratedProvidedTypes =
fsTcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
}
return
fun tcState ->
let ccuSigForFile, tcState =
AddCheckResultsToTcState
(tcGlobals, amap, true, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSig)
tcState

// printfn $"Finished applying Impl {file.FileName}"
partialResult, tcState
let partialResult =
Choice2Of2(amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile)

partialResult, tcState
with e ->
errorRecovery e range0
return fun tcState -> (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState
return fun tcState -> Choice1Of2(tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState
}

/// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true
Expand All @@ -1552,7 +1578,7 @@ let CheckOneInput'
tcState: TcState,
input: ParsedInput,
skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool)
: Cancellable<TcState -> PartialResult * TcState> =
: Cancellable<TcState -> PartialTypeCheckResult * TcState> =
CheckOneInputAux'(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, skipImplIfSigExists)

// Within a file, equip loggers to locally filter w.r.t. scope pragmas in each input
Expand Down Expand Up @@ -1747,3 +1773,41 @@ let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tc

tcState.Ccu.Deref.Contents <- ccuContents
tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile

let checkBackedImplementationFile
(tcGlobals: TcGlobals)
(tcConfig: TcConfig)
(logger: DiagnosticsLogger)
(pairResult: PairResultOfImplementInPair)
=
let amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile =
pairResult

// In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
// somewhere in the files processed prior to this one, including from the first phase, or in the processing
// of this particular file.
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)

let topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
CheckOneImplFile(
tcGlobals,
amap,
tcStateForImplFile.tcsCcu,
tcStateForImplFile.tcsImplicitOpenDeclarations,
checkForErrors2,
conditionalDefines,
TcResultsSink.NoSink,
tcConfig.internalTestSpanStackReferring,
tcStateForImplFile.tcsTcImplEnv,
Some rootSig,
file
)
|> Cancellable.runWithoutCancellation

let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile)
result, createsGeneratedProvidedTypes

let updateCreatesGeneratedProvidedTypes tcState value =
{ tcState with
tcsCreatesGeneratedProvidedTypes = value
}
12 changes: 11 additions & 1 deletion src/Compiler/Driver/ParseAndCheckInputs.fsi
View file
Original file line number Diff line number Diff line change
Expand Up @@ -152,6 +152,16 @@ val AddCheckResultsToTcState:

type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType

type PairResultOfImplementInPair =
Import.ImportMap * string list option * ModuleOrNamespaceType * bool * ParsedImplFileInput * TcState * ModuleOrNamespaceType

type PartialTypeCheckResult = Choice<PartialResult, PairResultOfImplementInPair>

val checkBackedImplementationFile:
TcGlobals -> TcConfig -> DiagnosticsLogger -> PairResultOfImplementInPair -> PartialResult * bool

val updateCreatesGeneratedProvidedTypes: TcState -> bool -> TcState

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

Expand Down Expand Up @@ -185,7 +195,7 @@ val CheckOneInput':
tcState: TcState *
input: ParsedInput *
skipImplIfSigExists: bool ->
Cancellable<TcState -> PartialResult * TcState>
Cancellable<TcState -> PartialTypeCheckResult * TcState>

val CheckMultipleInputsInParallel:
(CompilationThreadToken * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list) ->
Expand Down
39 changes: 30 additions & 9 deletions tests/ParallelTypeCheckingTests/Code/ParallelTypeChecking.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,12 +31,12 @@ let DiagnosticsLoggerForInput (tcConfig: TcConfig, input: ParsedInput, oldLogger

type State = TcState * bool
type FinalFileResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType
type SingleResult = State -> FinalFileResult * State
type SingleResult = State -> PartialTypeCheckResult * State
type Item = File

type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType

let folder (state: State) (result: SingleResult) : FinalFileResult * State = result state
let folder (state: State) (result: SingleResult) : PartialTypeCheckResult * State = result state

/// Use parallel checking of implementation files that have signature files
let CheckMultipleInputsInParallel
Expand All @@ -54,7 +54,7 @@ let CheckMultipleInputsInParallel
})

let graph = DependencyResolution.mkGraph sourceFiles
graph |> Graph.map (fun idx -> sourceFiles.[idx].File) |> Graph.print
// graph |> Graph.map (fun idx -> sourceFiles.[idx].File) |> Graph.print

let graphDumpPath =
let graphDumpName =
Expand All @@ -80,7 +80,7 @@ let CheckMultipleInputsInParallel
let processFile
((input, logger): ParsedInput * DiagnosticsLogger)
((currentTcState, _currentPriorErrors): State)
: State -> PartialResult * State =
: State -> PartialTypeCheckResult * State =
cancellable {
use _ = UseDiagnosticsLogger logger
// printfn $"Processing AST {file.ToString()}"
Expand Down Expand Up @@ -111,7 +111,7 @@ let CheckMultipleInputsInParallel
(fun (state: State) ->
// printfn $"Applying {file.ToString()}"
let tcState, priorErrors = state
let (partialResult: PartialResult, tcState) = f tcState
let (partialResult: PartialTypeCheckResult, tcState) = f tcState

let hasErrors = logger.ErrorCount > 0
// TODO Should we use local _priorErrors or global priorErrors?
Expand All @@ -131,16 +131,16 @@ let CheckMultipleInputsInParallel
let logger = DiagnosticsLoggerForInput(tcConfig, input, oldLogger)
input, logger)

let processFile (fileIdx: int) (state: State) : State -> PartialResult * State =
let processFile (fileIdx: int) (state: State) : State -> PartialTypeCheckResult * State =
let parsedInput, logger = inputsWithLoggers.[fileIdx]
processFile (parsedInput, logger) state

let folder: State -> SingleResult -> FinalFileResult * State = folder
let folder: State -> SingleResult -> PartialTypeCheckResult * State = folder
let _qnof = QualifiedNameOfFile.QualifiedNameOfFile(Ident("", Range.Zero))
let state: State = tcState, priorErrors

let partialResults, (tcState, _) =
GraphProcessing.processGraph<int, State, SingleResult, FinalFileResult>
GraphProcessing.processGraph<int, State, SingleResult, PartialTypeCheckResult>
graph
processFile
folder
Expand All @@ -150,4 +150,25 @@ let CheckMultipleInputsInParallel
(fun _ -> true)
10

partialResults |> Array.toList, tcState)
// Do the parallel phase, checking all implementation files that did have a signature, in parallel.
let results, createsGeneratedProvidedTypesFlags =
Array.zip partialResults inputsWithLoggers
|> ArrayParallel.map (fun (partialResult, (_, logger)) ->
use _ = UseDiagnosticsLogger logger
use _ = UseBuildPhase BuildPhase.TypeCheck

RequireCompilationThread ctok

match partialResult with
| Choice1Of2 result -> result, false
| Choice2Of2 backedImplResult -> checkBackedImplementationFile tcGlobals tcConfig logger backedImplResult)
|> Array.toList
|> List.unzip

let tcState =
updateCreatesGeneratedProvidedTypes
tcState
(tcState.CreatesGeneratedProvidedTypes
|| (createsGeneratedProvidedTypesFlags |> List.exists id))

results, tcState)

0 comments on commit a7cb8c9

Please sign in to comment.