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,6 +869,66 @@ 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 location =
+        let tags =
+            let mutable tags = TagList()
+            tags.Add(Activity.Tags.callerMemberName, memberName)
+            tags.Add("source", location)
+            tags
+
+        jumpCounter.Add(1L, &tags)
+
+    // Used by the self-listener.
+    let jumpsByFunctionName = ConcurrentDictionary<_, 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 source = nonNull tags[1].Value :?> string
+            let counter = jumpsByFunctionName.GetOrAdd((memberName, source), fun _ -> ref 0L)
+            Interlocked.Add(counter, v) |> ignore)
+
+        listener.Start()
+        listener :> IDisposable
+
+    let StatsToString () =
+        let headers = [ "caller"; "source"; "jumps" ]
+
+        let data =
+            [
+                for kvp in jumpsByFunctionName do
+                    let (memberName, source) = kvp.Key
+                    [ memberName; source; string kvp.Value.Value ]
+            ]
+
+        if List.isEmpty data then
+            ""
+        else
+            $"StackGuard jumps:\n{Metrics.printTable headers data}"
+
+    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) =
 
@@ -882,22 +943,15 @@ type StackGuard(maxDepth: int, name: 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
-            })
-
         depth <- depth + 1
 
         try
             if depth % maxDepth = 0 then
 
+                let fileName = System.IO.Path.GetFileName(path)
+
+                StackGuardMetrics.countJump memberName $"{fileName}:{line}"
+
                 async {
                     do! Async.SwitchToNewThread()
                     Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})"

src/Compiler/Facilities/DiagnosticsLogger.fsi

@@ -459,6 +459,11 @@ 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
 

src/Compiler/Utilities/Activity.fs

@@ -18,6 +18,54 @@ module ActivityNames =
 
     let AllRelevantNames = [| FscSourceName; ProfiledSourceName |]
 
+module Metrics =
+    let Meter = new Metrics.Meter(ActivityNames.FscSourceName)
+
+    let formatTable headers rows =
+        let columnWidths =
+            headers :: rows
+            |> List.transpose
+            |> List.map (List.map String.length >> List.max)
+
+        let center width (cell: string) =
+            String.replicate ((width - cell.Length) / 2) " " + cell |> _.PadRight(width)
+
+        let headers = (columnWidths, headers) ||> List.map2 center
+
+        let printRow (row: string list) =
+            row
+            |> List.mapi (fun i (cell: string) ->
+                if i = 0 then
+                    cell.PadRight(columnWidths[i])
+                else
+                    cell.PadLeft(columnWidths[i]))
+            |> String.concat " | "
+            |> sprintf "| %s |"
+
+        let headerRow = printRow headers
+
+        let divider = headerRow |> String.map (fun c -> if c = '|' then c else '-')
+        let hl = String.replicate divider.Length "-"
+
+        use sw = new StringWriter()
+
+        sw.WriteLine hl
+        sw.WriteLine headerRow
+        sw.WriteLine divider
+
+        for row in rows do
+            sw.WriteLine(printRow row)
+
+        sw.WriteLine hl
+
+        string sw
+
+    let printTable headers rows =
+        try
+            formatTable headers rows
+        with exn ->
+            $"Error formatting table: {exn}"
+
 [<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,11 @@ module ActivityNames =
 
     val AllRelevantNames: string[]
 
+module internal Metrics =
+    val Meter: Meter
+
+    val printTable: headers: string list -> rows: string list list -> string
+
 /// 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")
@@ -96,43 +96,24 @@ module CacheMetrics =
         listener :> IDisposable
 
     let StatsToString () =
-        use sw = new StringWriter()
-
-        let nameColumnWidth =
-            [ yield! statsByName.Keys; "Cache name" ] |> Seq.map String.length |> Seq.max
-
-        let columns = allCounters |> List.map _.Name
-        let columnWidths = columns |> List.map String.length |> List.map (max 8)
-
-        let header =
-            "| "
-            + String.concat
-                " | "
-                [
-                    "Cache name".PadRight nameColumnWidth
-                    "hit-ratio"
-                    for w, c in (columnWidths, columns) ||> List.zip do
-                        $"{c.PadLeft w}"
-                ]
-            + " |"
-
-        sw.WriteLine(String('-', header.Length))
-        sw.WriteLine(header)
-        sw.WriteLine(header |> String.map (fun c -> if c = '|' then '|' else '-'))
-
-        for kv in statsByName do
-            let name = kv.Key
-            let stats = kv.Value
-            let totals = stats.GetTotals()
-            sw.Write $"| {name.PadLeft nameColumnWidth} | {stats.Ratio, 9:P2} |"
-
-            for w, c in (columnWidths, columns) ||> List.zip do
-                sw.Write $" {totals[c].ToString().PadLeft(w)} |"
-
-            sw.WriteLine()
-
-        sw.WriteLine(String('-', header.Length))
-        string sw
+        let headers = [ "Cache name"; "hit-ratio" ] @ (allCounters |> List.map _.Name)
+
+        let rows =
+            [
+                for kv in statsByName do
+                    let name = kv.Key
+                    let stats = kv.Value
+                    let totals = stats.GetTotals()
+
+                    [
+                        yield name
+                        yield $"{stats.Ratio:P2}"
+                        for c in allCounters do
+                            yield $"{totals[c.Name]}"
+                    ]
+            ]
+
+        FSharp.Compiler.Diagnostics.Metrics.printTable headers rows
 
     let CaptureStatsAndWriteToConsole () =
         let listener = ListenToAll()

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

@@ -120,13 +120,15 @@ module FSharpServiceTelemetry =
 
         ActivitySource.AddActivityListener(listener)
 
-    let periodicallyDisplayCacheStats =
+    let periodicallyDisplayMetrics =
         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

vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs

@@ -417,7 +417,7 @@ type internal FSharpPackage() as this =
             false,
             fun _ _ ->
                 task {
-                    DebugHelpers.FSharpServiceTelemetry.periodicallyDisplayCacheStats
+                    DebugHelpers.FSharpServiceTelemetry.periodicallyDisplayMetrics
                     |> CancellableTask.start this.DisposalToken
                     |> ignore
                 }