Generate new Equals overload to avoid boxing for structural comparison

Author: psfinaki

docs/optimizations-equality.md

@@ -209,51 +209,11 @@ let f (x: float32) (y: float32) = (x = y)
 
 ### F# struct type (records, tuples - with compiler-generated structural equality)
 
-* Semantics: User expects field-by-field structural equality with no boxing
+* Semantics: User expects field-by-field structural equality
 * Perf expected: no boxing
 * Compilation today: `GenericEqualityIntrinsic<SomeStructType>`
-* Perf today: always boxes (Problem3 ❌)
+* Perf today: good ✅
 * [sharplab](https://sharplab.io/#v2:DYLgZgzgNALiCWwA+BYAUAbQDwGUYCcBXAYxgD4BddGATwAcBTAAhwHsBbBvI0gCgDcQTeADsYUJoSGiYASiYBedExVNO7AEYN8TAPoA6AGqKm/ZavVadBgKonC6dMAYwmYJrwAeQtp24k5JhoTLxMaWXQgA)
-* Note: the optimization path is a bit strange here, see the reductions below
-
-<details>
-
-<summary>Details</summary>
-
-```fsharp
-(x = y) 
-
---inline--> 
-
-GenericEquality x y 
-
---inline--> 
-
-GenericEqualityFast x y 
-
---inline--> 
-
-GenericEqualityIntrinsic x y
-
---devirtualize-->
-
-x.Equals(box y, LanguagePrimitives.GenericEqualityComparer);
-```
-
-The struct type has these generated methods:
-```csharp
-    override bool Equals(object y) 
-    override bool Equals(SomeStruct obj)
-    override bool Equals(object obj, IEqualityComparer comp) //with EqualsVal
-```
-
-These call each other in sequence, boxing then unboxing then boxing. We do NOT generate this method, we probably should:
-
-```csharp
-    override bool Equals(SomeStruct obj, IEqualityComparer comp) //with EqualsValUnboxed
-```
-
-If we did, the devirtualizing optimization should reduce to this directly, which would result in no boxing.
 
 </details>
 

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

@@ -9,3 +9,7 @@
 * Fix bug in optimization of for-loops over integral ranges with steps and units of measure. ([Issue #17025](https://github.com/dotnet/fsharp/issues/17025), [PR #17040](https://github.com/dotnet/fsharp/pull/17040), [PR #17048](https://github.com/dotnet/fsharp/pull/17048))
 * Fix calling an overridden virtual static method via the interface ([PR #17013](https://github.com/dotnet/fsharp/pull/17013))
 * Fix state machines compilation, when big decision trees are involved, by removing code split when resumable code is detected ([PR #17076](https://github.com/dotnet/fsharp/pull/17076))
+
+### Added
+
+* Generate new `Equals` overload to avoid boxing for structural comparison ([PR #16857](https://github.com/dotnet/fsharp/pull/16857))

eng/Build.ps1

@@ -214,9 +214,11 @@ function Process-Arguments() {
 
     if ($norealsig) {
         $script:realsig = $False;
+        $env:FSHARP_REALSIG="false"
     }
     else {
         $script:realsig = $True;
+        $env:FSHARP_REALSIG="true"
     }        
     if ($verifypackageshipstatus) {
         $script:verifypackageshipstatus = $True;

src/Compiler/Checking/AugmentWithHashCompare.fs

@@ -106,6 +106,9 @@ let mkEqualsTy g ty =
 let mkEqualsWithComparerTy g ty =
     mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ g.obj_ty; g.IEqualityComparer_ty ]) g.bool_ty)
 
+let mkEqualsWithComparerTyExact g ty =
+    mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ ty; g.IEqualityComparer_ty ]) g.bool_ty)
+
 let mkHashTy g ty =
     mkFunTy g (mkThisTy g ty) (mkFunTy g g.unit_ty g.int_ty)
 
@@ -361,7 +364,7 @@ let mkRecdEquality g tcref (tycon: Tycon) =
     thisv, thatv, expr
 
 /// Build the equality implementation for a record type when parameterized by a comparer
-let mkRecdEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje (thatv, thate) compe =
+let mkRecdEqualityWithComparer g tcref (tycon: Tycon) thise thatobje (thatv, thate) compe isexact =
     let m = tycon.Range
     let fields = tycon.AllInstanceFieldsAsList
     let tinst, ty = mkMinimalTy g tcref
@@ -382,14 +385,21 @@ let mkRecdEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje (
     let expr = mkEqualsTestConjuncts g m (List.map mkTest fields)
 
     let expr = mkBindThatAddr g m ty thataddrv thatv thate expr
-    // will be optimized away if not necessary
-    let expr = mkIsInstConditional g m ty thatobje thatv expr (mkFalse g m)
+
+    let expr = 
+        if isexact then 
+            expr
+        else
+            mkIsInstConditional g m ty thatobje thatv expr (mkFalse g m)
 
     let expr =
         if tycon.IsStructOrEnumTycon then
             expr
         else
-            mkBindThisNullEquals g m thise thatobje expr
+            if isexact then
+                mkBindThatNullEquals g m thise thate expr
+            else
+                mkBindThisNullEquals g m thise thatobje expr
 
     expr
 
@@ -425,7 +435,7 @@ let mkExnEquality (g: TcGlobals) exnref (exnc: Tycon) =
     thisv, thatv, expr
 
 /// Build the equality implementation for an exception definition when parameterized by a comparer
-let mkExnEqualityWithComparer g exnref (exnc: Tycon) (_thisv, thise) thatobje (thatv, thate) compe =
+let mkExnEqualityWithComparer g exnref (exnc: Tycon) thise thatobje (thatv, thate) compe isexact =
     let m = exnc.Range
     let thataddrv, thataddre = mkThatAddrLocal g m g.exn_ty
 
@@ -453,13 +463,21 @@ let mkExnEqualityWithComparer g exnref (exnc: Tycon) (_thisv, thise) thatobje (t
         mbuilder.Close(dtree, m, g.bool_ty)
 
     let expr = mkBindThatAddr g m g.exn_ty thataddrv thatv thate expr
-    let expr = mkIsInstConditional g m g.exn_ty thatobje thatv expr (mkFalse g m)
+
+    let expr = 
+        if isexact then
+            expr
+        else 
+            mkIsInstConditional g m g.exn_ty thatobje thatv expr (mkFalse g m)
 
     let expr =
         if exnc.IsStructOrEnumTycon then
             expr
         else
-            mkBindThisNullEquals g m thise thatobje expr
+            if isexact then
+                mkBindThatNullEquals g m thise thate expr
+            else
+                mkBindThisNullEquals g m thise thatobje expr
 
     expr
 
@@ -758,7 +776,7 @@ let mkUnionEquality g tcref (tycon: Tycon) =
     thisv, thatv, expr
 
 /// Build the equality implementation for a union type when parameterized by a comparer
-let mkUnionEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje (thatv, thate) compe =
+let mkUnionEqualityWithComparer g tcref (tycon: Tycon) thise thatobje (thatv, thate) compe isexact =
     let m = tycon.Range
     let ucases = tycon.UnionCasesAsList
     let tinst, ty = mkMinimalTy g tcref
@@ -846,13 +864,21 @@ let mkUnionEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje
                 (mkCompGenLet m thattagv (mkUnionCaseTagGetViaExprAddr (thataddre, tcref, tinst, m)) tagsEqTested)
 
     let expr = mkBindThatAddr g m ty thataddrv thatv thate expr
-    let expr = mkIsInstConditional g m ty thatobje thatv expr (mkFalse g m)
+
+    let expr = 
+        if isexact then
+            expr
+        else
+            mkIsInstConditional g m ty thatobje thatv expr (mkFalse g m)
 
     let expr =
         if tycon.IsStructOrEnumTycon then
             expr
         else
-            mkBindThisNullEquals g m thise thatobje expr
+            if isexact then
+                mkBindThatNullEquals g m thise thate expr
+            else
+                mkBindThisNullEquals g m thise thatobje expr
 
     expr
 
@@ -1014,6 +1040,15 @@ let getAugmentationAttribs g (tycon: Tycon) =
     TryFindFSharpBoolAttribute g g.attrib_CustomComparisonAttribute tycon.Attribs,
     TryFindFSharpBoolAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs
 
+[<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
+type EqualityWithComparerAugmentation = 
+    {
+        GetHashCode: Val
+        GetHashCodeWithComparer: Val
+        EqualsWithComparer: Val
+        EqualsExactWithComparer: Val
+    }
+
 let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) =
     let m = tycon.Range
     let attribs = getAugmentationAttribs g tycon
@@ -1333,7 +1368,25 @@ let MakeValsForEqualityWithComparerAugmentation g (tcref: TyconRef) =
     let withcEqualsVal =
         mkValSpec g tcref ty vis (Some(mkIStructuralEquatableEqualsSlotSig g)) "Equals" (tps +-> (mkEqualsWithComparerTy g ty)) tupArg false
 
-    objGetHashCodeVal, withcGetHashCodeVal, withcEqualsVal
+    let withcEqualsValExact =
+        mkValSpec
+            g 
+            tcref 
+            ty
+            vis
+            // This doesn't implement any interface.
+            None 
+            "Equals" 
+            (tps +-> (mkEqualsWithComparerTyExact g ty)) 
+            tupArg 
+            false
+
+    {
+        GetHashCode = objGetHashCodeVal
+        GetHashCodeWithComparer = withcGetHashCodeVal
+        EqualsWithComparer = withcEqualsVal
+        EqualsExactWithComparer = withcEqualsValExact
+    }    
 
 let MakeBindingsForCompareAugmentation g (tycon: Tycon) =
     let tcref = mkLocalTyconRef tycon
@@ -1419,7 +1472,7 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon
     let mkStructuralEquatable hashf equalsf =
         match tycon.GeneratedHashAndEqualsWithComparerValues with
         | None -> []
-        | Some(objGetHashCodeVal, withcGetHashCodeVal, withcEqualsVal) ->
+        | Some(objGetHashCodeVal, withcGetHashCodeVal, withcEqualsVal, withcEqualsExactValOption) ->
 
             // build the hash rhs
             let withcGetHashCodeExpr =
@@ -1451,12 +1504,33 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon
 
             // build the equals rhs
             let withcEqualsExpr =
-                let _tinst, ty = mkMinimalTy g tcref
+                let tinst, ty = mkMinimalTy g tcref
                 let thisv, thise = mkThisVar g m ty
                 let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty
                 let thatv, thate = mkCompGenLocal m "that" ty
                 let compv, compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty
-                let equalse = equalsf g tcref tycon (thisv, thise) thatobje (thatv, thate) compe
+
+                // if the new overload is available, use it
+                // otherwise, generate the whole equals thing
+                let equalse =
+                    match withcEqualsExactValOption with
+                    | Some withcEqualsExactVal ->
+                         mkIsInstConditional
+                             g
+                             m
+                             ty
+                             thatobje
+                             thatv
+                             (mkApps
+                                 g
+                                 ((exprForValRef m withcEqualsExactVal, withcEqualsExactVal.Type),
+                                  (if isNil tinst then [] else [ tinst ]),
+                                  [ thise; mkRefTupled g m [ thate; compe ] [ty; g.IEqualityComparer_ty ] ],
+                                  m))
+                             (mkFalse g m)
+                    | None ->
+                        equalsf g tcref tycon thise thatobje (thatv, thate) compe false
+
                 mkMultiLambdas g m tps [ [ thisv ]; [ thatobjv; compv ] ] (equalse, g.bool_ty)
 
             let objGetHashCodeExpr =
@@ -1481,9 +1555,22 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon
 
                 mkLambdas g m tps [ thisv; unitv ] (hashe, g.int_ty)
 
+            let withcEqualsExactExpr =
+                let _tinst, ty = mkMinimalTy g tcref
+                let thisv, thise = mkThisVar g m ty
+                let thatv, thate = mkCompGenLocal m "obj" ty
+                let compv, compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty
+
+                let equalse = equalsf g tcref tycon thise thate (thatv, thate) compe true
+
+                mkMultiLambdas g m tps [ [ thisv ]; [ thatv; compv ] ] (equalse, g.bool_ty)
+
             [
                 (mkCompGenBind withcGetHashCodeVal.Deref withcGetHashCodeExpr)
                 (mkCompGenBind objGetHashCodeVal.Deref objGetHashCodeExpr)
+                match withcEqualsExactValOption with
+                | Some withcEqualsExactVal -> mkCompGenBind withcEqualsExactVal.Deref withcEqualsExactExpr
+                | None -> ()
                 (mkCompGenBind withcEqualsVal.Deref withcEqualsExpr)
             ]
 

src/Compiler/Checking/AugmentWithHashCompare.fsi

@@ -7,6 +7,13 @@ open FSharp.Compiler
 open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TcGlobals
 
+[<NoEquality; NoComparison; StructuredFormatDisplay("{DebugText}")>]
+type EqualityWithComparerAugmentation =
+    { GetHashCode: Val
+      GetHashCodeWithComparer: Val
+      EqualsWithComparer: Val
+      EqualsExactWithComparer: Val }
+
 val CheckAugmentationAttribs: bool -> TcGlobals -> Import.ImportMap -> Tycon -> unit
 
 val TyconIsCandidateForAugmentationWithCompare: TcGlobals -> Tycon -> bool
@@ -21,7 +28,7 @@ val MakeValsForCompareWithComparerAugmentation: TcGlobals -> TyconRef -> Val
 
 val MakeValsForEqualsAugmentation: TcGlobals -> TyconRef -> Val * Val
 
-val MakeValsForEqualityWithComparerAugmentation: TcGlobals -> TyconRef -> Val * Val * Val
+val MakeValsForEqualityWithComparerAugmentation: TcGlobals -> TyconRef -> EqualityWithComparerAugmentation
 
 val MakeBindingsForCompareAugmentation: TcGlobals -> Tycon -> Binding list
 

src/Compiler/Checking/CheckDeclarations.fs

@@ -817,12 +817,18 @@ module AddAugmentationDeclarations =
             if hasExplicitIStructuralEquatable then
                 errorR(Error(FSComp.SR.tcImplementsIStructuralEquatableExplicitly(tycon.DisplayName), m))
             else
-                let evspec1, evspec2, evspec3 = AugmentTypeDefinitions.MakeValsForEqualityWithComparerAugmentation g tcref
+                let augmentation = AugmentTypeDefinitions.MakeValsForEqualityWithComparerAugmentation g tcref
                 PublishInterface cenv env.DisplayEnv tcref m true g.mk_IStructuralEquatable_ty
-                tcaug.SetHashAndEqualsWith (mkLocalValRef evspec1, mkLocalValRef evspec2, mkLocalValRef evspec3)
-                PublishValueDefn cenv env ModuleOrMemberBinding evspec1
-                PublishValueDefn cenv env ModuleOrMemberBinding evspec2
-                PublishValueDefn cenv env ModuleOrMemberBinding evspec3
+                tcaug.SetHashAndEqualsWith (
+                    mkLocalValRef augmentation.GetHashCode,
+                    mkLocalValRef augmentation.GetHashCodeWithComparer,
+                    mkLocalValRef augmentation.EqualsWithComparer,
+                    Some (mkLocalValRef augmentation.EqualsExactWithComparer))
+
+                PublishValueDefn cenv env ModuleOrMemberBinding augmentation.GetHashCode
+                PublishValueDefn cenv env ModuleOrMemberBinding augmentation.GetHashCodeWithComparer
+                PublishValueDefn cenv env ModuleOrMemberBinding augmentation.EqualsWithComparer
+                PublishValueDefnMaybeInclCompilerGenerated cenv env true ModuleOrMemberBinding augmentation.EqualsExactWithComparer
 
     let AddGenericCompareBindings (cenv: cenv) (tycon: Tycon) =
         if (* AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && *) Option.isSome tycon.GeneratedCompareToValues then 

src/Compiler/Checking/MethodOverrides.fs

@@ -776,7 +776,7 @@ module DispatchSlotChecking =
 
         // Get all the members that are immediately part of this type
         // Include the auto-generated members
-        let allImmediateMembers = tycon.MembersOfFSharpTyconSorted @ tycon.AllGeneratedValues
+        let allImmediateMembers = tycon.MembersOfFSharpTyconSorted @ tycon.AllGeneratedInterfaceImplsAndOverrides
 
         // Get all the members we have to implement, organized by each type we explicitly implement
         let slotImplSets = GetSlotImplSets infoReader denv AccessibleFromSomewhere false allReqdTys

src/Compiler/Checking/NicePrint.fs

@@ -1909,6 +1909,7 @@ module TastDefinitionPrinting =
             match vrefOpt with
             | None -> true
             | Some vref ->
+                (not vref.IsCompilerGenerated) &&
                 (denv.showObsoleteMembers || not (CheckFSharpAttributesForObsolete denv.g vref.Attribs)) &&
                 (denv.showHiddenMembers || not (CheckFSharpAttributesForHidden denv.g vref.Attribs))
 

src/Compiler/Checking/PostInferenceChecks.fs

@@ -2284,7 +2284,7 @@ let CheckEntityDefn cenv env (tycon: Entity) =
             else MethInfosEquivByNameAndPartialSig eraseFlag true g cenv.amap m minfo minfo2 (* partial ignores return type *)
 
         let immediateMeths =
-            [ for v in tycon.AllGeneratedValues do yield FSMeth (g, ty, v, None)
+            [ for v in tycon.AllGeneratedInterfaceImplsAndOverrides do yield FSMeth (g, ty, v, None)
               yield! GetImmediateIntrinsicMethInfosOfType (None, AccessibleFromSomewhere) g cenv.amap m ty ]
 
         let immediateProps = GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomewhere) g cenv.amap m ty

src/Compiler/CodeGen/IlxGen.fs

@@ -2189,7 +2189,7 @@ type AnonTypeGenerationTable() =
 
             let vspec1, vspec2 = AugmentTypeDefinitions.MakeValsForEqualsAugmentation g tcref
 
-            let evspec1, evspec2, evspec3 =
+            let augmentation =
                 AugmentTypeDefinitions.MakeValsForEqualityWithComparerAugmentation g tcref
 
             let cvspec1, cvspec2 = AugmentTypeDefinitions.MakeValsForCompareAugmentation g tcref
@@ -2200,7 +2200,13 @@ type AnonTypeGenerationTable() =
             tcaug.SetCompare(mkLocalValRef cvspec1, mkLocalValRef cvspec2)
             tcaug.SetCompareWith(mkLocalValRef cvspec3)
             tcaug.SetEquals(mkLocalValRef vspec1, mkLocalValRef vspec2)
-            tcaug.SetHashAndEqualsWith(mkLocalValRef evspec1, mkLocalValRef evspec2, mkLocalValRef evspec3)
+
+            tcaug.SetHashAndEqualsWith(
+                mkLocalValRef augmentation.GetHashCode,
+                mkLocalValRef augmentation.GetHashCodeWithComparer,
+                mkLocalValRef augmentation.EqualsWithComparer,
+                Some(mkLocalValRef augmentation.EqualsExactWithComparer)
+            )
 
             // Build the ILTypeDef. We don't rely on the normal record generation process because we want very specific field names