From 5233567dd362d0e95bf03c29549e62dceeb5937b Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Thu, 24 Apr 2025 13:52:03 +0200
Subject: [PATCH 01/28] add cache
---
src/Compiler/FSharp.Compiler.Service.fsproj | 2 +
src/Compiler/Utilities/Caches.fs | 408 ++++++++++++++++++
src/Compiler/Utilities/Caches.fsi | 85 ++++
...y_FSharp.Compiler.Service_Debug_net9.0.bsl | 12 +-
....Compiler.Service_Debug_netstandard2.0.bsl | 12 +-
...FSharp.Compiler.Service_Release_net9.0.bsl | 12 +-
...ompiler.Service_Release_netstandard2.0.bsl | 12 +-
7 files changed, 519 insertions(+), 24 deletions(-)
create mode 100644 src/Compiler/Utilities/Caches.fs
create mode 100644 src/Compiler/Utilities/Caches.fsi
diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj
index 74e59954e8f..9754dd25a11 100644
--- a/src/Compiler/FSharp.Compiler.Service.fsproj
+++ b/src/Compiler/FSharp.Compiler.Service.fsproj
@@ -146,6 +146,8 @@
+
+
diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs
new file mode 100644
index 00000000000..97f2b08d8af
--- /dev/null
+++ b/src/Compiler/Utilities/Caches.fs
@@ -0,0 +1,408 @@
+// LinkedList uses nulls, so we need to disable the nullability warnings for this file.
+namespace FSharp.Compiler
+
+open System
+open System.Collections.Generic
+open System.Collections.Concurrent
+open System.Threading
+open System.Diagnostics
+open System.Diagnostics.Metrics
+
+[]
+type CachingStrategy =
+ | LRU
+ | LFU
+
+[]
+type EvictionMethod =
+ | Blocking
+ | Background
+ | NoEviction
+
+[]
+type CacheOptions =
+ {
+ MaximumCapacity: int
+ PercentageToEvict: int
+ Strategy: CachingStrategy
+ EvictionMethod: EvictionMethod
+ LevelOfConcurrency: int
+ }
+
+ static member Default =
+ {
+ MaximumCapacity = 1024
+ PercentageToEvict = 5
+ Strategy = CachingStrategy.LRU
+ LevelOfConcurrency = Environment.ProcessorCount
+ EvictionMethod = EvictionMethod.Blocking
+ }
+
+[]
+[]
+type CachedEntity<'Key, 'Value> =
+ val mutable Key: 'Key
+ val mutable Value: 'Value
+ val mutable AccessCount: int64
+ val mutable Node: LinkedListNode>
+
+ new(key, value) =
+ {
+ Key = key
+ Value = value
+ AccessCount = 0L
+ Node = Unchecked.defaultof<_>
+ }
+
+ member this.WithNode() =
+ this.Node <- LinkedListNode(this)
+ this
+
+ member this.ReUse(key, value) =
+ this.Key <- key
+ this.Value <- value
+ this.AccessCount <- 0L
+ this
+
+ override this.ToString() = $"{this.Key}"
+
+type EntityPool<'Key, 'Value>(maximumCapacity, overCapacity: Event<_>) =
+ let pool = ConcurrentBag>()
+ let mutable created = 0
+
+ member _.Acquire(key, value) =
+ match pool.TryTake() with
+ | true, entity -> entity.ReUse(key, value)
+ | _ ->
+ if Interlocked.Increment &created > maximumCapacity then
+ overCapacity.Trigger()
+
+ CachedEntity(key, value).WithNode()
+
+ member _.Reclaim(entity: CachedEntity<'Key, 'Value>) =
+ if pool.Count < maximumCapacity then
+ pool.Add(entity)
+
+type IEvictionQueue<'Key, 'Value> =
+ abstract member Add: CachedEntity<'Key, 'Value> * CachingStrategy -> unit
+ abstract member Update: CachedEntity<'Key, 'Value> -> unit
+ abstract member GetKeysToEvict: int -> 'Key[]
+ abstract member Remove: CachedEntity<'Key, 'Value> -> unit
+
+[]
+type EvictionQueue<'Key, 'Value>(strategy: CachingStrategy) =
+
+ let list = LinkedList>()
+
+ interface IEvictionQueue<'Key, 'Value> with
+
+ member _.Add(entity: CachedEntity<'Key, 'Value>, strategy) =
+ lock list
+ <| fun () ->
+ if isNull entity.Node.List then
+ match strategy with
+ | CachingStrategy.LRU -> list.AddLast(entity.Node)
+ | CachingStrategy.LFU -> list.AddLast(entity.Node)
+ // list.AddFirst(entity.Node)
+
+ member _.Update(entity: CachedEntity<'Key, 'Value>) =
+ lock list
+ <| fun () ->
+ Interlocked.Increment(&entity.AccessCount) |> ignore
+
+ let node = entity.Node
+
+ // Sync between store and the eviction queue is not atomic. It might be already evicted or not yet added.
+ if node.List = list then
+
+ match strategy with
+ | CachingStrategy.LRU ->
+ // Just move this node to the end of the list.
+ list.Remove(node)
+ list.AddLast(node)
+ | CachingStrategy.LFU ->
+ // Bubble up the node in the list, linear time.
+ // TODO: frequency list approach would be faster.
+ let rec bubbleUp (current: LinkedListNode>) =
+ match current.Next with
+ | NonNull next when next.Value.AccessCount < entity.AccessCount -> bubbleUp next
+ | _ -> current
+
+ let next = bubbleUp node
+
+ if next <> node then
+ list.Remove(node)
+ list.AddAfter(next, node)
+
+ member _.GetKeysToEvict(count) =
+ lock list
+ <| fun () -> list |> Seq.map _.Key |> Seq.truncate count |> Seq.toArray
+
+ member this.Remove(entity: CachedEntity<_, _>) =
+ lock list <| fun () -> list.Remove(entity.Node)
+
+ member _.Count = list.Count
+
+ static member NoEviction =
+ { new IEvictionQueue<'Key, 'Value> with
+ member _.Add(_, _) = ()
+
+ member _.Update(entity) =
+ Interlocked.Increment(&entity.AccessCount) |> ignore
+
+ member _.GetKeysToEvict(_) = [||]
+ member _.Remove(_) = ()
+ }
+
+type ICacheEvents =
+ []
+ abstract member CacheHit: IEvent
+
+ []
+ abstract member CacheMiss: IEvent
+
+ []
+ abstract member Eviction: IEvent
+
+ []
+ abstract member EvictionFail: IEvent
+
+ []
+ abstract member OverCapacity: IEvent
+
+[]
+[]
+type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (options: CacheOptions, capacity, cts: CancellationTokenSource) =
+
+ let cacheHit = Event()
+ let cacheMiss = Event()
+ let eviction = Event()
+ let evictionFail = Event()
+ let overCapacity = Event()
+
+ let pool = EntityPool<'Key, 'Value>(capacity, overCapacity)
+
+ let store =
+ ConcurrentDictionary<'Key, CachedEntity<'Key, 'Value>>(options.LevelOfConcurrency, capacity)
+
+ let evictionQueue: IEvictionQueue<'Key, 'Value> =
+ match options.EvictionMethod with
+ | EvictionMethod.NoEviction -> EvictionQueue.NoEviction
+ | _ -> EvictionQueue(options.Strategy)
+
+ let tryEvictItems () =
+ let count =
+ if store.Count > options.MaximumCapacity then
+ (store.Count - options.MaximumCapacity)
+ + int (float options.MaximumCapacity * float options.PercentageToEvict / 100.0)
+ else
+ 0
+
+ for key in evictionQueue.GetKeysToEvict(count) do
+ match store.TryRemove(key) with
+ | true, removed ->
+ evictionQueue.Remove(removed)
+ pool.Reclaim(removed)
+ eviction.Trigger()
+ | _ ->
+ failwith "eviction fail"
+ evictionFail.Trigger()
+
+ let rec backgroundEviction () =
+ async {
+ tryEvictItems ()
+
+ let utilization = (float store.Count / float options.MaximumCapacity)
+ // So, based on utilization this will scale the delay between 0 and 1 seconds.
+ // Worst case scenario would be when 1 second delay happens,
+ // if the cache will grow rapidly (or in bursts), it will go beyond the maximum capacity.
+ // In this case underlying dictionary will resize, AND we will have to evict items, which will likely be slow.
+ // In this case, cache stats should be used to adjust MaximumCapacity and PercentageToEvict.
+ let delay = 1000.0 - (1000.0 * utilization)
+
+ if delay > 0.0 then
+ do! Async.Sleep(int delay)
+
+ return! backgroundEviction ()
+ }
+
+ do
+ if options.EvictionMethod = EvictionMethod.Background then
+ Async.Start(backgroundEviction (), cancellationToken = cts.Token)
+
+ member _.TryGetValue(key: 'Key, value: outref<'Value>) =
+ match store.TryGetValue(key) with
+ | true, cachedEntity ->
+ cacheHit.Trigger()
+ evictionQueue.Update(cachedEntity)
+ value <- cachedEntity.Value
+ true
+ | _ ->
+ cacheMiss.Trigger()
+ value <- Unchecked.defaultof<'Value>
+ false
+
+ member _.TryAdd(key: 'Key, value: 'Value) =
+ if options.EvictionMethod.IsBlocking then
+ tryEvictItems ()
+
+ let cachedEntity = pool.Acquire(key, value)
+
+ if store.TryAdd(key, cachedEntity) then
+ evictionQueue.Add(cachedEntity, options.Strategy)
+ true
+ else
+ pool.Reclaim(cachedEntity)
+ false
+
+ member _.AddOrUpdate(key: 'Key, value: 'Value) =
+ if options.EvictionMethod.IsBlocking then
+ tryEvictItems ()
+
+ let aquired = pool.Acquire(key, value)
+
+ let entity =
+ store.AddOrUpdate(
+ key,
+ (fun _ -> aquired),
+ (fun _ (current: CachedEntity<_, _>) ->
+ pool.Reclaim aquired
+ current.Value <- value
+ evictionQueue.Remove(current)
+ current)
+ )
+
+ evictionQueue.Add(entity, options.Strategy)
+
+ interface ICacheEvents with
+
+ []
+ member val CacheHit = cacheHit.Publish
+
+ []
+ member val CacheMiss = cacheMiss.Publish
+
+ []
+ member val Eviction = eviction.Publish
+
+ []
+ member val EvictionFail = evictionFail.Publish
+
+ []
+ member val OverCapacity = overCapacity.Publish
+
+ interface IDisposable with
+ member this.Dispose() =
+ cts.Cancel()
+ CacheInstrumentation.RemoveInstrumentation(this)
+ GC.SuppressFinalize(this)
+
+ member this.Dispose() = (this :> IDisposable).Dispose()
+
+ override this.Finalize() : unit = this.Dispose()
+
+ static member Create<'Key, 'Value>(options: CacheOptions) =
+ // Increase expected capacity by the percentage to evict, since we want to not resize the dictionary.
+ let capacity =
+ options.MaximumCapacity
+ + int (float options.MaximumCapacity * float options.PercentageToEvict / 100.0)
+
+ let cts = new CancellationTokenSource()
+ let cache = new Cache<'Key, 'Value>(options, capacity, cts)
+ CacheInstrumentation.AddInstrumentation cache |> ignore
+ cache
+
+ member this.GetStats() = CacheInstrumentation.GetStats(this)
+
+and CacheInstrumentation(cache: ICacheEvents) =
+ static let mutable cacheId = 0
+
+ static let instrumentedCaches = ConcurrentDictionary()
+
+ static let meter = new Meter(nameof CacheInstrumentation)
+
+ let instanceId = $"cache-{Interlocked.Increment(&cacheId)}"
+
+ let hits = meter.CreateCounter("hits", "count", instanceId)
+ let misses = meter.CreateCounter("misses", "count", instanceId)
+ let evictions = meter.CreateCounter("evictions", "count", instanceId)
+
+ let evictionFails =
+ meter.CreateCounter("eviction-fails", "count", instanceId)
+
+ let overCapacity = meter.CreateCounter("over-capacity", "count", instanceId)
+
+ do
+ cache.CacheHit.Add <| fun _ -> hits.Add(1L)
+ cache.CacheMiss.Add <| fun _ -> misses.Add(1L)
+ cache.Eviction.Add <| fun _ -> evictions.Add(1L)
+ cache.EvictionFail.Add <| fun _ -> evictionFails.Add(1L)
+ cache.OverCapacity.Add <| fun _ -> overCapacity.Add(1L)
+
+ let current = ConcurrentDictionary()
+
+ let listener =
+ new MeterListener(
+ InstrumentPublished =
+ fun i l ->
+ if i.Meter = meter && i.Description = instanceId then
+ l.EnableMeasurementEvents(i)
+ )
+
+ do
+ listener.SetMeasurementEventCallback(fun k v _ _ -> Interlocked.Add(current.GetOrAdd(k, ref 0L), v) |> ignore)
+ listener.Start()
+
+ member val CacheId = instanceId
+
+ member val RecentStats = "-" with get, set
+
+ member this.TryUpdateStats(clearCounts) =
+ let stats =
+ try
+ let ratio =
+ float current[hits].Value / float (current[hits].Value + current[misses].Value)
+ * 100.0
+
+ [
+ for i in current.Keys do
+ let v = current[i].Value
+
+ if v > 0 then
+ $"{i.Name}: {v}"
+ ]
+ |> String.concat ", "
+ |> sprintf "%s | hit ratio: %s %s" this.CacheId (if Double.IsNaN(ratio) then "-" else $"%.1f{ratio}%%")
+ with _ ->
+ "!"
+
+ if clearCounts then
+ for r in current.Values do
+ Interlocked.Exchange(r, 0L) |> ignore
+
+ if stats <> this.RecentStats then
+ this.RecentStats <- stats
+ true
+ else
+ false
+
+ member this.Dispose() = listener.Dispose()
+
+ static member GetStats(cache: ICacheEvents) =
+ instrumentedCaches[cache].TryUpdateStats(false) |> ignore
+ instrumentedCaches[cache].RecentStats
+
+ static member GetStatsUpdateForAllCaches(clearCounts) =
+ [
+ for i in instrumentedCaches.Values do
+ if i.TryUpdateStats(clearCounts) then
+ i.RecentStats
+ ]
+ |> String.concat "\n"
+
+ static member AddInstrumentation(cache: ICacheEvents) =
+ instrumentedCaches[cache] <- new CacheInstrumentation(cache)
+
+ static member RemoveInstrumentation(cache: ICacheEvents) =
+ instrumentedCaches[cache].Dispose()
+ instrumentedCaches.TryRemove(cache) |> ignore
diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi
new file mode 100644
index 00000000000..c2dd99fe041
--- /dev/null
+++ b/src/Compiler/Utilities/Caches.fsi
@@ -0,0 +1,85 @@
+namespace FSharp.Compiler
+
+open System
+open System.Threading
+
+[]
+type internal CachingStrategy =
+ | LRU
+ | LFU
+
+[]
+type internal EvictionMethod =
+ | Blocking
+ | Background
+ | NoEviction
+
+[]
+type internal CacheOptions =
+ { MaximumCapacity: int
+ PercentageToEvict: int
+ Strategy: CachingStrategy
+ EvictionMethod: EvictionMethod
+ LevelOfConcurrency: int }
+
+ static member Default: CacheOptions
+
+[]
+type internal CachedEntity<'Key, 'Value> =
+ new: key: 'Key * value: 'Value -> CachedEntity<'Key, 'Value>
+ member WithNode: unit -> CachedEntity<'Key, 'Value>
+ member ReUse: key: 'Key * value: 'Value -> CachedEntity<'Key, 'Value>
+ override ToString: unit -> string
+
+type internal IEvictionQueue<'Key, 'Value> =
+ abstract member Add: CachedEntity<'Key, 'Value> * CachingStrategy -> unit
+ abstract member Update: CachedEntity<'Key, 'Value> -> unit
+ abstract member GetKeysToEvict: int -> 'Key[]
+ abstract member Remove: CachedEntity<'Key, 'Value> -> unit
+
+[]
+type internal EvictionQueue<'Key, 'Value> =
+ new: strategy: CachingStrategy -> EvictionQueue<'Key, 'Value>
+ member Count: int
+ static member NoEviction: IEvictionQueue<'Key, 'Value>
+ interface IEvictionQueue<'Key, 'Value>
+
+type internal ICacheEvents =
+ []
+ abstract member CacheHit: IEvent
+
+ []
+ abstract member CacheMiss: IEvent
+
+ []
+ abstract member Eviction: IEvent
+
+ []
+ abstract member EvictionFail: IEvent
+
+ []
+ abstract member OverCapacity: IEvent
+
+[]
+type internal Cache<'Key, 'Value when 'Key: not null and 'Key: equality> =
+ new: options: CacheOptions * capacity: int * cts: CancellationTokenSource -> Cache<'Key, 'Value>
+ member TryGetValue: key: 'Key * value: outref<'Value> -> bool
+ member TryAdd: key: 'Key * value: 'Value -> bool
+ member AddOrUpdate: key: 'Key * value: 'Value -> unit
+ member Dispose: unit -> unit
+ member GetStats: unit -> string
+
+ static member Create<'Key, 'Value> : options: CacheOptions -> Cache<'Key, 'Value>
+
+ interface ICacheEvents
+ interface IDisposable
+
+type internal CacheInstrumentation =
+ new: cache: ICacheEvents -> CacheInstrumentation
+ member CacheId: string
+ member RecentStats: string
+ member TryUpdateStats: clearCounts: bool -> bool
+ static member GetStats: cache: ICacheEvents -> string
+ static member GetStatsUpdateForAllCaches: clearCounts: bool -> string
+ static member AddInstrumentation: cache: ICacheEvents -> unit
+ static member RemoveInstrumentation: cache: ICacheEvents -> unit
diff --git a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_net9.0.bsl b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_net9.0.bsl
index 69842b9e059..bd581b3d765 100644
--- a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_net9.0.bsl
+++ b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_net9.0.bsl
@@ -21,14 +21,14 @@
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CodeAnalysis.Hosted.CompilerHelpers::fscCompile([FSharp.Compiler.Service]FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver, string, string[])][offset 0x00000082][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CodeAnalysis.Hosted.CompilerHelpers::fscCompile([FSharp.Compiler.Service]FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver, string, string[])][offset 0x0000008B][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+MagicAssemblyResolution::ResolveAssemblyCore([FSharp.Compiler.Service]Internal.Utilities.Library.CompilationThreadToken, [FSharp.Compiler.Service]FSharp.Compiler.Text.Range, [FSharp.Compiler.Service]FSharp.Compiler.CompilerConfig+TcConfigBuilder, [FSharp.Compiler.Service]FSharp.Compiler.CompilerImports+TcImports, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiDynamicCompiler, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiConsoleOutput, string)][offset 0x00000015][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-805::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001E5][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-812::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001E5][found Char] Unexpected type on the stack.
[IL]: Error [UnmanagedPointer]: : FSharp.Compiler.Interactive.Shell+Utilities+pointerToNativeInt@110::Invoke(object)][offset 0x00000007] Unmanaged pointers are not a verifiable type.
[IL]: Error [StackUnexpected]: : .$FSharpCheckerResults+dataTipOfReferences@2225::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000084][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000082][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000008B][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000094][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000082][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000008B][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000094][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.StaticLinking+TypeForwarding::followTypeForwardForILTypeRef([FSharp.Compiler.Service]FSharp.Compiler.AbstractIL.IL+ILTypeRef)][offset 0x00000010][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CompilerOptions::getCompilerOption([FSharp.Compiler.Service]FSharp.Compiler.CompilerOptions+CompilerOption, [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1)][offset 0x000000E6][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CompilerOptions::AddPathMapping([FSharp.Compiler.Service]FSharp.Compiler.CompilerConfig+TcConfigBuilder, string)][offset 0x0000000B][found Char] Unexpected type on the stack.
diff --git a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl
index 6e41547cd11..752b1e98415 100644
--- a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl
+++ b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl
@@ -28,18 +28,18 @@
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CodeAnalysis.Hosted.CompilerHelpers::fscCompile([FSharp.Compiler.Service]FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver, string, string[])][offset 0x0000008B][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+FsiStdinSyphon::GetLine(string, int32)][offset 0x00000039][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+MagicAssemblyResolution::ResolveAssemblyCore([FSharp.Compiler.Service]Internal.Utilities.Library.CompilationThreadToken, [FSharp.Compiler.Service]FSharp.Compiler.Text.Range, [FSharp.Compiler.Service]FSharp.Compiler.CompilerConfig+TcConfigBuilder, [FSharp.Compiler.Service]FSharp.Compiler.CompilerImports+TcImports, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiDynamicCompiler, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiConsoleOutput, string)][offset 0x00000015][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-805::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001E5][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-812::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001E5][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+FsiInteractionProcessor::CompletionsForPartialLID([FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiDynamicCompilerState, string)][offset 0x0000001B][found Char] Unexpected type on the stack.
[IL]: Error [UnmanagedPointer]: : FSharp.Compiler.Interactive.Shell+Utilities+pointerToNativeInt@110::Invoke(object)][offset 0x00000007] Unmanaged pointers are not a verifiable type.
[IL]: Error [StackUnexpected]: : .$FSharpCheckerResults+dataTipOfReferences@2225::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000084][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.EditorServices.AssemblyContent+traverseMemberFunctionAndValues@176::Invoke([FSharp.Compiler.Service]FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue)][offset 0x00000059][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.EditorServices.AssemblyContent+traverseEntity@218::GenerateNext([S.P.CoreLib]System.Collections.Generic.IEnumerable`1&)][offset 0x000000DA][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.EditorServices.ParsedInput+visitor@1424-6::VisitExpr([FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1, [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, [FSharp.Compiler.Service]FSharp.Compiler.Syntax.SynExpr)][offset 0x00000605][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000082][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000008B][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-509::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000094][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000082][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000008B][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000094][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : .$Symbols+fullName@2495-1::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000015][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CreateILModule+MainModuleBuilder::ConvertProductVersionToILVersionInfo(string)][offset 0x00000011][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.StaticLinking+TypeForwarding::followTypeForwardForILTypeRef([FSharp.Compiler.Service]FSharp.Compiler.AbstractIL.IL+ILTypeRef)][offset 0x00000010][found Char] Unexpected type on the stack.
diff --git a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_net9.0.bsl b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_net9.0.bsl
index 4e7b5396676..d171cb2277a 100644
--- a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_net9.0.bsl
+++ b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_net9.0.bsl
@@ -21,13 +21,13 @@
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CodeAnalysis.Hosted.CompilerHelpers::fscCompile([FSharp.Compiler.Service]FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver, string, string[])][offset 0x00000082][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CodeAnalysis.Hosted.CompilerHelpers::fscCompile([FSharp.Compiler.Service]FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver, string, string[])][offset 0x0000008B][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+MagicAssemblyResolution::ResolveAssemblyCore([FSharp.Compiler.Service]Internal.Utilities.Library.CompilationThreadToken, [FSharp.Compiler.Service]FSharp.Compiler.Text.Range, [FSharp.Compiler.Service]FSharp.Compiler.CompilerConfig+TcConfigBuilder, [FSharp.Compiler.Service]FSharp.Compiler.CompilerImports+TcImports, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiDynamicCompiler, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiConsoleOutput, string)][offset 0x00000015][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-849::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001C7][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-856::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001C7][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : .$FSharpCheckerResults+GetReferenceResolutionStructuredToolTipText@2225::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000076][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000064][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000006D][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000076][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000064][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000006D][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000076][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Driver+ProcessCommandLineFlags@291-1::Invoke(string)][offset 0x0000000B][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Driver+ProcessCommandLineFlags@291-1::Invoke(string)][offset 0x00000014][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.StaticLinking+TypeForwarding::followTypeForwardForILTypeRef([FSharp.Compiler.Service]FSharp.Compiler.AbstractIL.IL+ILTypeRef)][offset 0x00000010][found Char] Unexpected type on the stack.
diff --git a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_netstandard2.0.bsl b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_netstandard2.0.bsl
index 431d4e5512a..3b30273904b 100644
--- a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_netstandard2.0.bsl
+++ b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Release_netstandard2.0.bsl
@@ -28,17 +28,17 @@
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CodeAnalysis.Hosted.CompilerHelpers::fscCompile([FSharp.Compiler.Service]FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver, string, string[])][offset 0x0000008B][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+FsiStdinSyphon::GetLine(string, int32)][offset 0x00000032][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+MagicAssemblyResolution::ResolveAssemblyCore([FSharp.Compiler.Service]Internal.Utilities.Library.CompilationThreadToken, [FSharp.Compiler.Service]FSharp.Compiler.Text.Range, [FSharp.Compiler.Service]FSharp.Compiler.CompilerConfig+TcConfigBuilder, [FSharp.Compiler.Service]FSharp.Compiler.CompilerImports+TcImports, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiDynamicCompiler, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiConsoleOutput, string)][offset 0x00000015][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-849::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001C7][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-856::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001C7][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+FsiInteractionProcessor::CompletionsForPartialLID([FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiDynamicCompilerState, string)][offset 0x00000024][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : .$FSharpCheckerResults+GetReferenceResolutionStructuredToolTipText@2225::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000076][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.EditorServices.AssemblyContent+traverseMemberFunctionAndValues@176::Invoke([FSharp.Compiler.Service]FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue)][offset 0x0000002B][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.EditorServices.AssemblyContent+traverseEntity@218::GenerateNext([S.P.CoreLib]System.Collections.Generic.IEnumerable`1&)][offset 0x000000BB][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.EditorServices.ParsedInput+visitor@1424-11::VisitExpr([FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1, [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, [FSharp.Compiler.Service]FSharp.Compiler.Syntax.SynExpr)][offset 0x00000620][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000064][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000006D][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-530::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000076][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000064][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000006D][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-537::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000076][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : .$Symbols+fullName@2495-3::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000030][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Driver+ProcessCommandLineFlags@291-1::Invoke(string)][offset 0x0000000B][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Driver+ProcessCommandLineFlags@291-1::Invoke(string)][offset 0x00000014][found Char] Unexpected type on the stack.
From df70074078875614098e725d58b78aa55ee14633 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Thu, 24 Apr 2025 13:55:30 +0200
Subject: [PATCH 02/28] enable typeSubsumptionCache in IDE
---
src/Compiler/Checking/TypeRelations.fs | 8 ++--
src/Compiler/Checking/import.fs | 66 ++++++++++++++++++--------
src/Compiler/Checking/import.fsi | 9 ++--
src/Compiler/Utilities/TypeHashing.fs | 46 +++++++++++-------
4 files changed, 84 insertions(+), 45 deletions(-)
diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs
index 2cb5dd4057a..fa900069508 100644
--- a/src/Compiler/Checking/TypeRelations.fs
+++ b/src/Compiler/Checking/TypeRelations.fs
@@ -102,7 +102,7 @@ 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.compilationMode = CompilationMode.OneOff && g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
+ if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
match amap.TypeSubsumptionCache.TryGetValue(key) with
| true, subsumes ->
ValueSome subsumes
@@ -112,8 +112,8 @@ let inline TryGetCachedTypeSubsumption (g: TcGlobals) (amap: ImportMap) key =
ValueNone
let inline UpdateCachedTypeSubsumption (g: TcGlobals) (amap: ImportMap) key subsumes : unit =
- if g.compilationMode = CompilationMode.OneOff && g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
- amap.TypeSubsumptionCache[key] <- subsumes
+ if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
+ amap.TypeSubsumptionCache.AddOrUpdate(key, subsumes)
/// The feasible coercion relation. Part of the language spec.
let rec TypeFeasiblySubsumesType ndeep (g: TcGlobals) (amap: ImportMap) m (ty1: TType) (canCoerce: CanCoerce) (ty2: TType) =
@@ -125,7 +125,7 @@ let rec TypeFeasiblySubsumesType ndeep (g: TcGlobals) (amap: ImportMap) m (ty1:
let ty2 = stripTyEqns g ty2
// Check if language feature supported
- let key = TTypeCacheKey.FromStrippedTypes (ty1, ty2, canCoerce, g)
+ let key = TTypeCacheKey.FromStrippedTypes (ty1, ty2, canCoerce)
match TryGetCachedTypeSubsumption g amap key with
| ValueSome subsumes ->
diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs
index c87d6cdad03..1b3ccbd64fb 100644
--- a/src/Compiler/Checking/import.fs
+++ b/src/Compiler/Checking/import.fs
@@ -6,17 +6,22 @@ module internal FSharp.Compiler.Import
open System.Collections.Concurrent
open System.Collections.Generic
open System.Collections.Immutable
-open FSharp.Compiler.Text.Range
+open System.Diagnostics
+open System.Runtime.CompilerServices
+open System.Threading
+
open Internal.Utilities.Library
open Internal.Utilities.Library.Extras
open Internal.Utilities.TypeHashing
open Internal.Utilities.TypeHashing.HashTypes
+
open FSharp.Compiler
open FSharp.Compiler.AbstractIL.IL
open FSharp.Compiler.CompilerGlobalState
open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.SyntaxTreeOps
open FSharp.Compiler.Text
+open FSharp.Compiler.Text.Range
open FSharp.Compiler.Xml
open FSharp.Compiler.TypedTree
open FSharp.Compiler.TypedTreeBasics
@@ -52,18 +57,18 @@ type CanCoerce =
| CanCoerce
| NoCoerce
-type [] TTypeCacheKey =
+[]
+type TTypeCacheKey =
val ty1: TType
val ty2: TType
val canCoerce: CanCoerce
- val tcGlobals: TcGlobals
- private new (ty1, ty2, canCoerce, tcGlobals) =
- { ty1 = ty1; ty2 = ty2; canCoerce = canCoerce; tcGlobals = tcGlobals }
+ private new (ty1, ty2, canCoerce) =
+ { ty1 = ty1; ty2 = ty2; canCoerce = canCoerce }
- static member FromStrippedTypes (ty1, ty2, canCoerce, tcGlobals) =
- TTypeCacheKey(ty1, ty2, canCoerce, tcGlobals)
+ static member FromStrippedTypes (ty1, ty2, canCoerce) =
+ TTypeCacheKey(ty1, ty2, canCoerce)
interface System.IEquatable with
member this.Equals other =
@@ -72,8 +77,8 @@ type [] TTypeCacheKey =
elif this.ty1 === other.ty1 && this.ty2 === other.ty2 then
true
else
- stampEquals this.tcGlobals this.ty1 other.ty1
- && stampEquals this.tcGlobals this.ty2 other.ty2
+ HashStamps.stampEquals this.ty1 other.ty1
+ && HashStamps.stampEquals this.ty2 other.ty2
override this.Equals(other:objnull) =
match other with
@@ -81,14 +86,37 @@ type [] TTypeCacheKey =
| _ -> false
override this.GetHashCode() : int =
- let g = this.tcGlobals
-
- let ty1Hash = combineHash (hashStamp g this.ty1) (hashTType g this.ty1)
- let ty2Hash = combineHash (hashStamp g this.ty2) (hashTType g this.ty2)
-
- let combined = combineHash (combineHash ty1Hash ty2Hash) (hash this.canCoerce)
-
- combined
+ HashStamps.hashTType this.ty1
+ |> pipeToHash (HashStamps.hashTType this.ty2)
+ |> pipeToHash (hash this.canCoerce)
+
+ override this.ToString () = $"{this.ty1.DebugText}-{this.ty2.DebugText}"
+
+let getOrCreateTypeSubsumptionCache =
+ let mutable lockObj = obj()
+ let mutable cache = None
+
+ fun compilationMode ->
+ lock lockObj <| fun () ->
+ match cache with
+ | Some c -> c
+ | _ ->
+ let options =
+ match compilationMode with
+ | CompilationMode.OneOff ->
+ // This is a one-off compilation, so we don't need to worry about eviction.
+ { CacheOptions.Default with
+ MaximumCapacity = 200_000
+ EvictionMethod = EvictionMethod.NoEviction }
+ | _ ->
+ // Oncremental use, so we need to set up the cache with eviction.
+ { CacheOptions.Default with
+ EvictionMethod = EvictionMethod.Background
+ Strategy = CachingStrategy.LRU
+ PercentageToEvict = 5
+ MaximumCapacity = 4 * 32768 }
+ cache <- Some (Cache.Create(options))
+ cache.Value
//-------------------------------------------------------------------------
// Import an IL types as F# types.
@@ -106,15 +134,13 @@ type [] TTypeCacheKey =
type ImportMap(g: TcGlobals, assemblyLoader: AssemblyLoader) =
let typeRefToTyconRefCache = ConcurrentDictionary()
- let typeSubsumptionCache = ConcurrentDictionary(System.Environment.ProcessorCount, 1024)
-
member _.g = g
member _.assemblyLoader = assemblyLoader
member _.ILTypeRefToTyconRefCache = typeRefToTyconRefCache
- member _.TypeSubsumptionCache = typeSubsumptionCache
+ member val TypeSubsumptionCache: Cache = getOrCreateTypeSubsumptionCache g.compilationMode
let CanImportILScopeRef (env: ImportMap) m scoref =
diff --git a/src/Compiler/Checking/import.fsi b/src/Compiler/Checking/import.fsi
index c387558fcba..0ba2a635ec0 100644
--- a/src/Compiler/Checking/import.fsi
+++ b/src/Compiler/Checking/import.fsi
@@ -45,15 +45,14 @@ type CanCoerce =
[]
type TTypeCacheKey =
interface System.IEquatable
- private new: ty1: TType * ty2: TType * canCoerce: CanCoerce * tcGlobals: TcGlobals -> TTypeCacheKey
+ private new: ty1: TType * ty2: TType * canCoerce: CanCoerce -> TTypeCacheKey
- static member FromStrippedTypes:
- ty1: TType * ty2: TType * canCoerce: CanCoerce * tcGlobals: TcGlobals -> TTypeCacheKey
+ static member FromStrippedTypes: ty1: TType * ty2: TType * canCoerce: CanCoerce -> TTypeCacheKey
val ty1: TType
val ty2: TType
val canCoerce: CanCoerce
- val tcGlobals: TcGlobals
+ //val tcGlobals: TcGlobals
override GetHashCode: unit -> int
/// Represents a context used for converting AbstractIL .NET and provided types to F# internal compiler data structures.
@@ -73,7 +72,7 @@ type ImportMap =
member g: TcGlobals
/// Type subsumption cache
- member TypeSubsumptionCache: ConcurrentDictionary
+ member TypeSubsumptionCache: Cache
module Nullness =
diff --git a/src/Compiler/Utilities/TypeHashing.fs b/src/Compiler/Utilities/TypeHashing.fs
index bcdface38be..7639f2dd679 100644
--- a/src/Compiler/Utilities/TypeHashing.fs
+++ b/src/Compiler/Utilities/TypeHashing.fs
@@ -126,22 +126,6 @@ module HashAccessibility =
module rec HashTypes =
open Microsoft.FSharp.Core.LanguagePrimitives
- let stampEquals g ty1 ty2 =
- match (stripTyEqns g ty1), (stripTyEqns g ty2) with
- | TType_app(tcref1, _, _), TType_app(tcref2, _, _) -> tcref1.Stamp.Equals(tcref2.Stamp)
- | TType_var(r1, _), TType_var(r2, _) -> r1.Stamp.Equals(r2.Stamp)
- | _ -> false
-
- /// Get has for Stamp for TType_app tyconref and TType_var typar
- let hashStamp g ty =
- let v: Stamp =
- match (stripTyEqns g ty) with
- | TType_app(tcref, _, _) -> tcref.Stamp
- | TType_var(r, _) -> r.Stamp
- | _ -> GenericZero
-
- hash v
-
/// Hash a reference to a type
let hashTyconRef tcref = hashTyconRefImpl tcref
@@ -344,3 +328,33 @@ module HashTastMemberOrVals =
hashNonMemberVal (g, obs) (tps, vref.Deref, tau, cxs)
| Some _ -> hashMember (g, obs) emptyTyparInst vref.Deref
+
+module HashStamps =
+ let rec stampEquals ty1 ty2 =
+ match ty1, ty2 with
+ | TType_app(tcref1, tinst1, _), TType_app(tcref2, tinst2, _) ->
+ tcref1.Stamp = tcref2.Stamp
+ && tinst1.Length = tinst2.Length
+ && (tinst1, tinst2) ||> Seq.zip |> Seq.forall (fun (t1, t2) -> stampEquals t1 t2)
+
+ | TType_var(r1, _), TType_var(r2, _) -> r1.Stamp = r2.Stamp
+ | _ -> false
+
+ let inline hashStamp (x: int64) = uint x * 2654435761u |> int
+
+ // The idea is to keep the illusion of immutability of TType.
+ // This hash must be stable during compilation, otherwise we won't be able to find keys or evict from the cache.
+ let rec hashTType ty =
+ match ty with
+ | TType_ucase(_, tinst) -> tinst |> hashListOrderMatters (hashTType)
+ | TType_app(tcref, tinst, _) -> tinst |> hashListOrderMatters (hashTType) |> pipeToHash (hashStamp tcref.Stamp)
+ | TType_anon(info, tys) -> tys |> hashListOrderMatters (hashTType) |> pipeToHash (hashStamp info.Stamp)
+ | TType_tuple(_, tys) -> tys |> hashListOrderMatters (hashTType)
+ | TType_forall(tps, tau) ->
+ tps
+ |> Seq.map _.Stamp
+ |> hashListOrderMatters (hashStamp)
+ |> pipeToHash (hashTType tau)
+ | TType_fun(d, r, _) -> hashTType d |> pipeToHash (hashTType r)
+ | TType_var(r, _) -> hashStamp r.Stamp
+ | TType_measure _ -> 0
From 460f5926372649957c1520e4428416dfaad51275 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Thu, 24 Apr 2025 14:00:54 +0200
Subject: [PATCH 03/28] add some monitoring
---
tests/FSharp.Test.Utilities/XunitHelpers.fs | 18 ++++-
.../src/FSharp.Editor/Common/Logging.fs | 72 ++++++++++++++-----
.../LanguageService/LanguageService.fs | 20 ++++--
.../FSharp.Editor.Tests.fsproj | 3 +
.../tests/Salsa/VisualFSharp.Salsa.fsproj | 3 +
.../UnitTests/VisualFSharp.UnitTests.fsproj | 3 +
6 files changed, 96 insertions(+), 23 deletions(-)
diff --git a/tests/FSharp.Test.Utilities/XunitHelpers.fs b/tests/FSharp.Test.Utilities/XunitHelpers.fs
index 34a44df17ed..c68b2f29a14 100644
--- a/tests/FSharp.Test.Utilities/XunitHelpers.fs
+++ b/tests/FSharp.Test.Utilities/XunitHelpers.fs
@@ -12,9 +12,9 @@ open TestFramework
open FSharp.Compiler.Diagnostics
-open OpenTelemetry
open OpenTelemetry.Resources
open OpenTelemetry.Trace
+open OpenTelemetry.Metrics
/// Disables custom internal parallelization added with XUNIT_EXTRAS.
/// Execute test cases in a class or a module one by one instead of all at once. Allow other collections to run simultaneously.
@@ -146,12 +146,17 @@ type FSharpXunitFramework(sink: IMessageSink) =
AssemblyResolver.addResolver ()
#endif
+ // On Windows forwarding localhost to wsl2 docker container sometimes does not work. Use IP address instead.
+ let otlpEndpoint = Uri("http://127.0.0.1:4317")
+
// Configure OpenTelemetry export. Traces can be viewed in Jaeger or other compatible tools.
use tracerProvider =
OpenTelemetry.Sdk.CreateTracerProviderBuilder()
.AddSource(ActivityNames.FscSourceName)
.ConfigureResource(fun r -> r.AddService("F#") |> ignore)
.AddOtlpExporter(fun o ->
+ o.Endpoint <- otlpEndpoint
+ o.Protocol <- OpenTelemetry.Exporter.OtlpExportProtocol.Grpc
// Empirical values to ensure no traces are lost and no significant delay at the end of test run.
o.TimeoutMilliseconds <- 200
o.BatchExportProcessorOptions.MaxQueueSize <- 16384
@@ -159,6 +164,17 @@ type FSharpXunitFramework(sink: IMessageSink) =
)
.Build()
+ use meterProvider =
+ OpenTelemetry.Sdk.CreateMeterProviderBuilder()
+ .AddMeter(nameof FSharp.Compiler.CacheInstrumentation)
+ .ConfigureResource(fun r -> r.AddService("F#") |> ignore)
+ .AddOtlpExporter(fun e m ->
+ e.Endpoint <- otlpEndpoint
+ e.Protocol <- OpenTelemetry.Exporter.OtlpExportProtocol.Grpc
+ m.PeriodicExportingMetricReaderOptions.ExportIntervalMilliseconds <- 1000
+ )
+ .Build()
+
logConfig initialConfig
log "Installing TestConsole redirection"
TestConsole.install()
diff --git a/vsintegration/src/FSharp.Editor/Common/Logging.fs b/vsintegration/src/FSharp.Editor/Common/Logging.fs
index b0f56df3234..e8d0e4d5daf 100644
--- a/vsintegration/src/FSharp.Editor/Common/Logging.fs
+++ b/vsintegration/src/FSharp.Editor/Common/Logging.fs
@@ -30,6 +30,8 @@ module Config =
let fsharpOutputGuid = Guid fsharpOutputGuidString
open Config
+open System.Diagnostics.Metrics
+open System.Text
[]
type Logger [] ([)>] serviceProvider: IServiceProvider) =
@@ -118,11 +120,7 @@ module Logging =
let logExceptionWithContext (ex: Exception, context) =
logErrorf "Context: %s\nException Message: %s\nStack Trace: %s" context ex.Message ex.StackTrace
-#if DEBUG
-module Activity =
-
- open OpenTelemetry.Resources
- open OpenTelemetry.Trace
+module FSharpServiceTelemetry =
let listen filter =
let indent (activity: Activity) =
@@ -135,16 +133,15 @@ module Activity =
String.replicate (loop activity 0) " "
let collectTags (activity: Activity) =
- [ for tag in activity.Tags -> $"{tag.Key}: %A{tag.Value}" ]
- |> String.concat ", "
+ [ for tag in activity.Tags -> $"{tag.Key}: {tag.Value}" ] |> String.concat ", "
let listener =
new ActivityListener(
- ShouldListenTo = (fun source -> source.Name = FSharp.Compiler.Diagnostics.ActivityNames.FscSourceName),
+ ShouldListenTo = (fun source -> source.Name = ActivityNames.FscSourceName),
Sample =
(fun context ->
if context.Name.Contains(filter) then
- ActivitySamplingResult.AllDataAndRecorded
+ ActivitySamplingResult.AllData
else
ActivitySamplingResult.None),
ActivityStarted = (fun a -> logMsg $"{indent a}{a.OperationName} {collectTags a}")
@@ -152,13 +149,56 @@ module Activity =
ActivitySource.AddActivityListener(listener)
- let export () =
- OpenTelemetry.Sdk
- .CreateTracerProviderBuilder()
- .AddSource(ActivityNames.FscSourceName)
- .SetResourceBuilder(ResourceBuilder.CreateDefault().AddService(serviceName = "F#", serviceVersion = "1.0.0"))
- .AddOtlpExporter()
- .Build()
+ let logCacheMetricsToOutput () =
+
+ let timer = new System.Timers.Timer(1000.0, AutoReset = true)
+
+ timer.Elapsed.Add(fun _ ->
+ let stats =
+ FSharp.Compiler.CacheInstrumentation.GetStatsUpdateForAllCaches(clearCounts = true)
+
+ if stats <> "" then
+ logMsg $"\n{stats}")
+
+ timer.Start()
+
+#if DEBUG
+ open OpenTelemetry.Resources
+ open OpenTelemetry.Trace
+ open OpenTelemetry.Metrics
+
+ let otelExport () =
+ // On Windows forwarding localhost to wsl2 docker container sometimes does not work. Use IP address instead.
+ let otlpEndpoint = Uri("http://127.0.0.1:4317")
+
+ let meterProvider =
+ // Configure OpenTelemetry metrics. Metrics can be viewed in Prometheus or other compatible tools.
+ OpenTelemetry.Sdk
+ .CreateMeterProviderBuilder()
+ .ConfigureResource(fun r -> r.AddService("F#") |> ignore)
+ .AddMeter(nameof FSharp.Compiler.CacheInstrumentation)
+ .AddOtlpExporter(fun e m ->
+ e.Endpoint <- otlpEndpoint
+ m.PeriodicExportingMetricReaderOptions.ExportIntervalMilliseconds <- 1000
+ m.TemporalityPreference <- MetricReaderTemporalityPreference.Cumulative)
+ .Build()
+
+ let tracerProvider =
+ // Configure OpenTelemetry export. Traces can be viewed in Jaeger or other compatible tools.
+ OpenTelemetry.Sdk
+ .CreateTracerProviderBuilder()
+ .AddSource(ActivityNames.FscSourceName)
+ .ConfigureResource(fun r -> r.AddService("F#") |> ignore)
+ .AddOtlpExporter(fun e -> e.Endpoint <- otlpEndpoint)
+ .Build()
+
+ let a = Activity.startNoTags "FSharpPackage"
+
+ fun () ->
+ a.Dispose()
+ tracerProvider.ForceFlush(5000) |> ignore
+ tracerProvider.Dispose()
+ meterProvider.Dispose()
let listenToAll () = listen ""
#endif
diff --git a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs
index 5cc9cec2943..d12d66bf660 100644
--- a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs
+++ b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs
@@ -340,15 +340,23 @@ type internal FSharpPackage() as this =
let mutable solutionEventsOpt = None
-#if DEBUG
- let _traceProvider = Logging.Activity.export ()
- let _logger = Logging.Activity.listenToAll ()
- // Logging.Activity.listen "IncrementalBuild"
-#endif
-
// FSI-LINKAGE-POINT: unsited init
do FSharp.Interactive.Hooks.fsiConsoleWindowPackageCtorUnsited (this :> Package)
+ // Uncomment to view cache metrics in the output window
+ // do Logging.FSharpServiceTelemetry.logCacheMetricsToOutput ()
+
+#if DEBUG
+
+ let flushTelemetry = Logging.FSharpServiceTelemetry.otelExport ()
+
+ override this.Dispose(disposing: bool) =
+ base.Dispose(disposing: bool)
+
+ if disposing then
+ flushTelemetry ()
+#endif
+
override this.InitializeAsync(cancellationToken: CancellationToken, progress: IProgress) : Tasks.Task =
// `base.` methods can't be called in the `async` builder, so we have to cache it
let baseInitializeAsync = base.InitializeAsync(cancellationToken, progress)
diff --git a/vsintegration/tests/FSharp.Editor.Tests/FSharp.Editor.Tests.fsproj b/vsintegration/tests/FSharp.Editor.Tests/FSharp.Editor.Tests.fsproj
index 738a3e1323c..25f46d3505f 100644
--- a/vsintegration/tests/FSharp.Editor.Tests/FSharp.Editor.Tests.fsproj
+++ b/vsintegration/tests/FSharp.Editor.Tests/FSharp.Editor.Tests.fsproj
@@ -17,6 +17,9 @@
+
+ XunitSetup.fs
+
diff --git a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj
index 7f24444a6e5..ba2efee9706 100644
--- a/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj
+++ b/vsintegration/tests/Salsa/VisualFSharp.Salsa.fsproj
@@ -16,6 +16,9 @@
+
+ XunitSetup.fs
+
diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj
index 77c7d12e017..c7f69001d9e 100644
--- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj
+++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj
@@ -17,6 +17,9 @@
+
+ XunitSetup.fs
+
From b2a130a1822699d72258d51f60784b36cab29d28 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Thu, 24 Apr 2025 16:49:17 +0200
Subject: [PATCH 04/28] yeet LFU
---
src/Compiler/Checking/import.fs | 1 -
src/Compiler/Utilities/Caches.fs | 50 ++++++++-----------------------
src/Compiler/Utilities/Caches.fsi | 10 ++-----
3 files changed, 15 insertions(+), 46 deletions(-)
diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs
index 1b3ccbd64fb..649a412bca6 100644
--- a/src/Compiler/Checking/import.fs
+++ b/src/Compiler/Checking/import.fs
@@ -112,7 +112,6 @@ let getOrCreateTypeSubsumptionCache =
// Oncremental use, so we need to set up the cache with eviction.
{ CacheOptions.Default with
EvictionMethod = EvictionMethod.Background
- Strategy = CachingStrategy.LRU
PercentageToEvict = 5
MaximumCapacity = 4 * 32768 }
cache <- Some (Cache.Create(options))
diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs
index 97f2b08d8af..e93d9a168a7 100644
--- a/src/Compiler/Utilities/Caches.fs
+++ b/src/Compiler/Utilities/Caches.fs
@@ -8,11 +8,6 @@ open System.Threading
open System.Diagnostics
open System.Diagnostics.Metrics
-[]
-type CachingStrategy =
- | LRU
- | LFU
-
[]
type EvictionMethod =
| Blocking
@@ -24,7 +19,6 @@ type CacheOptions =
{
MaximumCapacity: int
PercentageToEvict: int
- Strategy: CachingStrategy
EvictionMethod: EvictionMethod
LevelOfConcurrency: int
}
@@ -33,7 +27,6 @@ type CacheOptions =
{
MaximumCapacity = 1024
PercentageToEvict = 5
- Strategy = CachingStrategy.LRU
LevelOfConcurrency = Environment.ProcessorCount
EvictionMethod = EvictionMethod.Blocking
}
@@ -84,26 +77,25 @@ type EntityPool<'Key, 'Value>(maximumCapacity, overCapacity: Event<_>) =
pool.Add(entity)
type IEvictionQueue<'Key, 'Value> =
- abstract member Add: CachedEntity<'Key, 'Value> * CachingStrategy -> unit
+ abstract member Add: CachedEntity<'Key, 'Value> -> unit
abstract member Update: CachedEntity<'Key, 'Value> -> unit
abstract member GetKeysToEvict: int -> 'Key[]
abstract member Remove: CachedEntity<'Key, 'Value> -> unit
[]
-type EvictionQueue<'Key, 'Value>(strategy: CachingStrategy) =
+type EvictionQueue<'Key, 'Value>() =
let list = LinkedList>()
interface IEvictionQueue<'Key, 'Value> with
- member _.Add(entity: CachedEntity<'Key, 'Value>, strategy) =
+ member _.Add(entity: CachedEntity<'Key, 'Value>) =
lock list
<| fun () ->
if isNull entity.Node.List then
- match strategy with
- | CachingStrategy.LRU -> list.AddLast(entity.Node)
- | CachingStrategy.LFU -> list.AddLast(entity.Node)
- // list.AddFirst(entity.Node)
+ list.AddLast(entity.Node)
+ else
+ assert false
member _.Update(entity: CachedEntity<'Key, 'Value>) =
lock list
@@ -114,25 +106,9 @@ type EvictionQueue<'Key, 'Value>(strategy: CachingStrategy) =
// Sync between store and the eviction queue is not atomic. It might be already evicted or not yet added.
if node.List = list then
-
- match strategy with
- | CachingStrategy.LRU ->
- // Just move this node to the end of the list.
- list.Remove(node)
- list.AddLast(node)
- | CachingStrategy.LFU ->
- // Bubble up the node in the list, linear time.
- // TODO: frequency list approach would be faster.
- let rec bubbleUp (current: LinkedListNode>) =
- match current.Next with
- | NonNull next when next.Value.AccessCount < entity.AccessCount -> bubbleUp next
- | _ -> current
-
- let next = bubbleUp node
-
- if next <> node then
- list.Remove(node)
- list.AddAfter(next, node)
+ // Just move this node to the end of the list.
+ list.Remove(node)
+ list.AddLast(node)
member _.GetKeysToEvict(count) =
lock list
@@ -145,7 +121,7 @@ type EvictionQueue<'Key, 'Value>(strategy: CachingStrategy) =
static member NoEviction =
{ new IEvictionQueue<'Key, 'Value> with
- member _.Add(_, _) = ()
+ member _.Add(_) = ()
member _.Update(entity) =
Interlocked.Increment(&entity.AccessCount) |> ignore
@@ -188,7 +164,7 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
let evictionQueue: IEvictionQueue<'Key, 'Value> =
match options.EvictionMethod with
| EvictionMethod.NoEviction -> EvictionQueue.NoEviction
- | _ -> EvictionQueue(options.Strategy)
+ | _ -> EvictionQueue()
let tryEvictItems () =
let count =
@@ -249,7 +225,7 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
let cachedEntity = pool.Acquire(key, value)
if store.TryAdd(key, cachedEntity) then
- evictionQueue.Add(cachedEntity, options.Strategy)
+ evictionQueue.Add(cachedEntity)
true
else
pool.Reclaim(cachedEntity)
@@ -272,7 +248,7 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
current)
)
- evictionQueue.Add(entity, options.Strategy)
+ evictionQueue.Add(entity)
interface ICacheEvents with
diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi
index c2dd99fe041..c2c8257a0ff 100644
--- a/src/Compiler/Utilities/Caches.fsi
+++ b/src/Compiler/Utilities/Caches.fsi
@@ -3,11 +3,6 @@ namespace FSharp.Compiler
open System
open System.Threading
-[]
-type internal CachingStrategy =
- | LRU
- | LFU
-
[]
type internal EvictionMethod =
| Blocking
@@ -18,7 +13,6 @@ type internal EvictionMethod =
type internal CacheOptions =
{ MaximumCapacity: int
PercentageToEvict: int
- Strategy: CachingStrategy
EvictionMethod: EvictionMethod
LevelOfConcurrency: int }
@@ -32,14 +26,14 @@ type internal CachedEntity<'Key, 'Value> =
override ToString: unit -> string
type internal IEvictionQueue<'Key, 'Value> =
- abstract member Add: CachedEntity<'Key, 'Value> * CachingStrategy -> unit
+ abstract member Add: CachedEntity<'Key, 'Value> -> unit
abstract member Update: CachedEntity<'Key, 'Value> -> unit
abstract member GetKeysToEvict: int -> 'Key[]
abstract member Remove: CachedEntity<'Key, 'Value> -> unit
[]
type internal EvictionQueue<'Key, 'Value> =
- new: strategy: CachingStrategy -> EvictionQueue<'Key, 'Value>
+ new: unit -> EvictionQueue<'Key, 'Value>
member Count: int
static member NoEviction: IEvictionQueue<'Key, 'Value>
interface IEvictionQueue<'Key, 'Value>
From 4c7e044ea3a7df01a087e641c876e82fe01436f9 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Thu, 24 Apr 2025 16:49:59 +0200
Subject: [PATCH 05/28] flesh out the comparer
---
src/Compiler/Utilities/TypeHashing.fs | 44 +++++++++++++++++++++++----
1 file changed, 38 insertions(+), 6 deletions(-)
diff --git a/src/Compiler/Utilities/TypeHashing.fs b/src/Compiler/Utilities/TypeHashing.fs
index 7639f2dd679..1d847180e80 100644
--- a/src/Compiler/Utilities/TypeHashing.fs
+++ b/src/Compiler/Utilities/TypeHashing.fs
@@ -329,15 +329,47 @@ module HashTastMemberOrVals =
hashNonMemberVal (g, obs) (tps, vref.Deref, tau, cxs)
| Some _ -> hashMember (g, obs) emptyTyparInst vref.Deref
+/// Practical TType comparer strictly for the use with cache keys.
module HashStamps =
- let rec stampEquals ty1 ty2 =
+ let rec typeInstStampsEqual (tys1: TypeInst) (tys2: TypeInst) =
+ tys1.Length = tys2.Length
+ && (tys1, tys2) ||> Seq.zip |> Seq.forall (fun (t1, t2) -> stampEquals t1 t2)
+
+ and inline typarStampEquals (t1: Typar) (t2: Typar) = t1.Stamp = t2.Stamp
+
+ and typarsStampsEqual (tps1: Typars) (tps2: Typars) =
+ tps1.Length = tps2.Length && (tps1, tps2) ||> Seq.forall2 typarStampEquals
+
+ and measureStampEquals (m1: Measure) (m2: Measure) =
+ match m1, m2 with
+ | Measure.Var(mv1), Measure.Var(mv2) -> mv1.Stamp = mv2.Stamp
+ | Measure.Const(t1, _), Measure.Const(t2, _) -> t1.Stamp = t2.Stamp
+ | Measure.Prod(m1, m2, _), Measure.Prod(m3, m4, _) -> measureStampEquals m1 m3 && measureStampEquals m2 m4
+ | Measure.Inv m1, Measure.Inv m2 -> measureStampEquals m1 m2
+ | Measure.One _, Measure.One _ -> true
+ | Measure.RationalPower(m1, r1), Measure.RationalPower(m2, r2) -> r1 = r2 && measureStampEquals m1 m2
+ | _ -> false
+
+ and nullnessEquals (n1: Nullness) (n2: Nullness) =
+ match n1, n2 with
+ | Nullness.Known n1, Nullness.Known n2 -> n1 = n2
+ | Nullness.Variable _, Nullness.Variable _ -> true
+ | _ -> false
+
+ and stampEquals ty1 ty2 =
match ty1, ty2 with
- | TType_app(tcref1, tinst1, _), TType_app(tcref2, tinst2, _) ->
+ | TType_ucase(u, tys1), TType_ucase(v, tys2) -> u.CaseName = v.CaseName && typeInstStampsEqual tys1 tys2
+ | TType_app(tcref1, tinst1, Nullness.Known n1), TType_app(tcref2, tinst2, Nullness.Known n2) ->
+ n1 = n2 && tcref1.Stamp = tcref2.Stamp && typeInstStampsEqual tinst1 tinst2
+ | TType_app(tcref1, tinst1, n1), TType_app(tcref2, tinst2, n2) ->
tcref1.Stamp = tcref2.Stamp
- && tinst1.Length = tinst2.Length
- && (tinst1, tinst2) ||> Seq.zip |> Seq.forall (fun (t1, t2) -> stampEquals t1 t2)
-
- | TType_var(r1, _), TType_var(r2, _) -> r1.Stamp = r2.Stamp
+ && nullnessEquals n1 n2
+ && typeInstStampsEqual tinst1 tinst2
+ | TType_anon(info1, tys1), TType_anon(info2, tys2) -> info1.Stamp = info2.Stamp && typeInstStampsEqual tys1 tys2
+ | TType_tuple(c1, tys1), TType_tuple(c2, tys2) -> c1 = c2 && typeInstStampsEqual tys1 tys2
+ | TType_forall(tps1, tau1), TType_forall(tps2, tau2) -> typarsStampsEqual tps1 tps2 && stampEquals tau1 tau2
+ | TType_var(r1, n1), TType_var(r2, n2) -> r1.Stamp = r2.Stamp && nullnessEquals n1 n2
+ | TType_measure m1, TType_measure m2 -> measureStampEquals m1 m2
| _ -> false
let inline hashStamp (x: int64) = uint x * 2654435761u |> int
From a269b6afb21575d8337463f03c376ce29d2d8047 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Thu, 24 Apr 2025 17:10:41 +0200
Subject: [PATCH 06/28] fix sources
---
src/Compiler/FSharp.Compiler.Service.fsproj | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj
index 9754dd25a11..bbddf424684 100644
--- a/src/Compiler/FSharp.Compiler.Service.fsproj
+++ b/src/Compiler/FSharp.Compiler.Service.fsproj
@@ -146,8 +146,8 @@
-
-
+
+
From 874d9c1a84c346aaed191741f88ac36987617258 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Thu, 24 Apr 2025 23:53:20 +0200
Subject: [PATCH 07/28] try to deal with CI memory overload
---
src/Compiler/Checking/import.fs | 4 +-
src/Compiler/Utilities/Caches.fs | 48 +++++++++++--------
src/Compiler/Utilities/Caches.fsi | 7 +--
tests/FSharp.Test.Utilities/XunitHelpers.fs | 10 +++-
.../src/FSharp.Editor/Common/Logging.fs | 1 +
5 files changed, 44 insertions(+), 26 deletions(-)
diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs
index 649a412bca6..d5e9eeb6852 100644
--- a/src/Compiler/Checking/import.fs
+++ b/src/Compiler/Checking/import.fs
@@ -106,10 +106,10 @@ let getOrCreateTypeSubsumptionCache =
| CompilationMode.OneOff ->
// This is a one-off compilation, so we don't need to worry about eviction.
{ CacheOptions.Default with
- MaximumCapacity = 200_000
+ MaximumCapacity = 4 * 1024
EvictionMethod = EvictionMethod.NoEviction }
| _ ->
- // Oncremental use, so we need to set up the cache with eviction.
+ // Incremental use, so we need to set up the cache with eviction.
{ CacheOptions.Default with
EvictionMethod = EvictionMethod.Background
PercentageToEvict = 5
diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs
index e93d9a168a7..5e7023cd242 100644
--- a/src/Compiler/Utilities/Caches.fs
+++ b/src/Compiler/Utilities/Caches.fs
@@ -10,7 +10,6 @@ open System.Diagnostics.Metrics
[]
type EvictionMethod =
- | Blocking
| Background
| NoEviction
@@ -28,7 +27,7 @@ type CacheOptions =
MaximumCapacity = 1024
PercentageToEvict = 5
LevelOfConcurrency = Environment.ProcessorCount
- EvictionMethod = EvictionMethod.Blocking
+ EvictionMethod = EvictionMethod.Background
}
[]
@@ -219,9 +218,6 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
false
member _.TryAdd(key: 'Key, value: 'Value) =
- if options.EvictionMethod.IsBlocking then
- tryEvictItems ()
-
let cachedEntity = pool.Acquire(key, value)
if store.TryAdd(key, cachedEntity) then
@@ -232,9 +228,6 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
false
member _.AddOrUpdate(key: 'Key, value: 'Value) =
- if options.EvictionMethod.IsBlocking then
- tryEvictItems ()
-
let aquired = pool.Acquire(key, value)
let entity =
@@ -277,17 +270,6 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
override this.Finalize() : unit = this.Dispose()
- static member Create<'Key, 'Value>(options: CacheOptions) =
- // Increase expected capacity by the percentage to evict, since we want to not resize the dictionary.
- let capacity =
- options.MaximumCapacity
- + int (float options.MaximumCapacity * float options.PercentageToEvict / 100.0)
-
- let cts = new CancellationTokenSource()
- let cache = new Cache<'Key, 'Value>(options, capacity, cts)
- CacheInstrumentation.AddInstrumentation cache |> ignore
- cache
-
member this.GetStats() = CacheInstrumentation.GetStats(this)
and CacheInstrumentation(cache: ICacheEvents) =
@@ -382,3 +364,31 @@ and CacheInstrumentation(cache: ICacheEvents) =
static member RemoveInstrumentation(cache: ICacheEvents) =
instrumentedCaches[cache].Dispose()
instrumentedCaches.TryRemove(cache) |> ignore
+
+module Cache =
+
+ // During testing a lot of compilations are started in app domains and subprocesses.
+ // This is a reliable way to pass the override to all of them.
+ []
+ let private overrideVariable = "FSHARP_CACHE_OVERRIDE"
+
+ /// Use for testing purposes to reduce memory consumption in testhost and its subprocesses.
+ let OverrideMaxCapacityForTesting () =
+ Environment.SetEnvironmentVariable(overrideVariable, "true", EnvironmentVariableTarget.Process)
+
+ let Create<'Key, 'Value when 'Key: not null and 'Key: equality> (options: CacheOptions) =
+
+ let options =
+ match Environment.GetEnvironmentVariable(overrideVariable) with
+ | null -> options
+ | _ -> { options with MaximumCapacity = 8 * 1024 }
+
+ // Increase expected capacity by the percentage to evict, since we want to not resize the dictionary.
+ let capacity =
+ options.MaximumCapacity
+ + int (float options.MaximumCapacity * float options.PercentageToEvict / 100.0)
+
+ let cts = new CancellationTokenSource()
+ let cache = new Cache<'Key, 'Value>(options, capacity, cts)
+ CacheInstrumentation.AddInstrumentation cache |> ignore
+ cache
diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi
index c2c8257a0ff..1b3db0174f4 100644
--- a/src/Compiler/Utilities/Caches.fsi
+++ b/src/Compiler/Utilities/Caches.fsi
@@ -5,7 +5,6 @@ open System.Threading
[]
type internal EvictionMethod =
- | Blocking
| Background
| NoEviction
@@ -63,8 +62,6 @@ type internal Cache<'Key, 'Value when 'Key: not null and 'Key: equality> =
member Dispose: unit -> unit
member GetStats: unit -> string
- static member Create<'Key, 'Value> : options: CacheOptions -> Cache<'Key, 'Value>
-
interface ICacheEvents
interface IDisposable
@@ -77,3 +74,7 @@ type internal CacheInstrumentation =
static member GetStatsUpdateForAllCaches: clearCounts: bool -> string
static member AddInstrumentation: cache: ICacheEvents -> unit
static member RemoveInstrumentation: cache: ICacheEvents -> unit
+
+module internal Cache =
+ val OverrideMaxCapacityForTesting: unit -> unit
+ val Create<'Key, 'Value when 'Key: not null and 'Key: equality> : options: CacheOptions -> Cache<'Key, 'Value>
diff --git a/tests/FSharp.Test.Utilities/XunitHelpers.fs b/tests/FSharp.Test.Utilities/XunitHelpers.fs
index c68b2f29a14..902335b6568 100644
--- a/tests/FSharp.Test.Utilities/XunitHelpers.fs
+++ b/tests/FSharp.Test.Utilities/XunitHelpers.fs
@@ -145,6 +145,11 @@ type FSharpXunitFramework(sink: IMessageSink) =
// We need AssemblyResolver already here, because OpenTelemetry loads some assemblies dynamically.
AssemblyResolver.addResolver ()
#endif
+
+ // Override cache capacity to reduce memory usage in CI.
+ FSharp.Compiler.Cache.OverrideMaxCapacityForTesting()
+
+ let testRunName = $"RunTests_{assemblyName.Name} {Runtime.InteropServices.RuntimeInformation.FrameworkDescription}"
// On Windows forwarding localhost to wsl2 docker container sometimes does not work. Use IP address instead.
let otlpEndpoint = Uri("http://127.0.0.1:4317")
@@ -167,7 +172,8 @@ type FSharpXunitFramework(sink: IMessageSink) =
use meterProvider =
OpenTelemetry.Sdk.CreateMeterProviderBuilder()
.AddMeter(nameof FSharp.Compiler.CacheInstrumentation)
- .ConfigureResource(fun r -> r.AddService("F#") |> ignore)
+ .AddMeter("System.Runtime")
+ .ConfigureResource(fun r -> r.AddService(testRunName) |> ignore)
.AddOtlpExporter(fun e m ->
e.Endpoint <- otlpEndpoint
e.Protocol <- OpenTelemetry.Exporter.OtlpExportProtocol.Grpc
@@ -180,7 +186,7 @@ type FSharpXunitFramework(sink: IMessageSink) =
TestConsole.install()
begin
- use _ = Activity.startNoTags $"RunTests_{assemblyName.Name} {Runtime.InteropServices.RuntimeInformation.FrameworkDescription}"
+ use _ = Activity.startNoTags testRunName
// We can't just call base.RunTestCases here, because it's implementation is async void.
use runner = new XunitTestAssemblyRunner (x.TestAssembly, testCases, x.DiagnosticMessageSink, executionMessageSink, executionOptions)
runner.RunAsync().Wait()
diff --git a/vsintegration/src/FSharp.Editor/Common/Logging.fs b/vsintegration/src/FSharp.Editor/Common/Logging.fs
index e8d0e4d5daf..524abb31830 100644
--- a/vsintegration/src/FSharp.Editor/Common/Logging.fs
+++ b/vsintegration/src/FSharp.Editor/Common/Logging.fs
@@ -177,6 +177,7 @@ module FSharpServiceTelemetry =
.CreateMeterProviderBuilder()
.ConfigureResource(fun r -> r.AddService("F#") |> ignore)
.AddMeter(nameof FSharp.Compiler.CacheInstrumentation)
+ .AddMeter("System.Runtime")
.AddOtlpExporter(fun e m ->
e.Endpoint <- otlpEndpoint
m.PeriodicExportingMetricReaderOptions.ExportIntervalMilliseconds <- 1000
From 4bca2df7180309ed68d653dace10004d54b09b4a Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Fri, 25 Apr 2025 02:17:47 +0200
Subject: [PATCH 08/28] replace singleton with CWT again
---
src/Compiler/Checking/import.fs | 43 +++++++++++----------------
src/Compiler/Utilities/TypeHashing.fs | 3 +-
2 files changed, 19 insertions(+), 27 deletions(-)
diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs
index d5e9eeb6852..2138e070001 100644
--- a/src/Compiler/Checking/import.fs
+++ b/src/Compiler/Checking/import.fs
@@ -92,30 +92,23 @@ type TTypeCacheKey =
override this.ToString () = $"{this.ty1.DebugText}-{this.ty2.DebugText}"
-let getOrCreateTypeSubsumptionCache =
- let mutable lockObj = obj()
- let mutable cache = None
-
- fun compilationMode ->
- lock lockObj <| fun () ->
- match cache with
- | Some c -> c
- | _ ->
- let options =
- match compilationMode with
- | CompilationMode.OneOff ->
- // This is a one-off compilation, so we don't need to worry about eviction.
- { CacheOptions.Default with
- MaximumCapacity = 4 * 1024
- EvictionMethod = EvictionMethod.NoEviction }
- | _ ->
- // Incremental use, so we need to set up the cache with eviction.
- { CacheOptions.Default with
- EvictionMethod = EvictionMethod.Background
- PercentageToEvict = 5
- MaximumCapacity = 4 * 32768 }
- cache <- Some (Cache.Create(options))
- cache.Value
+let createTypeSubsumptionCache (g: TcGlobals) =
+ let options =
+ match g.compilationMode with
+ | CompilationMode.OneOff ->
+ // This is a one-off compilation, so we don't need to worry about eviction.
+ { CacheOptions.Default with
+ MaximumCapacity = 4 * 1024
+ EvictionMethod = EvictionMethod.NoEviction }
+ | _ ->
+ // Incremental use, so we need to set up the cache with eviction.
+ { CacheOptions.Default with
+ EvictionMethod = EvictionMethod.Background
+ PercentageToEvict = 5
+ MaximumCapacity = 4 * 32768 }
+ Cache.Create(options)
+
+let typeSubsumptionCaches = ConditionalWeakTable>()
//-------------------------------------------------------------------------
// Import an IL types as F# types.
@@ -139,7 +132,7 @@ type ImportMap(g: TcGlobals, assemblyLoader: AssemblyLoader) =
member _.ILTypeRefToTyconRefCache = typeRefToTyconRefCache
- member val TypeSubsumptionCache: Cache = getOrCreateTypeSubsumptionCache g.compilationMode
+ member val TypeSubsumptionCache: Cache = typeSubsumptionCaches.GetValue(g, createTypeSubsumptionCache)
let CanImportILScopeRef (env: ImportMap) m scoref =
diff --git a/src/Compiler/Utilities/TypeHashing.fs b/src/Compiler/Utilities/TypeHashing.fs
index 1d847180e80..c066a8ece18 100644
--- a/src/Compiler/Utilities/TypeHashing.fs
+++ b/src/Compiler/Utilities/TypeHashing.fs
@@ -332,8 +332,7 @@ module HashTastMemberOrVals =
/// Practical TType comparer strictly for the use with cache keys.
module HashStamps =
let rec typeInstStampsEqual (tys1: TypeInst) (tys2: TypeInst) =
- tys1.Length = tys2.Length
- && (tys1, tys2) ||> Seq.zip |> Seq.forall (fun (t1, t2) -> stampEquals t1 t2)
+ tys1.Length = tys2.Length && (tys1, tys2) ||> Seq.forall2 stampEquals
and inline typarStampEquals (t1: Typar) (t2: Typar) = t1.Stamp = t2.Stamp
From 9ba405d3c64f5228614afb9eade533f3a728acaa Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Fri, 25 Apr 2025 02:18:20 +0200
Subject: [PATCH 09/28] remove sketchy logic
---
src/Compiler/Checking/TypeRelations.fs | 2 +-
src/Compiler/Utilities/Caches.fs | 23 +++++------------------
src/Compiler/Utilities/Caches.fsi | 1 -
3 files changed, 6 insertions(+), 20 deletions(-)
diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs
index fa900069508..fddf6027875 100644
--- a/src/Compiler/Checking/TypeRelations.fs
+++ b/src/Compiler/Checking/TypeRelations.fs
@@ -113,7 +113,7 @@ let inline TryGetCachedTypeSubsumption (g: TcGlobals) (amap: ImportMap) key =
let inline UpdateCachedTypeSubsumption (g: TcGlobals) (amap: ImportMap) key subsumes : unit =
if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
- amap.TypeSubsumptionCache.AddOrUpdate(key, subsumes)
+ 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) =
diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs
index 5e7023cd242..b2ce43985e5 100644
--- a/src/Compiler/Utilities/Caches.fs
+++ b/src/Compiler/Utilities/Caches.fs
@@ -114,7 +114,10 @@ type EvictionQueue<'Key, 'Value>() =
<| fun () -> list |> Seq.map _.Key |> Seq.truncate count |> Seq.toArray
member this.Remove(entity: CachedEntity<_, _>) =
- lock list <| fun () -> list.Remove(entity.Node)
+ lock list
+ <| fun () ->
+ if entity.Node.List = list then
+ list.Remove(entity.Node)
member _.Count = list.Count
@@ -227,22 +230,6 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
pool.Reclaim(cachedEntity)
false
- member _.AddOrUpdate(key: 'Key, value: 'Value) =
- let aquired = pool.Acquire(key, value)
-
- let entity =
- store.AddOrUpdate(
- key,
- (fun _ -> aquired),
- (fun _ (current: CachedEntity<_, _>) ->
- pool.Reclaim aquired
- current.Value <- value
- evictionQueue.Remove(current)
- current)
- )
-
- evictionQueue.Add(entity)
-
interface ICacheEvents with
[]
@@ -381,7 +368,7 @@ module Cache =
let options =
match Environment.GetEnvironmentVariable(overrideVariable) with
| null -> options
- | _ -> { options with MaximumCapacity = 8 * 1024 }
+ | _ -> { options with MaximumCapacity = 1024 }
// Increase expected capacity by the percentage to evict, since we want to not resize the dictionary.
let capacity =
diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi
index 1b3db0174f4..22785871114 100644
--- a/src/Compiler/Utilities/Caches.fsi
+++ b/src/Compiler/Utilities/Caches.fsi
@@ -58,7 +58,6 @@ type internal Cache<'Key, 'Value when 'Key: not null and 'Key: equality> =
new: options: CacheOptions * capacity: int * cts: CancellationTokenSource -> Cache<'Key, 'Value>
member TryGetValue: key: 'Key * value: outref<'Value> -> bool
member TryAdd: key: 'Key * value: 'Value -> bool
- member AddOrUpdate: key: 'Key * value: 'Value -> unit
member Dispose: unit -> unit
member GetStats: unit -> string
From 5c6a5005ad4049a8668374e60edee736275c542a Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Fri, 25 Apr 2025 14:08:07 +0200
Subject: [PATCH 10/28] cache of caches deal with memory restrictions in CI,
dispose caches
---
src/Compiler/Checking/import.fs | 7 +++++--
src/Compiler/Utilities/Caches.fs | 28 ++++++++++++++++++++--------
src/Compiler/Utilities/Caches.fsi | 6 +++++-
3 files changed, 30 insertions(+), 11 deletions(-)
diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs
index 2138e070001..de21f7ae7f3 100644
--- a/src/Compiler/Checking/import.fs
+++ b/src/Compiler/Checking/import.fs
@@ -108,7 +108,9 @@ let createTypeSubsumptionCache (g: TcGlobals) =
MaximumCapacity = 4 * 32768 }
Cache.Create(options)
-let typeSubsumptionCaches = ConditionalWeakTable>()
+let typeSubsumptionCaches = Cache.Create>({ CacheOptions.Default with MaximumCapacity = 16 })
+
+do typeSubsumptionCaches.ValueEvicted.Add <| _.Dispose()
//-------------------------------------------------------------------------
// Import an IL types as F# types.
@@ -132,7 +134,8 @@ type ImportMap(g: TcGlobals, assemblyLoader: AssemblyLoader) =
member _.ILTypeRefToTyconRefCache = typeRefToTyconRefCache
- member val TypeSubsumptionCache: Cache = typeSubsumptionCaches.GetValue(g, createTypeSubsumptionCache)
+ member val TypeSubsumptionCache: Cache =
+ typeSubsumptionCaches.GetOrCreate(g, createTypeSubsumptionCache)
let CanImportILScopeRef (env: ImportMap) m scoref =
diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs
index b2ce43985e5..b3c5495b38f 100644
--- a/src/Compiler/Utilities/Caches.fs
+++ b/src/Compiler/Utilities/Caches.fs
@@ -5,9 +5,12 @@ open System
open System.Collections.Generic
open System.Collections.Concurrent
open System.Threading
+open System.Threading.Tasks
open System.Diagnostics
open System.Diagnostics.Metrics
+open FSharp.Compiler.Diagnostics
+
[]
type EvictionMethod =
| Background
@@ -154,7 +157,7 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
let cacheHit = Event()
let cacheMiss = Event()
- let eviction = Event()
+ let eviction = Event<'Value>()
let evictionFail = Event()
let overCapacity = Event()
@@ -181,7 +184,7 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
| true, removed ->
evictionQueue.Remove(removed)
pool.Reclaim(removed)
- eviction.Trigger()
+ eviction.Trigger(removed.Value)
| _ ->
failwith "eviction fail"
evictionFail.Trigger()
@@ -230,6 +233,17 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
pool.Reclaim(cachedEntity)
false
+ member this.GetOrCreate(key: 'Key, valueFactory: 'Key -> 'Value) =
+ match this.TryGetValue(key) with
+ | true, value -> value
+ | _ ->
+ let value = valueFactory key
+ this.TryAdd(key, value) |> ignore
+ value
+
+ []
+ member val ValueEvicted = eviction.Publish
+
interface ICacheEvents with
[]
@@ -239,7 +253,7 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
member val CacheMiss = cacheMiss.Publish
[]
- member val Eviction = eviction.Publish
+ member val Eviction = eviction.Publish |> Event.map ignore
[]
member val EvictionFail = evictionFail.Publish
@@ -249,14 +263,12 @@ type Cache<'Key, 'Value when 'Key: not null and 'Key: equality> internal (option
interface IDisposable with
member this.Dispose() =
+ store.Clear()
cts.Cancel()
CacheInstrumentation.RemoveInstrumentation(this)
- GC.SuppressFinalize(this)
member this.Dispose() = (this :> IDisposable).Dispose()
- override this.Finalize() : unit = this.Dispose()
-
member this.GetStats() = CacheInstrumentation.GetStats(this)
and CacheInstrumentation(cache: ICacheEvents) =
@@ -367,8 +379,8 @@ module Cache =
let options =
match Environment.GetEnvironmentVariable(overrideVariable) with
- | null -> options
- | _ -> { options with MaximumCapacity = 1024 }
+ | NonNull _ when options.MaximumCapacity > 1024 -> { options with MaximumCapacity = 1024 }
+ | _ -> options
// Increase expected capacity by the percentage to evict, since we want to not resize the dictionary.
let capacity =
diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi
index 22785871114..c382c141131 100644
--- a/src/Compiler/Utilities/Caches.fsi
+++ b/src/Compiler/Utilities/Caches.fsi
@@ -58,8 +58,12 @@ type internal Cache<'Key, 'Value when 'Key: not null and 'Key: equality> =
new: options: CacheOptions * capacity: int * cts: CancellationTokenSource -> Cache<'Key, 'Value>
member TryGetValue: key: 'Key * value: outref<'Value> -> bool
member TryAdd: key: 'Key * value: 'Value -> bool
- member Dispose: unit -> unit
+ member GetOrCreate: key: 'Key * valueFactory: ('Key -> 'Value) -> 'Value
member GetStats: unit -> string
+ member Dispose: unit -> unit
+
+ []
+ member ValueEvicted: IEvent<'Value>
interface ICacheEvents
interface IDisposable
From 3046f881d99fe422e2e4e1a6f75e8f9306772922 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Fri, 25 Apr 2025 15:03:51 +0200
Subject: [PATCH 11/28] ilver
---
src/Compiler/Utilities/Caches.fs | 16 +++++++++++-----
...rify_FSharp.Compiler.Service_Debug_net9.0.bsl | 12 ++++++------
...arp.Compiler.Service_Debug_netstandard2.0.bsl | 12 ++++++------
...fy_FSharp.Compiler.Service_Release_net9.0.bsl | 12 ++++++------
...p.Compiler.Service_Release_netstandard2.0.bsl | 12 ++++++------
5 files changed, 35 insertions(+), 29 deletions(-)
diff --git a/src/Compiler/Utilities/Caches.fs b/src/Compiler/Utilities/Caches.fs
index b3c5495b38f..0bb849310b7 100644
--- a/src/Compiler/Utilities/Caches.fs
+++ b/src/Compiler/Utilities/Caches.fs
@@ -375,13 +375,19 @@ module Cache =
let OverrideMaxCapacityForTesting () =
Environment.SetEnvironmentVariable(overrideVariable, "true", EnvironmentVariableTarget.Process)
- let Create<'Key, 'Value when 'Key: not null and 'Key: equality> (options: CacheOptions) =
-
- let options =
+ let applyOverride (options: CacheOptions) =
+ let capacity =
match Environment.GetEnvironmentVariable(overrideVariable) with
- | NonNull _ when options.MaximumCapacity > 1024 -> { options with MaximumCapacity = 1024 }
- | _ -> options
+ | NonNull _ when options.MaximumCapacity < 100 -> 3
+ | NonNull _ -> 512
+ | _ -> options.MaximumCapacity
+ { options with
+ MaximumCapacity = capacity
+ }
+
+ let Create<'Key, 'Value when 'Key: not null and 'Key: equality> (options: CacheOptions) =
+ let options = applyOverride options
// Increase expected capacity by the percentage to evict, since we want to not resize the dictionary.
let capacity =
options.MaximumCapacity
diff --git a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_net9.0.bsl b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_net9.0.bsl
index bd581b3d765..72270ed5f02 100644
--- a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_net9.0.bsl
+++ b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_net9.0.bsl
@@ -21,14 +21,14 @@
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CodeAnalysis.Hosted.CompilerHelpers::fscCompile([FSharp.Compiler.Service]FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver, string, string[])][offset 0x00000082][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CodeAnalysis.Hosted.CompilerHelpers::fscCompile([FSharp.Compiler.Service]FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver, string, string[])][offset 0x0000008B][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+MagicAssemblyResolution::ResolveAssemblyCore([FSharp.Compiler.Service]Internal.Utilities.Library.CompilationThreadToken, [FSharp.Compiler.Service]FSharp.Compiler.Text.Range, [FSharp.Compiler.Service]FSharp.Compiler.CompilerConfig+TcConfigBuilder, [FSharp.Compiler.Service]FSharp.Compiler.CompilerImports+TcImports, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiDynamicCompiler, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiConsoleOutput, string)][offset 0x00000015][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-812::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001E5][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-817::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001E5][found Char] Unexpected type on the stack.
[IL]: Error [UnmanagedPointer]: : FSharp.Compiler.Interactive.Shell+Utilities+pointerToNativeInt@110::Invoke(object)][offset 0x00000007] Unmanaged pointers are not a verifiable type.
[IL]: Error [StackUnexpected]: : .$FSharpCheckerResults+dataTipOfReferences@2225::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000084][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000082][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000008B][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000094][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-521::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-521::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-521::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000082][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-521::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000008B][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-521::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000094][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.StaticLinking+TypeForwarding::followTypeForwardForILTypeRef([FSharp.Compiler.Service]FSharp.Compiler.AbstractIL.IL+ILTypeRef)][offset 0x00000010][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CompilerOptions::getCompilerOption([FSharp.Compiler.Service]FSharp.Compiler.CompilerOptions+CompilerOption, [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1)][offset 0x000000E6][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CompilerOptions::AddPathMapping([FSharp.Compiler.Service]FSharp.Compiler.CompilerConfig+TcConfigBuilder, string)][offset 0x0000000B][found Char] Unexpected type on the stack.
diff --git a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl
index 752b1e98415..841c59db0d6 100644
--- a/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl
+++ b/tests/ILVerify/ilverify_FSharp.Compiler.Service_Debug_netstandard2.0.bsl
@@ -28,18 +28,18 @@
[IL]: Error [StackUnexpected]: : FSharp.Compiler.CodeAnalysis.Hosted.CompilerHelpers::fscCompile([FSharp.Compiler.Service]FSharp.Compiler.CodeAnalysis.LegacyReferenceResolver, string, string[])][offset 0x0000008B][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+FsiStdinSyphon::GetLine(string, int32)][offset 0x00000039][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+MagicAssemblyResolution::ResolveAssemblyCore([FSharp.Compiler.Service]Internal.Utilities.Library.CompilationThreadToken, [FSharp.Compiler.Service]FSharp.Compiler.Text.Range, [FSharp.Compiler.Service]FSharp.Compiler.CompilerConfig+TcConfigBuilder, [FSharp.Compiler.Service]FSharp.Compiler.CompilerImports+TcImports, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiDynamicCompiler, [FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiConsoleOutput, string)][offset 0x00000015][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-812::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001E5][found Char] Unexpected type on the stack.
+[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+clo@3502-817::Invoke([S.P.CoreLib]System.Tuple`3)][offset 0x000001E5][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.Interactive.Shell+FsiInteractionProcessor::CompletionsForPartialLID([FSharp.Compiler.Service]FSharp.Compiler.Interactive.Shell+FsiDynamicCompilerState, string)][offset 0x0000001B][found Char] Unexpected type on the stack.
[IL]: Error [UnmanagedPointer]: : FSharp.Compiler.Interactive.Shell+Utilities+pointerToNativeInt@110::Invoke(object)][offset 0x00000007] Unmanaged pointers are not a verifiable type.
[IL]: Error [StackUnexpected]: : .$FSharpCheckerResults+dataTipOfReferences@2225::Invoke([FSharp.Core]Microsoft.FSharp.Core.Unit)][offset 0x00000084][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.EditorServices.AssemblyContent+traverseMemberFunctionAndValues@176::Invoke([FSharp.Compiler.Service]FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue)][offset 0x00000059][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.EditorServices.AssemblyContent+traverseEntity@218::GenerateNext([S.P.CoreLib]System.Collections.Generic.IEnumerable`1&)][offset 0x000000DA][found Char] Unexpected type on the stack.
[IL]: Error [StackUnexpected]: : FSharp.Compiler.EditorServices.ParsedInput+visitor@1424-6::VisitExpr([FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1, [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, [FSharp.Compiler.Service]FSharp.Compiler.Syntax.SynExpr)][offset 0x00000605][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000032][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x0000003B][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,Microsoft.FSharp.Core.Unit>)][offset 0x00000082][found Char] Unexpected type on the stack.
-[IL]: Error [StackUnexpected]: : .$ServiceLexing+clo@921-516::Invoke([FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2