A few super-minor compiler perf improvements (#17130)

* Minor compiler perf improvements

* Override `ToString` on `BuildPhase`.

* Cache the delegate passed into `ConcurrentDictionary.GetOrAdd` where
  possible. See #14582, fsharp/fslang-suggestions#1083, etc.

* Name

* Update release notes

* Fmt

* Remove unneeded `StringBuilder`

* Start count at 1

* 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`.

---------

Co-authored-by: Petr <[email protected]>

Author: brianrourkeboll

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))

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))

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<string, string list> splitNamespaceAux
+
 let splitNamespace nm =
-    memoizeNamespaceTable.GetOrAdd(nm, splitNamespaceAux)
+    memoizeNamespaceTable.GetOrAdd(nm, splitNamespaceAuxDelegate)
 
 // ++GLOBAL MUTABLE STATE (concurrency-safe)
 let memoizeNamespaceArrayTable = ConcurrentDictionary<string, string[]>()
 
+// Cache this as a delegate.
+let splitNamespaceToArrayDelegate =
+    Func<string, string array>(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<string, string option * string> splitTypeNameRightAux
+
 let splitTypeNameRight nm =
-    memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightAux)
+    memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightAuxDelegate)
 
 // --------------------------------------------------------------------
 // Ordered lists with a lookup table

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
                 )

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 =
     [<Literal>]

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<string, string>(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 =

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<string,Ref<int>>(max Environment.ProcessorCount 1, 127)
+    let basicNameCounts = ConcurrentDictionary<string, int ref>(max Environment.ProcessorCount 1, 127)
+    // Cache this as a delegate.
+    let basicNameCountsAddDelegate = Func<string, int ref>(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

src/FSharp.Core/QueryExtensions.fs

@@ -38,8 +38,10 @@ module internal Adapters =
 
     let memoize f =
         let d = new ConcurrentDictionary<Type, 'b>(HashIdentity.Structural)
+        // Cache this as a delegate.
+        let valueFactory = Func<Type, 'b> f
 
-        fun x -> d.GetOrAdd(x, (fun r -> f r))
+        fun x -> d.GetOrAdd(x, valueFactory)
 
     let isPartiallyImmutableRecord: Type -> bool =
         memoize (fun t ->