From d238d25d75f46ba11d52168271a20b1aa579e4fc Mon Sep 17 00:00:00 2001 From: Will Smith Date: Mon, 22 Feb 2021 16:52:35 -0800 Subject: [PATCH 01/25] 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 4803a5632d..8522e2361f 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/25] 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 8522e2361f..5f25054505 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/25] 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 042df6f95a..21af02c5ec 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 5442a72313..3239c9c528 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 41fb657d69..fa4df23ede 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 7fb9ecce89..09a2985220 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 5f25054505..1be155b03a 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 e5743c212c..4622c87007 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 e4061568df..174e3d21d2 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 55cb7f62aa..5f236450ee 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 76f755025a..50de0c528c 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 1a112ef13a..785bebd7c6 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 5ac6967a01..79d80058f5 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 21b4ffeaba..4406386f6d 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 882b461778..76a8f6cb8e 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 2df5c973a3..061432ea8b 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 d5bdb94347..0be236f545 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 b51c67434b..9c4d53d25d 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 68f0e225ab..61002e176d 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 1efa245134..c08cbb2749 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/25] 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 1be155b03a..8adbbc9951 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/25] 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 fa4df23ede..17c63c9de5 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 09a2985220..7fb9ecce89 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 8adbbc9951..165e8bb069 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 4622c87007..e5743c212c 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 174e3d21d2..e4061568df 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 5f236450ee..55cb7f62aa 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 50de0c528c..76f755025a 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 785bebd7c6..1a112ef13a 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 79d80058f5..5ac6967a01 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 4406386f6d..21b4ffeaba 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 76a8f6cb8e..882b461778 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 061432ea8b..2df5c973a3 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 0be236f545..d5bdb94347 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 9c4d53d25d..b51c67434b 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 61002e176d..68f0e225ab 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 c08cbb2749..1efa245134 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/25] 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 35b33ca82a..5407dbbcda 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 21f20a056e..91756b6fb7 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 165e8bb069..31ceba9c4b 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/25] 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 17c63c9de5..d25a4b138a 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/25] 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 5407dbbcda..ede5b6f181 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 91756b6fb7..21f20a056e 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 31ceba9c4b..165e8bb069 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/25] 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 ede5b6f181..a9806f2fbe 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 21f20a056e..8128d36b0e 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 165e8bb069..c3cec13378 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 692046b92e..2fb343fb6e 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 ceea83cf55..24abefea3a 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/25] 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 a9806f2fbe..3ae5660c0f 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/25] 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 3ae5660c0f..9b54e88b9d 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 8128d36b0e..682167eeca 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 24abefea3a..c7dfd1189d 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/25] 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 9b54e88b9d..3aba4f928c 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/25] 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 2fb343fb6e..ad6c7421c6 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/25] 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 3aba4f928c..a8d167406e 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/25] 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 a8d167406e..7da63ded29 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/25] 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 7da63ded29..3534f70d82 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/25] 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 511a212372..92e45f30a3 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 ad6c7421c6..12f9574c65 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 24abefea3a..08cdc40742 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 f408f042fc91adf397d2635cc95b65045dafc3ae Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 2 Mar 2021 18:31:31 -0800 Subject: [PATCH 18/25] Initial ilx-code-gen parallel work --- src/fsharp/IlxGen.fs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index a8b8d2cb8d..65dc57896c 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -894,6 +894,8 @@ and IlxGenEnv = /// Are we inside of a recursive let binding, while loop, or a for loop? isInLoop: bool + + delayCodeGen: bool } override _.ToString() = "" @@ -2249,7 +2251,7 @@ let rec GenExpr cenv cgbuf eenv sp (expr: Expr) sequel = cenv.exprRecursionDepth <- cenv.exprRecursionDepth - 1 - if cenv.exprRecursionDepth = 0 then + if cenv.exprRecursionDepth = 0 && not eenv.delayCodeGen then ProcessDelayedGenMethods cenv and ProcessDelayedGenMethods cenv = @@ -6185,14 +6187,14 @@ and GenMethodForBinding else body - let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel) + let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, { eenvForMeth with delayCodeGen = false }, 0, bodyExpr, sequel) // This is the main code generation for most methods false, MethodBody.IL(ilCodeLazy), false match ilMethodBody with | MethodBody.IL(ilCodeLazy) -> - if cenv.exprRecursionDepth > 0 then + if cenv.exprRecursionDepth > 0 || eenvForMeth.delayCodeGen then cenv.delayedGenMethods.Enqueue(fun _ -> ilCodeLazy.Force() |> ignore) else // Eagerly codegen if we are not in an expression depth. @@ -7994,6 +7996,8 @@ let CodegenAssembly cenv eenv mgbuf implFiles = //printfn "#_emptyTopInstrs = %d" _emptyTopInstrs.Length () + ProcessDelayedGenMethods cenv + mgbuf.AddInitializeScriptsInOrderToEntryPoint() //------------------------------------------------------------------------- @@ -8015,7 +8019,8 @@ let GetEmptyIlxGenEnv (g: TcGlobals) ccu = innerVals = [] sigToImplRemapInfo = [] (* "module remap info" *) withinSEH = false - isInLoop = false } + isInLoop = false + delayCodeGen = true } type IlxGenResults = { ilTypeDefs: ILTypeDef list From b36f45ab532b8a016822df29ada84b7843629a79 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 2 Mar 2021 19:00:18 -0800 Subject: [PATCH 19/25] compiles --- src/fsharp/IlxGen.fs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 65dc57896c..703eae2dbb 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -6187,6 +6187,7 @@ and GenMethodForBinding else body + let cenv = { cenv with exprRecursionDepth = 0; delayedGenMethods = Queue() } let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, { eenvForMeth with delayCodeGen = false }, 0, bodyExpr, sequel) // This is the main code generation for most methods @@ -7980,6 +7981,9 @@ let CodegenAssembly cenv eenv mgbuf implFiles = let eenv = List.fold (GenImplFile cenv mgbuf None) eenv a let eenv = GenImplFile cenv mgbuf cenv.opts.mainMethodInfo eenv b + cenv.exprRecursionDepth <- 0 + ProcessDelayedGenMethods cenv + // Some constructs generate residue types and bindings. Generate these now. They don't result in any // top-level initialization code. let extraBindings = mgbuf.GrabExtraBindingsToGenerate() @@ -7996,8 +8000,6 @@ let CodegenAssembly cenv eenv mgbuf implFiles = //printfn "#_emptyTopInstrs = %d" _emptyTopInstrs.Length () - ProcessDelayedGenMethods cenv - mgbuf.AddInitializeScriptsInOrderToEntryPoint() //------------------------------------------------------------------------- From 0db7045fd46141dc42bcdc23a7e87a03a64ad3db Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 2 Mar 2021 19:12:11 -0800 Subject: [PATCH 20/25] Does not work but it tries to use parallelism --- src/fsharp/IlxGen.fs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 703eae2dbb..628d2212ba 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -7981,8 +7981,11 @@ let CodegenAssembly cenv eenv mgbuf implFiles = let eenv = List.fold (GenImplFile cenv mgbuf None) eenv a let eenv = GenImplFile cenv mgbuf cenv.opts.mainMethodInfo eenv b - cenv.exprRecursionDepth <- 0 - ProcessDelayedGenMethods cenv + let genMeths = cenv.delayedGenMethods |> Array.ofSeq + cenv.delayedGenMethods.Clear() + + genMeths + |> ArrayParallel.iter (fun gen -> gen cenv) // Some constructs generate residue types and bindings. Generate these now. They don't result in any // top-level initialization code. From 17f3d9b1026f92e6a3515d0fdf21cd30bd618f52 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 2 Mar 2021 19:27:22 -0800 Subject: [PATCH 21/25] Compiles again --- src/fsharp/IlxGen.fs | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 628d2212ba..d34fe1bd2d 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -6,6 +6,7 @@ module internal FSharp.Compiler.IlxGen open System.IO open System.Reflection open System.Collections.Generic +open System.Collections.Immutable open Internal.Utilities open Internal.Utilities.Collections @@ -896,6 +897,8 @@ and IlxGenEnv = isInLoop: bool delayCodeGen: bool + + delayedFileGen: ImmutableArray<(cenv -> unit) []> } override _.ToString() = "" @@ -7101,7 +7104,9 @@ and GenImplFile cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (implFile: TypedI let allocVal = ComputeAndAddStorageForLocalTopVal (cenv.amap, g, cenv.intraAssemblyInfo, cenv.opts.isInteractive, NoShadowLocal) AddBindingsForLocalModuleType allocVal clocCcu eenv mexpr.Type - eenvafter + let eenvfinal = { eenvafter with delayedFileGen = eenvafter.delayedFileGen.Add(cenv.delayedGenMethods |> Array.ofSeq) } + cenv.delayedGenMethods.Clear() + eenvfinal and GenForceWholeFileInitializationAsPartOfCCtor cenv (mgbuf: AssemblyBuilder) (lazyInitInfo: ResizeArray<_>) tref m = // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field @@ -7981,11 +7986,13 @@ let CodegenAssembly cenv eenv mgbuf implFiles = let eenv = List.fold (GenImplFile cenv mgbuf None) eenv a let eenv = GenImplFile cenv mgbuf cenv.opts.mainMethodInfo eenv b - let genMeths = cenv.delayedGenMethods |> Array.ofSeq - cenv.delayedGenMethods.Clear() + let genMeths = eenv.delayedFileGen |> Array.ofSeq genMeths - |> ArrayParallel.iter (fun gen -> gen cenv) + |> Array.iter (fun genMeths -> + genMeths + |> Array.iter (fun gen -> gen cenv) + ) // Some constructs generate residue types and bindings. Generate these now. They don't result in any // top-level initialization code. @@ -8025,7 +8032,8 @@ let GetEmptyIlxGenEnv (g: TcGlobals) ccu = sigToImplRemapInfo = [] (* "module remap info" *) withinSEH = false isInLoop = false - delayCodeGen = true } + delayCodeGen = true + delayedFileGen = ImmutableArray.Empty } type IlxGenResults = { ilTypeDefs: ILTypeDef list From f4a298ce0181af6cbcde1c9e1f7cebf4df0dfc10 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 2 Mar 2021 19:53:49 -0800 Subject: [PATCH 22/25] parallel ilx gen works --- src/fsharp/IlxGen.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index d34fe1bd2d..8bb97ad405 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -7989,7 +7989,7 @@ let CodegenAssembly cenv eenv mgbuf implFiles = let genMeths = eenv.delayedFileGen |> Array.ofSeq genMeths - |> Array.iter (fun genMeths -> + |> ArrayParallel.iter (fun genMeths -> genMeths |> Array.iter (fun gen -> gen cenv) ) From c1e89aed03265b43aaf15e886ab1087e028f78a7 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 4 Mar 2021 16:09:23 -0800 Subject: [PATCH 23/25] Refactoring a bit --- src/fsharp/IlxGen.fs | 43 ++++++++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 19 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 8bb97ad405..6f69a6b3a3 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -2448,7 +2448,20 @@ and CodeGenMethodForExpr cenv mgbuf (spReq, entryPointInfo, methodName, eenv, al CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, (fun cgbuf eenv -> GenExpr cenv cgbuf eenv spReq expr0 sequel0), expr0.Range) - code + code + +and DelayCodeGenMethodForExpr cenv mgbuf (spReq, entryPointInfo, methodName, eenv, alreadyUsedArgs, expr0, sequel0) = + let ilLazyCode = + lazy + CodeGenMethodForExpr { cenv with exprRecursionDepth = 0; delayedGenMethods = Queue() } mgbuf (spReq, entryPointInfo, methodName, { eenv with delayCodeGen = false }, alreadyUsedArgs, expr0, sequel0) + + if cenv.exprRecursionDepth > 0 || eenv.delayCodeGen then + cenv.delayedGenMethods.Enqueue(fun _ -> ilLazyCode.Force() |> ignore) + else + // Eagerly codegen if we are not in an expression depth. + ilLazyCode.Force() |> ignore + + ilLazyCode //-------------------------------------------------------------------------- // Generate sequels @@ -5646,8 +5659,14 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) star cgbuf.mgbuf.AddOrMergePropertyDef(ilGetterMethSpec.MethodRef.DeclaringTypeRef, ilPropDef, m) let ilMethodDef = - let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, rhsExpr, Return) - let ilMethodBody = MethodBody.IL(lazy ilCode) + let ilLazyCode = + if eenv.delayCodeGen then + DelayCodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, rhsExpr, Return) + else + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, rhsExpr, Return) + lazy ilCode + + let ilMethodBody = MethodBody.IL(ilLazyCode) (mkILStaticMethod ([], ilGetterMethSpec.Name, access, [], mkILReturn ilTy, ilMethodBody)).WithSpecialName |> AddNonUserCompilerGeneratedAttribs g @@ -6099,9 +6118,6 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs = let hasAggressiveInliningImplFlag = (implflags &&& 0x0100) <> 0x0 hasPreserveSigImplFlag, hasSynchronizedImplFlag, hasNoInliningImplFlag, hasAggressiveInliningImplFlag, attrs -and DelayGenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs = - cenv.delayedGenMethods.Enqueue (fun cenv -> GenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs) - and GenMethodForBinding cenv mgbuf eenv (v: Val, mspec, hasWitnessEntry, generateWitnessArgs, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, @@ -6190,21 +6206,10 @@ and GenMethodForBinding else body - let cenv = { cenv with exprRecursionDepth = 0; delayedGenMethods = Queue() } - let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, { eenvForMeth with delayCodeGen = false }, 0, bodyExpr, sequel) + let ilLazyCode = DelayCodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel) // This is the main code generation for most methods - false, MethodBody.IL(ilCodeLazy), false - - match ilMethodBody with - | MethodBody.IL(ilCodeLazy) -> - if cenv.exprRecursionDepth > 0 || eenvForMeth.delayCodeGen then - cenv.delayedGenMethods.Enqueue(fun _ -> ilCodeLazy.Force() |> ignore) - else - // Eagerly codegen if we are not in an expression depth. - ilCodeLazy.Force() |> ignore - | _ -> - () + false, MethodBody.IL(ilLazyCode), false // Do not generate DllImport attributes into the code - they are implicit from the P/Invoke let attrs = From 311d43650e22e321abe9df6f622e211af4b4c57b Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 4 Mar 2021 16:13:51 -0800 Subject: [PATCH 24/25] 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 5ad1ffbcbf..ccb9e7a94d 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 e056a1a099d0bd4c14ce46a446a86ade1998f458 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 4 Mar 2021 16:49:14 -0800 Subject: [PATCH 25/25] Removing a few LOH allocs --- src/fsharp/absil/bytes.fs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/fsharp/absil/bytes.fs b/src/fsharp/absil/bytes.fs index ade5aae435..ce07864075 100644 --- a/src/fsharp/absil/bytes.fs +++ b/src/fsharp/absil/bytes.fs @@ -5,6 +5,7 @@ namespace Internal.Utilities open System open System.IO +open System.Buffers open System.IO.MemoryMappedFiles open System.Runtime.InteropServices open FSharp.NativeInterop @@ -432,10 +433,16 @@ type internal ByteBuffer = let oldBufSize = buf.bbArray.Length if newSize > oldBufSize then let old = buf.bbArray - buf.bbArray <- Bytes.zeroCreate (max newSize (oldBufSize * 2)) + buf.bbArray <- ArrayPool.Shared.Rent(max newSize (oldBufSize * 2)) Bytes.blit old 0 buf.bbArray 0 buf.bbCurrent + ArrayPool.Shared.Return(old) - member buf.Close () = Bytes.sub buf.bbArray 0 buf.bbCurrent + member buf.Close () = + let result = Bytes.sub buf.bbArray 0 buf.bbCurrent + ArrayPool.Shared.Return(buf.bbArray) + buf.bbArray <- [||] + buf.bbCurrent <- 0 + result member buf.EmitIntAsByte (i:int) = let newSize = buf.bbCurrent + 1 @@ -499,7 +506,7 @@ type internal ByteBuffer = member buf.Position = buf.bbCurrent static member Create sz = - { bbArray=Bytes.zeroCreate sz + { bbArray = ArrayPool.Shared.Rent(sz) bbCurrent = 0 } []