diff --git a/src/fsharp/FSharp.Core/FSharp.Core.fsproj b/src/fsharp/FSharp.Core/FSharp.Core.fsproj index f7267fe0d84..305b1f30da2 100644 --- a/src/fsharp/FSharp.Core/FSharp.Core.fsproj +++ b/src/fsharp/FSharp.Core/FSharp.Core.fsproj @@ -108,6 +108,9 @@ Collections/array3.fs + + Collections/mapsetcmp.fs + Collections/map.fsi diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 1b8f9ec073e..1345dcee9b8 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -2,11 +2,8 @@ namespace Microsoft.FSharp.Collections open System -open System.Collections open System.Collections.Generic open System.Diagnostics -open System.Numerics -open System.Reflection open System.Runtime.CompilerServices open System.Text open Microsoft.FSharp.Core @@ -30,120 +27,10 @@ type internal MapTreeNode<'Key, 'Value>(k:'Key, v:'Value, left:MapTree<'Key, 'Va [] module MapTree = + open MapSetDefaultComparison let empty = null - type CompareHelper<'T when 'T : comparison>() = - static let c = LanguagePrimitives.FastGenericComparer - - // A constrained call to IComparable<'T>.CompareTo - static member private CompareCG<'U when 'U :> IComparable<'U>>(l:'U, r:'U):int = l.CompareTo(r) - - // A call to IComparable.CompareTo - static member private CompareC<'U when 'U :> IComparable>(l:'U, r:'U):int = l.CompareTo(r) - - static member val CompareToDlg : Func<'T,'T,int> = - let dlg = - let ty = typeof<'T> - try - let normalCmp = - not (typeof.IsAssignableFrom(ty)) - && isNull (Attribute.GetCustomAttribute(ty, typeof)) - && isNull (Attribute.GetCustomAttribute(ty, typeof)) - && not (ty.IsArray) - - // See #816, IComparable<'T> actually does not satisfy comparison constraint, but it should be preferred - if typeof>.IsAssignableFrom(ty) then - let m = - typeof>.GetMethod("CompareCG", BindingFlags.NonPublic ||| BindingFlags.Static) - .MakeGenericMethod([|ty|]) - Delegate.CreateDelegate(typeof>, m) :?> Func<'T,'T,int> - elif typeof.IsAssignableFrom(ty) && normalCmp then - let m = - typeof>.GetMethod("CompareC", BindingFlags.NonPublic ||| BindingFlags.Static) - .MakeGenericMethod([|typeof<'T>|]) - Delegate.CreateDelegate(typeof>, m) :?> Func<'T,'T,int> - else null - with _ -> null - dlg - with get - - // If backed by static readonly field that will be JIT-time constant - static member val IsIComparable = not(isNull CompareHelper<'T>.CompareToDlg) with get - - [] - static member Compare(l:'T, r:'T):int = - // Should use IsIComparable when it's backed by static readonly field - if isNull CompareHelper<'T>.CompareToDlg then - c.Compare(l, r) - else - CompareHelper<'T>.CompareToDlg.Invoke(l,r) - - // Constructors are not inlined by F#, but JIT could inline them. - // This is what we need here, because LanguagePrimitives.FastGenericComparer.Compare - // has a .tail prefix that breaks the typeof(T)==typeof(...) JIT optimization in cmp - // A struct with a single int field should be lowered by JIT. - [] - [] - type Comparison<'T when 'T : comparison> = - struct - val Value: int - [] - new(l:'T,r:'T) = { Value = CompareHelper<'T>.Compare(l, r) } - end - - [] - let cmp<'T when 'T : comparison> (l:'T) (r:'T) : int = - // See the pattern explanation: https://github.com/dotnet/runtime/blob/4b8d10154c39b1f56424d4ba2068a3150d90d475/src/libraries/System.Private.CoreLib/src/System/Numerics/Vector_1.cs#L14 - // All types that implement IComparable<'T> and are accessible here without additional dependencies should be in the list - if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then - unbox(box(l)).ToInt64().CompareTo( (unbox(box(r))).ToInt64()) - else if Type.op_Equality(typeof<'T>, typeof) then - unbox(box(l)).ToUInt64().CompareTo( (unbox(box(r))).ToUInt64()) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - - // F# rules for floats - else if Type.op_Equality(typeof<'T>, typeof) then - let l = unbox(box(l)) - let r = unbox(box(r)) - if l < r then (-1) - elif l > r then (1) - elif l = r then (0) - elif r = r then (-1) - elif l = l then (1) - else 0 - else if Type.op_Equality(typeof<'T>, typeof) then - let l = unbox(box(l)) - let r = unbox(box(r)) - if l < r then (-1) - elif l > r then (1) - elif l = r then (0) - elif r = r then (-1) - elif l = l then (1) - else 0 - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) - - else if Type.op_Equality(typeof<'T>, typeof) then - // same as in GenericComparisonFast - String.CompareOrdinal(unbox(box(l)),(unbox(box(r)))) - - else Comparison(l,r).Value - let inline isEmpty (m:MapTree<'Key, 'Value>) = isNull m let inline private asNode(value:MapTree<'Key,'Value>) : MapTreeNode<'Key,'Value> = @@ -865,7 +752,7 @@ type Map<[]'Key, [ as m2-> Seq.compareWith (fun (kvp1 : KeyValuePair<_, _>) (kvp2 : KeyValuePair<_, _>)-> - let c = MapTree.cmp kvp1.Key kvp2.Key in + let c = MapSetDefaultComparison.cmp kvp1.Key kvp2.Key in if c <> 0 then c else Unchecked.compare kvp1.Value kvp2.Value) m m2 | _ -> diff --git a/src/fsharp/FSharp.Core/mapsetcmp.fs b/src/fsharp/FSharp.Core/mapsetcmp.fs new file mode 100644 index 00000000000..d05f73ab337 --- /dev/null +++ b/src/fsharp/FSharp.Core/mapsetcmp.fs @@ -0,0 +1,122 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +namespace Microsoft.FSharp.Collections + +open System +open System.Collections +open System.Numerics +open System.Reflection +open System.Runtime.CompilerServices +open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators + +module internal MapSetDefaultComparison = + type CompareHelper<'T when 'T : comparison>() = + static let c = LanguagePrimitives.FastGenericComparer + + // A constrained call to IComparable<'T>.CompareTo + static member private CompareCG<'U when 'U :> IComparable<'U>>(l:'U, r:'U):int = l.CompareTo(r) + + // A call to IComparable.CompareTo + static member private CompareC<'U when 'U :> IComparable>(l:'U, r:'U):int = l.CompareTo(r) + + static member val CompareToDlg : Func<'T,'T,int> = + let dlg = + let ty = typeof<'T> + try + let normalCmp = + not (typeof.IsAssignableFrom(ty)) + && isNull (Attribute.GetCustomAttribute(ty, typeof)) + && isNull (Attribute.GetCustomAttribute(ty, typeof)) + && not (ty.IsArray) + + // See #816, IComparable<'T> actually does not satisfy comparison constraint, but it should be preferred + if typeof>.IsAssignableFrom(ty) then + let m = + typeof>.GetMethod("CompareCG", BindingFlags.NonPublic ||| BindingFlags.Static) + .MakeGenericMethod([|ty|]) + Delegate.CreateDelegate(typeof>, m) :?> Func<'T,'T,int> + elif typeof.IsAssignableFrom(ty) && normalCmp then + let m = + typeof>.GetMethod("CompareC", BindingFlags.NonPublic ||| BindingFlags.Static) + .MakeGenericMethod([|typeof<'T>|]) + Delegate.CreateDelegate(typeof>, m) :?> Func<'T,'T,int> + else null + with _ -> null + dlg + with get + + // If backed by static readonly field that will be JIT-time constant + static member val IsIComparable = not(isNull CompareHelper<'T>.CompareToDlg) with get + + [] + static member Compare(l:'T, r:'T):int = + // Should use IsIComparable when it's backed by static readonly field + if isNull CompareHelper<'T>.CompareToDlg then + c.Compare(l, r) + else + CompareHelper<'T>.CompareToDlg.Invoke(l,r) + + // Constructors are not inlined by F#, but JIT could inline them. + // This is what we need here, because LanguagePrimitives.FastGenericComparer.Compare + // has a .tail prefix that breaks the typeof(T)==typeof(...) JIT optimization in cmp + // A struct with a single int field should be lowered by JIT. + [] + [] + type Comparison<'T when 'T : comparison> = + struct + val Value: int + [] + new(l:'T,r:'T) = { Value = CompareHelper<'T>.Compare(l, r) } + end + + [] + let cmp<'T when 'T : comparison> (l:'T) (r:'T) : int = + // See the pattern explanation: https://github.com/dotnet/runtime/blob/4b8d10154c39b1f56424d4ba2068a3150d90d475/src/libraries/System.Private.CoreLib/src/System/Numerics/Vector_1.cs#L14 + // All types that implement IComparable<'T> and are accessible here without additional dependencies should be in the list + if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then + unbox(box(l)).ToInt64().CompareTo( (unbox(box(r))).ToInt64()) + else if Type.op_Equality(typeof<'T>, typeof) then + unbox(box(l)).ToUInt64().CompareTo( (unbox(box(r))).ToUInt64()) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + + // F# rules for floats + else if Type.op_Equality(typeof<'T>, typeof) then + let l = unbox(box(l)) + let r = unbox(box(r)) + if l < r then (-1) + elif l > r then (1) + elif l = r then (0) + elif r = r then (-1) + elif l = l then (1) + else 0 + else if Type.op_Equality(typeof<'T>, typeof) then + let l = unbox(box(l)) + let r = unbox(box(r)) + if l < r then (-1) + elif l > r then (1) + elif l = r then (0) + elif r = r then (-1) + elif l = l then (1) + else 0 + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + else if Type.op_Equality(typeof<'T>, typeof) then unbox(box(l)).CompareTo(unbox(box(r))) + + else if Type.op_Equality(typeof<'T>, typeof) then + // same as in GenericComparisonFast + String.CompareOrdinal(unbox(box(l)),(unbox(box(r)))) + + else Comparison(l,r).Value \ No newline at end of file