Eviction processor no longer keeps cache instance alive

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))

src/Compiler/Utilities/Caches.fs

@@ -20,7 +20,6 @@ module CacheMetrics =
     let allCounters = [ adds; updates; hits; misses; evictions; evictionFails ]
 
     let creations = Meter.CreateCounter<int64>("creations", "count")
-    let disposals = Meter.CreateCounter<int64>("disposals", "count")
 
     let mkTags (name: string) =
         // Avoid TagList(ReadOnlySpan<...>) to support net472 runtime
@@ -37,7 +36,6 @@ module CacheMetrics =
     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 ]
@@ -203,10 +201,30 @@ type CachedEntity<'Key, 'Value> =
     override this.ToString() = $"{this.Key}"
 
 [<Struct>]
-type EvictionQueueMessage<'Entity, 'Target> =
-    | Add of 'Entity * 'Target
+type EvictionQueueMessage<'Entity, 'Store> =
+    | Add of 'Entity * 'Store
     | Update of 'Entity
 
+module EvictionProcessor =
+    // Shared work queue for all caches running in EvictionMode.MailboxProcessor.
+    let private agent =
+        MailboxProcessor.Start(
+            (fun inbox ->
+                let rec loop () =
+                    async {
+                        let! work = inbox.Receive()
+                        work ()
+                        return! loop ()
+                    }
+
+                loop ()),
+            cancellationToken = CancellationToken.None
+        )
+
+    let Error = agent.Error
+
+    let post = agent.Post
+
 [<Sealed; NoComparison; NoEquality>]
 [<DebuggerDisplay("{DebugDisplay()}")>]
 type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Key>, ?name) =
@@ -228,7 +246,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<CachedEntity<'Key, 'Value>>()
 
@@ -237,16 +255,13 @@ 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.
     // 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
@@ -286,38 +301,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,19 +378,6 @@ 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)
-
-    // 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
     // (CacheMetrics.ListenToAll, e.g. under --times or the editor's metrics view) is running.

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
 
 [<Struct; RequireQualifiedAccess; NoComparison; NoEquality>]
@@ -53,6 +53,9 @@ module internal CacheOptions =
     /// Set eviction mode to NoEviction.
     val withNoEviction: CacheOptions<'Key> -> CacheOptions<'Key>
 
+module internal EvictionProcessor =
+    val Error: IEvent<exn>
+
 [<Sealed; NoComparison; NoEquality>]
 type internal Cache<'Key, 'Value when 'Key: not null> =
     new: options: CacheOptions<'Key> * ?name: string -> Cache<'Key, 'Value>
@@ -61,8 +64,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<unit>
     /// For testing only.

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,28 +14,48 @@ let shouldNeverTimeout = 15_000
 let shouldNeverTimeout = 200_000
 #endif
 
-let defaultStructural() = CacheOptions.getDefault HashIdentity.Structural
+let private defaultStructural() = CacheOptions.getDefault HashIdentity.Structural
+
+[<System.Runtime.CompilerServices.MethodImpl(System.Runtime.CompilerServices.MethodImplOptions.NoInlining)>]
+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<string, obj>(options, name = "Idle cache collection")
+    let payload = obj()
+    let evicted = TaskCompletionSource<unit>()
+    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) |}
+
+[<Theory>]
+[<InlineData(false)>]
+[<InlineData(true)>]
+let ``Idle cache and contents are collected without explicit disposal`` useMailbox =
+    let references = createIdleCache useMailbox
+    GC.Collect()
+    let collected =
+        System.Threading.SpinWait.SpinUntil(
+            (fun () -> not references.Cache.IsAlive && not references.Payload.IsAlive),
+            shouldNeverTimeout)
+    collected |> shouldBeTrue
 
 // 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
 // assembly, so nothing else increments those names. A second concurrently-active listener would
 // double-count every measurement, so keep it that way.
 
-[<Fact>]
-let ``Create and dispose many`` () =
-    let caches =
-        [ for _  in 1 .. 100 do
-            new Cache<string, int>(defaultStructural(), name = "Create and dispose many") :> IDisposable ]
-
-    for c in caches do
-        c.Dispose()
 
 [<Fact>]
 let ``Basic add and retrieve`` () =
     let name = "Basic_add_and_retrieve"
     use _ = CacheMetrics.ListenToAll()
-    use cache = new Cache<string, int>(defaultStructural(), name = name)
+    let cache = new Cache<string, int>(defaultStructural(), name = name)
 
     cache.TryAdd("key1", 1) |> shouldBeTrue
     cache.TryAdd("key2", 2) |> shouldBeTrue
@@ -58,7 +78,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<string, int>({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name)
+    let cache = new Cache<string, int>({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name)
 
     cache.TryAdd("key1", 1) |> shouldBeTrue
     cache.TryAdd("key2", 2) |> shouldBeTrue
@@ -92,7 +112,7 @@ let ``Stress test evictions`` () =
     let name = "Stress test evictions"
 
     use _ = CacheMetrics.ListenToAll()
-    use cache = new Cache<string, int>({ defaultStructural() with TotalCapacity = cacheSize; HeadroomPercentage = 0 }, name = name)
+    let cache = new Cache<string, int>({ defaultStructural() with TotalCapacity = cacheSize; HeadroomPercentage = 0 }, name = name)
 
     let evictionsCompleted = new TaskCompletionSource<unit>()
     let expectedEvictions = iterations - cacheSize
@@ -127,7 +147,7 @@ let ``Stress test evictions`` () =
 let ``Metrics can be retrieved`` () =
     let name = "test_metrics"
     use _ = CacheMetrics.ListenToAll()
-    use cache = new Cache<string, int>({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name)
+    let cache = new Cache<string, int>({ defaultStructural() with TotalCapacity = 2; HeadroomPercentage = 0 }, name = name)
 
     cache.TryAdd("key1", 1) |> shouldBeTrue
     cache.TryAdd("key2", 2) |> shouldBeTrue
@@ -152,7 +172,7 @@ let ``Metrics can be retrieved`` () =
 let ``GetOrAdd basic usage`` () =
     let cacheName = "GetOrAdd_basic_usage"
     use _ = CacheMetrics.ListenToAll()
-    use cache = new Cache<string, int>(defaultStructural(), name = cacheName)
+    let cache = new Cache<string, int>(defaultStructural(), name = cacheName)
     let mutable factoryCalls = 0
     let factory k = factoryCalls <- factoryCalls + 1; String.length k
     let v1 = cache.GetOrAdd("abc", factory)
@@ -174,7 +194,7 @@ let ``GetOrAdd basic usage`` () =
 let ``AddOrUpdate basic usage`` () =
     let cacheName = "AddOrUpdate_basic_usage"
     use _ = CacheMetrics.ListenToAll()
-    use cache = new Cache<string, int>(defaultStructural(), name = cacheName)
+    let cache = new Cache<string, int>(defaultStructural(), name = cacheName)
     cache.AddOrUpdate("x", 1)
     let mutable value = 0
     cache.TryGetValue("x", &value) |> shouldBeTrue
@@ -199,7 +219,7 @@ type BoxedKey = BoxedKey of int * int
 let ``GetOrAdd with reference identity`` () =
     let cacheName = "GetOrAdd_with_Reference"
     use _ = CacheMetrics.ListenToAll()
-    use cache = new Cache<BoxedKey, int>(CacheOptions.getReferenceIdentity(), cacheName)
+    let cache = new Cache<BoxedKey, int>(CacheOptions.getReferenceIdentity(), cacheName)
     let t1 = BoxedKey (1, 2)
     let t2 = BoxedKey (1, 2)
     let t3 = BoxedKey (1, 2)
@@ -236,7 +256,7 @@ let ``GetOrAdd with reference identity`` () =
 let ``AddOrUpdate with reference identity`` () =
     let cacheName = "AddOrUpdate_with_Reference"
     use _ = CacheMetrics.ListenToAll()
-    use cache = new Cache<obj, int>(CacheOptions.getReferenceIdentity(), name = cacheName)
+    let cache = new Cache<obj, int>(CacheOptions.getReferenceIdentity(), name = cacheName)
     let t1 = box (3, 4)
     let t2 = box (3, 4)
     cache.AddOrUpdate(t1, 7)

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

@@ -54,6 +54,15 @@ type internal FSharpWorkspaceServiceFactory
     [<Composition.ImportingConstructor>]
     (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 =