Skip to content

Cache more type relations #19107

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 6 commits into
base: main
Choose a base branch
from
+199 −123
Draft

Cache more type relations #19107

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
46a1d33
more type relations caches
majocha Nov 20, 2025
6842fa8
sort stats by name
majocha Nov 20, 2025
d0e9a94
refactor
majocha Nov 20, 2025
3ec4811
naming
majocha Nov 21, 2025
6e08582
Merge branch 'main' into cache-more-relations
majocha Nov 22, 2025
96c5f0e
speed up key generation
majocha Nov 26, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
148 changes: 99 additions & 49 deletions src/Compiler/Checking/TypeRelations.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,27 +25,52 @@ type CanCoerce =
| CanCoerce
| NoCoerce

let tryGetTypeStructure ty =
match ty with
| TType_app _ ->
tryGetTypeStructureOfStrippedType ty
| _ -> ValueNone

let cacheOptions (g: TcGlobals) =
match g.compilationMode with
| CompilationMode.OneOff -> Caches.CacheOptions.getDefault HashIdentity.Structural |> Caches.CacheOptions.withNoEviction
| _ -> { Caches.CacheOptions.getDefault HashIdentity.Structural with TotalCapacity = 65536; HeadroomPercentage = 75 }

// Cache for feasible subsumption checks
[<Struct; NoComparison>]
type TTypeCacheKey =
| TTypeCacheKey of TypeStructure * TypeStructure * CanCoerce
type TTypeFeasiblySubsumesCacheKey =
| TTypeFeasiblySubsumesCacheKey of TypeStructure * TypeStructure * CanCoerce
static member TryGetFromStrippedTypes(ty1, ty2, canCoerce) =
let tryGetTypeStructure ty =
match ty with
| TType_app _ ->
tryGetTypeStructureOfStrippedType ty
| _ -> ValueNone

(tryGetTypeStructure ty1, tryGetTypeStructure ty2)
||> ValueOption.map2(fun t1 t2 -> TTypeCacheKey(t1, t2, canCoerce))
||> ValueOption.map2(fun t1 t2 -> TTypeFeasiblySubsumesCacheKey(t1, t2, canCoerce))

let getTypeSubsumptionCache =
let factory (g: TcGlobals) =
let options =
match g.compilationMode with
| CompilationMode.OneOff -> Caches.CacheOptions.getDefault HashIdentity.Structural |> Caches.CacheOptions.withNoEviction
| _ -> { Caches.CacheOptions.getDefault HashIdentity.Structural with TotalCapacity = 65536; HeadroomPercentage = 75 }
new Caches.Cache<TTypeCacheKey, bool>(options, "typeSubsumptionCache")
Extras.WeakMap.getOrCreate factory
Extras.WeakMap.getOrCreate (fun g -> new Caches.Cache<TTypeFeasiblySubsumesCacheKey, bool>(cacheOptions g, "typeSubsumptionCache"))

// Cache for feasible equivalence checks
[<Struct; NoComparison>]
type TTypeFeasibleEquivCacheKey =
| TTypeFeasibleEquivCacheKey of TypeStructure * TypeStructure * bool
static member TryGetFromStrippedTypes(stripMeasures: bool, ty1: TType, ty2: TType) =
let sortPair a b = if hash a <= hash b then (a, b) else (b, a)
(tryGetTypeStructure ty1, tryGetTypeStructure ty2)
||> ValueOption.map2(fun t1 t2 ->
let t1, t2 = sortPair t1 t2
TTypeFeasibleEquivCacheKey(t1, t2, stripMeasures))

let getTypeFeasibleEquivCache =
Extras.WeakMap.getOrCreate (fun g -> new Caches.Cache<TTypeFeasibleEquivCacheKey, bool>(cacheOptions g, "typeFeasibleEquivCache"))

// Cache for definite subsumption without coercion
[<Struct; NoComparison>]
type TTypeDefinitelySubsumesNoCoerceCacheKey =
| TTypeDefinitelySubsumesNoCoerceCacheKey of TypeStructure * TypeStructure
static member TryGetFromStrippedTypes(ty1: TType, ty2: TType) =
(tryGetTypeStructure ty1, tryGetTypeStructure ty2)
||> ValueOption.map2(fun t1 t2 -> TTypeDefinitelySubsumesNoCoerceCacheKey(t1, t2))

let getTypeDefinitelySubsumesNoCoerceCache =
Extras.WeakMap.getOrCreate (fun g -> new Caches.Cache<TTypeDefinitelySubsumesNoCoerceCacheKey, bool>(cacheOptions g, "typeDefinitelySubsumesNoCoerceCache"))

/// Implements a :> b without coercion based on finalized (no type variable) types
// Note: This relation is approximate and not part of the language specification.
Expand All @@ -64,22 +89,37 @@ let rec TypeDefinitelySubsumesTypeNoCoercion ndeep g amap m ty1 ty2 =
if ty1 === ty2 then true
elif typeEquiv g ty1 ty2 then true
else

let checkSubsumes ty1 ty2 =

typeEquiv g ty1 ty2 ||

// F# reference types are subtypes of type 'obj'
(typeEquiv g ty1 g.obj_ty_ambivalent && isRefTy g ty2) ||
// Follow the supertype chain
(isAppTy g ty2 &&
isRefTy g ty2 &&

((match GetSuperTypeOfType g amap m ty2 with
| None -> false
| Some ty -> TypeDefinitelySubsumesTypeNoCoercion (ndeep+1) g amap m ty1 ty) ||

// Follow the interface hierarchy
(isInterfaceTy g ty1 &&
ty2 |> GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m
|> List.exists (TypeDefinitelySubsumesTypeNoCoercion (ndeep+1) g amap m ty1))))

let ty1 = stripTyEqns g ty1
let ty2 = stripTyEqns g ty2
// F# reference types are subtypes of type 'obj'
(typeEquiv g ty1 g.obj_ty_ambivalent && isRefTy g ty2) ||
// Follow the supertype chain
(isAppTy g ty2 &&
isRefTy g ty2 &&

((match GetSuperTypeOfType g amap m ty2 with
| None -> false
| Some ty -> TypeDefinitelySubsumesTypeNoCoercion (ndeep+1) g amap m ty1 ty) ||

// Follow the interface hierarchy
(isInterfaceTy g ty1 &&
ty2 |> GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m
|> List.exists (TypeDefinitelySubsumesTypeNoCoercion (ndeep+1) g amap m ty1))))
if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
let key = TTypeDefinitelySubsumesNoCoerceCacheKey.TryGetFromStrippedTypes(ty1, ty2)
match key with
| ValueNone -> checkSubsumes ty1 ty2
| ValueSome key ->
(getTypeDefinitelySubsumesNoCoerceCache g).GetOrAdd(key, fun _ -> checkSubsumes ty1 ty2)
else
checkSubsumes ty1 ty2

let stripAll stripMeasures g ty =
if stripMeasures then
Expand All @@ -96,30 +136,40 @@ let rec TypesFeasiblyEquivalent stripMeasures ndeep g amap m ty1 ty2 =
let ty1 = stripAll stripMeasures g ty1
let ty2 = stripAll stripMeasures g ty2

match ty1, ty2 with
| TType_measure _, TType_measure _
| TType_var _, _
| _, TType_var _ -> true
let computeEquiv ty1 ty2 =

match ty1, ty2 with
| TType_measure _, TType_measure _
| TType_var _, _
| _, TType_var _ -> true

| TType_app (tcref1, l1, _), TType_app (tcref2, l2, _) when tyconRefEq g tcref1 tcref2 ->
List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2
| TType_app (tcref1, l1, _), TType_app (tcref2, l2, _) when tyconRefEq g tcref1 tcref2 ->
List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2

| TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2) ->
(evalTupInfoIsStruct anonInfo1.TupInfo = evalTupInfoIsStruct anonInfo2.TupInfo) &&
(match anonInfo1.Assembly, anonInfo2.Assembly with ccu1, ccu2 -> ccuEq ccu1 ccu2) &&
(anonInfo1.SortedNames = anonInfo2.SortedNames) &&
List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2
| TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2) ->
(evalTupInfoIsStruct anonInfo1.TupInfo = evalTupInfoIsStruct anonInfo2.TupInfo) &&
(match anonInfo1.Assembly, anonInfo2.Assembly with ccu1, ccu2 -> ccuEq ccu1 ccu2) &&
(anonInfo1.SortedNames = anonInfo2.SortedNames) &&
List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2

| TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) ->
evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 &&
List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2
| TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) ->
evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 &&
List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2

| TType_fun (domainTy1, rangeTy1, _), TType_fun (domainTy2, rangeTy2, _) ->
TypesFeasiblyEquivalent stripMeasures ndeep g amap m domainTy1 domainTy2 &&
TypesFeasiblyEquivalent stripMeasures ndeep g amap m rangeTy1 rangeTy2
| TType_fun (domainTy1, rangeTy1, _), TType_fun (domainTy2, rangeTy2, _) ->
TypesFeasiblyEquivalent stripMeasures ndeep g amap m domainTy1 domainTy2 &&
TypesFeasiblyEquivalent stripMeasures ndeep g amap m rangeTy1 rangeTy2

| _ ->
false
| _ ->
false

if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then
let key = TTypeFeasibleEquivCacheKey.TryGetFromStrippedTypes(stripMeasures, ty1, ty2)
match key with
| ValueNone -> computeEquiv ty1 ty2
| ValueSome key1 ->(getTypeFeasibleEquivCache g).GetOrAdd(key1, fun _ -> computeEquiv ty1 ty2)
else
computeEquiv ty1 ty2

/// The feasible equivalence relation. Part of the language spec.
let TypesFeasiblyEquiv ndeep g amap m ty1 ty2 =
Expand Down Expand Up @@ -165,7 +215,7 @@ let rec TypeFeasiblySubsumesType ndeep (g: TcGlobals) (amap: ImportMap) m (ty1:
true

| _ when g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache ->
match TTypeCacheKey.TryGetFromStrippedTypes(ty1, ty2, canCoerce) with
match TTypeFeasiblySubsumesCacheKey.TryGetFromStrippedTypes(ty1, ty2, canCoerce) with
| ValueSome key ->
(getTypeSubsumptionCache g).GetOrAdd(key, fun _ -> checkSubsumes ty1 ty2)
| _ -> checkSubsumes ty1 ty2
Expand Down
6 changes: 3 additions & 3 deletions src/Compiler/Utilities/Caches.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -99,9 +99,9 @@ module CacheMetrics =

let rows =
[
for kv in statsByName do
let name = kv.Key
let stats = kv.Value
for k in statsByName.Keys |> Seq.sort do
let name = k
let stats = statsByName[k]
let totals = stats.GetTotals()

[
Expand Down
Loading
Loading