diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs index 3943455c6bd..27274f7ebda 100644 --- a/src/Compiler/Checking/TypeRelations.fs +++ b/src/Compiler/Checking/TypeRelations.fs @@ -35,8 +35,8 @@ let getTypeSubsumptionCache = let factory (g: TcGlobals) = let options = match g.compilationMode with - | CompilationMode.OneOff -> Caches.CacheOptions.getDefault() |> Caches.CacheOptions.withNoEviction - | _ -> { Caches.CacheOptions.getDefault() with TotalCapacity = 65536; HeadroomPercentage = 75 } + | CompilationMode.OneOff -> Caches.CacheOptions.getDefault HashIdentity.Structural |> Caches.CacheOptions.withNoEviction + | _ -> { Caches.CacheOptions.getDefault HashIdentity.Structural with TotalCapacity = 65536; HeadroomPercentage = 75 } new Caches.Cache(options, "typeSubsumptionCache") Extras.WeakMap.getOrCreate factory diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 2ef07e66e6b..2bea066e427 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -569,6 +569,7 @@ let main1 exiter.Exit 1 if tcConfig.showTimes then + Caches.CacheMetrics.CaptureStatsAndWriteToConsole() |> disposables.Register Activity.Profiling.addConsoleListener () |> disposables.Register tcConfig.writeTimesToFile diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs index 37f93dc298b..51216a4ea6a 100644 --- a/src/Compiler/Utilities/Caches.fs +++ b/src/Compiler/Utilities/Caches.fs @@ -7,6 +7,7 @@ open System.Collections.Concurrent open System.Threading open System.Diagnostics open System.Diagnostics.Metrics +open System.IO module CacheMetrics = let Meter = new Meter("FSharp.Compiler.Cache") @@ -22,57 +23,153 @@ module CacheMetrics = let creations = Meter.CreateCounter("creations", "count") let disposals = Meter.CreateCounter("disposals", "count") - let mkTag name = KeyValuePair<_, obj>("name", name) + let mutable private nextCacheId = 0 - 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) + let mkTags (name: string) = + let cacheId = Interlocked.Increment &nextCacheId + // Avoid TagList(ReadOnlySpan<...>) to support net472 runtime + let mutable tags = TagList() + tags.Add("name", box name) + tags.Add("cacheId", box cacheId) + tags -// 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 Add (tags: inref) = adds.Add(1L, &tags) + let Update (tags: inref) = updates.Add(1L, &tags) + let Hit (tags: inref) = hits.Add(1L, &tags) + let Miss (tags: inref) = misses.Add(1L, &tags) + let Eviction (tags: inref) = evictions.Add(1L, &tags) + let EvictionFail (tags: inref) = evictionFails.Add(1L, &tags) + let Created (tags: inref) = creations.Add(1L, &tags) + let Disposed (tags: inref) = disposals.Add(1L, &tags) - let incr key v = - Interlocked.Add(totals[key], v) |> ignore + type Stats() = + let totals = Map [ for counter in allCounters -> counter.Name, ref 0L ] + let total key = totals[key].Value - let total key = totals[key].Value + let mutable ratio = Double.NaN - let mutable ratio = Double.NaN + let updateRatio () = + ratio <- float (total hits.Name) / float (total hits.Name + total misses.Name) - let updateRatio () = - ratio <- - float (total CacheMetrics.hits.Name) - / float (total CacheMetrics.hits.Name + total CacheMetrics.misses.Name) + member _.Incr key v = + assert (totals.ContainsKey key) + Interlocked.Add(totals[key], v) |> ignore - let listener = new MeterListener() + if key = hits.Name || key = misses.Name then + updateRatio () - do + 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() + + let getStatsByName name = + statsByName.GetOrAdd(name, fun _ -> Stats()) + + let ListenToAll () = + let listener = new MeterListener() - for instrument in CacheMetrics.allCounters do + for instrument in allCounters do listener.EnableMeasurementEvents instrument listener.SetMeasurementEventCallback(fun instrument v tags _ -> - if tags[0] = tag then - incr instrument.Name v - - if instrument = CacheMetrics.hits || instrument = CacheMetrics.misses then - updateRatio ()) + match tags[0].Value with + | :? string as name -> + let stats = getStatsByName name + stats.Incr instrument.Name v + | _ -> assert false) listener.Start() + 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 CaptureStatsAndWriteToConsole () = + let listener = ListenToAll() + + { new IDisposable with + member _.Dispose() = + listener.Dispose() + Console.WriteLine(StatsToString()) + } - interface IDisposable with - member _.Dispose() = listener.Dispose() + // 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) = + + let stats = Stats() + let listener = new MeterListener() + + do + for instrument in allCounters do + listener.EnableMeasurementEvents instrument + + listener.SetMeasurementEventCallback(fun instrument v tags _ -> + let tagsMatch = tags[0] = cacheTags[0] && tags[1] = cacheTags[1] - member _.GetTotals() = - [ for k in totals.Keys -> k, total k ] |> Map.ofList + if tagsMatch then + stats.Incr instrument.Name v) - member _.GetStats() = [ "hit-ratio", ratio ] |> Map.ofList + listener.Start() + + interface IDisposable with + member _.Dispose() = listener.Dispose() + + member _.GetTotals() = stats.GetTotals() + + member _.Ratio = stats.Ratio + + override _.ToString() = stats.ToString() [] type EvictionMode = @@ -97,22 +194,17 @@ type CacheOptions<'Key> = } module CacheOptions = - let getDefault () = - { - CacheOptions.TotalCapacity = 1024 - CacheOptions.HeadroomPercentage = 50 - CacheOptions.EvictionMode = EvictionMode.MailboxProcessor - CacheOptions.Comparer = HashIdentity.Structural - } - let getReferenceIdentity () = + let getDefault comparer = { CacheOptions.TotalCapacity = 1024 CacheOptions.HeadroomPercentage = 50 CacheOptions.EvictionMode = EvictionMode.MailboxProcessor - CacheOptions.Comparer = HashIdentity.Reference + CacheOptions.Comparer = comparer } + let getReferenceIdentity () = getDefault HashIdentity.Reference + let withNoEviction options = { options with CacheOptions.EvictionMode = EvictionMode.NoEviction @@ -151,7 +243,7 @@ type EvictionQueueMessage<'Entity, 'Target> = | Update of 'Entity [] -[] +[] type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Key>, ?name) = do @@ -178,7 +270,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 @@ -211,10 +303,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 @@ -262,7 +354,11 @@ 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 @@ -270,12 +366,12 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke 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 @@ -285,7 +381,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 @@ -302,11 +398,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 @@ -321,18 +417,19 @@ 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() = @@ -341,3 +438,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 diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi index 9ecdcd2a79c..809911f5116 100644 --- a/src/Compiler/Utilities/Caches.fsi +++ b/src/Compiler/Utilities/Caches.fsi @@ -8,13 +8,16 @@ 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 -> IDisposable + val StatsToString: unit -> string + val CaptureStatsAndWriteToConsole: unit -> IDisposable -[] -/// A local listener that can be created for a specific Cache instance to get its metrics. For testing purposes only. -type internal CacheMetricsListener = - member GetStats: unit -> Map - member GetTotals: unit -> Map - interface IDisposable + /// A local listener that can be created for a specific Cache instance to get its metrics. For testing purposes only. + [] + type internal CacheMetricsListener = + member Ratio: float + member GetTotals: unit -> Map + interface IDisposable [] type internal EvictionMode = @@ -43,7 +46,7 @@ type internal CacheOptions<'Key> = module internal CacheOptions = /// Default options, using structural equality for keys and queued eviction. - val getDefault: unit -> CacheOptions<'Key> when 'Key: equality + val getDefault: IEqualityComparer<'Key> -> CacheOptions<'Key> /// Default options, using reference equality for keys and queued eviction. val getReferenceIdentity: unit -> CacheOptions<'Key> when 'Key: not struct /// Set eviction mode to NoEviction. @@ -64,4 +67,4 @@ type internal Cache<'Key, 'Value when 'Key: not null> = /// For testing only. member EvictionFailed: IEvent /// For testing only. Creates a local telemetry listener for this cache instance. - member CreateMetricsListener: unit -> CacheMetricsListener + member CreateMetricsListener: unit -> CacheMetrics.CacheMetricsListener diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs index 27cedae59de..b7aac72a93b 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs @@ -1,4 +1,4 @@ -module CompilerService.Caches +module internal CompilerService.Caches open FSharp.Compiler.Caches open Xunit @@ -14,11 +14,13 @@ let shouldNeverTimeout = 15_000 let shouldNeverTimeout = 200_000 #endif +let defaultStructural() = CacheOptions.getDefault HashIdentity.Structural + [] let ``Create and dispose many`` () = let caches = [ for _ in 1 .. 100 do - new Cache(CacheOptions.getDefault(), name = "Create and dispose many") :> IDisposable ] + new Cache(defaultStructural(), name = "Create and dispose many") :> IDisposable ] for c in caches do c.Dispose() @@ -26,7 +28,7 @@ let ``Create and dispose many`` () = [] let ``Basic add and retrieve`` () = let name = "Basic_add_and_retrieve" - use cache = new Cache(CacheOptions.getDefault(), name = name) + use cache = new Cache(defaultStructural(), name = name) use metricsListener = cache.CreateMetricsListener() cache.TryAdd("key1", 1) |> shouldBeTrue @@ -49,7 +51,7 @@ let ``Basic add and retrieve`` () = [] let ``Eviction of least recently used`` () = let name = "Eviction_of_least_recently_used" - use cache = new Cache({ CacheOptions.getDefault() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name) + use cache = new Cache({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name) use metricsListener = cache.CreateMetricsListener() cache.TryAdd("key1", 1) |> shouldBeTrue @@ -83,7 +85,7 @@ let ``Stress test evictions`` () = let iterations = 10_000 let name = "Stress test evictions" - use cache = new Cache({ CacheOptions.getDefault() with TotalCapacity = cacheSize; HeadroomPercentage = 0 }, name = name) + use cache = new Cache({ defaultStructural() with TotalCapacity = cacheSize; HeadroomPercentage = 0 }, name = name) use metricsListener = cache.CreateMetricsListener() let evictionsCompleted = new TaskCompletionSource() @@ -117,7 +119,7 @@ let ``Stress test evictions`` () = [] let ``Metrics can be retrieved`` () = - use cache = new Cache({ CacheOptions.getDefault() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = "test_metrics") + use cache = new Cache({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = "test_metrics") use metricsListener = cache.CreateMetricsListener() cache.TryAdd("key1", 1) |> shouldBeTrue @@ -133,17 +135,16 @@ 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 [] let ``GetOrAdd basic usage`` () = let cacheName = "GetOrAdd_basic_usage" - use cache = new Cache(CacheOptions.getDefault(), name = cacheName) + use cache = new Cache(defaultStructural(), name = cacheName) use metricsListener = cache.CreateMetricsListener() let mutable factoryCalls = 0 let factory k = factoryCalls <- factoryCalls + 1; String.length k @@ -156,17 +157,16 @@ 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 [] let ``AddOrUpdate basic usage`` () = let cacheName = "AddOrUpdate_basic_usage" - use cache = new Cache(CacheOptions.getDefault(), name = cacheName) + use cache = new Cache(defaultStructural(), name = cacheName) use metricsListener = cache.CreateMetricsListener() cache.AddOrUpdate("x", 1) let mutable value = 0 @@ -179,11 +179,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 +219,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 [] @@ -250,10 +248,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