Experiment/paralllel unit tests

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 =

tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj

@@ -182,6 +182,7 @@
     <Compile Include="..\service\PrettyNaming.fs">
       <Link>PrettyNaming.fs</Link>
     </Compile>
+    <Compile Include="..\..\..\fsharp-compiler-playground\PlaygroundTests.fs"/>
     <Compile Include="..\service\Program.fs">
       <Link>Program.fs</Link>
     </Compile>