Type subsumption cache, fix keys to reduce memory use

azure-pipelines-PR.yml

@@ -457,13 +457,11 @@ stages:
                 _configuration: Release
                 _testKind: testFSharpQA
                 transparentCompiler:
-                FSHARP_CACHE_OVERRIDE: 256
               vs_release:
                 _configuration: Release
                 _testKind: testVs
                 setupVsHive: true
                 transparentCompiler:
-                FSHARP_CACHE_OVERRIDE: 256
               transparent_compiler_release:
                 _configuration: Release
                 _testKind: testCoreclr

src/Compiler/Checking/TypeRelations.fs

@@ -7,6 +7,7 @@ module internal FSharp.Compiler.TypeRelations
 open FSharp.Compiler.Features
 open Internal.Utilities.Collections
 open Internal.Utilities.Library
+open Internal.Utilities.TypeHashing.StructuralUtilities
 
 open FSharp.Compiler.DiagnosticsLogger
 open FSharp.Compiler.TcGlobals
@@ -19,6 +20,26 @@ open Import
 
 #nowarn "3391"
 
+[<Struct; NoComparison>]
+type CanCoerce =
+    | CanCoerce
+    | NoCoerce
+
+[<Struct; NoComparison>]
+type TTypeCacheKey =
+    | TTypeCacheKey of TypeStructure * TypeStructure * CanCoerce
+    static member Create(ty1, ty2, canCoerce) =
+        TTypeCacheKey(getTypeStructure ty1, getTypeStructure ty2, canCoerce)
+
+let getTypeSubsumptionCache =
+    let factory (g: TcGlobals) =
+        let options =
+            match g.compilationMode with
+            | CompilationMode.OneOff -> Caches.CacheOptions.getDefault() |> Caches.CacheOptions.withNoEviction
+            | _ -> { Caches.CacheOptions.getDefault() with TotalCapacity = 65536; HeadroomPercentage = 75 }
+        new Caches.Cache<TTypeCacheKey, bool>(options, "typeSubsumptionCache")
+    Extras.WeakMap.getOrCreate factory     
+
 /// Implements a :> b without coercion based on finalized (no type variable) types
 // Note: This relation is approximate and not part of the language specification.
 //
@@ -136,14 +157,8 @@ let rec TypeFeasiblySubsumesType ndeep (g: TcGlobals) (amap: ImportMap) m (ty1:
                     List.exists (TypeFeasiblySubsumesType (ndeep + 1) g amap m ty1 NoCoerce) interfaces
 
     if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
-        let key = TTypeCacheKey.FromStrippedTypes (ty1, ty2, canCoerce)
-
-        match amap.TypeSubsumptionCache.TryGetValue(key) with
-        | true, subsumes -> subsumes
-        | false, _ ->
-            let subsumes = checkSubsumes ty1 ty2
-            amap.TypeSubsumptionCache.TryAdd(key, subsumes) |> ignore
-            subsumes
+        let key = TTypeCacheKey.Create(ty1, ty2, canCoerce)
+        (getTypeSubsumptionCache g).GetOrAdd(key, fun _ -> checkSubsumes ty1 ty2)
     else
         checkSubsumes ty1 ty2
 

src/Compiler/Checking/TypeRelations.fsi

@@ -9,6 +9,11 @@ open FSharp.Compiler.TcGlobals
 open FSharp.Compiler.Text
 open FSharp.Compiler.TypedTree
 
+[<Struct; NoComparison>]
+type CanCoerce =
+    | CanCoerce
+    | NoCoerce
+
 /// Implements a :> b without coercion based on finalized (no type variable) types
 val TypeDefinitelySubsumesTypeNoCoercion:
     ndeep: int -> g: TcGlobals -> amap: ImportMap -> m: range -> ty1: TType -> ty2: TType -> bool

src/Compiler/Checking/import.fs

@@ -50,51 +50,6 @@ type AssemblyLoader =
     abstract RecordGeneratedTypeRoot : ProviderGeneratedType -> unit
 #endif
 
-[<Struct; NoComparison>]
-type CanCoerce =
-    | CanCoerce
-    | NoCoerce
-
-[<Struct; NoComparison; CustomEquality; DebuggerDisplay("{ToString()}")>]
-type TTypeCacheKey =
-
-    val ty1: TType
-    val ty2: TType
-    val canCoerce: CanCoerce
-
-    private new (ty1, ty2, canCoerce) =
-        { ty1 = ty1; ty2 = ty2; canCoerce = canCoerce }
-
-    static member FromStrippedTypes (ty1, ty2, canCoerce) =
-        TTypeCacheKey(ty1, ty2, canCoerce)
-
-    interface System.IEquatable<TTypeCacheKey> with
-        member this.Equals other =
-            if this.canCoerce <> other.canCoerce then
-                false
-            elif this.ty1 === other.ty1 && this.ty2 === other.ty2 then
-                true
-            else
-                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 =
-        HashStamps.hashTType this.ty1
-        |> pipeToHash (HashStamps.hashTType this.ty2)
-        |> pipeToHash (hash this.canCoerce)
-
-    override this.ToString () = $"{this.ty1.DebugText}-{this.ty2.DebugText}"
-
-let typeSubsumptionCache =
-    // Leave most of the capacity in reserve for bursts.
-    let options = { CacheOptions.getDefault() with TotalCapacity = 131072; HeadroomPercentage = 75 }
-    lazy new Cache<TTypeCacheKey, bool>(options, "typeSubsumptionCache")
-
 //-------------------------------------------------------------------------
 // Import an IL types as F# types.
 //-------------------------------------------------------------------------
@@ -117,8 +72,6 @@ type ImportMap(g: TcGlobals, assemblyLoader: AssemblyLoader) =
 
     member _.ILTypeRefToTyconRefCache = typeRefToTyconRefCache
 
-    member val TypeSubsumptionCache: Cache<TTypeCacheKey, bool> = typeSubsumptionCache.Value
-
 let CanImportILScopeRef (env: ImportMap) m scoref =
 
     let isResolved assemblyRef =

src/Compiler/Checking/import.fsi

@@ -36,24 +36,6 @@ type AssemblyLoader =
     abstract RecordGeneratedTypeRoot: ProviderGeneratedType -> unit
 #endif
 
-[<Struct; NoComparison>]
-type CanCoerce =
-    | CanCoerce
-    | NoCoerce
-
-[<Struct; NoComparison; CustomEquality>]
-type TTypeCacheKey =
-    interface System.IEquatable<TTypeCacheKey>
-    private new: ty1: TType * ty2: TType * canCoerce: CanCoerce -> TTypeCacheKey
-
-    static member FromStrippedTypes: ty1: TType * ty2: TType * canCoerce: CanCoerce -> TTypeCacheKey
-
-    val ty1: TType
-    val ty2: TType
-    val canCoerce: CanCoerce
-
-    override GetHashCode: unit -> int
-
 /// Represents a context used for converting AbstractIL .NET and provided types to F# internal compiler data structures.
 /// Also cache the conversion of AbstractIL ILTypeRef nodes, based on hashes of these.
 ///
@@ -70,9 +52,6 @@ type ImportMap =
     /// The TcGlobals for the import context
     member g: TcGlobals
 
-    /// Type subsumption cache
-    member TypeSubsumptionCache: Cache<TTypeCacheKey, bool>
-
 module Nullness =
 
     [<Struct; NoEquality; NoComparison>]

src/Compiler/Service/FSharpCheckerResults.fs

@@ -538,7 +538,7 @@ type internal TypeCheckInfo
                         // check that type of value is the same or subtype of tcref
                         // yes - allow access to protected members
                         // no - strip ability to access protected members
-                        if TypeRelations.TypeFeasiblySubsumesType 0 g amap m thisTy Import.CanCoerce ty then
+                        if TypeRelations.TypeFeasiblySubsumesType 0 g amap m thisTy TypeRelations.CanCoerce ty then
                             ad
                         else
                             AccessibleFrom(paths, None)

src/Compiler/Utilities/Caches.fs

@@ -118,21 +118,6 @@ module CacheOptions =
             CacheOptions.EvictionMode = EvictionMode.NoEviction
         }
 
-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.
-    [<Literal>]
-    let private overrideVariable = "FSHARP_CACHE_OVERRIDE"
-
-    /// Use for testing purposes to reduce memory consumption in testhost and its subprocesses.
-    let OverrideCapacityForTesting () =
-        Environment.SetEnvironmentVariable(overrideVariable, "4096", EnvironmentVariableTarget.Process)
-
-    let applyOverride (options: CacheOptions<_>) =
-        match Int32.TryParse(Environment.GetEnvironmentVariable(overrideVariable)) with
-        | true, n when options.TotalCapacity > n -> { options with TotalCapacity = n }
-        | _ -> options
-
 // It is important that this is not a struct, because LinkedListNode holds a reference to it,
 // and it holds the reference to that Node, in a circular way.
 [<Sealed; NoComparison; NoEquality>]
@@ -176,8 +161,6 @@ type Cache<'Key, 'Value when 'Key: not null> internal (options: CacheOptions<'Ke
         if options.HeadroomPercentage < 0 then
             invalidArg "HeadroomPercentage" "HeadroomPercentage must be positive"
 
-    let options = Cache.applyOverride options
-
     let name = defaultArg name (Guid.NewGuid().ToString())
 
     // Determine evictable headroom as the percentage of total capcity, since we want to not resize the dictionary.

src/Compiler/Utilities/Caches.fsi

@@ -49,10 +49,6 @@ module internal CacheOptions =
     /// Set eviction mode to NoEviction.
     val withNoEviction: CacheOptions<'Key> -> CacheOptions<'Key>
 
-module internal Cache =
-    /// Use for testing purposes to reduce memory consumption in testhost and its subprocesses.
-    val OverrideCapacityForTesting: unit -> unit
-
 [<Sealed; NoComparison; NoEquality>]
 type internal Cache<'Key, 'Value when 'Key: not null> =
     new: options: CacheOptions<'Key> * ?name: string -> Cache<'Key, 'Value>