Type check backed implementation files in parallel in a second phase.

Author: nojaf

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -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
 
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
+    }

src/Compiler/Driver/ParseAndCheckInputs.fsi

@@ -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
 
@@ -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) ->

tests/ParallelTypeCheckingTests/Code/ParallelTypeChecking.fs

@@ -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
@@ -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 =
@@ -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()}"
@@ -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?
@@ -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
@@ -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)