Collect StackGuard stats

src/Compiler/Driver/fsc.fs

@@ -569,6 +569,7 @@ let main1
             exiter.Exit 1
 
     if tcConfig.showTimes then
+        StackGuardMetrics.CaptureStatsAndWriteToConsole() |> disposables.Register
         Caches.CacheMetrics.CaptureStatsAndWriteToConsole() |> disposables.Register
         Activity.Profiling.addConsoleListener () |> disposables.Register
 

src/Compiler/Facilities/DiagnosticsLogger.fs

@@ -16,6 +16,7 @@ open System.Runtime.InteropServices
 open Internal.Utilities.Library
 open Internal.Utilities.Library.Extras
 open System.Threading.Tasks
+open System.Collections.Concurrent
 
 /// Represents the style being used to format errors
 [<RequireQualifiedAccess; NoComparison; NoEquality>]
@@ -868,36 +869,75 @@ let internal languageFeatureNotSupportedInLibraryError (langFeature: LanguageFea
     let suggestedVersionStr = LanguageVersion.GetFeatureVersionString langFeature
     error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary (featureStr, suggestedVersionStr), m))
 
+module StackGuardMetrics =
+
+    let meter = FSharp.Compiler.Diagnostics.Metrics.Meter
+
+    let jumpCounter =
+        meter.CreateCounter<int64>(
+            "stackguard-jumps",
+            description = "Tracks the number of times the stack guard has jumped to a new thread"
+        )
+
+    let countJump memberName =
+        let tags =
+            let mutable tags = TagList()
+            tags.Add(Activity.Tags.callerMemberName, memberName)
+            tags
+
+        jumpCounter.Add(1L, &tags)
+
+    // Used by the self-listener.
+    let jumpsByFunctionName = ConcurrentDictionary<string, int64 ref>()
+
+    let Listen () =
+        let listener = new Metrics.MeterListener()
+
+        listener.EnableMeasurementEvents jumpCounter
+
+        listener.SetMeasurementEventCallback(fun _ v tags _ ->
+            let memberName = nonNull tags[0].Value :?> string
+            let counter = jumpsByFunctionName.GetOrAdd(memberName, fun _ -> ref 0L)
+            Interlocked.Add(counter, v) |> ignore)
+
+        listener.Start()
+        listener :> IDisposable
+
+    let StatsToString () =
+        let entries =
+            jumpsByFunctionName
+            |> Seq.map (fun kvp -> $"{kvp.Key}: {kvp.Value.Value}")
+            |> String.concat ", "
+
+        if entries.Length > 0 then
+            $"StackGuard jumps: {entries} \n"
+        else
+            ""
+
+    let CaptureStatsAndWriteToConsole () =
+        let listener = Listen()
+
+        { new IDisposable with
+            member _.Dispose() =
+                listener.Dispose()
+                StatsToString() |> printfn "%s"
+        }
+
 /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached
 type StackGuard(maxDepth: int, name: string) =
 
     let mutable depth = 1
 
     [<DebuggerHidden; DebuggerStepThrough>]
-    member _.Guard
-        (
-            f,
-            [<CallerMemberName; Optional; DefaultParameterValue("")>] memberName: string,
-            [<CallerFilePath; Optional; DefaultParameterValue("")>] path: string,
-            [<CallerLineNumber; Optional; DefaultParameterValue(0)>] line: int
-        ) =
-
-        Activity.addEventWithTags
-            "DiagnosticsLogger.StackGuard.Guard"
-            (seq {
-                Activity.Tags.stackGuardName, box name
-                Activity.Tags.stackGuardCurrentDepth, depth
-                Activity.Tags.stackGuardMaxDepth, maxDepth
-                Activity.Tags.callerMemberName, memberName
-                Activity.Tags.callerFilePath, path
-                Activity.Tags.callerLineNumber, line
-            })
+    member _.Guard(f, [<CallerMemberName; Optional; DefaultParameterValue("")>] memberName: string) =
 
         depth <- depth + 1
 
         try
             if depth % maxDepth = 0 then
 
+                StackGuardMetrics.countJump memberName
+
                 async {
                     do! Async.SwitchToNewThread()
                     Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})"

src/Compiler/Facilities/DiagnosticsLogger.fsi

@@ -459,16 +459,16 @@ val tryLanguageFeatureErrorOption:
 
 val languageFeatureNotSupportedInLibraryError: langFeature: LanguageFeature -> m: range -> 'T
 
+module internal StackGuardMetrics =
+    val Listen: unit -> IDisposable
+    val StatsToString: unit -> string
+    val CaptureStatsAndWriteToConsole: unit -> IDisposable
+
 type StackGuard =
     new: maxDepth: int * name: string -> StackGuard
 
     /// Execute the new function, on a new thread if necessary
-    member Guard:
-        f: (unit -> 'T) *
-        [<CallerMemberName; Optional; DefaultParameterValue("")>] memberName: string *
-        [<CallerFilePath; Optional; DefaultParameterValue("")>] path: string *
-        [<CallerLineNumber; Optional; DefaultParameterValue(0)>] line: int ->
-            'T
+    member Guard: f: (unit -> 'T) * [<CallerMemberName; Optional; DefaultParameterValue("")>] memberName: string -> 'T
 
     member GuardCancellable: Internal.Utilities.Library.Cancellable<'T> -> Internal.Utilities.Library.Cancellable<'T>
 

src/Compiler/Utilities/Activity.fs

@@ -18,6 +18,9 @@ module ActivityNames =
 
     let AllRelevantNames = [| FscSourceName; ProfiledSourceName |]
 
+module Metrics =
+    let Meter = new Metrics.Meter(ActivityNames.FscSourceName, "1.0.0")
+
 [<RequireQualifiedAccess>]
 module internal Activity =
 

src/Compiler/Utilities/Activity.fsi

@@ -2,7 +2,7 @@
 namespace FSharp.Compiler.Diagnostics
 
 open System
-open Internal.Utilities.Library
+open System.Diagnostics.Metrics
 
 /// For activities following the dotnet distributed tracing concept
 /// https://learn.microsoft.com/dotnet/core/diagnostics/distributed-tracing-concepts?source=recommendations
@@ -16,6 +16,9 @@ module ActivityNames =
 
     val AllRelevantNames: string[]
 
+module internal Metrics =
+    val Meter: Meter
+
 /// For activities following the dotnet distributed tracing concept
 /// https://learn.microsoft.com/dotnet/core/diagnostics/distributed-tracing-concepts?source=recommendations
 [<RequireQualifiedAccess>]

src/Compiler/Utilities/Caches.fs

@@ -10,7 +10,7 @@ open System.Diagnostics.Metrics
 open System.IO
 
 module CacheMetrics =
-    let Meter = new Meter("FSharp.Compiler.Cache")
+    let Meter = FSharp.Compiler.Diagnostics.Metrics.Meter
     let adds = Meter.CreateCounter<int64>("adds", "count")
     let updates = Meter.CreateCounter<int64>("updates", "count")
     let hits = Meter.CreateCounter<int64>("hits", "count")

tests/FSharp.Test.Utilities/XunitHelpers.fs

@@ -175,7 +175,7 @@ type OpenTelemetryExport(testRunName, enable) =
 
             // Configure OpenTelemetry metrics export. Metrics can be viewed in Prometheus or other compatible tools.
             OpenTelemetry.Sdk.CreateMeterProviderBuilder()
-                .AddMeter(CacheMetrics.Meter.Name)
+                .AddMeter(ActivityNames.FscSourceName)
                 .AddMeter("System.Runtime")
                 .ConfigureResource(fun r -> r.AddService(testRunName) |> ignore)
                 .AddOtlpExporter(fun e m ->

vsintegration/src/FSharp.Editor/Common/DebugHelpers.fs

@@ -123,10 +123,12 @@ module FSharpServiceTelemetry =
     let periodicallyDisplayCacheStats =
         cancellableTask {
             use _ = CacheMetrics.ListenToAll()
+            use _ = FSharp.Compiler.DiagnosticsLogger.StackGuardMetrics.Listen()
 
             while true do
                 do! Task.Delay(TimeSpan.FromSeconds 10.0)
                 FSharpOutputPane.logMsg (CacheMetrics.StatsToString())
+                FSharpOutputPane.logMsg (FSharp.Compiler.DiagnosticsLogger.StackGuardMetrics.StatsToString())
         }
 
 #if DEBUG