Type relations cache: optimize key generation (#19120)

Author: majocha

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

@@ -0,0 +1,3 @@
+### Fixed
+
+* Type relations cache: optimize key generation ([Issue #19116](https://github.com/dotnet/fsharp/issues/18767)) ([PR #19120](https://github.com/dotnet/fsharp/pull/19120))

src/Compiler/Utilities/TypeHashing.fs

@@ -389,147 +389,190 @@ module StructuralUtilities =
 
     [<Struct; NoComparison; RequireQualifiedAccess>]
     type TypeToken =
-        | Stamp of stamp: Stamp
-        | UCase of name: string
-        | Nullness of nullness: NullnessInfo
+        | Stamp of int
+        | UCase of int
+        | Nullness of int
         | NullnessUnsolved
-        | TupInfo of b: bool
+        | TupInfo of int
         | Forall of int
         | MeasureOne
-        | MeasureRational of int * int
+        | MeasureDenominator of int
+        | MeasureNumerator of int
         | Solved of int
         | Unsolved of int
         | Rigid of int
 
     type TypeStructure =
         | Stable of TypeToken[]
+        // Unstable means that the type structure of a given TType may change because of constraint solving or Trace.Undo.
         | Unstable of TypeToken[]
         | PossiblyInfinite
 
-    type private EmitContext =
-        {
-            typarMap: System.Collections.Generic.Dictionary<Stamp, int>
-            emitNullness: bool
-            mutable stable: bool
-        }
+    type private GenerationContext() =
+        member val TyparMap = System.Collections.Generic.Dictionary<Stamp, int>(4)
+        member val Tokens = ResizeArray<TypeToken>(256)
+        member val EmitNullness = false with get, set
+        member val Stable = true with get, set
 
-    let private emitNullness env (n: Nullness) =
-        seq {
-            if env.emitNullness then
-                env.stable <- false //
+        member this.Reset() =
+            this.TyparMap.Clear()
+            this.Tokens.Clear()
+            this.EmitNullness <- false
+            this.Stable <- true
 
+    let private context =
+        new System.Threading.ThreadLocal<GenerationContext>(fun () -> GenerationContext())
+
+    let private getContext () =
+        let ctx = context.Value
+        ctx.Reset()
+        ctx
+
+    let inline private encodeNullness (n: NullnessInfo) =
+        match n with
+        | NullnessInfo.AmbivalentToNull -> 0
+        | NullnessInfo.WithNull -> 1
+        | NullnessInfo.WithoutNull -> 2
+
+    let private emitNullness (ctx: GenerationContext) (n: Nullness) =
+        if ctx.EmitNullness then
+            ctx.Stable <- false
+
+            let out = ctx.Tokens
+
+            if out.Count < 256 then
                 match n.TryEvaluate() with
-                | ValueSome k -> TypeToken.Nullness k
-                | ValueNone -> TypeToken.NullnessUnsolved
-        }
+                | ValueSome k -> out.Add(TypeToken.Nullness(encodeNullness k))
+                | ValueNone -> out.Add(TypeToken.NullnessUnsolved)
+
+    let inline private emitStamp (ctx: GenerationContext) (stamp: Stamp) =
+        let out = ctx.Tokens
+
+        if out.Count < 256 then
+            // Emit low 32 bits first
+            let lo = int (stamp &&& 0xFFFFFFFFL)
+            out.Add(TypeToken.Stamp lo)
+            // If high 32 bits are non-zero, emit them as another token
+            let hi64 = stamp >>> 32
+
+            if hi64 <> 0L && out.Count < 256 then
+                out.Add(TypeToken.Stamp(int hi64))
 
-    let rec private emitMeasure (m: Measure) =
-        seq {
+    let rec private emitMeasure (ctx: GenerationContext) (m: Measure) =
+        let out = ctx.Tokens
+
+        if out.Count >= 256 then
+            ()
+        else
             match m with
-            | Measure.Var mv -> TypeToken.Stamp mv.Stamp
-            | Measure.Const(tcref, _) -> TypeToken.Stamp tcref.Stamp
+            | Measure.Var mv -> emitStamp ctx mv.Stamp
+            | Measure.Const(tcref, _) -> emitStamp ctx tcref.Stamp
             | Measure.Prod(m1, m2, _) ->
-                yield! emitMeasure m1
-                yield! emitMeasure m2
-            | Measure.Inv m1 -> yield! emitMeasure m1
-            | Measure.One _ -> TypeToken.MeasureOne
+                emitMeasure ctx m1
+                emitMeasure ctx m2
+            | Measure.Inv m1 -> emitMeasure ctx m1
+            | Measure.One _ -> out.Add(TypeToken.MeasureOne)
             | Measure.RationalPower(m1, r) ->
-                yield! emitMeasure m1
-                TypeToken.MeasureRational(GetNumerator r, GetDenominator r)
-        }
+                emitMeasure ctx m1
+
+                if out.Count < 256 then
+                    out.Add(TypeToken.MeasureNumerator(GetNumerator r))
+                    out.Add(TypeToken.MeasureDenominator(GetDenominator r))
+
+    let rec private emitTType (ctx: GenerationContext) (ty: TType) =
+        let out = ctx.Tokens
 
-    and private emitTType (env: EmitContext) (ty: TType) =
-        seq {
+        if out.Count >= 256 then
+            ()
+        else
             match ty with
             | TType_ucase(u, tinst) ->
-                TypeToken.Stamp u.TyconRef.Stamp
-                TypeToken.UCase u.CaseName
+                emitStamp ctx u.TyconRef.Stamp
+
+                if out.Count < 256 then
+                    out.Add(TypeToken.UCase(hashText u.CaseName))
 
                 for arg in tinst do
-                    yield! emitTType env arg
+                    emitTType ctx arg
 
             | TType_app(tcref, tinst, n) ->
-                TypeToken.Stamp tcref.Stamp
-                yield! emitNullness env n
+                emitStamp ctx tcref.Stamp
+                emitNullness ctx n
 
                 for arg in tinst do
-                    yield! emitTType env arg
+                    emitTType ctx arg
 
             | TType_anon(info, tys) ->
-                TypeToken.Stamp info.Stamp
+                emitStamp ctx info.Stamp
 
                 for arg in tys do
-                    yield! emitTType env arg
+                    emitTType ctx arg
 
             | TType_tuple(tupInfo, tys) ->
-                TypeToken.TupInfo(evalTupInfoIsStruct tupInfo)
+                out.Add(TypeToken.TupInfo(if evalTupInfoIsStruct tupInfo then 1 else 0))
 
                 for arg in tys do
-                    yield! emitTType env arg
+                    emitTType ctx arg
 
             | TType_forall(tps, tau) ->
                 for tp in tps do
-                    env.typarMap.[tp.Stamp] <- env.typarMap.Count
+                    ctx.TyparMap.[tp.Stamp] <- ctx.TyparMap.Count
 
-                TypeToken.Forall tps.Length
+                out.Add(TypeToken.Forall tps.Length)
 
-                yield! emitTType env tau
+                emitTType ctx tau
 
             | TType_fun(d, r, n) ->
-                yield! emitTType env d
-                yield! emitTType env r
-                yield! emitNullness env n
+                emitTType ctx d
+                emitTType ctx r
+                emitNullness ctx n
 
             | TType_var(r, n) ->
-                yield! emitNullness env n
+                emitNullness ctx n
 
                 let typarId =
-                    match env.typarMap.TryGetValue r.Stamp with
+                    match ctx.TyparMap.TryGetValue r.Stamp with
                     | true, idx -> idx
                     | _ ->
-                        let idx = env.typarMap.Count
-                        env.typarMap.[r.Stamp] <- idx
+                        let idx = ctx.TyparMap.Count
+                        ctx.TyparMap.[r.Stamp] <- idx
                         idx
 
                 // Solved may become unsolved, in case of Trace.Undo.
-                env.stable <- false
+                if not r.IsFromError then
+                    ctx.Stable <- false
 
                 match r.Solution with
-                | Some ty -> yield! emitTType env ty
+                | Some ty -> emitTType ctx ty
                 | None ->
-                    if r.Rigidity = TyparRigidity.Rigid then
-                        TypeToken.Rigid typarId
-                    else
-                        TypeToken.Unsolved typarId
-
-            | TType_measure m -> yield! emitMeasure m
-        }
+                    if out.Count < 256 then
+                        if r.Rigidity = TyparRigidity.Rigid then
+                            out.Add(TypeToken.Rigid typarId)
+                        else
+                            out.Add(TypeToken.Unsolved typarId)
 
-    let private getTypeStructureOfStrippedType (ty: TType) =
+            | TType_measure m -> emitMeasure ctx m
 
-        let env =
-            {
-                typarMap = System.Collections.Generic.Dictionary<Stamp, int>()
-                emitNullness = false
-                stable = true
-            }
+    let private getTypeStructureOfStrippedTypeUncached (ty: TType) =
+        let ctx = getContext ()
+        emitTType ctx ty
 
-        let tokens = emitTType env ty |> Seq.truncate 256 |> Seq.toArray
+        let out = ctx.Tokens
 
         // If the sequence got too long, just drop it, we could be dealing with an infinite type.
-        if tokens.Length = 256 then PossiblyInfinite
-        elif not env.stable then Unstable tokens
-        else Stable tokens
+        if out.Count >= 256 then PossiblyInfinite
+        elif not ctx.Stable then Unstable(out.ToArray())
+        else Stable(out.ToArray())
 
     // Speed up repeated calls by memoizing results for types that yield a stable structure.
-    let private memoize =
+    let private getTypeStructureOfStrippedType =
         WeakMap.cacheConditionally
             (function
             | Stable _ -> true
             | _ -> false)
-            getTypeStructureOfStrippedType
+            getTypeStructureOfStrippedTypeUncached
 
     let tryGetTypeStructureOfStrippedType ty =
-        match memoize ty with
+        match getTypeStructureOfStrippedType ty with
         | PossiblyInfinite -> ValueNone
         | ts -> ValueSome ts