diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index b8a0efd14a..6a17b25136 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/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 diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 32b04b8c90..fdca4495fd 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/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( + "rawDataValueTypeGenerator", (fun (cloc, size) -> let name = CompilerGeneratedName("T" + string (newUnique ()) + "_" + string size + "Bytes") // Type names ending ...$T_37Bytes diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 5db9b2e1b2..a249c5d2bb 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -114,6 +114,8 @@ + + @@ -147,8 +149,6 @@ - - diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index ee5a3c3867..9999b80160 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -687,7 +687,7 @@ type TcGlobals( // Build the memoization table for files let v_memoize_file = - MemoizationTable(compute, keyComparer = HashIdentity.Structural) + MemoizationTable("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)) diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 470d7402e0..aa83558632 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -11,6 +11,8 @@ open System.Threading open System.Threading.Tasks open System.Runtime.CompilerServices +open FSharp.Compiler.Caches + [] 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 diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index e2fba35536..654a7259d8 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/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