diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs
index 3f4ac2f89ee..1144a0bd045 100644
--- a/src/Compiler/Driver/ParseAndCheckInputs.fs
+++ b/src/Compiler/Driver/ParseAndCheckInputs.fs
@@ -4,6 +4,7 @@
module internal FSharp.Compiler.ParseAndCheckInputs
open System
+open System.Collections.Immutable
open System.IO
open System.Collections.Generic
@@ -1454,32 +1455,106 @@ let CheckMultipleInputsInParallel
// somewhere in the files processed prior to each one, or in the processing of this particular file.
let priorErrors = checkForErrors ()
+ let MAGIC_NUMBER = 4
+
// Do the first linear phase, checking all signatures and any implementation files that don't have a signature.
// Implementation files that do have a signature will result in a Choice2Of2 indicating to next do some of the
// checking in parallel.
let partialResults, (tcState, _) =
- ((tcState, priorErrors), inputsWithLoggers)
- ||> List.mapFold (fun (tcState, priorErrors) (input, logger) ->
- use _ = UseDiagnosticsLogger logger
+ let sequentialFiles, parallelFiles =
+ List.take MAGIC_NUMBER inputsWithLoggers, List.skip MAGIC_NUMBER inputsWithLoggers
- let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
-
- let partialResult, tcState =
- CheckOneInputAux(
- checkForErrors2,
- tcConfig,
- tcImports,
- tcGlobals,
- prefixPathOpt,
- TcResultsSink.NoSink,
- tcState,
- input,
- true
- )
- |> Cancellable.runWithoutCancellation
+ let sequentialPartialResults, (sequentialTcState, sequentialPriorErrors) =
+ ((tcState, priorErrors), sequentialFiles)
+ ||> List.mapFold (fun (tcState, priorErrors) (input, logger) ->
+ use _ = UseDiagnosticsLogger logger
+ let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
- let priorErrors = checkForErrors2 ()
- partialResult, (tcState, priorErrors))
+ let partialResult, tcState =
+ CheckOneInputAux(
+ checkForErrors2,
+ tcConfig,
+ tcImports,
+ tcGlobals,
+ prefixPathOpt,
+ TcResultsSink.NoSink,
+ tcState,
+ input,
+ true
+ )
+ |> Cancellable.runWithoutCancellation
+
+ let priorErrors = checkForErrors2 ()
+ partialResult, (tcState, priorErrors))
+
+ let amap = tcImports.GetImportMap()
+
+ let conditionalDefines =
+ if tcConfig.noConditionalErasure then
+ None
+ else
+ Some tcConfig.conditionalDefines
+
+ let parallelPartialResults, (parallelTcState, parallelPriorErrors) =
+ List.toArray parallelFiles
+ |> ArrayParallel.map (fun (input, logger) ->
+ cancellable {
+ // this is taken mostly from CheckOneInputAux, the case where the impl has no signature file
+ let file =
+ match input with
+ | ParsedInput.ImplFile file -> file
+ | ParsedInput.SigFile _ -> failwith "not expecting a signature file for now"
+
+ let tcSink = TcResultsSink.NoSink
+
+ // Typecheck the implementation file
+ let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
+ CheckOneImplFile(
+ tcGlobals,
+ amap,
+ sequentialTcState.tcsCcu,
+ sequentialTcState.tcsImplicitOpenDeclarations,
+ checkForErrors,
+ conditionalDefines,
+ TcResultsSink.NoSink,
+ tcConfig.internalTestSpanStackReferring,
+ sequentialTcState.tcsTcImplEnv,
+ None,
+ file
+ )
+
+ return
+ (fun tcState ->
+ let tcState =
+ { tcState with
+ tcsCreatesGeneratedProvidedTypes =
+ tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
+ }
+
+ let ccuSigForFile, updateTcState =
+ AddCheckResultsToTcState
+ (tcGlobals,
+ amap,
+ false,
+ prefixPathOpt,
+ tcSink,
+ tcState.tcsTcImplEnv,
+ input.QualifiedName,
+ implFile.Signature)
+ tcState
+
+ Choice1Of2(tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile), logger, updateTcState)
+ }
+ |> Cancellable.runWithoutCancellation)
+ |> fun results ->
+ ((sequentialTcState, sequentialPriorErrors, ImmutableQueue.Empty), results)
+ ||> Array.fold (fun (tcState, priorErrors, partialResults) result ->
+ let partialResult, logger, nextTcState = result tcState
+ let priorErrors = priorErrors || (logger.ErrorCount > 0)
+ (nextTcState, priorErrors, partialResults.Enqueue partialResult))
+ |> fun (tcState, priorErrors, partialResults) -> Seq.toList partialResults, (tcState, priorErrors)
+
+ [ yield! sequentialPartialResults; yield! parallelPartialResults ], (parallelTcState, parallelPriorErrors)
// Do the parallel phase, checking all implementation files that did have a signature, in parallel.
let results, createsGeneratedProvidedTypesFlags =
diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj
index c5b206ed9e6..46db84dce13 100644
--- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj
+++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj
@@ -182,6 +182,7 @@
PrettyNaming.fs
+
Program.fs