From 58175149f33ba7aa8062ff65f468200d39341b00 Mon Sep 17 00:00:00 2001 From: nojaf Date: Wed, 12 Oct 2022 15:21:58 +0200 Subject: [PATCH 1/4] Good stuff... --- src/Compiler/Driver/ParseAndCheckInputs.fs | 27 +++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 3f4ac2f89ee..a479b33fe1f 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1454,12 +1454,16 @@ 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) -> + let sequentialFiles, parallelFiles = + List.take MAGIC_NUMBER inputsWithLoggers, List.skip MAGIC_NUMBER inputsWithLoggers + + let checkOneInput tcState priorErrors input logger = use _ = UseDiagnosticsLogger logger let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) @@ -1479,7 +1483,24 @@ let CheckMultipleInputsInParallel |> Cancellable.runWithoutCancellation let priorErrors = checkForErrors2 () - partialResult, (tcState, priorErrors)) + partialResult, (tcState, priorErrors) + + let sequentialPartialResults, (sequentialTcState, sequentialPriorErrors) = + ((tcState, priorErrors), sequentialFiles) + ||> List.mapFold (fun (tcState, priorErrors) (input, logger) -> + checkOneInput tcState priorErrors input logger) + + let parallelPartialResults, (parallelTcState, parallelPriorErrors) = + List.toArray parallelFiles + |> ArrayParallel.map (fun (input, logger) -> + checkOneInput sequentialTcState sequentialPriorErrors input logger + ) + |> fun results -> + let partialResult = Array.map fst results |> List.ofArray + let _, (tcState, priorErrors) = Array.head results + partialResult, (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 = From 3fafc1b958f67ef65240b42b4d98fe6383f95c6d Mon Sep 17 00:00:00 2001 From: nojaf Date: Wed, 12 Oct 2022 16:04:35 +0200 Subject: [PATCH 2/4] Some more stuff. --- src/Compiler/Driver/ParseAndCheckInputs.fs | 29 ++++++++++++++++--- .../FSharp.Compiler.Service.Tests.fsproj | 1 + 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index a479b33fe1f..fe9993cbcd2 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1462,7 +1462,7 @@ let CheckMultipleInputsInParallel let partialResults, (tcState, _) = let sequentialFiles, parallelFiles = List.take MAGIC_NUMBER inputsWithLoggers, List.skip MAGIC_NUMBER inputsWithLoggers - + let checkOneInput tcState priorErrors input logger = use _ = UseDiagnosticsLogger logger @@ -1496,9 +1496,30 @@ let CheckMultipleInputsInParallel checkOneInput sequentialTcState sequentialPriorErrors input logger ) |> fun results -> - let partialResult = Array.map fst results |> List.ofArray - let _, (tcState, priorErrors) = Array.head results - partialResult, (tcState, priorErrors) + let partialResults = Array.map fst results |> List.ofArray + let tcState = + (sequentialTcState, partialResults) + ||> List.fold(fun tcState partialResult -> + match partialResult with + | Choice1Of2 (tcEnvAtEnd, _topAttrs, Some implFile, ccuSigForFile) -> + AddCheckResultsToTcState( + tcGlobals, + tcImports.GetImportMap(), + false, + prefixPathOpt, + TcResultsSink.NoSink, + tcEnvAtEnd, + implFile.QualifiedNameOfFile, + ccuSigForFile + ) tcState + |> snd + | _ -> + // No signature files for now + tcState + ) + + let priorErrors = Array.fold (fun acc (_, (_, priorError)) -> acc || priorError) sequentialPriorErrors results + partialResults, (tcState, priorErrors) [ yield! sequentialPartialResults; yield! parallelPartialResults ], (parallelTcState, parallelPriorErrors) 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 From d4bea0f60a51a2b04cb2af6c116a3f8555760d52 Mon Sep 17 00:00:00 2001 From: nojaf Date: Wed, 12 Oct 2022 17:34:16 +0200 Subject: [PATCH 3/4] This no valid result. --- src/Compiler/Driver/ParseAndCheckInputs.fs | 128 +++++++++++++-------- 1 file changed, 81 insertions(+), 47 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index fe9993cbcd2..daec7852438 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 @@ -1463,63 +1464,96 @@ let CheckMultipleInputsInParallel let sequentialFiles, parallelFiles = List.take MAGIC_NUMBER inputsWithLoggers, List.skip MAGIC_NUMBER inputsWithLoggers - let checkOneInput tcState priorErrors input logger = - use _ = UseDiagnosticsLogger logger - - let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) - - let partialResult, tcState = - CheckOneInputAux( - checkForErrors2, - tcConfig, - tcImports, - tcGlobals, - prefixPathOpt, - TcResultsSink.NoSink, - tcState, - input, - true - ) - |> Cancellable.runWithoutCancellation - - let priorErrors = checkForErrors2 () - partialResult, (tcState, priorErrors) - let sequentialPartialResults, (sequentialTcState, sequentialPriorErrors) = ((tcState, priorErrors), sequentialFiles) ||> List.mapFold (fun (tcState, priorErrors) (input, logger) -> - checkOneInput tcState priorErrors input logger) + use _ = UseDiagnosticsLogger logger + let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0) + + 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) -> - checkOneInput sequentialTcState sequentialPriorErrors input logger + cancellable { + printfn "Start with %s" input.FileName + // Nojaf: 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 -> - let partialResults = Array.map fst results |> List.ofArray - let tcState = - (sequentialTcState, partialResults) - ||> List.fold(fun tcState partialResult -> - match partialResult with - | Choice1Of2 (tcEnvAtEnd, _topAttrs, Some implFile, ccuSigForFile) -> - AddCheckResultsToTcState( - tcGlobals, - tcImports.GetImportMap(), - false, - prefixPathOpt, - TcResultsSink.NoSink, - tcEnvAtEnd, - implFile.QualifiedNameOfFile, - ccuSigForFile - ) tcState - |> snd - | _ -> - // No signature files for now - tcState - ) + () - let priorErrors = Array.fold (fun acc (_, (_, priorError)) -> acc || priorError) sequentialPriorErrors results - partialResults, (tcState, priorErrors) + ((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) From ea54424f6ea2f268eb6a44b8ffa40d0b3a465510 Mon Sep 17 00:00:00 2001 From: nojaf Date: Thu, 13 Oct 2022 13:44:43 +0200 Subject: [PATCH 4/4] Format code. --- src/Compiler/Driver/ParseAndCheckInputs.fs | 67 +++++++++++----------- 1 file changed, 33 insertions(+), 34 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index daec7852438..1144a0bd045 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1485,10 +1485,10 @@ let CheckMultipleInputsInParallel |> Cancellable.runWithoutCancellation let priorErrors = checkForErrors2 () - partialResult, (tcState, priorErrors) - ) + partialResult, (tcState, priorErrors)) let amap = tcImports.GetImportMap() + let conditionalDefines = if tcConfig.noConditionalErasure then None @@ -1499,17 +1499,14 @@ let CheckMultipleInputsInParallel List.toArray parallelFiles |> ArrayParallel.map (fun (input, logger) -> cancellable { - printfn "Start with %s" input.FileName - // Nojaf: this is taken mostly from CheckOneInputAux, the case where the impl has no signature file - - + // 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( @@ -1526,34 +1523,36 @@ let CheckMultipleInputsInParallel 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 - ) + 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 - ) + |> 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) + ((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)