From 327bdd9d5fca5c2ba72e1892f08628c6b6d6786c Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 10 Oct 2026 22:53:21 +0200 Subject: [PATCH 01/10] eviction processor no longer keeps cache instance alive --- src/Compiler/Utilities/Caches.fs | 72 ++++++++----------- src/Compiler/Utilities/Caches.fsi | 2 +- .../CompilerService/Caches.fs | 63 +++++++++++++++- 3 files changed, 92 insertions(+), 45 deletions(-) diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs index d8c143cebc6..013a25fd5c1 100644 --- a/src/Compiler/Utilities/Caches.fs +++ b/src/Compiler/Utilities/Caches.fs @@ -5,6 +5,7 @@ open System open System.Collections.Generic open System.Collections.Concurrent open System.Threading +open System.Threading.Tasks open System.Diagnostics open System.Diagnostics.Metrics @@ -202,11 +203,30 @@ type CachedEntity<'Key, 'Value> = override this.ToString() = $"{this.Key}" -[] -type EvictionQueueMessage<'Entity, 'Target> = +type EvictionQueueMessageHandler<'Entity, 'Target> = + abstract member Handle: 'Entity * 'Target -> unit + +and [] EvictionQueueMessage<'Entity, 'Target> = | Add of 'Entity * 'Target | Update of 'Entity +module private EvictionProcessor = + + let private processor = + MailboxProcessor.Start( + (fun inbox -> + let rec processNext () = + async { + let! work = inbox.Receive() + work () + return! processNext () + } + + processNext ())) + + + let post work = processor.Post work + [] [] type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Key>, ?name) = @@ -237,9 +257,6 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke let tags = CacheMetrics.mkTags name - // Track disposal state (0 = not disposed, 1 = disposed) - let mutable disposed = 0 - let mutable deadKeysCount = 0 // Keys with unreliable identity can prevent eviction, taking up space in the cache. @@ -286,38 +303,17 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke // Store updates are not synchronized with evictionQueue. It is possible the entity is no longer in the queue or already added. | _ -> () - let startEvictionProcessor ct = - MailboxProcessor.Start( - (fun mb -> - let rec processNext () = - async { - let! message = mb.Receive() - processEvictionMessage message - return! processNext () - } - - processNext ()), - ct - ) - let immediate msg = lock evictionQueue <| fun () -> processEvictionMessage msg - let post, disposeEvictionProcessor = - match options.EvictionMode with - | EvictionMode.NoEviction -> ignore, ignore - | EvictionMode.Immediate -> immediate, ignore - | EvictionMode.MailboxProcessor -> - let cts = new CancellationTokenSource() - let evictionProcessor = startEvictionProcessor cts.Token - let post = evictionProcessor.Post - - let dispose () = - cts.Cancel() - cts.Dispose() - evictionProcessor.Dispose() + let queued msg = + EvictionProcessor.post <| fun () -> processEvictionMessage msg - post, dispose + let post = + match options.EvictionMode with + | EvictionMode.NoEviction -> ignore + | EvictionMode.Immediate -> immediate + | EvictionMode.MailboxProcessor -> queued do CacheMetrics.Created &tags @@ -384,18 +380,10 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke CacheMetrics.Update &tags post (EvictionQueueMessage.Update result) - member _.Dispose() = - if Interlocked.Exchange(&disposed, 1) = 0 then - disposeEvictionProcessor () - CacheMetrics.Disposed &tags - interface IDisposable with member this.Dispose() = - this.Dispose() - GC.SuppressFinalize(this) + CacheMetrics.Disposed &tags - // Finalizer to ensure eviction loop is cancelled if Dispose wasn't called. - override this.Finalize() = this.Dispose() #if DEBUG // Shows the totals aggregated for this cache's name. Populated only while a metrics listener diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi index e0bff618fcb..3996957f5f8 100644 --- a/src/Compiler/Utilities/Caches.fsi +++ b/src/Compiler/Utilities/Caches.fsi @@ -26,7 +26,7 @@ type internal EvictionMode = | NoEviction /// Evict items immediately on the caller's thread when adding a new item that would exceed capacity. | Immediate - /// Evict items in the background using a MailboxProcessor to queue eviction requests. This may lag behind during heavy load but avoids blocking callers. + /// Evict items in the background using a shared MailboxProcessor to queue eviction requests. This may lag behind during heavy load but avoids blocking callers. | MailboxProcessor [] diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs index 5adf5572320..99e345c5899 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs @@ -1,4 +1,4 @@ -module internal CompilerService.Caches +module CompilerService.Caches open FSharp.Compiler.Caches open Xunit @@ -14,7 +14,66 @@ let shouldNeverTimeout = 15_000 let shouldNeverTimeout = 200_000 #endif -let defaultStructural() = CacheOptions.getDefault HashIdentity.Structural +let private defaultStructural() = CacheOptions.getDefault HashIdentity.Structural + +[] +let private createIdleCache useMailbox = + let options = + { defaultStructural() with + TotalCapacity = 1 + HeadroomPercentage = 0 + EvictionMode = if useMailbox then EvictionMode.MailboxProcessor else EvictionMode.Immediate } + let cache = new Cache(options, name = "Idle cache collection") + let payload = obj() + let evicted = TaskCompletionSource() + cache.Evicted.Add evicted.SetResult + cache.TryAdd("first", obj()) |> shouldBeTrue + cache.TryAdd("last", payload) |> shouldBeTrue + evicted.Task.Wait shouldNeverTimeout |> shouldBeTrue + struct {| Cache = WeakReference(cache); Payload = WeakReference(payload) |} + +[] +[] +[] +let ``Idle cache and contents are collected without explicit disposal`` useMailbox = + let references = createIdleCache useMailbox + let collected = + System.Threading.SpinWait.SpinUntil( + (fun () -> + GC.Collect() + GC.WaitForPendingFinalizers() + GC.Collect() + not references.Cache.IsAlive && not references.Payload.IsAlive), + shouldNeverTimeout) + collected |> shouldBeTrue + +[] +[] +[] +let ``Disposing or faulting one cache does not stop eviction for another`` faultFirst = + let options = + { defaultStructural() with + TotalCapacity = 1 + HeadroomPercentage = 0 + EvictionMode = EvictionMode.MailboxProcessor } + use first = new Cache(options, name = "First cache isolation") + if faultFirst then + first.Evicted.Add(fun () -> raise (InvalidOperationException("Eviction subscriber failed"))) + else + (first :> IDisposable).Dispose() + first.TryAdd("first", obj()) |> shouldBeTrue + first.TryAdd("last", obj()) |> shouldBeTrue + + use second = new Cache(options, name = "Second cache isolation") + let evicted = TaskCompletionSource() + second.Evicted.Add evicted.SetResult + second.TryAdd("first", 1) |> shouldBeTrue + second.TryAdd("last", 2) |> shouldBeTrue + evicted.Task.Wait shouldNeverTimeout |> shouldBeTrue + let mutable value = 0 + second.TryGetValue("first", &value) |> shouldBeFalse + second.TryGetValue("last", &value) |> shouldBeTrue + value |> shouldEqual 2 // Metrics assertions below read absolute per-name totals via CacheMetrics.getTotalsByName. Those totals // are aggregated process-globally while a CacheMetrics.ListenToAll() listener is running. This works From 97c1893a279da9da6cb45010833b3611e368f88e Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 10 Oct 2026 23:11:55 +0200 Subject: [PATCH 02/10] get rid of dispose and finalize --- src/Compiler/Utilities/Caches.fs | 15 ++----- src/Compiler/Utilities/Caches.fsi | 2 - .../CompilerService/Caches.fs | 40 +++++++------------ 3 files changed, 17 insertions(+), 40 deletions(-) diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs index 013a25fd5c1..d5bb89d35d0 100644 --- a/src/Compiler/Utilities/Caches.fs +++ b/src/Compiler/Utilities/Caches.fs @@ -5,7 +5,6 @@ open System open System.Collections.Generic open System.Collections.Concurrent open System.Threading -open System.Threading.Tasks open System.Diagnostics open System.Diagnostics.Metrics @@ -21,7 +20,6 @@ module CacheMetrics = let allCounters = [ adds; updates; hits; misses; evictions; evictionFails ] let creations = Meter.CreateCounter("creations", "count") - let disposals = Meter.CreateCounter("disposals", "count") let mkTags (name: string) = // Avoid TagList(ReadOnlySpan<...>) to support net472 runtime @@ -38,7 +36,6 @@ module CacheMetrics = 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) type Stats() = let totals = Map [ for counter in allCounters -> counter.Name, ref 0L ] @@ -203,10 +200,8 @@ type CachedEntity<'Key, 'Value> = override this.ToString() = $"{this.Key}" -type EvictionQueueMessageHandler<'Entity, 'Target> = - abstract member Handle: 'Entity * 'Target -> unit - -and [] EvictionQueueMessage<'Entity, 'Target> = +[] +type EvictionQueueMessage<'Entity, 'Target> = | Add of 'Entity * 'Target | Update of 'Entity @@ -218,7 +213,7 @@ module private EvictionProcessor = let rec processNext () = async { let! work = inbox.Receive() - work () + try work () with _ -> () // Think where to report a failure. return! processNext () } @@ -380,10 +375,6 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke CacheMetrics.Update &tags post (EvictionQueueMessage.Update result) - interface IDisposable with - member this.Dispose() = - CacheMetrics.Disposed &tags - #if DEBUG // Shows the totals aggregated for this cache's name. Populated only while a metrics listener diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi index 3996957f5f8..e3056d5236c 100644 --- a/src/Compiler/Utilities/Caches.fsi +++ b/src/Compiler/Utilities/Caches.fsi @@ -61,8 +61,6 @@ type internal Cache<'Key, 'Value when 'Key: not null> = member GetOrAdd: key: 'Key * valueFactory: ('Key -> 'Value) -> 'Value member AddOrUpdate: key: 'Key * value: 'Value -> unit - interface IDisposable - /// For testing only. member Evicted: IEvent /// For testing only. diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs index 99e345c5899..0012dcfc4bb 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs @@ -47,24 +47,20 @@ let ``Idle cache and contents are collected without explicit disposal`` useMailb shouldNeverTimeout) collected |> shouldBeTrue -[] -[] -[] -let ``Disposing or faulting one cache does not stop eviction for another`` faultFirst = +[] +let ``Faulting one cache does not stop eviction for another`` () = let options = { defaultStructural() with TotalCapacity = 1 HeadroomPercentage = 0 EvictionMode = EvictionMode.MailboxProcessor } - use first = new Cache(options, name = "First cache isolation") - if faultFirst then - first.Evicted.Add(fun () -> raise (InvalidOperationException("Eviction subscriber failed"))) - else - (first :> IDisposable).Dispose() + let first = new Cache(options, name = "First cache isolation") + first.Evicted.Add(fun () -> raise (InvalidOperationException("Eviction subscriber failed"))) + first.TryAdd("first", obj()) |> shouldBeTrue first.TryAdd("last", obj()) |> shouldBeTrue - use second = new Cache(options, name = "Second cache isolation") + let second = new Cache(options, name = "Second cache isolation") let evicted = TaskCompletionSource() second.Evicted.Add evicted.SetResult second.TryAdd("first", 1) |> shouldBeTrue @@ -81,20 +77,12 @@ let ``Disposing or faulting one cache does not stop eviction for another`` fault // assembly, so nothing else increments those names. A second concurrently-active listener would // double-count every measurement, so keep it that way. -[] -let ``Create and dispose many`` () = - let caches = - [ for _ in 1 .. 100 do - new Cache(defaultStructural(), name = "Create and dispose many") :> IDisposable ] - - for c in caches do - c.Dispose() [] let ``Basic add and retrieve`` () = let name = "Basic_add_and_retrieve" use _ = CacheMetrics.ListenToAll() - use cache = new Cache(defaultStructural(), name = name) + let cache = new Cache(defaultStructural(), name = name) cache.TryAdd("key1", 1) |> shouldBeTrue cache.TryAdd("key2", 2) |> shouldBeTrue @@ -117,7 +105,7 @@ let ``Basic add and retrieve`` () = let ``Eviction of least recently used`` () = let name = "Eviction_of_least_recently_used" use _ = CacheMetrics.ListenToAll() - use cache = new Cache({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name) + let cache = new Cache({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name) cache.TryAdd("key1", 1) |> shouldBeTrue cache.TryAdd("key2", 2) |> shouldBeTrue @@ -151,7 +139,7 @@ let ``Stress test evictions`` () = let name = "Stress test evictions" use _ = CacheMetrics.ListenToAll() - use cache = new Cache({ defaultStructural() with TotalCapacity = cacheSize; HeadroomPercentage = 0 }, name = name) + let cache = new Cache({ defaultStructural() with TotalCapacity = cacheSize; HeadroomPercentage = 0 }, name = name) let evictionsCompleted = new TaskCompletionSource() let expectedEvictions = iterations - cacheSize @@ -186,7 +174,7 @@ let ``Stress test evictions`` () = let ``Metrics can be retrieved`` () = let name = "test_metrics" use _ = CacheMetrics.ListenToAll() - use cache = new Cache({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name) + let cache = new Cache({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name) cache.TryAdd("key1", 1) |> shouldBeTrue cache.TryAdd("key2", 2) |> shouldBeTrue @@ -211,7 +199,7 @@ let ``Metrics can be retrieved`` () = let ``GetOrAdd basic usage`` () = let cacheName = "GetOrAdd_basic_usage" use _ = CacheMetrics.ListenToAll() - use cache = new Cache(defaultStructural(), name = cacheName) + let cache = new Cache(defaultStructural(), name = cacheName) let mutable factoryCalls = 0 let factory k = factoryCalls <- factoryCalls + 1; String.length k let v1 = cache.GetOrAdd("abc", factory) @@ -233,7 +221,7 @@ let ``GetOrAdd basic usage`` () = let ``AddOrUpdate basic usage`` () = let cacheName = "AddOrUpdate_basic_usage" use _ = CacheMetrics.ListenToAll() - use cache = new Cache(defaultStructural(), name = cacheName) + let cache = new Cache(defaultStructural(), name = cacheName) cache.AddOrUpdate("x", 1) let mutable value = 0 cache.TryGetValue("x", &value) |> shouldBeTrue @@ -258,7 +246,7 @@ type BoxedKey = BoxedKey of int * int let ``GetOrAdd with reference identity`` () = let cacheName = "GetOrAdd_with_Reference" use _ = CacheMetrics.ListenToAll() - use cache = new Cache(CacheOptions.getReferenceIdentity(), cacheName) + let cache = new Cache(CacheOptions.getReferenceIdentity(), cacheName) let t1 = BoxedKey (1, 2) let t2 = BoxedKey (1, 2) let t3 = BoxedKey (1, 2) @@ -295,7 +283,7 @@ let ``GetOrAdd with reference identity`` () = let ``AddOrUpdate with reference identity`` () = let cacheName = "AddOrUpdate_with_Reference" use _ = CacheMetrics.ListenToAll() - use cache = new Cache(CacheOptions.getReferenceIdentity(), name = cacheName) + let cache = new Cache(CacheOptions.getReferenceIdentity(), name = cacheName) let t1 = box (3, 4) let t2 = box (3, 4) cache.AddOrUpdate(t1, 7) From 33864f1ea27b238f3609f5e52dcc9887e04467c0 Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 11 Oct 2026 00:22:07 +0200 Subject: [PATCH 03/10] per type singleton --- src/Compiler/Utilities/Caches.fs | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs index d5bb89d35d0..aa1f79b713b 100644 --- a/src/Compiler/Utilities/Caches.fs +++ b/src/Compiler/Utilities/Caches.fs @@ -201,26 +201,23 @@ type CachedEntity<'Key, 'Value> = override this.ToString() = $"{this.Key}" [] -type EvictionQueueMessage<'Entity, 'Target> = - | Add of 'Entity * 'Target - | Update of 'Entity +type EvictionQueueMessage<'Key, 'Value when 'Key: not null> = + | Add of CachedEntity<'Key, 'Value> * ConcurrentDictionary<'Key, CachedEntity<'Key, 'Value>> + | Update of CachedEntity<'Key, 'Value> -module private EvictionProcessor = - - let private processor = +type EvictionProcessor<'Key, 'Value when 'Key: not null> = + static let instance = MailboxProcessor.Start( (fun inbox -> let rec processNext () = async { - let! work = inbox.Receive() - try work () with _ -> () // Think where to report a failure. + let! struct(handle, message: EvictionQueueMessage<'Key, 'Value>) = inbox.Receive() + try handle message with _ -> () // Think where to report a failure. return! processNext () } processNext ())) - - - let post work = processor.Post work + static member Instance = instance [] [] @@ -267,7 +264,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke let processEvictionMessage msg = match msg with - | EvictionQueueMessage.Add(entity: CachedEntity<_, _>, target) when isNull entity.Node.List -> + | EvictionQueueMessage.Add(entity, target) when isNull entity.Node.List -> evictionQueue.AddLast(entity.Node) // store has been rebuilt while this message was in the queue. if store <> target then @@ -302,7 +299,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke lock evictionQueue <| fun () -> processEvictionMessage msg let queued msg = - EvictionProcessor.post <| fun () -> processEvictionMessage msg + EvictionProcessor<'Key, 'Value>.Instance.Post(struct(processEvictionMessage, msg)) let post = match options.EvictionMode with From 7756b94e04f12a667550d0b1b22c96de8b1ec1c7 Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 11 Oct 2026 09:16:58 +0200 Subject: [PATCH 04/10] format, simplify type annotations --- src/Compiler/Utilities/Caches.fs | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs index aa1f79b713b..ac67ab87716 100644 --- a/src/Compiler/Utilities/Caches.fs +++ b/src/Compiler/Utilities/Caches.fs @@ -201,22 +201,29 @@ type CachedEntity<'Key, 'Value> = override this.ToString() = $"{this.Key}" [] -type EvictionQueueMessage<'Key, 'Value when 'Key: not null> = - | Add of CachedEntity<'Key, 'Value> * ConcurrentDictionary<'Key, CachedEntity<'Key, 'Value>> - | Update of CachedEntity<'Key, 'Value> +type EvictionQueueMessage<'Entity, 'Store> = + | Add of 'Entity * 'Store + | Update of 'Entity -type EvictionProcessor<'Key, 'Value when 'Key: not null> = +type EvictionProcessor<'Message> = static let instance = MailboxProcessor.Start( (fun inbox -> let rec processNext () = async { - let! struct(handle, message: EvictionQueueMessage<'Key, 'Value>) = inbox.Receive() - try handle message with _ -> () // Think where to report a failure. + let! struct (handle, message: 'Message) = inbox.Receive() + + try + handle message + with _ -> + () // Think where to report a failure. + return! processNext () } - processNext ())) + processNext ()) + ) + static member Instance = instance [] @@ -240,7 +247,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke let capacity = options.TotalCapacity - headroom let mutable store = - ConcurrentDictionary<'Key, CachedEntity<'Key, 'Value>>(Environment.ProcessorCount, capacity, options.Comparer) + ConcurrentDictionary(Environment.ProcessorCount, capacity, options.Comparer) let evictionQueue = LinkedList>() @@ -255,7 +262,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke // In such case we rebuild the store to remove dead keys. let rebuildStore () = let newStore = - ConcurrentDictionary<'Key, CachedEntity<'Key, 'Value>>(Environment.ProcessorCount, capacity, options.Comparer) + ConcurrentDictionary(Environment.ProcessorCount, capacity, options.Comparer) for entity in evictionQueue do newStore.TryAdd(entity.Key, entity) |> ignore @@ -264,7 +271,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke let processEvictionMessage msg = match msg with - | EvictionQueueMessage.Add(entity, target) when isNull entity.Node.List -> + | EvictionQueueMessage.Add(entity: CachedEntity<_, _>, target) when isNull entity.Node.List -> evictionQueue.AddLast(entity.Node) // store has been rebuilt while this message was in the queue. if store <> target then @@ -299,7 +306,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke lock evictionQueue <| fun () -> processEvictionMessage msg let queued msg = - EvictionProcessor<'Key, 'Value>.Instance.Post(struct(processEvictionMessage, msg)) + EvictionProcessor<_>.Instance.Post(struct (processEvictionMessage, msg)) let post = match options.EvictionMode with @@ -372,7 +379,6 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke CacheMetrics.Update &tags post (EvictionQueueMessage.Update result) - #if DEBUG // Shows the totals aggregated for this cache's name. Populated only while a metrics listener // (CacheMetrics.ListenToAll, e.g. under --times or the editor's metrics view) is running. From c524b9958980b7d80712fcb019360273649bdc70 Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 11 Oct 2026 10:01:28 +0200 Subject: [PATCH 05/10] revert to work item --- src/Compiler/Utilities/Caches.fs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs index ac67ab87716..e18485ff22a 100644 --- a/src/Compiler/Utilities/Caches.fs +++ b/src/Compiler/Utilities/Caches.fs @@ -205,16 +205,17 @@ type EvictionQueueMessage<'Entity, 'Store> = | Add of 'Entity * 'Store | Update of 'Entity -type EvictionProcessor<'Message> = - static let instance = +module EvictionProcessor = + // Shared work queue for all caches running in EvictionMode.MailboxProcessor. + let private agent = MailboxProcessor.Start( (fun inbox -> let rec processNext () = async { - let! struct (handle, message: 'Message) = inbox.Receive() + let! work = inbox.Receive() try - handle message + work () with _ -> () // Think where to report a failure. @@ -224,7 +225,7 @@ type EvictionProcessor<'Message> = processNext ()) ) - static member Instance = instance + let post = agent.Post [] [] @@ -306,7 +307,7 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke lock evictionQueue <| fun () -> processEvictionMessage msg let queued msg = - EvictionProcessor<_>.Instance.Post(struct (processEvictionMessage, msg)) + EvictionProcessor.post <| fun () -> processEvictionMessage msg let post = match options.EvictionMode with From 1e8b94c940d80c535824248777776e443ad8d815 Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 11 Oct 2026 10:39:57 +0200 Subject: [PATCH 06/10] one GC collect should be enough --- .../CompilerService/Caches.fs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs index 0012dcfc4bb..108617d2006 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs @@ -37,13 +37,10 @@ let private createIdleCache useMailbox = [] let ``Idle cache and contents are collected without explicit disposal`` useMailbox = let references = createIdleCache useMailbox + GC.Collect() let collected = System.Threading.SpinWait.SpinUntil( - (fun () -> - GC.Collect() - GC.WaitForPendingFinalizers() - GC.Collect() - not references.Cache.IsAlive && not references.Payload.IsAlive), + (fun () -> not references.Cache.IsAlive && not references.Payload.IsAlive), shouldNeverTimeout) collected |> shouldBeTrue From 336b5d0ac6789614d273ef298050d33511f28b3e Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 11 Oct 2026 10:45:54 +0200 Subject: [PATCH 07/10] add release notes --- docs/release-notes/.FSharp.Compiler.Service/11.0.100.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index f383908e195..d8bf8f9195f 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -12,6 +12,7 @@ * Fix recursive inline SRTP resolution being truncated by one currying level (e.g. FSharpPlus `memoizeN`), a regression from the function-domain unification order change in [PR #15181](https://github.com/dotnet/fsharp/pull/15181); the contravariant domain now keeps the inference variable that still carries the pending member constraint. ([PR #20247](https://github.com/dotnet/fsharp/pull/20247)) * Fix exponential (2^N) compile time in pattern matching with shared guards and partial active patterns. ([Issue #18425](https://github.com/dotnet/fsharp/issues/18425), [PR #20244](https://github.com/dotnet/fsharp/pull/20244)) * Fix incorrect Debug lowering of inline builders that compose low-level resumable state machines. ([Issue #20466](https://github.com/dotnet/fsharp/issues/20466), [PR #20469](https://github.com/dotnet/fsharp/pull/20469)) +* Prevent idle caches and their contents from being retained indefinitely, allowing them to be garbage-collected without explicit disposal. ([Issue #20756](https://github.com/dotnet/fsharp/issues/20756), [PR #20758](https://github.com/dotnet/fsharp/pull/20758)) * Fix incorrect `StructLayout(Size = 1)` emission for data-less struct unions where the compiler-generated tag field makes the actual runtime size larger. ([PR #19759](https://github.com/dotnet/fsharp/pull/19759)) * Embed F# metadata-removal rules before resource collection, preserve custom rules, and combine generated rules when linking assemblies. ([PR #20527](https://github.com/dotnet/fsharp/pull/20527)) * Fix FS0750 "This construct may only be used within computation expressions" incorrectly raised for `let!`/`use!`/`do!` appearing in the right-hand side of a plain `let` binding inside a computation expression. The right-hand side is now desugared as a nested computation of the same builder whose result is bound with `let!`, keeping its bindings correctly scoped. ([Issue #19457](https://github.com/dotnet/fsharp/issues/19457), [PR #19868](https://github.com/dotnet/fsharp/pull/19868)) From 9b32132c1dab1f146be6264317ef6cc54b3d6276 Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 12 Oct 2026 14:54:22 +0200 Subject: [PATCH 08/10] address review --- src/Compiler/Utilities/Caches.fs | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs index e18485ff22a..f9020d76343 100644 --- a/src/Compiler/Utilities/Caches.fs +++ b/src/Compiler/Utilities/Caches.fs @@ -210,19 +210,21 @@ module EvictionProcessor = let private agent = MailboxProcessor.Start( (fun inbox -> - let rec processNext () = + let execute f = + try + f () + with _ -> + () // Think where to report a failure. + + let rec loop () = async { let! work = inbox.Receive() - - try - work () - with _ -> - () // Think where to report a failure. - - return! processNext () + execute work + return! loop () } - processNext ()) + loop ()), + cancellationToken = CancellationToken.None ) let post = agent.Post From 7cb103ea313c19ce285a33045399e48ab4532496 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 12 Oct 2026 22:57:08 +0200 Subject: [PATCH 09/10] if there is unexpected error surface it in VS UI --- src/Compiler/Utilities/Caches.fs | 10 +++------- src/Compiler/Utilities/Caches.fsi | 3 +++ .../FSharp.Editor/LanguageService/LanguageService.fs | 9 +++++++++ 3 files changed, 15 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs index f9020d76343..c0b6b1f7961 100644 --- a/src/Compiler/Utilities/Caches.fs +++ b/src/Compiler/Utilities/Caches.fs @@ -210,16 +210,10 @@ module EvictionProcessor = let private agent = MailboxProcessor.Start( (fun inbox -> - let execute f = - try - f () - with _ -> - () // Think where to report a failure. - let rec loop () = async { let! work = inbox.Receive() - execute work + work () return! loop () } @@ -227,6 +221,8 @@ module EvictionProcessor = cancellationToken = CancellationToken.None ) + let Error = agent.Error + let post = agent.Post [] diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi index e3056d5236c..837b3343bb2 100644 --- a/src/Compiler/Utilities/Caches.fsi +++ b/src/Compiler/Utilities/Caches.fsi @@ -53,6 +53,9 @@ module internal CacheOptions = /// Set eviction mode to NoEviction. val withNoEviction: CacheOptions<'Key> -> CacheOptions<'Key> +module internal EvictionProcessor = + val Error: IEvent + [] type internal Cache<'Key, 'Value when 'Key: not null> = new: options: CacheOptions<'Key> * ?name: string -> Cache<'Key, 'Value> diff --git a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs index ac8ceffd4f9..20a5148f1e3 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs @@ -54,6 +54,15 @@ type internal FSharpWorkspaceServiceFactory [] (editorOptions: EditorOptions, metadataAsSourceService: FSharpMetadataAsSourceService) = + static do + FSharp.Compiler.Caches.EvictionProcessor.Error.Add(fun ex -> + ThreadHelper.JoinableTaskFactory.RunAsync(fun () -> + task { + do! ThreadHelper.JoinableTaskFactory.SwitchToMainThreadAsync() + System.Runtime.ExceptionServices.ExceptionDispatchInfo.Capture(ex).Throw() + }) + |> ignore) + let tryGetMetadataSnapshot (workspace: VisualStudioWorkspace) (path, timeStamp) = try let md = From d3694fc53ff60eac64589640c600355ef5cebf3b Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Tue, 13 Oct 2026 16:57:21 +0200 Subject: [PATCH 10/10] Remove cache eviction isolation test --- .../CompilerService/Caches.fs | 24 ------------------- 1 file changed, 24 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs index 108617d2006..f83bbd359e5 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/Caches.fs @@ -44,30 +44,6 @@ let ``Idle cache and contents are collected without explicit disposal`` useMailb shouldNeverTimeout) collected |> shouldBeTrue -[] -let ``Faulting one cache does not stop eviction for another`` () = - let options = - { defaultStructural() with - TotalCapacity = 1 - HeadroomPercentage = 0 - EvictionMode = EvictionMode.MailboxProcessor } - let first = new Cache(options, name = "First cache isolation") - first.Evicted.Add(fun () -> raise (InvalidOperationException("Eviction subscriber failed"))) - - first.TryAdd("first", obj()) |> shouldBeTrue - first.TryAdd("last", obj()) |> shouldBeTrue - - let second = new Cache(options, name = "Second cache isolation") - let evicted = TaskCompletionSource() - second.Evicted.Add evicted.SetResult - second.TryAdd("first", 1) |> shouldBeTrue - second.TryAdd("last", 2) |> shouldBeTrue - evicted.Task.Wait shouldNeverTimeout |> shouldBeTrue - let mutable value = 0 - second.TryGetValue("first", &value) |> shouldBeFalse - second.TryGetValue("last", &value) |> shouldBeTrue - value |> shouldEqual 2 - // Metrics assertions below read absolute per-name totals via CacheMetrics.getTotalsByName. Those totals // are aggregated process-globally while a CacheMetrics.ListenToAll() listener is running. This works // because each test uses a unique cache name and this module is the only ListenToAll caller in the