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