collect metrics from MemoizationTables (#18936)

Author: majocha

src/Compiler/Checking/InfoReader.fs

@@ -727,9 +727,9 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this =
     /// Make a cache for function 'f' keyed by type (plus some additional 'flags') that only 
     /// caches computations for monomorphic types.
 
-    let MakeInfoCache f (flagsEq : IEqualityComparer<_>) = 
+    let MakeInfoCache name f (flagsEq : IEqualityComparer<_>) = 
         MemoizationTable<_, _>
-             (compute=f,
+             (name, compute=f,
               // Only cache closed, monomorphic types (closed = all members for the type
               // have been processed). Generic type instantiations could be processed if we had 
               // a decent hash function for these.
@@ -803,18 +803,18 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this =
                member _.GetHashCode((ad, nm)) = AccessorDomain.CustomGetHashCode ad + hash nm
                member _.Equals((ad1, nm1), (ad2, nm2)) = AccessorDomain.CustomEquals(g, ad1, ad2) && (nm1 = nm2) }
 
-    let methodInfoCache = MakeInfoCache GetIntrinsicMethodSetsUncached hashFlags0
-    let propertyInfoCache = MakeInfoCache GetIntrinsicPropertySetsUncached hashFlags0
-    let recdOrClassFieldInfoCache =  MakeInfoCache GetIntrinsicRecdOrClassFieldInfosUncached hashFlags1
-    let ilFieldInfoCache = MakeInfoCache GetIntrinsicILFieldInfosUncached hashFlags1
-    let eventInfoCache = MakeInfoCache GetIntrinsicEventInfosUncached hashFlags1
-    let namedItemsCache = MakeInfoCache GetIntrinsicNamedItemsUncached hashFlags2
-    let mostSpecificOverrideMethodInfoCache = MakeInfoCache GetIntrinsicMostSpecificOverrideMethodSetsUncached hashFlags0
-
-    let entireTypeHierarchyCache = MakeInfoCache GetEntireTypeHierarchyUncached HashIdentity.Structural
-    let primaryTypeHierarchyCache = MakeInfoCache GetPrimaryTypeHierarchyUncached HashIdentity.Structural
-    let implicitConversionCache = MakeInfoCache FindImplicitConversionsUncached hashFlags3
-    let isInterfaceWithStaticAbstractMethodCache = MakeInfoCache IsInterfaceTypeWithMatchingStaticAbstractMemberUncached hashFlags4
+    let methodInfoCache = MakeInfoCache "methodInfoCache" GetIntrinsicMethodSetsUncached hashFlags0
+    let propertyInfoCache = MakeInfoCache "propertyInfoCache" GetIntrinsicPropertySetsUncached hashFlags0
+    let recdOrClassFieldInfoCache =  MakeInfoCache "recdOrClassFieldInfoCache" GetIntrinsicRecdOrClassFieldInfosUncached hashFlags1
+    let ilFieldInfoCache = MakeInfoCache "ilFieldInfoCache" GetIntrinsicILFieldInfosUncached hashFlags1
+    let eventInfoCache = MakeInfoCache "eventInfoCache" GetIntrinsicEventInfosUncached hashFlags1
+    let namedItemsCache = MakeInfoCache "namedItemsCache" GetIntrinsicNamedItemsUncached hashFlags2
+    let mostSpecificOverrideMethodInfoCache = MakeInfoCache "mostSpecificOverrideMethodInfoCache" GetIntrinsicMostSpecificOverrideMethodSetsUncached hashFlags0
+
+    let entireTypeHierarchyCache = MakeInfoCache "entireTypeHierarchyCache" GetEntireTypeHierarchyUncached HashIdentity.Structural
+    let primaryTypeHierarchyCache = MakeInfoCache "primaryTypeHierarchyCache" GetPrimaryTypeHierarchyUncached HashIdentity.Structural
+    let implicitConversionCache = MakeInfoCache "implicitConversionCache" FindImplicitConversionsUncached hashFlags3
+    let isInterfaceWithStaticAbstractMethodCache = MakeInfoCache "isInterfaceWithStaticAbstractMethodCache" IsInterfaceTypeWithMatchingStaticAbstractMemberUncached hashFlags4
 
     // Runtime feature support
 

src/Compiler/CodeGen/IlxGen.fs

@@ -2334,6 +2334,7 @@ and AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf
     // A memoization table for generating value types for big constant arrays
     let rawDataValueTypeGenerator =
         MemoizationTable<CompileLocation * int, ILTypeSpec>(
+            "rawDataValueTypeGenerator",
             (fun (cloc, size) ->
                 let name =
                     CompilerGeneratedName("T" + string (newUnique ()) + "_" + string size + "Bytes") // Type names ending ...$T<unique>_37Bytes

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -114,6 +114,8 @@
     </EmbeddedResource>
     <Compile Include="Utilities\Activity.fsi" />
     <Compile Include="Utilities\Activity.fs" />
+	<Compile Include="Utilities\Caches.fsi" />
+    <Compile Include="Utilities\Caches.fs" />
     <Compile Include="Utilities\illib.fsi" />
     <Compile Include="Utilities\illib.fs" />
     <Compile Include="Utilities\sformat.fsi" />
@@ -147,8 +149,6 @@
     <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" />

src/Compiler/TypedTree/TcGlobals.fs

@@ -687,7 +687,7 @@ type TcGlobals(
 
   // Build the memoization table for files
   let v_memoize_file =
-      MemoizationTable<int, ILSourceDocument>(compute, keyComparer = HashIdentity.Structural)
+      MemoizationTable<int, ILSourceDocument>("v_memoize_file", compute, keyComparer = HashIdentity.Structural)
 
   let v_and_info =                   makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref,                    CompileOpName "&"                      , None                 , None          , [],         mk_rel_sig v_bool_ty)
   let v_addrof_info =                makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref,                    CompileOpName "~&"                     , None                 , None          , [vara],     ([[varaTy]], mkByrefTy varaTy))

src/Compiler/Utilities/illib.fs

@@ -11,6 +11,8 @@ open System.Threading
 open System.Threading.Tasks
 open System.Runtime.CompilerServices
 
+open FSharp.Compiler.Caches
+
 [<Class>]
 type InterruptibleLazy<'T> private (value, valueFactory: unit -> 'T) =
     let syncObj = obj ()
@@ -950,10 +952,11 @@ type UniqueStampGenerator<'T when 'T: equality and 'T: not null>() =
     member _.Table = encodeTable.Keys
 
 /// memoize tables (all entries cached, never collected)
-type MemoizationTable<'T, 'U when 'T: not null>(compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) =
+type MemoizationTable<'T, 'U when 'T: not null>(name, compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) =
 
-    let table = new ConcurrentDictionary<'T, Lazy<'U>>(keyComparer)
-    let computeFunc = Func<_, _>(fun key -> lazy (compute key))
+    let options = CacheOptions.getDefault keyComparer |> CacheOptions.withNoEviction
+    let table = new Cache<'T, Lazy<'U>>(options, name)
+    let computeFunc key = lazy compute key
 
     member t.Apply x =
         if

src/Compiler/Utilities/illib.fsi

@@ -386,7 +386,8 @@ type internal UniqueStampGenerator<'T when 'T: equality and 'T: not null> =
 type internal MemoizationTable<'T, 'U when 'T: not null> =
 
     new:
-        compute: ('T -> 'U) * keyComparer: IEqualityComparer<'T> * ?canMemoize: ('T -> bool) -> MemoizationTable<'T, 'U>
+        name: string * compute: ('T -> 'U) * keyComparer: IEqualityComparer<'T> * ?canMemoize: ('T -> bool) ->
+            MemoizationTable<'T, 'U>
 
     member Apply: x: 'T -> 'U