[WIP] Devirtualize Equality

src/absil/il.fs

@@ -2582,6 +2582,8 @@ type ILGlobals(primaryScopeRef) =
     let m_typ_IntPtr = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IntPtr))
     let m_typ_UIntPtr = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UIntPtr))
 
+    let m_typ_IEquatableT = mkILBoxedType (mkILTySpec (m_mkSysILTypeRef "System.IEquatable`1", [ mkILTyvarTy 1us ]))
+
     member x.primaryAssemblyScopeRef    = m_typ_Object.TypeRef.Scope
     member x.primaryAssemblyName        = m_typ_Object.TypeRef.Scope.AssemblyRef.Name
     member x.typ_Object                 = m_typ_Object
@@ -2602,6 +2604,7 @@ type ILGlobals(primaryScopeRef) =
     member x.typ_Double                 = m_typ_Double
     member x.typ_Bool                   = m_typ_Bool
     member x.typ_Char                   = m_typ_Char
+    member x.typ_IEquatableT            = m_typ_IEquatableT
 
     /// For debugging
     [<DebuggerBrowsable(DebuggerBrowsableState.Never)>]

src/absil/il.fsi

@@ -1583,6 +1583,7 @@ type ILGlobals =
     member typ_Double: ILType
     member typ_Bool: ILType
     member typ_Char: ILType
+    member typ_IEquatableT: ILType
 
 
 /// Build the table of commonly used references given functions to find types in system assemblies

src/fsharp/CompileOptions.fs

@@ -416,6 +416,11 @@ let SetOptimizeOn(tcConfigB : TcConfigBuilder) =
 let SetOptimizeSwitch (tcConfigB : TcConfigBuilder) switch = 
     if (switch = OptionSwitch.On) then SetOptimizeOn(tcConfigB) else SetOptimizeOff(tcConfigB)
 
+let SetSpecificOptimizeSwitch (tcConfigB : TcConfigBuilder) n switch = 
+    match n with 
+    | "equality" -> tcConfigB.optSettings <- { tcConfigB.optSettings with optimizeComparisonLogic = (switch = OptionSwitch.On) }
+    | _ -> failwithf "dodgy flag %s" n
+
 let SetTailcallSwitch (tcConfigB : TcConfigBuilder) switch =
     tcConfigB.emitTailcalls <- (switch = OptionSwitch.On)
 
@@ -696,6 +701,8 @@ let codeGenerationFlags isFsi (tcConfigB : TcConfigBuilder) =
     let codegen =
         [CompilerOption("optimize", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None, 
                             Some (FSComp.SR.optsOptimize()))
+         CompilerOption("optimize", tagNone, OptionStringListSwitch (SetSpecificOptimizeSwitch tcConfigB) , None, 
+                            Some (FSComp.SR.optsOptimize()))
          CompilerOption("tailcalls", tagNone, OptionSwitch (SetTailcallSwitch tcConfigB), None,
                             Some (FSComp.SR.optsTailcalls()))
          CompilerOption("deterministic", tagNone, OptionSwitch (SetDeterministicSwitch tcConfigB), None,

src/fsharp/Optimizer.fs

@@ -261,6 +261,7 @@ type OptimizationSettings =
       jitOptUser : bool option
       localOptUser : bool option
       crossModuleOptUser : bool option 
+      optimizeComparisonLogic : bool  
       /// size after which we start chopping methods in two, though only at match targets 
       bigTargetSize : int   
       /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations 
@@ -278,6 +279,7 @@ type OptimizationSettings =
         { abstractBigTargets = false
           jitOptUser = None
           localOptUser = None
+          optimizeComparisonLogic = false
           /// size after which we start chopping methods in two, though only at match targets 
           bigTargetSize = 100  
           /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations 
@@ -2479,7 +2481,34 @@ and DevirtualizeApplication cenv env (vref:ValRef) ty tyargs args m =
     let wrap, args = TakeAddressOfStructArgumentIfNeeded cenv vref ty args m
     let transformedExpr = wrap (MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref, vref.Type, (if isNil tyargs then [] else [tyargs]), args, m))
     OptimizeExpr cenv env transformedExpr
-
+
+and DevirtualizeGenericEqualityIntrinsic cenv env receiver arg m =
+    let call = mkCall_IEquatableT_Equals cenv.g m receiver arg
+    OptimizeExpr cenv env call
+
+/// Check if a type 'ty' implements 'IEquatable<ty>'
+and IsIEquatableTy cenv m ty =
+    let searchTy = mkAppTy cenv.g.system_GenericIEquatable_tcref [ty]
+    ExistsInEntireHierarchyOfType (fun t -> typeEquiv cenv.g t searchTy) cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes ty
+
+/// Check if a type 'ty' implements 'IStructuralEquatable'
+and IsIStructuralEquatableTy cenv m ty =
+    let searchTy = mkAppTy cenv.g.tcref_System_IStructuralEquatable []
+    ExistsInEntireHierarchyOfType (fun t -> typeEquiv cenv.g t searchTy) cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes ty    
+
+/// Check if a type 'ty' is a structural F# type with default structural equality semantics
+and IsGeneratedHashAndEqualsTy g ty =
+    isAnonRecdTy g ty || 
+    (isAppTy g ty &&
+     (let tcref = tcrefOfAppTy g ty
+      tcref.GeneratedHashAndEqualsValues.IsSome && tcref.GeneratedHashAndEqualsWithComparerValues.IsSome))
+
+/// Check if we can (perhaps optimistically) convert the reduced optimization of 'a = b' to '(a :> IEquatable).Equals(b)' 
+and CanOptimizeGenericEqualityIntrinsicToIEquatableEquals cenv m ty  = 
+    IsIEquatableTy cenv m ty && 
+    not (isAnyTupleTy cenv.g ty) && 
+    (IsGeneratedHashAndEqualsTy cenv.g ty || (cenv.settings.optimizeComparisonLogic && not (IsIStructuralEquatableTy cenv m ty)))
+
 and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
     match f, tyargs, args with 
 
@@ -2536,7 +2565,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
         | _ -> None 
 
     // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparer
-    | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_per_inner_vref ty args  && not(isRefTupleTy cenv.g ty) ->
+    | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_withc_outer_vref ty args  && not(isRefTupleTy cenv.g ty) ->
        let tcref, tyargs = StripToNominalTyconRef cenv ty
        match tcref.GeneratedHashAndEqualsWithComparerValues, args with
        | Some (_, _, withcEqualsVal), [x; y] -> 
@@ -2606,7 +2635,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
         match vref with 
         | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m)            
         | None -> None
-        
+
     // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types
     | Expr.Val(v, _, _), [ty], _ when  valRefEq cenv.g v cenv.g.generic_comparison_withc_inner_vref && isRefTupleTy cenv.g ty ->
         let tyargs = destRefTupleTy cenv.g ty 
@@ -2675,6 +2704,9 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
                 MightMakeCriticalTailcall = false
                 Info=UnknownValue})
 
+    | Expr.Val(v, _, _), [_], [receiver; arg] when valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref &&  CanOptimizeGenericEqualityIntrinsicToIEquatableEquals cenv m (tyOfExpr cenv.g receiver) ->
+        Some(DevirtualizeGenericEqualityIntrinsic cenv env receiver arg m)
+
     | _ -> None
 
 /// Attempt to inline an application of a known value at callsites

src/fsharp/Optimizer.fsi

@@ -12,6 +12,7 @@ type OptimizationSettings =
       jitOptUser : bool option
       localOptUser : bool option
       crossModuleOptUser : bool option
+      optimizeComparisonLogic : bool  
       bigTargetSize : int
       veryBigExprSize : int 
       lambdaInlineThreshold : int

src/fsharp/TastOps.fs

@@ -6386,6 +6386,9 @@ let mspec_String_Concat4 (g: TcGlobals) =
 let mspec_String_Concat_Array (g: TcGlobals) = 
     mkILNonGenericStaticMethSpecInTy (g.ilg.typ_String, "Concat", [ mkILArr1DTy g.ilg.typ_String ], g.ilg.typ_String)
 
+let mspec_IEquatableT_Equals (g: TcGlobals) =
+    mkILNonGenericMethSpecInTy (g.ilg.typ_IEquatableT, ILCallingConv.Instance, "Equals", [ mkILTyvarTy 0us ], g.ilg.typ_Bool)
+
 let fspec_Missing_Value (g: TcGlobals) = IL.mkILFieldSpecInTy(g.iltyp_Missing, "Value", g.iltyp_Missing)
 
 let mkInitializeArrayMethSpec (g: TcGlobals) = 
@@ -6623,6 +6626,21 @@ let mkStaticCall_String_Concat_Array g m arg =
     let mspec = mspec_String_Concat_Array g
     Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg], m)
 
+let mkCall_IEquatableT_Equals g m receiver arg =
+    let mspec = mspec_IEquatableT_Equals g
+    let receiverTy = tyOfExpr g receiver
+    let isStruct = isStructTy g receiverTy
+
+    let wrap, finalExpr, valUseFlag =
+        if isStruct then
+            let wrap, addrOfReceiver, _, _ = mkExprAddrOfExpr g true false Mutates.NeverMutates receiver None m
+            wrap, addrOfReceiver, ValUseFlag.PossibleConstrainedCall(receiverTy)
+        else
+            id, receiver, ValUseFlag.NormalValUse
+
+    Expr.Op(TOp.ILCall(isStruct, false, false, false, valUseFlag, false, false, mspec.MethodRef, [receiverTy], [], [g.bool_ty]), [], [finalExpr; arg], m)
+    |> wrap
+
 // Quotations can't contain any IL.
 // As a result, we aim to get rid of all IL generation in the typechecker and pattern match
 // compiler, or else train the quotation generator to understand the generated IL. 

src/fsharp/TastOps.fsi

@@ -1965,6 +1965,8 @@ val mkStaticCall_String_Concat4 : TcGlobals -> range -> Expr -> Expr -> Expr ->
 
 val mkStaticCall_String_Concat_Array : TcGlobals -> range -> Expr -> Expr
 
+val mkCall_IEquatableT_Equals : TcGlobals -> range -> Expr -> Expr -> Expr
+
 //-------------------------------------------------------------------------
 // operations primarily associated with the optimization to fix
 // up loops to generate .NET code that does not include array bound checks

src/fsharp/range.fs

@@ -269,10 +269,14 @@ type range(code1:int64, code2: int64) =
 
     override r.ToString() = sprintf "%s (%d,%d--%d,%d) IsSynthetic=%b" r.FileName r.StartLine r.StartColumn r.EndLine r.EndColumn r.IsSynthetic
 
-let mkRange filePath startPos endPos = range (fileIndexOfFileAux true filePath, startPos, endPos)
+    interface IEquatable<range> with
 
-let equals (r1: range) (r2: range) =
-    r1.Code1 = r2.Code1 && r1.Code2 = r2.Code2
+        member this.Equals(m) = this.Code1 = m.Code1 && this.Code2 = m.Code2
+
+let mkRange f b e =
+    // remove relative parts from full path
+    let normalizedFilePath = if Path.IsPathRooted f then try Path.GetFullPath f with _ -> f else f
+    range (fileIndexOfFile normalizedFilePath, b, e)
 
 let mkFileIndexRange fileIndex startPos endPos = range (fileIndex, startPos, endPos)
 

src/fsharp/range.fsi

@@ -2,6 +2,7 @@
 
 module public Microsoft.FSharp.Compiler.Range
 
+open System
 open System.Text
 open System.Collections.Generic
 open Internal.Utilities
@@ -91,6 +92,8 @@ type range =
 
     /// The range where all values are zero
     static member Zero : range
+
+    interface IEquatable<range>
 
 /// This view of range marks uses file indexes explicitly 
 val mkFileIndexRange : FileIndex -> pos -> pos -> range