Merge branch 'cache-stats' into cache-2

Author: majocha

src/Compiler/Utilities/Caches.fs

@@ -22,57 +22,103 @@ module CacheMetrics =
     let creations = Meter.CreateCounter<int64>("creations", "count")
     let disposals = Meter.CreateCounter<int64>("disposals", "count")
 
-    let mkTag name = KeyValuePair<_, obj>("name", name)
-
-    let Add (tag: KeyValuePair<_, _>) = adds.Add(1L, tag)
-    let Update (tag: KeyValuePair<_, _>) = updates.Add(1L, tag)
-    let Hit (tag: KeyValuePair<_, _>) = hits.Add(1L, tag)
-    let Miss (tag: KeyValuePair<_, _>) = misses.Add(1L, tag)
-    let Eviction (tag: KeyValuePair<_, _>) = evictions.Add(1L, tag)
-    let EvictionFail (tag: KeyValuePair<_, _>) = evictionFails.Add(1L, tag)
-    let Created (tag: KeyValuePair<_, _>) = creations.Add(1L, tag)
-    let Disposed (tag: KeyValuePair<_, _>) = disposals.Add(1L, tag)
-
-// Currently the Cache emits telemetry for raw cache events: hits, misses, evictions etc.
-// This class observes those counters and keeps a snapshot of readings. It is used in tests and can be used to print cache stats in debug mode.
-type CacheMetricsListener(tag) =
-    let totals = Map [ for counter in CacheMetrics.allCounters -> counter.Name, ref 0L ]
-
-    let incr key v =
-        Interlocked.Add(totals[key], v) |> ignore
-
-    let total key = totals[key].Value
-
-    let mutable ratio = Double.NaN
+    let mutable private nextCacheId = 0
+
+    let mkTags (name: string) =
+        let cacheId = Interlocked.Increment &nextCacheId
+        [| "name", box name; "cacheId", box cacheId |]
+        |> Array.map KeyValuePair
+        |> TagList
+
+    let Add (tags: inref<TagList>) = adds.Add(1L, &tags)
+    let Update (tags: inref<TagList>) = updates.Add(1L, &tags)
+    let Hit (tags: inref<TagList>) = hits.Add(1L, &tags)
+    let Miss (tags: inref<TagList>) = misses.Add(1L, &tags)
+    let Eviction (tags: inref<TagList>) = evictions.Add(1L, &tags)
+    let EvictionFail (tags: inref<TagList>) = evictionFails.Add(1L, &tags)
+    let Created (tags: inref<TagList>) = creations.Add(1L, &tags)
+    let Disposed (tags: inref<TagList>) = disposals.Add(1L, &tags)
+
+    type Stats() =
+        let totals = Map [ for counter in allCounters -> counter.Name, ref 0L ]
+        let total key = totals[key].Value
+
+        let mutable ratio = Double.NaN
+        
+        let updateRatio () =
+            ratio <-
+                float (total hits.Name)
+                / float (total hits.Name + total misses.Name)
+
+        member _.Incr key v =
+            assert (totals.ContainsKey key)
+            Interlocked.Add(totals[key], v) |> ignore
+
+            if key = hits.Name || key = misses.Name then
+                updateRatio ()
+
+        member _.GetTotals() =
+            [ for k in totals.Keys -> k, total k ] |> Map.ofList
+
+        member _.Ratio = ratio
+
+        override _.ToString() =
+            let parts =
+                [ for kv in totals do
+                    yield $"{kv.Key}={kv.Value.Value}"
+                  if not (Double.IsNaN ratio) then
+                      yield $"hit-ratio={ratio:P2}" ]
+            String.Join(", ", parts)
+
+    let statsByName = ConcurrentDictionary<string, Stats>()
+
+    let getStatsByName name = statsByName.GetOrAdd(name, fun _ -> Stats ())
+
+    let ListenToAll () =
+        let listener = new MeterListener()
+        for instrument in allCounters do
+            listener.EnableMeasurementEvents instrument
+        listener.SetMeasurementEventCallback(fun instrument v tags _ ->
+            match tags[0].Value with
+            | :? string as name ->
+                let stats = getStatsByName name
+                stats.Incr instrument.Name v
+            | _ -> assert false)
+        listener.Start()
 
-    let updateRatio () =
-        ratio <-
-            float (total CacheMetrics.hits.Name)
-            / float (total CacheMetrics.hits.Name + total CacheMetrics.misses.Name)
+    let StatsToString () =
+        let sb = Text.StringBuilder()
+        sb.AppendLine "Cache Metrics:" |> ignore
+        for kv in statsByName do
+            sb.AppendLine $"Cache {kv.Key}: {kv.Value}" |> ignore
+        sb.AppendLine() |> ignore
+        string sb
 
-    let listener = new MeterListener()
+    // Currently the Cache emits telemetry for raw cache events: hits, misses, evictions etc.
+    // This type observes those counters and keeps a snapshot of readings. It is used in tests and can be used to print cache stats in debug mode.
+    type CacheMetricsListener(cacheTags: TagList) =
 
-    do
+        let stats = Stats()
+        let listener = new MeterListener()
 
-        for instrument in CacheMetrics.allCounters do
-            listener.EnableMeasurementEvents instrument
+        do
+            for instrument in allCounters do
+                listener.EnableMeasurementEvents instrument
 
-        listener.SetMeasurementEventCallback(fun instrument v tags _ ->
-            if tags[0] = tag then
-                incr instrument.Name v
+            listener.SetMeasurementEventCallback(fun instrument v tags _ ->
+                let tagsMatch = tags[0] = cacheTags[0] && tags[1] = cacheTags[1]
+                if tagsMatch then stats.Incr instrument.Name v)
 
-                if instrument = CacheMetrics.hits || instrument = CacheMetrics.misses then
-                    updateRatio ())
+            listener.Start()
 
-        listener.Start()
+        interface IDisposable with
+            member _.Dispose() = listener.Dispose()
 
-    interface IDisposable with
-        member _.Dispose() = listener.Dispose()
+        member _.GetTotals() = stats.GetTotals()
 
-    member _.GetTotals() =
-        [ for k in totals.Keys -> k, total k ] |> Map.ofList
+        member _.Ratio = stats.Ratio
 
-    member _.GetStats() = [ "hit-ratio", ratio ] |> Map.ofList
+        override _.ToString() = stats.ToString()
 
 [<RequireQualifiedAccess>]
 type EvictionMode =
@@ -163,7 +209,7 @@ type EvictionQueueMessage<'Entity, 'Target> =
     | Update of 'Entity
 
 [<Sealed; NoComparison; NoEquality>]
-[<DebuggerDisplay("{GetStats()}")>]
+[<DebuggerDisplay("{DebugDisplay()}")>]
 type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Key>, ?name) =
 
     do
@@ -190,7 +236,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke
     let evicted = Event<_>()
     let evictionFailed = Event<_>()
 
-    let tag = CacheMetrics.mkTag name
+    let tags = CacheMetrics.mkTags name
 
     // Track disposal state (0 = not disposed, 1 = disposed)
     let mutable disposed = 0
@@ -223,10 +269,10 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke
 
                 match store.TryRemove(first.Value.Key) with
                 | true, _ ->
-                    CacheMetrics.Eviction tag
+                    CacheMetrics.Eviction &tags
                     evicted.Trigger()
                 | _ ->
-                    CacheMetrics.EvictionFail tag
+                    CacheMetrics.EvictionFail &tags
                     evictionFailed.Trigger()
                     deadKeysCount <- deadKeysCount + 1
 
@@ -244,11 +290,14 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke
     let startEvictionProcessor ct =
         MailboxProcessor.Start(
             (fun mb ->
-                async {
-                    while true do
+                let rec processNext () =
+                    async {
                         let! message = mb.Receive()
                         processEvictionMessage message
-                }),
+                        return! processNext ()
+                    }
+
+                processNext ()),
             ct
         )
 
@@ -271,20 +320,24 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke
 
             post, dispose
 
-    do CacheMetrics.Created tag
+#if DEBUG
+    let debugListener = new CacheMetrics.CacheMetricsListener(tags)
+#endif
+
+    do CacheMetrics.Created &tags
 
     member val Evicted = evicted.Publish
     member val EvictionFailed = evictionFailed.Publish
 
     member _.TryGetValue(key: 'Key, value: outref<'Value>) =
         match store.TryGetValue(key) with
         | true, entity ->
-            CacheMetrics.Hit tag
+            CacheMetrics.Hit &tags
             post (EvictionQueueMessage.Update entity)
             value <- entity.Value
             true
         | _ ->
-            CacheMetrics.Miss tag
+            CacheMetrics.Miss &tags
             value <- Unchecked.defaultof<'Value>
             false
 
@@ -294,7 +347,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke
         let added = store.TryAdd(key, entity)
 
         if added then
-            CacheMetrics.Add tag
+            CacheMetrics.Add &tags
             post (EvictionQueueMessage.Add(entity, store))
 
         added
@@ -311,11 +364,11 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke
 
         if wasMiss then
             post (EvictionQueueMessage.Add(result, store))
-            CacheMetrics.Add tag
-            CacheMetrics.Miss tag
+            CacheMetrics.Add &tags    
+            CacheMetrics.Miss &tags
         else
             post (EvictionQueueMessage.Update result)
-            CacheMetrics.Hit tag
+            CacheMetrics.Hit &tags
 
         result.Value
 
@@ -330,18 +383,18 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke
 
         // Returned value tells us if the entity was added or updated.
         if Object.ReferenceEquals(addValue, result) then
-            CacheMetrics.Add tag
+            CacheMetrics.Add &tags
             post (EvictionQueueMessage.Add(addValue, store))
         else
-            CacheMetrics.Update tag
+            CacheMetrics.Update &tags
             post (EvictionQueueMessage.Update result)
 
-    member _.CreateMetricsListener() = new CacheMetricsListener(tag)
+    member _.CreateMetricsListener() = new CacheMetrics.CacheMetricsListener(tags)
 
     member _.Dispose() =
         if Interlocked.Exchange(&disposed, 1) = 0 then
             disposeEvictionProcessor ()
-            CacheMetrics.Disposed tag
+            CacheMetrics.Disposed &tags
 
     interface IDisposable with
         member this.Dispose() =
@@ -350,3 +403,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke
 
     // Finalizer to ensure eviction loop is cancelled if Dispose wasn't called.
     override this.Finalize() = this.Dispose()
+
+#if DEBUG
+    member _.DebugDisplay() = debugListener.ToString()
+#endif

src/Compiler/Utilities/Caches.fsi

@@ -8,13 +8,15 @@ module internal CacheMetrics =
     /// Global telemetry Meter for all caches. Exposed for testing purposes.
     /// Set FSHARP_OTEL_EXPORT environment variable to enable OpenTelemetry export to external collectors in tests.
     val Meter: Meter
+    val ListenToAll: unit -> unit
+    val StatsToString: unit -> string
 
-/// A local listener that can be created for a specific Cache instance to get its metrics. For testing purposes only.
-[<Class>]
-type internal CacheMetricsListener =
-    member GetStats: unit -> Map<string, float>
-    member GetTotals: unit -> Map<string, int64>
-    interface IDisposable
+    /// A local listener that can be created for a specific Cache instance to get its metrics. For testing purposes only.
+    [<Class>]
+    type internal CacheMetricsListener =
+        member Ratio: float
+        member GetTotals: unit -> Map<string, int64>
+        interface IDisposable
 
 [<RequireQualifiedAccess; NoComparison>]
 type internal EvictionMode =
@@ -64,4 +66,4 @@ type internal Cache<'Key, 'Value when 'Key: not null> =
     /// For testing only.
     member EvictionFailed: IEvent<unit>
     /// For testing only. Creates a local telemetry listener for this cache instance.
-    member CreateMetricsListener: unit -> CacheMetricsListener
+    member CreateMetricsListener: unit -> CacheMetrics.CacheMetricsListener

tests/Directory.Build.props

@@ -16,6 +16,7 @@
     <NoOptimizationData>false</NoOptimizationData>
     <NoInterfaceData>false</NoInterfaceData>
     <CompressMetadata>true</CompressMetadata>
+    <ServerGarbageCollection>true</ServerGarbageCollection>
   </PropertyGroup>
 
 </Project>

tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs

@@ -133,10 +133,9 @@ let ``Metrics can be retrieved`` () =
     cache.TryAdd("key3", 3) |> shouldBeTrue
     evictionCompleted.Task.Wait shouldNeverTimeout |> shouldBeTrue
 
-    let stats = metricsListener.GetStats()
     let totals = metricsListener.GetTotals()
 
-    stats.["hit-ratio"] |> shouldEqual 1.0
+    metricsListener.Ratio |> shouldEqual 1.0
     totals.["evictions"] |> shouldEqual 1L
     totals.["adds"] |> shouldEqual 3L
 
@@ -156,11 +155,10 @@ let ``GetOrAdd basic usage`` () =
     v3 |> shouldEqual 4
     factoryCalls |> shouldEqual 2
     // Metrics assertions
-    let stats = metricsListener.GetStats()
     let totals = metricsListener.GetTotals()
     totals.["hits"] |> shouldEqual 1L
     totals.["misses"] |> shouldEqual 2L
-    stats.["hit-ratio"] |> shouldEqual (1.0/3.0)
+    metricsListener.Ratio |> shouldEqual (1.0/3.0)
     totals.["adds"] |> shouldEqual 2L
 
 [<Fact>]
@@ -179,11 +177,10 @@ let ``AddOrUpdate basic usage`` () =
     cache.TryGetValue("y", &value) |> shouldBeTrue
     value |> shouldEqual 99
     // Metrics assertions
-    let stats = metricsListener.GetStats()
     let totals = metricsListener.GetTotals()
     totals.["hits"] |> shouldEqual 3L // 3 cache hits
     totals.["misses"] |> shouldEqual 0L // 0 cache misses
-    stats.["hit-ratio"] |> shouldEqual 1.0
+    metricsListener.Ratio |> shouldEqual 1.0
     totals.["adds"] |> shouldEqual 2L // "x" and "y" added
     totals.["updates"] |> shouldEqual 1L // "x" updated
 
@@ -220,11 +217,10 @@ let ``GetOrAdd with reference identity`` () =
     v1'' |> shouldEqual v1'
     v2'' |> shouldEqual v2'
     // Metrics assertions
-    let stats = metricsListener.GetStats()
     let totals = metricsListener.GetTotals()
     totals.["hits"] |> shouldEqual 4L
     totals.["misses"] |> shouldEqual 3L
-    stats.["hit-ratio"] |> shouldEqual (4.0 / 7.0)
+    metricsListener.Ratio |> shouldEqual (4.0 / 7.0)
     totals.["adds"] |> shouldEqual 2L
 
 [<Fact>]
@@ -250,10 +246,9 @@ let ``AddOrUpdate with reference identity`` () =
     cache.TryGetValue(t1, &value1Updated) |> shouldBeTrue
     value1Updated |> shouldEqual 9
     // Metrics assertions
-    let stats = metricsListener.GetStats()
     let totals = metricsListener.GetTotals()
     totals.["hits"] |> shouldEqual 3L // 3 cache hits
     totals.["misses"] |> shouldEqual 0L // 0 cache misses
-    stats.["hit-ratio"] |> shouldEqual 1.0
+    metricsListener.Ratio |> shouldEqual 1.0
     totals.["adds"] |> shouldEqual 2L // t1 and t2 added
     totals.["updates"] |> shouldEqual 1L // t1 updated once