Enable TypeSubsumptionCache for IDE use

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

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 [<Struct; NoComparison; CustomEquality>] TTypeCacheKey =
+[<Struct; NoComparison; CustomEquality; DebuggerDisplay("{ToString()}")>]
+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<TTypeCacheKey> with
         member this.Equals other =
@@ -72,23 +77,46 @@ type [<Struct; NoComparison; CustomEquality>] 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
         | :? TTypeCacheKey as p -> (this :> System.IEquatable<TTypeCacheKey>).Equals p
         | _ -> 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<TTypeCacheKey, bool>(options))
+                cache.Value
 
 //-------------------------------------------------------------------------
 // Import an IL types as F# types.
@@ -106,15 +134,13 @@ type [<Struct; NoComparison; CustomEquality>] TTypeCacheKey =
 type ImportMap(g: TcGlobals, assemblyLoader: AssemblyLoader) =
     let typeRefToTyconRefCache = ConcurrentDictionary<ILTypeRef, TyconRef>()
 
-    let typeSubsumptionCache = ConcurrentDictionary<TTypeCacheKey, bool>(System.Environment.ProcessorCount, 1024)
-
     member _.g = g
 
     member _.assemblyLoader = assemblyLoader
 
     member _.ILTypeRefToTyconRefCache = typeRefToTyconRefCache
 
-    member _.TypeSubsumptionCache = typeSubsumptionCache
+    member val TypeSubsumptionCache: Cache<TTypeCacheKey, bool> = getOrCreateTypeSubsumptionCache g.compilationMode
 
 let CanImportILScopeRef (env: ImportMap) m scoref =
 

src/Compiler/Checking/import.fsi

@@ -45,15 +45,14 @@ type CanCoerce =
 [<Struct; NoComparison; CustomEquality>]
 type TTypeCacheKey =
     interface System.IEquatable<TTypeCacheKey>
-    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<TTypeCacheKey, bool>
+    member TypeSubsumptionCache: Cache<TTypeCacheKey, bool>
 
 module Nullness =
 

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -146,6 +146,8 @@
     <Compile Include="Utilities\lib.fsi" />
     <Compile Include="Utilities\lib.fs" />
     <Compile Include="Utilities\DependencyGraph.fs" />
+    <Compile Include="utilities\Caches.fsi" />
+    <Compile Include="utilities\Caches.fs" />
     <Compile Include="Utilities\LruCache.fsi" />
     <Compile Include="Utilities\LruCache.fs" />
     <Compile Include="Utilities\ImmutableArray.fsi" />