From d238d25d75f46ba11d52168271a20b1aa579e4fc Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 22 Feb 2021 16:52:35 -0800 Subject: [PATCH 01/19] Enabling parallel parsing for compiling --- src/fsharp/fsc.fs | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 4803a5632dc..8522e2361f9 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -19,6 +19,7 @@ open System.IO open System.Reflection open System.Text open System.Threading +open System.Threading.Tasks open Internal.Utilities open Internal.Utilities.Filename @@ -545,18 +546,21 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, let inputs = try - let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint - - List.zip sourceFiles isLastCompiland - // PERF: consider making this parallel, once uses of global state relevant to parsing are cleaned up - |> List.choose (fun (sourceFile, isLastCompiland) -> - - let sourceFileDirectory = Path.GetDirectoryName sourceFile - - match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], sourceFile, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) with - | Some input -> Some (input, sourceFileDirectory) - | None -> None) - + let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint + let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofSeq + let parallelOptions = ParallelOptions(MaxDegreeOfParallelism=min Environment.ProcessorCount sourceFiles.Length) + + let results = Array.zeroCreate sourceFiles.Length + Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> + results.[i] <- + let (filename: string, isLastCompiland) = sourceFiles.[i] + let pathOfMetaCommandSource = Path.GetDirectoryName filename + match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], filename, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) with + | Some input -> Some (input, pathOfMetaCommandSource) + | None -> None) |> ignore + results + |> Array.choose id + |> List.ofArray with e -> errorRecoveryNoRange e exiter.Exit 1 From 9724f27e0d3db503f1b6ed3dbd1b29ccf1f7691d Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 22 Feb 2021 17:34:09 -0800 Subject: [PATCH 02/19] Using a delayed error logger per parsing file --- src/fsharp/fsc.fs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 8522e2361f9..5f250545057 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -555,11 +555,15 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, results.[i] <- let (filename: string, isLastCompiland) = sourceFiles.[i] let pathOfMetaCommandSource = Path.GetDirectoryName filename - match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], filename, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) with - | Some input -> Some (input, pathOfMetaCommandSource) - | None -> None) |> ignore + let delayedErrorLogger = errorLoggerProvider.CreateDelayAndForwardLogger(exiter) + match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], filename, (isLastCompiland, isExe), delayedErrorLogger, (*retryLocked*)false) with + | Some input -> delayedErrorLogger, Some (input, pathOfMetaCommandSource) + | None -> delayedErrorLogger, None) |> ignore results - |> Array.choose id + |> Array.choose (fun (delayedErrorLogger, result) -> + delayedErrorLogger.CommitDelayedDiagnostics errorLogger + result + ) |> List.ofArray with e -> errorRecoveryNoRange e From 53f234a04c6210853893712c5c01e2fb295de950 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 23 Feb 2021 17:29:34 -0800 Subject: [PATCH 03/19] Added -parallel option --- src/fsharp/CompilerConfig.fs | 3 +++ src/fsharp/CompilerConfig.fsi | 2 ++ src/fsharp/CompilerOptions.fs | 8 ++++++ src/fsharp/FSComp.txt | 1 + src/fsharp/fsc.fs | 39 ++++++++++++++++----------- src/fsharp/xlf/FSComp.txt.cs.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.de.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.es.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.fr.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.it.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.ja.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.ko.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.pl.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.pt-BR.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.ru.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.tr.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.zh-Hans.xlf | 5 ++++ src/fsharp/xlf/FSComp.txt.zh-Hant.xlf | 5 ++++ 18 files changed, 103 insertions(+), 15 deletions(-) diff --git a/src/fsharp/CompilerConfig.fs b/src/fsharp/CompilerConfig.fs index 042df6f95a8..21af02c5ec1 100644 --- a/src/fsharp/CompilerConfig.fs +++ b/src/fsharp/CompilerConfig.fs @@ -425,6 +425,7 @@ type TcConfigBuilder = mutable optSettings: Optimizer.OptimizationSettings mutable emitTailcalls: bool mutable deterministic: bool + mutable concurrentBuild: bool mutable preferredUiLang: string option mutable lcid: int option mutable productNameForBannerText: string @@ -625,6 +626,7 @@ type TcConfigBuilder = optSettings = Optimizer.OptimizationSettings.Defaults emitTailcalls = true deterministic = false + concurrentBuild = true preferredUiLang = None lcid = None productNameForBannerText = FSharpProductName @@ -1001,6 +1003,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member x.optSettings = data.optSettings member x.emitTailcalls = data.emitTailcalls member x.deterministic = data.deterministic + member x.concurrentBuild = data.concurrentBuild member x.pathMap = data.pathMap member x.langVersion = data.langVersion member x.preferredUiLang = data.preferredUiLang diff --git a/src/fsharp/CompilerConfig.fsi b/src/fsharp/CompilerConfig.fsi index 5442a723133..3239c9c528f 100644 --- a/src/fsharp/CompilerConfig.fsi +++ b/src/fsharp/CompilerConfig.fsi @@ -232,6 +232,7 @@ type TcConfigBuilder = mutable optSettings : Optimizer.OptimizationSettings mutable emitTailcalls: bool mutable deterministic: bool + mutable concurrentBuild: bool mutable preferredUiLang: string option mutable lcid : int option mutable productNameForBannerText: string @@ -417,6 +418,7 @@ type TcConfig = member optSettings : Optimizer.OptimizationSettings member emitTailcalls: bool member deterministic: bool + member concurrentBuild: bool member pathMap: PathMap member preferredUiLang: string option member optsOn : bool diff --git a/src/fsharp/CompilerOptions.fs b/src/fsharp/CompilerOptions.fs index 41fb657d69b..fa4df23ede9 100644 --- a/src/fsharp/CompilerOptions.fs +++ b/src/fsharp/CompilerOptions.fs @@ -412,6 +412,9 @@ let SetTailcallSwitch (tcConfigB: TcConfigBuilder) switch = let SetDeterministicSwitch (tcConfigB: TcConfigBuilder) switch = tcConfigB.deterministic <- (switch = OptionSwitch.On) +let SetParallelSwitch (tcConfigB: TcConfigBuilder) switch = + tcConfigB.concurrentBuild <- (switch = OptionSwitch.On) + let AddPathMapping (tcConfigB: TcConfigBuilder) (pathPair: string) = match pathPair.Split([|'='|], 2) with | [| oldPrefix; newPrefix |] -> @@ -807,6 +810,11 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) = OptionSwitch (SetDeterministicSwitch tcConfigB), None, Some (FSComp.SR.optsDeterministic())) + CompilerOption + ("parallel", tagNone, + OptionSwitch (SetParallelSwitch tcConfigB), None, + Some (FSComp.SR.optsParallel())) + CompilerOption ("pathmap", tagPathMap, OptionStringList (AddPathMapping tcConfigB), None, diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 7fb9ecce89c..09a29852208 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -869,6 +869,7 @@ optsDebug,"Specify debugging type: full, portable, embedded, pdbonly. ('%s' is t optsOptimize,"Enable optimizations (Short form: -O)" optsTailcalls,"Enable or disable tailcalls" optsDeterministic,"Produce a deterministic assembly (including module version GUID and timestamp)" +optsParallel,"Specifies whether to use concurrent build" optsPathMap,"Maps physical paths to source path names output by the compiler" optsCrossoptimize,"Enable or disable cross-module optimizations" optsWarnaserrorPM,"Report all warnings as errors" diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 5f250545057..1be155b03a6 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -548,23 +548,32 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, try let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofSeq - let parallelOptions = ParallelOptions(MaxDegreeOfParallelism=min Environment.ProcessorCount sourceFiles.Length) - let results = Array.zeroCreate sourceFiles.Length - Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> - results.[i] <- - let (filename: string, isLastCompiland) = sourceFiles.[i] - let pathOfMetaCommandSource = Path.GetDirectoryName filename + let tryParse errorLogger (filename: string, isLastCompiland) = + let pathOfMetaCommandSource = Path.GetDirectoryName filename + match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], filename, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) with + | Some input -> Some (input, pathOfMetaCommandSource) + | None -> None + + if tcConfig.concurrentBuild then + let parallelOptions = ParallelOptions(MaxDegreeOfParallelism=min Environment.ProcessorCount sourceFiles.Length) + + let results = Array.zeroCreate sourceFiles.Length + Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> let delayedErrorLogger = errorLoggerProvider.CreateDelayAndForwardLogger(exiter) - match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], filename, (isLastCompiland, isExe), delayedErrorLogger, (*retryLocked*)false) with - | Some input -> delayedErrorLogger, Some (input, pathOfMetaCommandSource) - | None -> delayedErrorLogger, None) |> ignore - results - |> Array.choose (fun (delayedErrorLogger, result) -> - delayedErrorLogger.CommitDelayedDiagnostics errorLogger - result - ) - |> List.ofArray + results.[i] <- delayedErrorLogger, tryParse delayedErrorLogger sourceFiles.[i] + ) |> ignore + + results + |> Array.choose (fun (delayedErrorLogger, result) -> + delayedErrorLogger.CommitDelayedDiagnostics errorLogger + result + ) + |> List.ofArray + else + sourceFiles + |> Array.choose (tryParse errorLogger) + |> List.ofArray with e -> errorRecoveryNoRange e exiter.Exit 1 diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index e5743c212c4..4622c870078 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -252,6 +252,11 @@ Zobrazte si povolené hodnoty verze jazyka a pak zadejte požadovanou verzi, například latest nebo preview. + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: Podporované jazykové verze: diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index e4061568dfc..174e3d21d20 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -252,6 +252,11 @@ Zeigen Sie die zulässigen Werte für die Sprachversion an. Geben Sie die Sprachversion als "latest" oder "preview" an. + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: Unterstützte Sprachversionen: diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index 55cb7f62aa1..5f236450ee5 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -252,6 +252,11 @@ Mostrar los valores permitidos para la versión de idioma, especificar la versión de idioma como "latest" "preview" + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: Versiones de lenguaje admitidas: diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index 76f755025a9..50de0c528c3 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -252,6 +252,11 @@ Afficher les valeurs autorisées pour la version du langage, spécifier la version du langage comme 'dernière' ou 'préversion' + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: Versions linguistiques prises en charge : diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index 1a112ef13a9..785bebd7c65 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -252,6 +252,11 @@ Visualizza i valori consentiti per la versione del linguaggio. Specificare la versione del linguaggio, ad esempio 'latest' o 'preview' + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: Versioni del linguaggio supportate: diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 5ac6967a019..79d80058f51 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -252,6 +252,11 @@ 言語バージョンで許可された値を表示し、'最新' や 'プレビュー' などの言語バージョンを指定する + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: サポートされる言語バージョン: diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index 21b4ffeaba9..4406386f6d8 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -252,6 +252,11 @@ 언어 버전의 허용된 값을 표시하고 '최신' 또는 '미리 보기'와 같은 언어 버전을 지정합니다. + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: 지원되는 언어 버전: diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index 882b461778d..76a8f6cb8ed 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -252,6 +252,11 @@ Wyświetl dozwolone wartości dla wersji językowej; określ wersję językową, np. „latest” lub „preview” + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: Obsługiwane wersje językowe: diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index 2df5c973a32..061432ea8bd 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -252,6 +252,11 @@ Exibe os valores permitidos para a versão do idioma, especifica a versão do idioma, como 'mais recente ' ou 'prévia' + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: Versões de linguagens com suporte: diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index d5bdb943475..0be236f5457 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -252,6 +252,11 @@ Отображение допустимых значений для версии языка. Укажите версию языка, например, "latest" или "preview". + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: Поддерживаемые языковые версии: diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index b51c67434b5..9c4d53d25dd 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -252,6 +252,11 @@ Dil sürümü için izin verilen değerleri görüntüleyin, dil sürümünü 'en son' veya 'önizleme' örneklerindeki gibi belirtin + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: Desteklenen dil sürümleri: diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index 68f0e225ab5..61002e176dd 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -252,6 +252,11 @@ 显示语言版本的允许值，指定语言版本，如“最新”或“预览” + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: 支持的语言版本: diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index 1efa245134e..c08cbb27498 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -252,6 +252,11 @@ 顯示語言版本允許的值，指定 'latest' 或 'preview' 等語言版本 + + Specifies whether to use concurrent build + Specifies whether to use concurrent build + + Supported language versions: 支援的語言版本: From bf07e861fc8b9ad3cc2ab586589e36600f045ea8 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 23 Feb 2021 17:52:01 -0800 Subject: [PATCH 04/19] Fixing error logger --- src/fsharp/fsc.fs | 27 +++++++++++++++++++++++---- 1 file changed, 23 insertions(+), 4 deletions(-) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 1be155b03a6..8adbbc9951f 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -558,11 +558,30 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, if tcConfig.concurrentBuild then let parallelOptions = ParallelOptions(MaxDegreeOfParallelism=min Environment.ProcessorCount sourceFiles.Length) + let mutable exitCode = 0 + let delayedExiter = + { new Exiter with + member this.Exit n = exitCode <- n; raise StopProcessing } + let results = Array.zeroCreate sourceFiles.Length - Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> - let delayedErrorLogger = errorLoggerProvider.CreateDelayAndForwardLogger(exiter) - results.[i] <- delayedErrorLogger, tryParse delayedErrorLogger sourceFiles.[i] - ) |> ignore + + try + Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> + let delayedErrorLogger = errorLoggerProvider.CreateDelayAndForwardLogger(delayedExiter) + results.[i] <- delayedErrorLogger, tryParse delayedErrorLogger sourceFiles.[i] + ) |> ignore + with + | StopProcessing -> + results + |> Array.iter (fun result -> + match box result with + | null -> () + | _ -> + match result with + | delayedErrorLogger, _ -> + delayedErrorLogger.CommitDelayedDiagnostics errorLogger + ) + exiter.Exit exitCode results |> Array.choose (fun (delayedErrorLogger, result) -> From 4b7c652d403b0e58e6af44e701e8cdafd15e5c07 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 09:40:20 -0800 Subject: [PATCH 05/19] Moved parallel compiler option to be a test option --- src/fsharp/CompilerOptions.fs | 6 +- src/fsharp/FSComp.txt | 1 - src/fsharp/fsc.fs | 97 ++++++++++++++------------- src/fsharp/xlf/FSComp.txt.cs.xlf | 5 -- src/fsharp/xlf/FSComp.txt.de.xlf | 5 -- src/fsharp/xlf/FSComp.txt.es.xlf | 5 -- src/fsharp/xlf/FSComp.txt.fr.xlf | 5 -- src/fsharp/xlf/FSComp.txt.it.xlf | 5 -- src/fsharp/xlf/FSComp.txt.ja.xlf | 5 -- src/fsharp/xlf/FSComp.txt.ko.xlf | 5 -- src/fsharp/xlf/FSComp.txt.pl.xlf | 5 -- src/fsharp/xlf/FSComp.txt.pt-BR.xlf | 5 -- src/fsharp/xlf/FSComp.txt.ru.xlf | 5 -- src/fsharp/xlf/FSComp.txt.tr.xlf | 5 -- src/fsharp/xlf/FSComp.txt.zh-Hans.xlf | 5 -- src/fsharp/xlf/FSComp.txt.zh-Hant.xlf | 5 -- 16 files changed, 51 insertions(+), 118 deletions(-) diff --git a/src/fsharp/CompilerOptions.fs b/src/fsharp/CompilerOptions.fs index fa4df23ede9..17c63c9de5c 100644 --- a/src/fsharp/CompilerOptions.fs +++ b/src/fsharp/CompilerOptions.fs @@ -810,11 +810,6 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) = OptionSwitch (SetDeterministicSwitch tcConfigB), None, Some (FSComp.SR.optsDeterministic())) - CompilerOption - ("parallel", tagNone, - OptionSwitch (SetParallelSwitch tcConfigB), None, - Some (FSComp.SR.optsParallel())) - CompilerOption ("pathmap", tagPathMap, OptionStringList (AddPathMapping tcConfigB), None, @@ -1044,6 +1039,7 @@ let testFlag tcConfigB = | "DumpDebugInfo" -> tcConfigB.dumpDebugInfo <- true | "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true | "ContinueAfterParseFailure" -> tcConfigB.continueAfterParseFailure <- true + | "ParallelOff" -> tcConfigB.concurrentBuild <- false #if DEBUG | "ShowParserStackOnParseError" -> showParserStackOnParseError <- true #endif diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 09a29852208..7fb9ecce89c 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -869,7 +869,6 @@ optsDebug,"Specify debugging type: full, portable, embedded, pdbonly. ('%s' is t optsOptimize,"Enable optimizations (Short form: -O)" optsTailcalls,"Enable or disable tailcalls" optsDeterministic,"Produce a deterministic assembly (including module version GUID and timestamp)" -optsParallel,"Specifies whether to use concurrent build" optsPathMap,"Maps physical paths to source path names output by the compiler" optsCrossoptimize,"Enable or disable cross-module optimizations" optsWarnaserrorPM,"Report all warnings as errors" diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 8adbbc9951f..165e8bb0694 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -412,6 +412,55 @@ let TryFindVersionAttribute g attrib attribName attribs deterministic = None | _ -> None +let parseFiles (tcConfig: TcConfig) lexResourceManager (exiter: Exiter) (errorLoggerProvider: ErrorLoggerProvider) errorLogger sourceFiles = + let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint + let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofSeq + + let tryParse errorLogger (filename: string, isLastCompiland) = + let pathOfMetaCommandSource = Path.GetDirectoryName filename + match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], filename, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) with + | Some input -> Some (input, pathOfMetaCommandSource) + | None -> None + + if tcConfig.concurrentBuild then + let parallelOptions = ParallelOptions(MaxDegreeOfParallelism=min Environment.ProcessorCount sourceFiles.Length) + + let mutable exitCode = 0 + let delayedExiter = + { new Exiter with + member this.Exit n = exitCode <- n; raise StopProcessing } + + let results = Array.zeroCreate sourceFiles.Length + + try + Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> + let delayedErrorLogger = errorLoggerProvider.CreateDelayAndForwardLogger(delayedExiter) + results.[i] <- delayedErrorLogger, tryParse delayedErrorLogger sourceFiles.[i] + ) |> ignore + with + | StopProcessing -> + results + |> Array.iter (fun result -> + match box result with + | null -> () + | _ -> + match result with + | delayedErrorLogger, _ -> + delayedErrorLogger.CommitDelayedDiagnostics errorLogger + ) + exiter.Exit exitCode + + results + |> Array.choose (fun (delayedErrorLogger, result) -> + delayedErrorLogger.CommitDelayedDiagnostics errorLogger + result + ) + |> List.ofArray + else + sourceFiles + |> Array.choose (tryParse errorLogger) + |> List.ofArray + //---------------------------------------------------------------------------- // Main phases of compilation. These are written as separate functions with explicit argument passing // to ensure transient objects are eligible for GC and only actual required information @@ -546,53 +595,7 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, let inputs = try - let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint - let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofSeq - - let tryParse errorLogger (filename: string, isLastCompiland) = - let pathOfMetaCommandSource = Path.GetDirectoryName filename - match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], filename, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) with - | Some input -> Some (input, pathOfMetaCommandSource) - | None -> None - - if tcConfig.concurrentBuild then - let parallelOptions = ParallelOptions(MaxDegreeOfParallelism=min Environment.ProcessorCount sourceFiles.Length) - - let mutable exitCode = 0 - let delayedExiter = - { new Exiter with - member this.Exit n = exitCode <- n; raise StopProcessing } - - let results = Array.zeroCreate sourceFiles.Length - - try - Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> - let delayedErrorLogger = errorLoggerProvider.CreateDelayAndForwardLogger(delayedExiter) - results.[i] <- delayedErrorLogger, tryParse delayedErrorLogger sourceFiles.[i] - ) |> ignore - with - | StopProcessing -> - results - |> Array.iter (fun result -> - match box result with - | null -> () - | _ -> - match result with - | delayedErrorLogger, _ -> - delayedErrorLogger.CommitDelayedDiagnostics errorLogger - ) - exiter.Exit exitCode - - results - |> Array.choose (fun (delayedErrorLogger, result) -> - delayedErrorLogger.CommitDelayedDiagnostics errorLogger - result - ) - |> List.ofArray - else - sourceFiles - |> Array.choose (tryParse errorLogger) - |> List.ofArray + parseFiles tcConfig lexResourceManager exiter errorLoggerProvider errorLogger sourceFiles with e -> errorRecoveryNoRange e exiter.Exit 1 diff --git a/src/fsharp/xlf/FSComp.txt.cs.xlf b/src/fsharp/xlf/FSComp.txt.cs.xlf index 4622c870078..e5743c212c4 100644 --- a/src/fsharp/xlf/FSComp.txt.cs.xlf +++ b/src/fsharp/xlf/FSComp.txt.cs.xlf @@ -252,11 +252,6 @@ Zobrazte si povolené hodnoty verze jazyka a pak zadejte požadovanou verzi, například latest nebo preview. - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: Podporované jazykové verze: diff --git a/src/fsharp/xlf/FSComp.txt.de.xlf b/src/fsharp/xlf/FSComp.txt.de.xlf index 174e3d21d20..e4061568dfc 100644 --- a/src/fsharp/xlf/FSComp.txt.de.xlf +++ b/src/fsharp/xlf/FSComp.txt.de.xlf @@ -252,11 +252,6 @@ Zeigen Sie die zulässigen Werte für die Sprachversion an. Geben Sie die Sprachversion als "latest" oder "preview" an. - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: Unterstützte Sprachversionen: diff --git a/src/fsharp/xlf/FSComp.txt.es.xlf b/src/fsharp/xlf/FSComp.txt.es.xlf index 5f236450ee5..55cb7f62aa1 100644 --- a/src/fsharp/xlf/FSComp.txt.es.xlf +++ b/src/fsharp/xlf/FSComp.txt.es.xlf @@ -252,11 +252,6 @@ Mostrar los valores permitidos para la versión de idioma, especificar la versión de idioma como "latest" "preview" - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: Versiones de lenguaje admitidas: diff --git a/src/fsharp/xlf/FSComp.txt.fr.xlf b/src/fsharp/xlf/FSComp.txt.fr.xlf index 50de0c528c3..76f755025a9 100644 --- a/src/fsharp/xlf/FSComp.txt.fr.xlf +++ b/src/fsharp/xlf/FSComp.txt.fr.xlf @@ -252,11 +252,6 @@ Afficher les valeurs autorisées pour la version du langage, spécifier la version du langage comme 'dernière' ou 'préversion' - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: Versions linguistiques prises en charge : diff --git a/src/fsharp/xlf/FSComp.txt.it.xlf b/src/fsharp/xlf/FSComp.txt.it.xlf index 785bebd7c65..1a112ef13a9 100644 --- a/src/fsharp/xlf/FSComp.txt.it.xlf +++ b/src/fsharp/xlf/FSComp.txt.it.xlf @@ -252,11 +252,6 @@ Visualizza i valori consentiti per la versione del linguaggio. Specificare la versione del linguaggio, ad esempio 'latest' o 'preview' - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: Versioni del linguaggio supportate: diff --git a/src/fsharp/xlf/FSComp.txt.ja.xlf b/src/fsharp/xlf/FSComp.txt.ja.xlf index 79d80058f51..5ac6967a019 100644 --- a/src/fsharp/xlf/FSComp.txt.ja.xlf +++ b/src/fsharp/xlf/FSComp.txt.ja.xlf @@ -252,11 +252,6 @@ 言語バージョンで許可された値を表示し、'最新' や 'プレビュー' などの言語バージョンを指定する - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: サポートされる言語バージョン: diff --git a/src/fsharp/xlf/FSComp.txt.ko.xlf b/src/fsharp/xlf/FSComp.txt.ko.xlf index 4406386f6d8..21b4ffeaba9 100644 --- a/src/fsharp/xlf/FSComp.txt.ko.xlf +++ b/src/fsharp/xlf/FSComp.txt.ko.xlf @@ -252,11 +252,6 @@ 언어 버전의 허용된 값을 표시하고 '최신' 또는 '미리 보기'와 같은 언어 버전을 지정합니다. - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: 지원되는 언어 버전: diff --git a/src/fsharp/xlf/FSComp.txt.pl.xlf b/src/fsharp/xlf/FSComp.txt.pl.xlf index 76a8f6cb8ed..882b461778d 100644 --- a/src/fsharp/xlf/FSComp.txt.pl.xlf +++ b/src/fsharp/xlf/FSComp.txt.pl.xlf @@ -252,11 +252,6 @@ Wyświetl dozwolone wartości dla wersji językowej; określ wersję językową, np. „latest” lub „preview” - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: Obsługiwane wersje językowe: diff --git a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf index 061432ea8bd..2df5c973a32 100644 --- a/src/fsharp/xlf/FSComp.txt.pt-BR.xlf +++ b/src/fsharp/xlf/FSComp.txt.pt-BR.xlf @@ -252,11 +252,6 @@ Exibe os valores permitidos para a versão do idioma, especifica a versão do idioma, como 'mais recente ' ou 'prévia' - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: Versões de linguagens com suporte: diff --git a/src/fsharp/xlf/FSComp.txt.ru.xlf b/src/fsharp/xlf/FSComp.txt.ru.xlf index 0be236f5457..d5bdb943475 100644 --- a/src/fsharp/xlf/FSComp.txt.ru.xlf +++ b/src/fsharp/xlf/FSComp.txt.ru.xlf @@ -252,11 +252,6 @@ Отображение допустимых значений для версии языка. Укажите версию языка, например, "latest" или "preview". - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: Поддерживаемые языковые версии: diff --git a/src/fsharp/xlf/FSComp.txt.tr.xlf b/src/fsharp/xlf/FSComp.txt.tr.xlf index 9c4d53d25dd..b51c67434b5 100644 --- a/src/fsharp/xlf/FSComp.txt.tr.xlf +++ b/src/fsharp/xlf/FSComp.txt.tr.xlf @@ -252,11 +252,6 @@ Dil sürümü için izin verilen değerleri görüntüleyin, dil sürümünü 'en son' veya 'önizleme' örneklerindeki gibi belirtin - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: Desteklenen dil sürümleri: diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf index 61002e176dd..68f0e225ab5 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hans.xlf @@ -252,11 +252,6 @@ 显示语言版本的允许值，指定语言版本，如“最新”或“预览” - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: 支持的语言版本: diff --git a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf index c08cbb27498..1efa245134e 100644 --- a/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/fsharp/xlf/FSComp.txt.zh-Hant.xlf @@ -252,11 +252,6 @@ 顯示語言版本允許的值，指定 'latest' 或 'preview' 等語言版本 - - Specifies whether to use concurrent build - Specifies whether to use concurrent build - - Supported language versions: 支援的語言版本: From d2198df8ea80c7293c83b32704b3417842bb0085 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 12:03:10 -0800 Subject: [PATCH 06/19] Trying to get tests to pass --- src/fsharp/ParseAndCheckInputs.fs | 22 +++++++++++++++------- src/fsharp/ParseAndCheckInputs.fsi | 3 +++ src/fsharp/fsc.fs | 7 +++++++ 3 files changed, 25 insertions(+), 7 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 35b33ca82a5..5407dbbcdaf 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -368,15 +368,23 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp let ValidSuffixes = FSharpSigFileSuffixes@FSharpImplFileSuffixes -/// Parse an input from disk -let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) = - try - let lower = String.lowercase filename +/// Checks to see if the file exists. +let CheckFileExists filename = + let lower = String.lowercase filename + + if List.exists (Filename.checkSuffix lower) ValidSuffixes then - if List.exists (Filename.checkSuffix lower) ValidSuffixes then + if not(FileSystem.SafeExists filename) then + error(Error(FSComp.SR.buildCouldNotFindSourceFile filename, rangeStartup)) - if not(FileSystem.SafeExists filename) then - error(Error(FSComp.SR.buildCouldNotFindSourceFile filename, rangeStartup)) + true + else + false + +/// Parse an input from disk +let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) = + try + if CheckFileExists filename then // Get a stream reader for the file use reader = File.OpenReaderAndRetry (filename, tcConfig.inputCodePage, retryLocked) diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index 21f20a056e6..91756b6fb72 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -46,6 +46,9 @@ val ApplyMetaCommandsFromInputToTcConfig: TcConfig * ParsedInput * string * Depe /// Process the #nowarn in an input and integrate them into the TcConfig val ApplyNoWarnsToTcConfig: TcConfig * ParsedInput * string -> TcConfig +/// Checks to see if the file exists. +val CheckFileExists: filename: string -> bool + /// Parse one input file val ParseOneInputFile: TcConfig * Lexhelp.LexResourceManager * string list * string * isLastCompiland: (bool * bool) * ErrorLogger * (*retryLocked*) bool -> ParsedInput option diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 165e8bb0694..31ceba9c4be 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -433,6 +433,13 @@ let parseFiles (tcConfig: TcConfig) lexResourceManager (exiter: Exiter) (errorLo let results = Array.zeroCreate sourceFiles.Length try + + // Check to see if the file exists before we try to parallelize them. + sourceFiles + |> Array.iter (fun (filename, _) -> + CheckFileExists filename |> ignore + ) + Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> let delayedErrorLogger = errorLoggerProvider.CreateDelayAndForwardLogger(delayedExiter) results.[i] <- delayedErrorLogger, tryParse delayedErrorLogger sourceFiles.[i] From d4ad54c07753df228d9b859b0866925f24ff1659 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 13:05:54 -0800 Subject: [PATCH 07/19] Remove switch --- src/fsharp/CompilerOptions.fs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/fsharp/CompilerOptions.fs b/src/fsharp/CompilerOptions.fs index 17c63c9de5c..d25a4b138a2 100644 --- a/src/fsharp/CompilerOptions.fs +++ b/src/fsharp/CompilerOptions.fs @@ -412,9 +412,6 @@ let SetTailcallSwitch (tcConfigB: TcConfigBuilder) switch = let SetDeterministicSwitch (tcConfigB: TcConfigBuilder) switch = tcConfigB.deterministic <- (switch = OptionSwitch.On) -let SetParallelSwitch (tcConfigB: TcConfigBuilder) switch = - tcConfigB.concurrentBuild <- (switch = OptionSwitch.On) - let AddPathMapping (tcConfigB: TcConfigBuilder) (pathPair: string) = match pathPair.Split([|'='|], 2) with | [| oldPrefix; newPrefix |] -> From 23d81e3e41d45444013ed2719bb8a2b36484e5ed Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 13:12:13 -0800 Subject: [PATCH 08/19] Minor refactor --- src/fsharp/ParseAndCheckInputs.fs | 26 ++++++++++++-------------- src/fsharp/ParseAndCheckInputs.fsi | 3 --- src/fsharp/fsc.fs | 7 ------- 3 files changed, 12 insertions(+), 24 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 5407dbbcdaf..ede5b6f1810 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -368,23 +368,21 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp let ValidSuffixes = FSharpSigFileSuffixes@FSharpImplFileSuffixes -/// Checks to see if the file exists. -let CheckFileExists filename = - let lower = String.lowercase filename - - if List.exists (Filename.checkSuffix lower) ValidSuffixes then - - if not(FileSystem.SafeExists filename) then - error(Error(FSComp.SR.buildCouldNotFindSourceFile filename, rangeStartup)) - - true - else - false - /// Parse an input from disk let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) = + let isValid = + let lower = String.lowercase filename + + if List.exists (Filename.checkSuffix lower) ValidSuffixes then + + if not(FileSystem.SafeExists filename) then + error(Error(FSComp.SR.buildCouldNotFindSourceFile filename, rangeStartup)) + + true + else + false try - if CheckFileExists filename then + if isValid then // Get a stream reader for the file use reader = File.OpenReaderAndRetry (filename, tcConfig.inputCodePage, retryLocked) diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index 91756b6fb72..21f20a056e6 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -46,9 +46,6 @@ val ApplyMetaCommandsFromInputToTcConfig: TcConfig * ParsedInput * string * Depe /// Process the #nowarn in an input and integrate them into the TcConfig val ApplyNoWarnsToTcConfig: TcConfig * ParsedInput * string -> TcConfig -/// Checks to see if the file exists. -val CheckFileExists: filename: string -> bool - /// Parse one input file val ParseOneInputFile: TcConfig * Lexhelp.LexResourceManager * string list * string * isLastCompiland: (bool * bool) * ErrorLogger * (*retryLocked*) bool -> ParsedInput option diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 31ceba9c4be..165e8bb0694 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -433,13 +433,6 @@ let parseFiles (tcConfig: TcConfig) lexResourceManager (exiter: Exiter) (errorLo let results = Array.zeroCreate sourceFiles.Length try - - // Check to see if the file exists before we try to parallelize them. - sourceFiles - |> Array.iter (fun (filename, _) -> - CheckFileExists filename |> ignore - ) - Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> let delayedErrorLogger = errorLoggerProvider.CreateDelayAndForwardLogger(delayedExiter) results.[i] <- delayedErrorLogger, tryParse delayedErrorLogger sourceFiles.[i] From 3f32f7de514e8e7bf33c98cf5b5dfa8410183c19 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 14:40:58 -0800 Subject: [PATCH 09/19] More refactoring --- src/fsharp/ParseAndCheckInputs.fs | 114 +++++++++++++++++++++++------ src/fsharp/ParseAndCheckInputs.fsi | 5 +- src/fsharp/fsc.fs | 57 +-------------- src/fsharp/lib.fs | 24 ++++++ src/fsharp/lib.fsi | 9 +++ 5 files changed, 130 insertions(+), 79 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index ede5b6f1810..a9806f2fbe7 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -368,37 +368,105 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp let ValidSuffixes = FSharpSigFileSuffixes@FSharpImplFileSuffixes -/// Parse an input from disk -let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) = - let isValid = - let lower = String.lowercase filename - - if List.exists (Filename.checkSuffix lower) ValidSuffixes then - - if not(FileSystem.SafeExists filename) then - error(Error(FSComp.SR.buildCouldNotFindSourceFile filename, rangeStartup)) - - true - else - false - try - if isValid then +let checkInputFile (tcConfig: TcConfig) filename = + let lower = String.lowercase filename - // Get a stream reader for the file - use reader = File.OpenReaderAndRetry (filename, tcConfig.inputCodePage, retryLocked) + if List.exists (Filename.checkSuffix lower) ValidSuffixes then + if not(FileSystem.SafeExists filename) then + error(Error(FSComp.SR.buildCouldNotFindSourceFile filename, rangeStartup)) + else + error(Error(FSComp.SR.buildInvalidSourceFileExtension(SanitizeFileName filename tcConfig.implicitIncludeDir), rangeStartup)) + +let parseInputFileAux (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) = + try + // Get a stream reader for the file + use reader = File.OpenReaderAndRetry (filename, tcConfig.inputCodePage, retryLocked) - // Set up the LexBuffer for the file - let lexbuf = UnicodeLexing.StreamReaderAsLexbuf(tcConfig.langVersion.SupportsFeature, reader) + // Set up the LexBuffer for the file + let lexbuf = UnicodeLexing.StreamReaderAsLexbuf(tcConfig.langVersion.SupportsFeature, reader) - // Parse the file drawing tokens from the lexbuf - ParseOneInputLexbuf(tcConfig, lexResourceManager, conditionalCompilationDefines, lexbuf, filename, isLastCompiland, errorLogger) - else - error(Error(FSComp.SR.buildInvalidSourceFileExtension(SanitizeFileName filename tcConfig.implicitIncludeDir), rangeStartup)) + // Parse the file drawing tokens from the lexbuf + ParseOneInputLexbuf(tcConfig, lexResourceManager, conditionalCompilationDefines, lexbuf, filename, isLastCompiland, errorLogger) + with e -> + errorRecovery e rangeStartup + None +/// Parse an input from disk +let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) = + try + checkInputFile tcConfig filename + parseInputFileAux(tcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) with e -> errorRecovery e rangeStartup None +let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, sourceFiles, errorLogger: ErrorLogger, exiter: Exiter, createErrorLogger: (Exiter -> CapturingErrorLogger), retryLocked) = + try + let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint + let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofSeq + + if tcConfig.concurrentBuild then + let mutable exitCode = 0 + let delayedExiter = + { new Exiter with + member this.Exit n = exitCode <- n; raise StopProcessing } + + // Check input files and create delayed error loggers before we try to parallel parse. + let delayedErrorLoggers = + sourceFiles + |> Array.map (fun (filename, _) -> + checkInputFile tcConfig filename + createErrorLogger(delayedExiter) + ) + + let commitDelayedErrorLoggers () = + delayedErrorLoggers + |> Array.iter (fun delayedErrorLogger -> + delayedErrorLogger.CommitDelayedDiagnostics errorLogger + ) + + let results = + try + sourceFiles + |> ArrayParallel.mapi (fun i (filename, isLastCompiland) -> + let delayedErrorLogger = delayedErrorLoggers.[i] + + let result = + let directoryName = Path.GetDirectoryName filename + match parseInputFileAux(tcConfig, lexResourceManager, conditionalCompilationDefines, filename, (isLastCompiland, isExe), errorLogger, retryLocked) with + | Some input -> Some (input, directoryName) + | None -> None + + delayedErrorLogger, result + ) + with + | StopProcessing -> + commitDelayedErrorLoggers () + exiter.Exit exitCode + + | _ -> + commitDelayedErrorLoggers () + reraise() + + results + |> Array.choose (fun (delayedErrorLogger, result) -> + delayedErrorLogger.CommitDelayedDiagnostics errorLogger + result + ) + |> List.ofArray + else + sourceFiles + |> Array.choose (fun (filename, isLastCompiland) -> + let directoryName = Path.GetDirectoryName filename + match ParseOneInputFile(tcConfig, lexResourceManager, conditionalCompilationDefines, filename, (isLastCompiland, isExe), errorLogger, retryLocked) with + | Some input -> Some (input, directoryName) + | None -> None) + |> List.ofArray + + with e -> + errorRecoveryNoRange e + exiter.Exit 1 + let ProcessMetaCommandsFromInput (nowarnF: 'state -> range * string -> 'state, hashReferenceF: 'state -> range * string * Directive -> 'state, diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index 21f20a056e6..8128d36b0eb 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -47,7 +47,10 @@ val ApplyMetaCommandsFromInputToTcConfig: TcConfig * ParsedInput * string * Depe val ApplyNoWarnsToTcConfig: TcConfig * ParsedInput * string -> TcConfig /// Parse one input file -val ParseOneInputFile: TcConfig * Lexhelp.LexResourceManager * string list * string * isLastCompiland: (bool * bool) * ErrorLogger * (*retryLocked*) bool -> ParsedInput option +val ParseOneInputFile: TcConfig * Lexhelp.LexResourceManager * conditionalCompilationDefines: string list * string * isLastCompiland: (bool * bool) * ErrorLogger * retryLocked: bool -> ParsedInput option + +/// Parse multiple input files +val ParseInputFiles: TcConfig * Lexhelp.LexResourceManager * conditionalCompilationDefines: string list * string list * ErrorLogger * Exiter * createErrorLogger: (Exiter -> CapturingErrorLogger) * retryLocked: bool -> (ParsedInput * string) list /// Get the initial type checking environment including the loading of mscorlib/System.Core, FSharp.Core /// applying the InternalsVisibleTo in referenced assemblies and opening 'Checked' if requested. diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 165e8bb0694..c3cec133783 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -412,55 +412,6 @@ let TryFindVersionAttribute g attrib attribName attribs deterministic = None | _ -> None -let parseFiles (tcConfig: TcConfig) lexResourceManager (exiter: Exiter) (errorLoggerProvider: ErrorLoggerProvider) errorLogger sourceFiles = - let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint - let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofSeq - - let tryParse errorLogger (filename: string, isLastCompiland) = - let pathOfMetaCommandSource = Path.GetDirectoryName filename - match ParseOneInputFile(tcConfig, lexResourceManager, ["COMPILED"], filename, (isLastCompiland, isExe), errorLogger, (*retryLocked*)false) with - | Some input -> Some (input, pathOfMetaCommandSource) - | None -> None - - if tcConfig.concurrentBuild then - let parallelOptions = ParallelOptions(MaxDegreeOfParallelism=min Environment.ProcessorCount sourceFiles.Length) - - let mutable exitCode = 0 - let delayedExiter = - { new Exiter with - member this.Exit n = exitCode <- n; raise StopProcessing } - - let results = Array.zeroCreate sourceFiles.Length - - try - Parallel.For(0, sourceFiles.Length, parallelOptions, fun i -> - let delayedErrorLogger = errorLoggerProvider.CreateDelayAndForwardLogger(delayedExiter) - results.[i] <- delayedErrorLogger, tryParse delayedErrorLogger sourceFiles.[i] - ) |> ignore - with - | StopProcessing -> - results - |> Array.iter (fun result -> - match box result with - | null -> () - | _ -> - match result with - | delayedErrorLogger, _ -> - delayedErrorLogger.CommitDelayedDiagnostics errorLogger - ) - exiter.Exit exitCode - - results - |> Array.choose (fun (delayedErrorLogger, result) -> - delayedErrorLogger.CommitDelayedDiagnostics errorLogger - result - ) - |> List.ofArray - else - sourceFiles - |> Array.choose (tryParse errorLogger) - |> List.ofArray - //---------------------------------------------------------------------------- // Main phases of compilation. These are written as separate functions with explicit argument passing // to ensure transient objects are eligible for GC and only actual required information @@ -593,12 +544,8 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, ReportTime tcConfig "Parse inputs" use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - let inputs = - try - parseFiles tcConfig lexResourceManager exiter errorLoggerProvider errorLogger sourceFiles - with e -> - errorRecoveryNoRange e - exiter.Exit 1 + let createErrorLogger = (fun exiter -> errorLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingErrorLogger) + let inputs = ParseInputFiles(tcConfig, lexResourceManager, ["COMPILED"], sourceFiles, errorLogger, exiter, createErrorLogger, (*retryLocked*)false) let inputs, _ = (Map.empty, inputs) ||> List.mapFold (fun state (input, x) -> diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 692046b92e5..2fb343fb6e8 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -5,6 +5,7 @@ module internal Internal.Utilities.Library.Extras open System open System.IO open System.Collections.Generic +open System.Threading.Tasks open System.Runtime.InteropServices open Internal.Utilities open Internal.Utilities.Collections @@ -594,3 +595,26 @@ type DisposablesTracker() = items.Clear() for i in l do try i.Dispose() with _ -> () + +/// Specialized parallel functions for an array. +/// Different from Array.Parallel as it will try to minimize the max degree of parallelism. +[] +module ArrayParallel = + + let inline iteri f (arr: 'T []) = + let parallelOptions = ParallelOptions(MaxDegreeOfParallelism=min Environment.ProcessorCount arr.Length) + Parallel.For(0, arr.Length, parallelOptions, fun i -> + f i arr.[i] + ) |> ignore + + let inline iter f (arr: 'T []) = + arr |> iteri (fun _ item -> f item) + + let inline mapi f (arr: 'T []) = + let mapped = Array.zeroCreate arr.Length + arr |> iteri (fun i item -> mapped.[i] <- f i item) + mapped + + let inline map f (arr: 'T []) = + arr |> mapi (fun _ item -> f item) + \ No newline at end of file diff --git a/src/fsharp/lib.fsi b/src/fsharp/lib.fsi index ceea83cf55b..24abefea3ad 100644 --- a/src/fsharp/lib.fsi +++ b/src/fsharp/lib.fsi @@ -288,3 +288,12 @@ type DisposablesTracker = member Register: i:System.IDisposable -> unit interface System.IDisposable + +/// Specialized parallel functions for an array. +/// Different from Array.Parallel as it will try to minimize the max degree of parallelism. +[] +module ArrayParallel = + + val inline map : ('T -> 'U) -> 'T [] -> 'U [] + + val inline mapi : (int -> 'T -> 'U) -> 'T [] -> 'U [] \ No newline at end of file From 03c8b8a63a01bc90eba3a88b3128e32b997f9b20 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 14:43:21 -0800 Subject: [PATCH 10/19] Add comment --- src/fsharp/ParseAndCheckInputs.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index a9806f2fbe7..3ae5660c0f2 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -400,6 +400,7 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompil errorRecovery e rangeStartup None +/// Parse multiple input files let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, conditionalCompilationDefines, sourceFiles, errorLogger: ErrorLogger, exiter: Exiter, createErrorLogger: (Exiter -> CapturingErrorLogger), retryLocked) = try let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint From 51c897ba94a2bba26afeb878565188c3042b0382 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 15:48:03 -0800 Subject: [PATCH 11/19] Initial work for parallel type checking --- src/fsharp/ParseAndCheckInputs.fs | 35 ++++++++++++++++++++++++++++-- src/fsharp/ParseAndCheckInputs.fsi | 2 ++ src/fsharp/lib.fsi | 4 ++++ 3 files changed, 39 insertions(+), 2 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 3ae5660c0f2..9b54e88b9d9 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -703,6 +703,9 @@ 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) = @@ -879,6 +882,14 @@ let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, pre TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) |> Eventually.force ctok +/// Typecheck a single file (or interactive entry into F# Interactive) +let TypeCheckOneInputSkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = + // '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 + TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, true) + |> Eventually.force ctok + /// Finish checking multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputsFinish(results, tcState: TcState) = let tcEnvsAtEndFile, topAttrs, implFiles, ccuSigsForFiles = List.unzip4 results @@ -910,7 +921,27 @@ let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) = 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 (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) - let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(results, tcState) + let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInputSkipImpl (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 + |> ArrayParallel.iteri (fun i (input, (_, _, implOpt, _)) -> + match implOpt with + | None -> () + | Some impl -> + match impl with + | TypedImplFile.TImplFile(qualifiedNameOfFile=qualifiedNameOfFile;implementationExpressionWithSignature=ModuleOrNamespaceExprWithSig.ModuleOrNamespaceExprWithSig(contents=ModuleOrNamespaceExpr.TMDefs [])) -> + let tcState = tcState.RemoveImpl(qualifiedNameOfFile) + let result, _ = TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input + newResults.[i] <- result + | _ -> + () + ) + + let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(newResults |> List.ofArray, tcState) let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index 8128d36b0eb..682167eecae 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -78,6 +78,8 @@ type TcState = member CreatesGeneratedProvidedTypes: bool + member RemoveImpl: QualifiedNameOfFile -> TcState + /// Get the initial type checking state for a set of inputs val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * NiceNameGenerator * TcEnv -> TcState diff --git a/src/fsharp/lib.fsi b/src/fsharp/lib.fsi index 24abefea3ad..c7dfd1189da 100644 --- a/src/fsharp/lib.fsi +++ b/src/fsharp/lib.fsi @@ -294,6 +294,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 [] \ No newline at end of file From d3c674de4649d957e927e15d0140566145e31838 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 16:04:06 -0800 Subject: [PATCH 12/19] Minor refactor --- src/fsharp/ParseAndCheckInputs.fs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 9b54e88b9d9..3aba4f928c3 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -929,17 +929,21 @@ let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobal (inputs, results) ||> Array.zip - |> ArrayParallel.iteri (fun i (input, (_, _, implOpt, _)) -> + |> Array.mapi (fun i (input, (_, _, implOpt, _)) -> match implOpt with - | None -> () + | None -> None | Some impl -> match impl with | TypedImplFile.TImplFile(qualifiedNameOfFile=qualifiedNameOfFile;implementationExpressionWithSignature=ModuleOrNamespaceExprWithSig.ModuleOrNamespaceExprWithSig(contents=ModuleOrNamespaceExpr.TMDefs [])) -> - let tcState = tcState.RemoveImpl(qualifiedNameOfFile) - let result, _ = TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input - newResults.[i] <- result + Some(i, input, qualifiedNameOfFile) | _ -> - () + None + ) + |> Array.choose id + |> ArrayParallel.iter (fun (i, input, qualifiedNameOfFile) -> + let tcState = tcState.RemoveImpl(qualifiedNameOfFile) + let result, _ = TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input + newResults.[i] <- result ) let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(newResults |> List.ofArray, tcState) From 20f285ee7764c74e229a4055a8452d4f1c6e9042 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 16:38:02 -0800 Subject: [PATCH 13/19] Add max --- src/fsharp/lib.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 2fb343fb6e8..ad6c7421c6c 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -602,7 +602,7 @@ type DisposablesTracker() = module ArrayParallel = let inline iteri f (arr: 'T []) = - let parallelOptions = ParallelOptions(MaxDegreeOfParallelism=min Environment.ProcessorCount arr.Length) + let parallelOptions = ParallelOptions(MaxDegreeOfParallelism = max (min Environment.ProcessorCount arr.Length) 1) Parallel.For(0, arr.Length, parallelOptions, fun i -> f i arr.[i] ) |> ignore From 6b06c3a18d1f105bff21f958c7d605ce8cc756bf Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 25 Feb 2021 17:05:26 -0800 Subject: [PATCH 14/19] Some cleanup --- src/fsharp/ParseAndCheckInputs.fs | 60 +++++++++++++++++-------------- 1 file changed, 33 insertions(+), 27 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 3aba4f928c3..a8d167406ee 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -919,33 +919,39 @@ let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) = tcState, declaredImpls -let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = +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 = (tcState, inputs) ||> List.mapFold (TypeCheckOneInputSkipImpl (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, _ = TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input - newResults.[i] <- result - ) - - let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(newResults |> List.ofArray, tcState) + let results, tcState = + if tcConfig.concurrentBuild then + let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInputSkipImpl (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, _ = TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input + newResults.[i] <- result + ) + + newResults |> List.ofArray, tcState + else + (tcState, inputs) ||> List.mapFold (TypeCheckOneInputSkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + + let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(results, tcState) let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile From c6c54b91770393b4c074e263b8ed7f24a909dfe1 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Fri, 26 Feb 2021 09:50:07 -0800 Subject: [PATCH 15/19] do not use SkipImpl --- src/fsharp/ParseAndCheckInputs.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index a8d167406ee..7da63ded29d 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -950,7 +950,7 @@ let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports newResults |> List.ofArray, tcState else - (tcState, inputs) ||> List.mapFold (TypeCheckOneInputSkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(results, tcState) let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) From 0f39ad495587f2589ef54e68ec1d40a424d1c2d2 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Fri, 26 Feb 2021 10:04:35 -0800 Subject: [PATCH 16/19] minor refactor --- src/fsharp/ParseAndCheckInputs.fs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 7da63ded29d..3534f70d82c 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -874,21 +874,20 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports: return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState } -/// Typecheck a single file (or interactive entry into F# Interactive) -let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = +let TypeCheckOneInputAux (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 - TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) + TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, skipImplIfSigExists) |> Eventually.force ctok /// Typecheck a single file (or interactive entry into F# Interactive) +let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = + TypeCheckOneInputAux(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 TypeCheckOneInputSkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = - // '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 - TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, true) - |> Eventually.force ctok + TypeCheckOneInputAux(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) = From 5c5a466139f348aa99cb79a474225d5f433affbf Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 1 Mar 2021 17:07:23 -0800 Subject: [PATCH 17/19] Handling aggregate exceptions from ArrayParallel. Using try/finally to commit delayed diagnostics --- src/fsharp/ParseAndCheckInputs.fs | 33 ++++++++++++------------------- src/fsharp/lib.fs | 11 ++++++++--- src/fsharp/lib.fsi | 1 + 3 files changed, 22 insertions(+), 23 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 511a2123724..92e45f30a31 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -441,33 +441,26 @@ let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, conditionalCompilat createErrorLogger(delayedExiter) ) - let commitDelayedErrorLoggers () = - delayedErrorLoggers - |> Array.iter (fun delayedErrorLogger -> - delayedErrorLogger.CommitDelayedDiagnostics errorLogger - ) - let results = try - sourceFiles - |> ArrayParallel.mapi (fun i (filename, isLastCompiland) -> - let delayedErrorLogger = delayedErrorLoggers.[i] + try + sourceFiles + |> ArrayParallel.mapi (fun i (filename, isLastCompiland) -> + let delayedErrorLogger = delayedErrorLoggers.[i] - let directoryName = Path.GetDirectoryName filename - let input = parseInputFileAux(tcConfig, lexResourceManager, conditionalCompilationDefines, filename, (isLastCompiland, isExe), delayedErrorLogger, retryLocked) - (input, directoryName) - ) + let directoryName = Path.GetDirectoryName filename + let input = parseInputFileAux(tcConfig, lexResourceManager, conditionalCompilationDefines, filename, (isLastCompiland, isExe), delayedErrorLogger, retryLocked) + (input, directoryName) + ) + finally + delayedErrorLoggers + |> Array.iter (fun delayedErrorLogger -> + delayedErrorLogger.CommitDelayedDiagnostics errorLogger + ) with | StopProcessing -> - commitDelayedErrorLoggers () exiter.Exit exitCode - | _ -> - commitDelayedErrorLoggers () - reraise() - - commitDelayedErrorLoggers () - results |> List.ofArray else diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index ad6c7421c6c..12f9574c65f 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -598,14 +598,19 @@ type DisposablesTracker() = /// Specialized parallel functions for an array. /// Different from Array.Parallel as it will try to minimize the max degree of parallelism. +/// Will flatten aggregate exceptions that contain one exception. [] module ArrayParallel = let inline iteri f (arr: 'T []) = let parallelOptions = ParallelOptions(MaxDegreeOfParallelism = max (min Environment.ProcessorCount arr.Length) 1) - Parallel.For(0, arr.Length, parallelOptions, fun i -> - f i arr.[i] - ) |> ignore + try + Parallel.For(0, arr.Length, parallelOptions, fun i -> + f i arr.[i] + ) |> ignore + with + | :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> + raise(ex.InnerExceptions.[0]) let inline iter f (arr: 'T []) = arr |> iteri (fun _ item -> f item) diff --git a/src/fsharp/lib.fsi b/src/fsharp/lib.fsi index 24abefea3ad..08cdc407424 100644 --- a/src/fsharp/lib.fsi +++ b/src/fsharp/lib.fsi @@ -291,6 +291,7 @@ type DisposablesTracker = /// Specialized parallel functions for an array. /// Different from Array.Parallel as it will try to minimize the max degree of parallelism. +/// Will flatten aggregate exceptions that contain one exception. [] module ArrayParallel = From 311d43650e22e321abe9df6f622e211af4b4c57b Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 4 Mar 2021 16:13:51 -0800 Subject: [PATCH 18/19] Fix build --- src/fsharp/ParseAndCheckInputs.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 5ad1ffbcbf5..ccb9e7a94d3 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -885,7 +885,7 @@ let TypeCheckOneInputAux (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck RequireCompilationThread ctok - TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) + TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, skipImplIfSigExists) |> Eventually.force CancellationToken.None |> function | ValueOrCancelled.Value v -> v From 4fe0f71120b9cc7b59dd32692a9dcff7666deb81 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 4 Nov 2021 13:42:14 -0700 Subject: [PATCH 19/19] Fixing build --- src/fsharp/ParseAndCheckInputs.fs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 8e4a2624a31..cb650d9cbda 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -949,7 +949,7 @@ let TypeCheckOneInput(checkForErrors, } /// Typecheck a single file (or interactive entry into F# Interactive) -let TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp skipImplIfSigExists = +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 @@ -959,12 +959,12 @@ let TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig, tcImports, tcGlobals |> Cancellable.runWithoutCancellation /// Typecheck a single file (or interactive entry into F# Interactive) -let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = - TypeCheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp false +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 TypeCheckOneInputSkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = - TypeCheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp true +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) = @@ -999,7 +999,7 @@ let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports // 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 (TypeCheckOneInputSkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInputEntrySkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) let inputs = Array.ofList inputs let newResults = Array.ofList results @@ -1020,13 +1020,13 @@ let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports |> Array.choose id |> ArrayParallel.iter (fun (i, input, qualifiedNameOfFile) -> let tcState = tcState.RemoveImpl(qualifiedNameOfFile) - let result, _ = TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input + let result, _ = TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input newResults.[i] <- result ) newResults |> List.ofArray, tcState else - (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + (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)