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 9abf960b75f..f3c5f7fd4a9 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md @@ -19,5 +19,6 @@ ### 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)) * Reduce allocations in compiler checking via `ValueOption` usage ([PR #16822](https://github.com/dotnet/fsharp/pull/16822)) 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)) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index fecefad1434..37c160ef673 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -90,22 +90,24 @@ 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 +158,12 @@ let splitTypeNameRightAux (nm: string) = let s1, s2 = splitNameAt nm idx Some s1, s2 +// Cache this as a delegate. +let splitTypeNameRightAuxDelegate = + Func splitTypeNameRightAux + let splitTypeNameRight nm = - memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightAux) + memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightAuxDelegate) // -------------------------------------------------------------------- // Ordered lists with a lookup table 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 ) diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 443282ffe95..3cc3e1b4755 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -221,6 +221,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..d91eddbeb04 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 - fun opp -> - // Has this operator already been compiled? - compiledOperators.GetOrAdd( - opp, - fun (op: string) -> - let opLength = op.Length + // Cache this as a delegate. + let compiledOperatorsAddDelegate = + Func(fun (op: string) -> + let opLength = op.Length - let sb = - StringBuilder(opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) + let sb = + StringBuilder(opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) - for i = 0 to opLength - 1 do - let c = op[i] + 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 + 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() + /// The compiled (mangled) operator name. + let opName = sb.ToString() - // Cache the compiled name so it can be reused. - opName - ) + // Cache the compiled name so it can be reused. + opName) + + fun opp -> + // Has this operator already been compiled? + 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..72da3da4f58 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -5,7 +5,6 @@ module FSharp.Compiler.CompilerGlobalState open System -open System.Collections.Generic open System.Collections.Concurrent open System.Threading open FSharp.Compiler.Syntax.PrettyNaming @@ -19,15 +18,19 @@ 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 basicNameCountsAddDelegate = Func(fun _ -> ref 0) - member _.FreshCompilerGeneratedName (name, m: range) = - let basicName = GetBasicNameOfPossibleCompilerGeneratedName name - let countCell = basicNameCounts.GetOrAdd(basicName,fun k -> ref 0) + member _.FreshCompilerGeneratedNameOfBasicName (basicName, m: range) = + 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) + /// 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 /// at the point of first generation. @@ -42,7 +45,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 ->