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