improve

Author: majocha

src/Compiler/Checking/TypeRelations.fs

@@ -7,7 +7,7 @@ module internal FSharp.Compiler.TypeRelations
 open FSharp.Compiler.Features
 open Internal.Utilities.Collections
 open Internal.Utilities.Library
-open Internal.Utilities.TypeHashing
+open Internal.Utilities.TypeHashing.StructuralUtilities
 
 open FSharp.Compiler.DiagnosticsLogger
 open FSharp.Compiler.TcGlobals
@@ -27,9 +27,9 @@ type CanCoerce =
 
 [<Struct; NoComparison>]
 type TTypeCacheKey =
-    | TTypeCacheKey of TypeStructural.TypeStructure * TypeStructural.TypeStructure * CanCoerce
+    | TTypeCacheKey of TypeStructure * TypeStructure * CanCoerce
     static member Create(ty1, ty2, canCoerce) =
-        TTypeCacheKey(TypeStructural.getTypeStructure ty1, TypeStructural.getTypeStructure ty2, canCoerce)
+        TTypeCacheKey(getTypeStructure ty1, getTypeStructure ty2, canCoerce)
 
 let getTypeSubsumptionCache =
     let factory (g: TcGlobals) =

src/Compiler/Utilities/TypeHashing.fs

@@ -359,32 +359,23 @@ module HashTastMemberOrVals =
         | Some _ -> hashMember (g, obs) emptyTyparInst vref.Deref
 
 /// Lossless accumulation of TType structure
-module TypeStructural =
-    // Helper struct whose instances are never equal (even to themselves).
+module StructuralUtilities =
     [<Struct; CustomEquality; NoComparison>]
     type NeverEqual =
         struct
             interface System.IEquatable<NeverEqual> with
                 member _.Equals _ = false
-
-            override _.Equals(_) = false
+            override _.Equals _ = false
             override _.GetHashCode() = 0
         end
 
-    [<Struct; NoComparison>]
+    [<Struct; NoComparison; RequireQualifiedAccess>]
     type NullnessToken =
         | Known of info: NullnessInfo
         | Variable of never: NeverEqual
         | Absent
 
-    /// Convert compiler Nullness info to token form
-    let inline toNullnessToken (n: Nullness) =
-        match n with
-        | Nullness.Known k -> NullnessToken.Known k
-        | Nullness.Variable _ -> NullnessToken.Variable(NeverEqual())
-
-    /// Tokens capturing a lossless, structural representation of TType needed for deterministic keys.
-    [<Struct; NoComparison>]
+    [<Struct; NoComparison; RequireQualifiedAccess>]
     type TypeToken =
         | Stamp of stamp: Stamp
         | UCase of name: string
@@ -395,59 +386,70 @@ module TypeStructural =
 
     type TypeStructure = TypeToken[]
 
-    /// Accumulate Measure to MeasureToken
-    let rec private accumulateMeasure m acc =
+    [<Literal>]
+    let private initialTokenCapacity = 4
+
+    // Single reusable token for Nullness.Variable
+    let private neverEqual = NullnessToken.Variable(NeverEqual())
+
+    let inline toNullnessToken (n: Nullness) =
+        match n with
+        | Nullness.Known k -> NullnessToken.Known k
+        // If nullness is not known we must treat the types as not equal for caching purposes.
+        | Nullness.Variable _ -> neverEqual
+
+    let rec private accumulateMeasure (tokens: ResizeArray<TypeToken>) (m: Measure) =
         match m with
-        | Measure.Var mv -> acc (Stamp mv.Stamp)
-        | Measure.Const(tcref, _) -> acc (Stamp tcref.Stamp)
+        | Measure.Var mv ->
+            tokens.Add(TypeToken.Stamp mv.Stamp)
+        | Measure.Const(tcref, _) ->
+            tokens.Add(TypeToken.Stamp tcref.Stamp)
         | Measure.Prod(m1, m2, _) ->
-            accumulateMeasure m1 acc
-            accumulateMeasure m2 acc
-        | Measure.Inv m1 -> accumulateMeasure m1 acc
-        | Measure.One _ -> acc MeasureOne
+            accumulateMeasure tokens m1
+            accumulateMeasure tokens m2
+        | Measure.Inv m1 ->
+            accumulateMeasure tokens m1
+        | Measure.One _ ->
+            tokens.Add(TypeToken.MeasureOne)
         | Measure.RationalPower(m1, r) ->
-            accumulateMeasure m1 acc
-            acc (MeasureRational r)
+            accumulateMeasure tokens m1
+            tokens.Add(TypeToken.MeasureRational r)
 
-    /// Accumulate a TType into a lossless token list. Uses stamps for identity where appropriate (matching hashTType logic).
-    let rec private accumulateTType (ty: TType) acc =
+    let rec private accumulateTType (tokens: ResizeArray<TypeToken>) (ty: TType) =
         match ty with
         | TType_ucase(u, tinst) ->
-            acc (UCase u.CaseName)
-
+            tokens.Add(TypeToken.UCase u.CaseName)
             for arg in tinst do
-                accumulateTType arg acc
+                accumulateTType tokens arg
         | TType_app(tcref, tinst, n) ->
-            acc (Stamp tcref.Stamp)
-            acc (Nullness(toNullnessToken n))
-
+            tokens.Add(TypeToken.Stamp tcref.Stamp)
+            tokens.Add(TypeToken.Nullness(toNullnessToken n))
             for arg in tinst do
-                accumulateTType arg acc
+                accumulateTType tokens arg
         | TType_anon(info, tys) ->
-            acc (Stamp info.Stamp)
-
+            tokens.Add(TypeToken.Stamp info.Stamp)
             for arg in tys do
-                accumulateTType arg acc
+                accumulateTType tokens arg
         | TType_tuple(tupInfo, tys) ->
-            acc (TupInfo(evalTupInfoIsStruct tupInfo))
-
+            tokens.Add(TypeToken.TupInfo(evalTupInfoIsStruct tupInfo))
             for arg in tys do
-                accumulateTType arg acc
+                accumulateTType tokens arg
         | TType_forall(tps, tau) ->
             for tp in tps do
-                acc (Stamp tp.Stamp)
-
-            accumulateTType tau acc
+                tokens.Add(TypeToken.Stamp tp.Stamp)
+            accumulateTType tokens tau
         | TType_fun(d, r, n) ->
-            accumulateTType d acc
-            accumulateTType r acc
-            acc (Nullness(toNullnessToken n))
+            accumulateTType tokens d
+            accumulateTType tokens r
+            tokens.Add(TypeToken.Nullness(toNullnessToken n))
         | TType_var(r, n) ->
-            acc (Stamp r.Stamp)
-            acc (Nullness(toNullnessToken n))
-        | TType_measure m -> accumulateMeasure m acc
+            tokens.Add(TypeToken.Stamp r.Stamp)
+            tokens.Add(TypeToken.Nullness(toNullnessToken n))
+        | TType_measure m ->
+            accumulateMeasure tokens m
 
+    /// Get the full structure of a type as a sequence of tokens, suitable for equality 
     let getTypeStructure ty =
-        let tokens = ResizeArray()
-        accumulateTType ty tokens.Add
+        let tokens = ResizeArray<TypeToken>(initialTokenCapacity)
+        accumulateTType tokens ty
         tokens.ToArray()