From 769d6226cf6f29d4bd84c1b2f0feb034de099559 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Thu, 9 May 2024 16:27:41 -0400 Subject: [PATCH 1/7] Minor compiler perf improvements * Override `ToString` on `BuildPhase`. * Cache the delegate passed into `ConcurrentDictionary.GetOrAdd` where possible. See #14582, fsharp/fslang-suggestions#1083, etc. --- src/Compiler/AbstractIL/il.fs | 22 ++++++---- src/Compiler/Facilities/DiagnosticsLogger.fs | 14 ++++++ src/Compiler/SyntaxTree/PrettyNaming.fs | 43 ++++++++++--------- src/Compiler/TypedTree/CompilerGlobalState.fs | 21 ++++----- src/FSharp.Core/QueryExtensions.fs | 4 +- 5 files changed, 63 insertions(+), 41 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index fecefad1434..ecdb17239d2 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -90,22 +90,23 @@ let rec splitNamespaceAux (nm: string) = | -1 -> [ nm ] | idx -> let s1, s2 = splitNameAt nm idx - let s1 = memoizeNamespacePartTable.GetOrAdd(s1, id) + let s1 = memoizeNamespacePartTable.GetOrAdd(s1, s1) s1 :: splitNamespaceAux s2 +// Cache this as a delegate. +let splitNamespaceAuxDelegate = Func splitNamespaceAux + let splitNamespace nm = - memoizeNamespaceTable.GetOrAdd(nm, splitNamespaceAux) + memoizeNamespaceTable.GetOrAdd(nm, splitNamespaceAuxDelegate) // ++GLOBAL MUTABLE STATE (concurrency-safe) let memoizeNamespaceArrayTable = ConcurrentDictionary() +// Cache this as a delegate. +let splitNamespaceToArrayDelegate = Func(splitNamespace >> Array.ofList) + let splitNamespaceToArray nm = - memoizeNamespaceArrayTable.GetOrAdd( - nm, - fun nm -> - let x = Array.ofList (splitNamespace nm) - x - ) + memoizeNamespaceArrayTable.GetOrAdd(nm, splitNamespaceToArrayDelegate) let splitILTypeName (nm: string) = match nm.LastIndexOf '.' with @@ -156,8 +157,11 @@ let splitTypeNameRightAux (nm: string) = let s1, s2 = splitNameAt nm idx Some s1, s2 +// Cache this as a delegate. +let splitTypeNameRightDelegate = Func splitTypeNameRightAux + let splitTypeNameRight nm = - memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightAux) + memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightDelegate) // -------------------------------------------------------------------- // Ordered lists with a lookup table diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index d93a3a60b6c..df744633232 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -220,6 +220,20 @@ type BuildPhase = | Output | Interactive // An error seen during interactive execution + override this.ToString() = + match this with + | DefaultPhase -> nameof DefaultPhase + | Compile -> nameof Compile + | Parameter -> nameof Parameter + | Parse -> nameof Parse + | TypeCheck -> nameof TypeCheck + | CodeGen -> nameof CodeGen + | Optimize -> nameof Optimize + | IlxGen -> nameof IlxGen + | IlGen -> nameof IlGen + | Output -> nameof Output + | Interactive -> nameof Interactive + /// Literal build phase subcategory strings. module BuildPhaseSubcategory = [] diff --git a/src/Compiler/SyntaxTree/PrettyNaming.fs b/src/Compiler/SyntaxTree/PrettyNaming.fs index 3000297d866..952d7ee9abe 100755 --- a/src/Compiler/SyntaxTree/PrettyNaming.fs +++ b/src/Compiler/SyntaxTree/PrettyNaming.fs @@ -389,29 +389,30 @@ let compileCustomOpName = /// They're typically used more than once so this avoids some CPU and GC overhead. let compiledOperators = ConcurrentDictionary<_, string> StringComparer.Ordinal + // Cache this as a delegate. + let compiledOperatorsAddDelegate = + Func(fun (op: string) -> + let opLength = op.Length + + let sb = + StringBuilder(opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) + + for i = 0 to opLength - 1 do + let c = op[i] + + match t2.TryGetValue c with + | true, x -> sb.Append(x) |> ignore + | false, _ -> sb.Append(c) |> ignore + + /// The compiled (mangled) operator name. + let opName = sb.ToString() + + // Cache the compiled name so it can be reused. + opName) + fun opp -> // Has this operator already been compiled? - compiledOperators.GetOrAdd( - opp, - fun (op: string) -> - let opLength = op.Length - - let sb = - StringBuilder(opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) - - for i = 0 to opLength - 1 do - let c = op[i] - - match t2.TryGetValue c with - | true, x -> sb.Append(x) |> ignore - | false, _ -> sb.Append(c) |> ignore - - /// The compiled (mangled) operator name. - let opName = sb.ToString() - - // Cache the compiled name so it can be reused. - opName - ) + compiledOperators.GetOrAdd(opp, compiledOperatorsAddDelegate) /// Maps the built-in F# operators to their mangled operator names. let standardOpNames = diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index 7047fc3cf35..15ea8d217a5 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -5,9 +5,7 @@ module FSharp.Compiler.CompilerGlobalState open System -open System.Collections.Generic open System.Collections.Concurrent -open System.Threading open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.Text @@ -19,14 +17,17 @@ open FSharp.Compiler.Text /// policy to make all globally-allocated objects concurrency safe in case future versions of the compiler /// are used to host multiple concurrent instances of compilation. type NiceNameGenerator() = - let basicNameCounts = ConcurrentDictionary>(max Environment.ProcessorCount 1, 127) + let basicNameCounts = ConcurrentDictionary(max Environment.ProcessorCount 1, 127) + // Cache this as a delegate. + let basicNameCountsUpdateDelegate = Func(fun _k count -> count + 1) - member _.FreshCompilerGeneratedName (name, m: range) = - let basicName = GetBasicNameOfPossibleCompilerGeneratedName name - let countCell = basicNameCounts.GetOrAdd(basicName,fun k -> ref 0) - let count = Interlocked.Increment(countCell) - - CompilerGeneratedNameSuffix basicName (string m.StartLine + (match (count-1) with 0 -> "" | n -> "-" + string n)) + member _.FreshCompilerGeneratedNameOfBasicName (basicName, m: range) = + let count = basicNameCounts.AddOrUpdate(basicName, 0, basicNameCountsUpdateDelegate) + let suffix = match count with 0 -> string m.StartLine | n -> string m.StartLine + "-" + string n + CompilerGeneratedNameSuffix basicName suffix + + member this.FreshCompilerGeneratedName (name, m: range) = + this.FreshCompilerGeneratedNameOfBasicName (GetBasicNameOfPossibleCompilerGeneratedName name, m) /// Generates compiler-generated names marked up with a source code location, but if given the same unique value then /// return precisely the same name. Each name generated also includes the StartLine number of the range passed in @@ -42,7 +43,7 @@ type StableNiceNameGenerator() = member x.GetUniqueCompilerGeneratedName (name, m: range, uniq) = let basicName = GetBasicNameOfPossibleCompilerGeneratedName name let key = basicName, uniq - niceNames.GetOrAdd(key, fun _ -> innerGenerator.FreshCompilerGeneratedName(name, m)) + niceNames.GetOrAdd(key, fun (basicName, _) -> innerGenerator.FreshCompilerGeneratedNameOfBasicName(basicName, m)) type internal CompilerGlobalState () = /// A global generator of compiler generated names diff --git a/src/FSharp.Core/QueryExtensions.fs b/src/FSharp.Core/QueryExtensions.fs index 27d20d35fa4..378324ec55b 100644 --- a/src/FSharp.Core/QueryExtensions.fs +++ b/src/FSharp.Core/QueryExtensions.fs @@ -38,8 +38,10 @@ module internal Adapters = let memoize f = let d = new ConcurrentDictionary(HashIdentity.Structural) + // Cache this as a delegate. + let valueFactory = Func f - fun x -> d.GetOrAdd(x, (fun r -> f r)) + fun x -> d.GetOrAdd(x, valueFactory) let isPartiallyImmutableRecord: Type -> bool = memoize (fun t -> From 369699178ad56bb656333df4c7d2755a6069eb0a Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Thu, 9 May 2024 16:41:33 -0400 Subject: [PATCH 2/7] Name --- src/Compiler/AbstractIL/il.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index ecdb17239d2..8559aeff009 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -158,10 +158,10 @@ let splitTypeNameRightAux (nm: string) = Some s1, s2 // Cache this as a delegate. -let splitTypeNameRightDelegate = Func splitTypeNameRightAux +let splitTypeNameRightAuxDelegate = Func splitTypeNameRightAux let splitTypeNameRight nm = - memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightDelegate) + memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightAuxDelegate) // -------------------------------------------------------------------- // Ordered lists with a lookup table From 6cf2247fdb6e020105cd0409609f1d6e1eb7c1f4 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Thu, 9 May 2024 16:45:07 -0400 Subject: [PATCH 3/7] Update release notes --- docs/release-notes/.FSharp.Compiler.Service/8.0.400.md | 1 + docs/release-notes/.FSharp.Core/8.0.400.md | 7 +++++++ 2 files changed, 8 insertions(+) create mode 100644 docs/release-notes/.FSharp.Core/8.0.400.md diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md index fd28a3c2736..0800edf0978 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md @@ -19,4 +19,5 @@ ### Changed +* Minor compiler perf improvements. ([PR #17130](https://github.com/dotnet/fsharp/pull/17130)) * Improve error of Active Pattern case Argument Count Not Match ([PR #16846](https://github.com/dotnet/fsharp/pull/16846)) diff --git a/docs/release-notes/.FSharp.Core/8.0.400.md b/docs/release-notes/.FSharp.Core/8.0.400.md new file mode 100644 index 00000000000..48a05231dc9 --- /dev/null +++ b/docs/release-notes/.FSharp.Core/8.0.400.md @@ -0,0 +1,7 @@ +### Fixed + +### Added + +### Changed + +* Cache delegate in query extensions. ([PR #17130](https://github.com/dotnet/fsharp/pull/17130)) From ee16caf2b210f25721e80243b1e514416becd916 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Thu, 9 May 2024 16:50:29 -0400 Subject: [PATCH 4/7] Fmt --- src/Compiler/AbstractIL/il.fs | 6 ++++-- src/Compiler/SyntaxTree/PrettyNaming.fs | 10 +++++----- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 8559aeff009..37c160ef673 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -103,7 +103,8 @@ let splitNamespace nm = let memoizeNamespaceArrayTable = ConcurrentDictionary() // Cache this as a delegate. -let splitNamespaceToArrayDelegate = Func(splitNamespace >> Array.ofList) +let splitNamespaceToArrayDelegate = + Func(splitNamespace >> Array.ofList) let splitNamespaceToArray nm = memoizeNamespaceArrayTable.GetOrAdd(nm, splitNamespaceToArrayDelegate) @@ -158,7 +159,8 @@ let splitTypeNameRightAux (nm: string) = Some s1, s2 // Cache this as a delegate. -let splitTypeNameRightAuxDelegate = Func splitTypeNameRightAux +let splitTypeNameRightAuxDelegate = + Func splitTypeNameRightAux let splitTypeNameRight nm = memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightAuxDelegate) diff --git a/src/Compiler/SyntaxTree/PrettyNaming.fs b/src/Compiler/SyntaxTree/PrettyNaming.fs index 952d7ee9abe..d91eddbeb04 100755 --- a/src/Compiler/SyntaxTree/PrettyNaming.fs +++ b/src/Compiler/SyntaxTree/PrettyNaming.fs @@ -393,20 +393,20 @@ let compileCustomOpName = let compiledOperatorsAddDelegate = Func(fun (op: string) -> let opLength = op.Length - + let sb = StringBuilder(opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) - + for i = 0 to opLength - 1 do let c = op[i] - + match t2.TryGetValue c with | true, x -> sb.Append(x) |> ignore | false, _ -> sb.Append(c) |> ignore - + /// The compiled (mangled) operator name. let opName = sb.ToString() - + // Cache the compiled name so it can be reused. opName) From 0ed74f8b5f8add9c44cf9ebbf7c832c94c3fab8f Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Fri, 10 May 2024 09:13:46 -0400 Subject: [PATCH 5/7] Remove unneeded `StringBuilder` --- src/Compiler/Checking/CheckExpressions.fs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index ec2b29d08be..871f36dd454 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -7442,8 +7442,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn if List.isEmpty synFillExprs then if isString then - let sb = System.Text.StringBuilder(printfFormatString).Replace("%%", "%") - let str = mkString g m (sb.ToString()) + let str = mkString g m (printfFormatString.Replace("%%", "%")) TcPropagatingExprLeafThenConvert cenv overallTy g.string_ty env (* true *) m (fun () -> str, tpenv ) From 7bb88fa9a7a2c0ebd954baecd0c8b46945cd820d Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Fri, 10 May 2024 12:08:42 -0400 Subject: [PATCH 6/7] Start count at 1 --- src/Compiler/TypedTree/CompilerGlobalState.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index 15ea8d217a5..7f3206089cf 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -22,8 +22,8 @@ type NiceNameGenerator() = let basicNameCountsUpdateDelegate = Func(fun _k count -> count + 1) member _.FreshCompilerGeneratedNameOfBasicName (basicName, m: range) = - let count = basicNameCounts.AddOrUpdate(basicName, 0, basicNameCountsUpdateDelegate) - let suffix = match count with 0 -> string m.StartLine | n -> string m.StartLine + "-" + string n + let count = basicNameCounts.AddOrUpdate(basicName, 1, basicNameCountsUpdateDelegate) + let suffix = match count with 1 -> string m.StartLine | n -> string m.StartLine + "-" + string n CompilerGeneratedNameSuffix basicName suffix member this.FreshCompilerGeneratedName (name, m: range) = From 02546c537a8da5ccec8fe9cbf28734f4b8d92a08 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Fri, 10 May 2024 18:12:35 -0400 Subject: [PATCH 7/7] Go back to `GetOrAdd` * I don't think I fully understand why, but I did some rough microbenchmarking, and for some reason the `GetOrAdd` and `Interlocked.Increment` on a ref cell technique is actually something like twice as fast as `AddOrUpdate`. --- src/Compiler/TypedTree/CompilerGlobalState.fs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index 7f3206089cf..72da3da4f58 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -6,6 +6,7 @@ module FSharp.Compiler.CompilerGlobalState open System open System.Collections.Concurrent +open System.Threading open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.Text @@ -17,14 +18,15 @@ open FSharp.Compiler.Text /// policy to make all globally-allocated objects concurrency safe in case future versions of the compiler /// are used to host multiple concurrent instances of compilation. type NiceNameGenerator() = - let basicNameCounts = ConcurrentDictionary(max Environment.ProcessorCount 1, 127) + let basicNameCounts = ConcurrentDictionary(max Environment.ProcessorCount 1, 127) // Cache this as a delegate. - let basicNameCountsUpdateDelegate = Func(fun _k count -> count + 1) + let basicNameCountsAddDelegate = Func(fun _ -> ref 0) member _.FreshCompilerGeneratedNameOfBasicName (basicName, m: range) = - let count = basicNameCounts.AddOrUpdate(basicName, 1, basicNameCountsUpdateDelegate) - let suffix = match count with 1 -> string m.StartLine | n -> string m.StartLine + "-" + string n - CompilerGeneratedNameSuffix basicName suffix + let countCell = basicNameCounts.GetOrAdd(basicName, basicNameCountsAddDelegate) + let count = Interlocked.Increment(countCell) + + CompilerGeneratedNameSuffix basicName (string m.StartLine + (match (count-1) with 0 -> "" | n -> "-" + string n)) member this.FreshCompilerGeneratedName (name, m: range) = this.FreshCompilerGeneratedNameOfBasicName (GetBasicNameOfPossibleCompilerGeneratedName name, m)