Type relations cache: Add a failsafe in case of infinite types

docs/release-notes/.FSharp.Compiler.Service/11.0.0.md

@@ -3,6 +3,7 @@
 * Scripts: Fix resolving the dotnet host path when an SDK directory is specified. ([PR #18960](https://github.com/dotnet/fsharp/pull/18960))
 * Fix excessive StackGuard thread jumping ([PR #18971](https://github.com/dotnet/fsharp/pull/18971))
 * Fix name is bound multiple times is not reported in 'as' pattern ([PR #18984](https://github.com/dotnet/fsharp/pull/18984))
+* Type relations cache: handle potentially "infinite" types ([PR #19010](https://github.com/dotnet/fsharp/pull/19010))  
 
 ### Added
 

src/Compiler/Checking/TypeRelations.fs

@@ -28,8 +28,12 @@ type CanCoerce =
 [<Struct; NoComparison>]
 type TTypeCacheKey =
     | TTypeCacheKey of TypeStructure * TypeStructure * CanCoerce
-    static member FromStrippedTypes(ty1, ty2, canCoerce) =
-        TTypeCacheKey(getTypeStructure ty1, getTypeStructure ty2, canCoerce)
+    static member TryGetFromStrippedTypes(ty1, ty2, canCoerce) =
+        let t1, t2 = getTypeStructure ty1, getTypeStructure ty2
+        if t1.IsPossiblyInfinite || t2.IsPossiblyInfinite then
+            ValueNone
+        else
+            ValueSome (TTypeCacheKey(t1, t2, canCoerce))
 
 let getTypeSubsumptionCache =
     let factory (g: TcGlobals) =
@@ -157,8 +161,10 @@ 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)
-        (getTypeSubsumptionCache g).GetOrAdd(key, fun _ -> checkSubsumes ty1 ty2)
+        match TTypeCacheKey.TryGetFromStrippedTypes(ty1, ty2, canCoerce) with
+        | ValueSome key ->
+            (getTypeSubsumptionCache g).GetOrAdd(key, fun _ -> checkSubsumes ty1 ty2)
+        | _ -> checkSubsumes ty1 ty2
     else
         checkSubsumes ty1 ty2
 

src/Compiler/Utilities/TypeHashing.fs

@@ -401,7 +401,9 @@ module StructuralUtilities =
         | MeasureRational of int * int
         | NeverEqual of never: NeverEqual
 
-    type TypeStructure = TypeStructure of ImmutableArray<TypeToken>
+    type TypeStructure =
+        | TypeStructure of TypeToken[]
+        | PossiblyInfinite of never: NeverEqual
 
     let inline toNullnessToken (n: Nullness) =
         match n.TryEvaluate() with
@@ -464,6 +466,15 @@ module StructuralUtilities =
             | TType_measure m -> yield! accumulateMeasure m
         }
 
+    // If the sequence got too long, just drop it, we could be dealing with an infinite type.
+    let private toTypeStructure tokens =
+        let tokens = tokens |> Seq.truncate 256 |> Array.ofSeq
+
+        if tokens.Length = 256 then
+            PossiblyInfinite NeverEqual.Singleton
+        else
+            TypeStructure tokens
+
     /// Get the full structure of a type as a sequence of tokens, suitable for equality
     let getTypeStructure =
-        Extras.WeakMap.getOrCreate (fun ty -> accumulateTType ty |> ImmutableArray.ofSeq |> TypeStructure)
+        Extras.WeakMap.getOrCreate (fun ty -> accumulateTType ty |> toTypeStructure)