[CompilerPerf] Extends #5112 ideas to Comparers (i.e >, >=, <, <= and LanguagePrimitives.FastGenericComparer)

src/fsharp/FSharp.Core/local.fs

@@ -990,8 +990,12 @@ module internal Array =
 
     open System
 
-    let inline fastComparerForArraySort<'t when 't : comparison> () =
-        LanguagePrimitives.FastGenericComparerCanBeNull<'t>
+    let inline getInternalComparer<'t when 't : comparison> () =
+        // Previously a "comparer" was returned the could be null, which was for optimized Array.Sort
+        // but we now mainly return Comparer.Default (and FastGenericComparerInternal more so)
+        // which is also optimized in Array.Sort
+        // ** this comment can be destroyed sometime in the future, it is just as a breadcrumb for review **
+        LanguagePrimitives.FastGenericComparerInternal<'t>
 
     // The input parameter should be checked by callers if necessary
     let inline zeroCreateUnchecked (count:int) = 
@@ -1089,26 +1093,26 @@ module internal Array =
             let keys = zeroCreateUnchecked array.Length
             for i = 0 to array.Length - 1 do 
                 keys.[i] <- projection array.[i]
-            Array.Sort<_,_>(keys, array, fastComparerForArraySort())
+            Array.Sort<_,_>(keys, array, getInternalComparer())
 
     let unstableSortInPlace (array : array<'T>) = 
         let len = array.Length 
         if len < 2 then () 
-        else Array.Sort<_>(array, fastComparerForArraySort())
+        else Array.Sort<_>(array, getInternalComparer())
 
-    let stableSortWithKeysAndComparer (cFast:IComparer<'Key>) (c:IComparer<'Key>) (array:array<'T>) (keys:array<'Key>)  =
+    let stableSortWithKeysAndComparer (c:IComparer<'Key>) (array:array<'T>) (keys:array<'Key>)  =
         // 'places' is an array or integers storing the permutation performed by the sort
         let places = zeroCreateUnchecked array.Length 
         for i = 0 to array.Length - 1 do 
             places.[i] <- i 
-        System.Array.Sort<_,_>(keys, places, cFast)
+        System.Array.Sort<_,_>(keys, places, c)
         // 'array2' is a copy of the original values
         let array2 = (array.Clone() :?> array<'T>)
 
         // Walk through any chunks where the keys are equal
         let mutable i = 0
         let len = array.Length
-        let intCompare = fastComparerForArraySort<int>()
+        let intCompare = getInternalComparer<int>()
 
         while i < len do 
             let mutable j = i
@@ -1123,9 +1127,8 @@ module internal Array =
             i <- j
 
     let stableSortWithKeys (array:array<'T>) (keys:array<'Key>) =
-        let cFast = fastComparerForArraySort()
-        let c = LanguagePrimitives.FastGenericComparer<'Key>
-        stableSortWithKeysAndComparer cFast c array keys
+        let c = getInternalComparer()
+        stableSortWithKeysAndComparer c array keys
 
     let stableSortInPlaceBy (projection: 'T -> 'U) (array : array<'T>) =
         let len = array.Length 
@@ -1141,13 +1144,11 @@ module internal Array =
         let len = array.Length 
         if len < 2 then () 
         else
-            let cFast = LanguagePrimitives.FastGenericComparerCanBeNull<'T>
-            match cFast with 
-            | null -> 
+            if LanguagePrimitives.EquivalentForStableAndUnstableSort<'T> then
                 // An optimization for the cases where the keys and values coincide and do not have identity, e.g. are integers
                 // In this case an unstable sort is just as good as a stable sort (and faster)
                 Array.Sort<_,_>(array, null)
-            | _ -> 
+            else
                 // 'keys' is an array storing the projected keys
                 let keys = (array.Clone() :?> array<'T>)
                 stableSortWithKeys array keys
@@ -1158,7 +1159,7 @@ module internal Array =
             let keys = (array.Clone() :?> array<'T>)
             let comparer = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(comparer)
             let c = { new IComparer<'T> with member __.Compare(x,y) = comparer.Invoke(x,y) }
-            stableSortWithKeysAndComparer c c array keys
+            stableSortWithKeysAndComparer c array keys
 
     let inline subUnchecked startIndex count (array : 'T[]) =
         let res = zeroCreateUnchecked count : 'T[]

src/fsharp/FSharp.Core/prim-types.fsi

@@ -952,7 +952,10 @@ namespace Microsoft.FSharp.Core
         val inline FastGenericComparer<'T>  : System.Collections.Generic.IComparer<'T> when 'T : comparison 
 
         /// <summary>Make an F# comparer object for the given type, where it can be null if System.Collections.Generic.Comparer&lt;'T&gt;.Default</summary>
-        val internal FastGenericComparerCanBeNull<'T>  : System.Collections.Generic.IComparer<'T> when 'T : comparison 
+        val internal FastGenericComparerInternal<'T>  : System.Collections.Generic.Comparer<'T> when 'T : comparison 
+
+        /// As an optimization, determine if a fast unstable sort can be used with equivalent results
+        val internal EquivalentForStableAndUnstableSort<'T> : bool
 
         /// <summary>Make an F# hash/equality object for the given type</summary>
         val inline FastGenericEqualityComparer<'T> : System.Collections.Generic.IEqualityComparer<'T> when 'T : equality
@@ -1238,6 +1241,26 @@ namespace Microsoft.FSharp.Core
 
         /// <summary>The F# compiler emits calls to some of the functions in this module as part of the compiled form of some language constructs</summary>
         module HashCompare =
+            [<AbstractClass; Sealed>]
+            type FSharpEqualityComparer_ER<'T> =
+                static member EqualityComparer : System.Collections.Generic.EqualityComparer<'T>
+
+            [<AbstractClass; Sealed>]
+            type FSharpEqualityComparer_PER<'T> =
+                static member EqualityComparer : System.Collections.Generic.EqualityComparer<'T>
+
+            /// <summary>A primitive entry point used by the F# compiler for optimization purposes.</summary> 
+            [<CompilerMessage("This function is a primitive library routine used by optimized F# code and should not be used directly", 1204, IsHidden=true)>]
+            val inline FSharpEqualityComparer_ER_Equals : x:'T -> y:'T -> bool
+
+            /// <summary>A primitive entry point used by the F# compiler for optimization purposes.</summary> 
+            [<CompilerMessage("This function is a primitive library routine used by optimized F# code and should not be used directly", 1204, IsHidden=true)>]
+            val inline FSharpEqualityComparer_PER_Equals : x:'T -> y:'T -> bool
+
+            /// <summary>A primitive entry point used by the F# compiler for optimization purposes.</summary> 
+            [<CompilerMessage("This function is a primitive library routine used by optimized F# code and should not be used directly", 1204, IsHidden=true)>]
+            val inline FSharpEqualityComparer_GetHashCode : x:'T -> int
+
             /// <summary>A primitive entry point used by the F# compiler for optimization purposes.</summary> 
             [<CompilerMessage("This function is a primitive library routine used by optimized F# code and should not be used directly", 1204, IsHidden=true)>]
             val PhysicalHashIntrinsic : input:'T -> int when 'T : not struct

src/fsharp/Optimizer.fs

@@ -2328,12 +2328,15 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
     //   REVIEW: GenericEqualityIntrinsic (which has no comparer) implements PER semantics (5537: this should be ER semantics)
     //           We are devirtualizing to a Equals(T) method which also implements PER semantics (5537: this should be ER semantics)
     | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_er_inner_vref ty args ->
-         
+        let tyargsOriginal = tyargs
         let tcref, tyargs = StripToNominalTyconRef cenv ty 
         match tcref.GeneratedHashAndEqualsValues with 
         | Some (_, vref)  -> Some (DevirtualizeApplication cenv env vref ty tyargs args m)
-        | _ -> None
-
+        | _ ->
+            // if type of generic argument has no generated equality operators, covert to "FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals"
+            match cenv.g.fsharpEqualityComparer_ER_Equals_vref.TryDeref with
+            | ValueNone -> None // referencing old version of FSharp.Core.dll
+            | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_ER_Equals_vref ty tyargsOriginal args m)
 
     // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerFast
     | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_withc_inner_vref ty args ->
@@ -2345,23 +2348,33 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
             Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m)
         | _ -> None 
 
-    // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparer
+    // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic
     | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_per_inner_vref ty args  && not(isRefTupleTy cenv.g ty) ->
+       let tyargsOriginal = tyargs
        let tcref, tyargs = StripToNominalTyconRef cenv ty
        match tcref.GeneratedHashAndEqualsWithComparerValues, args with
        | Some (_, _, withcEqualsVal), [x; y] -> 
            let args2 = [x; mkRefTupledNoTypes cenv.g m [mkCoerceExpr(y, cenv.g.obj_ty, m, ty); (mkCallGetGenericPEREqualityComparer cenv.g m)]]
            Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m)
-       | _ -> None     
+       | _ ->
+           // if type of generic argument has no generated equality operators, covert to "FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals"
+           match cenv.g.fsharpEqualityComparer_PER_Equals_vref.TryDeref with
+           | ValueNone -> None // referencing old version of FSharp.Core.dll
+           | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_PER_Equals_vref ty tyargsOriginal args m)
 
     // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashIntrinsic
     | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_inner_vref ty args ->
+        let tyargsOriginal = tyargs
         let tcref, tyargs = StripToNominalTyconRef cenv ty
         match tcref.GeneratedHashAndEqualsWithComparerValues, args with
         | Some (_, withcGetHashCodeVal, _), [x] -> 
             let args2 = [x; mkCallGetGenericEREqualityComparer cenv.g m]
             Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m)
-        | _ -> None 
+        | _ ->
+            // if type of generic argument has no generated equality operators, covert to "FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode"
+            match cenv.g.fsharpEqualityComparer_GetHashCode_vref.TryDeref with
+            | ValueNone -> None // referencing old version of FSharp.Core.dll
+            | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_GetHashCode_vref ty tyargsOriginal args m)
 
     // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic
     | Expr.Val(v, _, _), [ty], _ when  CanDevirtualizeApplication cenv v cenv.g.generic_hash_withc_inner_vref ty args ->
@@ -2416,6 +2429,24 @@ 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
+
+    // "GenericEqualityIntrinsic" when found in a generic context, convert to "FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals"
+    | Expr.Val(v, _, _), [(TType_var t) as ty], _ when (not cenv.g.compilingFslib) && valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref && t.Rigidity = TyparRigidity.Rigid ->
+        match cenv.g.fsharpEqualityComparer_PER_Equals_vref.TryDeref with
+        | ValueNone -> None // referencing old version of FSharp.Core.dll
+        | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_PER_Equals_vref ty tyargs args m)
+
+    // "GenericEqualityERIntrinsic" when found in a generic context, convert to "FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals"
+    | Expr.Val(v, _, _), [(TType_var t) as ty], _ when (not cenv.g.compilingFslib) && valRefEq cenv.g v cenv.g.generic_equality_er_inner_vref && t.Rigidity = TyparRigidity.Rigid ->
+        match cenv.g.fsharpEqualityComparer_ER_Equals_vref.TryDeref with
+        | ValueNone -> None // referencing old version of FSharp.Core.dll
+        | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_ER_Equals_vref ty tyargs args m)
+
+    // "GenericHashIntrinsic"  when found in a generic context, convert to "FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode"
+    | Expr.Val(v, _, _), [(TType_var t) as ty], _ when (not cenv.g.compilingFslib) && valRefEq cenv.g v cenv.g.generic_hash_inner_vref && t.Rigidity = TyparRigidity.Rigid ->
+        match cenv.g.fsharpEqualityComparer_GetHashCode_vref.TryDeref with
+        | ValueNone -> None // referencing old version of FSharp.Core.dll
+        | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_GetHashCode_vref ty tyargs args m)
 
     // 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 ->

src/fsharp/TcGlobals.fs

@@ -583,6 +583,10 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
   let v_generic_comparison_inner_info       = makeIntrinsicValRef(fslib_MFHashCompare_nleref,                  "GenericComparisonIntrinsic"           , None                 , None          , [vara],     mk_compare_sig varaTy)
   let v_generic_comparison_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref,                  "GenericComparisonWithComparerIntrinsic", None                , None          , [vara],     mk_compare_withc_sig varaTy)
 
+  let v_FSharpEqualityComparer_PER_Equals_info      = makeIntrinsicValRef(fslib_MFHashCompare_nleref,          "FSharpEqualityComparer_PER_Equals"     , None                , None          , [vara],     mk_rel_sig varaTy)
+  let v_FSharpEqualityComparer_GetHashCode_info     = makeIntrinsicValRef(fslib_MFHashCompare_nleref,          "FSharpEqualityComparer_GetHashCode", None                , None          , [vara],     mk_hash_sig varaTy)
+  let v_FSharpEqualityComparer_ER_Equals_info       = makeIntrinsicValRef(fslib_MFHashCompare_nleref,          "FSharpEqualityComparer_ER_Equals"      , None                , None          , [vara],     mk_rel_sig varaTy)
+
   let v_generic_hash_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref,                              "GenericHashIntrinsic"                 , None                 , None          , [vara],     mk_hash_sig varaTy)
   let v_generic_hash_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref,                        "GenericHashWithComparerIntrinsic"     , None                 , None          , [vara],     mk_hash_withc_sig  varaTy)
 
@@ -1220,6 +1224,9 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
   member __.generic_hash_withc_outer_info = v_generic_hash_withc_outer_info
   member val generic_hash_inner_vref = ValRefForIntrinsic v_generic_hash_inner_info
   member val generic_hash_withc_inner_vref = ValRefForIntrinsic v_generic_hash_withc_inner_info
+  member val fsharpEqualityComparer_ER_Equals_vref   = ValRefForIntrinsic v_FSharpEqualityComparer_ER_Equals_info      
+  member val fsharpEqualityComparer_PER_Equals_vref  = ValRefForIntrinsic v_FSharpEqualityComparer_PER_Equals_info     
+  member val fsharpEqualityComparer_GetHashCode_vref = ValRefForIntrinsic v_FSharpEqualityComparer_GetHashCode_info
 
   member val reference_equality_inner_vref         = ValRefForIntrinsic v_reference_equality_inner_info