diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 5ad43a53542..cb650d9cbda 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -769,7 +769,10 @@ type TcState = { x with tcsTcSigEnv = tcEnvAtEndOfLastInput tcsTcImplEnv = tcEnvAtEndOfLastInput } + member x.RemoveImpl qualifiedNameOfFile = + { x with tcsRootImpls = x.tcsRootImpls.Remove(qualifiedNameOfFile) } + /// Create the initial type checking state for compiling an assembly let GetInitialTcState(m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcImports, niceNameGen, tcEnv0, openDecls0) = ignore tcImports @@ -946,15 +949,23 @@ let TypeCheckOneInput(checkForErrors, } /// Typecheck a single file (or interactive entry into F# Interactive) -let TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = +let TypeCheckOneInputEntryAux (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp skipImplIfSigExists = // 'use' ensures that the warning handler is restored at the end use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck RequireCompilationThread ctok - TypeCheckOneInput (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) + TypeCheckOneInput (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, skipImplIfSigExists) |> Cancellable.runWithoutCancellation +/// Typecheck a single file (or interactive entry into F# Interactive) +let TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = + TypeCheckOneInputEntryAux(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp false + +/// Typecheck a single file but skip it if the file is an impl and has a backing sig +let TypeCheckOneInputEntrySkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = + TypeCheckOneInputEntryAux(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp true + /// Finish checking multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputsFinish(results, tcState: TcState) = let tcEnvsAtEndFile, topAttrs, implFiles, ccuSigsForFiles = List.unzip4 results @@ -983,10 +994,40 @@ let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) = errorR(Error(FSComp.SR.buildSignatureWithoutImplementation(qualNameOfFile.Text), qualNameOfFile.Range))) tcState, declaredImpls, ccuContents + +let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = + // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions + let results, tcState = + if tcConfig.concurrentBuild then + let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInputEntrySkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + + let inputs = Array.ofList inputs + let newResults = Array.ofList results + let results = Array.ofList results + + (inputs, results) + ||> Array.zip + |> Array.mapi (fun i (input, (_, _, implOpt, _)) -> + match implOpt with + | None -> None + | Some impl -> + match impl with + | TypedImplFile.TImplFile(qualifiedNameOfFile=qualifiedNameOfFile;implementationExpressionWithSignature=ModuleOrNamespaceExprWithSig.ModuleOrNamespaceExprWithSig(contents=ModuleOrNamespaceExpr.TMDefs [])) -> + Some(i, input, qualifiedNameOfFile) + | _ -> + None + ) + |> Array.choose id + |> ArrayParallel.iter (fun (i, input, qualifiedNameOfFile) -> + let tcState = tcState.RemoveImpl(qualifiedNameOfFile) + let result, _ = TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input + newResults.[i] <- result + ) + + newResults |> List.ofArray, tcState + else + (tcState, inputs) ||> List.mapFold (TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) -let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = - // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions - let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(results, tcState) let tcState, declaredImpls, ccuContents = TypeCheckClosedInputSetFinish (implFiles, tcState) tcState.Ccu.Deref.Contents <- ccuContents diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index d0906edbf27..40ba07d80f7 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -85,6 +85,8 @@ type TcState = member CreatesGeneratedProvidedTypes: bool + member RemoveImpl: QualifiedNameOfFile -> TcState + /// Get the initial type checking state for a set of inputs val GetInitialTcState: range * diff --git a/src/fsharp/lib.fsi b/src/fsharp/lib.fsi index 28d9f10b380..2c30814767a 100644 --- a/src/fsharp/lib.fsi +++ b/src/fsharp/lib.fsi @@ -302,6 +302,10 @@ type DisposablesTracker = [] module ArrayParallel = + val inline iter : ('T -> unit) -> 'T [] -> unit + + val inline iteri : (int -> 'T -> unit) -> 'T [] -> unit + val inline map : ('T -> 'U) -> 'T [] -> 'U [] val inline mapi : (int -> 'T -> 'U) -> 'T [] -> 'U [] 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 1dd8cacb515..ec7f2fa2f84 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -2,8 +2,7 @@ Exe - net472;net5.0 - net5.0 + net472;net5.0 $(NoWarn);44;75; true false @@ -12,7 +11,6 @@ - @@ -72,13 +70,7 @@ ParserTests.fs - - XmlDocTests.fs - - - PrettyNaming.fs - - + Program.fs @@ -86,8 +78,6 @@ - - - + \ No newline at end of file diff --git a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj index e180057142e..07250b365ad 100644 --- a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj +++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj @@ -1,7 +1,7 @@  - net472;net5.0 + net472;net5.0 net5.0 win-x86;win-x64;linux-x64;osx-x64 $(AssetTargetFallback);portable-net45+win8+wp8+wpa81 @@ -28,14 +28,11 @@ - - - - +