Skip to content

Caches: remove EntityPool, improve metrics, add eviction stress test #18786

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 8 commits into from
Aug 11, 2025
Merged

Caches: remove EntityPool, improve metrics, add eviction stress test #18786

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
6460381
improve metrics, add eviction stress test
majocha Jul 30, 2025
a42417e
make the tests look nicer
majocha Jul 31, 2025
1e21ae9
ilver
majocha Aug 4, 2025
4702f12
Merge branch 'main' into cache-metrics
majocha Aug 5, 2025
43e6ebc
Merge branch 'main' into cache-metrics
majocha Aug 6, 2025
9ee3fb1
fix 18819
majocha Aug 6, 2025
acf831a
Merge branch 'main' into cache-metrics
majocha Aug 6, 2025
3dc511f
Merge branch 'main' into cache-metrics
majocha Aug 6, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
85 changes: 36 additions & 49 deletions src/Compiler/Checking/TypeRelations.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -101,20 +101,6 @@ let TypesFeasiblyEquiv ndeep g amap m ty1 ty2 =
let TypesFeasiblyEquivStripMeasures g amap m ty1 ty2 =
TypesFeasiblyEquivalent true 0 g amap m ty1 ty2

let inline TryGetCachedTypeSubsumption (g: TcGlobals) (amap: ImportMap) key =
if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
match amap.TypeSubsumptionCache.TryGetValue(key) with
| true, subsumes ->
ValueSome subsumes
| false, _ ->
ValueNone
else
ValueNone

let inline UpdateCachedTypeSubsumption (g: TcGlobals) (amap: ImportMap) key subsumes : unit =
if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
amap.TypeSubsumptionCache.TryAdd(key, subsumes) |> ignore

/// The feasible coercion relation. Part of the language spec.
let rec TypeFeasiblySubsumesType ndeep (g: TcGlobals) (amap: ImportMap) m (ty1: TType) (canCoerce: CanCoerce) (ty2: TType) =

Expand All @@ -124,41 +110,42 @@ let rec TypeFeasiblySubsumesType ndeep (g: TcGlobals) (amap: ImportMap) m (ty1:
let ty1 = stripTyEqns g ty1
let ty2 = stripTyEqns g ty2

// Check if language feature supported
let key = TTypeCacheKey.FromStrippedTypes (ty1, ty2, canCoerce)

match TryGetCachedTypeSubsumption g amap key with
| ValueSome subsumes ->
subsumes
| ValueNone ->
let subsumes =
match ty1, ty2 with
| TType_measure _, TType_measure _
| TType_var _, _ | _, TType_var _ ->
true

| TType_app (tc1, l1, _), TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 ->
List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2

| TType_tuple _, TType_tuple _
| TType_anon _, TType_anon _
| TType_fun _, TType_fun _ ->
TypesFeasiblyEquiv ndeep g amap m ty1 ty2

| _ ->
// F# reference types are subtypes of type 'obj'
if isObjTyAnyNullness g ty1 && (canCoerce = CanCoerce || isRefTy g ty2) then
true
elif isAppTy g ty2 && (canCoerce = CanCoerce || isRefTy g ty2) && TypeFeasiblySubsumesTypeWithSupertypeCheck g amap m ndeep ty1 ty2 then
true
else
let interfaces = GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m ty2
// See if any interface in type hierarchy of ty2 is a supertype of ty1
List.exists (TypeFeasiblySubsumesType (ndeep + 1) g amap m ty1 NoCoerce) interfaces

UpdateCachedTypeSubsumption g amap key subsumes

subsumes
let checkSubsumes ty1 ty2 =
match ty1, ty2 with
| TType_measure _, TType_measure _
| TType_var _, _ | _, TType_var _ ->
true

| TType_app (tc1, l1, _), TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 ->
List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2

| TType_tuple _, TType_tuple _
| TType_anon _, TType_anon _
| TType_fun _, TType_fun _ ->
TypesFeasiblyEquiv ndeep g amap m ty1 ty2

| _ ->
// F# reference types are subtypes of type 'obj'
if isObjTyAnyNullness g ty1 && (canCoerce = CanCoerce || isRefTy g ty2) then
true
elif isAppTy g ty2 && (canCoerce = CanCoerce || isRefTy g ty2) && TypeFeasiblySubsumesTypeWithSupertypeCheck g amap m ndeep ty1 ty2 then
true
else
let interfaces = GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m ty2
// See if any interface in type hierarchy of ty2 is a supertype of ty1
List.exists (TypeFeasiblySubsumesType (ndeep + 1) g amap m ty1 NoCoerce) interfaces

if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
let key = TTypeCacheKey.FromStrippedTypes (ty1, ty2, canCoerce)

match amap.TypeSubsumptionCache.TryGetValue(key) with
| true, subsumes -> subsumes
| false, _ ->
let subsumes = checkSubsumes ty1 ty2
amap.TypeSubsumptionCache.TryAdd(key, subsumes) |> ignore
subsumes
else
checkSubsumes ty1 ty2

and TypeFeasiblySubsumesTypeWithSupertypeCheck g amap m ndeep ty1 ty2 =
match GetSuperTypeOfType g amap m ty2 with
Expand Down
187 changes: 71 additions & 116 deletions src/Compiler/Utilities/Caches.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ open System.Collections.Concurrent
open System.Threading
open System.Diagnostics
open System.Diagnostics.Metrics
open System.Collections.Immutable

[<Struct; RequireQualifiedAccess; NoComparison; NoEquality>]
type CacheOptions =
Expand Down Expand Up @@ -47,112 +48,80 @@ type CachedEntity<'Key, 'Value> =
entity.node <- LinkedListNode(entity)
entity

member this.ReUse(key, value) =
this.key <- key
this.value <- value
this

override this.ToString() = $"{this.Key}"

// Currently the Cache itself exposes Metrics.Counters that count raw cache events: hits, misses, evictions etc.
// This class observes those counters and keeps a snapshot of readings. For now this is used only to print cache stats in debug mode.
// TODO: We could add some System.Diagnostics.Metrics.Gauge instruments to this class, to get computed stats also exposed as metrics.
type CacheMetrics(cacheId) =
type CacheMetrics(cacheId: string) =
static let meter = new Meter("FSharp.Compiler.Cache")

static let observedCaches = ConcurrentDictionary<string, CacheMetrics>()

let readings = ConcurrentDictionary<string, int64 ref>()
let created = meter.CreateCounter<int64>("created", "count", cacheId)
let hits = meter.CreateCounter<int64>("hits", "count", cacheId)
let misses = meter.CreateCounter<int64>("misses", "count", cacheId)
let evictions = meter.CreateCounter<int64>("evictions", "count", cacheId)
let evictionFails = meter.CreateCounter<int64>("eviction-fails", "count", cacheId)
let allCouinters = [ created; hits; misses; evictions; evictionFails ]

let listener = new MeterListener()
let totals =
let builder = ImmutableDictionary.CreateBuilder<Instrument, int64 ref>()

do
listener.InstrumentPublished <-
fun i l ->
if i.Meter = meter && i.Description = cacheId then
l.EnableMeasurementEvents(i)
for counter in allCouinters do
builder.Add(counter, ref 0L)

listener.SetMeasurementEventCallback<int64>(fun k v _ _ -> Interlocked.Add(readings.GetOrAdd(k.Name, ref 0L), v) |> ignore)
listener.Start()
builder.ToImmutable()

member this.Dispose() = listener.Dispose()
let incr key v =
Interlocked.Add(totals[key], v) |> ignore

member val CacheId = cacheId
let total key = totals[key].Value

static member val Meter = meter
let mutable ratio = Double.NaN

member val RecentStats = "-" with get, set

member this.TryUpdateStats(clearCounts) =
let ratio =
try
float readings["hits"].Value
/ float (readings["hits"].Value + readings["misses"].Value)
* 100.0
with _ ->
Double.NaN

let stats =
[
for name in readings.Keys do
let v = readings[name].Value

if v > 0 then
$"{name}: {v}"
]
|> String.concat ", "
|> sprintf "%s | hit ratio: %s %s" this.CacheId (if Double.IsNaN(ratio) then "-" else $"%.1f{ratio}%%")

if clearCounts then
for r in readings.Values do
Interlocked.Exchange(r, 0L) |> ignore

if stats <> this.RecentStats then
this.RecentStats <- stats
true
else
false
let updateRatio () =
ratio <- float (total hits) / float (total hits + total misses)

// TODO: Should return a Map, not a string
static member GetStats(cacheId) =
observedCaches[cacheId].TryUpdateStats(false) |> ignore
observedCaches[cacheId].RecentStats
let listener = new MeterListener()

static member GetStatsUpdateForAllCaches(clearCounts) =
[
for i in observedCaches.Values do
if i.TryUpdateStats(clearCounts) then
i.RecentStats
]
|> String.concat "\n"
let startListening () =
for i in allCouinters do
listener.EnableMeasurementEvents i

static member AddInstrumentation(cacheId) =
if observedCaches.ContainsKey cacheId then
invalidArg "cacheId" $"cache with name {cacheId} already exists"
listener.SetMeasurementEventCallback(fun instrument v _ _ ->
incr instrument v

observedCaches[cacheId] <- new CacheMetrics(cacheId)
if instrument = hits || instrument = misses then
updateRatio ())

static member RemoveInstrumentation(cacheId) =
observedCaches[cacheId].Dispose()
observedCaches.TryRemove(cacheId) |> ignore
listener.Start()

// Creates and after reclaiming holds entities for reuse.
// More than totalCapacity can be created, but it will hold for reuse at most totalCapacity.
type EntityPool<'Key, 'Value>(totalCapacity, cacheId) =
let pool = ConcurrentBag<CachedEntity<'Key, 'Value>>()
member val Created = created
member val Hits = hits
member val Misses = misses
member val Evictions = evictions
member val EvictionFails = evictionFails

let created = CacheMetrics.Meter.CreateCounter<int64>("created", "count", cacheId)
member this.ObserveMetrics() =
observedCaches[cacheId] <- this
startListening ()

member _.Acquire(key, value) =
match pool.TryTake() with
| true, entity -> entity.ReUse(key, value)
| _ ->
created.Add 1L
CachedEntity.Create(key, value)
member this.Dispose() =
observedCaches.TryRemove cacheId |> ignore
listener.Dispose()

member _.GetInstanceTotals() =
[ for k in totals.Keys -> k.Name, total k ] |> Map.ofList

member _.Reclaim(entity: CachedEntity<'Key, 'Value>) =
if pool.Count < totalCapacity then
pool.Add(entity)
member _.GetInstanceStats() = [ "hit-ratio", ratio ] |> Map.ofList

static member val Meter = meter

static member GetTotals(cacheId) =
observedCaches[cacheId].GetInstanceTotals()

static member GetStats(cacheId) =
observedCaches[cacheId].GetInstanceStats()

module Cache =
// During testing a lot of compilations are started in app domains and subprocesses.
Expand All @@ -176,25 +145,13 @@ type EvictionQueueMessage<'Key, 'Value> =

[<Sealed; NoComparison; NoEquality>]
[<DebuggerDisplay("{GetStats()}")>]
type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (totalCapacity, headroom, ?name, ?observeMetrics) =

let instanceId = defaultArg name (Guid.NewGuid().ToString())
type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (totalCapacity, headroom, name, listen) =

let observeMetrics = defaultArg observeMetrics false
let metrics = new CacheMetrics(name)

do
if observeMetrics then
CacheMetrics.AddInstrumentation instanceId

let meter = CacheMetrics.Meter
let hits = meter.CreateCounter<int64>("hits", "count", instanceId)
let misses = meter.CreateCounter<int64>("misses", "count", instanceId)
let evictions = meter.CreateCounter<int64>("evictions", "count", instanceId)

let evictionFails =
meter.CreateCounter<int64>("eviction-fails", "count", instanceId)

let pool = EntityPool<'Key, 'Value>(totalCapacity, instanceId)
if listen then
metrics.ObserveMetrics()

let store =
ConcurrentDictionary<'Key, CachedEntity<'Key, 'Value>>(Environment.ProcessorCount, totalCapacity)
Expand All @@ -205,6 +162,7 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (totalC
let capacity = totalCapacity - headroom

let evicted = Event<_>()
let evictionFailed = Event<_>()

let cts = new CancellationTokenSource()

Expand All @@ -222,12 +180,14 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (totalC
let first = nonNull evictionQueue.First

match store.TryRemove(first.Value.Key) with
| true, removed ->
| true, _ ->
evictionQueue.Remove(first)
pool.Reclaim(removed)
evictions.Add 1L
metrics.Evictions.Add 1L
evicted.Trigger()
| _ -> evictionFails.Add 1L
| _ ->
// This should not be possible to happen, but if it does, we want to know.
metrics.EvictionFails.Add 1L
evictionFailed.Trigger()

// Store updates are not synchronized. It is possible the entity is no longer in the queue.
| EvictionQueueMessage.Update entity when isNull entity.Node.List -> ()
Expand All @@ -245,30 +205,27 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (totalC
)

member val Evicted = evicted.Publish

member val Name = instanceId
member val EvictionFailed = evictionFailed.Publish

member _.TryGetValue(key: 'Key, value: outref<'Value>) =
match store.TryGetValue(key) with
| true, entity ->
hits.Add 1L
metrics.Hits.Add 1L
evictionProcessor.Post(EvictionQueueMessage.Update entity)
value <- entity.Value
true
| _ ->
misses.Add 1L
metrics.Misses.Add 1L
value <- Unchecked.defaultof<'Value>
false

member _.TryAdd(key: 'Key, value: 'Value) =
let entity = pool.Acquire(key, value)
let entity = CachedEntity.Create(key, value)

let added = store.TryAdd(key, entity)

if added then
evictionProcessor.Post(EvictionQueueMessage.Add entity)
else
pool.Reclaim(entity)

added

Expand All @@ -278,14 +235,10 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (totalC
cts.Dispose()
evictionProcessor.Dispose()
store.Clear()

if observeMetrics then
CacheMetrics.RemoveInstrumentation instanceId
metrics.Dispose()

member this.Dispose() = (this :> IDisposable).Dispose()

member this.GetStats() = CacheMetrics.GetStats(this.Name)

static member Create<'Key, 'Value>(options: CacheOptions, ?name, ?observeMetrics) =
if options.TotalCapacity < 0 then
invalidArg "Capacity" "Capacity must be positive"
Expand All @@ -298,7 +251,9 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (totalC
let headroom =
int (float options.TotalCapacity * float options.HeadroomPercentage / 100.0)

let cache =
new Cache<_, _>(totalCapacity, headroom, ?name = name, ?observeMetrics = observeMetrics)
let name = defaultArg name (Guid.NewGuid().ToString())
let observeMetrics = defaultArg observeMetrics false

let cache = new Cache<_, _>(totalCapacity, headroom, name, observeMetrics)

cache
Loading
Loading