From 648b95feac77db70511f5592f33e90935155a748 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 5 Jun 2018 16:42:01 +1000 Subject: [PATCH 01/64] Helper function for FastGenericEqualityComparerTable --- src/fsharp/FSharp.Core/prim-types.fs | 42 ++++++++++++++++------------ 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index d04a8f8b45c..08e74cda169 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -2112,27 +2112,33 @@ namespace Microsoft.FSharp.Core let Float32IEquality = MakeGenericEqualityComparer() let DecimalIEquality = MakeGenericEqualityComparer() + let tryGetFastGenericEqualityComparerTable (ty:Type) = + match ty with + | ty when ty.Equals typeof -> box BoolIEquality + | ty when ty.Equals typeof -> box ByteIEquality + | ty when ty.Equals typeof -> box Int32IEquality + | ty when ty.Equals typeof -> box UInt32IEquality + | ty when ty.Equals typeof -> box CharIEquality + | ty when ty.Equals typeof -> box SByteIEquality + | ty when ty.Equals typeof -> box Int16IEquality + | ty when ty.Equals typeof -> box Int64IEquality + | ty when ty.Equals typeof -> box IntPtrIEquality + | ty when ty.Equals typeof -> box UInt16IEquality + | ty when ty.Equals typeof -> box UInt64IEquality + | ty when ty.Equals typeof -> box UIntPtrIEquality + | ty when ty.Equals typeof -> box FloatIEquality + | ty when ty.Equals typeof -> box Float32IEquality + | ty when ty.Equals typeof -> box DecimalIEquality + | ty when ty.Equals typeof -> box StringIEquality + | _ -> null + [] - type FastGenericEqualityComparerTable<'T>() = + type FastGenericEqualityComparerTable<'T>() = static let f : System.Collections.Generic.IEqualityComparer<'T> = - match typeof<'T> with - | ty when ty.Equals(typeof) -> unboxPrim (box BoolIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box ByteIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box Int32IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt32IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box CharIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box SByteIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box Int16IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box Int64IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box IntPtrIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt16IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt64IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box UIntPtrIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box FloatIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box Float32IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box DecimalIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box StringIEquality) + match tryGetFastGenericEqualityComparerTable typeof<'T> with + | :? System.Collections.Generic.IEqualityComparer<'T> as comp -> comp | _ -> MakeGenericEqualityComparer<'T>() + static member Function : System.Collections.Generic.IEqualityComparer<'T> = f let FastGenericEqualityComparerFromTable<'T> = FastGenericEqualityComparerTable<'T>.Function From 413b9e5226ec41a83130a24881271af188268f2f Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 5 Jun 2018 17:37:55 +1000 Subject: [PATCH 02/64] Use the default equality comparer where applicable --- src/fsharp/FSharp.Core/prim-types.fs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 08e74cda169..418adde82b6 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -2132,12 +2132,23 @@ namespace Microsoft.FSharp.Core | ty when ty.Equals typeof -> box StringIEquality | _ -> null + let canUseDefaultEqualityComparer (ty:Type) = + // avoid any types that need special handling in GenericEqualityObj + true + && ty.IsSealed // covers enum and value types + && not (typeof.IsAssignableFrom ty) + && not ty.IsArray + [] type FastGenericEqualityComparerTable<'T>() = static let f : System.Collections.Generic.IEqualityComparer<'T> = - match tryGetFastGenericEqualityComparerTable typeof<'T> with + let ty = typeof<'T> + match tryGetFastGenericEqualityComparerTable ty with | :? System.Collections.Generic.IEqualityComparer<'T> as comp -> comp - | _ -> MakeGenericEqualityComparer<'T>() + | _ -> + if canUseDefaultEqualityComparer ty + then unboxPrim (box System.Collections.Generic.EqualityComparer<'T>.Default) + else MakeGenericEqualityComparer<'T>() static member Function : System.Collections.Generic.IEqualityComparer<'T> = f From 64f65d68e6781953229888c72b355fe2b89fc136 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 5 Jun 2018 19:29:58 +1000 Subject: [PATCH 03/64] Avoid calls to GenericEqualityObj for known types --- src/fsharp/FSharp.Core/prim-types.fs | 56 +++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 418adde82b6..0e70a304037 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1532,12 +1532,63 @@ namespace Microsoft.FSharp.Core override iec.Equals(x:obj,y:obj) = GenericEqualityObj true iec (x,y) // ER Semantics override iec.GetHashCode(x:obj) = raise (InvalidOperationException (SR.GetString(SR.notUsedForHashing))) } + type IERorPER = interface end + type ER = inherit IERorPER + type PER = inherit IERorPER + + type GenericEqualityTCall<'T> = delegate of 'T * 'T -> bool + + let tryGetGenericEqualityTCall (er:bool) (ty:Type) : obj = + match er, ty with + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.String.Equals((# "" x : string #),(# "" y : string #)))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #)))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall(fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | false, ty when ty.Equals typeof-> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> + if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then + true + else + (# "ceq" x y : bool #))) + | true, ty when ty.Equals typeof -> box (GenericEqualityTCall(fun x y -> + if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then + true + else + (# "ceq" x y : bool #))) + | _ -> null + + type GenericEqualityT<'T, 'ERorPER when 'ERorPER :> IERorPER> private () = + static let f : GenericEqualityTCall<'T> = + let er = + if typeof<'ERorPER>.Equals typeof then true + elif typeof<'ERorPER>.Equals typeof then false + else raise (Exception "logic error") + match tryGetGenericEqualityTCall er typeof<'T> with + | :? GenericEqualityTCall<'T> as call -> call + | _ -> + if er + then GenericEqualityTCall<'T>(fun x y -> GenericEqualityObj true fsEqualityComparerNoHashingER (box x, box y)) + else GenericEqualityTCall<'T>(fun x y -> GenericEqualityObj false fsEqualityComparerNoHashingPER (box x, box y)) + + static member Function = f + /// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false) // // The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityIntrinsic (x : 'T) (y : 'T) : bool = - GenericEqualityObj false fsEqualityComparerNoHashingPER ((box x), (box y)) + GenericEqualityT<'T, PER>.Function.Invoke (x, y) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1546,7 +1597,7 @@ namespace Microsoft.FSharp.Core // The compiler optimizer is aware of this function (see use of generic_equality_er_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityERIntrinsic (x : 'T) (y : 'T) : bool = - GenericEqualityObj true fsEqualityComparerNoHashingER ((box x), (box y)) + GenericEqualityT<'T, ER>.Function.Invoke (x, y) /// Implements generic equality between two values using "comp" for recursive calls. // @@ -2113,6 +2164,7 @@ namespace Microsoft.FSharp.Core let DecimalIEquality = MakeGenericEqualityComparer() let tryGetFastGenericEqualityComparerTable (ty:Type) = + // TODO: Remove the ones that don't have special handling and thus just used default match ty with | ty when ty.Equals typeof -> box BoolIEquality | ty when ty.Equals typeof -> box ByteIEquality From 354c7b2908b31fb836a7581a79530e03141a55b0 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 6 Jun 2018 15:54:12 +1000 Subject: [PATCH 04/64] Avoid boxing in the "standard" use of GenericEqualityWithComparerIntrinsic --- src/fsharp/FSharp.Core/prim-types.fs | 66 ++++++++++++++-------------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 0e70a304037..ab5dc099a4a 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -771,6 +771,35 @@ namespace Microsoft.FSharp.Core let anyToStringShowingNull x = anyToString "null" x module HashCompare = + let defaultHashNodes = 18 + + /// The implementation of IEqualityComparer, using depth-limited for hashing and PER semantics for NaN equality. + type CountLimitedHasherPER(sz:int) = + [] + val mutable nodeCount : int + + member x.Fresh() = + if (System.Threading.Interlocked.CompareExchange(&(x.nodeCount), sz, 0) = 0) then + x + else + new CountLimitedHasherPER(sz) + + interface IEqualityComparer + + /// The implementation of IEqualityComparer, using unlimited depth for hashing and ER semantics for NaN equality. + type UnlimitedHasherER() = + interface IEqualityComparer + + /// The implementation of IEqualityComparer, using unlimited depth for hashing and PER semantics for NaN equality. + type UnlimitedHasherPER() = + interface IEqualityComparer + + + /// The unique object for unlimited depth for hashing and ER semantics for equality. + let fsEqualityComparerUnlimitedHashingER = UnlimitedHasherER() + + /// The unique object for unlimited depth for hashing and PER semantics for equality. + let fsEqualityComparerUnlimitedHashingPER = UnlimitedHasherPER() //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: Physical Equality @@ -1605,7 +1634,10 @@ namespace Microsoft.FSharp.Core // and devirtualizes calls to it based on "T", and under the assumption that "comp" // is either fsEqualityComparerNoHashingER or fsEqualityComparerNoHashingPER. let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool = - comp.Equals((box x),(box y)) + if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then + GenericEqualityT<'T, PER>.Function.Invoke (x, y) + else + comp.Equals (box x, box y) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) @@ -1696,38 +1728,6 @@ namespace Microsoft.FSharp.Core //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: HASHING. //------------------------------------------------------------------------- - - - - let defaultHashNodes = 18 - - /// The implementation of IEqualityComparer, using depth-limited for hashing and PER semantics for NaN equality. - type CountLimitedHasherPER(sz:int) = - [] - val mutable nodeCount : int - - member x.Fresh() = - if (System.Threading.Interlocked.CompareExchange(&(x.nodeCount), sz, 0) = 0) then - x - else - new CountLimitedHasherPER(sz) - - interface IEqualityComparer - - /// The implementation of IEqualityComparer, using unlimited depth for hashing and ER semantics for NaN equality. - type UnlimitedHasherER() = - interface IEqualityComparer - - /// The implementation of IEqualityComparer, using unlimited depth for hashing and PER semantics for NaN equality. - type UnlimitedHasherPER() = - interface IEqualityComparer - - - /// The unique object for unlimited depth for hashing and ER semantics for equality. - let fsEqualityComparerUnlimitedHashingER = UnlimitedHasherER() - - /// The unique object for unlimited depth for hashing and PER semantics for equality. - let fsEqualityComparerUnlimitedHashingPER = UnlimitedHasherPER() let inline HashCombine nr x y = (x <<< 1) + y + 631 * nr From 0dcd0f99e5b7c7a57472a98b48316891cd157d83 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 6 Jun 2018 16:21:18 +1000 Subject: [PATCH 05/64] Added method to avoid tail calls --- src/fsharp/FSharp.Core/prim-types.fs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index ab5dc099a4a..d275ef1f10a 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1612,12 +1612,16 @@ namespace Microsoft.FSharp.Core static member Function = f + // The FSharp compiler will not insert a tail call when this is used (this might be "fixed" + // in a future release) + let inline avoid_tail_call f = match f () with true -> true | _ -> false + /// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false) // // The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityIntrinsic (x : 'T) (y : 'T) : bool = - GenericEqualityT<'T, PER>.Function.Invoke (x, y) + avoid_tail_call (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1626,7 +1630,7 @@ namespace Microsoft.FSharp.Core // The compiler optimizer is aware of this function (see use of generic_equality_er_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityERIntrinsic (x : 'T) (y : 'T) : bool = - GenericEqualityT<'T, ER>.Function.Invoke (x, y) + avoid_tail_call (fun () -> GenericEqualityT<'T, ER>.Function.Invoke (x, y)) /// Implements generic equality between two values using "comp" for recursive calls. // @@ -1635,7 +1639,7 @@ namespace Microsoft.FSharp.Core // is either fsEqualityComparerNoHashingER or fsEqualityComparerNoHashingPER. let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then - GenericEqualityT<'T, PER>.Function.Invoke (x, y) + avoid_tail_call (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) else comp.Equals (box x, box y) From 189a7e97765528f0967a981c4964e89f04a0b385 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 6 Jun 2018 17:03:57 +1000 Subject: [PATCH 06/64] Implemented hashing --- src/fsharp/FSharp.Core/prim-types.fs | 66 ++++++++++++++++++++-------- 1 file changed, 48 insertions(+), 18 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index d275ef1f10a..7af39de7969 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1642,7 +1642,6 @@ namespace Microsoft.FSharp.Core avoid_tail_call (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) else comp.Equals (box x, box y) - /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1843,11 +1842,54 @@ namespace Microsoft.FSharp.Core override iec.Equals(x:obj,y:obj) = GenericEqualityObj false iec (x,y) override iec.GetHashCode(x:obj) = GenericHashParamObj iec x + /// Direct call to GetHashCode on the string type + let inline HashString (s:string) = + match s with + | null -> 0 + | _ -> (# "call instance int32 [mscorlib]System.String::GetHashCode()" s : int #) + + // from mscorlib v4.0.30319 + let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) + let inline HashSByte (x:sbyte) = (# "xor" (# "shl" x 8 : int #) x : int #) + let inline HashInt16 (x:int16) = (# "or" (# "conv.u2" x : int #) (# "shl" x 16 : int #) : int #) + let inline HashInt64 (x:int64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr" x 32 : int #) : int #) : int #) + let inline HashUInt64 (x:uint64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr.un" x 32 : int #) : int #) : int #) + let inline HashIntPtr (x:nativeint) = (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) + let inline HashUIntPtr (x:unativeint) = (# "and" (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) 0x7fffffff : int #) + + type GenericHashTCall<'T> = delegate of 'T -> int + + let tryGetGenericHashTCall (ty:Type) : obj = + match ty with + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall HashChar) + | ty when ty.Equals typeof -> box (GenericHashTCall HashSByte) + | ty when ty.Equals typeof -> box (GenericHashTCall HashInt16) + | ty when ty.Equals typeof -> box (GenericHashTCall HashInt64) + | ty when ty.Equals typeof -> box (GenericHashTCall HashUInt64) + | ty when ty.Equals typeof -> box (GenericHashTCall HashIntPtr) + | ty when ty.Equals typeof -> box (GenericHashTCallHashUIntPtr) + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall HashString) + | _ -> null + + type GenericHashT<'T> private () = + static let f : GenericHashTCall<'T> = + match tryGetGenericHashTCall typeof<'T> with + | :? GenericHashTCall<'T> as call -> call + | _ -> GenericHashTCall<'T>(fun x -> GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x)) + + static member Function = f + /// Intrinsic for calls to depth-unlimited structural hashing that were not optimized by static conditionals. // // NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_inner_vref in opt.fs) // and devirtualizes calls to it based on type "T". - let GenericHashIntrinsic input = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box input) + let GenericHashIntrinsic input = + GenericHashT<'T>.Function.Invoke input /// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals. let LimitedGenericHashIntrinsic limit input = GenericHashParamObj (CountLimitedHasherPER(limit)) (box input) @@ -1860,23 +1902,11 @@ namespace Microsoft.FSharp.Core // NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_withc_inner_vref in opt.fs) // and devirtualizes calls to it based on type "T". let GenericHashWithComparerIntrinsic<'T> (comp : System.Collections.IEqualityComparer) (input : 'T) : int = - GenericHashParamObj comp (box input) + if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then + GenericHashT<'T>.Function.Invoke input + else + GenericHashParamObj comp (box input) - /// Direct call to GetHashCode on the string type - let inline HashString (s:string) = - match s with - | null -> 0 - | _ -> (# "call instance int32 [mscorlib]System.String::GetHashCode()" s : int #) - - // from mscorlib v4.0.30319 - let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) - let inline HashSByte (x:sbyte) = (# "xor" (# "shl" x 8 : int #) x : int #) - let inline HashInt16 (x:int16) = (# "or" (# "conv.u2" x : int #) (# "shl" x 16 : int #) : int #) - let inline HashInt64 (x:int64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr" x 32 : int #) : int #) : int #) - let inline HashUInt64 (x:uint64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr.un" x 32 : int #) : int #) : int #) - let inline HashIntPtr (x:nativeint) = (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) - let inline HashUIntPtr (x:unativeint) = (# "and" (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) 0x7fffffff : int #) - /// Core entry into structural hashing for either limited or unlimited hashing. // // "iec" is assumed to be either fsEqualityComparerUnlimitedHashingER, fsEqualityComparerUnlimitedHashingPER or From 8fc8fcdc2329661e9e37b81467e543b325b19514 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 6 Jun 2018 17:24:41 +1000 Subject: [PATCH 07/64] Additional use of EqualityComparer.Default --- src/fsharp/FSharp.Core/prim-types.fs | 39 ++++++++++++++++------------ 1 file changed, 23 insertions(+), 16 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 7af39de7969..57379a4e536 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1565,6 +1565,18 @@ namespace Microsoft.FSharp.Core type ER = inherit IERorPER type PER = inherit IERorPER + let canUseDefaultEqualityComparer (ty:Type) = + // avoid any types that need special handling in GenericEqualityObj + true + && ty.IsSealed // covers enum and value types + && not (typeof.IsAssignableFrom ty) + && not ty.IsArray + + // The FSharp compiler will not insert a tail call when this is used (this might be "fixed" + // in a future release) + let inline avoid_tail_call f = + match f () with true -> true | _ -> false + type GenericEqualityTCall<'T> = delegate of 'T * 'T -> bool let tryGetGenericEqualityTCall (er:bool) (ty:Type) : obj = @@ -1605,17 +1617,16 @@ namespace Microsoft.FSharp.Core else raise (Exception "logic error") match tryGetGenericEqualityTCall er typeof<'T> with | :? GenericEqualityTCall<'T> as call -> call - | _ -> - if er - then GenericEqualityTCall<'T>(fun x y -> GenericEqualityObj true fsEqualityComparerNoHashingER (box x, box y)) - else GenericEqualityTCall<'T>(fun x y -> GenericEqualityObj false fsEqualityComparerNoHashingPER (box x, box y)) + | _ when canUseDefaultEqualityComparer typeof<'T> -> + let comparer = System.Collections.Generic.EqualityComparer<'T>.Default + GenericEqualityTCall<'T>(fun x y -> avoid_tail_call (fun () -> comparer.Equals (x, y))) + | _ when er -> + GenericEqualityTCall<'T>(fun x y -> GenericEqualityObj true fsEqualityComparerNoHashingER (box x, box y)) + | _ -> + GenericEqualityTCall<'T>(fun x y -> GenericEqualityObj false fsEqualityComparerNoHashingPER (box x, box y)) static member Function = f - // The FSharp compiler will not insert a tail call when this is used (this might be "fixed" - // in a future release) - let inline avoid_tail_call f = match f () with true -> true | _ -> false - /// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false) // // The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs) @@ -1880,6 +1891,9 @@ namespace Microsoft.FSharp.Core static let f : GenericHashTCall<'T> = match tryGetGenericHashTCall typeof<'T> with | :? GenericHashTCall<'T> as call -> call + | _ when canUseDefaultEqualityComparer typeof<'T> -> + let comparer = System.Collections.Generic.EqualityComparer<'T>.Default + GenericHashTCall<'T> comparer.GetHashCode | _ -> GenericHashTCall<'T>(fun x -> GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x)) static member Function = f @@ -2218,13 +2232,6 @@ namespace Microsoft.FSharp.Core | ty when ty.Equals typeof -> box StringIEquality | _ -> null - let canUseDefaultEqualityComparer (ty:Type) = - // avoid any types that need special handling in GenericEqualityObj - true - && ty.IsSealed // covers enum and value types - && not (typeof.IsAssignableFrom ty) - && not ty.IsArray - [] type FastGenericEqualityComparerTable<'T>() = static let f : System.Collections.Generic.IEqualityComparer<'T> = @@ -2232,7 +2239,7 @@ namespace Microsoft.FSharp.Core match tryGetFastGenericEqualityComparerTable ty with | :? System.Collections.Generic.IEqualityComparer<'T> as comp -> comp | _ -> - if canUseDefaultEqualityComparer ty + if HashCompare.canUseDefaultEqualityComparer ty then unboxPrim (box System.Collections.Generic.EqualityComparer<'T>.Default) else MakeGenericEqualityComparer<'T>() From e4be905dac7c790a27abd95def6329530da2bce9 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 6 Jun 2018 17:46:52 +1000 Subject: [PATCH 08/64] Consistent naming --- src/fsharp/FSharp.Core/prim-types.fs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 57379a4e536..6c9e5f6a859 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1574,8 +1574,9 @@ namespace Microsoft.FSharp.Core // The FSharp compiler will not insert a tail call when this is used (this might be "fixed" // in a future release) - let inline avoid_tail_call f = - match f () with true -> true | _ -> false + let inline avoid_tail_call_bool f = match f () with true -> true | _ -> false + let inline avoid_tail_call_int f = 0 + f () + type GenericEqualityTCall<'T> = delegate of 'T * 'T -> bool @@ -1619,7 +1620,7 @@ namespace Microsoft.FSharp.Core | :? GenericEqualityTCall<'T> as call -> call | _ when canUseDefaultEqualityComparer typeof<'T> -> let comparer = System.Collections.Generic.EqualityComparer<'T>.Default - GenericEqualityTCall<'T>(fun x y -> avoid_tail_call (fun () -> comparer.Equals (x, y))) + GenericEqualityTCall<'T>(fun x y -> avoid_tail_call_bool (fun () -> comparer.Equals (x, y))) | _ when er -> GenericEqualityTCall<'T>(fun x y -> GenericEqualityObj true fsEqualityComparerNoHashingER (box x, box y)) | _ -> @@ -1632,7 +1633,7 @@ namespace Microsoft.FSharp.Core // The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityIntrinsic (x : 'T) (y : 'T) : bool = - avoid_tail_call (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) + avoid_tail_call_bool (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1641,7 +1642,7 @@ namespace Microsoft.FSharp.Core // The compiler optimizer is aware of this function (see use of generic_equality_er_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityERIntrinsic (x : 'T) (y : 'T) : bool = - avoid_tail_call (fun () -> GenericEqualityT<'T, ER>.Function.Invoke (x, y)) + avoid_tail_call_bool (fun () -> GenericEqualityT<'T, ER>.Function.Invoke (x, y)) /// Implements generic equality between two values using "comp" for recursive calls. // @@ -1650,7 +1651,7 @@ namespace Microsoft.FSharp.Core // is either fsEqualityComparerNoHashingER or fsEqualityComparerNoHashingPER. let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then - avoid_tail_call (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) + avoid_tail_call_bool (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) else comp.Equals (box x, box y) @@ -1893,8 +1894,9 @@ namespace Microsoft.FSharp.Core | :? GenericHashTCall<'T> as call -> call | _ when canUseDefaultEqualityComparer typeof<'T> -> let comparer = System.Collections.Generic.EqualityComparer<'T>.Default - GenericHashTCall<'T> comparer.GetHashCode - | _ -> GenericHashTCall<'T>(fun x -> GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x)) + GenericHashTCall<'T> (fun x -> avoid_tail_call_int (fun () -> comparer.GetHashCode x)) + | _ -> + GenericHashTCall<'T> (fun x -> GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x)) static member Function = f @@ -1903,7 +1905,7 @@ namespace Microsoft.FSharp.Core // NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_inner_vref in opt.fs) // and devirtualizes calls to it based on type "T". let GenericHashIntrinsic input = - GenericHashT<'T>.Function.Invoke input + avoid_tail_call_int (fun () -> GenericHashT<'T>.Function.Invoke input) /// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals. let LimitedGenericHashIntrinsic limit input = GenericHashParamObj (CountLimitedHasherPER(limit)) (box input) @@ -1917,7 +1919,7 @@ namespace Microsoft.FSharp.Core // and devirtualizes calls to it based on type "T". let GenericHashWithComparerIntrinsic<'T> (comp : System.Collections.IEqualityComparer) (input : 'T) : int = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then - GenericHashT<'T>.Function.Invoke input + avoid_tail_call_int (fun () -> GenericHashT<'T>.Function.Invoke input) else GenericHashParamObj comp (box input) From 67f3e9adef996c6585f33a74ed273eb307c673ae Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 7 Jun 2018 19:33:43 +1000 Subject: [PATCH 09/64] Fixed up by mix up my ERs with my PERs! --- src/fsharp/FSharp.Core/prim-types.fs | 36 ++++++++++++++-------------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 6c9e5f6a859..3b3a59ac3c6 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1582,28 +1582,28 @@ namespace Microsoft.FSharp.Core let tryGetGenericEqualityTCall (er:bool) (ty:Type) : obj = match er, ty with - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.String.Equals((# "" x : string #),(# "" y : string #)))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #)))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall(fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | false, ty when ty.Equals typeof-> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.String.Equals((# "" x : string #),(# "" y : string #)))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #)))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then true else (# "ceq" x y : bool #))) - | true, ty when ty.Equals typeof -> box (GenericEqualityTCall(fun x y -> + | false, ty when ty.Equals typeof -> box (GenericEqualityTCall(fun x y -> if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then true else From b6a207618c1e05c2e7c2a1729cdb3968a6eab697 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 7 Jun 2018 19:36:27 +1000 Subject: [PATCH 10/64] Apply De Morgan's law to make it a bit cleaner --- src/fsharp/FSharp.Core/prim-types.fs | 44 ++++++++++++---------------- 1 file changed, 18 insertions(+), 26 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 3b3a59ac3c6..7706b6a9d3c 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1582,32 +1582,24 @@ namespace Microsoft.FSharp.Core let tryGetGenericEqualityTCall (er:bool) (ty:Type) : obj = match er, ty with - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.String.Equals((# "" x : string #),(# "" y : string #)))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #)))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> - if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then - true - else - (# "ceq" x y : bool #))) - | false, ty when ty.Equals typeof -> box (GenericEqualityTCall(fun x y -> - if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then - true - else - (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.String.Equals((# "" x : string #),(# "" y : string #)))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #)))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) + | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) | _ -> null type GenericEqualityT<'T, 'ERorPER when 'ERorPER :> IERorPER> private () = From 984ee584e3ef7ce0a0a43df1437f83780af202da Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Fri, 8 Jun 2018 16:50:18 +1000 Subject: [PATCH 11/64] Argh, got the PER and ER mixed up even when I tried to fix. Now good (hopefully!) --- src/fsharp/FSharp.Core/prim-types.fs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 7706b6a9d3c..f95fc99afe9 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1577,7 +1577,6 @@ namespace Microsoft.FSharp.Core let inline avoid_tail_call_bool f = match f () with true -> true | _ -> false let inline avoid_tail_call_int f = 0 + f () - type GenericEqualityTCall<'T> = delegate of 'T * 'T -> bool let tryGetGenericEqualityTCall (er:bool) (ty:Type) : obj = @@ -1596,10 +1595,10 @@ namespace Microsoft.FSharp.Core | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) - | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) + | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) + | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) + | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) | _ -> null type GenericEqualityT<'T, 'ERorPER when 'ERorPER :> IERorPER> private () = @@ -1642,8 +1641,10 @@ namespace Microsoft.FSharp.Core // and devirtualizes calls to it based on "T", and under the assumption that "comp" // is either fsEqualityComparerNoHashingER or fsEqualityComparerNoHashingPER. let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool = - if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then + if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) || obj.ReferenceEquals (comp, fsEqualityComparerNoHashingPER) then avoid_tail_call_bool (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) + elif obj.ReferenceEquals (comp, fsEqualityComparerNoHashingER) then + avoid_tail_call_bool (fun () -> GenericEqualityT<'T, ER>.Function.Invoke (x, y)) else comp.Equals (box x, box y) From 9778b98436dd4b9067926e135ea9a675ca9a9d61 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Fri, 8 Jun 2018 17:11:34 +1000 Subject: [PATCH 12/64] Removed custom delegates by using System.Func --- src/fsharp/FSharp.Core/prim-types.fs | 102 ++++++++++++++------------- 1 file changed, 53 insertions(+), 49 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index f95fc99afe9..d0bc1a5920d 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1577,7 +1577,7 @@ namespace Microsoft.FSharp.Core let inline avoid_tail_call_bool f = match f () with true -> true | _ -> false let inline avoid_tail_call_int f = 0 + f () - type GenericEqualityTCall<'T> = delegate of 'T * 'T -> bool + type GenericEqualityTCall<'T> = Func<'T, 'T, bool> let tryGetGenericEqualityTCall (er:bool) (ty:Type) : obj = match er, ty with @@ -1601,22 +1601,24 @@ namespace Microsoft.FSharp.Core | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) | _ -> null - type GenericEqualityT<'T, 'ERorPER when 'ERorPER :> IERorPER> private () = - static let f : GenericEqualityTCall<'T> = - let er = - if typeof<'ERorPER>.Equals typeof then true - elif typeof<'ERorPER>.Equals typeof then false - else raise (Exception "logic error") - match tryGetGenericEqualityTCall er typeof<'T> with - | :? GenericEqualityTCall<'T> as call -> call - | _ when canUseDefaultEqualityComparer typeof<'T> -> - let comparer = System.Collections.Generic.EqualityComparer<'T>.Default - GenericEqualityTCall<'T>(fun x y -> avoid_tail_call_bool (fun () -> comparer.Equals (x, y))) - | _ when er -> - GenericEqualityTCall<'T>(fun x y -> GenericEqualityObj true fsEqualityComparerNoHashingER (box x, box y)) - | _ -> - GenericEqualityTCall<'T>(fun x y -> GenericEqualityObj false fsEqualityComparerNoHashingPER (box x, box y)) + let getGenericEquality<'T, 'ERorPER when 'ERorPER :> IERorPER> () = + let er = + if typeof<'ERorPER>.Equals typeof then true + elif typeof<'ERorPER>.Equals typeof then false + else raise (Exception "logic error") + + match tryGetGenericEqualityTCall er typeof<'T> with + | :? GenericEqualityTCall<'T> as call -> call + | _ when canUseDefaultEqualityComparer typeof<'T> -> + let comparer = System.Collections.Generic.EqualityComparer<'T>.Default + GenericEqualityTCall<'T> (fun x y -> avoid_tail_call_bool (fun () -> comparer.Equals (x, y))) + | _ when er -> + GenericEqualityTCall<'T> (fun x y -> GenericEqualityObj true fsEqualityComparerNoHashingER (box x, box y)) + | _ -> + GenericEqualityTCall<'T> (fun x y -> GenericEqualityObj false fsEqualityComparerNoHashingPER (box x, box y)) + type GenericEqualityT<'T, 'ERorPER when 'ERorPER :> IERorPER> private () = + static let f = getGenericEquality<'T, 'ERorPER> () static member Function = f /// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false) @@ -1862,35 +1864,36 @@ namespace Microsoft.FSharp.Core let inline HashIntPtr (x:nativeint) = (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) let inline HashUIntPtr (x:unativeint) = (# "and" (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) 0x7fffffff : int #) - type GenericHashTCall<'T> = delegate of 'T -> int + type GenericHashTCall<'T> = Func<'T, int> let tryGetGenericHashTCall (ty:Type) : obj = match ty with - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall HashChar) - | ty when ty.Equals typeof -> box (GenericHashTCall HashSByte) - | ty when ty.Equals typeof -> box (GenericHashTCall HashInt16) - | ty when ty.Equals typeof -> box (GenericHashTCall HashInt64) - | ty when ty.Equals typeof -> box (GenericHashTCall HashUInt64) - | ty when ty.Equals typeof -> box (GenericHashTCall HashIntPtr) - | ty when ty.Equals typeof -> box (GenericHashTCallHashUIntPtr) - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall HashString) + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall HashChar) + | ty when ty.Equals typeof -> box (GenericHashTCall HashSByte) + | ty when ty.Equals typeof -> box (GenericHashTCall HashInt16) + | ty when ty.Equals typeof -> box (GenericHashTCall HashInt64) + | ty when ty.Equals typeof -> box (GenericHashTCall HashUInt64) + | ty when ty.Equals typeof -> box (GenericHashTCall HashIntPtr) + | ty when ty.Equals typeof -> box (GenericHashTCall HashUIntPtr) + | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) + | ty when ty.Equals typeof -> box (GenericHashTCall HashString) | _ -> null - type GenericHashT<'T> private () = - static let f : GenericHashTCall<'T> = - match tryGetGenericHashTCall typeof<'T> with - | :? GenericHashTCall<'T> as call -> call - | _ when canUseDefaultEqualityComparer typeof<'T> -> - let comparer = System.Collections.Generic.EqualityComparer<'T>.Default - GenericHashTCall<'T> (fun x -> avoid_tail_call_int (fun () -> comparer.GetHashCode x)) - | _ -> - GenericHashTCall<'T> (fun x -> GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x)) + let getGenericHashTCall<'T> () = + match tryGetGenericHashTCall typeof<'T> with + | :? GenericHashTCall<'T> as call -> call + | _ when canUseDefaultEqualityComparer typeof<'T> -> + let comparer = System.Collections.Generic.EqualityComparer<'T>.Default + GenericHashTCall<'T> (fun x -> avoid_tail_call_int (fun () -> comparer.GetHashCode x)) + | _ -> + GenericHashTCall<'T> (fun x -> GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x)) + type GenericHashT<'T> private () = + static let f = getGenericHashTCall<'T> () static member Function = f /// Intrinsic for calls to depth-unlimited structural hashing that were not optimized by static conditionals. @@ -2227,18 +2230,19 @@ namespace Microsoft.FSharp.Core | ty when ty.Equals typeof -> box StringIEquality | _ -> null + let getFastGenericEqualityComparerTable<'T> () = + let ty = typeof<'T> + match tryGetFastGenericEqualityComparerTable ty with + | :? System.Collections.Generic.IEqualityComparer<'T> as comp -> comp + | _ when HashCompare.canUseDefaultEqualityComparer ty-> + unboxPrim (box System.Collections.Generic.EqualityComparer<'T>.Default) + | _ -> + MakeGenericEqualityComparer<'T>() + [] type FastGenericEqualityComparerTable<'T>() = - static let f : System.Collections.Generic.IEqualityComparer<'T> = - let ty = typeof<'T> - match tryGetFastGenericEqualityComparerTable ty with - | :? System.Collections.Generic.IEqualityComparer<'T> as comp -> comp - | _ -> - if HashCompare.canUseDefaultEqualityComparer ty - then unboxPrim (box System.Collections.Generic.EqualityComparer<'T>.Default) - else MakeGenericEqualityComparer<'T>() - - static member Function : System.Collections.Generic.IEqualityComparer<'T> = f + static let f = getFastGenericEqualityComparerTable<'T> () + static member Function = f let FastGenericEqualityComparerFromTable<'T> = FastGenericEqualityComparerTable<'T>.Function From f66d84251b5edbde3103a948e5f2861f65da28c6 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Fri, 8 Jun 2018 19:18:03 +1000 Subject: [PATCH 13/64] Disallow optimization on Nullable types --- src/fsharp/FSharp.Core/prim-types.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index d0bc1a5920d..9a89450fced 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1571,6 +1571,7 @@ namespace Microsoft.FSharp.Core && ty.IsSealed // covers enum and value types && not (typeof.IsAssignableFrom ty) && not ty.IsArray + && not (ty.IsGenericType && ty.GetGenericTypeDefinition().Equals (typedefof>)) // The FSharp compiler will not insert a tail call when this is used (this might be "fixed" // in a future release) From d53a1f3107a8eb32e9e030fad5e13f2a8a6d4f93 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 9 Jun 2018 13:22:10 +1000 Subject: [PATCH 14/64] More inclusive check for canUseDefaultEqualityComparer --- src/fsharp/FSharp.Core/prim-types.fs | 40 +++++++++++++++++++++++----- 1 file changed, 34 insertions(+), 6 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 9a89450fced..c07f59dd6bd 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1566,12 +1566,40 @@ namespace Microsoft.FSharp.Core type PER = inherit IERorPER let canUseDefaultEqualityComparer (ty:Type) = - // avoid any types that need special handling in GenericEqualityObj - true - && ty.IsSealed // covers enum and value types - && not (typeof.IsAssignableFrom ty) - && not ty.IsArray - && not (ty.IsGenericType && ty.GetGenericTypeDefinition().Equals (typedefof>)) + let processed = System.Collections.Generic.HashSet () + + let rec recurse idx (types:array) = + if idx = types.Length then true + else + let ty = get types idx + if not (processed.Add ty) then + recurse (idx+1) types + else + let isValidGenericType ifNotType fullname = + if not (ty.IsGenericType && ty.GetGenericTypeDefinition().FullName.Equals fullname) + then ifNotType + else recurse 0 (ty.GetGenericArguments ()) + + // avoid any types that need special handling in GenericEqualityObj + true + && ty.IsSealed // covers enum and value types + && not ty.IsArray + && not (ty.Equals typeof) + && not (ty.Equals typeof) + && isValidGenericType true "System.Nullable`1" + && not (typeof.IsAssignableFrom ty + && not (false + || isValidGenericType false "System.ValueTuple`1" + || isValidGenericType false "System.ValueTuple`2" + || isValidGenericType false "System.ValueTuple`3" + || isValidGenericType false "System.ValueTuple`4" + || isValidGenericType false "System.ValueTuple`5" + || isValidGenericType false "System.ValueTuple`6" + || isValidGenericType false "System.ValueTuple`7" + || isValidGenericType false "System.ValueTuple`8")) + && recurse (idx+1) types + + recurse 0 [|ty|] // The FSharp compiler will not insert a tail call when this is used (this might be "fixed" // in a future release) From 325707fdbc36a7bfd4fb5644d07a58525b6cf0b6 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 9 Jun 2018 16:28:52 +1000 Subject: [PATCH 15/64] Updated il output files --- .../GenericComparison/Compare07.il.bsl | 25 +++++++++---------- .../GenericComparison/Compare10.il.bsl | 25 +++++++++---------- .../GenericComparison/Equals06.il.bsl | 25 +++++++++---------- .../GenericComparison/Equals09.il.bsl | 23 ++++++++--------- .../GenericComparison/Hash09.il.bsl | 25 +++++++++---------- .../GenericComparison/Hash12.il.bsl | 23 ++++++++--------- 6 files changed, 70 insertions(+), 76 deletions(-) diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl index 70335b05d20..b4c8337b1c2 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Compare07 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Compare07 { - // Offset: 0x00000000 Length: 0x0000089A + // Offset: 0x00000000 Length: 0x0000089E } .mresource public FSharpOptimizationData.Compare07 { - // Offset: 0x000008A0 Length: 0x00000692 + // Offset: 0x000008A8 Length: 0x0000069A } .module Compare07.dll -// MVID: {59B18AEE-05DE-F88E-A745-0383EE8AB159} +// MVID: {5B1B6346-05DE-F88E-A745-038346631B5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02BA0000 +// Image base: 0x02B60000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare07.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare07.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -633,7 +633,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) + // Code size 20 (0x14) .maxstack 4 .locals init ([0] class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 V_0) .line 4,4 : 10,20 '' @@ -641,18 +641,17 @@ IL_0001: isinst class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0014 + IL_0008: brfalse.s IL_0012 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: tail. - IL_000e: callvirt instance bool class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1) - IL_0013: ret + IL_000c: callvirt instance bool class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1) + IL_0011: ret .line 16707566,16707566 : 0,0 '' - IL_0014: ldc.i4.0 - IL_0015: ret + IL_0012: ldc.i4.0 + IL_0013: ret } // end of method GenericKey`1::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare10.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare10.il.bsl index 16bada503c5..55ccbcf4cf7 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare10.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare10.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Compare10 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Compare10 { - // Offset: 0x00000000 Length: 0x00000AA4 + // Offset: 0x00000000 Length: 0x00000AA8 } .mresource public FSharpOptimizationData.Compare10 { - // Offset: 0x00000AA8 Length: 0x0000058E + // Offset: 0x00000AB0 Length: 0x0000058E } .module Compare10.dll -// MVID: {59B18AEE-04BF-1753-A745-0383EE8AB159} +// MVID: {5B1B6346-04BF-1753-A745-038346631B5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x002E0000 +// Image base: 0x01030000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] int32 V_4, [5] int32 V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare10.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare10.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -1330,7 +1330,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) + // Code size 20 (0x14) .maxstack 4 .locals init ([0] class Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys V_0) .line 5,5 : 10,26 '' @@ -1338,18 +1338,17 @@ IL_0001: isinst Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0014 + IL_0008: brfalse.s IL_0012 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: tail. - IL_000e: callvirt instance bool Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) - IL_0013: ret + IL_000c: callvirt instance bool Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) + IL_0011: ret .line 16707566,16707566 : 0,0 '' - IL_0014: ldc.i4.0 - IL_0015: ret + IL_0012: ldc.i4.0 + IL_0013: ret } // end of method KeyWithInnerKeys::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl index 91247bff24d..4254bb088fe 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Equals06 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals06 { - // Offset: 0x00000000 Length: 0x00000896 + // Offset: 0x00000000 Length: 0x0000089A } .mresource public FSharpOptimizationData.Equals06 { - // Offset: 0x000008A0 Length: 0x0000068E + // Offset: 0x000008A0 Length: 0x00000696 } .module Equals06.dll -// MVID: {59B18AEE-0759-31EC-A745-0383EE8AB159} +// MVID: {5B1B6346-0759-31EC-A745-038346631B5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01B90000 +// Image base: 0x02B30000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals06.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals06.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -633,7 +633,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) + // Code size 20 (0x14) .maxstack 4 .locals init ([0] class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 V_0) .line 4,4 : 10,20 '' @@ -641,18 +641,17 @@ IL_0001: isinst class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0014 + IL_0008: brfalse.s IL_0012 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: tail. - IL_000e: callvirt instance bool class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1) - IL_0013: ret + IL_000c: callvirt instance bool class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1) + IL_0011: ret .line 16707566,16707566 : 0,0 '' - IL_0014: ldc.i4.0 - IL_0015: ret + IL_0012: ldc.i4.0 + IL_0013: ret } // end of method GenericKey`1::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals09.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals09.il.bsl index 8985acaa02b..cde1562a76b 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals09.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals09.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Equals09 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals09 { - // Offset: 0x00000000 Length: 0x00000AA0 + // Offset: 0x00000000 Length: 0x00000AA4 } .mresource public FSharpOptimizationData.Equals09 { // Offset: 0x00000AA8 Length: 0x0000058B } .module Equals09.dll -// MVID: {59B18AEE-0759-46D9-A745-0383EE8AB159} +// MVID: {5B1B6346-0759-46D9-A745-038346631B5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02720000 +// Image base: 0x02560000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] int32 V_4, [5] int32 V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals09.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals09.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -1330,7 +1330,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) + // Code size 20 (0x14) .maxstack 4 .locals init ([0] class Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys V_0) .line 5,5 : 10,26 '' @@ -1338,18 +1338,17 @@ IL_0001: isinst Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0014 + IL_0008: brfalse.s IL_0012 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: tail. - IL_000e: callvirt instance bool Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) - IL_0013: ret + IL_000c: callvirt instance bool Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) + IL_0011: ret .line 16707566,16707566 : 0,0 '' - IL_0014: ldc.i4.0 - IL_0015: ret + IL_0012: ldc.i4.0 + IL_0013: ret } // end of method KeyWithInnerKeys::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl index df7b115d207..4cf28a5ff57 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Hash09 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash09 { - // Offset: 0x00000000 Length: 0x0000088E + // Offset: 0x00000000 Length: 0x00000892 } .mresource public FSharpOptimizationData.Hash09 { - // Offset: 0x00000898 Length: 0x00000686 + // Offset: 0x00000898 Length: 0x0000068E } .module Hash09.dll -// MVID: {59B18AEE-9642-77DB-A745-0383EE8AB159} +// MVID: {5B1B6346-9642-77DB-A745-038346631B5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00690000 +// Image base: 0x025D0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash09.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash09.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -633,7 +633,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) + // Code size 20 (0x14) .maxstack 4 .locals init ([0] class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 V_0) .line 4,4 : 10,20 '' @@ -641,18 +641,17 @@ IL_0001: isinst class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0014 + IL_0008: brfalse.s IL_0012 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: tail. - IL_000e: callvirt instance bool class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1) - IL_0013: ret + IL_000c: callvirt instance bool class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1) + IL_0011: ret .line 16707566,16707566 : 0,0 '' - IL_0014: ldc.i4.0 - IL_0015: ret + IL_0012: ldc.i4.0 + IL_0013: ret } // end of method GenericKey`1::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash12.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash12.il.bsl index 9c5bfb73cf3..8836ff15748 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash12.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash12.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Hash12 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash12 { - // Offset: 0x00000000 Length: 0x00000A98 + // Offset: 0x00000000 Length: 0x00000A9C } .mresource public FSharpOptimizationData.Hash12 { // Offset: 0x00000AA0 Length: 0x00000585 } .module Hash12.dll -// MVID: {59B18AEE-9661-796E-A745-0383EE8AB159} +// MVID: {5B1B6346-9661-796E-A745-038346631B5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01080000 +// Image base: 0x02810000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] int32 V_4, [5] int32 V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash12.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash12.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -1330,7 +1330,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 22 (0x16) + // Code size 20 (0x14) .maxstack 4 .locals init ([0] class Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys V_0) .line 5,5 : 10,26 '' @@ -1338,18 +1338,17 @@ IL_0001: isinst Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0014 + IL_0008: brfalse.s IL_0012 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: tail. - IL_000e: callvirt instance bool Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) - IL_0013: ret + IL_000c: callvirt instance bool Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) + IL_0011: ret .line 16707566,16707566 : 0,0 '' - IL_0014: ldc.i4.0 - IL_0015: ret + IL_0012: ldc.i4.0 + IL_0013: ret } // end of method KeyWithInnerKeys::Equals .property instance int32 Tag() From 070cf6a2ae61f51ed098cda8bc9505dfd5f4d9e5 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 11 Jun 2018 17:27:49 +1000 Subject: [PATCH 16/64] Removed IERorPER by splitting calling class into 2, and added helper functions --- src/fsharp/FSharp.Core/prim-types.fs | 35 ++++++++++++---------------- 1 file changed, 15 insertions(+), 20 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index c07f59dd6bd..056d986f838 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1561,10 +1561,6 @@ namespace Microsoft.FSharp.Core override iec.Equals(x:obj,y:obj) = GenericEqualityObj true iec (x,y) // ER Semantics override iec.GetHashCode(x:obj) = raise (InvalidOperationException (SR.GetString(SR.notUsedForHashing))) } - type IERorPER = interface end - type ER = inherit IERorPER - type PER = inherit IERorPER - let canUseDefaultEqualityComparer (ty:Type) = let processed = System.Collections.Generic.HashSet () @@ -1630,12 +1626,7 @@ namespace Microsoft.FSharp.Core | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) | _ -> null - let getGenericEquality<'T, 'ERorPER when 'ERorPER :> IERorPER> () = - let er = - if typeof<'ERorPER>.Equals typeof then true - elif typeof<'ERorPER>.Equals typeof then false - else raise (Exception "logic error") - + let getGenericEquality<'T> er = match tryGetGenericEqualityTCall er typeof<'T> with | :? GenericEqualityTCall<'T> as call -> call | _ when canUseDefaultEqualityComparer typeof<'T> -> @@ -1646,16 +1637,20 @@ namespace Microsoft.FSharp.Core | _ -> GenericEqualityTCall<'T> (fun x y -> GenericEqualityObj false fsEqualityComparerNoHashingPER (box x, box y)) - type GenericEqualityT<'T, 'ERorPER when 'ERorPER :> IERorPER> private () = - static let f = getGenericEquality<'T, 'ERorPER> () - static member Function = f + type GenericEqualityT_ER<'T> private () = + static let f = getGenericEquality<'T> true + static member inline Equals (x, y) = f.Invoke (x, y) + + type GenericEqualityT_PER<'T> private () = + static let f = getGenericEquality<'T> false + static member inline Equals (x, y) = f.Invoke (x, y) /// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false) // // The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityIntrinsic (x : 'T) (y : 'T) : bool = - avoid_tail_call_bool (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) + avoid_tail_call_bool (fun () -> GenericEqualityT_PER<'T>.Equals (x, y)) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1664,7 +1659,7 @@ namespace Microsoft.FSharp.Core // The compiler optimizer is aware of this function (see use of generic_equality_er_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityERIntrinsic (x : 'T) (y : 'T) : bool = - avoid_tail_call_bool (fun () -> GenericEqualityT<'T, ER>.Function.Invoke (x, y)) + avoid_tail_call_bool (fun () -> GenericEqualityT_ER<'T>.Equals (x, y)) /// Implements generic equality between two values using "comp" for recursive calls. // @@ -1673,9 +1668,9 @@ namespace Microsoft.FSharp.Core // is either fsEqualityComparerNoHashingER or fsEqualityComparerNoHashingPER. let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) || obj.ReferenceEquals (comp, fsEqualityComparerNoHashingPER) then - avoid_tail_call_bool (fun () -> GenericEqualityT<'T, PER>.Function.Invoke (x, y)) + avoid_tail_call_bool (fun () -> GenericEqualityT_PER<'T>.Equals (x, y)) elif obj.ReferenceEquals (comp, fsEqualityComparerNoHashingER) then - avoid_tail_call_bool (fun () -> GenericEqualityT<'T, ER>.Function.Invoke (x, y)) + avoid_tail_call_bool (fun () -> GenericEqualityT_ER<'T>.Equals (x, y)) else comp.Equals (box x, box y) @@ -1923,14 +1918,14 @@ namespace Microsoft.FSharp.Core type GenericHashT<'T> private () = static let f = getGenericHashTCall<'T> () - static member Function = f + static member inline GetHashCode x = f.Invoke x /// Intrinsic for calls to depth-unlimited structural hashing that were not optimized by static conditionals. // // NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_inner_vref in opt.fs) // and devirtualizes calls to it based on type "T". let GenericHashIntrinsic input = - avoid_tail_call_int (fun () -> GenericHashT<'T>.Function.Invoke input) + avoid_tail_call_int (fun () -> GenericHashT<'T>.GetHashCode input) /// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals. let LimitedGenericHashIntrinsic limit input = GenericHashParamObj (CountLimitedHasherPER(limit)) (box input) @@ -1944,7 +1939,7 @@ namespace Microsoft.FSharp.Core // and devirtualizes calls to it based on type "T". let GenericHashWithComparerIntrinsic<'T> (comp : System.Collections.IEqualityComparer) (input : 'T) : int = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then - avoid_tail_call_int (fun () -> GenericHashT<'T>.Function.Invoke input) + avoid_tail_call_int (fun () -> GenericHashT<'T>.GetHashCode input) else GenericHashParamObj comp (box input) From 70290f173b8f341b8d2551884eaa2cec3d8b8b7f Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 13 Jun 2018 19:39:39 +1000 Subject: [PATCH 17/64] Changed it all to used EqualityComparer derived classes and restored tail calls --- src/fsharp/FSharp.Core/prim-types.fs | 472 +++++++++--------- .../GenericComparison/Compare07.il.bsl | 25 +- .../GenericComparison/Compare10.il.bsl | 25 +- .../GenericComparison/Equals06.il.bsl | 25 +- .../GenericComparison/Equals09.il.bsl | 23 +- .../GenericComparison/Hash09.il.bsl | 25 +- .../GenericComparison/Hash12.il.bsl | 23 +- 7 files changed, 313 insertions(+), 305 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 056d986f838..885ce8b8505 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -771,6 +771,9 @@ namespace Microsoft.FSharp.Core let anyToStringShowingNull x = anyToString "null" x module HashCompare = + //------------------------------------------------------------------------- + // LanguagePrimitives.HashCompare: HASHING. + //------------------------------------------------------------------------- let defaultHashNodes = 18 /// The implementation of IEqualityComparer, using depth-limited for hashing and PER semantics for NaN equality. @@ -800,7 +803,106 @@ namespace Microsoft.FSharp.Core /// The unique object for unlimited depth for hashing and PER semantics for equality. let fsEqualityComparerUnlimitedHashingPER = UnlimitedHasherPER() - + + let inline HashCombine nr x y = (x <<< 1) + y + 631 * nr + + let GenericHashObjArray (iec : System.Collections.IEqualityComparer) (x: obj[]) : int = + let len = x.Length + let mutable i = len - 1 + if i > defaultHashNodes then i <- defaultHashNodes // limit the hash + let mutable acc = 0 + while (i >= 0) do + // NOTE: GenericHash* call decreases nr + acc <- HashCombine i acc (iec.GetHashCode(x.GetValue(i))); + i <- i - 1 + acc + + // optimized case - byte arrays + let GenericHashByteArray (x: byte[]) : int = + let len = length x + let mutable i = len - 1 + if i > defaultHashNodes then i <- defaultHashNodes // limit the hash + let mutable acc = 0 + while (i >= 0) do + acc <- HashCombine i acc (intOfByte (get x i)); + i <- i - 1 + acc + + // optimized case - int arrays + let GenericHashInt32Array (x: int[]) : int = + let len = length x + let mutable i = len - 1 + if i > defaultHashNodes then i <- defaultHashNodes // limit the hash + let mutable acc = 0 + while (i >= 0) do + acc <- HashCombine i acc (get x i); + i <- i - 1 + acc + + // optimized case - int arrays + let GenericHashInt64Array (x: int64[]) : int = + let len = length x + let mutable i = len - 1 + if i > defaultHashNodes then i <- defaultHashNodes // limit the hash + let mutable acc = 0 + while (i >= 0) do + acc <- HashCombine i acc (int32 (get x i)); + i <- i - 1 + acc + + // special case - arrays do not by default have a decent structural hashing function + let GenericHashArbArray (iec : System.Collections.IEqualityComparer) (x: System.Array) : int = + match x.Rank with + | 1 -> + let b = x.GetLowerBound(0) + let len = x.Length + let mutable i = b + len - 1 + if i > b + defaultHashNodes then i <- b + defaultHashNodes // limit the hash + let mutable acc = 0 + while (i >= b) do + // NOTE: GenericHash* call decreases nr + acc <- HashCombine i acc (iec.GetHashCode(x.GetValue(i))); + i <- i - 1 + acc + | _ -> + HashCombine 10 (x.GetLength(0)) (x.GetLength(1)) + + // Core implementation of structural hashing, corresponds to pseudo-code in the + // F# Language spec. Searches for the IStructuralHash interface, otherwise uses GetHashCode(). + // Arrays are structurally hashed through a separate technique. + // + // "iec" is either fsEqualityComparerUnlimitedHashingER, fsEqualityComparerUnlimitedHashingPER or a CountLimitedHasherPER. + let rec GenericHashParamObj (iec : System.Collections.IEqualityComparer) (x: obj) : int = + match x with + | null -> 0 + | (:? System.Array as a) -> + match a with + | :? (obj[]) as oa -> GenericHashObjArray iec oa + | :? (byte[]) as ba -> GenericHashByteArray ba + | :? (int[]) as ba -> GenericHashInt32Array ba + | :? (int64[]) as ba -> GenericHashInt64Array ba + | _ -> GenericHashArbArray iec a + | :? IStructuralEquatable as a -> + a.GetHashCode(iec) + | _ -> + x.GetHashCode() + + /// Direct call to GetHashCode on the string type + let inline HashString (s:string) = + match s with + | null -> 0 + | _ -> (# "call instance int32 [mscorlib]System.String::GetHashCode()" s : int #) + + // from mscorlib v4.0.30319 + let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) + let inline HashSByte (x:sbyte) = (# "xor" (# "shl" x 8 : int #) x : int #) + let inline HashInt16 (x:int16) = (# "or" (# "conv.u2" x : int #) (# "shl" x 16 : int #) : int #) + let inline HashInt64 (x:int64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr" x 32 : int #) : int #) : int #) + let inline HashUInt64 (x:uint64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr.un" x 32 : int #) : int #) : int #) + let inline HashIntPtr (x:nativeint) = (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) + let inline HashUIntPtr (x:unativeint) = (# "and" (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) 0x7fffffff : int #) + + //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: Physical Equality //------------------------------------------------------------------------- @@ -1580,6 +1682,8 @@ namespace Microsoft.FSharp.Core true && ty.IsSealed // covers enum and value types && not ty.IsArray + && not (ty.Equals typeof) + && not (ty.Equals typeof) && not (ty.Equals typeof) && not (ty.Equals typeof) && isValidGenericType true "System.Nullable`1" @@ -1597,60 +1701,141 @@ namespace Microsoft.FSharp.Core recurse 0 [|ty|] - // The FSharp compiler will not insert a tail call when this is used (this might be "fixed" - // in a future release) - let inline avoid_tail_call_bool f = match f () with true -> true | _ -> false - let inline avoid_tail_call_int f = 0 + f () - - type GenericEqualityTCall<'T> = Func<'T, 'T, bool> - - let tryGetGenericEqualityTCall (er:bool) (ty:Type) : obj = + let tryGetFSharpEqualityComparer (er:bool) (ty:Type) : obj = match er, ty with - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.String.Equals((# "" x : string #),(# "" y : string #)))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #)))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | _, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | false, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #))) - | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) - | true, ty when ty.Equals typeof -> box (GenericEqualityTCall (fun x y -> (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))))) + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = System.String.Equals (x, y) + member __.GetHashCode x = HashString x } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = System.Decimal.op_Equality (x, y) + member __.GetHashCode x = x.GetHashCode () } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = (# "" x : int #) } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = HashSByte x } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = HashInt16 x } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = (# "" x : int #) } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = HashInt64 x } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = (# "" x : int #) } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = (# "" x : int #) } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = (# "" x : int #) } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = HashUInt64 x } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = HashIntPtr x } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = HashUIntPtr x } + + | _, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = HashChar x } + + | false, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = x.GetHashCode () } + + | false, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = x.GetHashCode () } + + | true, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))) + member __.GetHashCode x = x.GetHashCode () } + + | true, ty when ty.Equals typeof -> box { + new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))) + member __.GetHashCode x = x.GetHashCode () } + | _ -> null + let genericFSharpEqualityComparer_ER<'T> () = { + new EqualityComparer<'T>() with + member __.Equals (x,y) = GenericEqualityObj true fsEqualityComparerUnlimitedHashingER (box x, box y) + member __.GetHashCode x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x) + } + + let genericFSharpEqualityComparer_PER<'T> () = { + new EqualityComparer<'T>() with + member __.Equals (x,y) = GenericEqualityObj false fsEqualityComparerUnlimitedHashingPER (box x, box y) + member __.GetHashCode x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x) + } + let getGenericEquality<'T> er = - match tryGetGenericEqualityTCall er typeof<'T> with - | :? GenericEqualityTCall<'T> as call -> call - | _ when canUseDefaultEqualityComparer typeof<'T> -> - let comparer = System.Collections.Generic.EqualityComparer<'T>.Default - GenericEqualityTCall<'T> (fun x y -> avoid_tail_call_bool (fun () -> comparer.Equals (x, y))) - | _ when er -> - GenericEqualityTCall<'T> (fun x y -> GenericEqualityObj true fsEqualityComparerNoHashingER (box x, box y)) - | _ -> - GenericEqualityTCall<'T> (fun x y -> GenericEqualityObj false fsEqualityComparerNoHashingPER (box x, box y)) - - type GenericEqualityT_ER<'T> private () = - static let f = getGenericEquality<'T> true - static member inline Equals (x, y) = f.Invoke (x, y) - - type GenericEqualityT_PER<'T> private () = - static let f = getGenericEquality<'T> false - static member inline Equals (x, y) = f.Invoke (x, y) + match tryGetFSharpEqualityComparer er typeof<'T> with + | :? EqualityComparer<'T> as call -> call + | _ when canUseDefaultEqualityComparer typeof<'T> -> EqualityComparer<'T>.Default + | _ when er -> genericFSharpEqualityComparer_ER<'T> () + | _ -> genericFSharpEqualityComparer_PER<'T> () + + type FSharpEqualityComparer_ER<'T> private () = + static let comparer = getGenericEquality<'T> true + + static member Comparer = comparer + + static member inline Equals (x, y) = comparer.Equals (x, y) + static member inline GetHashCode x = comparer.GetHashCode x + + type FSharpEqualityComparer_PER<'T> private () = + static let comparer = getGenericEquality<'T> false + + static member Comparer = comparer + + static member inline Equals (x, y) = comparer.Equals (x, y) + static member inline GetHashCode x = comparer.GetHashCode x /// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false) // // The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityIntrinsic (x : 'T) (y : 'T) : bool = - avoid_tail_call_bool (fun () -> GenericEqualityT_PER<'T>.Equals (x, y)) + FSharpEqualityComparer_PER<'T>.Equals (x, y) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1659,7 +1844,7 @@ namespace Microsoft.FSharp.Core // The compiler optimizer is aware of this function (see use of generic_equality_er_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityERIntrinsic (x : 'T) (y : 'T) : bool = - avoid_tail_call_bool (fun () -> GenericEqualityT_ER<'T>.Equals (x, y)) + FSharpEqualityComparer_ER<'T>.Equals (x, y) /// Implements generic equality between two values using "comp" for recursive calls. // @@ -1668,9 +1853,9 @@ namespace Microsoft.FSharp.Core // is either fsEqualityComparerNoHashingER or fsEqualityComparerNoHashingPER. let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) || obj.ReferenceEquals (comp, fsEqualityComparerNoHashingPER) then - avoid_tail_call_bool (fun () -> GenericEqualityT_PER<'T>.Equals (x, y)) + FSharpEqualityComparer_PER<'T>.Equals (x, y) elif obj.ReferenceEquals (comp, fsEqualityComparerNoHashingER) then - avoid_tail_call_bool (fun () -> GenericEqualityT_ER<'T>.Equals (x, y)) + FSharpEqualityComparer_ER<'T>.Equals (x, y) else comp.Equals (box x, box y) @@ -1758,95 +1943,6 @@ namespace Microsoft.FSharp.Core let inline GenericInequalityFast (x:'T) (y:'T) = (not(GenericEqualityFast x y) : bool) let inline GenericInequalityERFast (x:'T) (y:'T) = (not(GenericEqualityERFast x y) : bool) - - //------------------------------------------------------------------------- - // LanguagePrimitives.HashCompare: HASHING. - //------------------------------------------------------------------------- - - let inline HashCombine nr x y = (x <<< 1) + y + 631 * nr - - let GenericHashObjArray (iec : System.Collections.IEqualityComparer) (x: obj[]) : int = - let len = x.Length - let mutable i = len - 1 - if i > defaultHashNodes then i <- defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= 0) do - // NOTE: GenericHash* call decreases nr - acc <- HashCombine i acc (iec.GetHashCode(x.GetValue(i))); - i <- i - 1 - acc - - // optimized case - byte arrays - let GenericHashByteArray (x: byte[]) : int = - let len = length x - let mutable i = len - 1 - if i > defaultHashNodes then i <- defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= 0) do - acc <- HashCombine i acc (intOfByte (get x i)); - i <- i - 1 - acc - - // optimized case - int arrays - let GenericHashInt32Array (x: int[]) : int = - let len = length x - let mutable i = len - 1 - if i > defaultHashNodes then i <- defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= 0) do - acc <- HashCombine i acc (get x i); - i <- i - 1 - acc - - // optimized case - int arrays - let GenericHashInt64Array (x: int64[]) : int = - let len = length x - let mutable i = len - 1 - if i > defaultHashNodes then i <- defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= 0) do - acc <- HashCombine i acc (int32 (get x i)); - i <- i - 1 - acc - - // special case - arrays do not by default have a decent structural hashing function - let GenericHashArbArray (iec : System.Collections.IEqualityComparer) (x: System.Array) : int = - match x.Rank with - | 1 -> - let b = x.GetLowerBound(0) - let len = x.Length - let mutable i = b + len - 1 - if i > b + defaultHashNodes then i <- b + defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= b) do - // NOTE: GenericHash* call decreases nr - acc <- HashCombine i acc (iec.GetHashCode(x.GetValue(i))); - i <- i - 1 - acc - | _ -> - HashCombine 10 (x.GetLength(0)) (x.GetLength(1)) - - // Core implementation of structural hashing, corresponds to pseudo-code in the - // F# Language spec. Searches for the IStructuralHash interface, otherwise uses GetHashCode(). - // Arrays are structurally hashed through a separate technique. - // - // "iec" is either fsEqualityComparerUnlimitedHashingER, fsEqualityComparerUnlimitedHashingPER or a CountLimitedHasherPER. - let rec GenericHashParamObj (iec : System.Collections.IEqualityComparer) (x: obj) : int = - match x with - | null -> 0 - | (:? System.Array as a) -> - match a with - | :? (obj[]) as oa -> GenericHashObjArray iec oa - | :? (byte[]) as ba -> GenericHashByteArray ba - | :? (int[]) as ba -> GenericHashInt32Array ba - | :? (int64[]) as ba -> GenericHashInt64Array ba - | _ -> GenericHashArbArray iec a - | :? IStructuralEquatable as a -> - a.GetHashCode(iec) - | _ -> - x.GetHashCode() - - /// Fill in the implementation of CountLimitedHasherPER type CountLimitedHasherPER with @@ -1873,59 +1969,12 @@ namespace Microsoft.FSharp.Core override iec.Equals(x:obj,y:obj) = GenericEqualityObj false iec (x,y) override iec.GetHashCode(x:obj) = GenericHashParamObj iec x - /// Direct call to GetHashCode on the string type - let inline HashString (s:string) = - match s with - | null -> 0 - | _ -> (# "call instance int32 [mscorlib]System.String::GetHashCode()" s : int #) - - // from mscorlib v4.0.30319 - let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) - let inline HashSByte (x:sbyte) = (# "xor" (# "shl" x 8 : int #) x : int #) - let inline HashInt16 (x:int16) = (# "or" (# "conv.u2" x : int #) (# "shl" x 16 : int #) : int #) - let inline HashInt64 (x:int64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr" x 32 : int #) : int #) : int #) - let inline HashUInt64 (x:uint64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr.un" x 32 : int #) : int #) : int #) - let inline HashIntPtr (x:nativeint) = (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) - let inline HashUIntPtr (x:unativeint) = (# "and" (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) 0x7fffffff : int #) - - type GenericHashTCall<'T> = Func<'T, int> - - let tryGetGenericHashTCall (ty:Type) : obj = - match ty with - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall HashChar) - | ty when ty.Equals typeof -> box (GenericHashTCall HashSByte) - | ty when ty.Equals typeof -> box (GenericHashTCall HashInt16) - | ty when ty.Equals typeof -> box (GenericHashTCall HashInt64) - | ty when ty.Equals typeof -> box (GenericHashTCall HashUInt64) - | ty when ty.Equals typeof -> box (GenericHashTCall HashIntPtr) - | ty when ty.Equals typeof -> box (GenericHashTCall HashUIntPtr) - | ty when ty.Equals typeof -> box (GenericHashTCall (fun x -> (# "" x : int #))) - | ty when ty.Equals typeof -> box (GenericHashTCall HashString) - | _ -> null - - let getGenericHashTCall<'T> () = - match tryGetGenericHashTCall typeof<'T> with - | :? GenericHashTCall<'T> as call -> call - | _ when canUseDefaultEqualityComparer typeof<'T> -> - let comparer = System.Collections.Generic.EqualityComparer<'T>.Default - GenericHashTCall<'T> (fun x -> avoid_tail_call_int (fun () -> comparer.GetHashCode x)) - | _ -> - GenericHashTCall<'T> (fun x -> GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x)) - - type GenericHashT<'T> private () = - static let f = getGenericHashTCall<'T> () - static member inline GetHashCode x = f.Invoke x - /// Intrinsic for calls to depth-unlimited structural hashing that were not optimized by static conditionals. // // NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_inner_vref in opt.fs) // and devirtualizes calls to it based on type "T". let GenericHashIntrinsic input = - avoid_tail_call_int (fun () -> GenericHashT<'T>.GetHashCode input) + FSharpEqualityComparer_PER<'T>.GetHashCode input /// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals. let LimitedGenericHashIntrinsic limit input = GenericHashParamObj (CountLimitedHasherPER(limit)) (box input) @@ -1939,7 +1988,7 @@ namespace Microsoft.FSharp.Core // and devirtualizes calls to it based on type "T". let GenericHashWithComparerIntrinsic<'T> (comp : System.Collections.IEqualityComparer) (input : 'T) : int = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then - avoid_tail_call_int (fun () -> GenericHashT<'T>.GetHashCode input) + FSharpEqualityComparer_PER<'T>.GetHashCode input else GenericHashParamObj comp (box input) @@ -2216,59 +2265,12 @@ namespace Microsoft.FSharp.Core member self.GetHashCode(x) = GenericLimitedHash limit x member self.Equals(x,y) = GenericEquality x y } - let BoolIEquality = MakeGenericEqualityComparer() - let CharIEquality = MakeGenericEqualityComparer() - let StringIEquality = MakeGenericEqualityComparer() - let SByteIEquality = MakeGenericEqualityComparer() - let Int16IEquality = MakeGenericEqualityComparer() - let Int32IEquality = MakeGenericEqualityComparer() - let Int64IEquality = MakeGenericEqualityComparer() - let IntPtrIEquality = MakeGenericEqualityComparer() - let ByteIEquality = MakeGenericEqualityComparer() - let UInt16IEquality = MakeGenericEqualityComparer() - let UInt32IEquality = MakeGenericEqualityComparer() - let UInt64IEquality = MakeGenericEqualityComparer() - let UIntPtrIEquality = MakeGenericEqualityComparer() - let FloatIEquality = MakeGenericEqualityComparer() - let Float32IEquality = MakeGenericEqualityComparer() - let DecimalIEquality = MakeGenericEqualityComparer() - - let tryGetFastGenericEqualityComparerTable (ty:Type) = - // TODO: Remove the ones that don't have special handling and thus just used default - match ty with - | ty when ty.Equals typeof -> box BoolIEquality - | ty when ty.Equals typeof -> box ByteIEquality - | ty when ty.Equals typeof -> box Int32IEquality - | ty when ty.Equals typeof -> box UInt32IEquality - | ty when ty.Equals typeof -> box CharIEquality - | ty when ty.Equals typeof -> box SByteIEquality - | ty when ty.Equals typeof -> box Int16IEquality - | ty when ty.Equals typeof -> box Int64IEquality - | ty when ty.Equals typeof -> box IntPtrIEquality - | ty when ty.Equals typeof -> box UInt16IEquality - | ty when ty.Equals typeof -> box UInt64IEquality - | ty when ty.Equals typeof -> box UIntPtrIEquality - | ty when ty.Equals typeof -> box FloatIEquality - | ty when ty.Equals typeof -> box Float32IEquality - | ty when ty.Equals typeof -> box DecimalIEquality - | ty when ty.Equals typeof -> box StringIEquality - | _ -> null - - let getFastGenericEqualityComparerTable<'T> () = - let ty = typeof<'T> - match tryGetFastGenericEqualityComparerTable ty with - | :? System.Collections.Generic.IEqualityComparer<'T> as comp -> comp - | _ when HashCompare.canUseDefaultEqualityComparer ty-> - unboxPrim (box System.Collections.Generic.EqualityComparer<'T>.Default) - | _ -> - MakeGenericEqualityComparer<'T>() - [] type FastGenericEqualityComparerTable<'T>() = - static let f = getFastGenericEqualityComparerTable<'T> () + static let f = HashCompare.FSharpEqualityComparer_PER<'T>.Comparer static member Function = f - let FastGenericEqualityComparerFromTable<'T> = FastGenericEqualityComparerTable<'T>.Function + let FastGenericEqualityComparerFromTable<'T> = FastGenericEqualityComparerTable<'T>.Function :> IEqualityComparer<'T> // This is the implementation of HashIdentity.Structural. In most cases this just becomes // FastGenericEqualityComparerFromTable. diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl index b4c8337b1c2..70335b05d20 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:3:0 + .ver 4:4:1:0 } .assembly Compare07 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Compare07 { - // Offset: 0x00000000 Length: 0x0000089E + // Offset: 0x00000000 Length: 0x0000089A } .mresource public FSharpOptimizationData.Compare07 { - // Offset: 0x000008A8 Length: 0x0000069A + // Offset: 0x000008A0 Length: 0x00000692 } .module Compare07.dll -// MVID: {5B1B6346-05DE-F88E-A745-038346631B5B} +// MVID: {59B18AEE-05DE-F88E-A745-0383EE8AB159} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02B60000 +// Image base: 0x02BA0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare07.fsx' + .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare07.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -633,7 +633,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) + // Code size 22 (0x16) .maxstack 4 .locals init ([0] class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 V_0) .line 4,4 : 10,20 '' @@ -641,17 +641,18 @@ IL_0001: isinst class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 + IL_0008: brfalse.s IL_0014 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: callvirt instance bool class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1) - IL_0011: ret + IL_000c: tail. + IL_000e: callvirt instance bool class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1) + IL_0013: ret .line 16707566,16707566 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret + IL_0014: ldc.i4.0 + IL_0015: ret } // end of method GenericKey`1::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare10.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare10.il.bsl index 55ccbcf4cf7..16bada503c5 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare10.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare10.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:3:0 + .ver 4:4:1:0 } .assembly Compare10 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Compare10 { - // Offset: 0x00000000 Length: 0x00000AA8 + // Offset: 0x00000000 Length: 0x00000AA4 } .mresource public FSharpOptimizationData.Compare10 { - // Offset: 0x00000AB0 Length: 0x0000058E + // Offset: 0x00000AA8 Length: 0x0000058E } .module Compare10.dll -// MVID: {5B1B6346-04BF-1753-A745-038346631B5B} +// MVID: {59B18AEE-04BF-1753-A745-0383EE8AB159} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01030000 +// Image base: 0x002E0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] int32 V_4, [5] int32 V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare10.fsx' + .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare10.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -1330,7 +1330,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) + // Code size 22 (0x16) .maxstack 4 .locals init ([0] class Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys V_0) .line 5,5 : 10,26 '' @@ -1338,17 +1338,18 @@ IL_0001: isinst Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 + IL_0008: brfalse.s IL_0014 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: callvirt instance bool Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) - IL_0011: ret + IL_000c: tail. + IL_000e: callvirt instance bool Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Compare10/CompareMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) + IL_0013: ret .line 16707566,16707566 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret + IL_0014: ldc.i4.0 + IL_0015: ret } // end of method KeyWithInnerKeys::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl index 4254bb088fe..91247bff24d 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:3:0 + .ver 4:4:1:0 } .assembly Equals06 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals06 { - // Offset: 0x00000000 Length: 0x0000089A + // Offset: 0x00000000 Length: 0x00000896 } .mresource public FSharpOptimizationData.Equals06 { - // Offset: 0x000008A0 Length: 0x00000696 + // Offset: 0x000008A0 Length: 0x0000068E } .module Equals06.dll -// MVID: {5B1B6346-0759-31EC-A745-038346631B5B} +// MVID: {59B18AEE-0759-31EC-A745-0383EE8AB159} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02B30000 +// Image base: 0x01B90000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals06.fsx' + .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals06.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -633,7 +633,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) + // Code size 22 (0x16) .maxstack 4 .locals init ([0] class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 V_0) .line 4,4 : 10,20 '' @@ -641,17 +641,18 @@ IL_0001: isinst class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 + IL_0008: brfalse.s IL_0014 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: callvirt instance bool class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1) - IL_0011: ret + IL_000c: tail. + IL_000e: callvirt instance bool class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1) + IL_0013: ret .line 16707566,16707566 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret + IL_0014: ldc.i4.0 + IL_0015: ret } // end of method GenericKey`1::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals09.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals09.il.bsl index cde1562a76b..8985acaa02b 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals09.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals09.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:3:0 + .ver 4:4:1:0 } .assembly Equals09 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals09 { - // Offset: 0x00000000 Length: 0x00000AA4 + // Offset: 0x00000000 Length: 0x00000AA0 } .mresource public FSharpOptimizationData.Equals09 { // Offset: 0x00000AA8 Length: 0x0000058B } .module Equals09.dll -// MVID: {5B1B6346-0759-46D9-A745-038346631B5B} +// MVID: {59B18AEE-0759-46D9-A745-0383EE8AB159} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02560000 +// Image base: 0x02720000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] int32 V_4, [5] int32 V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals09.fsx' + .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals09.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -1330,7 +1330,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) + // Code size 22 (0x16) .maxstack 4 .locals init ([0] class Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys V_0) .line 5,5 : 10,26 '' @@ -1338,17 +1338,18 @@ IL_0001: isinst Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 + IL_0008: brfalse.s IL_0014 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: callvirt instance bool Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) - IL_0011: ret + IL_000c: tail. + IL_000e: callvirt instance bool Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Equals09/EqualsMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) + IL_0013: ret .line 16707566,16707566 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret + IL_0014: ldc.i4.0 + IL_0015: ret } // end of method KeyWithInnerKeys::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl index 4cf28a5ff57..df7b115d207 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:3:0 + .ver 4:4:1:0 } .assembly Hash09 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash09 { - // Offset: 0x00000000 Length: 0x00000892 + // Offset: 0x00000000 Length: 0x0000088E } .mresource public FSharpOptimizationData.Hash09 { - // Offset: 0x00000898 Length: 0x0000068E + // Offset: 0x00000898 Length: 0x00000686 } .module Hash09.dll -// MVID: {5B1B6346-9642-77DB-A745-038346631B5B} +// MVID: {59B18AEE-9642-77DB-A745-0383EE8AB159} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x025D0000 +// Image base: 0x00690000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash09.fsx' + .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash09.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -633,7 +633,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) + // Code size 22 (0x16) .maxstack 4 .locals init ([0] class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 V_0) .line 4,4 : 10,20 '' @@ -641,17 +641,18 @@ IL_0001: isinst class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 + IL_0008: brfalse.s IL_0014 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: callvirt instance bool class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1) - IL_0011: ret + IL_000c: tail. + IL_000e: callvirt instance bool class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::Equals(class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1) + IL_0013: ret .line 16707566,16707566 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret + IL_0014: ldc.i4.0 + IL_0015: ret } // end of method GenericKey`1::Equals .property instance int32 Tag() diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash12.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash12.il.bsl index 8836ff15748..9c5bfb73cf3 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash12.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash12.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:3:0 + .ver 4:4:1:0 } .assembly Hash12 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash12 { - // Offset: 0x00000000 Length: 0x00000A9C + // Offset: 0x00000000 Length: 0x00000A98 } .mresource public FSharpOptimizationData.Hash12 { // Offset: 0x00000AA0 Length: 0x00000585 } .module Hash12.dll -// MVID: {5B1B6346-9661-796E-A745-038346631B5B} +// MVID: {59B18AEE-9661-796E-A745-0383EE8AB159} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02810000 +// Image base: 0x01080000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] int32 V_4, [5] int32 V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash12.fsx' + .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash12.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -1330,7 +1330,7 @@ instance bool Equals(object obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 20 (0x14) + // Code size 22 (0x16) .maxstack 4 .locals init ([0] class Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys V_0) .line 5,5 : 10,26 '' @@ -1338,17 +1338,18 @@ IL_0001: isinst Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys IL_0006: stloc.0 IL_0007: ldloc.0 - IL_0008: brfalse.s IL_0012 + IL_0008: brfalse.s IL_0014 .line 16707566,16707566 : 0,0 '' IL_000a: ldarg.0 IL_000b: ldloc.0 - IL_000c: callvirt instance bool Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) - IL_0011: ret + IL_000c: tail. + IL_000e: callvirt instance bool Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys::Equals(class Hash12/HashMicroPerfAndCodeGenerationTests/KeyWithInnerKeys) + IL_0013: ret .line 16707566,16707566 : 0,0 '' - IL_0012: ldc.i4.0 - IL_0013: ret + IL_0014: ldc.i4.0 + IL_0015: ret } // end of method KeyWithInnerKeys::Equals .property instance int32 Tag() From 4771226fcba0ef9c1115517fa15c5a052ec2d976 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 14 Jun 2018 19:17:46 +1000 Subject: [PATCH 18/64] Removed comparers that matched EqualityComparer<>.Default and code review changes --- src/fsharp/FSharp.Core/prim-types.fs | 169 +++++++-------------------- 1 file changed, 43 insertions(+), 126 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 885ce8b8505..184ec962bfc 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1666,146 +1666,67 @@ namespace Microsoft.FSharp.Core let canUseDefaultEqualityComparer (ty:Type) = let processed = System.Collections.Generic.HashSet () - let rec recurse idx (types:array) = + let rec checkType idx (types:Type[]) = if idx = types.Length then true else let ty = get types idx if not (processed.Add ty) then - recurse (idx+1) types + checkType (idx+1) types else let isValidGenericType ifNotType fullname = if not (ty.IsGenericType && ty.GetGenericTypeDefinition().FullName.Equals fullname) then ifNotType - else recurse 0 (ty.GetGenericArguments ()) + else checkType 0 (ty.GetGenericArguments ()) + let isTypeAndGenericArgumentsOK fullname = isValidGenericType false fullname + let isNotTypeOrIsTypeAndGenericArgumentsOK fullname = isValidGenericType true fullname // avoid any types that need special handling in GenericEqualityObj - true - && ty.IsSealed // covers enum and value types + // GenericEqualityObj handles string as a special cases, but internally routes to same equality + + ty.IsSealed // covers enum and value types + // ref types need to be sealed as derived class might implement IStructuralEquatable && not ty.IsArray - && not (ty.Equals typeof) - && not (ty.Equals typeof) && not (ty.Equals typeof) && not (ty.Equals typeof) - && isValidGenericType true "System.Nullable`1" + && isNotTypeOrIsTypeAndGenericArgumentsOK "System.Nullable`1" && not (typeof.IsAssignableFrom ty - && not (false - || isValidGenericType false "System.ValueTuple`1" - || isValidGenericType false "System.ValueTuple`2" - || isValidGenericType false "System.ValueTuple`3" - || isValidGenericType false "System.ValueTuple`4" - || isValidGenericType false "System.ValueTuple`5" - || isValidGenericType false "System.ValueTuple`6" - || isValidGenericType false "System.ValueTuple`7" - || isValidGenericType false "System.ValueTuple`8")) - && recurse (idx+1) types - - recurse 0 [|ty|] + // we accept ValueTuple even though it supports IStructuralEquatable + // if all generic arguements pass check + && not ( isTypeAndGenericArgumentsOK "System.ValueTuple`1" + || isTypeAndGenericArgumentsOK "System.ValueTuple`2" + || isTypeAndGenericArgumentsOK "System.ValueTuple`3" + || isTypeAndGenericArgumentsOK "System.ValueTuple`4" + || isTypeAndGenericArgumentsOK "System.ValueTuple`5" + || isTypeAndGenericArgumentsOK "System.ValueTuple`6" + || isTypeAndGenericArgumentsOK "System.ValueTuple`7" + || isTypeAndGenericArgumentsOK "System.ValueTuple`8")) + && checkType (idx+1) types + + checkType 0 [|ty|] let tryGetFSharpEqualityComparer (er:bool) (ty:Type) : obj = match er, ty with - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = System.String.Equals (x, y) - member __.GetHashCode x = HashString x } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = System.Decimal.op_Equality (x, y) - member __.GetHashCode x = x.GetHashCode () } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = (# "" x : int #) } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = HashSByte x } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = HashInt16 x } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = (# "" x : int #) } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = HashInt64 x } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = (# "" x : int #) } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = (# "" x : int #) } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = (# "" x : int #) } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = HashUInt64 x } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = HashIntPtr x } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = HashUIntPtr x } - - | _, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = HashChar x } - - | false, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = x.GetHashCode () } - - | false, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) - member __.GetHashCode x = x.GetHashCode () } - - | true, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))) - member __.GetHashCode x = x.GetHashCode () } - - | true, ty when ty.Equals typeof -> box { - new EqualityComparer() with - member __.Equals (x,y) = (# "ceq" x y : bool #) || (not ((# "ceq" x x : bool #) || (# "ceq" y y : bool #))) - member __.GetHashCode x = x.GetHashCode () } - + | false, ty when ty.Equals typeof -> + box { new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = x.GetHashCode () } + | false, ty when ty.Equals typeof -> + box { new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = x.GetHashCode () } + | true, ty when ty.Equals typeof -> box EqualityComparer.Default + | true, ty when ty.Equals typeof -> box EqualityComparer.Default | _ -> null - let genericFSharpEqualityComparer_ER<'T> () = { - new EqualityComparer<'T>() with + let genericFSharpEqualityComparer_ER<'T> () = + { new EqualityComparer<'T>() with member __.Equals (x,y) = GenericEqualityObj true fsEqualityComparerUnlimitedHashingER (box x, box y) - member __.GetHashCode x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x) - } + member __.GetHashCode x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x) } - let genericFSharpEqualityComparer_PER<'T> () = { - new EqualityComparer<'T>() with + let genericFSharpEqualityComparer_PER<'T> () = + { new EqualityComparer<'T>() with member __.Equals (x,y) = GenericEqualityObj false fsEqualityComparerUnlimitedHashingPER (box x, box y) - member __.GetHashCode x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x) - } + member __.GetHashCode x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x) } let getGenericEquality<'T> er = match tryGetFSharpEqualityComparer er typeof<'T> with @@ -1977,7 +1898,8 @@ namespace Microsoft.FSharp.Core FSharpEqualityComparer_PER<'T>.GetHashCode input /// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals. - let LimitedGenericHashIntrinsic limit input = GenericHashParamObj (CountLimitedHasherPER(limit)) (box input) + let LimitedGenericHashIntrinsic limit input = + GenericHashParamObj (CountLimitedHasherPER(limit)) (box input) /// Intrinsic for a recursive call to structural hashing that was not optimized by static conditionals. // @@ -2252,7 +2174,6 @@ namespace Microsoft.FSharp.Core // LanguagePrimitives: PUBLISH IEqualityComparer AND IComparer OBJECTS //------------------------------------------------------------------------- - let inline MakeGenericEqualityComparer<'T>() = // type-specialize some common cases to generate more efficient functions { new System.Collections.Generic.IEqualityComparer<'T> with @@ -2265,12 +2186,8 @@ namespace Microsoft.FSharp.Core member self.GetHashCode(x) = GenericLimitedHash limit x member self.Equals(x,y) = GenericEquality x y } - [] - type FastGenericEqualityComparerTable<'T>() = - static let f = HashCompare.FSharpEqualityComparer_PER<'T>.Comparer - static member Function = f - - let FastGenericEqualityComparerFromTable<'T> = FastGenericEqualityComparerTable<'T>.Function :> IEqualityComparer<'T> + let FastGenericEqualityComparerFromTable<'T> = + HashCompare.FSharpEqualityComparer_PER<'T>.Comparer :> IEqualityComparer<'T> // This is the implementation of HashIdentity.Structural. In most cases this just becomes // FastGenericEqualityComparerFromTable. From c864428aa97949465109a0cc7d67fce648177642 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 16 Jun 2018 14:19:31 +1000 Subject: [PATCH 19/64] Added additional types where EqualityComparer.Default can be used --- src/fsharp/FSharp.Core/prim-types.fs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 184ec962bfc..6ad5a57a0e3 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1663,7 +1663,7 @@ namespace Microsoft.FSharp.Core override iec.Equals(x:obj,y:obj) = GenericEqualityObj true iec (x,y) // ER Semantics override iec.GetHashCode(x:obj) = raise (InvalidOperationException (SR.GetString(SR.notUsedForHashing))) } - let canUseDefaultEqualityComparer (ty:Type) = + let canUseDefaultEqualityComparer er (rootType:Type) = let processed = System.Collections.Generic.HashSet () let rec checkType idx (types:Type[]) = @@ -1686,8 +1686,8 @@ namespace Microsoft.FSharp.Core ty.IsSealed // covers enum and value types // ref types need to be sealed as derived class might implement IStructuralEquatable && not ty.IsArray - && not (ty.Equals typeof) - && not (ty.Equals typeof) + && (er || (not (ty.Equals typeof))) + && (er || (not (ty.Equals typeof))) && isNotTypeOrIsTypeAndGenericArgumentsOK "System.Nullable`1" && not (typeof.IsAssignableFrom ty // we accept ValueTuple even though it supports IStructuralEquatable @@ -1699,10 +1699,16 @@ namespace Microsoft.FSharp.Core || isTypeAndGenericArgumentsOK "System.ValueTuple`5" || isTypeAndGenericArgumentsOK "System.ValueTuple`6" || isTypeAndGenericArgumentsOK "System.ValueTuple`7" - || isTypeAndGenericArgumentsOK "System.ValueTuple`8")) + || isTypeAndGenericArgumentsOK "System.ValueTuple`8" + || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Collections.FSharpList`1" + || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpOption`1" + || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpValueOption`1" + || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpResult`2" + ) + ) && checkType (idx+1) types - checkType 0 [|ty|] + checkType 0 [|rootType|] let tryGetFSharpEqualityComparer (er:bool) (ty:Type) : obj = match er, ty with @@ -1731,7 +1737,7 @@ namespace Microsoft.FSharp.Core let getGenericEquality<'T> er = match tryGetFSharpEqualityComparer er typeof<'T> with | :? EqualityComparer<'T> as call -> call - | _ when canUseDefaultEqualityComparer typeof<'T> -> EqualityComparer<'T>.Default + | _ when canUseDefaultEqualityComparer er typeof<'T> -> EqualityComparer<'T>.Default | _ when er -> genericFSharpEqualityComparer_ER<'T> () | _ -> genericFSharpEqualityComparer_PER<'T> () From 07d96ee5faa6f7a36978ef49674c591e7077bea0 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 16 Jun 2018 17:20:03 +1000 Subject: [PATCH 20/64] Save unnecessary type checks when more information is known --- src/fsharp/FSharp.Core/prim-types.fs | 66 ++++++++++++++++++++++++---- 1 file changed, 57 insertions(+), 9 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 6ad5a57a0e3..9b04318e7e4 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1663,6 +1663,9 @@ namespace Microsoft.FSharp.Core override iec.Equals(x:obj,y:obj) = GenericEqualityObj true iec (x,y) // ER Semantics override iec.GetHashCode(x:obj) = raise (InvalidOperationException (SR.GetString(SR.notUsedForHashing))) } + let isStructuralEquatable (ty:Type) = typeof.IsAssignableFrom ty + let isArray (ty:Type) = ty.IsArray || (typeof.IsAssignableFrom ty) + let canUseDefaultEqualityComparer er (rootType:Type) = let processed = System.Collections.Generic.HashSet () @@ -1685,11 +1688,11 @@ namespace Microsoft.FSharp.Core ty.IsSealed // covers enum and value types // ref types need to be sealed as derived class might implement IStructuralEquatable - && not ty.IsArray + && not (isArray ty) && (er || (not (ty.Equals typeof))) && (er || (not (ty.Equals typeof))) && isNotTypeOrIsTypeAndGenericArgumentsOK "System.Nullable`1" - && not (typeof.IsAssignableFrom ty + && not (isStructuralEquatable ty // we accept ValueTuple even though it supports IStructuralEquatable // if all generic arguements pass check && not ( isTypeAndGenericArgumentsOK "System.ValueTuple`1" @@ -1724,22 +1727,67 @@ namespace Microsoft.FSharp.Core | true, ty when ty.Equals typeof -> box EqualityComparer.Default | _ -> null - let genericFSharpEqualityComparer_ER<'T> () = + let arrayEqualityComparer<'T> er comparer = + let arrayEquals (er:bool) (iec:System.Collections.IEqualityComparer) (xobj:obj) (yobj:obj) : bool = + match xobj,yobj with + | null, null -> true + | null, _ -> false + | _, null -> false + | (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericEqualityObjArray er iec arr1 arr2 + | (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericEqualityByteArray arr1 arr2 + | (:? (int32[]) as arr1), (:? (int32[]) as arr2) -> GenericEqualityInt32Array arr1 arr2 + | (:? (int64[]) as arr1), (:? (int64[]) as arr2) -> GenericEqualityInt64Array arr1 arr2 + | (:? (char[]) as arr1), (:? (char[]) as arr2) -> GenericEqualityCharArray arr1 arr2 + | (:? (float32[]) as arr1), (:? (float32[]) as arr2) -> GenericEqualitySingleArray er arr1 arr2 + | (:? (float[]) as arr1), (:? (float[]) as arr2) -> GenericEqualityDoubleArray er arr1 arr2 + | (:? System.Array as arr1), (:? System.Array as arr2) -> GenericEqualityArbArray er iec arr1 arr2 + | _ -> raise (Exception "invalid logic - expected array") + + let getHashCode iec (xobj:obj) = + match xobj with + | null -> 0 + | :? (obj[]) as oa -> GenericHashObjArray iec oa + | :? (byte[]) as ba -> GenericHashByteArray ba + | :? (int[]) as ba -> GenericHashInt32Array ba + | :? (int64[]) as ba -> GenericHashInt64Array ba + | :? System.Array as a -> GenericHashArbArray iec a + | _ -> raise (Exception "invalid logic - expected array") + { new EqualityComparer<'T>() with - member __.Equals (x,y) = GenericEqualityObj true fsEqualityComparerUnlimitedHashingER (box x, box y) - member __.GetHashCode x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x) } + member __.Equals (x, y) = arrayEquals er comparer (box x) (box y) + member __.GetHashCode x = getHashCode fsEqualityComparerUnlimitedHashingPER (box x) } - let genericFSharpEqualityComparer_PER<'T> () = + let structuralEqualityComparer<'T> comparer = + { new EqualityComparer<'T>() with + member __.Equals (x,y) = + match box x, box y with + | null, null -> true + | null, _ -> false + | _, null -> false + | (:? IStructuralEquatable as x1), yobj -> x1.Equals (yobj, comparer) + | _ -> raise (Exception "invalid logic - expected IStructuralEquatable") + + member __.GetHashCode x = + match box x with + | null -> 0 + | :? IStructuralEquatable as a -> a.GetHashCode fsEqualityComparerUnlimitedHashingPER + | _ -> raise (Exception "invalid logic - expected IStructuralEquatable") } + + let unknownEqualityComparer<'T> er comparer = { new EqualityComparer<'T>() with - member __.Equals (x,y) = GenericEqualityObj false fsEqualityComparerUnlimitedHashingPER (box x, box y) + member __.Equals (x,y) = GenericEqualityObj er comparer (box x, box y) member __.GetHashCode x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x) } let getGenericEquality<'T> er = match tryGetFSharpEqualityComparer er typeof<'T> with | :? EqualityComparer<'T> as call -> call | _ when canUseDefaultEqualityComparer er typeof<'T> -> EqualityComparer<'T>.Default - | _ when er -> genericFSharpEqualityComparer_ER<'T> () - | _ -> genericFSharpEqualityComparer_PER<'T> () + | _ when isArray typeof<'T> && er -> arrayEqualityComparer true fsEqualityComparerUnlimitedHashingER + | _ when isArray typeof<'T> -> arrayEqualityComparer false fsEqualityComparerUnlimitedHashingPER + | _ when isStructuralEquatable typeof<'T> && er -> structuralEqualityComparer fsEqualityComparerUnlimitedHashingER + | _ when isStructuralEquatable typeof<'T> -> structuralEqualityComparer fsEqualityComparerUnlimitedHashingPER + | _ when er -> unknownEqualityComparer true fsEqualityComparerUnlimitedHashingER + | _ -> unknownEqualityComparer false fsEqualityComparerUnlimitedHashingPER type FSharpEqualityComparer_ER<'T> private () = static let comparer = getGenericEquality<'T> true From edc211e5c7eb46711976599b82d71fb977cea87d Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 18 Jun 2018 17:48:34 +1000 Subject: [PATCH 21/64] Removed now unused objects, and other minor cleanup --- src/fsharp/FSharp.Core/prim-types.fs | 45 +++++++--------------------- 1 file changed, 11 insertions(+), 34 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 9b04318e7e4..ca0ef1398c8 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1484,8 +1484,8 @@ namespace Microsoft.FSharp.Core // Run in either PER or ER mode. In PER mode, equality involving a NaN returns "false". // In ER mode, equality on two NaNs returns "true". // - // If "er" is true the "iec" is fsEqualityComparerNoHashingER - // If "er" is false the "iec" is fsEqualityComparerNoHashingPER + // If "er" is true the "iec" is fsEqualityComparerUnlimitedHashingER + // If "er" is false the "iec" is fsEqualityComparerUnlimitedHashingPER let rec GenericEqualityObj (er:bool) (iec:System.Collections.IEqualityComparer) ((xobj:obj),(yobj:obj)) : bool = (*if objEq xobj yobj then true else *) match xobj,yobj with @@ -1648,21 +1648,6 @@ namespace Microsoft.FSharp.Core else i <- i + 1 res - - /// One of the two unique instances of System.Collections.IEqualityComparer. Implements PER semantics - /// where equality on NaN returns "false". - let fsEqualityComparerNoHashingPER = - { new System.Collections.IEqualityComparer with - override iec.Equals(x:obj,y:obj) = GenericEqualityObj false iec (x,y) // PER Semantics - override iec.GetHashCode(x:obj) = raise (InvalidOperationException (SR.GetString(SR.notUsedForHashing))) } - - /// One of the two unique instances of System.Collections.IEqualityComparer. Implements ER semantics - /// where equality on NaN returns "true". - let fsEqualityComparerNoHashingER = - { new System.Collections.IEqualityComparer with - override iec.Equals(x:obj,y:obj) = GenericEqualityObj true iec (x,y) // ER Semantics - override iec.GetHashCode(x:obj) = raise (InvalidOperationException (SR.GetString(SR.notUsedForHashing))) } - let isStructuralEquatable (ty:Type) = typeof.IsAssignableFrom ty let isArray (ty:Type) = ty.IsArray || (typeof.IsAssignableFrom ty) @@ -1791,26 +1776,18 @@ namespace Microsoft.FSharp.Core type FSharpEqualityComparer_ER<'T> private () = static let comparer = getGenericEquality<'T> true - static member Comparer = comparer - static member inline Equals (x, y) = comparer.Equals (x, y) - static member inline GetHashCode x = comparer.GetHashCode x - type FSharpEqualityComparer_PER<'T> private () = static let comparer = getGenericEquality<'T> false - static member Comparer = comparer - static member inline Equals (x, y) = comparer.Equals (x, y) - static member inline GetHashCode x = comparer.GetHashCode x - /// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false) // // The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityIntrinsic (x : 'T) (y : 'T) : bool = - FSharpEqualityComparer_PER<'T>.Equals (x, y) + FSharpEqualityComparer_PER<'T>.Comparer.Equals (x, y) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1819,18 +1796,18 @@ namespace Microsoft.FSharp.Core // The compiler optimizer is aware of this function (see use of generic_equality_er_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityERIntrinsic (x : 'T) (y : 'T) : bool = - FSharpEqualityComparer_ER<'T>.Equals (x, y) + FSharpEqualityComparer_ER<'T>.Comparer.Equals (x, y) /// Implements generic equality between two values using "comp" for recursive calls. // // The compiler optimizer is aware of this function (see use of generic_equality_withc_inner_vref in opt.fs) // and devirtualizes calls to it based on "T", and under the assumption that "comp" - // is either fsEqualityComparerNoHashingER or fsEqualityComparerNoHashingPER. + // is either fsEqualityComparerUnlimitedHashingER or fsEqualityComparerUnlimitedHashingPER. let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool = - if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) || obj.ReferenceEquals (comp, fsEqualityComparerNoHashingPER) then - FSharpEqualityComparer_PER<'T>.Equals (x, y) - elif obj.ReferenceEquals (comp, fsEqualityComparerNoHashingER) then - FSharpEqualityComparer_ER<'T>.Equals (x, y) + if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then + FSharpEqualityComparer_PER<'T>.Comparer.Equals (x, y) + elif obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingER) then + FSharpEqualityComparer_ER<'T>.Comparer.Equals (x, y) else comp.Equals (box x, box y) @@ -1949,7 +1926,7 @@ namespace Microsoft.FSharp.Core // NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_inner_vref in opt.fs) // and devirtualizes calls to it based on type "T". let GenericHashIntrinsic input = - FSharpEqualityComparer_PER<'T>.GetHashCode input + FSharpEqualityComparer_PER<'T>.Comparer.GetHashCode input /// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals. let LimitedGenericHashIntrinsic limit input = @@ -1964,7 +1941,7 @@ namespace Microsoft.FSharp.Core // and devirtualizes calls to it based on type "T". let GenericHashWithComparerIntrinsic<'T> (comp : System.Collections.IEqualityComparer) (input : 'T) : int = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then - FSharpEqualityComparer_PER<'T>.GetHashCode input + FSharpEqualityComparer_PER<'T>.Comparer.GetHashCode input else GenericHashParamObj comp (box input) From 4a36c1e149e6938ce61cc0130c7cb6eeb3c6b0cb Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 23 Jun 2018 10:34:03 +1000 Subject: [PATCH 22/64] Modified Optimizer to manually inline GenericEqualityIntrinsic and friends (as they have special handling) --- src/fsharp/FSharp.Core/prim-types.fs | 29 +++++-- src/fsharp/FSharp.Core/prim-types.fsi | 20 +++++ src/fsharp/Optimizer.fs | 25 ++++-- src/fsharp/TcGlobals.fs | 7 ++ .../Linq101Joins01.il.bsl | 83 +++++++++++-------- .../StaticInit/StaticInit_Struct01.il.bsl | 43 ++++++---- .../GenericComparison/Compare07.il.bsl | 80 +++++++++--------- .../GenericComparison/Equals06.il.bsl | 80 +++++++++--------- .../GenericComparison/Equals07.il.bsl | 45 +++++----- .../GenericComparison/Equals08.il.bsl | 45 +++++----- .../GenericComparison/Hash09.il.bsl | 80 +++++++++--------- .../GenericComparison/Hash10.il.bsl | 39 ++++----- .../GenericComparison/Hash11.il.bsl | 39 ++++----- 13 files changed, 351 insertions(+), 264 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index ca0ef1398c8..fd7c235cb58 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1774,20 +1774,31 @@ namespace Microsoft.FSharp.Core | _ when er -> unknownEqualityComparer true fsEqualityComparerUnlimitedHashingER | _ -> unknownEqualityComparer false fsEqualityComparerUnlimitedHashingPER + [] type FSharpEqualityComparer_ER<'T> private () = static let comparer = getGenericEquality<'T> true - static member Comparer = comparer + static member EqualityComparer = comparer + [] type FSharpEqualityComparer_PER<'T> private () = static let comparer = getGenericEquality<'T> false - static member Comparer = comparer + static member EqualityComparer = comparer + + let inline FSharpEqualityComparer_ER_Equals (x:'T) (y:'T) = + FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals (x, y) + + let inline FSharpEqualityComparer_PER_Equals (x:'T) (y:'T) = + FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals (x, y) + + let inline FSharpEqualityComparer_GetHashCode (x:'T) = + FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode x /// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false) // // The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityIntrinsic (x : 'T) (y : 'T) : bool = - FSharpEqualityComparer_PER<'T>.Comparer.Equals (x, y) + FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals (x, y) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1796,7 +1807,7 @@ namespace Microsoft.FSharp.Core // The compiler optimizer is aware of this function (see use of generic_equality_er_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityERIntrinsic (x : 'T) (y : 'T) : bool = - FSharpEqualityComparer_ER<'T>.Comparer.Equals (x, y) + FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals (x, y) /// Implements generic equality between two values using "comp" for recursive calls. // @@ -1805,9 +1816,9 @@ namespace Microsoft.FSharp.Core // is either fsEqualityComparerUnlimitedHashingER or fsEqualityComparerUnlimitedHashingPER. let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then - FSharpEqualityComparer_PER<'T>.Comparer.Equals (x, y) + FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals (x, y) elif obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingER) then - FSharpEqualityComparer_ER<'T>.Comparer.Equals (x, y) + FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals (x, y) else comp.Equals (box x, box y) @@ -1926,7 +1937,7 @@ namespace Microsoft.FSharp.Core // NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_inner_vref in opt.fs) // and devirtualizes calls to it based on type "T". let GenericHashIntrinsic input = - FSharpEqualityComparer_PER<'T>.Comparer.GetHashCode input + FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode input /// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals. let LimitedGenericHashIntrinsic limit input = @@ -1941,7 +1952,7 @@ namespace Microsoft.FSharp.Core // and devirtualizes calls to it based on type "T". let GenericHashWithComparerIntrinsic<'T> (comp : System.Collections.IEqualityComparer) (input : 'T) : int = if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then - FSharpEqualityComparer_PER<'T>.Comparer.GetHashCode input + FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode input else GenericHashParamObj comp (box input) @@ -2218,7 +2229,7 @@ namespace Microsoft.FSharp.Core member self.Equals(x,y) = GenericEquality x y } let FastGenericEqualityComparerFromTable<'T> = - HashCompare.FSharpEqualityComparer_PER<'T>.Comparer :> IEqualityComparer<'T> + HashCompare.FSharpEqualityComparer_PER<'T>.EqualityComparer :> IEqualityComparer<'T> // This is the implementation of HashIdentity.Structural. In most cases this just becomes // FastGenericEqualityComparerFromTable. diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 54fdf39ba2c..52b2139725d 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -1238,6 +1238,26 @@ namespace Microsoft.FSharp.Core /// The F# compiler emits calls to some of the functions in this module as part of the compiled form of some language constructs module HashCompare = + [] + type FSharpEqualityComparer_ER<'T> = + static member EqualityComparer : System.Collections.Generic.EqualityComparer<'T> + + [] + type FSharpEqualityComparer_PER<'T> = + static member EqualityComparer : System.Collections.Generic.EqualityComparer<'T> + + /// A primitive entry point used by the F# compiler for optimization purposes. + [] + val inline FSharpEqualityComparer_ER_Equals : x:'T -> y:'T -> bool + + /// A primitive entry point used by the F# compiler for optimization purposes. + [] + val inline FSharpEqualityComparer_PER_Equals : x:'T -> y:'T -> bool + + /// A primitive entry point used by the F# compiler for optimization purposes. + [] + val inline FSharpEqualityComparer_GetHashCode : x:'T -> int + /// A primitive entry point used by the F# compiler for optimization purposes. [] val PhysicalHashIntrinsic : input:'T -> int when 'T : not struct diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index da19114bcc7..4921dcff817 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2328,12 +2328,12 @@ 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 - + | _ -> + 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 +2345,27 @@ 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 + | _ -> + 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 + | _ -> + 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 +2420,15 @@ 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 + + | 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 -> + Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_PER_Equals_vref ty tyargs args m) + + | 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 -> + Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_ER_Equals_vref ty tyargs args m) + + | 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 -> + 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 -> diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index d6fb7cd3c73..70ff2912bfb 100755 --- a/src/fsharp/TcGlobals.fs +++ b/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 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Joins01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Joins01.il.bsl index 22342da9b92..603c997764a 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Joins01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Joins01.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly extern Utils { @@ -38,20 +38,20 @@ } .mresource public FSharpSignatureData.Linq101Joins01 { - // Offset: 0x00000000 Length: 0x000002F4 + // Offset: 0x00000000 Length: 0x00000326 } .mresource public FSharpOptimizationData.Linq101Joins01 { - // Offset: 0x000002F8 Length: 0x000000C3 + // Offset: 0x00000330 Length: 0x000000C3 } .module Linq101Joins01.exe -// MVID: {5A1F62A6-151B-685E-A745-0383A6621F5A} +// MVID: {5B2D78B8-151B-685E-A745-0383B8782D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x03830000 +// Image base: 0x027D0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -81,7 +81,7 @@ // Code size 2 (0x2) .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 14,14 : 32,33 'C:\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\QueryExpressionStepping\\Linq101Joins01.fs' + .line 14,14 : 32,33 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\QueryExpressionStepping\\Linq101Joins01.fs' IL_0000: ldarg.1 IL_0001: ret } // end of method q@14::Invoke @@ -790,54 +790,67 @@ .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Linq.QuerySource`2,class [Utils]Utils/Product,string>,object> Invoke(class [Utils]Utils/Product _arg2) cil managed { - // Code size 69 (0x45) + // Code size 86 (0x56) .maxstack 9 .locals init ([0] class [Utils]Utils/Product p, - [1] string t) + [1] string t, + [2] object V_2, + [3] object V_3, + [4] object V_4, + [5] object V_5) .line 40,40 : 9,40 '' IL_0000: ldarg.1 IL_0001: stloc.0 .line 41,41 : 17,39 '' IL_0002: ldloc.0 IL_0003: box [Utils]Utils/Product - IL_0008: ldnull - IL_0009: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityIntrinsic(!!0, - !!0) - IL_000e: brfalse.s IL_0012 - - IL_0010: br.s IL_0014 - - IL_0012: br.s IL_001c + IL_0008: stloc.2 + IL_0009: ldnull + IL_000a: stloc.3 + IL_000b: ldloc.2 + IL_000c: stloc.s V_4 + IL_000e: ldloc.3 + IL_000f: stloc.s V_5 + IL_0011: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_0016: ldloc.s V_4 + IL_0018: ldloc.s V_5 + IL_001a: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_001f: brfalse.s IL_0023 + + IL_0021: br.s IL_0025 + + IL_0023: br.s IL_002d .line 41,41 : 40,55 '' - IL_0014: ldstr "(No products)" + IL_0025: ldstr "(No products)" .line 100001,100001 : 0,0 '' - IL_0019: nop - IL_001a: br.s IL_0023 + IL_002a: nop + IL_002b: br.s IL_0034 .line 41,41 : 61,74 '' - IL_001c: ldloc.0 - IL_001d: callvirt instance string [Utils]Utils/Product::get_ProductName() + IL_002d: ldloc.0 + IL_002e: callvirt instance string [Utils]Utils/Product::get_ProductName() .line 100001,100001 : 0,0 '' - IL_0022: nop + IL_0033: nop .line 100001,100001 : 0,0 '' - IL_0023: stloc.1 + IL_0034: stloc.1 .line 42,42 : 9,22 '' - IL_0024: ldarg.0 - IL_0025: ldfld class [FSharp.Core]Microsoft.FSharp.Linq.QueryBuilder Linq101Joins01/'q4@40-4'::builder@ - IL_002a: ldarg.0 - IL_002b: ldfld string Linq101Joins01/'q4@40-4'::c - IL_0030: ldarg.0 - IL_0031: ldfld class [mscorlib]System.Collections.Generic.IEnumerable`1 Linq101Joins01/'q4@40-4'::ps - IL_0036: ldloc.0 - IL_0037: ldloc.1 - IL_0038: newobj instance void class [mscorlib]System.Tuple`4,class [Utils]Utils/Product,string>::.ctor(!0, + IL_0035: ldarg.0 + IL_0036: ldfld class [FSharp.Core]Microsoft.FSharp.Linq.QueryBuilder Linq101Joins01/'q4@40-4'::builder@ + IL_003b: ldarg.0 + IL_003c: ldfld string Linq101Joins01/'q4@40-4'::c + IL_0041: ldarg.0 + IL_0042: ldfld class [mscorlib]System.Collections.Generic.IEnumerable`1 Linq101Joins01/'q4@40-4'::ps + IL_0047: ldloc.0 + IL_0048: ldloc.1 + IL_0049: newobj instance void class [mscorlib]System.Tuple`4,class [Utils]Utils/Product,string>::.ctor(!0, !1, !2, !3) - IL_003d: tail. - IL_003f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Linq.QuerySource`2 [FSharp.Core]Microsoft.FSharp.Linq.QueryBuilder::Yield,class [Utils]Utils/Product,string>,object>(!!0) - IL_0044: ret + IL_004e: tail. + IL_0050: callvirt instance class [FSharp.Core]Microsoft.FSharp.Linq.QuerySource`2 [FSharp.Core]Microsoft.FSharp.Linq.QueryBuilder::Yield,class [Utils]Utils/Product,string>,object>(!!0) + IL_0055: ret } // end of method 'q4@40-4'::Invoke } // end of class 'q4@40-4' diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/StaticInit/StaticInit_Struct01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/StaticInit/StaticInit_Struct01.il.bsl index 55664ad8b3a..17ce5430574 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/StaticInit/StaticInit_Struct01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/StaticInit/StaticInit_Struct01.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly StaticInit_Struct01 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.StaticInit_Struct01 { - // Offset: 0x00000000 Length: 0x000007B1 + // Offset: 0x00000000 Length: 0x000007B5 } .mresource public FSharpOptimizationData.StaticInit_Struct01 { - // Offset: 0x000007B8 Length: 0x0000021F + // Offset: 0x000007C0 Length: 0x0000021F } .module StaticInit_Struct01.dll -// MVID: {59B19250-05F6-D6CB-A745-03835092B159} +// MVID: {5B2D78C5-05F6-D6CB-A745-0383C5782D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02BA0000 +// Image base: 0x02C80000 // =============== CLASS MEMBERS DECLARATION =================== @@ -71,7 +71,7 @@ .maxstack 5 .locals init ([0] valuetype StaticInit_Struct01/C& V_0) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 4,4 : 6,7 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\StaticInit\\StaticInit_Struct01.fs' + .line 4,4 : 6,7 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\StaticInit\\StaticInit_Struct01.fs' IL_0000: ldarga.s obj IL_0002: stloc.0 IL_0003: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() @@ -256,20 +256,33 @@ instance bool Equals(valuetype StaticInit_Struct01/C obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 23 (0x17) - .maxstack 4 - .locals init ([0] valuetype StaticInit_Struct01/C& V_0) + // Code size 38 (0x26) + .maxstack 5 + .locals init ([0] valuetype StaticInit_Struct01/C& V_0, + [1] valuetype [mscorlib]System.DateTime V_1, + [2] valuetype [mscorlib]System.DateTime V_2, + [3] valuetype [mscorlib]System.DateTime V_3, + [4] valuetype [mscorlib]System.DateTime V_4) .line 4,4 : 6,7 '' IL_0000: ldarga.s obj IL_0002: stloc.0 IL_0003: ldarg.0 IL_0004: ldfld valuetype [mscorlib]System.DateTime StaticInit_Struct01/C::s - IL_0009: ldloc.0 - IL_000a: ldfld valuetype [mscorlib]System.DateTime StaticInit_Struct01/C::s - IL_000f: tail. - IL_0011: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0016: ret + IL_0009: stloc.1 + IL_000a: ldloc.0 + IL_000b: ldfld valuetype [mscorlib]System.DateTime StaticInit_Struct01/C::s + IL_0010: stloc.2 + IL_0011: ldloc.1 + IL_0012: stloc.3 + IL_0013: ldloc.2 + IL_0014: stloc.s V_4 + IL_0016: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_001b: ldloc.3 + IL_001c: ldloc.s V_4 + IL_001e: tail. + IL_0020: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_0025: ret } // end of method C::Equals .method public hidebysig virtual final diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl index 70335b05d20..cb04fa9fb46 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Compare07 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Compare07 { - // Offset: 0x00000000 Length: 0x0000089A + // Offset: 0x00000000 Length: 0x0000089E } .mresource public FSharpOptimizationData.Compare07 { - // Offset: 0x000008A0 Length: 0x00000692 + // Offset: 0x000008A8 Length: 0x0000069A } .module Compare07.dll -// MVID: {59B18AEE-05DE-F88E-A745-0383EE8AB159} +// MVID: {5B2D7B11-05DE-F88E-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02BA0000 +// Image base: 0x02640000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare07.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare07.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -560,8 +560,8 @@ instance bool Equals(class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 77 (0x4d) - .maxstack 4 + // Code size 87 (0x57) + .maxstack 5 .locals init ([0] class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 V_0, [1] class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 V_1, [2] !a V_2, @@ -570,13 +570,13 @@ IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un - IL_0004: brfalse.s IL_0045 + IL_0004: brfalse.s IL_004f .line 16707566,16707566 : 0,0 '' IL_0006: ldarg.1 IL_0007: ldnull IL_0008: cgt.un - IL_000a: brfalse.s IL_0043 + IL_000a: brfalse.s IL_004d .line 16707566,16707566 : 0,0 '' IL_000c: ldarg.0 @@ -592,41 +592,43 @@ IL_0019: ldloc.1 IL_001a: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item1 IL_001f: stloc.3 - IL_0020: ldloc.2 - IL_0021: ldloc.3 - IL_0022: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0027: brfalse.s IL_0041 - - .line 16707566,16707566 : 0,0 '' - IL_0029: ldloc.0 - IL_002a: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_002f: stloc.2 - IL_0030: ldloc.1 - IL_0031: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_0036: stloc.3 - IL_0037: ldloc.2 - IL_0038: ldloc.3 - IL_0039: tail. - IL_003b: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0040: ret + IL_0020: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0025: ldloc.2 + IL_0026: ldloc.3 + IL_0027: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_002c: brfalse.s IL_004b + + .line 16707566,16707566 : 0,0 '' + IL_002e: ldloc.0 + IL_002f: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_0034: stloc.2 + IL_0035: ldloc.1 + IL_0036: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_003b: stloc.3 + IL_003c: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0041: ldloc.2 + IL_0042: ldloc.3 + IL_0043: tail. + IL_0045: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_004a: ret .line 16707566,16707566 : 0,0 '' - IL_0041: ldc.i4.0 - IL_0042: ret + IL_004b: ldc.i4.0 + IL_004c: ret .line 16707566,16707566 : 0,0 '' - IL_0043: ldc.i4.0 - IL_0044: ret + IL_004d: ldc.i4.0 + IL_004e: ret .line 16707566,16707566 : 0,0 '' - IL_0045: ldarg.1 - IL_0046: ldnull - IL_0047: cgt.un - IL_0049: ldc.i4.0 - IL_004a: ceq - IL_004c: ret + IL_004f: ldarg.1 + IL_0050: ldnull + IL_0051: cgt.un + IL_0053: ldc.i4.0 + IL_0054: ceq + IL_0056: ret } // end of method GenericKey`1::Equals .method public hidebysig virtual final diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl index 91247bff24d..e575063fd39 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Equals06 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals06 { - // Offset: 0x00000000 Length: 0x00000896 + // Offset: 0x00000000 Length: 0x0000089A } .mresource public FSharpOptimizationData.Equals06 { - // Offset: 0x000008A0 Length: 0x0000068E + // Offset: 0x000008A0 Length: 0x00000696 } .module Equals06.dll -// MVID: {59B18AEE-0759-31EC-A745-0383EE8AB159} +// MVID: {5B2D7B11-0759-31EC-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01B90000 +// Image base: 0x02980000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals06.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals06.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -560,8 +560,8 @@ instance bool Equals(class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 77 (0x4d) - .maxstack 4 + // Code size 87 (0x57) + .maxstack 5 .locals init ([0] class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 V_0, [1] class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 V_1, [2] !a V_2, @@ -570,13 +570,13 @@ IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un - IL_0004: brfalse.s IL_0045 + IL_0004: brfalse.s IL_004f .line 16707566,16707566 : 0,0 '' IL_0006: ldarg.1 IL_0007: ldnull IL_0008: cgt.un - IL_000a: brfalse.s IL_0043 + IL_000a: brfalse.s IL_004d .line 16707566,16707566 : 0,0 '' IL_000c: ldarg.0 @@ -592,41 +592,43 @@ IL_0019: ldloc.1 IL_001a: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item1 IL_001f: stloc.3 - IL_0020: ldloc.2 - IL_0021: ldloc.3 - IL_0022: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0027: brfalse.s IL_0041 - - .line 16707566,16707566 : 0,0 '' - IL_0029: ldloc.0 - IL_002a: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_002f: stloc.2 - IL_0030: ldloc.1 - IL_0031: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_0036: stloc.3 - IL_0037: ldloc.2 - IL_0038: ldloc.3 - IL_0039: tail. - IL_003b: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0040: ret + IL_0020: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0025: ldloc.2 + IL_0026: ldloc.3 + IL_0027: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_002c: brfalse.s IL_004b + + .line 16707566,16707566 : 0,0 '' + IL_002e: ldloc.0 + IL_002f: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_0034: stloc.2 + IL_0035: ldloc.1 + IL_0036: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_003b: stloc.3 + IL_003c: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0041: ldloc.2 + IL_0042: ldloc.3 + IL_0043: tail. + IL_0045: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_004a: ret .line 16707566,16707566 : 0,0 '' - IL_0041: ldc.i4.0 - IL_0042: ret + IL_004b: ldc.i4.0 + IL_004c: ret .line 16707566,16707566 : 0,0 '' - IL_0043: ldc.i4.0 - IL_0044: ret + IL_004d: ldc.i4.0 + IL_004e: ret .line 16707566,16707566 : 0,0 '' - IL_0045: ldarg.1 - IL_0046: ldnull - IL_0047: cgt.un - IL_0049: ldc.i4.0 - IL_004a: ceq - IL_004c: ret + IL_004f: ldarg.1 + IL_0050: ldnull + IL_0051: cgt.un + IL_0053: ldc.i4.0 + IL_0054: ceq + IL_0056: ret } // end of method GenericKey`1::Equals .method public hidebysig virtual final diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals07.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals07.il.bsl index 91f97c289a2..1ce42f2b348 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals07.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals07.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Equals07 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals07 { - // Offset: 0x00000000 Length: 0x0000022D + // Offset: 0x00000000 Length: 0x00000245 } .mresource public FSharpOptimizationData.Equals07 { - // Offset: 0x00000238 Length: 0x000000AF + // Offset: 0x00000250 Length: 0x000000AF } .module Equals07.dll -// MVID: {59B18AEE-0759-AE27-A745-0383EE8AB159} +// MVID: {5B2D7B11-0759-AE27-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01C80000 +// Image base: 0x02D80000 // =============== CLASS MEMBERS DECLARATION =================== @@ -57,14 +57,14 @@ .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .method public static bool f7() cil managed { - // Code size 68 (0x44) + // Code size 73 (0x49) .maxstack 5 .locals init ([0] bool x, [1] uint8[] t1, [2] uint8[] t2, [3] int32 i) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 5,5 : 8,29 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals07.fsx' + .line 5,5 : 8,29 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals07.fsx' IL_0000: ldc.i4.0 IL_0001: stloc.0 .line 6,6 : 8,35 '' @@ -90,26 +90,27 @@ .line 8,8 : 8,32 '' IL_002a: ldc.i4.0 IL_002b: stloc.3 - IL_002c: br.s IL_003a + IL_002c: br.s IL_003f .line 9,9 : 12,26 '' - IL_002e: ldloc.1 - IL_002f: ldloc.2 - IL_0030: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityIntrinsic(!!0, - !!0) - IL_0035: stloc.0 - IL_0036: ldloc.3 - IL_0037: ldc.i4.1 - IL_0038: add - IL_0039: stloc.3 + IL_002e: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_0033: ldloc.1 + IL_0034: ldloc.2 + IL_0035: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_003a: stloc.0 + IL_003b: ldloc.3 + IL_003c: ldc.i4.1 + IL_003d: add + IL_003e: stloc.3 .line 8,8 : 8,32 '' - IL_003a: ldloc.3 - IL_003b: ldc.i4 0x989681 - IL_0040: blt.s IL_002e + IL_003f: ldloc.3 + IL_0040: ldc.i4 0x989681 + IL_0045: blt.s IL_002e .line 10,10 : 8,9 '' - IL_0042: ldloc.0 - IL_0043: ret + IL_0047: ldloc.0 + IL_0048: ret } // end of method EqualsMicroPerfAndCodeGenerationTests::f7 } // end of class EqualsMicroPerfAndCodeGenerationTests diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals08.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals08.il.bsl index 55da6ee102e..39e19138617 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals08.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals08.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Equals08 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals08 { - // Offset: 0x00000000 Length: 0x0000022D + // Offset: 0x00000000 Length: 0x00000245 } .mresource public FSharpOptimizationData.Equals08 { - // Offset: 0x00000238 Length: 0x000000AF + // Offset: 0x00000250 Length: 0x000000AF } .module Equals08.dll -// MVID: {59B18AEE-0759-659E-A745-0383EE8AB159} +// MVID: {5B2D7B11-0759-659E-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01090000 +// Image base: 0x02FD0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -57,14 +57,14 @@ .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .method public static bool f8() cil managed { - // Code size 68 (0x44) + // Code size 73 (0x49) .maxstack 5 .locals init ([0] bool x, [1] int32[] t1, [2] int32[] t2, [3] int32 i) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 5,5 : 8,29 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals08.fsx' + .line 5,5 : 8,29 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals08.fsx' IL_0000: ldc.i4.0 IL_0001: stloc.0 .line 6,6 : 8,31 '' @@ -90,26 +90,27 @@ .line 8,8 : 8,32 '' IL_002a: ldc.i4.0 IL_002b: stloc.3 - IL_002c: br.s IL_003a + IL_002c: br.s IL_003f .line 9,9 : 12,26 '' - IL_002e: ldloc.1 - IL_002f: ldloc.2 - IL_0030: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityIntrinsic(!!0, - !!0) - IL_0035: stloc.0 - IL_0036: ldloc.3 - IL_0037: ldc.i4.1 - IL_0038: add - IL_0039: stloc.3 + IL_002e: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_0033: ldloc.1 + IL_0034: ldloc.2 + IL_0035: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_003a: stloc.0 + IL_003b: ldloc.3 + IL_003c: ldc.i4.1 + IL_003d: add + IL_003e: stloc.3 .line 8,8 : 8,32 '' - IL_003a: ldloc.3 - IL_003b: ldc.i4 0x989681 - IL_0040: blt.s IL_002e + IL_003f: ldloc.3 + IL_0040: ldc.i4 0x989681 + IL_0045: blt.s IL_002e .line 10,10 : 8,9 '' - IL_0042: ldloc.0 - IL_0043: ret + IL_0047: ldloc.0 + IL_0048: ret } // end of method EqualsMicroPerfAndCodeGenerationTests::f8 } // end of class EqualsMicroPerfAndCodeGenerationTests diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl index df7b115d207..726d2aea5e8 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Hash09 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash09 { - // Offset: 0x00000000 Length: 0x0000088E + // Offset: 0x00000000 Length: 0x00000892 } .mresource public FSharpOptimizationData.Hash09 { - // Offset: 0x00000898 Length: 0x00000686 + // Offset: 0x00000898 Length: 0x0000068E } .module Hash09.dll -// MVID: {59B18AEE-9642-77DB-A745-0383EE8AB159} +// MVID: {5B2D7B11-9642-77DB-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00690000 +// Image base: 0x02990000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash09.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash09.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -560,8 +560,8 @@ instance bool Equals(class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 77 (0x4d) - .maxstack 4 + // Code size 87 (0x57) + .maxstack 5 .locals init ([0] class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 V_0, [1] class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 V_1, [2] !a V_2, @@ -570,13 +570,13 @@ IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un - IL_0004: brfalse.s IL_0045 + IL_0004: brfalse.s IL_004f .line 16707566,16707566 : 0,0 '' IL_0006: ldarg.1 IL_0007: ldnull IL_0008: cgt.un - IL_000a: brfalse.s IL_0043 + IL_000a: brfalse.s IL_004d .line 16707566,16707566 : 0,0 '' IL_000c: ldarg.0 @@ -592,41 +592,43 @@ IL_0019: ldloc.1 IL_001a: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item1 IL_001f: stloc.3 - IL_0020: ldloc.2 - IL_0021: ldloc.3 - IL_0022: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0027: brfalse.s IL_0041 - - .line 16707566,16707566 : 0,0 '' - IL_0029: ldloc.0 - IL_002a: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_002f: stloc.2 - IL_0030: ldloc.1 - IL_0031: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_0036: stloc.3 - IL_0037: ldloc.2 - IL_0038: ldloc.3 - IL_0039: tail. - IL_003b: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0040: ret + IL_0020: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0025: ldloc.2 + IL_0026: ldloc.3 + IL_0027: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_002c: brfalse.s IL_004b + + .line 16707566,16707566 : 0,0 '' + IL_002e: ldloc.0 + IL_002f: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_0034: stloc.2 + IL_0035: ldloc.1 + IL_0036: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_003b: stloc.3 + IL_003c: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0041: ldloc.2 + IL_0042: ldloc.3 + IL_0043: tail. + IL_0045: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_004a: ret .line 16707566,16707566 : 0,0 '' - IL_0041: ldc.i4.0 - IL_0042: ret + IL_004b: ldc.i4.0 + IL_004c: ret .line 16707566,16707566 : 0,0 '' - IL_0043: ldc.i4.0 - IL_0044: ret + IL_004d: ldc.i4.0 + IL_004e: ret .line 16707566,16707566 : 0,0 '' - IL_0045: ldarg.1 - IL_0046: ldnull - IL_0047: cgt.un - IL_0049: ldc.i4.0 - IL_004a: ceq - IL_004c: ret + IL_004f: ldarg.1 + IL_0050: ldnull + IL_0051: cgt.un + IL_0053: ldc.i4.0 + IL_0054: ceq + IL_0056: ret } // end of method GenericKey`1::Equals .method public hidebysig virtual final diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash10.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash10.il.bsl index 20c3ceeb8f6..029eaf7814a 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash10.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash10.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Hash10 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash10 { - // Offset: 0x00000000 Length: 0x00000219 + // Offset: 0x00000000 Length: 0x00000231 } .mresource public FSharpOptimizationData.Hash10 { - // Offset: 0x00000220 Length: 0x000000A9 + // Offset: 0x00000238 Length: 0x000000A9 } .module Hash10.dll -// MVID: {59B18AEE-9661-78B4-A745-0383EE8AB159} +// MVID: {5B2D7B11-9661-78B4-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01080000 +// Image base: 0x01690000 // =============== CLASS MEMBERS DECLARATION =================== @@ -57,13 +57,13 @@ .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .method public static void f7() cil managed { - // Code size 44 (0x2c) + // Code size 49 (0x31) .maxstack 5 .locals init ([0] uint8[] arr, [1] int32 i, [2] int32 V_2) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 6,6 : 8,36 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash10.fsx' + .line 6,6 : 8,36 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash10.fsx' IL_0000: ldc.i4.0 IL_0001: ldc.i4.1 IL_0002: ldc.i4.s 100 @@ -76,22 +76,23 @@ .line 7,7 : 8,32 '' IL_0014: ldc.i4.0 IL_0015: stloc.1 - IL_0016: br.s IL_0023 + IL_0016: br.s IL_0028 .line 8,8 : 12,30 '' - IL_0018: ldloc.0 - IL_0019: call int32 [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericHashIntrinsic(!!0) - IL_001e: stloc.2 - IL_001f: ldloc.1 - IL_0020: ldc.i4.1 - IL_0021: add - IL_0022: stloc.1 + IL_0018: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_001d: ldloc.0 + IL_001e: callvirt instance int32 class [mscorlib]System.Collections.Generic.EqualityComparer`1::GetHashCode(!0) + IL_0023: stloc.2 + IL_0024: ldloc.1 + IL_0025: ldc.i4.1 + IL_0026: add + IL_0027: stloc.1 .line 7,7 : 8,32 '' - IL_0023: ldloc.1 - IL_0024: ldc.i4 0x989681 - IL_0029: blt.s IL_0018 + IL_0028: ldloc.1 + IL_0029: ldc.i4 0x989681 + IL_002e: blt.s IL_0018 - IL_002b: ret + IL_0030: ret } // end of method HashMicroPerfAndCodeGenerationTests::f7 } // end of class HashMicroPerfAndCodeGenerationTests diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash11.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash11.il.bsl index f4eb5020175..9848907a1b1 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash11.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash11.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Hash11 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash11 { - // Offset: 0x00000000 Length: 0x00000219 + // Offset: 0x00000000 Length: 0x00000231 } .mresource public FSharpOptimizationData.Hash11 { - // Offset: 0x00000220 Length: 0x000000A9 + // Offset: 0x00000238 Length: 0x000000A9 } .module Hash11.dll -// MVID: {59B18AEE-9661-78D3-A745-0383EE8AB159} +// MVID: {5B2D7B11-9661-78D3-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x002D0000 +// Image base: 0x027C0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -57,13 +57,13 @@ .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .method public static void f8() cil managed { - // Code size 44 (0x2c) + // Code size 49 (0x31) .maxstack 5 .locals init ([0] int32[] arr, [1] int32 i, [2] int32 V_2) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 6,6 : 8,32 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash11.fsx' + .line 6,6 : 8,32 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash11.fsx' IL_0000: ldc.i4.0 IL_0001: ldc.i4.1 IL_0002: ldc.i4.s 100 @@ -76,22 +76,23 @@ .line 7,7 : 8,32 '' IL_0014: ldc.i4.0 IL_0015: stloc.1 - IL_0016: br.s IL_0023 + IL_0016: br.s IL_0028 .line 8,8 : 12,30 '' - IL_0018: ldloc.0 - IL_0019: call int32 [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericHashIntrinsic(!!0) - IL_001e: stloc.2 - IL_001f: ldloc.1 - IL_0020: ldc.i4.1 - IL_0021: add - IL_0022: stloc.1 + IL_0018: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_001d: ldloc.0 + IL_001e: callvirt instance int32 class [mscorlib]System.Collections.Generic.EqualityComparer`1::GetHashCode(!0) + IL_0023: stloc.2 + IL_0024: ldloc.1 + IL_0025: ldc.i4.1 + IL_0026: add + IL_0027: stloc.1 .line 7,7 : 8,32 '' - IL_0023: ldloc.1 - IL_0024: ldc.i4 0x989681 - IL_0029: blt.s IL_0018 + IL_0028: ldloc.1 + IL_0029: ldc.i4 0x989681 + IL_002e: blt.s IL_0018 - IL_002b: ret + IL_0030: ret } // end of method HashMicroPerfAndCodeGenerationTests::f8 } // end of class HashMicroPerfAndCodeGenerationTests From f87500c2352859aeef23027e23476ea5854196ab Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 23 Jun 2018 20:18:15 +1000 Subject: [PATCH 23/64] Fixed SurfaceArea --- .../SurfaceArea.coreclr.fs | 17 +++++++++++++++++ .../FSharp.Core.UnitTests/SurfaceArea.net40.fs | 17 +++++++++++++++++ 2 files changed, 34 insertions(+) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index 0f36e747976..ef363486f12 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -2229,11 +2229,25 @@ Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_InputMu Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_InputSequenceEmptyString() Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_NoNegateMinValueString() Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.Type GetType() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Collections.Generic.EqualityComparer`1[T] EqualityComparer +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Collections.Generic.EqualityComparer`1[T] get_EqualityComparer() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.String ToString() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Type GetType() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Collections.Generic.EqualityComparer`1[T] EqualityComparer +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Collections.Generic.EqualityComparer`1[T] get_EqualityComparer() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.String ToString() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Type GetType() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean Equals(System.Object) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple2[T1,T2](System.Collections.IEqualityComparer, System.Tuple`2[T1,T2], System.Tuple`2[T1,T2]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple3[T1,T2,T3](System.Collections.IEqualityComparer, System.Tuple`3[T1,T2,T3], System.Tuple`3[T1,T2,T3]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple4[T1,T2,T3,T4](System.Collections.IEqualityComparer, System.Tuple`4[T1,T2,T3,T4], System.Tuple`4[T1,T2,T3,T4]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple5[T1,T2,T3,T4,T5](System.Collections.IEqualityComparer, System.Tuple`5[T1,T2,T3,T4,T5], System.Tuple`5[T1,T2,T3,T4,T5]) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FSharpEqualityComparer_ER_Equals[T](T, T) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FSharpEqualityComparer_PER_Equals[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityERIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityWithComparerIntrinsic[T](System.Collections.IEqualityComparer, T, T) @@ -2250,6 +2264,7 @@ Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple2[T1,T2 Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple3[T1,T2,T3](System.Collections.IEqualityComparer, System.Tuple`3[T1,T2,T3]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple4[T1,T2,T3,T4](System.Collections.IEqualityComparer, System.Tuple`4[T1,T2,T3,T4]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple5[T1,T2,T3,T4,T5](System.Collections.IEqualityComparer, System.Tuple`5[T1,T2,T3,T4,T5]) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FSharpEqualityComparer_GetHashCode[T](T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericComparisonIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericComparisonWithComparerIntrinsic[T](System.Collections.IComparer, T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericHashIntrinsic[T](T) @@ -2257,6 +2272,8 @@ Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericHashWithCompa Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GetHashCode() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 LimitedGenericHashIntrinsic[T](Int32, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 PhysicalHashIntrinsic[T](T) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T] +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T] Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: System.String ToString() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: System.Type GetType() Microsoft.FSharp.Core.LanguagePrimitives+IntrinsicFunctions: Boolean Equals(System.Object) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index 54038feab93..7f08a8900ac 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -2316,11 +2316,25 @@ Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_InputMu Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_InputSequenceEmptyString() Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_NoNegateMinValueString() Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.Type GetType() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Collections.Generic.EqualityComparer`1[T] EqualityComparer +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Collections.Generic.EqualityComparer`1[T] get_EqualityComparer() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.String ToString() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Type GetType() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Collections.Generic.EqualityComparer`1[T] EqualityComparer +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Collections.Generic.EqualityComparer`1[T] get_EqualityComparer() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.String ToString() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Type GetType() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean Equals(System.Object) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple2[T1,T2](System.Collections.IEqualityComparer, System.Tuple`2[T1,T2], System.Tuple`2[T1,T2]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple3[T1,T2,T3](System.Collections.IEqualityComparer, System.Tuple`3[T1,T2,T3], System.Tuple`3[T1,T2,T3]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple4[T1,T2,T3,T4](System.Collections.IEqualityComparer, System.Tuple`4[T1,T2,T3,T4], System.Tuple`4[T1,T2,T3,T4]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple5[T1,T2,T3,T4,T5](System.Collections.IEqualityComparer, System.Tuple`5[T1,T2,T3,T4,T5], System.Tuple`5[T1,T2,T3,T4,T5]) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FSharpEqualityComparer_ER_Equals[T](T, T) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FSharpEqualityComparer_PER_Equals[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityERIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityWithComparerIntrinsic[T](System.Collections.IEqualityComparer, T, T) @@ -2337,6 +2351,7 @@ Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple2[T1,T2 Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple3[T1,T2,T3](System.Collections.IEqualityComparer, System.Tuple`3[T1,T2,T3]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple4[T1,T2,T3,T4](System.Collections.IEqualityComparer, System.Tuple`4[T1,T2,T3,T4]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple5[T1,T2,T3,T4,T5](System.Collections.IEqualityComparer, System.Tuple`5[T1,T2,T3,T4,T5]) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FSharpEqualityComparer_GetHashCode[T](T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericComparisonIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericComparisonWithComparerIntrinsic[T](System.Collections.IComparer, T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericHashIntrinsic[T](T) @@ -2344,6 +2359,8 @@ Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericHashWithCompa Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GetHashCode() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 LimitedGenericHashIntrinsic[T](Int32, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 PhysicalHashIntrinsic[T](T) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T] +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T] Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: System.String ToString() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: System.Type GetType() Microsoft.FSharp.Core.LanguagePrimitives+IntrinsicFunctions: Boolean Equals(System.Object) From 6fb8c316f8e725f139a05ca2b9e15b179a9d3387 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sun, 24 Jun 2018 06:51:05 +1000 Subject: [PATCH 24/64] Ensure FSharp.Core has the optimization functions (and added comments) --- src/fsharp/Optimizer.fs | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 4921dcff817..d5bdf9a282d 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2333,7 +2333,10 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = match tcref.GeneratedHashAndEqualsValues with | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) | _ -> - Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_ER_Equals_vref ty tyargsOriginal args m) + // 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 -> @@ -2354,7 +2357,10 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = 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) | _ -> - Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_PER_Equals_vref ty tyargsOriginal args m) + // 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 -> @@ -2364,8 +2370,11 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | Some (_, withcGetHashCodeVal, _), [x] -> let args2 = [x; mkCallGetGenericEREqualityComparer cenv.g m] Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m) - | _ -> - Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_GetHashCode_vref ty tyargsOriginal args m) + | _ -> + // 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 -> @@ -2421,14 +2430,23 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | 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 -> - Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_PER_Equals_vref ty tyargs args m) + 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 -> - Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_ER_Equals_vref ty tyargs args m) + 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 -> - Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_GetHashCode_vref ty tyargs args m) + 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 -> From a734563ad31a124b24e2be5273089da31e58af8a Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 25 Jun 2018 19:20:17 +1000 Subject: [PATCH 25/64] Remove IL bloat from this PR as per https://github.com/Microsoft/visualfsharp/issues/5212 --- src/fsharp/FSharp.Core/prim-types.fs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index fd7c235cb58..c5a590da292 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1719,12 +1719,26 @@ namespace Microsoft.FSharp.Core | null, _ -> false | _, null -> false | (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericEqualityObjArray er iec arr1 arr2 + | _ -> + match xobj,yobj with | (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericEqualityByteArray arr1 arr2 + | _ -> + match xobj,yobj with | (:? (int32[]) as arr1), (:? (int32[]) as arr2) -> GenericEqualityInt32Array arr1 arr2 + | _ -> + match xobj,yobj with | (:? (int64[]) as arr1), (:? (int64[]) as arr2) -> GenericEqualityInt64Array arr1 arr2 + | _ -> + match xobj,yobj with | (:? (char[]) as arr1), (:? (char[]) as arr2) -> GenericEqualityCharArray arr1 arr2 + | _ -> + match xobj,yobj with | (:? (float32[]) as arr1), (:? (float32[]) as arr2) -> GenericEqualitySingleArray er arr1 arr2 + | _ -> + match xobj,yobj with | (:? (float[]) as arr1), (:? (float[]) as arr2) -> GenericEqualityDoubleArray er arr1 arr2 + | _ -> + match xobj,yobj with | (:? System.Array as arr1), (:? System.Array as arr2) -> GenericEqualityArbArray er iec arr1 arr2 | _ -> raise (Exception "invalid logic - expected array") From 71bb2380fdd9f83cae7ecfdf8e8be02b6356cb6a Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 26 Jun 2018 19:50:58 +1000 Subject: [PATCH 26/64] Remove null checks for IStructuralEquality Value Types --- src/fsharp/FSharp.Core/prim-types.fs | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index c5a590da292..fe788bd3291 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1649,6 +1649,7 @@ namespace Microsoft.FSharp.Core res let isStructuralEquatable (ty:Type) = typeof.IsAssignableFrom ty + let isValueTypeStructuralEquatable (ty:Type) = isStructuralEquatable ty && ty.IsValueType let isArray (ty:Type) = ty.IsArray || (typeof.IsAssignableFrom ty) let canUseDefaultEqualityComparer er (rootType:Type) = @@ -1772,6 +1773,11 @@ namespace Microsoft.FSharp.Core | :? IStructuralEquatable as a -> a.GetHashCode fsEqualityComparerUnlimitedHashingPER | _ -> raise (Exception "invalid logic - expected IStructuralEquatable") } + let structuralEqualityComparerValueType<'T> comparer = + { new EqualityComparer<'T>() with + member __.Equals (x,y) = ((box x):?>IStructuralEquatable).Equals (y, comparer) + member __.GetHashCode x = ((box x):?>IStructuralEquatable).GetHashCode fsEqualityComparerUnlimitedHashingPER } + let unknownEqualityComparer<'T> er comparer = { new EqualityComparer<'T>() with member __.Equals (x,y) = GenericEqualityObj er comparer (box x, box y) @@ -1779,14 +1785,16 @@ namespace Microsoft.FSharp.Core let getGenericEquality<'T> er = match tryGetFSharpEqualityComparer er typeof<'T> with - | :? EqualityComparer<'T> as call -> call - | _ when canUseDefaultEqualityComparer er typeof<'T> -> EqualityComparer<'T>.Default - | _ when isArray typeof<'T> && er -> arrayEqualityComparer true fsEqualityComparerUnlimitedHashingER - | _ when isArray typeof<'T> -> arrayEqualityComparer false fsEqualityComparerUnlimitedHashingPER - | _ when isStructuralEquatable typeof<'T> && er -> structuralEqualityComparer fsEqualityComparerUnlimitedHashingER - | _ when isStructuralEquatable typeof<'T> -> structuralEqualityComparer fsEqualityComparerUnlimitedHashingPER - | _ when er -> unknownEqualityComparer true fsEqualityComparerUnlimitedHashingER - | _ -> unknownEqualityComparer false fsEqualityComparerUnlimitedHashingPER + | :? EqualityComparer<'T> as call -> call + | _ when canUseDefaultEqualityComparer er typeof<'T> -> EqualityComparer<'T>.Default + | _ when isArray typeof<'T> && er -> arrayEqualityComparer true fsEqualityComparerUnlimitedHashingER + | _ when isArray typeof<'T> -> arrayEqualityComparer false fsEqualityComparerUnlimitedHashingPER + | _ when isValueTypeStructuralEquatable typeof<'T> && er -> structuralEqualityComparerValueType fsEqualityComparerUnlimitedHashingER + | _ when isValueTypeStructuralEquatable typeof<'T> -> structuralEqualityComparerValueType fsEqualityComparerUnlimitedHashingPER + | _ when isStructuralEquatable typeof<'T> && er -> structuralEqualityComparer fsEqualityComparerUnlimitedHashingER + | _ when isStructuralEquatable typeof<'T> -> structuralEqualityComparer fsEqualityComparerUnlimitedHashingPER + | _ when er -> unknownEqualityComparer true fsEqualityComparerUnlimitedHashingER + | _ -> unknownEqualityComparer false fsEqualityComparerUnlimitedHashingPER [] type FSharpEqualityComparer_ER<'T> private () = From d51ab1d1180ff9a195acc9faaef7fba823e7a10f Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 27 Jun 2018 15:58:29 +1000 Subject: [PATCH 27/64] Consolidated Type Specific Array Equality functions --- src/fsharp/FSharp.Core/prim-types.fs | 126 +++++---------------------- 1 file changed, 20 insertions(+), 106 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index fe788bd3291..87ce50eb3d1 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1378,105 +1378,30 @@ namespace Microsoft.FSharp.Core when 'T : char = not (# "clt" x y : bool #) when 'T : decimal = System.Decimal.op_GreaterThanOrEqual ((# "" x:decimal #), (# "" y:decimal #)) - //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: EQUALITY //------------------------------------------------------------------------- - - /// optimized case: Core implementation of structural equality on arrays. - let GenericEqualityByteArray (x:byte[]) (y:byte[]) : bool= - let lenx = x.Length - let leny = y.Length - let c = (lenx = leny) - if not c then c - else - let mutable i = 0 - let mutable res = true - while i < lenx do - let c = byteEq (get x i) (get y i) - if not c then (res <- false; i <- lenx) - else i <- i + 1 - res - - /// optimized case: Core implementation of structural equality on arrays. - let GenericEqualityInt32Array (x:int[]) (y:int[]) : bool= - let lenx = x.Length - let leny = y.Length - let c = (lenx = leny) - if not c then c - else - let mutable i = 0 - let mutable res = true - while i < lenx do - let c = int32Eq (get x i) (get y i) - if not c then (res <- false; i <- lenx) - else i <- i + 1 - res - - /// optimized case: Core implementation of structural equality on arrays - let GenericEqualitySingleArray er (x:float32[]) (y:float32[]) : bool= - let lenx = x.Length - let leny = y.Length - let f32eq x y = if er && not(float32Eq x x) && not(float32Eq y y) then true else (float32Eq x y) - let c = (lenx = leny) - if not c then c - else - let mutable i = 0 - let mutable res = true - while i < lenx do - let c = f32eq (get x i) (get y i) - if not c then (res <- false; i <- lenx) - else i <- i + 1 - res - - /// optimized case: Core implementation of structural equality on arrays. - let GenericEqualityDoubleArray er (x:float[]) (y:float[]) : bool= - let lenx = x.Length - let leny = y.Length - let c = (lenx = leny) - let feq x y = if er && not(floatEq x x) && not(floatEq y y) then true else (floatEq x y) - if not c then c - else - let mutable i = 0 - let mutable res = true - while i < lenx do - let c = feq (get x i) (get y i) - if not c then (res <- false; i <- lenx) - else i <- i + 1 - res - - /// optimized case: Core implementation of structural equality on arrays. - let GenericEqualityCharArray (x:char[]) (y:char[]) : bool= - let lenx = x.Length - let leny = y.Length - let c = (lenx = leny) - if not c then c - else - let mutable i = 0 - let mutable res = true - while i < lenx do - let c = charEq (get x i) (get y i) - if not c then (res <- false; i <- lenx) - else i <- i + 1 - res - - /// optimized case: Core implementation of structural equality on arrays. - let GenericEqualityInt64Array (x:int64[]) (y:int64[]) : bool= + let inline ArrayEquality<'T> (f:'T->'T->bool) (x:'T[]) (y:'T[]) : bool = let lenx = x.Length let leny = y.Length - let c = (lenx = leny) - if not c then c - else - let mutable i = 0 - let mutable res = true - while i < lenx do - let c = int64Eq (get x i) (get y i) - if not c then (res <- false; i <- lenx) - else i <- i + 1 - res - - + let rec loop i = + if i = lenx then true + elif f (get x i) (get y i) then loop (i+1) + else false + (lenx = leny) && loop 0 + + let inline ArrayEqualityWithERFlag<'T> (er:bool) (f:'T->'T->bool) (x:'T[]) (y:'T[]) : bool = + if er + then ArrayEquality (fun x y -> (not (f x x) && not (f y y)) || (f x y)) x y + else ArrayEquality f x y + + let GenericEqualityByteArray x y = ArrayEquality byteEq x y + let GenericEqualityInt32Array x y = ArrayEquality int32Eq x y + let GenericEqualitySingleArray er x y = ArrayEqualityWithERFlag er float32Eq x y + let GenericEqualityDoubleArray er x y = ArrayEqualityWithERFlag er floatEq x y + let GenericEqualityCharArray x y = ArrayEquality charEq x y + let GenericEqualityInt64Array x y = ArrayEquality int64Eq x y /// The core implementation of generic equality between two objects. This corresponds /// to th e pseudo-code in the F# language spec. @@ -1634,19 +1559,8 @@ namespace Microsoft.FSharp.Core #endif /// optimized case: Core implementation of structural equality on object arrays. - and GenericEqualityObjArray er iec (x:obj[]) (y:obj[]) : bool = - let lenx = x.Length - let leny = y.Length - let c = (lenx = leny ) - if not c then c - else - let mutable i = 0 - let mutable res = true - while i < lenx do - let c = GenericEqualityObj er iec ((get x i),(get y i)) - if not c then (res <- false; i <- lenx) - else i <- i + 1 - res + and GenericEqualityObjArray er iec (xarray:obj[]) (yarray:obj[]) : bool = + ArrayEquality (fun x y -> GenericEqualityObj er iec (x, y)) xarray yarray let isStructuralEquatable (ty:Type) = typeof.IsAssignableFrom ty let isValueTypeStructuralEquatable (ty:Type) = isStructuralEquatable ty && ty.IsValueType From 0390e93f78ceef74b9e81e1923a05c373a58644d Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 28 Jun 2018 08:59:46 +1000 Subject: [PATCH 28/64] Fix compiler call via FSharpFunc.Invoke rather than direct --- src/fsharp/FSharp.Core/prim-types.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 87ce50eb3d1..85079264009 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1657,7 +1657,7 @@ namespace Microsoft.FSharp.Core | (:? System.Array as arr1), (:? System.Array as arr2) -> GenericEqualityArbArray er iec arr1 arr2 | _ -> raise (Exception "invalid logic - expected array") - let getHashCode iec (xobj:obj) = + let getHashCode (iec, xobj:obj) = match xobj with | null -> 0 | :? (obj[]) as oa -> GenericHashObjArray iec oa @@ -1669,7 +1669,7 @@ namespace Microsoft.FSharp.Core { new EqualityComparer<'T>() with member __.Equals (x, y) = arrayEquals er comparer (box x) (box y) - member __.GetHashCode x = getHashCode fsEqualityComparerUnlimitedHashingPER (box x) } + member __.GetHashCode x = getHashCode (fsEqualityComparerUnlimitedHashingPER, box x) } let structuralEqualityComparer<'T> comparer = { new EqualityComparer<'T>() with From 9ea9790bd6746fc704c1e3f89cc373bdbbd9fa6a Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 28 Jun 2018 11:35:25 +1000 Subject: [PATCH 29/64] Replaced duplicated GetHashCode code with inline function --- src/fsharp/FSharp.Core/prim-types.fs | 77 ++++++++-------------------- 1 file changed, 20 insertions(+), 57 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 85079264009..7084299bde7 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -806,66 +806,29 @@ namespace Microsoft.FSharp.Core let inline HashCombine nr x y = (x <<< 1) + y + 631 * nr - let GenericHashObjArray (iec : System.Collections.IEqualityComparer) (x: obj[]) : int = - let len = x.Length - let mutable i = len - 1 - if i > defaultHashNodes then i <- defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= 0) do - // NOTE: GenericHash* call decreases nr - acc <- HashCombine i acc (iec.GetHashCode(x.GetValue(i))); - i <- i - 1 - acc - - // optimized case - byte arrays - let GenericHashByteArray (x: byte[]) : int = - let len = length x - let mutable i = len - 1 - if i > defaultHashNodes then i <- defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= 0) do - acc <- HashCombine i acc (intOfByte (get x i)); - i <- i - 1 - acc - - // optimized case - int arrays - let GenericHashInt32Array (x: int[]) : int = - let len = length x - let mutable i = len - 1 - if i > defaultHashNodes then i <- defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= 0) do - acc <- HashCombine i acc (get x i); - i <- i - 1 - acc - - // optimized case - int arrays - let GenericHashInt64Array (x: int64[]) : int = - let len = length x - let mutable i = len - 1 - if i > defaultHashNodes then i <- defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= 0) do - acc <- HashCombine i acc (int32 (get x i)); - i <- i - 1 - acc + let inline ArrayHashing<'element,'array when 'array :> System.Array> get lowerBound (f:'element->int) (x:'array) : int = + let rec loop acc i = + if i < lowerBound then acc + else loop (HashCombine i acc (f (get x i))) (i-1) + + let lastIdx = + let upperBound = lowerBound+defaultHashNodes + match lowerBound+x.Length-1 with + | oversized when oversized > upperBound -> upperBound + | good -> good + + loop 0 lastIdx + + let GenericHashObjArray (iec:System.Collections.IEqualityComparer) (x:obj[]) = ArrayHashing get 0 iec.GetHashCode x + let GenericHashByteArray (x:byte[]) = ArrayHashing get 0 intOfByte x + let GenericHashInt32Array (x:int32[]) = ArrayHashing get 0 (fun x -> x) x + let GenericHashInt64Array (x:int64[]) = ArrayHashing get 0 int32 x // special case - arrays do not by default have a decent structural hashing function let GenericHashArbArray (iec : System.Collections.IEqualityComparer) (x: System.Array) : int = - match x.Rank with - | 1 -> - let b = x.GetLowerBound(0) - let len = x.Length - let mutable i = b + len - 1 - if i > b + defaultHashNodes then i <- b + defaultHashNodes // limit the hash - let mutable acc = 0 - while (i >= b) do - // NOTE: GenericHash* call decreases nr - acc <- HashCombine i acc (iec.GetHashCode(x.GetValue(i))); - i <- i - 1 - acc - | _ -> - HashCombine 10 (x.GetLength(0)) (x.GetLength(1)) + match x.Rank with + | 1 -> ArrayHashing (fun a i -> a.GetValue i) (x.GetLowerBound 0) iec.GetHashCode x + | _ -> HashCombine 10 (x.GetLength(0)) (x.GetLength(1)) // Core implementation of structural hashing, corresponds to pseudo-code in the // F# Language spec. Searches for the IStructuralHash interface, otherwise uses GetHashCode(). From 03092bde21ae00f49b8792cf05d472665da6ee77 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 28 Jun 2018 12:27:58 +1000 Subject: [PATCH 30/64] Common array EqualityComparers (for types that previously had specialized GetHashCode) --- src/fsharp/FSharp.Core/prim-types.fs | 90 +++++++++++++++------------- 1 file changed, 48 insertions(+), 42 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 7084299bde7..f512e7527b8 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1590,49 +1590,55 @@ namespace Microsoft.FSharp.Core | true, ty when ty.Equals typeof -> box EqualityComparer.Default | _ -> null - let arrayEqualityComparer<'T> er comparer = - let arrayEquals (er:bool) (iec:System.Collections.IEqualityComparer) (xobj:obj) (yobj:obj) : bool = - match xobj,yobj with - | null, null -> true - | null, _ -> false - | _, null -> false - | (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericEqualityObjArray er iec arr1 arr2 - | _ -> - match xobj,yobj with - | (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericEqualityByteArray arr1 arr2 - | _ -> - match xobj,yobj with - | (:? (int32[]) as arr1), (:? (int32[]) as arr2) -> GenericEqualityInt32Array arr1 arr2 - | _ -> - match xobj,yobj with - | (:? (int64[]) as arr1), (:? (int64[]) as arr2) -> GenericEqualityInt64Array arr1 arr2 - | _ -> - match xobj,yobj with - | (:? (char[]) as arr1), (:? (char[]) as arr2) -> GenericEqualityCharArray arr1 arr2 - | _ -> - match xobj,yobj with - | (:? (float32[]) as arr1), (:? (float32[]) as arr2) -> GenericEqualitySingleArray er arr1 arr2 - | _ -> - match xobj,yobj with - | (:? (float[]) as arr1), (:? (float[]) as arr2) -> GenericEqualityDoubleArray er arr1 arr2 - | _ -> - match xobj,yobj with - | (:? System.Array as arr1), (:? System.Array as arr2) -> GenericEqualityArbArray er iec arr1 arr2 - | _ -> raise (Exception "invalid logic - expected array") - - let getHashCode (iec, xobj:obj) = - match xobj with - | null -> 0 - | :? (obj[]) as oa -> GenericHashObjArray iec oa - | :? (byte[]) as ba -> GenericHashByteArray ba - | :? (int[]) as ba -> GenericHashInt32Array ba - | :? (int64[]) as ba -> GenericHashInt64Array ba - | :? System.Array as a -> GenericHashArbArray iec a - | _ -> raise (Exception "invalid logic - expected array") + let inline nullableEqualityComparer<'a when 'a : null> equals getHashCode = + box { new EqualityComparer<'a>() with + member __.Equals (x,y) = + match x, y with + | null, null -> true + | null, _ -> false + | _, null -> false + | _ -> equals x y + + member __.GetHashCode x = + match x with + | null -> 0 + | _ -> getHashCode x } + + let tryGetFSharpArrayEqualityComparer (ty:Type) er comparer : obj = + if ty.Equals typeof then nullableEqualityComparer (fun x y -> GenericEqualityObjArray er comparer x y) (GenericHashObjArray fsEqualityComparerUnlimitedHashingPER) + elif ty.Equals typeof then nullableEqualityComparer GenericEqualityByteArray GenericHashByteArray + elif ty.Equals typeof then nullableEqualityComparer GenericEqualityInt32Array GenericHashInt32Array + elif ty.Equals typeof then nullableEqualityComparer GenericEqualityInt64Array GenericHashInt64Array + else null - { new EqualityComparer<'T>() with - member __.Equals (x, y) = arrayEquals er comparer (box x) (box y) - member __.GetHashCode x = getHashCode (fsEqualityComparerUnlimitedHashingPER, box x) } + let arrayEqualityComparer<'T> er comparer = + match tryGetFSharpArrayEqualityComparer typeof<'T> er comparer with + | :? EqualityComparer<'T> as arrayComparer -> arrayComparer + | _ -> + { new EqualityComparer<'T>() with + member __.Equals (x, y) = + let xobj, yobj = box x, box y + match xobj,yobj with + | null, null -> true + | null, _ -> false + | _, null -> false + | (:? (char[]) as arr1), (:? (char[]) as arr2) -> GenericEqualityCharArray arr1 arr2 + | _ -> + match xobj,yobj with + | (:? (float32[]) as arr1), (:? (float32[]) as arr2) -> GenericEqualitySingleArray er arr1 arr2 + | _ -> + match xobj,yobj with + | (:? (float[]) as arr1), (:? (float[])as arr2) -> GenericEqualityDoubleArray er arr1 arr2 + | _ -> + match xobj,yobj with + | (:? System.Array as arr1), (:? System.Array as arr2) -> GenericEqualityArbArray er comparer arr1 arr2 + | _ -> raise (Exception "invalid logic - expected array") + + member __.GetHashCode x = + match box x with + | null -> 0 + | :? System.Array as a -> GenericHashArbArray fsEqualityComparerUnlimitedHashingPER a + | _ -> raise (Exception "invalid logic - expected array") } let structuralEqualityComparer<'T> comparer = { new EqualityComparer<'T>() with From 224f20db9cd3b922163865adc53d4b1b6c8fc028 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 11 Jul 2018 16:59:13 +1000 Subject: [PATCH 31/64] Fix regression in regards to hash code on fast-path covariant arrays (+ comments) --- src/fsharp/FSharp.Core/prim-types.fs | 30 ++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index f512e7527b8..9da460dd5fa 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -839,6 +839,12 @@ namespace Microsoft.FSharp.Core match x with | null -> 0 | (:? System.Array as a) -> + // due to the rules of the CLI type system, array casts are "assignment compatible" + // see: https://blogs.msdn.microsoft.com/ericlippert/2009/09/24/why-is-covariance-of-value-typed-arrays-inconsistent/ + // this means that the cast and comparison for byte will also handle sbyte, int32 handle uint32, + // and int64 handle uint64. The hash code of an individual array element is different for the different + // types, but it is irrelevant for the creation of the hash code - but this is to be replicated in + // the tryGetFSharpArrayEqualityComparer function. match a with | :? (obj[]) as oa -> GenericHashObjArray iec oa | :? (byte[]) as ba -> GenericHashByteArray ba @@ -1383,10 +1389,12 @@ namespace Microsoft.FSharp.Core | (:? string as xs),(:? string as ys) -> System.String.Equals(xs,ys) // Permit structural equality on arrays | (:? System.Array as arr1),_ -> + // due to the rules of the CLI type system, array casts are "assignment compatible" + // see: https://blogs.msdn.microsoft.com/ericlippert/2009/09/24/why-is-covariance-of-value-typed-arrays-inconsistent/ + // this means that the cast and comparison for byte will also handle sbyte, int32 handle uint32, + // and int64 handle uint64. Equality will still be correct. match arr1,yobj with - // Fast path | (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericEqualityObjArray er iec arr1 arr2 - // Fast path | (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericEqualityByteArray arr1 arr2 | (:? (int32[]) as arr1), (:? (int32[]) as arr2) -> GenericEqualityInt32Array arr1 arr2 | (:? (int64[]) as arr1), (:? (int64[]) as arr2) -> GenericEqualityInt64Array arr1 arr2 @@ -1604,11 +1612,21 @@ namespace Microsoft.FSharp.Core | null -> 0 | _ -> getHashCode x } + let inline castNullableEqualityComparer<'fromType, 'toType when 'toType : null and 'fromType : null> (equals:'toType->'toType->bool) (getHashCode:'toType->int) = + let castEquals (lhs:'fromType) (rhs:'fromType) = equals (unboxPrim lhs) (unboxPrim rhs) + let castGetHashCode (o:'fromType) = getHashCode (unboxPrim o) + nullableEqualityComparer castEquals castGetHashCode + let tryGetFSharpArrayEqualityComparer (ty:Type) er comparer : obj = - if ty.Equals typeof then nullableEqualityComparer (fun x y -> GenericEqualityObjArray er comparer x y) (GenericHashObjArray fsEqualityComparerUnlimitedHashingPER) - elif ty.Equals typeof then nullableEqualityComparer GenericEqualityByteArray GenericHashByteArray - elif ty.Equals typeof then nullableEqualityComparer GenericEqualityInt32Array GenericHashInt32Array - elif ty.Equals typeof then nullableEqualityComparer GenericEqualityInt64Array GenericHashInt64Array + // the casts here between byte+sbyte, int32+uint32 and int64+uint64 are here to replicate the behaviour + // in GenericHashParamObj + if ty.Equals typeof then nullableEqualityComparer (fun x y -> GenericEqualityObjArray er comparer x y) (GenericHashObjArray fsEqualityComparerUnlimitedHashingPER) + elif ty.Equals typeof then nullableEqualityComparer GenericEqualityByteArray GenericHashByteArray + elif ty.Equals typeof then castNullableEqualityComparer GenericEqualityByteArray GenericHashByteArray + elif ty.Equals typeof then nullableEqualityComparer GenericEqualityInt32Array GenericHashInt32Array + elif ty.Equals typeof then castNullableEqualityComparer GenericEqualityInt32Array GenericHashInt32Array + elif ty.Equals typeof then nullableEqualityComparer GenericEqualityInt64Array GenericHashInt64Array + elif ty.Equals typeof then castNullableEqualityComparer GenericEqualityInt64Array GenericHashInt64Array else null let arrayEqualityComparer<'T> er comparer = From 84ed1ebef7a4a9d5a0cf38a67f5469ee74ebd52c Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sun, 1 Jul 2018 17:20:08 +1000 Subject: [PATCH 32/64] Similar treatment within prim-types for Comparer as #5112 was for EqualityComparer --- src/fsharp/FSharp.Core/local.fs | 9 +- src/fsharp/FSharp.Core/prim-types.fs | 289 +++++++++++------- src/fsharp/FSharp.Core/prim-types.fsi | 2 +- .../FSharp.Core/ComparersRegression.fs | 75 +++-- 4 files changed, 232 insertions(+), 143 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 42297795184..971c25d87d9 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -991,7 +991,7 @@ module internal Array = open System let inline fastComparerForArraySort<'t when 't : comparison> () = - LanguagePrimitives.FastGenericComparerCanBeNull<'t> + LanguagePrimitives.FastGenericComparerInternal<'t> // The input parameter should be checked by callers if necessary let inline zeroCreateUnchecked (count:int) = @@ -1141,13 +1141,12 @@ module internal Array = let len = array.Length if len < 2 then () else - let cFast = LanguagePrimitives.FastGenericComparerCanBeNull<'T> - match cFast with - | null -> + let cFast = LanguagePrimitives.FastGenericComparerInternal<'T> + if obj.ReferenceEquals (cFast, System.Collections.Generic.Comparer<'T>.Default) 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 diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 9da460dd5fa..b203689ce40 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -890,7 +890,6 @@ namespace Microsoft.FSharp.Core let inline PhysicalHashFast (input: 'T) = PhysicalHashIntrinsic input - //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: Comparison // @@ -906,7 +905,6 @@ namespace Microsoft.FSharp.Core let FailGenericComparison (obj: obj) = raise (new System.ArgumentException(String.Format(SR.GetString(SR.genericCompareFail1), obj.GetType().ToString()))) - /// This type has two instances - fsComparerER and fsComparerThrow. /// - fsComparerER = ER semantics = no throw on NaN comparison = new GenericComparer(false) = GenericComparer = GenericComparison @@ -921,7 +919,7 @@ namespace Microsoft.FSharp.Core /// Implements generic comparison between two objects. This corresponds to the pseudo-code in the F# /// specification. The treatment of NaNs is governed by "comp". - let rec GenericCompare (comp:GenericComparer) (xobj:obj,yobj:obj) = + let rec GenericCompare (comp:GenericComparer) (xobj:obj,yobj:obj) = (*if objEq xobj yobj then 0 else *) match xobj,yobj with | null,null -> 0 @@ -1145,11 +1143,177 @@ namespace Microsoft.FSharp.Core override c.Compare(x:obj,y:obj) = GenericCompare c (x,y) /// The unique object for comparing values in PER mode (where local exceptions are thrown when NaNs are compared) - let fsComparerPER = GenericComparer(true) + let fsComparerPER = GenericComparer(true) /// The unique object for comparing values in ER mode (where "0" is returned when NaNs are compared) let fsComparerER = GenericComparer(false) + let isStructuralComparable (ty:Type) = typeof.IsAssignableFrom ty + let isValueTypeStructuralComparable (ty:Type) = isStructuralComparable ty && ty.IsValueType + let isArray (ty:Type) = ty.IsArray || (typeof.IsAssignableFrom ty) + + let canUseDefaultComparer er (rootType:Type) = + let processed = System.Collections.Generic.HashSet () + + let rec checkType idx (types:Type[]) = + if idx = types.Length then true + else + let ty = get types idx + if not (processed.Add ty) then + checkType (idx+1) types + else + let isValidGenericType ifNotType fullname = + if not (ty.IsGenericType && ty.GetGenericTypeDefinition().FullName.Equals fullname) + then ifNotType + else checkType 0 (ty.GetGenericArguments ()) + let isTypeAndGenericArgumentsOK fullname = isValidGenericType false fullname + let isNotTypeOrIsTypeAndGenericArgumentsOK fullname = isValidGenericType true fullname + + // avoid any types that need special handling in GenericEqualityObj + // GenericEqualityObj handles string as a special cases, but internally routes to same equality + + ty.IsSealed // covers enum and value types + // ref types need to be sealed as derived class might implement IStructuralEquatable + && not (isArray ty) + && not (ty.Equals typeof) + && (er || (not (ty.Equals typeof))) + && (er || (not (ty.Equals typeof))) + && isNotTypeOrIsTypeAndGenericArgumentsOK "System.Nullable`1" + && not (isStructuralComparable ty + // we accept ValueTuple even though it supports IStructuralEquatable + // if all generic arguements pass check + && not ( isTypeAndGenericArgumentsOK "System.ValueTuple`1" + || isTypeAndGenericArgumentsOK "System.ValueTuple`2" + || isTypeAndGenericArgumentsOK "System.ValueTuple`3" + || isTypeAndGenericArgumentsOK "System.ValueTuple`4" + || isTypeAndGenericArgumentsOK "System.ValueTuple`5" + || isTypeAndGenericArgumentsOK "System.ValueTuple`6" + || isTypeAndGenericArgumentsOK "System.ValueTuple`7" + || isTypeAndGenericArgumentsOK "System.ValueTuple`8" + || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Collections.FSharpList`1" + || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpOption`1" + || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpValueOption`1" + || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpResult`2" + ) + ) + && checkType (idx+1) types + + checkType 0 [|rootType|] + + let tryGetFSharpComparer (externalUse:bool) (er:bool) (ty:Type) : obj = + match externalUse, er, ty with + | _, false, ty when ty.Equals typeof -> + box { new Comparer() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then (-1) + elif (# "cgt" x y : bool #) then (1) + elif (# "ceq" x y : bool #) then (0) + else (fsComparerPER:>IComparer).Compare (box x, box y) } + | _, false, ty when ty.Equals typeof -> + box { new Comparer() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then (-1) + elif (# "cgt" x y : bool #) then (1) + elif (# "ceq" x y : bool #) then (0) + else (fsComparerPER:>IComparer).Compare (box x, box y) } + | _, true, ty when ty.Equals typeof -> box Comparer.Default + | _, true, ty when ty.Equals typeof -> box Comparer.Default + + // the implemention of Comparer.Default returns a current culture specific comparer + | _, _, ty when ty.Equals typeof -> + box { new Comparer() with + member __.Compare (x,y) = System.String.CompareOrdinal(x, y) } + + // the implemention of the following comparers with Comparer<'T>.Default returns + // (int x)-(int y) rather than (sign (int x)-(int y)) + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) } + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) } + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) } + | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) } + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #) } + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #) } + | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #) } + + | _ -> null + + let inline nullableComparer<'a when 'a : null> compare = + box { new Comparer<'a>() with + member __.Compare (x,y) = + match x, y with + | null, null -> 0 + | null, _ -> -1 + | _, null -> 1 + | _ -> compare x y } + + let tryGetFSharpArrayComparer (ty:Type) comparer : obj = + if ty.Equals typeof then nullableComparer (fun x y -> GenericComparisonObjArrayWithComparer comparer x y) + elif ty.Equals typeof then nullableComparer GenericComparisonByteArray + else null + + let arrayComparer<'T> comparer = + match tryGetFSharpArrayComparer typeof<'T> comparer with + | :? Comparer<'T> as arrayComparer -> arrayComparer + | _ -> + { new Comparer<'T>() with + member __.Compare (x, y) = + match box x, box y with + | null, null -> 0 + | null, _ -> -1 + | _, null -> 1 + | (:? System.Array as arr1), (:? System.Array as arr2) -> GenericComparisonArbArrayWithComparer comparer arr1 arr2 + | _ -> raise (Exception "invalid logic - expected System.Array") } + + let structuralComparer<'T> comparer = + { new Comparer<'T>() with + member __.Compare (x,y) = + match box x, box y with + | null, null -> 0 + | null, _ -> -1 + | _, null -> 1 + | (:? IStructuralComparable as x1), yobj -> x1.CompareTo (yobj, comparer) + | _ -> raise (Exception "invalid logic - expected IStructuralEquatable") } + + let structuralComparerValueType<'T> comparer = + { new Comparer<'T>() with + member __.Compare (x,y) = ((box x):?>IStructuralComparable).CompareTo (y, comparer) } + + let unknownComparer<'T> comparer = + { new Comparer<'T>() with + member __.Compare (x,y) = GenericCompare comparer (box x, box y) } + + let getGenericComparison<'T> externalUse er = + match tryGetFSharpComparer externalUse er typeof<'T> with + | :? Comparer<'T> as call -> call + | _ when canUseDefaultComparer er typeof<'T> -> Comparer<'T>.Default + | _ when isArray typeof<'T> && er -> arrayComparer fsComparerER + | _ when isArray typeof<'T> -> arrayComparer fsComparerPER + | _ when isValueTypeStructuralComparable typeof<'T> && er -> structuralComparerValueType fsComparerER + | _ when isValueTypeStructuralComparable typeof<'T> -> structuralComparerValueType fsComparerPER + | _ when isStructuralComparable typeof<'T> && er -> structuralComparer fsComparerER + | _ when isStructuralComparable typeof<'T> -> structuralComparer fsComparerPER + | _ when er -> unknownComparer fsComparerER + | _ -> unknownComparer fsComparerPER + + [] + type FSharpComparer_ER<'T> private () = + static let comparer = getGenericComparison<'T> true true + static member Comparer = comparer + + [] + type FSharpComparer_InternalUse_ER<'T> private () = + static let comparer = getGenericComparison<'T> false true + static member Comparer = comparer + + [] + type FSharpComparer_PER<'T> private () = + static let comparer = getGenericComparison<'T> true false + static member Comparer = comparer + + [] + type FSharpComparer_InternalUse_PER<'T> private () = + static let comparer = getGenericComparison<'T> false false + static member Comparer = comparer + /// Compare two values of the same generic type, using "comp". // // "comp" is assumed to be either fsComparerPER or fsComparerER (and hence 'Compare' is implemented via 'GenericCompare'). @@ -1157,7 +1321,12 @@ namespace Microsoft.FSharp.Core // NOTE: the compiler optimizer is aware of this function and devirtualizes in the // cases where it is known how a particular type implements generic comparison. let GenericComparisonWithComparerIntrinsic<'T> (comp:System.Collections.IComparer) (x:'T) (y:'T) : int = - comp.Compare(box x, box y) + if obj.ReferenceEquals (comp, fsComparerER) then + FSharpComparer_InternalUse_ER.Comparer.Compare (x, y) + elif obj.ReferenceEquals (comp, fsComparerPER) then + FSharpComparer_InternalUse_PER.Comparer.Compare (x, y) + else + comp.Compare (box x, box y) /// Compare two values of the same generic type, in either PER or ER mode, but include static optimizations /// for various well-known cases. @@ -1193,52 +1362,45 @@ namespace Microsoft.FSharp.Core System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #)) when 'T : decimal = System.Decimal.Compare((# "" x:decimal #), (# "" y:decimal #)) - /// Generic comparison. Implements ER mode (where "0" is returned when NaNs are compared) // // The compiler optimizer is aware of this function (see use of generic_comparison_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericComparisonIntrinsic<'T> (x:'T) (y:'T) : int = - GenericComparisonWithComparerIntrinsic (fsComparerER :> IComparer) x y - + FSharpComparer_ER.Comparer.Compare (x, y) /// Generic less-than. Uses comparison implementation in PER mode but catches /// the local exception that is thrown when NaN's are compared. let GenericLessThanIntrinsic (x:'T) (y:'T) = try - (# "clt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) 0 : bool #) + (# "clt" (FSharpComparer_PER.Comparer.Compare (x, y)) 0 : bool #) with | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false - /// Generic greater-than. Uses comparison implementation in PER mode but catches /// the local exception that is thrown when NaN's are compared. let GenericGreaterThanIntrinsic (x:'T) (y:'T) = try - (# "cgt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) 0 : bool #) + (# "cgt" (FSharpComparer_PER.Comparer.Compare (x, y)) 0 : bool #) with | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false - /// Generic greater-than-or-equal. Uses comparison implementation in PER mode but catches /// the local exception that is thrown when NaN's are compared. let GenericGreaterOrEqualIntrinsic (x:'T) (y:'T) = try - (# "cgt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) (-1) : bool #) + (# "cgt" (FSharpComparer_PER.Comparer.Compare (x, y)) (-1) : bool #) with | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false - - /// Generic less-than-or-equal. Uses comparison implementation in PER mode but catches /// the local exception that is thrown when NaN's are compared. let GenericLessOrEqualIntrinsic (x:'T) (y:'T) = try - (# "clt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) 1 : bool #) + (# "clt" (FSharpComparer_PER.Comparer.Compare (x, y)) 1 : bool #) with | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false - /// Compare two values of the same generic type, in ER mode, with static optimizations /// for known cases. let inline GenericComparisonFast<'T> (x:'T) (y:'T) : int = @@ -1535,7 +1697,6 @@ namespace Microsoft.FSharp.Core let isStructuralEquatable (ty:Type) = typeof.IsAssignableFrom ty let isValueTypeStructuralEquatable (ty:Type) = isStructuralEquatable ty && ty.IsValueType - let isArray (ty:Type) = ty.IsArray || (typeof.IsAssignableFrom ty) let canUseDefaultEqualityComparer er (rootType:Type) = let processed = System.Collections.Generic.HashSet () @@ -1844,7 +2005,6 @@ namespace Microsoft.FSharp.Core /// Fill in the implementation of UnlimitedHasherER type UnlimitedHasherER with - interface System.Collections.IEqualityComparer with override iec.Equals(x:obj,y:obj) = GenericEqualityObj true iec (x,y) override iec.GetHashCode(x:obj) = GenericHashParamObj iec x @@ -2190,93 +2350,9 @@ namespace Microsoft.FSharp.Core let inline MakeGenericComparer<'T>() = { new System.Collections.Generic.IComparer<'T> with member __.Compare(x,y) = GenericComparison x y } - - let CharComparer = MakeGenericComparer() - let StringComparer = MakeGenericComparer() - let SByteComparer = MakeGenericComparer() - let Int16Comparer = MakeGenericComparer() - let Int32Comparer = MakeGenericComparer() - let Int64Comparer = MakeGenericComparer() - let IntPtrComparer = MakeGenericComparer() - let ByteComparer = MakeGenericComparer() - let UInt16Comparer = MakeGenericComparer() - let UInt32Comparer = MakeGenericComparer() - let UInt64Comparer = MakeGenericComparer() - let UIntPtrComparer = MakeGenericComparer() - let FloatComparer = MakeGenericComparer() - let Float32Comparer = MakeGenericComparer() - let DecimalComparer = MakeGenericComparer() - let BoolComparer = MakeGenericComparer() - - /// Use a type-indexed table to ensure we only create a single FastStructuralComparison function - /// for each type - [] - type FastGenericComparerTable<'T>() = - - // The CLI implementation of mscorlib optimizes array sorting - // when the comparer is either null or precisely - // reference-equals to System.Collections.Generic.Comparer<'T>.Default. - // This is an indication that a "fast" array sorting helper can be used. - // - // So, for all the types listed below, we want to pass in a value of "null" for - // the comparer object. Note that F# generic comparison coincides precisely with - // System.Collections.Generic.Comparer<'T>.Default for these types. - // - // A "null" comparer is only valid if the values do not have identity, e.g. integers. - // That is, an unstable sort of the array must be the semantically the - // same as a stable sort of the array. See Array.stableSortInPlace. - // - // REVIEW: in a future version we could extend this to include additional types - static let fCanBeNull : System.Collections.Generic.IComparer<'T> = - match typeof<'T> with - | ty when ty.Equals(typeof) -> unboxPrim (box IntPtrComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UIntPtrComparer) - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> unboxPrim (box StringComparer) - | ty when ty.Equals(typeof) -> null - | _ -> MakeGenericComparer<'T>() - - static let f : System.Collections.Generic.IComparer<'T> = - match typeof<'T> with - | ty when ty.Equals(typeof) -> unboxPrim (box ByteComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box CharComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box SByteComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box Int16Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box Int32Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box Int64Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box IntPtrComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt16Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt32Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt64Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UIntPtrComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box FloatComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box Float32Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box DecimalComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box StringComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box BoolComparer) - | _ -> - // Review: There are situations where we should be able - // to return System.Collections.Generic.Comparer<'T>.Default here. - // For example, for any value type. - MakeGenericComparer<'T>() - - static member Value : System.Collections.Generic.IComparer<'T> = f - - static member ValueCanBeNullIfDefaultSemantics : System.Collections.Generic.IComparer<'T> = fCanBeNull - let FastGenericComparerFromTable<'T> = - FastGenericComparerTable<'T>.Value + let FastGenericComparerFromTable<'T> : IComparer<'T> = + HashCompare.FSharpComparer_ER<'T>.Comparer :> IComparer<'T> let inline FastGenericComparer<'T> = // This gets used is 'T can't be resolved to anything interesting @@ -2307,7 +2383,8 @@ namespace Microsoft.FSharp.Core // which are then optimized for the particular nominal type involved. when 'T : 'T = MakeGenericComparer<'T>() - let FastGenericComparerCanBeNull<'T> = FastGenericComparerTable<'T>.ValueCanBeNullIfDefaultSemantics + let FastGenericComparerInternal<'T> : Comparer<'T> = + HashCompare.FSharpComparer_InternalUse_ER<'T>.Comparer //------------------------------------------------------------------------- // LanguagePrimitives: ENUMS diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 52b2139725d..1cd2364a345 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -952,7 +952,7 @@ namespace Microsoft.FSharp.Core val inline FastGenericComparer<'T> : System.Collections.Generic.IComparer<'T> when 'T : comparison /// Make an F# comparer object for the given type, where it can be null if System.Collections.Generic.Comparer<'T>.Default - val internal FastGenericComparerCanBeNull<'T> : System.Collections.Generic.IComparer<'T> when 'T : comparison + val internal FastGenericComparerInternal<'T> : System.Collections.Generic.Comparer<'T> when 'T : comparison /// Make an F# hash/equality object for the given type val inline FastGenericEqualityComparer<'T> : System.Collections.Generic.IEqualityComparer<'T> when 'T : equality diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs index 4333e5316af..b9aa3b5a290 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs @@ -5183,41 +5183,47 @@ type GeneratedTestSuite () = [] member __.``SBytes.Collection.ArrayArray C.I.compare``() = validate (SBytes.Collection.ArrayArray) C.I.compare [| - 0;1;-1;1;1;-1;-1;-1;-1;-1;-1;0;-1;1;1;-1;-1;-1;-1;-1;1;1;0;1;1;-1;-1;-1;-1;-1;-1;-1;-1;0;-1;-1;-1;-1;-1;-1; - -1;-1;-1;1;0;-1;-1;-1;-1;-1;1;1;1;1;1;0;1;-1;1;1;1;1;1;1;1;-1;0;-1;1;1;1;1;1;1;1;1;1;0;1;1; - 1;1;1;1;1;-1;-1;-1;0;-1;1;1;1;1;1;-1;-1;-1;1;0 - |] + 0;-255;-127;-128;-129;-1;-1;-1;-1;-1;255;0;128;127;126;-1;-1; + -1;-1;-1;127;-128;0;-1;-2;-1;-1;-1;-1;-1;128;-127;1;0;-1;-1; + -1;-1;-1;-1;129;-126;2;1;0;-1;-1;-1;-1;-1;1;1;1;1;1;0;-255; + -127;-128;-129;1;1;1;1;1;255;0;128;127;126;1;1;1;1;1;127; + -128;0;-1;-2;1;1;1;1;1;128;-127;1;0;-1;1;1;1;1;1;129;-126; + 2;1;0|] [] member __.``SBytes.Collection.ArrayArray C.I.less_than``() = validate (SBytes.Collection.ArrayArray) C.I.less_than [| - 0;0;1;0;0;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1; - 1;1;1;0;0;1;1;1;1;1;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;0;1;0;0;0;0;0;0;0;0;0;0;0;0; - 0;0;0;0;0;1;1;1;0;1;0;0;0;0;0;1;1;1;0;0 + 0;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;0;1;0;1;1;1; + 1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;1;0;0;0;1;1;1;1;1;0;0; + 0;0;0;0;1;1;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0; + 1;1;0;0;0;0;0;0;1;0;0;1;0;0;0;0;0;0;1;0;0;0 |] [] member __.``SBytes.Collection.ArrayArray C.I.less_or_equal``() = validate (SBytes.Collection.ArrayArray) C.I.less_or_equal [| - 1;0;1;0;0;1;1;1;1;1;1;1;1;0;0;1;1;1;1;1;0;0;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; - 1;1;1;0;1;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;0;0;0;0;0;1;1;1;0;0;0;0;0;0;0;0;0;1;0;0; - 0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;1;1;1;0;1 + 1;1;1;1;1;1;1;1;1;1;0;1;0;0;0;1;1;1;1;1;0;1;1;1;1;1; + 1;1;1;1;0;1;0;1;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;0; + 0;0;0;1;1;1;1;1;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;1;1; + 1;1;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;0;0;1 |] [] member __.``SBytes.Collection.ArrayArray C.I.greater_than``() = validate (SBytes.Collection.ArrayArray) C.I.greater_than [| - 0;1;0;1;1;0;0;0;0;0;0;0;0;1;1;0;0;0;0;0;1;1;0;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; - 0;0;0;1;0;0;0;0;0;0;1;1;1;1;1;0;1;0;1;1;1;1;1;1;1;0;0;0;1;1;1;1;1;1;1;1;1;0;1;1; - 1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;0;0;0;1;0 + 0;0;0;0;0;0;0;0;0;0;1;0;1;1;1;0;0;0;0;0;1;0;0;0;0;0; + 0;0;0;0;1;0;1;0;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;1; + 1;1;1;0;0;0;0;0;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;0;0; + 0;0;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;1;1;0 |] [] member __.``SBytes.Collection.ArrayArray C.I.greater_or_equal``() = validate (SBytes.Collection.ArrayArray) C.I.greater_or_equal [| - 1;1;0;1;1;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0; - 0;0;0;1;1;0;0;0;0;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1; - 1;1;1;1;1;0;0;0;1;0;1;1;1;1;1;0;0;0;1;1 + 1;0;0;0;0;0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;0; + 0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;0;1;1;1;0;0;0;0;0;1;1; + 1;1;1;1;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1; + 0;0;1;1;1;1;1;1;0;1;1;0;1;1;1;1;1;1;0;1;1;1 |] [] @@ -5247,41 +5253,48 @@ type GeneratedTestSuite () = [] member __.``SBytes.Collection.ArrayArray C.N.compare``() = validate (SBytes.Collection.ArrayArray) C.N.compare [| - 0;1;-1;1;1;-1;-1;-1;-1;-1;-1;0;-1;1;1;-1;-1;-1;-1;-1;1;1;0;1;1;-1;-1;-1;-1;-1;-1;-1;-1;0;-1;-1;-1;-1;-1;-1; - -1;-1;-1;1;0;-1;-1;-1;-1;-1;1;1;1;1;1;0;1;-1;1;1;1;1;1;1;1;-1;0;-1;1;1;1;1;1;1;1;1;1;0;1;1; - 1;1;1;1;1;-1;-1;-1;0;-1;1;1;1;1;1;-1;-1;-1;1;0 + 0;-255;-127;-128;-129;-1;-1;-1;-1;-1;255;0;128;127;126;-1;-1; + -1;-1;-1;127;-128;0;-1;-2;-1;-1;-1;-1;-1;128;-127;1;0;-1;-1; + -1;-1;-1;-1;129;-126;2;1;0;-1;-1;-1;-1;-1;1;1;1;1;1;0;-255; + -127;-128;-129;1;1;1;1;1;255;0;128;127;126;1;1;1;1;1;127; + -128;0;-1;-2;1;1;1;1;1;128;-127;1;0;-1;1;1;1;1;1;129;-126; + 2;1;0 |] [] member __.``SBytes.Collection.ArrayArray C.N.less_than``() = validate (SBytes.Collection.ArrayArray) C.N.less_than [| - 0;0;1;0;0;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1; - 1;1;1;0;0;1;1;1;1;1;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;0;1;0;0;0;0;0;0;0;0;0;0;0;0; - 0;0;0;0;0;1;1;1;0;1;0;0;0;0;0;1;1;1;0;0 + 0;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;0;1;0;1;1;1; + 1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;1;0;0;0;1;1;1;1;1;0;0; + 0;0;0;0;1;1;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0; + 1;1;0;0;0;0;0;0;1;0;0;1;0;0;0;0;0;0;1;0;0;0 |] [] member __.``SBytes.Collection.ArrayArray C.N.less_or_equal``() = validate (SBytes.Collection.ArrayArray) C.N.less_or_equal [| - 1;0;1;0;0;1;1;1;1;1;1;1;1;0;0;1;1;1;1;1;0;0;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; - 1;1;1;0;1;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;0;0;0;0;0;1;1;1;0;0;0;0;0;0;0;0;0;1;0;0; - 0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;1;1;1;0;1 + 1;1;1;1;1;1;1;1;1;1;0;1;0;0;0;1;1;1;1;1;0;1;1;1;1;1; + 1;1;1;1;0;1;0;1;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;0; + 0;0;0;1;1;1;1;1;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;1;1; + 1;1;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;0;0;1 |] [] member __.``SBytes.Collection.ArrayArray C.N.greater_than``() = validate (SBytes.Collection.ArrayArray) C.N.greater_than [| - 0;1;0;1;1;0;0;0;0;0;0;0;0;1;1;0;0;0;0;0;1;1;0;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; - 0;0;0;1;0;0;0;0;0;0;1;1;1;1;1;0;1;0;1;1;1;1;1;1;1;0;0;0;1;1;1;1;1;1;1;1;1;0;1;1; - 1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;0;0;0;1;0 + 0;0;0;0;0;0;0;0;0;0;1;0;1;1;1;0;0;0;0;0;1;0;0;0;0;0; + 0;0;0;0;1;0;1;0;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;1; + 1;1;1;0;0;0;0;0;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;0;0; + 0;0;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;1;1;0 |] [] member __.``SBytes.Collection.ArrayArray C.N.greater_or_equal``() = validate (SBytes.Collection.ArrayArray) C.N.greater_or_equal [| - 1;1;0;1;1;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0; - 0;0;0;1;1;0;0;0;0;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1; - 1;1;1;1;1;0;0;0;1;0;1;1;1;1;1;0;0;0;1;1 + 1;0;0;0;0;0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;0; + 0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;0;1;1;1;0;0;0;0;0;1;1; + 1;1;1;1;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1; + 0;0;1;1;1;1;1;1;0;1;1;0;1;1;1;1;1;1;0;1;1;1 |] [] From cd855bb90180a6d3eecda708d3e543dd217d0b22 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 2 Jul 2018 19:13:47 +1000 Subject: [PATCH 33/64] Moved throwing exceptions closer --- src/fsharp/FSharp.Core/prim-types.fs | 42 ++++++++++++---------------- 1 file changed, 18 insertions(+), 24 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index b203689ce40..0f9ce795ab8 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1205,34 +1205,33 @@ namespace Microsoft.FSharp.Core | _, false, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = - if (# "clt" x y : bool #) then (-1) - elif (# "cgt" x y : bool #) then (1) - elif (# "ceq" x y : bool #) then (0) - else (fsComparerPER:>IComparer).Compare (box x, box y) } + if (# "clt" x y : bool #) then -1 + elif (# "cgt" x y : bool #) then 1 + elif (# "ceq" x y : bool #) then 0 + else raise NaNException } | _, false, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = - if (# "clt" x y : bool #) then (-1) - elif (# "cgt" x y : bool #) then (1) - elif (# "ceq" x y : bool #) then (0) - else (fsComparerPER:>IComparer).Compare (box x, box y) } + if (# "clt" x y : bool #) then -1 + elif (# "cgt" x y : bool #) then 1 + elif (# "ceq" x y : bool #) then 0 + else raise NaNException } | _, true, ty when ty.Equals typeof -> box Comparer.Default | _, true, ty when ty.Equals typeof -> box Comparer.Default // the implemention of Comparer.Default returns a current culture specific comparer - | _, _, ty when ty.Equals typeof -> - box { new Comparer() with - member __.Compare (x,y) = System.String.CompareOrdinal(x, y) } + | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = System.String.CompareOrdinal(x, y) } + + | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } + | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } // the implemention of the following comparers with Comparer<'T>.Default returns // (int x)-(int y) rather than (sign (int x)-(int y)) - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) } - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) } - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) } - | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #) } - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #) } - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #) } - | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #) } + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } + | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } | _ -> null @@ -1306,11 +1305,6 @@ namespace Microsoft.FSharp.Core [] type FSharpComparer_PER<'T> private () = - static let comparer = getGenericComparison<'T> true false - static member Comparer = comparer - - [] - type FSharpComparer_InternalUse_PER<'T> private () = static let comparer = getGenericComparison<'T> false false static member Comparer = comparer @@ -1324,7 +1318,7 @@ namespace Microsoft.FSharp.Core if obj.ReferenceEquals (comp, fsComparerER) then FSharpComparer_InternalUse_ER.Comparer.Compare (x, y) elif obj.ReferenceEquals (comp, fsComparerPER) then - FSharpComparer_InternalUse_PER.Comparer.Compare (x, y) + FSharpComparer_PER.Comparer.Compare (x, y) else comp.Compare (box x, box y) From 87a2c6a692fd245d7c3e82a3603094674e50a0d3 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 2 Jul 2018 20:09:55 +1000 Subject: [PATCH 34/64] Added comparison usage, so could remove exception catching logic when unnecessary --- src/fsharp/FSharp.Core/prim-types.fs | 156 ++++++++++++++++++--------- 1 file changed, 103 insertions(+), 53 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 0f9ce795ab8..80b77f37281 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1200,38 +1200,73 @@ namespace Microsoft.FSharp.Core checkType 0 [|rootType|] - let tryGetFSharpComparer (externalUse:bool) (er:bool) (ty:Type) : obj = - match externalUse, er, ty with - | _, false, ty when ty.Equals typeof -> + type ComparisonUsage = + | NormalUsage = 0 + | LessThanUsage = 1 + | GreaterThanUsage = 2 + + let tryGetFSharpComparer (usage:ComparisonUsage) (externalUse:bool) (er:bool) (ty:Type) : obj = + match usage, externalUse, er, ty with + | ComparisonUsage.NormalUsage, _, false, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 elif (# "cgt" x y : bool #) then 1 elif (# "ceq" x y : bool #) then 0 else raise NaNException } - | _, false, ty when ty.Equals typeof -> + | ComparisonUsage.LessThanUsage, _, false, ty when ty.Equals typeof -> + box { new Comparer() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then -1 + elif (# "cgt" x y : bool #) then 1 + elif (# "ceq" x y : bool #) then 0 + else 1 } + | ComparisonUsage.GreaterThanUsage, _, false, ty when ty.Equals typeof -> + System.Console.WriteLine "ComparisonUsage.GreaterThanUsage" + box { new Comparer() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then -1 + elif (# "cgt" x y : bool #) then 1 + elif (# "ceq" x y : bool #) then 0 + else -1 } + | ComparisonUsage.NormalUsage, _, false, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 elif (# "cgt" x y : bool #) then 1 elif (# "ceq" x y : bool #) then 0 else raise NaNException } - | _, true, ty when ty.Equals typeof -> box Comparer.Default - | _, true, ty when ty.Equals typeof -> box Comparer.Default + | ComparisonUsage.LessThanUsage, _, false, ty when ty.Equals typeof -> + box { new Comparer() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then -1 + elif (# "cgt" x y : bool #) then 1 + elif (# "ceq" x y : bool #) then 0 + else 1 } + | ComparisonUsage.GreaterThanUsage, _, false, ty when ty.Equals typeof -> + box { new Comparer() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then -1 + elif (# "cgt" x y : bool #) then 1 + elif (# "ceq" x y : bool #) then 0 + else -1 } + + | _, _, true, ty when ty.Equals typeof -> box Comparer.Default + | _, _, true, ty when ty.Equals typeof -> box Comparer.Default // the implemention of Comparer.Default returns a current culture specific comparer - | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = System.String.CompareOrdinal(x, y) } + | _, _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = System.String.CompareOrdinal(x, y) } - | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } - | _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } + | _, _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } + | _, _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } // the implemention of the following comparers with Comparer<'T>.Default returns // (int x)-(int y) rather than (sign (int x)-(int y)) - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } - | true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } + | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } + | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } + | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } + | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } + | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } | _ -> null @@ -1280,32 +1315,63 @@ namespace Microsoft.FSharp.Core { new Comparer<'T>() with member __.Compare (x,y) = GenericCompare comparer (box x, box y) } - let getGenericComparison<'T> externalUse er = - match tryGetFSharpComparer externalUse er typeof<'T> with - | :? Comparer<'T> as call -> call - | _ when canUseDefaultComparer er typeof<'T> -> Comparer<'T>.Default - | _ when isArray typeof<'T> && er -> arrayComparer fsComparerER - | _ when isArray typeof<'T> -> arrayComparer fsComparerPER - | _ when isValueTypeStructuralComparable typeof<'T> && er -> structuralComparerValueType fsComparerER - | _ when isValueTypeStructuralComparable typeof<'T> -> structuralComparerValueType fsComparerPER - | _ when isStructuralComparable typeof<'T> && er -> structuralComparer fsComparerER - | _ when isStructuralComparable typeof<'T> -> structuralComparer fsComparerPER - | _ when er -> unknownComparer fsComparerER - | _ -> unknownComparer fsComparerPER + let getGenericComparison<'T> usage externalUse er = + match tryGetFSharpComparer usage externalUse er typeof<'T> with + | :? Comparer<'T> as comparer -> comparer + | _ when canUseDefaultComparer er typeof<'T> -> Comparer<'T>.Default + | _ -> + if er then + if isArray typeof<'T> then arrayComparer fsComparerER + elif isValueTypeStructuralComparable typeof<'T> then structuralComparerValueType fsComparerER + elif isStructuralComparable typeof<'T> then structuralComparer fsComparerER + else unknownComparer fsComparerER + else + let comparer = + if isArray typeof<'T> then arrayComparer fsComparerPER + elif isValueTypeStructuralComparable typeof<'T> then structuralComparerValueType fsComparerPER + elif isStructuralComparable typeof<'T> then structuralComparer fsComparerPER + else unknownComparer fsComparerPER + + match usage with + | ComparisonUsage.LessThanUsage -> + { new Comparer<'T>() with + member __.Compare (x,y) = + try + comparer.Compare (x,y) + with + e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> 1 } + | ComparisonUsage.GreaterThanUsage -> + { new Comparer<'T>() with + member __.Compare (x,y) = + try + comparer.Compare (x,y) + with + e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> -1 } + | _ -> comparer [] type FSharpComparer_ER<'T> private () = - static let comparer = getGenericComparison<'T> true true + static let comparer = getGenericComparison<'T> ComparisonUsage.NormalUsage true true static member Comparer = comparer [] type FSharpComparer_InternalUse_ER<'T> private () = - static let comparer = getGenericComparison<'T> false true + static let comparer = getGenericComparison<'T> ComparisonUsage.NormalUsage false true static member Comparer = comparer [] type FSharpComparer_PER<'T> private () = - static let comparer = getGenericComparison<'T> false false + static let comparer = getGenericComparison<'T> ComparisonUsage.NormalUsage false false + static member Comparer = comparer + + [] + type FSharpComparer_ForLessThanComparison<'T> private () = + static let comparer = getGenericComparison<'T> ComparisonUsage.LessThanUsage false false + static member Comparer = comparer + + [] + type FSharpComparer_ForGreaterThanComparison<'T> private () = + static let comparer = getGenericComparison<'T> ComparisonUsage.GreaterThanUsage false false static member Comparer = comparer /// Compare two values of the same generic type, using "comp". @@ -1363,37 +1429,21 @@ namespace Microsoft.FSharp.Core let GenericComparisonIntrinsic<'T> (x:'T) (y:'T) : int = FSharpComparer_ER.Comparer.Compare (x, y) - /// Generic less-than. Uses comparison implementation in PER mode but catches - /// the local exception that is thrown when NaN's are compared. + /// Generic less-than. let GenericLessThanIntrinsic (x:'T) (y:'T) = - try - (# "clt" (FSharpComparer_PER.Comparer.Compare (x, y)) 0 : bool #) - with - | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false + (# "clt" (FSharpComparer_ForLessThanComparison.Comparer.Compare (x, y)) 0 : bool #) - /// Generic greater-than. Uses comparison implementation in PER mode but catches - /// the local exception that is thrown when NaN's are compared. + /// Generic greater-than. let GenericGreaterThanIntrinsic (x:'T) (y:'T) = - try - (# "cgt" (FSharpComparer_PER.Comparer.Compare (x, y)) 0 : bool #) - with - | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false + (# "cgt" (FSharpComparer_ForGreaterThanComparison.Comparer.Compare (x, y)) 0 : bool #) - /// Generic greater-than-or-equal. Uses comparison implementation in PER mode but catches - /// the local exception that is thrown when NaN's are compared. + /// Generic greater-than-or-equal. let GenericGreaterOrEqualIntrinsic (x:'T) (y:'T) = - try - (# "cgt" (FSharpComparer_PER.Comparer.Compare (x, y)) (-1) : bool #) - with - | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false + (# "cgt" (FSharpComparer_ForGreaterThanComparison.Comparer.Compare (x, y)) -1 : bool #) - /// Generic less-than-or-equal. Uses comparison implementation in PER mode but catches - /// the local exception that is thrown when NaN's are compared. + /// Generic less-than-or-equal. let GenericLessOrEqualIntrinsic (x:'T) (y:'T) = - try - (# "clt" (FSharpComparer_PER.Comparer.Compare (x, y)) 1 : bool #) - with - | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false + (# "clt" (FSharpComparer_ForLessThanComparison.Comparer.Compare (x, y)) 1 : bool #) /// Compare two values of the same generic type, in ER mode, with static optimizations /// for known cases. From 0d5689076b1a102560fde49018b51e0fb16a485c Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 3 Jul 2018 16:20:33 +1000 Subject: [PATCH 35/64] Consolidated functions --- src/fsharp/FSharp.Core/prim-types.fs | 178 +++++++++++++-------------- 1 file changed, 86 insertions(+), 92 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 80b77f37281..77aeeb887c4 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1201,72 +1201,64 @@ namespace Microsoft.FSharp.Core checkType 0 [|rootType|] type ComparisonUsage = - | NormalUsage = 0 - | LessThanUsage = 1 - | GreaterThanUsage = 2 - - let tryGetFSharpComparer (usage:ComparisonUsage) (externalUse:bool) (er:bool) (ty:Type) : obj = - match usage, externalUse, er, ty with - | ComparisonUsage.NormalUsage, _, false, ty when ty.Equals typeof -> - box { new Comparer() with - member __.Compare (x,y) = - if (# "clt" x y : bool #) then -1 - elif (# "cgt" x y : bool #) then 1 - elif (# "ceq" x y : bool #) then 0 - else raise NaNException } - | ComparisonUsage.LessThanUsage, _, false, ty when ty.Equals typeof -> - box { new Comparer() with - member __.Compare (x,y) = - if (# "clt" x y : bool #) then -1 - elif (# "cgt" x y : bool #) then 1 - elif (# "ceq" x y : bool #) then 0 - else 1 } - | ComparisonUsage.GreaterThanUsage, _, false, ty when ty.Equals typeof -> - System.Console.WriteLine "ComparisonUsage.GreaterThanUsage" - box { new Comparer() with - member __.Compare (x,y) = - if (# "clt" x y : bool #) then -1 - elif (# "cgt" x y : bool #) then 1 - elif (# "ceq" x y : bool #) then 0 - else -1 } - | ComparisonUsage.NormalUsage, _, false, ty when ty.Equals typeof -> - box { new Comparer() with - member __.Compare (x,y) = - if (# "clt" x y : bool #) then -1 - elif (# "cgt" x y : bool #) then 1 - elif (# "ceq" x y : bool #) then 0 - else raise NaNException } - | ComparisonUsage.LessThanUsage, _, false, ty when ty.Equals typeof -> - box { new Comparer() with - member __.Compare (x,y) = - if (# "clt" x y : bool #) then -1 - elif (# "cgt" x y : bool #) then 1 - elif (# "ceq" x y : bool #) then 0 - else 1 } - | ComparisonUsage.GreaterThanUsage, _, false, ty when ty.Equals typeof -> - box { new Comparer() with + | ERUsage = 0 + | PERUsage = 1 + | LessThanUsage = 2 + | GreaterThanUsage = 3 + + [] + let LessThanUsageReturnFalse = 1 + [] + let GreaterThanUsageReturnFalse = -1 + + let inline signedComparer<'T> () = + box { new Comparer<'T>() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then -1 + else (# "cgt" x y : int #) } + + let inline unsignedComparer<'T> () = + box { new Comparer<'T>() with + member __.Compare (x,y) = + if (# "clt.un" x y : bool #) then -1 + else (# "cgt.un" x y : int #) } + + let inline floatingPointComparer<'T> onNaN = + box { new Comparer<'T>() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then -1 + elif (# "cgt" x y : bool #) then 1 + elif (# "ceq" x y : bool #) then 0 + else onNaN () } + + let tryGetFSharpComparer (usage:ComparisonUsage) (externalUse:bool) (ty:Type) : obj = + match usage, externalUse, ty with + | ComparisonUsage.ERUsage, _, ty when ty.Equals typeof -> box Comparer.Default + | ComparisonUsage.ERUsage, _, ty when ty.Equals typeof -> box Comparer.Default + + | ComparisonUsage.PERUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> raise NaNException) + | ComparisonUsage.LessThanUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> LessThanUsageReturnFalse) + | ComparisonUsage.GreaterThanUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> GreaterThanUsageReturnFalse) + + | ComparisonUsage.PERUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> raise NaNException) + | ComparisonUsage.LessThanUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> LessThanUsageReturnFalse) + | ComparisonUsage.GreaterThanUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> GreaterThanUsageReturnFalse) + + // the implemention of Comparer.Default returns a current culture specific comparer + | _, _, ty when ty.Equals typeof -> + box { new Comparer() with member __.Compare (x,y) = - if (# "clt" x y : bool #) then -1 - elif (# "cgt" x y : bool #) then 1 - elif (# "ceq" x y : bool #) then 0 - else -1 } + System.String.CompareOrdinal (x, y) } - | _, _, true, ty when ty.Equals typeof -> box Comparer.Default - | _, _, true, ty when ty.Equals typeof -> box Comparer.Default + | _, _, ty when ty.Equals typeof -> unsignedComparer () + | _, _, ty when ty.Equals typeof -> signedComparer () - // the implemention of Comparer.Default returns a current culture specific comparer - | _, _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = System.String.CompareOrdinal(x, y) } - - | _, _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } - | _, _, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } - - // the implemention of the following comparers with Comparer<'T>.Default returns - // (int x)-(int y) rather than (sign (int x)-(int y)) - | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } - | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } - | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt.un" x y : bool #) then -1 else (# "cgt.un" x y : int #) } - | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } - | _, true, _, ty when ty.Equals typeof -> box { new Comparer() with member __.Compare (x,y) = if (# "clt" x y : bool #) then -1 else (# "cgt" x y : int #) } + // these are used as external facing comparers for compatability (they always return -1/0/+1) + | _, true, ty when ty.Equals typeof -> unsignedComparer () + | _, true, ty when ty.Equals typeof -> signedComparer () + | _, true, ty when ty.Equals typeof -> signedComparer () + | _, true, ty when ty.Equals typeof -> unsignedComparer () + | _, true, ty when ty.Equals typeof -> unsignedComparer () | _ -> null @@ -1309,69 +1301,71 @@ namespace Microsoft.FSharp.Core let structuralComparerValueType<'T> comparer = { new Comparer<'T>() with - member __.Compare (x,y) = ((box x):?>IStructuralComparable).CompareTo (y, comparer) } + member __.Compare (x,y) = + ((box x):?>IStructuralComparable).CompareTo (y, comparer) } let unknownComparer<'T> comparer = { new Comparer<'T>() with - member __.Compare (x,y) = GenericCompare comparer (box x, box y) } + member __.Compare (x,y) = + GenericCompare comparer (box x, box y) } + + // this wrapper is used with the comparison operators to cause a false result when a NaNException + // has been thrown somewhere in the tested objects hierarchy + let maybeNaNExceptionComparer<'T> (comparer:Comparer<'T>) valueToCauseFalse = + { new Comparer<'T>() with + member __.Compare (x,y) = + try + comparer.Compare (x,y) + with + e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> valueToCauseFalse } + + let getGenericComparison<'T> usage externalUse = + let er = match usage with ComparisonUsage.ERUsage -> true | _ -> false - let getGenericComparison<'T> usage externalUse er = - match tryGetFSharpComparer usage externalUse er typeof<'T> with + match tryGetFSharpComparer usage externalUse typeof<'T> with | :? Comparer<'T> as comparer -> comparer | _ when canUseDefaultComparer er typeof<'T> -> Comparer<'T>.Default | _ -> if er then - if isArray typeof<'T> then arrayComparer fsComparerER + if isArray typeof<'T> then arrayComparer fsComparerER elif isValueTypeStructuralComparable typeof<'T> then structuralComparerValueType fsComparerER - elif isStructuralComparable typeof<'T> then structuralComparer fsComparerER - else unknownComparer fsComparerER + elif isStructuralComparable typeof<'T> then structuralComparer fsComparerER + else unknownComparer fsComparerER else let comparer = - if isArray typeof<'T> then arrayComparer fsComparerPER + if isArray typeof<'T> then arrayComparer fsComparerPER elif isValueTypeStructuralComparable typeof<'T> then structuralComparerValueType fsComparerPER - elif isStructuralComparable typeof<'T> then structuralComparer fsComparerPER - else unknownComparer fsComparerPER + elif isStructuralComparable typeof<'T> then structuralComparer fsComparerPER + else unknownComparer fsComparerPER match usage with - | ComparisonUsage.LessThanUsage -> - { new Comparer<'T>() with - member __.Compare (x,y) = - try - comparer.Compare (x,y) - with - e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> 1 } - | ComparisonUsage.GreaterThanUsage -> - { new Comparer<'T>() with - member __.Compare (x,y) = - try - comparer.Compare (x,y) - with - e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> -1 } + | ComparisonUsage.LessThanUsage -> maybeNaNExceptionComparer comparer LessThanUsageReturnFalse + | ComparisonUsage.GreaterThanUsage -> maybeNaNExceptionComparer comparer GreaterThanUsageReturnFalse | _ -> comparer [] type FSharpComparer_ER<'T> private () = - static let comparer = getGenericComparison<'T> ComparisonUsage.NormalUsage true true + static let comparer = getGenericComparison<'T> ComparisonUsage.ERUsage true static member Comparer = comparer [] type FSharpComparer_InternalUse_ER<'T> private () = - static let comparer = getGenericComparison<'T> ComparisonUsage.NormalUsage false true + static let comparer = getGenericComparison<'T> ComparisonUsage.ERUsage false static member Comparer = comparer [] type FSharpComparer_PER<'T> private () = - static let comparer = getGenericComparison<'T> ComparisonUsage.NormalUsage false false + static let comparer = getGenericComparison<'T> ComparisonUsage.PERUsage false static member Comparer = comparer [] type FSharpComparer_ForLessThanComparison<'T> private () = - static let comparer = getGenericComparison<'T> ComparisonUsage.LessThanUsage false false + static let comparer = getGenericComparison<'T> ComparisonUsage.LessThanUsage false static member Comparer = comparer [] type FSharpComparer_ForGreaterThanComparison<'T> private () = - static let comparer = getGenericComparison<'T> ComparisonUsage.GreaterThanUsage false false + static let comparer = getGenericComparison<'T> ComparisonUsage.GreaterThanUsage false static member Comparer = comparer /// Compare two values of the same generic type, using "comp". From 6fcde3130b659dfa3b6bb395d6092d08e06190dc Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 3 Jul 2018 17:53:57 +1000 Subject: [PATCH 36/64] Consolidated ArrayComparisons and addressed issue #5263 --- src/fsharp/FSharp.Core/prim-types.fs | 53 +++++++++++----------------- 1 file changed, 20 insertions(+), 33 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 77aeeb887c4..73396ce7081 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -917,6 +917,17 @@ namespace Microsoft.FSharp.Core /// This exception should never be observed by user code. let NaNException = new System.Exception() + let inline ArrayComparison<'T> (f:'T->'T->int) (x:'T[]) (y:'T[]) : int = + let lenx = x.Length + let leny = y.Length + let rec loop c i = + if c <> 0 then Math.Sign c + elif i = lenx then 0 + else loop (f (get x i) (get y i)) (i+1) + loop (lenx-leny) 0 + + let GenericComparisonByteArray (x:byte[]) (y:byte[]) : int = ArrayComparison (fun x y -> (# "conv.i4" x : int32 #)-(# "conv.i4" y : int32 #)) x y + /// Implements generic comparison between two objects. This corresponds to the pseudo-code in the F# /// specification. The treatment of NaNs is governed by "comp". let rec GenericCompare (comp:GenericComparer) (xobj:obj,yobj:obj) = @@ -930,10 +941,13 @@ namespace Microsoft.FSharp.Core // Permit structural comparison on arrays | (:? System.Array as arr1),_ -> match arr1,yobj with - // Fast path - | (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericComparisonObjArrayWithComparer comp arr1 arr2 - // Fast path - | (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericComparisonByteArray arr1 arr2 + | (:? (obj[]) as arr1), (:? (obj[]) as arr2)-> GenericComparisonObjArrayWithComparer comp arr1 arr2 + + // The additional equality check is required here because .net treats byte[] and sbyte[] as cast-compatible + // (but comparison is different) + | (:? (byte[]) as arr1), (:? (byte[]) as arr2) + when typeof.Equals (arr1.GetType ()) && typeof.Equals (arr2.GetType ()) -> GenericComparisonByteArray arr1 arr2 + | _ , (:? System.Array as arr2) -> GenericComparisonArbArrayWithComparer comp arr1 arr2 | _ -> FailGenericComparison xobj // Check for IStructuralComparable @@ -1108,35 +1122,8 @@ namespace Microsoft.FSharp.Core check 0 #endif - /// optimized case: Core implementation of structural comparison on object arrays. - and GenericComparisonObjArrayWithComparer (comp:GenericComparer) (x:obj[]) (y:obj[]) : int = - let lenx = x.Length - let leny = y.Length - let c = intOrder lenx leny - if c <> 0 then c - else - let mutable i = 0 - let mutable res = 0 - while i < lenx do - let c = GenericCompare comp ((get x i), (get y i)) - if c <> 0 then (res <- c; i <- lenx) - else i <- i + 1 - res - - /// optimized case: Core implementation of structural comparison on arrays. - and GenericComparisonByteArray (x:byte[]) (y:byte[]) : int = - let lenx = x.Length - let leny = y.Length - let c = intOrder lenx leny - if c <> 0 then c - else - let mutable i = 0 - let mutable res = 0 - while i < lenx do - let c = byteOrder (get x i) (get y i) - if c <> 0 then (res <- c; i <- lenx) - else i <- i + 1 - res + and GenericComparisonObjArrayWithComparer (comp:GenericComparer) (x:obj[]) (y:obj[]) : int = + ArrayComparison (fun x y -> GenericCompare comp (x, y)) x y type GenericComparer with interface System.Collections.IComparer with From b9433c25dc463a869cf1a49993eddd6b7b166a0a Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 18 Jul 2018 19:17:34 +1000 Subject: [PATCH 37/64] Fixed bug introduced in #5278 where an unstable sort could be used where a stable one was required --- src/fsharp/FSharp.Core/local.fs | 3 +-- src/fsharp/FSharp.Core/prim-types.fs | 19 +++++++++++++++++++ src/fsharp/FSharp.Core/prim-types.fsi | 3 +++ 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 971c25d87d9..56d6a20cbdd 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -1141,8 +1141,7 @@ module internal Array = let len = array.Length if len < 2 then () else - let cFast = LanguagePrimitives.FastGenericComparerInternal<'T> - if obj.ReferenceEquals (cFast, System.Collections.Generic.Comparer<'T>.Default) then + 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) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 73396ce7081..f7b7cef961f 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1330,6 +1330,21 @@ namespace Microsoft.FSharp.Core | ComparisonUsage.GreaterThanUsage -> maybeNaNExceptionComparer comparer GreaterThanUsageReturnFalse | _ -> comparer + /// As an optimization, determine if a fast unstable sort can be used with equivalent results + let equivalentForStableAndUnstableSort (ty:Type) = + ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + [] type FSharpComparer_ER<'T> private () = static let comparer = getGenericComparison<'T> ComparisonUsage.ERUsage true @@ -1337,8 +1352,10 @@ namespace Microsoft.FSharp.Core [] type FSharpComparer_InternalUse_ER<'T> private () = + static let equivalentForStableAndUnstableSort = equivalentForStableAndUnstableSort typeof<'T> static let comparer = getGenericComparison<'T> ComparisonUsage.ERUsage false static member Comparer = comparer + static member EquivalentForStableAndUnstableSort = equivalentForStableAndUnstableSort [] type FSharpComparer_PER<'T> private () = @@ -2410,6 +2427,8 @@ namespace Microsoft.FSharp.Core let FastGenericComparerInternal<'T> : Comparer<'T> = HashCompare.FSharpComparer_InternalUse_ER<'T>.Comparer + let EquivalentForStableAndUnstableSort<'T> : bool = + HashCompare.FSharpComparer_InternalUse_ER<'T>.EquivalentForStableAndUnstableSort //------------------------------------------------------------------------- // LanguagePrimitives: ENUMS diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 1cd2364a345..5b5d228d9e5 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -954,6 +954,9 @@ namespace Microsoft.FSharp.Core /// Make an F# comparer object for the given type, where it can be null if System.Collections.Generic.Comparer<'T>.Default 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 + /// Make an F# hash/equality object for the given type val inline FastGenericEqualityComparer<'T> : System.Collections.Generic.IEqualityComparer<'T> when 'T : equality From bae4ab84d60d4f556141a8abb8b81af851a1db11 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 19 Jul 2018 15:49:09 +1000 Subject: [PATCH 38/64] Removed now unnecessary optimization from stableSortWithKeysAndComparer --- src/fsharp/FSharp.Core/local.fs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 56d6a20cbdd..343b0409c26 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -990,7 +990,11 @@ module internal Array = open System - let inline fastComparerForArraySort<'t when 't : comparison> () = + 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 @@ -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() + let intCompare = getInternalComparer() 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 @@ -1156,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[] From 8c891a1a26168b1a857589febf6ca97e79038463 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sun, 8 Jul 2018 12:55:30 +1000 Subject: [PATCH 39/64] Moved isRecordType down to prim-types.fs (internal only) --- src/fsharp/FSharp.Core/prim-types.fs | 99 +++++++++++++++++++++++++++ src/fsharp/FSharp.Core/prim-types.fsi | 13 ++++ src/fsharp/FSharp.Core/reflect.fs | 93 +++++++------------------ 3 files changed, 136 insertions(+), 69 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index f7b7cef961f..1b512c5da43 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -770,6 +770,105 @@ namespace Microsoft.FSharp.Core let anyToStringShowingNull x = anyToString "null" x + module internal Reflection = + let tupleNames = [| + "System.Tuple`1"; "System.Tuple`2"; "System.Tuple`3"; + "System.Tuple`4"; "System.Tuple`5"; "System.Tuple`6"; + "System.Tuple`7"; "System.Tuple`8"; "System.Tuple" + "System.ValueTuple`1"; "System.ValueTuple`2"; "System.ValueTuple`3"; + "System.ValueTuple`4"; "System.ValueTuple`5"; "System.ValueTuple`6"; + "System.ValueTuple`7"; "System.ValueTuple`8"; "System.ValueTuple" |] + + let simpleTupleNames = [| + "Tuple`1"; "Tuple`2"; "Tuple`3"; + "Tuple`4"; "Tuple`5"; "Tuple`6"; + "Tuple`7"; "Tuple`8"; + "ValueTuple`1"; "ValueTuple`2"; "ValueTuple`3"; + "ValueTuple`4"; "ValueTuple`5"; "ValueTuple`6"; + "ValueTuple`7"; "ValueTuple`8"; |] + + let isTupleType (typ:Type) = + // We need to be careful that we only rely typ.IsGenericType, typ.Namespace and typ.Name here. + // + // Historically the FSharp.Core reflection utilities get used on implementations of + // System.Type that don't have functionality such as .IsEnum and .FullName fully implemented. + // This happens particularly over TypeBuilderInstantiation types in the ProvideTypes implementation of System.TYpe + // used in F# type providers. + typ.IsGenericType && + System.String.Equals(typ.Namespace, "System") && + Array.Exists (simpleTupleNames, Predicate typ.Name.StartsWith) + +#if !FX_NO_REFLECTION_ONLY + let cmaName = typeof.FullName + + let tryFindCompilationMappingAttributeFromData (attrs:System.Collections.Generic.IList, res:byref) : bool = + match attrs with + | null -> false + | _ -> + let mutable found = false + for a in attrs do + if a.Constructor.DeclaringType.FullName.Equals cmaName then + let args = a.ConstructorArguments + let flags = + match args.Count with + | 1 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), 0, 0) + | 2 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), 0) + | 3 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), (let x = args.[2] in x.Value :?> int)) + | _ -> (SourceConstructFlags.None, 0, 0) + res <- flags + found <- true + found +#endif + + let tryFindCompilationMappingAttribute (attrs:obj[], res:byref) : bool = + match attrs with + | null | [||] -> false + | [| :? CompilationMappingAttribute as a |] -> + res <- a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber + true + | _ -> raise (System.InvalidOperationException (SR.GetString(SR.multipleCompilationMappings))) + + let tryFindCompilationMappingAttributeFromType (typ:Type, res:byref) : bool = +#if !FX_NO_REFLECTION_ONLY + let assem = typ.Assembly + if (not (obj.ReferenceEquals(assem, null))) && assem.ReflectionOnly then + tryFindCompilationMappingAttributeFromData (typ.GetCustomAttributesData(), &res) + else +#endif + tryFindCompilationMappingAttribute (typ.GetCustomAttributes (typeof,false), &res) + + let tryFindSourceConstructFlagsOfType (typ:Type, res:byref) : bool = + let mutable x = unsafeDefault<_> + if tryFindCompilationMappingAttributeFromType (typ, &x) then + let flags,_n,_vn = x + res <- flags + true + else + false + + let inline flagsAnd<'a> (lhs:'a) (rhs:'a) = + (# "and" lhs rhs : 'a #) + + let inline flagsContains<'a when 'a : equality> (flags:'a) (mask:'a) (value:'a) = + (flagsAnd flags mask).Equals value + + let inline flagsIsSet<'a when 'a : equality> (flags:'a) (value:'a) = + flagsContains flags value value + + let isRecordType (typ:Type, bindingFlags:BindingFlags) = + let mutable flags = unsafeDefault<_> + match tryFindSourceConstructFlagsOfType (typ, &flags) with + | false -> false + | true -> + (flagsContains flags SourceConstructFlags.KindMask SourceConstructFlags.RecordType) && + // We see private representations only if BindingFlags.NonPublic is set + (if flagsIsSet flags SourceConstructFlags.NonPublicRepresentation then + flagsIsSet bindingFlags BindingFlags.NonPublic + else + true) + + + module HashCompare = //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: HASHING. diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 5b5d228d9e5..67d260082ce 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -1239,6 +1239,19 @@ namespace Microsoft.FSharp.Core //[] val inline SetArray4D : target:'T[,,,] -> index1:int -> index2:int -> index3:int -> index4:int -> value:'T -> unit + module internal Reflection = + val internal tupleNames : string [] + val internal isTupleType : Type -> bool + +#if !FX_NO_REFLECTION_ONLY + val internal tryFindCompilationMappingAttributeFromData : System.Collections.Generic.IList * byref -> bool +#endif + + val internal tryFindCompilationMappingAttribute : obj[] * byref -> bool + val internal tryFindCompilationMappingAttributeFromType : Type * byref -> bool + val internal tryFindSourceConstructFlagsOfType : Type * byref -> bool + val internal isRecordType : Type * System.Reflection.BindingFlags -> bool + /// The F# compiler emits calls to some of the functions in this module as part of the compiled form of some language constructs module HashCompare = [] diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 78528294f5c..ca385db43c7 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -83,11 +83,11 @@ module internal Impl = //----------------------------------------------------------------- // ATTRIBUTE DECOMPILATION - let tryFindCompilationMappingAttribute (attrs:obj[]) = - match attrs with - | null | [| |] -> None - | [| res |] -> let a = (res :?> CompilationMappingAttribute) in Some (a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber) - | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.multipleCompilationMappings)) + let tryFindCompilationMappingAttribute (attrs:obj[]) = + let mutable result = Unchecked.defaultof<_> + if LanguagePrimitives.Reflection.tryFindCompilationMappingAttribute (attrs, &result) + then Some result + else None let findCompilationMappingAttribute (attrs:obj[]) = match tryFindCompilationMappingAttribute attrs with @@ -95,26 +95,14 @@ module internal Impl = | Some a -> a #if !FX_NO_REFLECTION_ONLY - let cmaName = typeof.FullName let assemblyName = typeof.Assembly.GetName().Name let _ = assert (assemblyName = "FSharp.Core") let tryFindCompilationMappingAttributeFromData (attrs:System.Collections.Generic.IList) = - match attrs with - | null -> None - | _ -> - let mutable res = None - for a in attrs do - if a.Constructor.DeclaringType.FullName = cmaName then - let args = a.ConstructorArguments - let flags = - match args.Count with - | 1 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), 0, 0) - | 2 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), 0) - | 3 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), (let x = args.[2] in x.Value :?> int)) - | _ -> (enum 0, 0, 0) - res <- Some flags - res + let mutable result = Unchecked.defaultof<_> + if LanguagePrimitives.Reflection.tryFindCompilationMappingAttributeFromData (attrs, &result) + then Some result + else None let findCompilationMappingAttributeFromData attrs = match tryFindCompilationMappingAttributeFromData attrs with @@ -122,14 +110,11 @@ module internal Impl = | Some a -> a #endif - let tryFindCompilationMappingAttributeFromType (typ:Type) = -#if !FX_NO_REFLECTION_ONLY - let assem = typ.Assembly - if (not (isNull assem)) && assem.ReflectionOnly then - tryFindCompilationMappingAttributeFromData ( typ.GetCustomAttributesData()) - else -#endif - tryFindCompilationMappingAttribute ( typ.GetCustomAttributes (typeof,false)) + let tryFindCompilationMappingAttributeFromType (typ:Type) = + let mutable result = Unchecked.defaultof<_> + if LanguagePrimitives.Reflection.tryFindCompilationMappingAttributeFromType (typ, &result) + then Some result + else None let tryFindCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = #if !FX_NO_REFLECTION_ONLY @@ -159,10 +144,12 @@ module internal Impl = | None -> false | Some (flags,_n,_vn) -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Field - let tryFindSourceConstructFlagsOfType (typ:Type) = - match tryFindCompilationMappingAttributeFromType typ with - | None -> None - | Some (flags,_n,_vn) -> Some flags + let tryFindSourceConstructFlagsOfType (typ:Type) = + let mutable res = Unchecked.defaultof<_> + if LanguagePrimitives.Reflection.tryFindSourceConstructFlagsOfType (typ, &res) then + Some res + else + None //----------------------------------------------------------------- // UNION DECOMPILATION @@ -349,32 +336,9 @@ module internal Impl = //----------------------------------------------------------------- // TUPLE DECOMPILATION - let tupleNames = [| - "System.Tuple`1"; "System.Tuple`2"; "System.Tuple`3"; - "System.Tuple`4"; "System.Tuple`5"; "System.Tuple`6"; - "System.Tuple`7"; "System.Tuple`8"; "System.Tuple" - "System.ValueTuple`1"; "System.ValueTuple`2"; "System.ValueTuple`3"; - "System.ValueTuple`4"; "System.ValueTuple`5"; "System.ValueTuple`6"; - "System.ValueTuple`7"; "System.ValueTuple`8"; "System.ValueTuple" |] - - let simpleTupleNames = [| - "Tuple`1"; "Tuple`2"; "Tuple`3"; - "Tuple`4"; "Tuple`5"; "Tuple`6"; - "Tuple`7"; "Tuple`8"; - "ValueTuple`1"; "ValueTuple`2"; "ValueTuple`3"; - "ValueTuple`4"; "ValueTuple`5"; "ValueTuple`6"; - "ValueTuple`7"; "ValueTuple`8"; |] - - let isTupleType (typ:Type) = - // We need to be careful that we only rely typ.IsGenericType, typ.Namespace and typ.Name here. - // - // Historically the FSharp.Core reflection utilities get used on implementations of - // System.Type that don't have functionality such as .IsEnum and .FullName fully implemented. - // This happens particularly over TypeBuilderInstantiation types in the ProvideTypes implementation of System.TYpe - // used in F# type providers. - typ.IsGenericType && - typ.Namespace = "System" && - simpleTupleNames |> Seq.exists typ.Name.StartsWith + let tupleNames = LanguagePrimitives.Reflection.tupleNames + + let isTupleType (typ:Type) = LanguagePrimitives.Reflection.isTupleType typ let maxTuple = 8 // Which field holds the nested tuple? @@ -598,16 +562,7 @@ module internal Impl = //----------------------------------------------------------------- // RECORD DECOMPILATION - let isRecordType (typ:Type,bindingFlags:BindingFlags) = - match tryFindSourceConstructFlagsOfType(typ) with - | None -> false - | Some(flags) -> - (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.RecordType && - // We see private representations only if BindingFlags.NonPublic is set - (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum(0) then - (bindingFlags &&& BindingFlags.NonPublic) <> enum(0) - else - true) + let isRecordType (typ:Type,bindingFlags:BindingFlags) = LanguagePrimitives.Reflection.isRecordType (typ, bindingFlags) let fieldPropsOfRecordType(typ:Type,bindingFlags) = typ.GetProperties(instancePropertyFlags ||| bindingFlags) From 39b275e5225e24914f258b56a00761c93322b3ba Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sun, 8 Jul 2018 15:29:24 +1000 Subject: [PATCH 40/64] Moved enough of reflect.fs to get Record fields --- src/fsharp/FSharp.Core/prim-types.fs | 145 ++++++++++++++++++++++++-- src/fsharp/FSharp.Core/prim-types.fsi | 9 ++ src/fsharp/FSharp.Core/reflect.fs | 61 +++-------- 3 files changed, 159 insertions(+), 56 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 1b512c5da43..b5128924b8c 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -771,6 +771,72 @@ namespace Microsoft.FSharp.Core let anyToStringShowingNull x = anyToString "null" x module internal Reflection = + let inline flagsOr<'a> (lhs:'a) (rhs:'a) = + (# "or" lhs rhs : 'a #) + + let inline flagsAnd<'a> (lhs:'a) (rhs:'a) = + (# "and" lhs rhs : 'a #) + + let inline flagsContains<'a when 'a : equality> (flags:'a) (mask:'a) (value:'a) = + (flagsAnd flags mask).Equals value + + let inline flagsIsSet<'a when 'a : equality> (flags:'a) (value:'a) = + flagsContains flags value value + +#if FX_RESHAPED_REFLECTION + module internal ReflectionAdapters = + let toArray<'a> (s:System.Collections.Generic.IEnumerable<'a>) = + (System.Collections.Generic.List<'a> s).ToArray () + + open System + + let inline hasFlag (flag : BindingFlags) f = flagsIsSet f flag + let isDeclaredFlag f = hasFlag BindingFlags.DeclaredOnly f + let isPublicFlag f = hasFlag BindingFlags.Public f + let isStaticFlag f = hasFlag BindingFlags.Static f + let isInstanceFlag f = hasFlag BindingFlags.Instance f + let isNonPublicFlag f = hasFlag BindingFlags.NonPublic f + + let isAcceptable bindingFlags isStatic isPublic = + // 1. check if member kind (static\instance) was specified in flags + ((isStaticFlag bindingFlags && isStatic) || (isInstanceFlag bindingFlags && not isStatic)) && + // 2. check if member accessibility was specified in flags + ((isPublicFlag bindingFlags && isPublic) || (isNonPublicFlag bindingFlags && not isPublic)) + + type System.Type with + // use different sources based on Declared flag + member this.GetProperties (bindingFlags) = + let properties = + if isDeclaredFlag bindingFlags then + this.GetTypeInfo().DeclaredProperties + else + this.GetRuntimeProperties () + + Array.FindAll (toArray properties, Predicate (fun pi -> + let mi = + match pi.GetMethod with + | null -> pi.SetMethod + | _ -> pi.GetMethod + if obj.ReferenceEquals (mi, null) then + false + else + isAcceptable bindingFlags mi.IsStatic mi.IsPublic)) + + type System.Reflection.MemberInfo with + member this.GetCustomAttributes(attrTy, inherits) : obj[] = + downcast box(toArray (CustomAttributeExtensions.GetCustomAttributes(this, attrTy, inherits))) + + open ReflectionAdapters + open PrimReflectionAdapters +#endif + + +#if FX_RESHAPED_REFLECTION + let instancePropertyFlags = BindingFlags.Instance +#else + let instancePropertyFlags = flagsOr BindingFlags.GetProperty BindingFlags.Instance +#endif + let tupleNames = [| "System.Tuple`1"; "System.Tuple`2"; "System.Tuple`3"; "System.Tuple`4"; "System.Tuple`5"; "System.Tuple`6"; @@ -799,6 +865,8 @@ namespace Microsoft.FSharp.Core Array.Exists (simpleTupleNames, Predicate typ.Name.StartsWith) #if !FX_NO_REFLECTION_ONLY + let assemblyName = typeof.Assembly.GetName().Name + let _ = assert (System.String.Equals (assemblyName, "FSharp.Core")) let cmaName = typeof.FullName let tryFindCompilationMappingAttributeFromData (attrs:System.Collections.Generic.IList, res:byref) : bool = @@ -818,6 +886,12 @@ namespace Microsoft.FSharp.Core res <- flags found <- true found + + let findCompilationMappingAttributeFromData attrs = + let mutable x = unsafeDefault<_> + match tryFindCompilationMappingAttributeFromData (attrs, &x) with + | false -> raise (Exception "no compilation mapping attribute") + | true -> x #endif let tryFindCompilationMappingAttribute (attrs:obj[], res:byref) : bool = @@ -828,6 +902,12 @@ namespace Microsoft.FSharp.Core true | _ -> raise (System.InvalidOperationException (SR.GetString(SR.multipleCompilationMappings))) + let findCompilationMappingAttribute (attrs:obj[]) = + let mutable x = unsafeDefault<_> + match tryFindCompilationMappingAttribute (attrs, &x) with + | false -> raise (Exception "no compilation mapping attribute") + | true -> x + let tryFindCompilationMappingAttributeFromType (typ:Type, res:byref) : bool = #if !FX_NO_REFLECTION_ONLY let assem = typ.Assembly @@ -837,6 +917,24 @@ namespace Microsoft.FSharp.Core #endif tryFindCompilationMappingAttribute (typ.GetCustomAttributes (typeof,false), &res) + let tryFindCompilationMappingAttributeFromMemberInfo (info:MemberInfo, res:byref) : bool = +#if !FX_NO_REFLECTION_ONLY + let assem = info.DeclaringType.Assembly + if (not (obj.ReferenceEquals (assem, null))) && assem.ReflectionOnly then + tryFindCompilationMappingAttributeFromData (info.GetCustomAttributesData(), &res) + else +#endif + tryFindCompilationMappingAttribute (info.GetCustomAttributes (typeof,false), &res) + + let findCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = +#if !FX_NO_REFLECTION_ONLY + let assem = info.DeclaringType.Assembly + if (not (obj.ReferenceEquals (assem, null))) && assem.ReflectionOnly then + findCompilationMappingAttributeFromData (info.GetCustomAttributesData()) + else +#endif + findCompilationMappingAttribute (info.GetCustomAttributes (typeof,false)) + let tryFindSourceConstructFlagsOfType (typ:Type, res:byref) : bool = let mutable x = unsafeDefault<_> if tryFindCompilationMappingAttributeFromType (typ, &x) then @@ -846,15 +944,6 @@ namespace Microsoft.FSharp.Core else false - let inline flagsAnd<'a> (lhs:'a) (rhs:'a) = - (# "and" lhs rhs : 'a #) - - let inline flagsContains<'a when 'a : equality> (flags:'a) (mask:'a) (value:'a) = - (flagsAnd flags mask).Equals value - - let inline flagsIsSet<'a when 'a : equality> (flags:'a) (value:'a) = - flagsContains flags value value - let isRecordType (typ:Type, bindingFlags:BindingFlags) = let mutable flags = unsafeDefault<_> match tryFindSourceConstructFlagsOfType (typ, &flags) with @@ -867,7 +956,43 @@ namespace Microsoft.FSharp.Core else true) - + let isFieldProperty (prop : PropertyInfo) = + let mutable res = unsafeDefault<_> + match tryFindCompilationMappingAttributeFromMemberInfo(prop:>MemberInfo, &res) with + | false -> false + | true -> + let (flags,_n,_vn) = res + flagsContains flags SourceConstructFlags.KindMask SourceConstructFlags.Field + + let sequenceNumberOfMember (x:MemberInfo) = let (_,n,_) = findCompilationMappingAttributeFromMemberInfo x in n + let variantNumberOfMember (x:MemberInfo) = let (_,_,vn) = findCompilationMappingAttributeFromMemberInfo x in vn + + // Although this funciton is called sortFreshArray (and was so in it's previously life in reflect.fs) + // it does not create a fresh array, but rather uses the existing array. + let sortFreshArray (f:'a->int) (arr:'a[]) = + let comparer = System.Collections.Generic.Comparer.Default + System.Array.Sort (arr, { + new IComparer<'a> with + member __.Compare (lhs:'a, rhs:'a) = + comparer.Compare (f lhs, f rhs) }) + arr + + let fieldPropsOfRecordType (typ:Type, bindingFlags) = + let properties = typ.GetProperties (flagsOr instancePropertyFlags bindingFlags) + let fields = System.Array.FindAll (properties, Predicate isFieldProperty) + sortFreshArray sequenceNumberOfMember fields + + let isUnionType (typ:Type,bindingFlags:BindingFlags) = + let mutable flags = unsafeDefault<_> + match tryFindSourceConstructFlagsOfType(typ, &flags) with + | false -> false + | true -> + (flagsContains flags SourceConstructFlags.KindMask SourceConstructFlags.SumType) && + // We see private representations only if BindingFlags.NonPublic is set + (if flagsIsSet flags SourceConstructFlags.NonPublicRepresentation then + flagsIsSet bindingFlags BindingFlags.NonPublic + else + true) module HashCompare = //------------------------------------------------------------------------- diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 67d260082ce..901914636a4 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -1245,12 +1245,21 @@ namespace Microsoft.FSharp.Core #if !FX_NO_REFLECTION_ONLY val internal tryFindCompilationMappingAttributeFromData : System.Collections.Generic.IList * byref -> bool + val internal findCompilationMappingAttributeFromData : System.Collections.Generic.IList -> SourceConstructFlags*int*int #endif val internal tryFindCompilationMappingAttribute : obj[] * byref -> bool + val internal findCompilationMappingAttribute : obj[] -> SourceConstructFlags*int*int val internal tryFindCompilationMappingAttributeFromType : Type * byref -> bool + val internal tryFindCompilationMappingAttributeFromMemberInfo : System.Reflection.MemberInfo * byref -> bool + val internal findCompilationMappingAttributeFromMemberInfo : System.Reflection.MemberInfo -> SourceConstructFlags*int*int val internal tryFindSourceConstructFlagsOfType : Type * byref -> bool + val internal sequenceNumberOfMember : System.Reflection.MemberInfo -> int + val internal variantNumberOfMember : System.Reflection.MemberInfo -> int + val internal isFieldProperty : System.Reflection.PropertyInfo -> bool + val internal fieldPropsOfRecordType : Type * System.Reflection.BindingFlags -> System.Reflection.PropertyInfo[] val internal isRecordType : Type * System.Reflection.BindingFlags -> bool + val internal isUnionType : Type * System.Reflection.BindingFlags -> bool /// The F# compiler emits calls to some of the functions in this module as part of the compiled form of some language constructs module HashCompare = diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index ca385db43c7..027713b34ee 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -89,25 +89,16 @@ module internal Impl = then Some result else None - let findCompilationMappingAttribute (attrs:obj[]) = - match tryFindCompilationMappingAttribute attrs with - | None -> failwith "no compilation mapping attribute" - | Some a -> a + let findCompilationMappingAttribute (attrs:obj[]) = LanguagePrimitives.Reflection.findCompilationMappingAttribute attrs #if !FX_NO_REFLECTION_ONLY - let assemblyName = typeof.Assembly.GetName().Name - let _ = assert (assemblyName = "FSharp.Core") - let tryFindCompilationMappingAttributeFromData (attrs:System.Collections.Generic.IList) = let mutable result = Unchecked.defaultof<_> if LanguagePrimitives.Reflection.tryFindCompilationMappingAttributeFromData (attrs, &result) then Some result else None - let findCompilationMappingAttributeFromData attrs = - match tryFindCompilationMappingAttributeFromData attrs with - | None -> failwith "no compilation mapping attribute" - | Some a -> a + let findCompilationMappingAttributeFromData attrs = LanguagePrimitives.Reflection.findCompilationMappingAttributeFromData attrs #endif let tryFindCompilationMappingAttributeFromType (typ:Type) = @@ -117,32 +108,19 @@ module internal Impl = else None let tryFindCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = -#if !FX_NO_REFLECTION_ONLY - let assem = info.DeclaringType.Assembly - if (not (isNull assem)) && assem.ReflectionOnly then - tryFindCompilationMappingAttributeFromData (info.GetCustomAttributesData()) - else -#endif - tryFindCompilationMappingAttribute (info.GetCustomAttributes (typeof,false)) + let mutable result = Unchecked.defaultof<_> + if LanguagePrimitives.Reflection.tryFindCompilationMappingAttributeFromMemberInfo (info, &result) + then Some result + else None - let findCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = -#if !FX_NO_REFLECTION_ONLY - let assem = info.DeclaringType.Assembly - if (not (isNull assem)) && assem.ReflectionOnly then - findCompilationMappingAttributeFromData (info.GetCustomAttributesData()) - else -#endif - findCompilationMappingAttribute (info.GetCustomAttributes (typeof,false)) + let findCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = LanguagePrimitives.Reflection.findCompilationMappingAttributeFromMemberInfo info - let sequenceNumberOfMember (x: MemberInfo) = let (_,n,_) = findCompilationMappingAttributeFromMemberInfo x in n - let variantNumberOfMember (x: MemberInfo) = let (_,_,vn) = findCompilationMappingAttributeFromMemberInfo x in vn + let sequenceNumberOfMember (x:MemberInfo) = LanguagePrimitives.Reflection.sequenceNumberOfMember x + let variantNumberOfMember (x:MemberInfo) = LanguagePrimitives.Reflection.variantNumberOfMember x let sortFreshArray f arr = Array.sortInPlaceWith f arr; arr - let isFieldProperty (prop : PropertyInfo) = - match tryFindCompilationMappingAttributeFromMemberInfo(prop) with - | None -> false - | Some (flags,_n,_vn) -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Field + let isFieldProperty (prop : PropertyInfo) = LanguagePrimitives.Reflection.isFieldProperty prop let tryFindSourceConstructFlagsOfType (typ:Type) = let mutable res = Unchecked.defaultof<_> @@ -226,17 +204,11 @@ module internal Impl = (fun tag -> tagfieldmap.[tag]) let isUnionType (typ:Type,bindingFlags:BindingFlags) = + // isOptionType & isListType are not necessary. There were here before the code was refactored into prim-types + // presumably as an optimization, so have not been removed (no performance testing run at this time) isOptionType typ || - isListType typ || - match tryFindSourceConstructFlagsOfType(typ) with - | None -> false - | Some(flags) -> - (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.SumType && - // We see private representations only if BindingFlags.NonPublic is set - (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum(0) then - (bindingFlags &&& BindingFlags.NonPublic) <> enum(0) - else - true) + isListType typ || + LanguagePrimitives.Reflection.isUnionType (typ, bindingFlags) // Check the base type - if it is also an F# type then // for the moment we know it is a Discriminated Union @@ -564,10 +536,7 @@ module internal Impl = let isRecordType (typ:Type,bindingFlags:BindingFlags) = LanguagePrimitives.Reflection.isRecordType (typ, bindingFlags) - let fieldPropsOfRecordType(typ:Type,bindingFlags) = - typ.GetProperties(instancePropertyFlags ||| bindingFlags) - |> Array.filter isFieldProperty - |> sortFreshArray (fun p1 p2 -> compare (sequenceNumberOfMember p1) (sequenceNumberOfMember p2)) + let fieldPropsOfRecordType (typ:Type, bindingFlags) = LanguagePrimitives.Reflection.fieldPropsOfRecordType (typ, bindingFlags) let getRecordReader(typ:Type,bindingFlags) = let props = fieldPropsOfRecordType(typ,bindingFlags) From 395edf648d292c520af92e027bad40c1608bb468 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 9 Jul 2018 10:35:50 +1000 Subject: [PATCH 41/64] Moved reflection functions for Union types into prim-types.fs --- src/fsharp/FSharp.Core/prim-types.fs | 136 +++++++++++++++++++++++++- src/fsharp/FSharp.Core/prim-types.fsi | 3 + src/fsharp/FSharp.Core/reflect.fs | 75 +------------- 3 files changed, 142 insertions(+), 72 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index b5128924b8c..30fedc7b044 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -804,6 +804,49 @@ namespace Microsoft.FSharp.Core ((isPublicFlag bindingFlags && isPublic) || (isNonPublicFlag bindingFlags && not isPublic)) type System.Type with + member this.GetNestedType (name, bindingFlags) = + // MSDN: http://msdn.microsoft.com/en-us/library/0dcb3ad5.aspx + // The following BindingFlags filter flags can be used to define which nested types to include in the search: + // You must specify either BindingFlags.Public or BindingFlags.NonPublic to get a return. + // Specify BindingFlags.Public to include public nested types in the search. + // Specify BindingFlags.NonPublic to include non-public nested types (that is, private, internal, and protected nested types) in the search. + // This method returns only the nested types of the current type. It does not search the base classes of the current type. + // To find types that are nested in base classes, you must walk the inheritance hierarchy, calling GetNestedType at each level. + let e = this.GetTypeInfo().DeclaredNestedTypes.GetEnumerator () + let rec f () = + if not (e.MoveNext ()) then null + else + let nestedTy = e.Current + if (String.Equals (nestedTy.Name, name)) && + ((isPublicFlag bindingFlags && nestedTy.IsNestedPublic) || + (isNonPublicFlag bindingFlags && (nestedTy.IsNestedPrivate || nestedTy.IsNestedFamily || nestedTy.IsNestedAssembly || nestedTy.IsNestedFamORAssem || nestedTy.IsNestedFamANDAssem))) then + nestedTy.AsType () + else + f () + f () + + // use different sources based on Declared flag + member this.GetMethods (bindingFlags) = + let methods = + if isDeclaredFlag bindingFlags then + this.GetTypeInfo().DeclaredMethods + else + this.GetRuntimeMethods() + + Array.FindAll (toArray methods, Predicate (fun m -> + isAcceptable bindingFlags m.IsStatic m.IsPublic)) + + // use different sources based on Declared flag + member this.GetFields (bindingFlags) = + let fields = + if isDeclaredFlag bindingFlags then + this.GetTypeInfo().DeclaredFields + else + this.GetRuntimeFields() + + Array.FindAll (toArray fields, Predicate (fun f -> + isAcceptable bindingFlags f.IsStatic f.IsPublic)) + // use different sources based on Declared flag member this.GetProperties (bindingFlags) = let properties = @@ -821,20 +864,37 @@ namespace Microsoft.FSharp.Core false else isAcceptable bindingFlags mi.IsStatic mi.IsPublic)) + + member this.IsGenericTypeDefinition = this.GetTypeInfo().IsGenericTypeDefinition type System.Reflection.MemberInfo with member this.GetCustomAttributes(attrTy, inherits) : obj[] = downcast box(toArray (CustomAttributeExtensions.GetCustomAttributes(this, attrTy, inherits))) - open ReflectionAdapters + module internal SystemAdapters = + type Converter<'TInput, 'TOutput> = delegate of 'TInput -> 'TOutput + + type System.Array with + static member ConvertAll<'TInput, 'TOutput>(input:'TInput[], conv:Converter<'TInput, 'TOutput>) = + let output = (# "newarr !0" type ('TOutput) input.Length : 'TOutput array #) + for i = 0 to input.Length-1 do + set output i (conv.Invoke (get input i)) + output + open PrimReflectionAdapters + open ReflectionAdapters + open SystemAdapters #endif #if FX_RESHAPED_REFLECTION let instancePropertyFlags = BindingFlags.Instance + let staticFieldFlags = BindingFlags.Static + let staticMethodFlags = BindingFlags.Static #else let instancePropertyFlags = flagsOr BindingFlags.GetProperty BindingFlags.Instance + let staticFieldFlags = flagsOr BindingFlags.GetField BindingFlags.Static + let staticMethodFlags = BindingFlags.Static #endif let tupleNames = [| @@ -982,6 +1042,80 @@ namespace Microsoft.FSharp.Core let fields = System.Array.FindAll (properties, Predicate isFieldProperty) sortFreshArray sequenceNumberOfMember fields + let getUnionTypeTagNameMap (typ:Type,bindingFlags:BindingFlags) : (int*string)[] = + let enumTyp = typ.GetNestedType ("Tags", bindingFlags) + // Unions with a singleton case do not get a Tags type (since there is only one tag), hence enumTyp may be null in this case + match enumTyp with + | null -> + let methods = typ.GetMethods (flagsOr staticMethodFlags bindingFlags) + let maybeTagNames = + Array.ConvertAll (methods, Converter (fun minfo -> + let mutable res = unsafeDefault<_> + match tryFindCompilationMappingAttributeFromMemberInfo (minfo:>MemberInfo, &res) with + | false -> unsafeDefault<_> + | true -> + let flags,n,_vn = res + if flagsContains flags SourceConstructFlags.KindMask SourceConstructFlags.UnionCase then + // chop "get_" or "New" off the front + let nm = + let nm = minfo.Name + if nm.StartsWith "get_" then nm.Substring 4 + elif nm.StartsWith "New" then nm.Substring 3 + else nm + (n, nm) + else + unsafeDefault<_> )) + Array.FindAll (maybeTagNames, Predicate (fun maybeTagName -> not (obj.ReferenceEquals (maybeTagName, null)))) + | _ -> + let fields = enumTyp.GetFields (flagsOr staticFieldFlags bindingFlags) + let filtered = Array.FindAll (fields, (fun (f:FieldInfo) -> f.IsStatic && f.IsLiteral)) + let sorted = sortFreshArray (fun (f:FieldInfo) -> (f.GetValue null) :?> int) filtered + Array.ConvertAll (sorted, Converter (fun tagfield -> (tagfield.GetValue(null) :?> int),tagfield.Name)) + + let getUnionCasesTyp (typ: Type, _bindingFlags) = +#if CASES_IN_NESTED_CLASS + let casesTyp = typ.GetNestedType("Cases", bindingFlags) + if casesTyp.IsGenericTypeDefinition then casesTyp.MakeGenericType(typ.GetGenericArguments()) + else casesTyp +#else + typ +#endif + + let getUnionCaseTyp (typ: Type, tag: int, bindingFlags) = + let tagFields = getUnionTypeTagNameMap(typ,bindingFlags) + let tagField = let _,f = Array.Find (tagFields, Predicate (fun (i,_) -> i = tag)) in f + + if tagFields.Length = 1 then + typ + else + // special case: two-cased DU annotated with CompilationRepresentation(UseNullAsTrueValue) + // in this case it will be compiled as one class: return self type for non-nullary case and null for nullary + let isTwoCasedDU = + if tagFields.Length = 2 then + match typ.GetCustomAttributes(typeof, false) with + | [|:? CompilationRepresentationAttribute as attr|] -> + flagsIsSet attr.Flags CompilationRepresentationFlags.UseNullAsTrueValue + | _ -> false + else + false + if isTwoCasedDU then + typ + else + let casesTyp = getUnionCasesTyp (typ, bindingFlags) + let caseTyp = casesTyp.GetNestedType(tagField, bindingFlags) // if this is null then the union is nullary + match caseTyp with + | null -> null + | _ when caseTyp.IsGenericTypeDefinition -> caseTyp.MakeGenericType(casesTyp.GetGenericArguments()) + | _ -> caseTyp + + let fieldsPropsOfUnionCase(typ:Type, tag:int, bindingFlags) = + // Lookup the type holding the fields for the union case + let caseTyp = getUnionCaseTyp (typ, tag, bindingFlags) + let caseTyp = match caseTyp with null -> typ | _ -> caseTyp + let properties = caseTyp.GetProperties (flagsOr instancePropertyFlags bindingFlags) + let filtered = Array.FindAll (properties, Predicate (fun p -> if isFieldProperty p then (variantNumberOfMember (p:>MemberInfo)) = tag else false)) + sortFreshArray (fun (p:PropertyInfo) -> sequenceNumberOfMember p) filtered + let isUnionType (typ:Type,bindingFlags:BindingFlags) = let mutable flags = unsafeDefault<_> match tryFindSourceConstructFlagsOfType(typ, &flags) with diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 901914636a4..994495accbb 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -1259,6 +1259,9 @@ namespace Microsoft.FSharp.Core val internal isFieldProperty : System.Reflection.PropertyInfo -> bool val internal fieldPropsOfRecordType : Type * System.Reflection.BindingFlags -> System.Reflection.PropertyInfo[] val internal isRecordType : Type * System.Reflection.BindingFlags -> bool + val internal getUnionTypeTagNameMap : Type * System.Reflection.BindingFlags -> (int*string)[] + val internal getUnionCaseTyp : Type * int * System.Reflection.BindingFlags -> Type + val internal fieldsPropsOfUnionCase : Type * int* System.Reflection.BindingFlags -> System.Reflection.PropertyInfo[] val internal isUnionType : Type * System.Reflection.BindingFlags -> bool /// The F# compiler emits calls to some of the functions in this module as part of the compiled form of some language constructs diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 027713b34ee..498cc0e01ad 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -132,69 +132,9 @@ module internal Impl = //----------------------------------------------------------------- // UNION DECOMPILATION - // Get the type where the type definitions are stored - let getUnionCasesTyp (typ: Type, _bindingFlags) = -#if CASES_IN_NESTED_CLASS - let casesTyp = typ.GetNestedType("Cases", bindingFlags) - if casesTyp.IsGenericTypeDefinition then casesTyp.MakeGenericType(typ.GetGenericArguments()) - else casesTyp -#else - typ -#endif - - let getUnionTypeTagNameMap (typ:Type,bindingFlags) = - let enumTyp = typ.GetNestedType("Tags", bindingFlags) - // Unions with a singleton case do not get a Tags type (since there is only one tag), hence enumTyp may be null in this case - match enumTyp with - | null -> - typ.GetMethods(staticMethodFlags ||| bindingFlags) - |> Array.choose (fun minfo -> - match tryFindCompilationMappingAttributeFromMemberInfo(minfo) with - | None -> None - | Some (flags,n,_vn) -> - if (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.UnionCase then - let nm = minfo.Name - // chop "get_" or "New" off the front - let nm = - if not (isListType typ) && not (isOptionType typ) then - if nm.Length > 4 && nm.[0..3] = "get_" then nm.[4..] - elif nm.Length > 3 && nm.[0..2] = "New" then nm.[3..] - else nm - else nm - Some (n, nm) - else - None) - | _ -> - enumTyp.GetFields(staticFieldFlags ||| bindingFlags) - |> Array.filter (fun (f:FieldInfo) -> f.IsStatic && f.IsLiteral) - |> sortFreshArray (fun f1 f2 -> compare (f1.GetValue(null) :?> int) (f2.GetValue(null) :?> int)) - |> Array.map (fun tagfield -> (tagfield.GetValue(null) :?> int),tagfield.Name) - - let getUnionCaseTyp (typ: Type, tag: int, bindingFlags) = - let tagFields = getUnionTypeTagNameMap(typ,bindingFlags) - let tagField = tagFields |> Array.pick (fun (i,f) -> if i = tag then Some f else None) - if tagFields.Length = 1 then - typ - else - // special case: two-cased DU annotated with CompilationRepresentation(UseNullAsTrueValue) - // in this case it will be compiled as one class: return self type for non-nullary case and null for nullary - let isTwoCasedDU = - if tagFields.Length = 2 then - match typ.GetCustomAttributes(typeof, false) with - | [|:? CompilationRepresentationAttribute as attr|] -> - (attr.Flags &&& CompilationRepresentationFlags.UseNullAsTrueValue) = CompilationRepresentationFlags.UseNullAsTrueValue - | _ -> false - else - false - if isTwoCasedDU then - typ - else - let casesTyp = getUnionCasesTyp (typ, bindingFlags) - let caseTyp = casesTyp.GetNestedType(tagField, bindingFlags) // if this is null then the union is nullary - match caseTyp with - | null -> null - | _ when caseTyp.IsGenericTypeDefinition -> caseTyp.MakeGenericType(casesTyp.GetGenericArguments()) - | _ -> caseTyp + let getUnionTypeTagNameMap (typ:Type,bindingFlags) = LanguagePrimitives.Reflection.getUnionTypeTagNameMap (typ, bindingFlags) + + let getUnionCaseTyp (typ: Type, tag: int, bindingFlags) = LanguagePrimitives.Reflection.getUnionCaseTyp (typ, tag, bindingFlags) let getUnionTagConverter (typ:Type,bindingFlags) = if isOptionType typ then (fun tag -> match tag with 0 -> "None" | 1 -> "Some" | _ -> invalidArg "tag" (SR.GetString(SR.outOfRange))) @@ -232,14 +172,7 @@ module internal Impl = | 1 (* Cons *) -> getInstancePropertyInfos (typ,[| "Head"; "Tail" |],bindingFlags) | _ -> failwith "fieldsPropsOfUnionCase" else - // Lookup the type holding the fields for the union case - let caseTyp = getUnionCaseTyp (typ, tag, bindingFlags) - let caseTyp = match caseTyp with null -> typ | _ -> caseTyp - caseTyp.GetProperties(instancePropertyFlags ||| bindingFlags) - |> Array.filter isFieldProperty - |> Array.filter (fun prop -> variantNumberOfMember prop = tag) - |> sortFreshArray (fun p1 p2 -> compare (sequenceNumberOfMember p1) (sequenceNumberOfMember p2)) - + LanguagePrimitives.Reflection.fieldsPropsOfUnionCase (typ, tag, bindingFlags) let getUnionCaseRecordReader (typ:Type,tag:int,bindingFlags) = let props = fieldsPropsOfUnionCase(typ,tag,bindingFlags) From d3a6f231ddd5d0d363ca57221c1fb5dcfe1797ac Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 9 Jul 2018 10:43:22 +1000 Subject: [PATCH 42/64] Removed methods from prim-types.fsi that are now just used internally --- src/fsharp/FSharp.Core/prim-types.fsi | 15 ---------- src/fsharp/FSharp.Core/reflect.fs | 41 --------------------------- 2 files changed, 56 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 994495accbb..c233f80d23f 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -1242,25 +1242,10 @@ namespace Microsoft.FSharp.Core module internal Reflection = val internal tupleNames : string [] val internal isTupleType : Type -> bool - -#if !FX_NO_REFLECTION_ONLY - val internal tryFindCompilationMappingAttributeFromData : System.Collections.Generic.IList * byref -> bool - val internal findCompilationMappingAttributeFromData : System.Collections.Generic.IList -> SourceConstructFlags*int*int -#endif - - val internal tryFindCompilationMappingAttribute : obj[] * byref -> bool - val internal findCompilationMappingAttribute : obj[] -> SourceConstructFlags*int*int - val internal tryFindCompilationMappingAttributeFromType : Type * byref -> bool - val internal tryFindCompilationMappingAttributeFromMemberInfo : System.Reflection.MemberInfo * byref -> bool - val internal findCompilationMappingAttributeFromMemberInfo : System.Reflection.MemberInfo -> SourceConstructFlags*int*int val internal tryFindSourceConstructFlagsOfType : Type * byref -> bool - val internal sequenceNumberOfMember : System.Reflection.MemberInfo -> int - val internal variantNumberOfMember : System.Reflection.MemberInfo -> int - val internal isFieldProperty : System.Reflection.PropertyInfo -> bool val internal fieldPropsOfRecordType : Type * System.Reflection.BindingFlags -> System.Reflection.PropertyInfo[] val internal isRecordType : Type * System.Reflection.BindingFlags -> bool val internal getUnionTypeTagNameMap : Type * System.Reflection.BindingFlags -> (int*string)[] - val internal getUnionCaseTyp : Type * int * System.Reflection.BindingFlags -> Type val internal fieldsPropsOfUnionCase : Type * int* System.Reflection.BindingFlags -> System.Reflection.PropertyInfo[] val internal isUnionType : Type * System.Reflection.BindingFlags -> bool diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 498cc0e01ad..ef019303f61 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -83,45 +83,6 @@ module internal Impl = //----------------------------------------------------------------- // ATTRIBUTE DECOMPILATION - let tryFindCompilationMappingAttribute (attrs:obj[]) = - let mutable result = Unchecked.defaultof<_> - if LanguagePrimitives.Reflection.tryFindCompilationMappingAttribute (attrs, &result) - then Some result - else None - - let findCompilationMappingAttribute (attrs:obj[]) = LanguagePrimitives.Reflection.findCompilationMappingAttribute attrs - -#if !FX_NO_REFLECTION_ONLY - let tryFindCompilationMappingAttributeFromData (attrs:System.Collections.Generic.IList) = - let mutable result = Unchecked.defaultof<_> - if LanguagePrimitives.Reflection.tryFindCompilationMappingAttributeFromData (attrs, &result) - then Some result - else None - - let findCompilationMappingAttributeFromData attrs = LanguagePrimitives.Reflection.findCompilationMappingAttributeFromData attrs -#endif - - let tryFindCompilationMappingAttributeFromType (typ:Type) = - let mutable result = Unchecked.defaultof<_> - if LanguagePrimitives.Reflection.tryFindCompilationMappingAttributeFromType (typ, &result) - then Some result - else None - - let tryFindCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = - let mutable result = Unchecked.defaultof<_> - if LanguagePrimitives.Reflection.tryFindCompilationMappingAttributeFromMemberInfo (info, &result) - then Some result - else None - - let findCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = LanguagePrimitives.Reflection.findCompilationMappingAttributeFromMemberInfo info - - let sequenceNumberOfMember (x:MemberInfo) = LanguagePrimitives.Reflection.sequenceNumberOfMember x - let variantNumberOfMember (x:MemberInfo) = LanguagePrimitives.Reflection.variantNumberOfMember x - - let sortFreshArray f arr = Array.sortInPlaceWith f arr; arr - - let isFieldProperty (prop : PropertyInfo) = LanguagePrimitives.Reflection.isFieldProperty prop - let tryFindSourceConstructFlagsOfType (typ:Type) = let mutable res = Unchecked.defaultof<_> if LanguagePrimitives.Reflection.tryFindSourceConstructFlagsOfType (typ, &res) then @@ -134,8 +95,6 @@ module internal Impl = let getUnionTypeTagNameMap (typ:Type,bindingFlags) = LanguagePrimitives.Reflection.getUnionTypeTagNameMap (typ, bindingFlags) - let getUnionCaseTyp (typ: Type, tag: int, bindingFlags) = LanguagePrimitives.Reflection.getUnionCaseTyp (typ, tag, bindingFlags) - let getUnionTagConverter (typ:Type,bindingFlags) = if isOptionType typ then (fun tag -> match tag with 0 -> "None" | 1 -> "Some" | _ -> invalidArg "tag" (SR.GetString(SR.outOfRange))) elif isListType typ then (fun tag -> match tag with 0 -> "Empty" | 1 -> "Cons" | _ -> invalidArg "tag" (SR.GetString(SR.outOfRange))) From 80d65476603ccaff695089b4788b232f1c42b5c7 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 9 Jul 2018 14:49:54 +1000 Subject: [PATCH 43/64] Used the reflection functions to handle records and unions --- src/fsharp/FSharp.Core/prim-types.fs | 179 +++++++++++++-------------- 1 file changed, 85 insertions(+), 94 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 30fedc7b044..534ca97e9cb 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -953,6 +953,13 @@ namespace Microsoft.FSharp.Core | false -> raise (Exception "no compilation mapping attribute") | true -> x #endif + let hasCustomEquality (typ:Type) = + let arr = typ.GetCustomAttributes (typeof, false) + arr.Length > 0 + + let hasCustomComparison (typ:Type) = + let arr = typ.GetCustomAttributes (typeof, false) + arr.Length > 0 let tryFindCompilationMappingAttribute (attrs:obj[], res:byref) : bool = match attrs with @@ -1128,7 +1135,79 @@ namespace Microsoft.FSharp.Core else true) - module HashCompare = + module HashCompare = +#if FX_RESHAPED_REFLECTION + open Reflection.SystemAdapters +#endif + let isArray (ty:Type) = + ty.IsArray || (typeof.IsAssignableFrom ty) + + let canUseDotnetDefaultComparisonOrEquality isCustom hasStructuralInterface stringsRequireHandling er (rootType:Type) = + let processed = System.Collections.Generic.HashSet () + + let bindingPublicOrNonPublic = + Reflection.flagsOr BindingFlags.Public BindingFlags.NonPublic + + let rec isSuitableNullableTypeOrNotNullable (ty:Type) = + // although nullables not explicitly handled previously, they need special handling + // due to the implicit casting to their underlying generic type (i.e. could be a float) + let isNullableType = + ty.IsGenericType + && ty.GetGenericTypeDefinition().Equals typedefof> + if isNullableType then + checkType 0 (ty.GetGenericArguments ()) + else + true + + and isSuitableTupleType (ty:Type) = + Reflection.isTupleType ty + && ty.IsValueType // Tuple<...> don't have implementation, but ValueTuple<...> does + && checkType 0 (ty.GetGenericArguments ()) + + and isSuitableRecordType (ty:Type) = + Reflection.isRecordType (ty, bindingPublicOrNonPublic) && + (not (isCustom ty)) && + ( let fields = Reflection.fieldPropsOfRecordType (ty, bindingPublicOrNonPublic) + let fieldTypes = Array.ConvertAll (fields, Converter (fun f -> f.PropertyType)) + checkType 0 fieldTypes) + + and isSuitableUnionType (ty:Type) = + Reflection.isUnionType (ty, bindingPublicOrNonPublic) && + (not (isCustom ty)) && + ( let cases = Reflection.getUnionTypeTagNameMap (ty, bindingPublicOrNonPublic) + let rec checkCases idx = + if idx = cases.Length then true + else + let tag,_ = get cases idx + let fields = Reflection.fieldsPropsOfUnionCase (ty, tag, bindingPublicOrNonPublic) + let fieldTypes = Array.ConvertAll (fields, Converter (fun f -> f.PropertyType)) + if checkType 0 fieldTypes then + checkCases (idx+1) + else + false + checkCases 0) + + and checkType idx (types:Type[]) = + if idx = types.Length then true + else + let ty = get types idx + if not (processed.Add ty) then + checkType (idx+1) types + else + ty.IsSealed // covers enum and value types; derived ref types might implement from hasStructuralInterface + && not (isArray ty) + && (not stringsRequireHandling || (not (ty.Equals typeof))) + && (er || (not (ty.Equals typeof))) + && (er || (not (ty.Equals typeof))) + && isSuitableNullableTypeOrNotNullable ty + && ( isSuitableTupleType ty + || isSuitableRecordType ty + || isSuitableUnionType ty + || not (hasStructuralInterface ty)) + && checkType (idx+1) types + + checkType 0 [|rootType|] + //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: HASHING. //------------------------------------------------------------------------- @@ -1495,55 +1574,10 @@ namespace Microsoft.FSharp.Core let isStructuralComparable (ty:Type) = typeof.IsAssignableFrom ty let isValueTypeStructuralComparable (ty:Type) = isStructuralComparable ty && ty.IsValueType - let isArray (ty:Type) = ty.IsArray || (typeof.IsAssignableFrom ty) - let canUseDefaultComparer er (rootType:Type) = - let processed = System.Collections.Generic.HashSet () - - let rec checkType idx (types:Type[]) = - if idx = types.Length then true - else - let ty = get types idx - if not (processed.Add ty) then - checkType (idx+1) types - else - let isValidGenericType ifNotType fullname = - if not (ty.IsGenericType && ty.GetGenericTypeDefinition().FullName.Equals fullname) - then ifNotType - else checkType 0 (ty.GetGenericArguments ()) - let isTypeAndGenericArgumentsOK fullname = isValidGenericType false fullname - let isNotTypeOrIsTypeAndGenericArgumentsOK fullname = isValidGenericType true fullname - - // avoid any types that need special handling in GenericEqualityObj - // GenericEqualityObj handles string as a special cases, but internally routes to same equality - - ty.IsSealed // covers enum and value types - // ref types need to be sealed as derived class might implement IStructuralEquatable - && not (isArray ty) - && not (ty.Equals typeof) - && (er || (not (ty.Equals typeof))) - && (er || (not (ty.Equals typeof))) - && isNotTypeOrIsTypeAndGenericArgumentsOK "System.Nullable`1" - && not (isStructuralComparable ty - // we accept ValueTuple even though it supports IStructuralEquatable - // if all generic arguements pass check - && not ( isTypeAndGenericArgumentsOK "System.ValueTuple`1" - || isTypeAndGenericArgumentsOK "System.ValueTuple`2" - || isTypeAndGenericArgumentsOK "System.ValueTuple`3" - || isTypeAndGenericArgumentsOK "System.ValueTuple`4" - || isTypeAndGenericArgumentsOK "System.ValueTuple`5" - || isTypeAndGenericArgumentsOK "System.ValueTuple`6" - || isTypeAndGenericArgumentsOK "System.ValueTuple`7" - || isTypeAndGenericArgumentsOK "System.ValueTuple`8" - || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Collections.FSharpList`1" - || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpOption`1" - || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpValueOption`1" - || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpResult`2" - ) - ) - && checkType (idx+1) types - - checkType 0 [|rootType|] + let canUseDefaultComparer er (rootType:Type) = + // "Default" equality for strings is culturally sensitive, so needs special handling + canUseDotnetDefaultComparisonOrEquality Reflection.hasCustomComparison isStructuralComparable true er rootType type ComparisonUsage = | ERUsage = 0 @@ -2099,51 +2133,8 @@ namespace Microsoft.FSharp.Core let isValueTypeStructuralEquatable (ty:Type) = isStructuralEquatable ty && ty.IsValueType let canUseDefaultEqualityComparer er (rootType:Type) = - let processed = System.Collections.Generic.HashSet () - - let rec checkType idx (types:Type[]) = - if idx = types.Length then true - else - let ty = get types idx - if not (processed.Add ty) then - checkType (idx+1) types - else - let isValidGenericType ifNotType fullname = - if not (ty.IsGenericType && ty.GetGenericTypeDefinition().FullName.Equals fullname) - then ifNotType - else checkType 0 (ty.GetGenericArguments ()) - let isTypeAndGenericArgumentsOK fullname = isValidGenericType false fullname - let isNotTypeOrIsTypeAndGenericArgumentsOK fullname = isValidGenericType true fullname - - // avoid any types that need special handling in GenericEqualityObj - // GenericEqualityObj handles string as a special cases, but internally routes to same equality - - ty.IsSealed // covers enum and value types - // ref types need to be sealed as derived class might implement IStructuralEquatable - && not (isArray ty) - && (er || (not (ty.Equals typeof))) - && (er || (not (ty.Equals typeof))) - && isNotTypeOrIsTypeAndGenericArgumentsOK "System.Nullable`1" - && not (isStructuralEquatable ty - // we accept ValueTuple even though it supports IStructuralEquatable - // if all generic arguements pass check - && not ( isTypeAndGenericArgumentsOK "System.ValueTuple`1" - || isTypeAndGenericArgumentsOK "System.ValueTuple`2" - || isTypeAndGenericArgumentsOK "System.ValueTuple`3" - || isTypeAndGenericArgumentsOK "System.ValueTuple`4" - || isTypeAndGenericArgumentsOK "System.ValueTuple`5" - || isTypeAndGenericArgumentsOK "System.ValueTuple`6" - || isTypeAndGenericArgumentsOK "System.ValueTuple`7" - || isTypeAndGenericArgumentsOK "System.ValueTuple`8" - || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Collections.FSharpList`1" - || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpOption`1" - || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpValueOption`1" - || isTypeAndGenericArgumentsOK "Microsoft.FSharp.Core.FSharpResult`2" - ) - ) - && checkType (idx+1) types - - checkType 0 [|rootType|] + // "Default" equality for strings is by ordinal, so needs special handling required + canUseDotnetDefaultComparisonOrEquality Reflection.hasCustomEquality isStructuralEquatable false er rootType let tryGetFSharpEqualityComparer (er:bool) (ty:Type) : obj = match er, ty with From fbecaf2ab59309156c4640307ad0c29c1bb4123c Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 9 Jul 2018 18:44:10 +1000 Subject: [PATCH 44/64] Added check for fsharp value types --- src/fsharp/FSharp.Core/prim-types.fs | 42 +++++++++++++++++++--------- 1 file changed, 29 insertions(+), 13 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 534ca97e9cb..d90150a41bb 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -825,6 +825,13 @@ namespace Microsoft.FSharp.Core f () f () + member this.GetConstructors(bindingFlags) = + // type initializer will also be included in resultset + let constructors = this.GetTypeInfo().DeclaredConstructors + + Array.FindAll (toArray constructors, Predicate (fun ci -> + isAcceptable bindingFlags ci.IsStatic ci.IsPublic)) + // use different sources based on Declared flag member this.GetMethods (bindingFlags) = let methods = @@ -1011,18 +1018,22 @@ namespace Microsoft.FSharp.Core else false - let isRecordType (typ:Type, bindingFlags:BindingFlags) = + let isKnownType (typ:Type, bindingFlags:BindingFlags, knownType:SourceConstructFlags) = let mutable flags = unsafeDefault<_> match tryFindSourceConstructFlagsOfType (typ, &flags) with | false -> false | true -> - (flagsContains flags SourceConstructFlags.KindMask SourceConstructFlags.RecordType) && + (flagsContains flags SourceConstructFlags.KindMask knownType) && // We see private representations only if BindingFlags.NonPublic is set (if flagsIsSet flags SourceConstructFlags.NonPublicRepresentation then flagsIsSet bindingFlags BindingFlags.NonPublic else true) + let isRecordType (typ:Type, bindingFlags:BindingFlags) = isKnownType (typ, bindingFlags, SourceConstructFlags.RecordType) + let isObjectType (typ:Type, bindingFlags:BindingFlags) = isKnownType (typ, bindingFlags, SourceConstructFlags.ObjectType) + let isUnionType (typ:Type, bindingFlags:BindingFlags) = isKnownType (typ, bindingFlags, SourceConstructFlags.SumType) + let isFieldProperty (prop : PropertyInfo) = let mutable res = unsafeDefault<_> match tryFindCompilationMappingAttributeFromMemberInfo(prop:>MemberInfo, &res) with @@ -1123,17 +1134,13 @@ namespace Microsoft.FSharp.Core let filtered = Array.FindAll (properties, Predicate (fun p -> if isFieldProperty p then (variantNumberOfMember (p:>MemberInfo)) = tag else false)) sortFreshArray (fun (p:PropertyInfo) -> sequenceNumberOfMember p) filtered - let isUnionType (typ:Type,bindingFlags:BindingFlags) = - let mutable flags = unsafeDefault<_> - match tryFindSourceConstructFlagsOfType(typ, &flags) with - | false -> false - | true -> - (flagsContains flags SourceConstructFlags.KindMask SourceConstructFlags.SumType) && - // We see private representations only if BindingFlags.NonPublic is set - (if flagsIsSet flags SourceConstructFlags.NonPublicRepresentation then - flagsIsSet bindingFlags BindingFlags.NonPublic - else - true) + let tryGetSingleConstructorArgumentTypes (typ:Type, types:byref) = + match typ.GetConstructors (flagsOr BindingFlags.Instance (flagsOr BindingFlags.Public BindingFlags.NonPublic)) with + | [| single |] -> + types <- Array.ConvertAll (single.GetParameters (), Converter (fun p -> p.ParameterType)) + true + | _ -> + false module HashCompare = #if FX_RESHAPED_REFLECTION @@ -1164,6 +1171,14 @@ namespace Microsoft.FSharp.Core && ty.IsValueType // Tuple<...> don't have implementation, but ValueTuple<...> does && checkType 0 (ty.GetGenericArguments ()) + and isSuitableStructType (ty:Type) = + Reflection.isObjectType (ty, bindingPublicOrNonPublic) && + ty.IsValueType && + (not (isCustom ty)) && + ( let mutable types = unsafeDefault<_> + Reflection.tryGetSingleConstructorArgumentTypes (ty, &types) + && checkType 0 types) + and isSuitableRecordType (ty:Type) = Reflection.isRecordType (ty, bindingPublicOrNonPublic) && (not (isCustom ty)) && @@ -1201,6 +1216,7 @@ namespace Microsoft.FSharp.Core && (er || (not (ty.Equals typeof))) && isSuitableNullableTypeOrNotNullable ty && ( isSuitableTupleType ty + || isSuitableStructType ty || isSuitableRecordType ty || isSuitableUnionType ty || not (hasStructuralInterface ty)) From 66be88feebce638dc4181b12e2389eab5e7af539 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 10 Jul 2018 16:36:25 +1000 Subject: [PATCH 45/64] Fixed struct check where a [] field is used. --- src/fsharp/FSharp.Core/prim-types.fs | 21 ++++----------------- 1 file changed, 4 insertions(+), 17 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index d90150a41bb..ce3c3c61dbe 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -825,13 +825,6 @@ namespace Microsoft.FSharp.Core f () f () - member this.GetConstructors(bindingFlags) = - // type initializer will also be included in resultset - let constructors = this.GetTypeInfo().DeclaredConstructors - - Array.FindAll (toArray constructors, Predicate (fun ci -> - isAcceptable bindingFlags ci.IsStatic ci.IsPublic)) - // use different sources based on Declared flag member this.GetMethods (bindingFlags) = let methods = @@ -1134,13 +1127,9 @@ namespace Microsoft.FSharp.Core let filtered = Array.FindAll (properties, Predicate (fun p -> if isFieldProperty p then (variantNumberOfMember (p:>MemberInfo)) = tag else false)) sortFreshArray (fun (p:PropertyInfo) -> sequenceNumberOfMember p) filtered - let tryGetSingleConstructorArgumentTypes (typ:Type, types:byref) = - match typ.GetConstructors (flagsOr BindingFlags.Instance (flagsOr BindingFlags.Public BindingFlags.NonPublic)) with - | [| single |] -> - types <- Array.ConvertAll (single.GetParameters (), Converter (fun p -> p.ParameterType)) - true - | _ -> - false + let getAllInstanceFields (typ:Type) = + let fields = typ.GetFields (flagsOr BindingFlags.Instance (flagsOr BindingFlags.Public BindingFlags.NonPublic)) + Array.ConvertAll (fields, Converter (fun p -> p.FieldType)) module HashCompare = #if FX_RESHAPED_REFLECTION @@ -1175,9 +1164,7 @@ namespace Microsoft.FSharp.Core Reflection.isObjectType (ty, bindingPublicOrNonPublic) && ty.IsValueType && (not (isCustom ty)) && - ( let mutable types = unsafeDefault<_> - Reflection.tryGetSingleConstructorArgumentTypes (ty, &types) - && checkType 0 types) + checkType 0 (Reflection.getAllInstanceFields ty) and isSuitableRecordType (ty:Type) = Reflection.isRecordType (ty, bindingPublicOrNonPublic) && From fd6d783ef9aa02a232943cebb5fcc4de73f465cf Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 11 Jul 2018 18:47:19 +1000 Subject: [PATCH 46/64] Minor shift in logic order for less comparisons --- src/fsharp/FSharp.Core/prim-types.fs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index ce3c3c61dbe..14e82785bdc 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -1156,13 +1156,13 @@ namespace Microsoft.FSharp.Core true and isSuitableTupleType (ty:Type) = - Reflection.isTupleType ty - && ty.IsValueType // Tuple<...> don't have implementation, but ValueTuple<...> does - && checkType 0 (ty.GetGenericArguments ()) + ty.IsValueType && // Tuple<...> don't have implementation, but ValueTuple<...> does + Reflection.isTupleType ty && + checkType 0 (ty.GetGenericArguments ()) and isSuitableStructType (ty:Type) = - Reflection.isObjectType (ty, bindingPublicOrNonPublic) && ty.IsValueType && + Reflection.isObjectType (ty, bindingPublicOrNonPublic) && (not (isCustom ty)) && checkType 0 (Reflection.getAllInstanceFields ty) @@ -1202,11 +1202,11 @@ namespace Microsoft.FSharp.Core && (er || (not (ty.Equals typeof))) && (er || (not (ty.Equals typeof))) && isSuitableNullableTypeOrNotNullable ty - && ( isSuitableTupleType ty + && ((not (hasStructuralInterface ty)) + || isSuitableTupleType ty || isSuitableStructType ty || isSuitableRecordType ty - || isSuitableUnionType ty - || not (hasStructuralInterface ty)) + || isSuitableUnionType ty) && checkType (idx+1) types checkType 0 [|rootType|] From f11798565fffae8b0ca1b17fb71026fad1444846 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 19 Jul 2018 16:07:53 +1000 Subject: [PATCH 47/64] Removed MapOne case for performance. Now with only two cases, one of which can be represented as null due to [], no type checking or casting needs to be performed on each node access. This does come at the expense of more memory usage, where each leaf node now carries an extra (2*sizeof+sizeof) --- src/fsharp/FSharp.Core/map.fs | 57 ++++++----------------------------- 1 file changed, 10 insertions(+), 47 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 97c747e4ae5..02c5559bb78 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -12,10 +12,7 @@ namespace Microsoft.FSharp.Collections [] type MapTree<'Key,'Value when 'Key : comparison > = | MapEmpty - | MapOne of 'Key * 'Value | MapNode of 'Key * 'Value * MapTree<'Key,'Value> * MapTree<'Key,'Value> * int - // REVIEW: performance rumour has it that the data held in MapNode and MapOne should be - // exactly one cache line. It is currently ~7 and 4 words respectively. [] module MapTree = @@ -23,12 +20,10 @@ namespace Microsoft.FSharp.Collections let rec sizeAux acc m = match m with | MapEmpty -> acc - | MapOne _ -> acc + 1 | MapNode(_,_,l,r,_) -> sizeAux (sizeAux (acc+1) l) r let size x = sizeAux 0 x - #if TRACE_SETS_AND_MAPS let mutable traceCount = 0 let mutable numOnes = 0 @@ -64,9 +59,10 @@ namespace Microsoft.FSharp.Collections let empty = MapEmpty + let makeLeafNode k v = MapNode(k,v,MapEmpty,MapEmpty,1) + let height = function | MapEmpty -> 0 - | MapOne _ -> 1 | MapNode(_,_,_,_,h) -> h let isEmpty m = @@ -76,7 +72,7 @@ namespace Microsoft.FSharp.Collections let mk l k v r = match l,r with - | MapEmpty,MapEmpty -> MapOne(k,v) + | MapEmpty,MapEmpty -> makeLeafNode k v | _ -> let hl = height l let hr = height r @@ -116,12 +112,7 @@ namespace Microsoft.FSharp.Collections let rec add (comparer: IComparer<'Value>) k v m = match m with - | MapEmpty -> MapOne(k,v) - | MapOne(k2,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then MapNode (k,v,MapEmpty,m,2) - elif c = 0 then MapOne(k,v) - else MapNode (k,v,m,MapEmpty,2) + | MapEmpty -> makeLeafNode k v | MapNode(k2,v2,l,r,h) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (add comparer k v l) k2 v2 r @@ -131,10 +122,6 @@ namespace Microsoft.FSharp.Collections let rec find (comparer: IComparer<'Value>) k m = match m with | MapEmpty -> raise (KeyNotFoundException()) - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then v2 - else raise (KeyNotFoundException()) | MapNode(k2,v2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then find comparer k l @@ -144,10 +131,6 @@ namespace Microsoft.FSharp.Collections let rec tryFind (comparer: IComparer<'Value>) k m = match m with | MapEmpty -> None - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then Some v2 - else None | MapNode(k2,v2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then tryFind comparer k l @@ -160,7 +143,6 @@ namespace Microsoft.FSharp.Collections let rec partitionAux (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with | MapEmpty -> acc - | MapOne(k,v) -> partition1 comparer f k v acc | MapNode(k,v,l,r,_) -> let acc = partitionAux comparer f r acc let acc = partition1 comparer f k v acc @@ -173,7 +155,6 @@ namespace Microsoft.FSharp.Collections let rec filterAux (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with | MapEmpty -> acc - | MapOne(k,v) -> filter1 comparer f k v acc | MapNode(k,v,l,r,_) -> let acc = filterAux comparer f l acc let acc = filter1 comparer f k v acc @@ -184,7 +165,6 @@ namespace Microsoft.FSharp.Collections let rec spliceOutSuccessor m = match m with | MapEmpty -> failwith "internal error: Map.spliceOutSuccessor" - | MapOne(k2,v2) -> k2,v2,MapEmpty | MapNode(k2,v2,l,r,_) -> match l with | MapEmpty -> k2,v2,r @@ -193,9 +173,6 @@ namespace Microsoft.FSharp.Collections let rec remove (comparer: IComparer<'Value>) k m = match m with | MapEmpty -> empty - | MapOne(k2,_) -> - let c = comparer.Compare(k,k2) - if c = 0 then MapEmpty else m | MapNode(k2,v2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (remove comparer k l) k2 v2 r @@ -211,7 +188,6 @@ namespace Microsoft.FSharp.Collections let rec mem (comparer: IComparer<'Value>) k m = match m with | MapEmpty -> false - | MapOne(k2,_) -> (comparer.Compare(k,k2) = 0) | MapNode(k2,_,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then mem comparer k l @@ -220,7 +196,6 @@ namespace Microsoft.FSharp.Collections let rec iterOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with | MapEmpty -> () - | MapOne(k2,v2) -> f.Invoke(k2, v2) | MapNode(k2,v2,l,r,_) -> iterOpt f l; f.Invoke(k2, v2); iterOpt f r let iter f m = iterOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m @@ -228,7 +203,6 @@ namespace Microsoft.FSharp.Collections let rec tryPickOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with | MapEmpty -> None - | MapOne(k2,v2) -> f.Invoke(k2, v2) | MapNode(k2,v2,l,r,_) -> match tryPickOpt f l with | Some _ as res -> res @@ -243,7 +217,6 @@ namespace Microsoft.FSharp.Collections let rec existsOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with | MapEmpty -> false - | MapOne(k2,v2) -> f.Invoke(k2, v2) | MapNode(k2,v2,l,r,_) -> existsOpt f l || f.Invoke(k2, v2) || existsOpt f r let exists f m = existsOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m @@ -251,7 +224,6 @@ namespace Microsoft.FSharp.Collections let rec forallOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with | MapEmpty -> true - | MapOne(k2,v2) -> f.Invoke(k2, v2) | MapNode(k2,v2,l,r,_) -> forallOpt f l && f.Invoke(k2, v2) && forallOpt f r let forall f m = forallOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m @@ -259,7 +231,6 @@ namespace Microsoft.FSharp.Collections let rec map f m = match m with | MapEmpty -> empty - | MapOne(k,v) -> MapOne(k,f v) | MapNode(k,v,l,r,h) -> let l2 = map f l let v2 = f v @@ -269,7 +240,6 @@ namespace Microsoft.FSharp.Collections let rec mapiOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with | MapEmpty -> empty - | MapOne(k,v) -> MapOne(k, f.Invoke(k, v)) | MapNode(k,v,l,r,h) -> let l2 = mapiOpt f l let v2 = f.Invoke(k, v) @@ -281,7 +251,6 @@ namespace Microsoft.FSharp.Collections let rec foldBackOpt (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = match m with | MapEmpty -> x - | MapOne(k,v) -> f.Invoke(k,v,x) | MapNode(k,v,l,r,_) -> let x = foldBackOpt f r x let x = f.Invoke(k,v,x) @@ -292,7 +261,6 @@ namespace Microsoft.FSharp.Collections let rec foldOpt (f:OptimizedClosures.FSharpFunc<_,_,_,_>) x m = match m with | MapEmpty -> x - | MapOne(k,v) -> f.Invoke(x,k,v) | MapNode(k,v,l,r,_) -> let x = foldOpt f x l let x = f.Invoke(x,k,v) @@ -304,11 +272,6 @@ namespace Microsoft.FSharp.Collections let rec foldFromTo (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = match m with | MapEmpty -> x - | MapOne(k,v) -> - let cLoKey = comparer.Compare(lo,k) - let cKeyHi = comparer.Compare(k,hi) - let x = if cLoKey <= 0 && cKeyHi <= 0 then f.Invoke(k, v, x) else x - x | MapNode(k,v,l,r,_) -> let cLoKey = comparer.Compare(lo,k) let cKeyHi = comparer.Compare(k,hi) @@ -326,7 +289,6 @@ namespace Microsoft.FSharp.Collections let rec loop m acc = match m with | MapEmpty -> acc - | MapOne(k,v) -> (k,v)::acc | MapNode(k,v,l,r,_) -> loop l ((k,v)::loop r acc) loop m [] let toArray m = m |> toList |> Array.ofList @@ -373,8 +335,8 @@ namespace Microsoft.FSharp.Collections match stack with | [] -> [] | MapEmpty :: rest -> collapseLHS rest - | MapOne _ :: _ -> stack - | (MapNode(k,v,l,r,_)) :: rest -> collapseLHS (l :: MapOne (k,v) :: r :: rest) + | MapNode(_,_,MapEmpty,MapEmpty,_) :: _ -> stack + | (MapNode(k,v,l,r,_)) :: rest -> collapseLHS (l :: (makeLeafNode k v) :: r :: rest) let mkIterator s = { stack = collapseLHS [s]; started = false } @@ -384,7 +346,7 @@ namespace Microsoft.FSharp.Collections let current i = if i.started then match i.stack with - | MapOne (k,v) :: _ -> new KeyValuePair<_,_>(k,v) + | MapNode(k,v,MapEmpty,MapEmpty,_) :: _ -> new KeyValuePair<_,_>(k,v) | [] -> alreadyFinished() | _ -> failwith "Please report error: Map iterator, unexpected stack for current" else @@ -393,8 +355,9 @@ namespace Microsoft.FSharp.Collections let rec moveNext i = if i.started then match i.stack with - | MapOne _ :: rest -> i.stack <- collapseLHS rest - not i.stack.IsEmpty + | MapNode(_,_,MapEmpty,MapEmpty,_) :: rest -> + i.stack <- collapseLHS rest + not i.stack.IsEmpty | [] -> false | _ -> failwith "Please report error: Map iterator, unexpected stack for moveNext" else From c0e872d23784a9115ead9eab0b93c7e6af869e76 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Fri, 20 Jul 2018 17:30:54 +1000 Subject: [PATCH 48/64] Converted Map.Count from O(n) to O(1) --- src/fsharp/FSharp.Core/map.fs | 44 +++++++++++++---------------------- 1 file changed, 16 insertions(+), 28 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 02c5559bb78..6a4a17ddd46 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -16,14 +16,6 @@ namespace Microsoft.FSharp.Collections [] module MapTree = - - let rec sizeAux acc m = - match m with - | MapEmpty -> acc - | MapNode(_,_,l,r,_) -> sizeAux (sizeAux (acc+1) l) r - - let size x = sizeAux 0 x - #if TRACE_SETS_AND_MAPS let mutable traceCount = 0 let mutable numOnes = 0 @@ -59,34 +51,30 @@ namespace Microsoft.FSharp.Collections let empty = MapEmpty - let makeLeafNode k v = MapNode(k,v,MapEmpty,MapEmpty,1) + let mkLeaf k v = + MapNode (k, v, MapEmpty, MapEmpty, 1) - let height = function - | MapEmpty -> 0 - | MapNode(_,_,_,_,h) -> h + let size x = + match x with + | MapEmpty -> 0 + | MapNode (_,_,_,_,h) -> h let isEmpty m = match m with | MapEmpty -> true | _ -> false - let mk l k v r = - match l,r with - | MapEmpty,MapEmpty -> makeLeafNode k v - | _ -> - let hl = height l - let hr = height r - let m = if hl < hr then hr else hl - MapNode(k,v,l,r,m+1) + let mk l k v r = + MapNode (k,v,l,r,size l + size r + 1) let rebalance t1 k v t2 = - let t1h = height t1 - let t2h = height t2 - if t2h > t1h + 2 then (* right is heavier than left *) + let t1h = size t1 + let t2h = size t2 + if (t2h >>> 1) > t1h then (* right is heavier than left *) match t2 with | MapNode(t2k,t2v,t2l,t2r,_) -> (* one of the nodes must have height > height t1 + 1 *) - if height t2l > t1h + 1 then (* balance left: combination *) + if size t2l > t1h then (* balance left: combination *) match t2l with | MapNode(t2lk,t2lv,t2ll,t2lr,_) -> mk (mk t1 k v t2ll) t2lk t2lv (mk t2lr t2k t2v t2r) @@ -95,11 +83,11 @@ namespace Microsoft.FSharp.Collections mk (mk t1 k v t2l) t2k t2v t2r | _ -> failwith "rebalance" else - if t1h > t2h + 2 then (* left is heavier than right *) + if (t1h >>> 1) > t2h then (* left is heavier than right *) match t1 with | MapNode(t1k,t1v,t1l,t1r,_) -> (* one of the nodes must have height > height t2 + 1 *) - if height t1r > t2h + 1 then + if size t1r > t2h then (* balance right: combination *) match t1r with | MapNode(t1rk,t1rv,t1rl,t1rr,_) -> @@ -112,7 +100,7 @@ namespace Microsoft.FSharp.Collections let rec add (comparer: IComparer<'Value>) k v m = match m with - | MapEmpty -> makeLeafNode k v + | MapEmpty -> mkLeaf k v | MapNode(k2,v2,l,r,h) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (add comparer k v l) k2 v2 r @@ -336,7 +324,7 @@ namespace Microsoft.FSharp.Collections | [] -> [] | MapEmpty :: rest -> collapseLHS rest | MapNode(_,_,MapEmpty,MapEmpty,_) :: _ -> stack - | (MapNode(k,v,l,r,_)) :: rest -> collapseLHS (l :: (makeLeafNode k v) :: r :: rest) + | (MapNode(k,v,l,r,_)) :: rest -> collapseLHS (l :: (mkLeaf k v) :: r :: rest) let mkIterator s = { stack = collapseLHS [s]; started = false } From dbc11d91d628d73f24b3147b1b8b609b03222b64 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 21 Jul 2018 11:46:12 +1000 Subject: [PATCH 49/64] inlined mk/mkLeaf --- src/fsharp/FSharp.Core/map.fs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 6a4a17ddd46..3c93518507b 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -51,9 +51,6 @@ namespace Microsoft.FSharp.Collections let empty = MapEmpty - let mkLeaf k v = - MapNode (k, v, MapEmpty, MapEmpty, 1) - let size x = match x with | MapEmpty -> 0 @@ -64,8 +61,11 @@ namespace Microsoft.FSharp.Collections | MapEmpty -> true | _ -> false - let mk l k v r = - MapNode (k,v,l,r,size l + size r + 1) + let inline mk l k v r = + MapNode (k,v,l,r, size l + size r + 1) + + let inline mkLeaf k v = + MapNode (k, v, MapEmpty, MapEmpty, 1) let rebalance t1 k v t2 = let t1h = size t1 From cfb0201a02b389207b466d71c88d4e18de589cd6 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 21 Jul 2018 15:58:11 +1000 Subject: [PATCH 50/64] optimize ofSeq, ofList, ofArray via a temporary sorted ResizeArray and direct tree construction --- src/fsharp/FSharp.Core/local.fsi | 2 + src/fsharp/FSharp.Core/map.fs | 106 +++++++++++++++++++++++++++---- 2 files changed, 97 insertions(+), 11 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fsi b/src/fsharp/FSharp.Core/local.fsi index 3181dcbc6ec..3106c1bbc35 100644 --- a/src/fsharp/FSharp.Core/local.fsi +++ b/src/fsharp/FSharp.Core/local.fsi @@ -101,3 +101,5 @@ module internal Array = val stableSortInPlaceWith: comparer:('T -> 'T -> int) -> array:'T[] -> unit val stableSortInPlace: array:'T[] -> unit when 'T : comparison + + val stableSortWithKeysAndComparer : System.Collections.Generic.IComparer<'Key> -> array<'T> -> array<'Key> -> unit when 'Key : comparison \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 3c93518507b..81e1b2f66bc 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -273,26 +273,110 @@ namespace Microsoft.FSharp.Collections let foldSection (comparer: IComparer<'Value>) lo hi f m x = foldSectionOpt comparer lo hi (OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f)) m x + // create a mapping function which indexes the array, but with duplicate values removed + let private getLatestAccessor (comparer:IComparer<'Key>) (keys:IReadOnlyList<'Key>) (array:IReadOnlyList<'T>) = + let rec getFirstDuplicateKey i = + if i >= array.Count-1 then None + elif comparer.Compare (keys.[i], keys.[i+1]) = 0 then Some i + else getFirstDuplicateKey (i+1) + + match getFirstDuplicateKey 0 with + | None -> (fun i -> array.[i]), array.Count + | Some idx -> + let indexes = ResizeArray (array.Count-idx) + indexes.Add (idx+1) + for i = idx+2 to array.Count-1 do + if comparer.Compare (keys.[i-1], keys.[i]) = 0 then + indexes.[indexes.Count-1] <- i + else + indexes.Add i + (fun i -> if i < idx then array.[i] else array.[indexes.[i-idx]]), idx+indexes.Count + + let constructViaArray comparer (data:seq<'Key*'Value>) = + let array = data |> Seq.toArray + if array.Length = 0 then MapEmpty + else + let keys = array |> Array.map fst + + Microsoft.FSharp.Primitives.Basics.Array.stableSortWithKeysAndComparer comparer array keys + + let getKV, count = + getLatestAccessor comparer keys array + + let rec loop lower upper = + assert (lower <= upper) + let mid = lower + (upper-lower)/2 + let k,v = getKV mid + if mid = upper then + mkLeaf k v + else + let right = loop (mid+1) upper + if mid = lower then + mk MapEmpty k v right + else + let left = loop lower (mid-1) + mk left k v right + + loop 0 (count-1) + let toList m = let rec loop m acc = match m with | MapEmpty -> acc | MapNode(k,v,l,r,_) -> loop l ((k,v)::loop r acc) loop m [] + let toArray m = m |> toList |> Array.ofList - let ofList comparer l = List.fold (fun acc (k,v) -> add comparer k v acc) empty l - let rec mkFromEnumerator comparer acc (e : IEnumerator<_>) = - if e.MoveNext() then - let (x,y) = e.Current - mkFromEnumerator comparer (add comparer x y acc) e - else acc + [] + let largeObjectHeapBytes = 85000 + + let maxInitializationObjectCount<'Key, 'Value> () = + largeObjectHeapBytes * 10 / 9 / sizeof<'Key*'Value> / 2 + + let ofList comparer (l:list<'Key*'Value>) = + if l |> List.isEmpty then empty + else + let chunk = ResizeArray () + let maxCount = maxInitializationObjectCount<'Key, 'Value> () + let rec populate x = + match x with + | [] -> x + | hd::tl -> + chunk.Add hd + if chunk.Count = maxCount then tl + else populate tl + let remainder = populate l + let chunkTree = constructViaArray comparer chunk + remainder |> List.fold (fun acc (k,v) -> add comparer k v acc) chunkTree + + let ofSeqlImpl comparer (e:IEnumerator<'Key*'Value>) = + if not (e.MoveNext()) then empty + else + let chunk = ResizeArray () + let maxCount = maxInitializationObjectCount<'Key, 'Value> () + let rec populate () = + chunk.Add e.Current + if chunk.Count = maxCount then true + elif e.MoveNext () then populate () + else false + + let more = populate () + let chunkTree = constructViaArray comparer chunk + + if not more then + chunkTree + else + let rec addRemainder acc = + if e.MoveNext () then + let x, y = e.Current + addRemainder (add comparer x y acc) + else + acc + addRemainder chunkTree let ofArray comparer (arr : array<_>) = - let mutable res = empty - for (x,y) in arr do - res <- add comparer x y res - res + constructViaArray comparer arr let ofSeq comparer (c : seq<'Key * 'T>) = match c with @@ -300,7 +384,7 @@ namespace Microsoft.FSharp.Collections | :? list<'Key * 'T> as xs -> ofList comparer xs | _ -> use ie = c.GetEnumerator() - mkFromEnumerator comparer empty ie + ofSeqlImpl comparer ie let copyToArray s (arr: _[]) i = From 0e52fdee7375b69083aff958a0fcfaa1a1f2db76 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 24 Jul 2018 17:39:43 +1000 Subject: [PATCH 51/64] Split rebalance so as to inline decision logic --- src/fsharp/FSharp.Core/map.fs | 68 +++++++++++++++++------------------ 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 81e1b2f66bc..a7266013c6c 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -67,45 +67,45 @@ namespace Microsoft.FSharp.Collections let inline mkLeaf k v = MapNode (k, v, MapEmpty, MapEmpty, 1) - let rebalance t1 k v t2 = - let t1h = size t1 - let t2h = size t2 - if (t2h >>> 1) > t1h then (* right is heavier than left *) - match t2 with - | MapNode(t2k,t2v,t2l,t2r,_) -> - (* one of the nodes must have height > height t1 + 1 *) - if size t2l > t1h then (* balance left: combination *) - match t2l with - | MapNode(t2lk,t2lv,t2ll,t2lr,_) -> - mk (mk t1 k v t2ll) t2lk t2lv (mk t2lr t2k t2v t2r) - | _ -> failwith "rebalance" - else (* rotate left *) - mk (mk t1 k v t2l) t2k t2v t2r - | _ -> failwith "rebalance" - else - if (t1h >>> 1) > t2h then (* left is heavier than right *) - match t1 with - | MapNode(t1k,t1v,t1l,t1r,_) -> - (* one of the nodes must have height > height t2 + 1 *) - if size t1r > t2h then - (* balance right: combination *) - match t1r with - | MapNode(t1rk,t1rv,t1rl,t1rr,_) -> - mk (mk t1l t1k t1v t1rl) t1rk t1rv (mk t1rr k v t2) - | _ -> failwith "rebalance" - else - mk t1l t1k t1v (mk t1r k v t2) - | _ -> failwith "rebalance" - else mk t1 k v t2 + let private rebalanceRight l k v r = + match r with + | MapEmpty -> failwith "rebalance" + | MapNode(rk,rv,rl,rr,_) -> + (* one of the nodes must have height > height t1 + 1 *) + if size rl > size l then (* balance left: combination *) + match rl with + | MapEmpty -> failwith "rebalance" + | MapNode(rlk,rlv,rll,rlr,_) -> mk (mk l k v rll) rlk rlv (mk rlr rk rv rr) + else (* rotate left *) + mk (mk l k v rl) rk rv rr + + let private rebalanceLeft l k v r = + match l with + | MapEmpty -> failwith "rebalance" + | MapNode(lk,lv,ll,lr,_) -> + (* one of the nodes must have height > height t2 + 1 *) + if size lr > size r then + (* balance right: combination *) + match lr with + | MapEmpty -> failwith "rebalance" + | MapNode(lrk,lrv,lrl,lrr,_) -> mk (mk ll lk lv lrl) lrk lrv (mk lrr k v r) + else + mk ll lk lv (mk lr k v r) + + let inline rebalance l k v r = + let ls, rs = size l, size r + if (rs >>> 1) > ls then rebalanceRight l k v r + elif (ls >>> 1) > rs then rebalanceLeft l k v r + else MapNode (k,v,l,r, ls+rs+1) let rec add (comparer: IComparer<'Value>) k v m = match m with | MapEmpty -> mkLeaf k v - | MapNode(k2,v2,l,r,h) -> + | MapNode(k2,v2,l,r,s) -> let c = comparer.Compare(k,k2) - if c < 0 then rebalance (add comparer k v l) k2 v2 r - elif c = 0 then MapNode(k,v,l,r,h) - else rebalance l k2 v2 (add comparer k v r) + if c < 0 then rebalance (add comparer k v l) k2 v2 r + elif c > 0 then rebalance l k2 v2 (add comparer k v r) + else MapNode(k,v,l,r,s) let rec find (comparer: IComparer<'Value>) k m = match m with From b18c16cb3c0708c08e73b8b46638019982a99f03 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 26 Jul 2018 17:23:36 +1000 Subject: [PATCH 52/64] Removed MapEmpty --- src/fsharp/FSharp.Core/map.fs | 132 +++++++++++++++------------------- 1 file changed, 59 insertions(+), 73 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index a7266013c6c..d7c7c0aefe1 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -8,10 +8,8 @@ namespace Microsoft.FSharp.Collections open Microsoft.FSharp.Core open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - [] [] type MapTree<'Key,'Value when 'Key : comparison > = - | MapEmpty | MapNode of 'Key * 'Value * MapTree<'Key,'Value> * MapTree<'Key,'Value> * int [] @@ -49,48 +47,37 @@ namespace Microsoft.FSharp.Collections n #endif - let empty = MapEmpty + [] + type Constants<'Key, 'Value when 'Key : comparison> private () = + static let empty = MapNode(Unchecked.defaultof<'Key>, Unchecked.defaultof<'Value>, Unchecked.defaultof>, Unchecked.defaultof>, 0) + static member Empty = empty - let size x = - match x with - | MapEmpty -> 0 - | MapNode (_,_,_,_,h) -> h + let inline size (MapNode(_,_,_,_,s)) = s - let isEmpty m = - match m with - | MapEmpty -> true - | _ -> false + let inline isEmpty (MapNode(_,_,_,_,s)) = s = 0 let inline mk l k v r = MapNode (k,v,l,r, size l + size r + 1) let inline mkLeaf k v = - MapNode (k, v, MapEmpty, MapEmpty, 1) - - let private rebalanceRight l k v r = - match r with - | MapEmpty -> failwith "rebalance" - | MapNode(rk,rv,rl,rr,_) -> - (* one of the nodes must have height > height t1 + 1 *) - if size rl > size l then (* balance left: combination *) - match rl with - | MapEmpty -> failwith "rebalance" - | MapNode(rlk,rlv,rll,rlr,_) -> mk (mk l k v rll) rlk rlv (mk rlr rk rv rr) - else (* rotate left *) - mk (mk l k v rl) rk rv rr - - let private rebalanceLeft l k v r = - match l with - | MapEmpty -> failwith "rebalance" - | MapNode(lk,lv,ll,lr,_) -> - (* one of the nodes must have height > height t2 + 1 *) - if size lr > size r then - (* balance right: combination *) - match lr with - | MapEmpty -> failwith "rebalance" - | MapNode(lrk,lrv,lrl,lrr,_) -> mk (mk ll lk lv lrl) lrk lrv (mk lrr k v r) - else - mk ll lk lv (mk lr k v r) + MapNode (k, v, Constants.Empty, Constants.Empty, 1) + + let private rebalanceRight l k v (MapNode(rk,rv,rl,rr,_)) = + (* one of the nodes must have height > height t1 + 1 *) + if size rl > size l then (* balance left: combination *) + match rl with + | MapNode(rlk,rlv,rll,rlr,_) -> mk (mk l k v rll) rlk rlv (mk rlr rk rv rr) + else (* rotate left *) + mk (mk l k v rl) rk rv rr + + let private rebalanceLeft (MapNode(lk,lv,ll,lr,_)) k v r = + (* one of the nodes must have height > height t2 + 1 *) + if size lr > size r then + (* balance right: combination *) + match lr with + | MapNode(lrk,lrv,lrl,lrr,_) -> mk (mk ll lk lv lrl) lrk lrv (mk lrr k v r) + else + mk ll lk lv (mk lr k v r) let inline rebalance l k v r = let ls, rs = size l, size r @@ -98,10 +85,9 @@ namespace Microsoft.FSharp.Collections elif (ls >>> 1) > rs then rebalanceLeft l k v r else MapNode (k,v,l,r, ls+rs+1) - let rec add (comparer: IComparer<'Value>) k v m = - match m with - | MapEmpty -> mkLeaf k v - | MapNode(k2,v2,l,r,s) -> + let rec add (comparer: IComparer<'Value>) k v (MapNode(k2,v2,l,r,s)) = + if s = 0 then mkLeaf k v + else let c = comparer.Compare(k,k2) if c < 0 then rebalance (add comparer k v l) k2 v2 r elif c > 0 then rebalance l k2 v2 (add comparer k v r) @@ -109,7 +95,7 @@ namespace Microsoft.FSharp.Collections let rec find (comparer: IComparer<'Value>) k m = match m with - | MapEmpty -> raise (KeyNotFoundException()) + | MapNode(_,_,_,_,0) -> raise (KeyNotFoundException()) | MapNode(k2,v2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then find comparer k l @@ -118,7 +104,7 @@ namespace Microsoft.FSharp.Collections let rec tryFind (comparer: IComparer<'Value>) k m = match m with - | MapEmpty -> None + | MapNode(_,_,_,_,0) -> None | MapNode(k2,v2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then tryFind comparer k l @@ -130,44 +116,44 @@ namespace Microsoft.FSharp.Collections let rec partitionAux (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with - | MapEmpty -> acc + | MapNode(_,_,_,_,0) -> acc | MapNode(k,v,l,r,_) -> let acc = partitionAux comparer f r acc let acc = partition1 comparer f k v acc partitionAux comparer f l acc - let partition (comparer: IComparer<'Value>) f s = partitionAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s (empty,empty) + let partition (comparer: IComparer<'Value>) f s = partitionAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s (Constants.Empty,Constants.Empty) let filter1 (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) k v acc = if f.Invoke(k, v) then add comparer k v acc else acc let rec filterAux (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with - | MapEmpty -> acc + | MapNode(_,_,_,_,0) -> acc | MapNode(k,v,l,r,_) -> let acc = filterAux comparer f l acc let acc = filter1 comparer f k v acc filterAux comparer f r acc - let filter (comparer: IComparer<'Value>) f s = filterAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s empty + let filter (comparer: IComparer<'Value>) f s = filterAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s Constants.Empty let rec spliceOutSuccessor m = match m with - | MapEmpty -> failwith "internal error: Map.spliceOutSuccessor" + | MapNode(_,_,_,_,0) -> failwith "internal error: Map.spliceOutSuccessor" | MapNode(k2,v2,l,r,_) -> match l with - | MapEmpty -> k2,v2,r + | MapNode(_,_,_,_,0) -> k2,v2,r | _ -> let k3,v3,l' = spliceOutSuccessor l in k3,v3,mk l' k2 v2 r let rec remove (comparer: IComparer<'Value>) k m = match m with - | MapEmpty -> empty + | MapNode(_,_,_,_,0) -> Constants.Empty | MapNode(k2,v2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (remove comparer k l) k2 v2 r elif c = 0 then match l,r with - | MapEmpty,_ -> r - | _,MapEmpty -> l + | MapNode(_,_,_,_,0),_ -> r + | _,MapNode(_,_,_,_,0) -> l | _ -> let sk,sv,r' = spliceOutSuccessor r mk l sk sv r' @@ -175,7 +161,7 @@ namespace Microsoft.FSharp.Collections let rec mem (comparer: IComparer<'Value>) k m = match m with - | MapEmpty -> false + | MapNode(_,_,_,_,0) -> false | MapNode(k2,_,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then mem comparer k l @@ -183,14 +169,14 @@ namespace Microsoft.FSharp.Collections let rec iterOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> () + | MapNode(_,_,_,_,0) -> () | MapNode(k2,v2,l,r,_) -> iterOpt f l; f.Invoke(k2, v2); iterOpt f r let iter f m = iterOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m let rec tryPickOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> None + | MapNode(_,_,_,_,0) -> None | MapNode(k2,v2,l,r,_) -> match tryPickOpt f l with | Some _ as res -> res @@ -204,21 +190,21 @@ namespace Microsoft.FSharp.Collections let rec existsOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> false + | MapNode(_,_,_,_,0) -> false | MapNode(k2,v2,l,r,_) -> existsOpt f l || f.Invoke(k2, v2) || existsOpt f r let exists f m = existsOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m let rec forallOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> true + | MapNode(_,_,_,_,0) -> true | MapNode(k2,v2,l,r,_) -> forallOpt f l && f.Invoke(k2, v2) && forallOpt f r let forall f m = forallOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m let rec map f m = match m with - | MapEmpty -> empty + | MapNode(_,_,_,_,0) -> Constants.Empty | MapNode(k,v,l,r,h) -> let l2 = map f l let v2 = f v @@ -227,7 +213,7 @@ namespace Microsoft.FSharp.Collections let rec mapiOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> empty + | MapNode(_,_,_,_,0) -> Constants.Empty | MapNode(k,v,l,r,h) -> let l2 = mapiOpt f l let v2 = f.Invoke(k, v) @@ -238,7 +224,7 @@ namespace Microsoft.FSharp.Collections let rec foldBackOpt (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = match m with - | MapEmpty -> x + | MapNode(_,_,_,_,0) -> x | MapNode(k,v,l,r,_) -> let x = foldBackOpt f r x let x = f.Invoke(k,v,x) @@ -248,7 +234,7 @@ namespace Microsoft.FSharp.Collections let rec foldOpt (f:OptimizedClosures.FSharpFunc<_,_,_,_>) x m = match m with - | MapEmpty -> x + | MapNode(_,_,_,_,0) -> x | MapNode(k,v,l,r,_) -> let x = foldOpt f x l let x = f.Invoke(x,k,v) @@ -259,7 +245,7 @@ namespace Microsoft.FSharp.Collections let foldSectionOpt (comparer: IComparer<'Value>) lo hi (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = let rec foldFromTo (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = match m with - | MapEmpty -> x + | MapNode(_,_,_,_,0) -> x | MapNode(k,v,l,r,_) -> let cLoKey = comparer.Compare(lo,k) let cKeyHi = comparer.Compare(k,hi) @@ -294,7 +280,7 @@ namespace Microsoft.FSharp.Collections let constructViaArray comparer (data:seq<'Key*'Value>) = let array = data |> Seq.toArray - if array.Length = 0 then MapEmpty + if array.Length = 0 then Constants.Empty else let keys = array |> Array.map fst @@ -312,7 +298,7 @@ namespace Microsoft.FSharp.Collections else let right = loop (mid+1) upper if mid = lower then - mk MapEmpty k v right + mk Constants.Empty k v right else let left = loop lower (mid-1) mk left k v right @@ -322,7 +308,7 @@ namespace Microsoft.FSharp.Collections let toList m = let rec loop m acc = match m with - | MapEmpty -> acc + | MapNode(_,_,_,_,0) -> acc | MapNode(k,v,l,r,_) -> loop l ((k,v)::loop r acc) loop m [] @@ -335,7 +321,7 @@ namespace Microsoft.FSharp.Collections largeObjectHeapBytes * 10 / 9 / sizeof<'Key*'Value> / 2 let ofList comparer (l:list<'Key*'Value>) = - if l |> List.isEmpty then empty + if l |> List.isEmpty then Constants.Empty else let chunk = ResizeArray () let maxCount = maxInitializationObjectCount<'Key, 'Value> () @@ -351,7 +337,7 @@ namespace Microsoft.FSharp.Collections remainder |> List.fold (fun acc (k,v) -> add comparer k v acc) chunkTree let ofSeqlImpl comparer (e:IEnumerator<'Key*'Value>) = - if not (e.MoveNext()) then empty + if not (e.MoveNext()) then Constants.Empty else let chunk = ResizeArray () let maxCount = maxInitializationObjectCount<'Key, 'Value> () @@ -406,9 +392,9 @@ namespace Microsoft.FSharp.Collections let rec collapseLHS stack = match stack with | [] -> [] - | MapEmpty :: rest -> collapseLHS rest - | MapNode(_,_,MapEmpty,MapEmpty,_) :: _ -> stack - | (MapNode(k,v,l,r,_)) :: rest -> collapseLHS (l :: (mkLeaf k v) :: r :: rest) + | MapNode(_,_,_,_,0) :: rest -> collapseLHS rest + | MapNode(_,_,MapNode(_,_,_,_,0),MapNode(_,_,_,_,0),_) :: _ -> stack + | MapNode(k,v,l,r,_) :: rest -> collapseLHS (l :: (mkLeaf k v) :: r :: rest) let mkIterator s = { stack = collapseLHS [s]; started = false } @@ -418,7 +404,7 @@ namespace Microsoft.FSharp.Collections let current i = if i.started then match i.stack with - | MapNode(k,v,MapEmpty,MapEmpty,_) :: _ -> new KeyValuePair<_,_>(k,v) + | MapNode(k,v,MapNode(_,_,_,_,0),MapNode(_,_,_,_,0),_) :: _ -> new KeyValuePair<_,_>(k,v) | [] -> alreadyFinished() | _ -> failwith "Please report error: Map iterator, unexpected stack for current" else @@ -427,7 +413,7 @@ namespace Microsoft.FSharp.Collections let rec moveNext i = if i.started then match i.stack with - | MapNode(_,_,MapEmpty,MapEmpty,_) :: rest -> + | MapNode(_,_,MapNode(_,_,_,_,0),MapNode(_,_,_,_,0),_) :: rest -> i.stack <- collapseLHS rest not i.stack.IsEmpty | [] -> false @@ -476,7 +462,7 @@ namespace Microsoft.FSharp.Collections // set (it is just a lookup into a .NET table of type-instantiation-indexed static fields). static let empty = let comparer = LanguagePrimitives.FastGenericComparer<'Key> - new Map<'Key,'Value>(comparer,MapTree<_,_>.MapEmpty) + new Map<'Key,'Value>(comparer,MapTree.Constants.Empty) #if !FX_NO_BINARY_SERIALIZATION [] From d20d48fc9d6374feb0559c29dcf1f1bd13454b49 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Thu, 26 Jul 2018 19:02:50 +1000 Subject: [PATCH 53/64] manual selective inlining of rebalance in add --- src/fsharp/FSharp.Core/map.fs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index d7c7c0aefe1..bc467c378a7 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -89,9 +89,22 @@ namespace Microsoft.FSharp.Collections if s = 0 then mkLeaf k v else let c = comparer.Compare(k,k2) - if c < 0 then rebalance (add comparer k v l) k2 v2 r - elif c > 0 then rebalance l k2 v2 (add comparer k v r) - else MapNode(k,v,l,r,s) + if c < 0 then + let l' = add comparer k v l + let l's, rs = size l', size r + if (l's >>> 1) > rs then + rebalanceLeft l' k2 v2 r + else + MapNode (k2,v2,l',r, l's+rs+1) + elif c > 0 then + let r' = add comparer k v r + let ls, r's = size l, size r' + if (r's >>> 1) > ls then + rebalanceRight l k2 v2 r' + else + MapNode (k2,v2,l,r', ls+r's+1) + else + MapNode(k,v,l,r,s) let rec find (comparer: IComparer<'Value>) k m = match m with From cb0ac57cd3103bd7b0b7d7b406c35d026a438f0b Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 28 Jul 2018 10:27:54 +1000 Subject: [PATCH 54/64] Only access members when necessary - measurable performance diff for find's inner loop --- src/fsharp/FSharp.Core/map.fs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index bc467c378a7..0c3dfde73a9 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -106,14 +106,13 @@ namespace Microsoft.FSharp.Collections else MapNode(k,v,l,r,s) - let rec find (comparer: IComparer<'Value>) k m = - match m with - | MapNode(_,_,_,_,0) -> raise (KeyNotFoundException()) - | MapNode(k2,v2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then find comparer k l - elif c = 0 then v2 - else find comparer k r + let rec find (comparer: IComparer<'Value>) k (MapNode(k2,_,_,_,s) as m) = + if s = 0 then raise (KeyNotFoundException ()) + + let c = comparer.Compare(k,k2) + if c < 0 then match m with MapNode(_,_,l,_,_) -> find comparer k l + elif c > 0 then match m with MapNode(_,_,_,r,_) -> find comparer k r + else match m with MapNode(_,v2,_,_,_) -> v2 let rec tryFind (comparer: IComparer<'Value>) k m = match m with From ec978d1ed8d6c9e31e6178097d2cc21e42caf7f5 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 28 Jul 2018 16:46:04 +1000 Subject: [PATCH 55/64] Consolidated find functionality --- src/fsharp/FSharp.Core/map.fs | 50 ++++++++++++++++------------------- 1 file changed, 23 insertions(+), 27 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 0c3dfde73a9..701a4d3e404 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -85,7 +85,7 @@ namespace Microsoft.FSharp.Collections elif (ls >>> 1) > rs then rebalanceLeft l k v r else MapNode (k,v,l,r, ls+rs+1) - let rec add (comparer: IComparer<'Value>) k v (MapNode(k2,v2,l,r,s)) = + let rec add (comparer:IComparer<'Key>) k v (MapNode(k2,v2,l,r,s)) = if s = 0 then mkLeaf k v else let c = comparer.Compare(k,k2) @@ -106,27 +106,23 @@ namespace Microsoft.FSharp.Collections else MapNode(k,v,l,r,s) - let rec find (comparer: IComparer<'Value>) k (MapNode(k2,_,_,_,s) as m) = - if s = 0 then raise (KeyNotFoundException ()) - - let c = comparer.Compare(k,k2) - if c < 0 then match m with MapNode(_,_,l,_,_) -> find comparer k l - elif c > 0 then match m with MapNode(_,_,_,r,_) -> find comparer k r - else match m with MapNode(_,v2,_,_,_) -> v2 + let inline private findImpl (comparer:IComparer<'Key>) k m found notfound = + let rec loop (MapNode(k2,_,_,_,s) as m) = + if s = 0 then notfound () + else + let c = comparer.Compare(k,k2) + if c < 0 then match m with MapNode(_,_,l,_,_) -> loop l + elif c > 0 then match m with MapNode(_,_,_,r,_) -> loop r + else match m with MapNode(_,v2,_,_,_) -> found v2 + loop m - let rec tryFind (comparer: IComparer<'Value>) k m = - match m with - | MapNode(_,_,_,_,0) -> None - | MapNode(k2,v2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then tryFind comparer k l - elif c = 0 then Some v2 - else tryFind comparer k r + let find comparer k m = findImpl comparer k m id (fun () -> raise (KeyNotFoundException ())) + let tryFind comparer k m = findImpl comparer k m Some (fun () -> None) - let partition1 (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) k v (acc1,acc2) = + let partition1 (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) k v (acc1,acc2) = if f.Invoke(k, v) then (add comparer k v acc1,acc2) else (acc1,add comparer k v acc2) - let rec partitionAux (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = + let rec partitionAux (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with | MapNode(_,_,_,_,0) -> acc | MapNode(k,v,l,r,_) -> @@ -134,11 +130,11 @@ namespace Microsoft.FSharp.Collections let acc = partition1 comparer f k v acc partitionAux comparer f l acc - let partition (comparer: IComparer<'Value>) f s = partitionAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s (Constants.Empty,Constants.Empty) + let partition (comparer:IComparer<'Key>) f s = partitionAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s (Constants.Empty,Constants.Empty) - let filter1 (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) k v acc = if f.Invoke(k, v) then add comparer k v acc else acc + let filter1 (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) k v acc = if f.Invoke(k, v) then add comparer k v acc else acc - let rec filterAux (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = + let rec filterAux (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with | MapNode(_,_,_,_,0) -> acc | MapNode(k,v,l,r,_) -> @@ -146,7 +142,7 @@ namespace Microsoft.FSharp.Collections let acc = filter1 comparer f k v acc filterAux comparer f r acc - let filter (comparer: IComparer<'Value>) f s = filterAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s Constants.Empty + let filter (comparer:IComparer<'Key>) f s = filterAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s Constants.Empty let rec spliceOutSuccessor m = match m with @@ -156,7 +152,7 @@ namespace Microsoft.FSharp.Collections | MapNode(_,_,_,_,0) -> k2,v2,r | _ -> let k3,v3,l' = spliceOutSuccessor l in k3,v3,mk l' k2 v2 r - let rec remove (comparer: IComparer<'Value>) k m = + let rec remove (comparer:IComparer<'Key>) k m = match m with | MapNode(_,_,_,_,0) -> Constants.Empty | MapNode(k2,v2,l,r,_) -> @@ -171,7 +167,7 @@ namespace Microsoft.FSharp.Collections mk l sk sv r' else rebalance l k2 v2 (remove comparer k r) - let rec mem (comparer: IComparer<'Value>) k m = + let rec mem (comparer:IComparer<'Key>) k m = match m with | MapNode(_,_,_,_,0) -> false | MapNode(k2,_,l,r,_) -> @@ -254,7 +250,7 @@ namespace Microsoft.FSharp.Collections let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f)) x m - let foldSectionOpt (comparer: IComparer<'Value>) lo hi (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = + let foldSectionOpt (comparer:IComparer<'Key>) lo hi (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = let rec foldFromTo (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = match m with | MapNode(_,_,_,_,0) -> x @@ -268,7 +264,7 @@ namespace Microsoft.FSharp.Collections if comparer.Compare(lo,hi) = 1 then x else foldFromTo f m x - let foldSection (comparer: IComparer<'Value>) lo hi f m x = + let foldSection (comparer:IComparer<'Key>) lo hi f m x = foldSectionOpt comparer lo hi (OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f)) m x // create a mapping function which indexes the array, but with duplicate values removed @@ -452,7 +448,7 @@ namespace Microsoft.FSharp.Collections [] [] [] - type Map<[]'Key,[]'Value when 'Key : comparison >(comparer: IComparer<'Key>, tree: MapTree<'Key,'Value>) = + type Map<[]'Key,[]'Value when 'Key : comparison >(comparer:IComparer<'Key>, tree: MapTree<'Key,'Value>) = #if !FX_NO_BINARY_SERIALIZATION [] From 5e1ff834a79ae102dd3189dbe5da225ef112de7d Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sat, 28 Jul 2018 16:53:43 +1000 Subject: [PATCH 56/64] Labelled MapNode fields --- src/fsharp/FSharp.Core/map.fs | 60 +++++++++++++++++------------------ 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 701a4d3e404..0c59772c20a 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -10,7 +10,7 @@ namespace Microsoft.FSharp.Collections [] type MapTree<'Key,'Value when 'Key : comparison > = - | MapNode of 'Key * 'Value * MapTree<'Key,'Value> * MapTree<'Key,'Value> * int + | MapNode of Key:'Key * Value:'Value * Left:MapTree<'Key,'Value> * Right:MapTree<'Key,'Value> * Size:int [] module MapTree = @@ -52,9 +52,9 @@ namespace Microsoft.FSharp.Collections static let empty = MapNode(Unchecked.defaultof<'Key>, Unchecked.defaultof<'Value>, Unchecked.defaultof>, Unchecked.defaultof>, 0) static member Empty = empty - let inline size (MapNode(_,_,_,_,s)) = s + let inline size (MapNode(Size=s)) = s - let inline isEmpty (MapNode(_,_,_,_,s)) = s = 0 + let inline isEmpty (MapNode(Size=s)) = s = 0 let inline mk l k v r = MapNode (k,v,l,r, size l + size r + 1) @@ -86,7 +86,7 @@ namespace Microsoft.FSharp.Collections else MapNode (k,v,l,r, ls+rs+1) let rec add (comparer:IComparer<'Key>) k v (MapNode(k2,v2,l,r,s)) = - if s = 0 then mkLeaf k v + if s = 0 then mkLeaf k v else let c = comparer.Compare(k,k2) if c < 0 then @@ -107,13 +107,13 @@ namespace Microsoft.FSharp.Collections MapNode(k,v,l,r,s) let inline private findImpl (comparer:IComparer<'Key>) k m found notfound = - let rec loop (MapNode(k2,_,_,_,s) as m) = + let rec loop (MapNode(Key=k2;Size=s) as m) = if s = 0 then notfound () else let c = comparer.Compare(k,k2) - if c < 0 then match m with MapNode(_,_,l,_,_) -> loop l - elif c > 0 then match m with MapNode(_,_,_,r,_) -> loop r - else match m with MapNode(_,v2,_,_,_) -> found v2 + if c < 0 then match m with MapNode(Left=l) -> loop l + elif c > 0 then match m with MapNode(Right=r) -> loop r + else match m with MapNode(Value=v2) -> found v2 loop m let find comparer k m = findImpl comparer k m id (fun () -> raise (KeyNotFoundException ())) @@ -124,7 +124,7 @@ namespace Microsoft.FSharp.Collections let rec partitionAux (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with - | MapNode(_,_,_,_,0) -> acc + | MapNode(Size=0) -> acc | MapNode(k,v,l,r,_) -> let acc = partitionAux comparer f r acc let acc = partition1 comparer f k v acc @@ -136,7 +136,7 @@ namespace Microsoft.FSharp.Collections let rec filterAux (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with - | MapNode(_,_,_,_,0) -> acc + | MapNode(Size=0) -> acc | MapNode(k,v,l,r,_) -> let acc = filterAux comparer f l acc let acc = filter1 comparer f k v acc @@ -146,22 +146,22 @@ namespace Microsoft.FSharp.Collections let rec spliceOutSuccessor m = match m with - | MapNode(_,_,_,_,0) -> failwith "internal error: Map.spliceOutSuccessor" + | MapNode(Size=0) -> failwith "internal error: Map.spliceOutSuccessor" | MapNode(k2,v2,l,r,_) -> match l with - | MapNode(_,_,_,_,0) -> k2,v2,r + | MapNode(Size=0) -> k2,v2,r | _ -> let k3,v3,l' = spliceOutSuccessor l in k3,v3,mk l' k2 v2 r let rec remove (comparer:IComparer<'Key>) k m = match m with - | MapNode(_,_,_,_,0) -> Constants.Empty + | MapNode(Size=0) -> Constants.Empty | MapNode(k2,v2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (remove comparer k l) k2 v2 r elif c = 0 then match l,r with - | MapNode(_,_,_,_,0),_ -> r - | _,MapNode(_,_,_,_,0) -> l + | MapNode(Size=0),_ -> r + | _,MapNode(Size=0) -> l | _ -> let sk,sv,r' = spliceOutSuccessor r mk l sk sv r' @@ -169,7 +169,7 @@ namespace Microsoft.FSharp.Collections let rec mem (comparer:IComparer<'Key>) k m = match m with - | MapNode(_,_,_,_,0) -> false + | MapNode(Size=0) -> false | MapNode(k2,_,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then mem comparer k l @@ -177,14 +177,14 @@ namespace Microsoft.FSharp.Collections let rec iterOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapNode(_,_,_,_,0) -> () + | MapNode(Size=0) -> () | MapNode(k2,v2,l,r,_) -> iterOpt f l; f.Invoke(k2, v2); iterOpt f r let iter f m = iterOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m let rec tryPickOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapNode(_,_,_,_,0) -> None + | MapNode(Size=0) -> None | MapNode(k2,v2,l,r,_) -> match tryPickOpt f l with | Some _ as res -> res @@ -198,21 +198,21 @@ namespace Microsoft.FSharp.Collections let rec existsOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapNode(_,_,_,_,0) -> false + | MapNode(Size=0) -> false | MapNode(k2,v2,l,r,_) -> existsOpt f l || f.Invoke(k2, v2) || existsOpt f r let exists f m = existsOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m let rec forallOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapNode(_,_,_,_,0) -> true + | MapNode(Size=0) -> true | MapNode(k2,v2,l,r,_) -> forallOpt f l && f.Invoke(k2, v2) && forallOpt f r let forall f m = forallOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m let rec map f m = match m with - | MapNode(_,_,_,_,0) -> Constants.Empty + | MapNode(Size=0) -> Constants.Empty | MapNode(k,v,l,r,h) -> let l2 = map f l let v2 = f v @@ -221,7 +221,7 @@ namespace Microsoft.FSharp.Collections let rec mapiOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapNode(_,_,_,_,0) -> Constants.Empty + | MapNode(Size=0) -> Constants.Empty | MapNode(k,v,l,r,h) -> let l2 = mapiOpt f l let v2 = f.Invoke(k, v) @@ -232,7 +232,7 @@ namespace Microsoft.FSharp.Collections let rec foldBackOpt (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = match m with - | MapNode(_,_,_,_,0) -> x + | MapNode(Size=0) -> x | MapNode(k,v,l,r,_) -> let x = foldBackOpt f r x let x = f.Invoke(k,v,x) @@ -242,7 +242,7 @@ namespace Microsoft.FSharp.Collections let rec foldOpt (f:OptimizedClosures.FSharpFunc<_,_,_,_>) x m = match m with - | MapNode(_,_,_,_,0) -> x + | MapNode(Size=0) -> x | MapNode(k,v,l,r,_) -> let x = foldOpt f x l let x = f.Invoke(x,k,v) @@ -253,7 +253,7 @@ namespace Microsoft.FSharp.Collections let foldSectionOpt (comparer:IComparer<'Key>) lo hi (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = let rec foldFromTo (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = match m with - | MapNode(_,_,_,_,0) -> x + | MapNode(Size=0) -> x | MapNode(k,v,l,r,_) -> let cLoKey = comparer.Compare(lo,k) let cKeyHi = comparer.Compare(k,hi) @@ -316,7 +316,7 @@ namespace Microsoft.FSharp.Collections let toList m = let rec loop m acc = match m with - | MapNode(_,_,_,_,0) -> acc + | MapNode(Size=0) -> acc | MapNode(k,v,l,r,_) -> loop l ((k,v)::loop r acc) loop m [] @@ -400,8 +400,8 @@ namespace Microsoft.FSharp.Collections let rec collapseLHS stack = match stack with | [] -> [] - | MapNode(_,_,_,_,0) :: rest -> collapseLHS rest - | MapNode(_,_,MapNode(_,_,_,_,0),MapNode(_,_,_,_,0),_) :: _ -> stack + | MapNode(Size=0) :: rest -> collapseLHS rest + | MapNode(_,_,MapNode(Size=0),MapNode(Size=0),_) :: _ -> stack | MapNode(k,v,l,r,_) :: rest -> collapseLHS (l :: (mkLeaf k v) :: r :: rest) let mkIterator s = { stack = collapseLHS [s]; started = false } @@ -412,7 +412,7 @@ namespace Microsoft.FSharp.Collections let current i = if i.started then match i.stack with - | MapNode(k,v,MapNode(_,_,_,_,0),MapNode(_,_,_,_,0),_) :: _ -> new KeyValuePair<_,_>(k,v) + | MapNode(k,v,MapNode(Size=0),MapNode(Size=0),_) :: _ -> new KeyValuePair<_,_>(k,v) | [] -> alreadyFinished() | _ -> failwith "Please report error: Map iterator, unexpected stack for current" else @@ -421,7 +421,7 @@ namespace Microsoft.FSharp.Collections let rec moveNext i = if i.started then match i.stack with - | MapNode(_,_,MapNode(_,_,_,_,0),MapNode(_,_,_,_,0),_) :: rest -> + | MapNode(_,_,MapNode(Size=0),MapNode(Size=0),_) :: rest -> i.stack <- collapseLHS rest not i.stack.IsEmpty | [] -> false From bede57733663b00cf545951636617e1668fd1120 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sun, 29 Jul 2018 12:26:23 +1000 Subject: [PATCH 57/64] Revamped enumeration to create less garbage. Faster on 64-bit, slower on 32-bit. --- src/fsharp/FSharp.Core/map.fs | 152 +++++++++++++++------------------- 1 file changed, 67 insertions(+), 85 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 0c59772c20a..b7a00c7d4da 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -52,7 +52,11 @@ namespace Microsoft.FSharp.Collections static let empty = MapNode(Unchecked.defaultof<'Key>, Unchecked.defaultof<'Value>, Unchecked.defaultof>, Unchecked.defaultof>, 0) static member Empty = empty - let inline size (MapNode(Size=s)) = s + let inline size (MapNode(Size=s)) = s + let inline key (MapNode(Key=k)) = k + let inline value (MapNode(Value=v)) = v + let inline left (MapNode(Left=l)) = l + let inline right (MapNode(Right=r)) = r let inline isEmpty (MapNode(Size=s)) = s = 0 @@ -313,37 +317,12 @@ namespace Microsoft.FSharp.Collections loop 0 (count-1) - let toList m = - let rec loop m acc = - match m with - | MapNode(Size=0) -> acc - | MapNode(k,v,l,r,_) -> loop l ((k,v)::loop r acc) - loop m [] - - let toArray m = m |> toList |> Array.ofList - [] let largeObjectHeapBytes = 85000 let maxInitializationObjectCount<'Key, 'Value> () = largeObjectHeapBytes * 10 / 9 / sizeof<'Key*'Value> / 2 - let ofList comparer (l:list<'Key*'Value>) = - if l |> List.isEmpty then Constants.Empty - else - let chunk = ResizeArray () - let maxCount = maxInitializationObjectCount<'Key, 'Value> () - let rec populate x = - match x with - | [] -> x - | hd::tl -> - chunk.Add hd - if chunk.Count = maxCount then tl - else populate tl - let remainder = populate l - let chunkTree = constructViaArray comparer chunk - remainder |> List.fold (fun acc (k,v) -> add comparer k v acc) chunkTree - let ofSeqlImpl comparer (e:IEnumerator<'Key*'Value>) = if not (e.MoveNext()) then Constants.Empty else @@ -368,6 +347,12 @@ namespace Microsoft.FSharp.Collections else acc addRemainder chunkTree + + let ofList comparer (l:list<'Key*'Value>) = + match l with + | [] -> Constants.Empty + | l when (List.length l) <= (maxInitializationObjectCount<'Key, 'Value> ()) -> constructViaArray comparer l + | _ -> ofSeqlImpl comparer ((l:>seq<_>).GetEnumerator ()) let ofArray comparer (arr : array<_>) = constructViaArray comparer arr @@ -376,72 +361,67 @@ namespace Microsoft.FSharp.Collections match c with | :? array<'Key * 'T> as xs -> ofArray comparer xs | :? list<'Key * 'T> as xs -> ofList comparer xs - | _ -> - use ie = c.GetEnumerator() - ofSeqlImpl comparer ie - + | _ -> ofSeqlImpl comparer (c.GetEnumerator()) let copyToArray s (arr: _[]) i = let j = ref i s |> iter (fun x y -> arr.[!j] <- KeyValuePair(x,y); j := !j + 1) + + [] + type TreeIterator<'Key,'Value when 'Key : comparison>(root) = + let items = ResizeArray> () + let mutable depth = 0 + + let rec tryPush item = + if size item > 0 then + if depth = items.Count then + items.Add item + else + items.[depth] <- item + depth <- depth + 1 + tryPush (left item) - /// Imperative left-to-right iterators. - [] - type MapIterator<'Key,'Value when 'Key : comparison > = - { /// invariant: always collapseLHS result - mutable stack: MapTree<'Key,'Value> list; - /// true when MoveNext has been called - mutable started : bool } - - // collapseLHS: - // a) Always returns either [] or a list starting with MapOne. - // b) The "fringe" of the set stack is unchanged. - let rec collapseLHS stack = - match stack with - | [] -> [] - | MapNode(Size=0) :: rest -> collapseLHS rest - | MapNode(_,_,MapNode(Size=0),MapNode(Size=0),_) :: _ -> stack - | MapNode(k,v,l,r,_) :: rest -> collapseLHS (l :: (mkLeaf k v) :: r :: rest) - - let mkIterator s = { stack = collapseLHS [s]; started = false } + do tryPush root - let notStarted() = raise (InvalidOperationException(SR.GetString(SR.enumerationNotStarted))) - let alreadyFinished() = raise (InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))) + member inline __.PopCurrent f = + depth <- depth - 1 + match items.[depth] with + | MapNode(k,v,_,r,_) -> + tryPush r + f k v - let current i = - if i.started then - match i.stack with - | MapNode(k,v,MapNode(Size=0),MapNode(Size=0),_) :: _ -> new KeyValuePair<_,_>(k,v) - | [] -> alreadyFinished() - | _ -> failwith "Please report error: Map iterator, unexpected stack for current" - else - notStarted() - - let rec moveNext i = - if i.started then - match i.stack with - | MapNode(_,_,MapNode(Size=0),MapNode(Size=0),_) :: rest -> - i.stack <- collapseLHS rest - not i.stack.IsEmpty - | [] -> false - | _ -> failwith "Please report error: Map iterator, unexpected stack for moveNext" - else - i.started <- true (* The first call to MoveNext "starts" the enumeration. *) - not i.stack.IsEmpty - - let mkIEnumerator s = - let i = ref (mkIterator s) - { new IEnumerator<_> with - member __.Current = current !i - interface System.Collections.IEnumerator with - member __.Current = box (current !i) - member __.MoveNext() = moveNext !i - member __.Reset() = i := mkIterator s - interface System.IDisposable with - member __.Dispose() = ()} + member __.MorePairs = depth > 0 + + let inline private getEnumerable f m = + seq { let iterator = TreeIterator<_,_> m + while iterator.MorePairs do + yield iterator.PopCurrent f } + let tryGetSmallEnumerable m = + match m with + | MapNode(Size=0) -> Seq.empty + | MapNode(k,v,_,_,1) -> [ KeyValuePair (k,v) ] :> seq<_> + | MapNode(k,v,MapNode(lk,lv,_,_,1),_,2) -> [| KeyValuePair (lk,lv); KeyValuePair (k,v) |] :> seq<_> + | MapNode(k,v,_,MapNode(rk,rv,_,_,1),2) -> [| KeyValuePair (k,v); KeyValuePair (rk,rv) |] :> seq<_> + | MapNode(k,v,MapNode(lk,lv,_,_,1),MapNode(rk,rv,_,_,1),3) -> [| KeyValuePair (lk,lv); KeyValuePair (k,v); KeyValuePair (rk,rv) |] :> seq<_> + | _ -> null + + let getKVEnumerable m = + match tryGetSmallEnumerable m with + | null -> getEnumerable (fun k v -> KeyValuePair (k, v)) m + | small -> small + + let toSeq m = + getEnumerable (fun k v -> k, v) m + let toList m = + let iterator = TreeIterator<_,_> m + List.init (size m) (fun _ -> iterator.PopCurrent (fun k v -> k, v)) + + let toArray m = + let iterator = TreeIterator<_,_> m + Array.init (size m) (fun _ -> iterator.PopCurrent (fun k v -> k, v)) [>)>] [] @@ -568,6 +548,8 @@ namespace Microsoft.FSharp.Collections #endif MapTree.tryFind comparer key tree + member m.ToSeq() = MapTree.toSeq tree + member m.ToList() = MapTree.toList tree member m.ToArray() = MapTree.toArray tree @@ -599,10 +581,10 @@ namespace Microsoft.FSharp.Collections override this.GetHashCode() = this.ComputeHashCode() interface IEnumerable> with - member __.GetEnumerator() = MapTree.mkIEnumerator tree + member __.GetEnumerator() = (MapTree.getKVEnumerable tree).GetEnumerator() interface System.Collections.IEnumerable with - member __.GetEnumerator() = (MapTree.mkIEnumerator tree :> System.Collections.IEnumerator) + member __.GetEnumerator() = (((MapTree.getKVEnumerable tree).GetEnumerator()) :> System.Collections.IEnumerator) interface IDictionary<'Key, 'Value> with member m.Item @@ -739,7 +721,7 @@ namespace Microsoft.FSharp.Collections let foldBack<'Key,'T,'State when 'Key : comparison> folder (table:Map<'Key,'T>) (state:'State) = MapTree.foldBack folder table.Tree state [] - let toSeq (table:Map<_,_>) = table |> Seq.map (fun kvp -> kvp.Key, kvp.Value) + let toSeq (table:Map<_,_>) = table.ToSeq() [] let findKey predicate (table : Map<_,_>) = table |> toSeq |> Seq.pick (fun (k,v) -> if predicate k v then Some(k) else None) From 3b8385602a960fff7728ee084c3e04f5f4d273ad Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sun, 29 Jul 2018 13:14:33 +1000 Subject: [PATCH 58/64] Added Checked logic to ensure size constraint isn't violated --- src/fsharp/FSharp.Core/map.fs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index b7a00c7d4da..d9b3345dff2 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -60,8 +60,10 @@ namespace Microsoft.FSharp.Collections let inline isEmpty (MapNode(Size=s)) = s = 0 + let inline (++) l r = Checked.(+) l r + let inline mk l k v r = - MapNode (k,v,l,r, size l + size r + 1) + MapNode (k,v,l,r, size l ++ size r ++ 1) let inline mkLeaf k v = MapNode (k, v, Constants.Empty, Constants.Empty, 1) @@ -87,7 +89,7 @@ namespace Microsoft.FSharp.Collections let ls, rs = size l, size r if (rs >>> 1) > ls then rebalanceRight l k v r elif (ls >>> 1) > rs then rebalanceLeft l k v r - else MapNode (k,v,l,r, ls+rs+1) + else MapNode (k,v,l,r, ls ++ rs ++ 1) let rec add (comparer:IComparer<'Key>) k v (MapNode(k2,v2,l,r,s)) = if s = 0 then mkLeaf k v @@ -99,14 +101,14 @@ namespace Microsoft.FSharp.Collections if (l's >>> 1) > rs then rebalanceLeft l' k2 v2 r else - MapNode (k2,v2,l',r, l's+rs+1) + MapNode (k2,v2,l',r, l's ++ rs ++ 1) elif c > 0 then let r' = add comparer k v r let ls, r's = size l, size r' if (r's >>> 1) > ls then rebalanceRight l k2 v2 r' else - MapNode (k2,v2,l,r', ls+r's+1) + MapNode (k2,v2,l,r', ls ++ r's ++ 1) else MapNode(k,v,l,r,s) From 4ab22c97c7fff6395e8775a6267e30d4e352e916 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sun, 29 Jul 2018 13:19:34 +1000 Subject: [PATCH 59/64] findImpl use helper functions to clean up --- src/fsharp/FSharp.Core/map.fs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index d9b3345dff2..fc9be5783db 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -113,13 +113,13 @@ namespace Microsoft.FSharp.Collections MapNode(k,v,l,r,s) let inline private findImpl (comparer:IComparer<'Key>) k m found notfound = - let rec loop (MapNode(Key=k2;Size=s) as m) = - if s = 0 then notfound () + let rec loop m = + if (size m) = 0 then notfound () else - let c = comparer.Compare(k,k2) - if c < 0 then match m with MapNode(Left=l) -> loop l - elif c > 0 then match m with MapNode(Right=r) -> loop r - else match m with MapNode(Value=v2) -> found v2 + let c = comparer.Compare(k, key m) + if c < 0 then loop (left m) + elif c > 0 then loop (right m) + else found (value m) loop m let find comparer k m = findImpl comparer k m id (fun () -> raise (KeyNotFoundException ())) From a3d49c76101825ac21d1468ee3abe296e43d1079 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Sun, 29 Jul 2018 16:04:29 +1000 Subject: [PATCH 60/64] Made the non-(to|of)(Seq|List|Array) Map changes to the TaggedCollections version --- src/utils/TaggedCollections.fs | 311 +++++++++++---------------------- 1 file changed, 102 insertions(+), 209 deletions(-) diff --git a/src/utils/TaggedCollections.fs b/src/utils/TaggedCollections.fs index 232d3b75053..6eb89d326c7 100644 --- a/src/utils/TaggedCollections.fs +++ b/src/utils/TaggedCollections.fs @@ -701,196 +701,137 @@ namespace Internal.Utilities.Collections.Tagged Set<_,_>(comparer=comparer, tree=SetTree.ofSeq comparer l) - [] [] - type MapTree<'Key,'T> = - | MapEmpty -#if ONE - | MapOne of 'Key * 'T -#endif - | MapNode of 'Key * 'T * MapTree<'Key,'T> * MapTree<'Key,'T> * int + type MapTree<'Key,'Value> = + | MapNode of Key:'Key * Value:'Value * Left:MapTree<'Key,'Value> * Right:MapTree<'Key,'Value> * Size:int [] module MapTree = - let empty = MapEmpty - - let inline height x = - match x with - | MapEmpty -> 0 -#if ONE - | MapOne _ -> 1 -#endif - | MapNode(_,_,_,_,h) -> h - - let inline isEmpty m = - match m with - | MapEmpty -> true - | _ -> false - - let inline mk l k v r = -#if ONE - match l,r with - | MapEmpty,MapEmpty -> MapOne(k,v) - | _ -> -#endif - let hl = height l - let hr = height r - let m = if hl < hr then hr else hl - MapNode(k,v,l,r,m+1) - - let rebalance t1 k v t2 = - let t1h = height t1 - let t2h = height t2 - if t2h > t1h + 2 then // right is heavier than left - match t2 with - | MapNode(t2k,t2v,t2l,t2r,_) -> - // one of the nodes must have height > height t1 + 1 - if height t2l > t1h + 1 then // balance left: combination - match t2l with - | MapNode(t2lk,t2lv,t2ll,t2lr,_) -> - mk (mk t1 k v t2ll) t2lk t2lv (mk t2lr t2k t2v t2r) - | _ -> failwith "rebalance" - else // rotate left - mk (mk t1 k v t2l) t2k t2v t2r - | _ -> failwith "rebalance" + [] + type Constants<'Key, 'Value> private () = + static let empty = MapNode(Unchecked.defaultof<'Key>, Unchecked.defaultof<'Value>, Unchecked.defaultof>, Unchecked.defaultof>, 0) + static member Empty = empty + + let inline size (MapNode(Size=s)) = s + let inline key (MapNode(Key=k)) = k + let inline value (MapNode(Value=v)) = v + let inline left (MapNode(Left=l)) = l + let inline right (MapNode(Right=r)) = r + + let inline isEmpty (MapNode(Size=s)) = s = 0 + + let inline (++) l r = Checked.(+) l r + + let inline mk l k v r = + MapNode (k,v,l,r, size l ++ size r ++ 1) + + let inline mkLeaf k v = + MapNode (k, v, Constants.Empty, Constants.Empty, 1) + + let private rebalanceRight l k v (MapNode(rk,rv,rl,rr,_)) = + (* one of the nodes must have height > height t1 + 1 *) + if size rl > size l then (* balance left: combination *) + match rl with + | MapNode(rlk,rlv,rll,rlr,_) -> mk (mk l k v rll) rlk rlv (mk rlr rk rv rr) + else (* rotate left *) + mk (mk l k v rl) rk rv rr + + let private rebalanceLeft (MapNode(lk,lv,ll,lr,_)) k v r = + (* one of the nodes must have height > height t2 + 1 *) + if size lr > size r then + (* balance right: combination *) + match lr with + | MapNode(lrk,lrv,lrl,lrr,_) -> mk (mk ll lk lv lrl) lrk lrv (mk lrr k v r) else - if t1h > t2h + 2 then // left is heavier than right - match t1 with - | MapNode(t1k,t1v,t1l,t1r,_) -> - // one of the nodes must have height > height t2 + 1 - if height t1r > t2h + 1 then - // balance right: combination - match t1r with - | MapNode(t1rk,t1rv,t1rl,t1rr,_) -> - mk (mk t1l t1k t1v t1rl) t1rk t1rv (mk t1rr k v t2) - | _ -> failwith "rebalance" - else - mk t1l t1k t1v (mk t1r k v t2) - | _ -> failwith "rebalance" - else mk t1 k v t2 - - let rec sizeAux acc m = - match m with - | MapEmpty -> acc -#if ONE - | MapOne _ -> acc + 1 -#endif - | MapNode(_,_,l,r,_) -> sizeAux (sizeAux (acc+1) l) r + mk ll lk lv (mk lr k v r) -#if ONE -#else - let MapOne(k,v) = MapNode(k,v,MapEmpty,MapEmpty,1) -#endif - - let count x = sizeAux 0 x + let inline rebalance l k v r = + let ls, rs = size l, size r + if (rs >>> 1) > ls then rebalanceRight l k v r + elif (ls >>> 1) > rs then rebalanceLeft l k v r + else MapNode (k,v,l,r, ls ++ rs ++ 1) - let rec add (comparer: IComparer<'T>) k v m = - match m with - | MapEmpty -> MapOne(k,v) -#if ONE - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c < 0 then MapNode (k,v,MapEmpty,m,2) - elif c = 0 then MapOne(k,v) - else MapNode (k,v,m,MapEmpty,2) -#endif - | MapNode(k2,v2,l,r,h) -> + let rec add (comparer:IComparer<'Key>) k v (MapNode(k2,v2,l,r,s)) = + if s = 0 then mkLeaf k v + else let c = comparer.Compare(k,k2) - if c < 0 then rebalance (add comparer k v l) k2 v2 r - elif c = 0 then MapNode(k,v,l,r,h) - else rebalance l k2 v2 (add comparer k v r) + if c < 0 then + let l' = add comparer k v l + let l's, rs = size l', size r + if (l's >>> 1) > rs then + rebalanceLeft l' k2 v2 r + else + MapNode (k2,v2,l',r, l's ++ rs ++ 1) + elif c > 0 then + let r' = add comparer k v r + let ls, r's = size l, size r' + if (r's >>> 1) > ls then + rebalanceRight l k2 v2 r' + else + MapNode (k2,v2,l,r', ls ++ r's ++ 1) + else + MapNode(k,v,l,r,s) let indexNotFound() = raise (new System.Collections.Generic.KeyNotFoundException("An index satisfying the predicate was not found in the collection")) - let rec find (comparer: IComparer<'T>) k m = - match m with - | MapEmpty -> indexNotFound() -#if ONE - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then v2 - else indexNotFound() -#endif - | MapNode(k2,v2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then find comparer k l - elif c = 0 then v2 - else find comparer k r + let inline private findImpl (comparer:IComparer<'Key>) k m found notfound = + let rec loop m = + if (size m) = 0 then notfound () + else + let c = comparer.Compare(k, key m) + if c < 0 then loop (left m) + elif c > 0 then loop (right m) + else found (value m) + loop m - let rec tryFind (comparer: IComparer<'T>) k m = - match m with - | MapEmpty -> None -#if ONE - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then Some v2 - else None -#endif - | MapNode(k2,v2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then tryFind comparer k l - elif c = 0 then Some v2 - else tryFind comparer k r + let find comparer k m = findImpl comparer k m id (fun () -> indexNotFound()) + let tryFind comparer k m = findImpl comparer k m Some (fun () -> None) let partition1 (comparer: IComparer<'T>) f k v (acc1,acc2) = if f k v then (add comparer k v acc1,acc2) else (acc1,add comparer k v acc2) let rec partitionAux (comparer: IComparer<'T>) f s acc = match s with - | MapEmpty -> acc -#if ONE - | MapOne(k,v) -> partition1 comparer f k v acc -#endif + | MapNode(Size=0) -> acc | MapNode(k,v,l,r,_) -> let acc = partitionAux comparer f r acc let acc = partition1 comparer f k v acc partitionAux comparer f l acc - let partition (comparer: IComparer<'T>) f s = partitionAux comparer f s (empty,empty) + let partition (comparer: IComparer<'T>) f s = partitionAux comparer f s (Constants.Empty,Constants.Empty) let filter1 (comparer: IComparer<'T>) f k v acc = if f k v then add comparer k v acc else acc let rec filterAux (comparer: IComparer<'T>) f s acc = match s with - | MapEmpty -> acc -#if ONE - | MapOne(k,v) -> filter1 comparer f k v acc -#endif + | MapNode(Size=0) -> acc | MapNode(k,v,l,r,_) -> let acc = filterAux comparer f l acc let acc = filter1 comparer f k v acc filterAux comparer f r acc - let filter (comparer: IComparer<'T>) f s = filterAux comparer f s empty + let filter (comparer: IComparer<'T>) f s = filterAux comparer f s Constants.Empty let rec spliceOutSuccessor m = match m with - | MapEmpty -> failwith "internal error: Map.splice_out_succ_or_pred" -#if ONE - | MapOne(k2,v2) -> k2,v2,MapEmpty -#endif + | MapNode(Size=0) -> failwith "internal error: Map.splice_out_succ_or_pred" | MapNode(k2,v2,l,r,_) -> match l with - | MapEmpty -> k2,v2,r + | MapNode(Size=0) -> k2,v2,r | _ -> let k3,v3,l' = spliceOutSuccessor l in k3,v3,mk l' k2 v2 r let rec remove (comparer: IComparer<'T>) k m = match m with - | MapEmpty -> empty -#if ONE - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then MapEmpty else m -#endif + | MapNode(Size=0) -> Constants.Empty | MapNode(k2,v2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (remove comparer k l) k2 v2 r elif c = 0 then match l,r with - | MapEmpty,_ -> r - | _,MapEmpty -> l + | MapNode(Size=0),_ -> r + | _,MapNode(Size=0) -> l | _ -> let sk,sv,r' = spliceOutSuccessor r mk l sk sv r' @@ -898,10 +839,7 @@ namespace Internal.Utilities.Collections.Tagged let rec containsKey (comparer: IComparer<'T>) k m = match m with - | MapEmpty -> false -#if ONE - | MapOne(k2,v2) -> (comparer.Compare(k,k2) = 0) -#endif + | MapNode(Size=0) -> false | MapNode(k2,_,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then containsKey comparer k l @@ -909,18 +847,12 @@ namespace Internal.Utilities.Collections.Tagged let rec iter f m = match m with - | MapEmpty -> () -#if ONE - | MapOne(k2,v2) -> f k2 v2 -#endif + | MapNode(Size=0) -> () | MapNode(k2,v2,l,r,_) -> iter f l; f k2 v2; iter f r let rec first f m = match m with - | MapEmpty -> None -#if ONE - | MapOne(k2,v2) -> f k2 v2 -#endif + | MapNode(Size=0) -> None | MapNode(k2,v2,l,r,_) -> match first f l with | Some _ as res -> res @@ -931,34 +863,22 @@ namespace Internal.Utilities.Collections.Tagged let rec exists f m = match m with - | MapEmpty -> false -#if ONE - | MapOne(k2,v2) -> f k2 v2 -#endif + | MapNode(Size=0) -> false | MapNode(k2,v2,l,r,_) -> f k2 v2 || exists f l || exists f r let rec forAll f m = match m with - | MapEmpty -> true -#if ONE - | MapOne(k2,v2) -> f k2 v2 -#endif + | MapNode(Size=0) -> true | MapNode(k2,v2,l,r,_) -> f k2 v2 && forAll f l && forAll f r let rec map f m = match m with - | MapEmpty -> empty -#if ONE - | MapOne(k,v) -> MapOne(k,f v) -#endif + | MapNode(Size=0) -> Constants.Empty | MapNode(k,v,l,r,h) -> let v2 = f v in MapNode(k,v2,map f l, map f r,h) let rec mapi f m = match m with - | MapEmpty -> empty -#if ONE - | MapOne(k,v) -> MapOne(k,f k v) -#endif + | MapNode(Size=0) -> Constants.Empty | MapNode(k,v,l,r,h) -> let v2 = f k v in MapNode(k,v2, mapi f l, mapi f r,h) // Fold, right-to-left. @@ -966,23 +886,13 @@ namespace Internal.Utilities.Collections.Tagged // NOTE: This differs from the behaviour of Set.fold which folds left-to-right. let rec fold f m x = match m with - | MapEmpty -> x -#if ONE - | MapOne(k,v) -> f k v x -#endif + | MapNode(Size=0) -> x | MapNode(k,v,l,r,_) -> fold f l (f k v (fold f r x)) let foldSection (comparer: IComparer<'T>) lo hi f m x = let rec fold_from_to f m x = match m with - | MapEmpty -> x -#if ONE - | MapOne(k,v) -> - let clo_k = comparer.Compare(lo,k) - let ck_hi = comparer.Compare(k,hi) - let x = if clo_k <= 0 && ck_hi <= 0 then f k v x else x - x -#endif + | MapNode(Size=0) -> x | MapNode(k,v,l,r,_) -> let clo_k = comparer.Compare(lo,k) let ck_hi = comparer.Compare(k,hi) @@ -995,12 +905,7 @@ namespace Internal.Utilities.Collections.Tagged let rec foldMap (comparer: IComparer<'T>) f m z acc = match m with - | MapEmpty -> acc,z -#if ONE - | MapOne(k,v) -> - let v',z = f k v z - add comparer k v' acc,z -#endif + | MapNode(Size=0) -> acc,z | MapNode(k,v,l,r,_) -> let acc,z = foldMap comparer f r z acc let v',z = f k v z @@ -1009,7 +914,7 @@ namespace Internal.Utilities.Collections.Tagged let toList m = fold (fun k v acc -> (k,v) :: acc) m [] let toArray m = m |> toList |> Array.ofList - let ofList comparer l = List.fold (fun acc (k,v) -> add comparer k v acc) empty l + let ofList comparer l = List.fold (fun acc (k,v) -> add comparer k v acc) Constants.Empty l let rec mkFromEnumerator comparer acc (e : IEnumerator<_>) = @@ -1020,7 +925,7 @@ namespace Internal.Utilities.Collections.Tagged let ofSeq comparer (c : seq<_>) = use ie = c.GetEnumerator() - mkFromEnumerator comparer empty ie + mkFromEnumerator comparer Constants.Empty ie let copyToArray s (arr: _[]) i = let j = ref i @@ -1035,13 +940,9 @@ namespace Internal.Utilities.Collections.Tagged let rec collapseLHS stack = match stack with | [] -> [] - | MapEmpty :: rest -> collapseLHS rest -#if ONE - | MapOne _ :: _ -> stack -#else - | (MapNode(_,_,MapEmpty,MapEmpty,_)) :: _ -> stack -#endif - | (MapNode(k,v,l,r,_)) :: rest -> collapseLHS (l :: MapOne (k,v) :: r :: rest) + | MapNode(Size=0) :: rest -> collapseLHS rest + | (MapNode(_,_,MapNode(Size=0),MapNode(Size=0),_)) :: _ -> stack + | (MapNode(k,v,l,r,_)) :: rest -> collapseLHS (l :: (mkLeaf k v) :: r :: rest) /// invariant: always collapseLHS result let mutable stack = collapseLHS [s] @@ -1054,11 +955,7 @@ namespace Internal.Utilities.Collections.Tagged member i.Current = if started then match stack with -#if ONE - | MapOne (k,v) :: _ -> new KeyValuePair<_,_>(k,v) -#else - | (MapNode(k,v,MapEmpty,MapEmpty,_)) :: _ -> new KeyValuePair<_,_>(k,v) -#endif + | (MapNode(k,v,MapNode(Size=0),MapNode(Size=0),_)) :: _ -> new KeyValuePair<_,_>(k,v) | [] -> alreadyFinished() | _ -> failwith "Please report error: Map iterator, unexpected stack for current" else @@ -1067,11 +964,7 @@ namespace Internal.Utilities.Collections.Tagged member i.MoveNext() = if started then match stack with -#if ONE - | MapOne _ :: rest -> -#else - | (MapNode(_,_,MapEmpty,MapEmpty,_)) :: rest -> -#endif + | (MapNode(_,_,MapNode(Size=0),MapNode(Size=0),_)) :: rest -> stack <- collapseLHS rest; not stack.IsEmpty | [] -> false @@ -1103,7 +996,7 @@ namespace Internal.Utilities.Collections.Tagged member s.Tree = tree member s.Comparer : IComparer<'Key> = comparer - static member Empty(comparer : 'ComparerTag) = Map<'Key,'T,'ComparerTag>(comparer=comparer, tree=MapTree.empty) + static member Empty(comparer : 'ComparerTag) = Map<'Key,'T,'ComparerTag>(comparer=comparer, tree=MapTree.Constants.Empty) member m.Add(k,v) = refresh m (MapTree.add comparer k v tree) member m.IsEmpty = MapTree.isEmpty tree member m.Item with get(k : 'Key) = MapTree.find comparer k tree @@ -1114,7 +1007,7 @@ namespace Internal.Utilities.Collections.Tagged member m.Fold f acc = MapTree.fold f tree acc member m.FoldSection lo hi f acc = MapTree.foldSection comparer lo hi f tree acc member m.FoldAndMap f z = - let tree,z = MapTree.foldMap comparer f tree z MapTree.empty + let tree,z = MapTree.foldMap comparer f tree z MapTree.Constants.Empty refresh m tree, z member m.Iterate f = MapTree.iter f tree member m.MapRange f = refresh m (MapTree.map f tree) @@ -1122,7 +1015,7 @@ namespace Internal.Utilities.Collections.Tagged member m.Partition(f) = let r1,r2 = MapTree.partition comparer f tree refresh m r1, refresh m r2 - member m.Count = MapTree.count tree + member m.Count = MapTree.size tree member m.ContainsKey(k) = MapTree.containsKey comparer k tree member m.Remove(k) = refresh m (MapTree.remove comparer k tree) member m.TryFind(k) = MapTree.tryFind comparer k tree From 4b0fc384f0d7fa41ec4bca15eafa913ddcbe3fb8 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 30 Jul 2018 17:47:00 +1000 Subject: [PATCH 61/64] Removed SetOne --- src/fsharp/FSharp.Core/set.fs | 69 +++++------------------------------ 1 file changed, 9 insertions(+), 60 deletions(-) diff --git a/src/fsharp/FSharp.Core/set.fs b/src/fsharp/FSharp.Core/set.fs index 85c04a2c241..8ee68bcc900 100644 --- a/src/fsharp/FSharp.Core/set.fs +++ b/src/fsharp/FSharp.Core/set.fs @@ -18,7 +18,6 @@ namespace Microsoft.FSharp.Collections type SetTree<'T> when 'T: comparison = | SetEmpty // height = 0 | SetNode of 'T * SetTree<'T> * SetTree<'T> * int // height = int - | SetOne of 'T // height = 1 // OPTIMIZATION: store SetNode(k,SetEmpty,SetEmpty,1) ---> SetOne(k) // REVIEW: performance rumour has it that the data held in SetNode and SetOne should be // exactly one cache line on typical architectures. They are currently @@ -30,7 +29,6 @@ namespace Microsoft.FSharp.Collections let rec countAux s acc = match s with | SetNode(_,l,r,_) -> countAux l (countAux r (acc+1)) - | SetOne(_) -> acc+1 | SetEmpty -> acc let count s = countAux s 0 @@ -64,7 +62,6 @@ namespace Microsoft.FSharp.Collections totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (count n); n #else - let SetOne n = SetTree.SetOne n let SetNode (x,l,r,h) = SetTree.SetNode(x,l,r,h) #endif @@ -73,7 +70,6 @@ namespace Microsoft.FSharp.Collections let height t = match t with | SetEmpty -> 0 - | SetOne _ -> 1 | SetNode (_,_,_,h) -> h #if CHECKED @@ -88,11 +84,14 @@ namespace Microsoft.FSharp.Collections (-2 <= (h1 - h2) && (h1 - h2) <= 2) && checkInvariant t1 && checkInvariant t2 #endif + let inline mkLeaf k = + SetNode (k, SetEmpty, SetEmpty, 1) + let tolerance = 2 let mk l k r = match l,r with - | SetEmpty,SetEmpty -> SetOne (k) + | SetEmpty,SetEmpty -> mkLeaf k | _ -> let hl = height l let hr = height r @@ -137,13 +136,7 @@ namespace Microsoft.FSharp.Collections if c < 0 then rebalance (add comparer k l) k2 r elif c = 0 then t else rebalance l k2 (add comparer k r) - | SetOne(k2) -> - // nb. no check for rebalance needed for small trees, also be sure to reuse node already allocated - let c = comparer.Compare(k,k2) - if c < 0 then SetNode (k,SetEmpty,t,2) - elif c = 0 then t - else SetNode (k,t,SetEmpty,2) - | SetEmpty -> SetOne(k) + | SetEmpty -> mkLeaf k let rec balance comparer t1 k t2 = // Given t1 < k < t2 where t1 and t2 are "balanced", @@ -152,8 +145,6 @@ namespace Microsoft.FSharp.Collections match t1,t2 with | SetEmpty,t2 -> add comparer k t2 // drop t1 = empty | t1,SetEmpty -> add comparer k t1 // drop t2 = empty - | SetOne k1,t2 -> add comparer k (add comparer k1 t2) - | t1,SetOne k2 -> add comparer k (add comparer k2 t1) | SetNode(k1,t11,t12,h1),SetNode(k2,t21,t22,h2) -> // Have: (t11 < k1 < t12) < k < (t21 < k2 < t22) // Either (a) h1,h2 differ by at most 2 - no rebalance needed. @@ -185,18 +176,12 @@ namespace Microsoft.FSharp.Collections else // pivot t2 let t12Lo,havePivot,t12Hi = split comparer pivot t12 balance comparer t11 k1 t12Lo,havePivot,t12Hi - | SetOne k1 -> - let c = comparer.Compare(k1,pivot) - if c < 0 then t ,false,SetEmpty // singleton under pivot - elif c = 0 then SetEmpty,true ,SetEmpty // singleton is pivot - else SetEmpty,false,t // singleton over pivot | SetEmpty -> SetEmpty,false,SetEmpty let rec spliceOutSuccessor t = match t with | SetEmpty -> failwith "internal error: Set.spliceOutSuccessor" - | SetOne (k2) -> k2,SetEmpty | SetNode (k2,l,r,_) -> match l with | SetEmpty -> k2,r @@ -205,10 +190,6 @@ namespace Microsoft.FSharp.Collections let rec remove (comparer: IComparer<'T>) k t = match t with | SetEmpty -> t - | SetOne (k2) -> - let c = comparer.Compare(k,k2) - if c = 0 then SetEmpty - else t | SetNode (k2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (remove comparer k l) k2 r @@ -228,19 +209,16 @@ namespace Microsoft.FSharp.Collections if c < 0 then mem comparer k l elif c = 0 then true else mem comparer k r - | SetOne(k2) -> (comparer.Compare(k,k2) = 0) | SetEmpty -> false let rec iter f t = match t with | SetNode(k2,l,r,_) -> iter f l; f k2; iter f r - | SetOne(k2) -> f k2 | SetEmpty -> () let rec foldBackOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m x = match m with | SetNode(k,l,r,_) -> foldBackOpt f l (f.Invoke(k, (foldBackOpt f r x))) - | SetOne(k) -> f.Invoke(k, x) | SetEmpty -> x let foldBack f m x = foldBackOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m x @@ -251,7 +229,6 @@ namespace Microsoft.FSharp.Collections let x = foldOpt f x l in let x = f.Invoke(x, k) foldOpt f x r - | SetOne(k) -> f.Invoke(x, k) | SetEmpty -> x let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) x m @@ -259,13 +236,11 @@ namespace Microsoft.FSharp.Collections let rec forall f m = match m with | SetNode(k2,l,r,_) -> f k2 && forall f l && forall f r - | SetOne(k2) -> f k2 | SetEmpty -> true let rec exists f m = match m with | SetNode(k2,l,r,_) -> f k2 || exists f l || exists f r - | SetOne(k2) -> f k2 | SetEmpty -> false let isEmpty m = match m with | SetEmpty -> true | _ -> false @@ -279,7 +254,6 @@ namespace Microsoft.FSharp.Collections | SetNode(k,l,r,_) -> let acc = if f k then add comparer k acc else acc filterAux comparer f l (filterAux comparer f r acc) - | SetOne(k) -> if f k then add comparer k acc else acc | SetEmpty -> acc let filter comparer f s = filterAux comparer f s SetEmpty @@ -290,7 +264,6 @@ namespace Microsoft.FSharp.Collections | _ -> match m with | SetNode(k,l,r,_) -> diffAux comparer l (diffAux comparer r (remove comparer k acc)) - | SetOne(k) -> remove comparer k acc | SetEmpty -> acc let diff comparer a b = diffAux comparer b a @@ -311,8 +284,6 @@ namespace Microsoft.FSharp.Collections balance comparer (union comparer t21 lo) k2 (union comparer t22 hi) | SetEmpty,t -> t | t,SetEmpty -> t - | SetOne k1,t2 -> add comparer k1 t2 - | t1,SetOne k2 -> add comparer k2 t1 let rec intersectionAux comparer b m acc = match m with @@ -320,8 +291,6 @@ namespace Microsoft.FSharp.Collections let acc = intersectionAux comparer b r acc let acc = if mem comparer k b then add comparer k acc else acc intersectionAux comparer b l acc - | SetOne(k) -> - if mem comparer k b then add comparer k acc else acc | SetEmpty -> acc let intersection comparer a b = intersectionAux comparer b a SetEmpty @@ -334,7 +303,6 @@ namespace Microsoft.FSharp.Collections let acc = partitionAux comparer f r acc let acc = partition1 comparer f k acc partitionAux comparer f l acc - | SetOne(k) -> partition1 comparer f k acc | SetEmpty -> acc let partition comparer f s = partitionAux comparer f s (SetEmpty,SetEmpty) @@ -343,31 +311,26 @@ namespace Microsoft.FSharp.Collections let (|MatchSetNode|MatchSetEmpty|) s = match s with | SetNode(k2,l,r,_) -> MatchSetNode(k2,l,r) - | SetOne(k2) -> MatchSetNode(k2,SetEmpty,SetEmpty) | SetEmpty -> MatchSetEmpty let rec minimumElementAux s n = match s with | SetNode(k,l,_,_) -> minimumElementAux l k - | SetOne(k) -> k | SetEmpty -> n and minimumElementOpt s = match s with | SetNode(k,l,_,_) -> Some(minimumElementAux l k) - | SetOne(k) -> Some k | SetEmpty -> None and maximumElementAux s n = match s with | SetNode(k,_,r,_) -> maximumElementAux r k - | SetOne(k) -> k | SetEmpty -> n and maximumElementOpt s = match s with | SetNode(k,_,r,_) -> Some(maximumElementAux r k) - | SetOne(k) -> Some(k) | SetEmpty -> None let minimumElement s = @@ -398,8 +361,8 @@ namespace Microsoft.FSharp.Collections match stack with | [] -> [] | SetEmpty :: rest -> collapseLHS rest - | SetOne _ :: _ -> stack - | SetNode(k,l,r,_) :: rest -> collapseLHS (l :: SetOne k :: r :: rest) + | SetNode(_,_,_,1) :: _ -> stack + | SetNode(k,l,r,_) :: rest -> collapseLHS (l :: (mkLeaf k) :: r :: rest) let mkIterator s = { stack = collapseLHS [s]; started = false } @@ -409,7 +372,7 @@ namespace Microsoft.FSharp.Collections let current i = if i.started then match i.stack with - | SetOne k :: _ -> k + | SetNode(k,_,_,1) :: _ -> k | [] -> alreadyFinished() | _ -> failwith "Please report error: Set iterator, unexpected stack for current" else @@ -418,7 +381,7 @@ namespace Microsoft.FSharp.Collections let rec moveNext i = if i.started then match i.stack with - | SetOne _ :: rest -> + | SetNode(_,_,_,1) :: rest -> i.stack <- collapseLHS rest; not i.stack.IsEmpty | [] -> false @@ -448,24 +411,11 @@ namespace Microsoft.FSharp.Collections | [],_ -> -1 | _ ,[] -> 1 | (SetEmpty _ :: t1),(SetEmpty :: t2) -> compareStacks comparer t1 t2 - | (SetOne(n1k) :: t1),(SetOne(n2k) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer t1 t2 - | (SetOne(n1k) :: t1),(SetNode(n2k,SetEmpty,n2r,_) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer (SetEmpty :: t1) (n2r :: t2) - | (SetNode(n1k,(SetEmpty as emp),n1r,_) :: t1),(SetOne(n2k) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer (n1r :: t1) (emp :: t2) | (SetNode(n1k,SetEmpty,n1r,_) :: t1),(SetNode(n2k,SetEmpty,n2r,_) :: t2) -> let c = comparer.Compare(n1k,n2k) if c <> 0 then c else compareStacks comparer (n1r :: t1) (n2r :: t2) - | (SetOne(n1k) :: t1),_ -> - compareStacks comparer (SetEmpty :: SetOne(n1k) :: t1) l2 | (SetNode(n1k,n1l,n1r,_) :: t1),_ -> compareStacks comparer (n1l :: SetNode(n1k,SetEmpty,n1r,0) :: t1) l2 - | _,(SetOne(n2k) :: t2) -> - compareStacks comparer l1 (SetEmpty :: SetOne(n2k) :: t2) | _,(SetNode(n2k,n2l,n2r,_) :: t2) -> compareStacks comparer l1 (n2l :: SetNode(n2k,SetEmpty,n2r,0) :: t2) @@ -482,7 +432,6 @@ namespace Microsoft.FSharp.Collections let rec loop m acc = match m with | SetNode(k,l,r,_) -> loop l (k :: loop r acc) - | SetOne(k) -> k ::acc | SetEmpty -> acc loop s [] From e91c10ecff704dae178d5dec1b909f445e2992a6 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Mon, 30 Jul 2018 19:06:31 +1000 Subject: [PATCH 62/64] Converted Set's height to size --- src/fsharp/FSharp.Core/set.fs | 43 +++++++++++++---------------------- 1 file changed, 16 insertions(+), 27 deletions(-) diff --git a/src/fsharp/FSharp.Core/set.fs b/src/fsharp/FSharp.Core/set.fs index 8ee68bcc900..be2f6e283b7 100644 --- a/src/fsharp/FSharp.Core/set.fs +++ b/src/fsharp/FSharp.Core/set.fs @@ -17,7 +17,7 @@ namespace Microsoft.FSharp.Collections [] type SetTree<'T> when 'T: comparison = | SetEmpty // height = 0 - | SetNode of 'T * SetTree<'T> * SetTree<'T> * int // height = int + | SetNode of 'T * SetTree<'T> * SetTree<'T> * Size:int // OPTIMIZATION: store SetNode(k,SetEmpty,SetEmpty,1) ---> SetOne(k) // REVIEW: performance rumour has it that the data held in SetNode and SetOne should be // exactly one cache line on typical architectures. They are currently @@ -26,13 +26,6 @@ namespace Microsoft.FSharp.Collections [] module internal SetTree = - let rec countAux s acc = - match s with - | SetNode(_,l,r,_) -> countAux l (countAux r (acc+1)) - | SetEmpty -> acc - - let count s = countAux s 0 - #if TRACE_SETS_AND_MAPS let mutable traceCount = 0 let mutable numOnes = 0 @@ -67,10 +60,10 @@ namespace Microsoft.FSharp.Collections #endif - let height t = + let size t = match t with | SetEmpty -> 0 - | SetNode (_,_,_,h) -> h + | SetNode (Size=s) -> s #if CHECKED let rec checkInvariant t = @@ -87,25 +80,21 @@ namespace Microsoft.FSharp.Collections let inline mkLeaf k = SetNode (k, SetEmpty, SetEmpty, 1) - let tolerance = 2 + let inline (++) l r = Checked.(+) l r let mk l k r = match l,r with | SetEmpty,SetEmpty -> mkLeaf k - | _ -> - let hl = height l - let hr = height r - let m = if hl < hr then hr else hl - SetNode(k,l,r,m+1) + | _ -> SetNode(k,l,r,(size l) ++ (size r) + 1) let rebalance t1 k t2 = - let t1h = height t1 - let t2h = height t2 - if t2h > t1h + tolerance then // right is heavier than left + let t1s = size t1 + let t2s = size t2 + if (t2s >>> 1) > t1s then // right is heavier than left match t2 with | SetNode(t2k,t2l,t2r,_) -> // one of the nodes must have height > height t1 + 1 - if height t2l > t1h + 1 then // balance left: combination + if size t2l > t1s then // balance left: combination match t2l with | SetNode(t2lk,t2ll,t2lr,_) -> mk (mk t1 k t2ll) t2lk (mk t2lr t2k t2r) @@ -114,11 +103,11 @@ namespace Microsoft.FSharp.Collections mk (mk t1 k t2l) t2k t2r | _ -> failwith "rebalance" else - if t1h > t2h + tolerance then // left is heavier than right + if (t1s >>> 1) > t2s then // left is heavier than right match t1 with | SetNode(t1k,t1l,t1r,_) -> // one of the nodes must have height > height t2 + 1 - if height t1r > t2h + 1 then + if size t1r > t2s then // balance right: combination match t1r with | SetNode(t1rk,t1rl,t1rr,_) -> @@ -145,16 +134,16 @@ namespace Microsoft.FSharp.Collections match t1,t2 with | SetEmpty,t2 -> add comparer k t2 // drop t1 = empty | t1,SetEmpty -> add comparer k t1 // drop t2 = empty - | SetNode(k1,t11,t12,h1),SetNode(k2,t21,t22,h2) -> + | SetNode(k1,t11,t12,s1),SetNode(k2,t21,t22,s2) -> // Have: (t11 < k1 < t12) < k < (t21 < k2 < t22) // Either (a) h1,h2 differ by at most 2 - no rebalance needed. // (b) h1 too small, i.e. h1+2 < h2 // (c) h2 too small, i.e. h2+2 < h1 - if h1+tolerance < h2 then + if s1 < (s2 >>> 1) then // case: b, h1 too small // push t1 into low side of t2, may increase height by 1 so rebalance rebalance (balance comparer t1 k t21) k2 t22 - elif h2+tolerance < h1 then + elif s2 < (s1 >>> 1) then // case: c, h2 too small // push t2 into high side of t1, may increase height by 1 so rebalance rebalance t11 k1 (balance comparer t12 k t2) @@ -440,7 +429,7 @@ namespace Microsoft.FSharp.Collections iter (fun x -> arr.[!j] <- x; j := !j + 1) s let toArray s = - let n = (count s) + let n = size s let res = Array.zeroCreate n copyToArray s res 0; res @@ -531,7 +520,7 @@ namespace Microsoft.FSharp.Collections #endif Set<'T>(s.Comparer,SetTree.remove s.Comparer value s.Tree) - member s.Count = SetTree.count s.Tree + member s.Count = SetTree.size s.Tree member s.Contains(value) = #if TRACE_SETS_AND_MAPS From 074d90274a4e22cff0193c044437ae10133603e0 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 31 Jul 2018 19:30:35 +1000 Subject: [PATCH 63/64] Cut SetTree down to just SetNode --- src/fsharp/FSharp.Core/set.fs | 167 ++++++++++++++++------------------ 1 file changed, 76 insertions(+), 91 deletions(-) diff --git a/src/fsharp/FSharp.Core/set.fs b/src/fsharp/FSharp.Core/set.fs index be2f6e283b7..a3013ba7a51 100644 --- a/src/fsharp/FSharp.Core/set.fs +++ b/src/fsharp/FSharp.Core/set.fs @@ -13,16 +13,9 @@ namespace Microsoft.FSharp.Collections (* A classic functional language implementation of binary trees *) - [] [] type SetTree<'T> when 'T: comparison = - | SetEmpty // height = 0 | SetNode of 'T * SetTree<'T> * SetTree<'T> * Size:int - // OPTIMIZATION: store SetNode(k,SetEmpty,SetEmpty,1) ---> SetOne(k) - // REVIEW: performance rumour has it that the data held in SetNode and SetOne should be - // exactly one cache line on typical architectures. They are currently - // ~6 and 3 words respectively. - [] module internal SetTree = @@ -54,16 +47,14 @@ namespace Microsoft.FSharp.Collections let n = SetTree.SetNode(x,l,r,h) totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (count n); n - #else - let SetNode (x,l,r,h) = SetTree.SetNode(x,l,r,h) - #endif - - let size t = - match t with - | SetEmpty -> 0 - | SetNode (Size=s) -> s + [] + type Constants<'Key when 'Key : comparison> private () = + static let empty = SetNode(Unchecked.defaultof<'Key>, Unchecked.defaultof>, Unchecked.defaultof>, 0) + static member Empty = empty + + let size (SetNode (Size=s)) = s #if CHECKED let rec checkInvariant t = @@ -77,15 +68,11 @@ namespace Microsoft.FSharp.Collections (-2 <= (h1 - h2) && (h1 - h2) <= 2) && checkInvariant t1 && checkInvariant t2 #endif - let inline mkLeaf k = - SetNode (k, SetEmpty, SetEmpty, 1) - let inline (++) l r = Checked.(+) l r - let mk l k r = - match l,r with - | SetEmpty,SetEmpty -> mkLeaf k - | _ -> SetNode(k,l,r,(size l) ++ (size r) + 1) + let inline mkLeaf k = SetNode (k, Constants.Empty, Constants.Empty, 1) + + let inline mk l k r = SetNode(k,l,r,(size l) ++ (size r) + 1) let rebalance t1 k t2 = let t1s = size t1 @@ -98,10 +85,8 @@ namespace Microsoft.FSharp.Collections match t2l with | SetNode(t2lk,t2ll,t2lr,_) -> mk (mk t1 k t2ll) t2lk (mk t2lr t2k t2r) - | _ -> failwith "rebalance" else // rotate left mk (mk t1 k t2l) t2k t2r - | _ -> failwith "rebalance" else if (t1s >>> 1) > t2s then // left is heavier than right match t1 with @@ -112,28 +97,26 @@ namespace Microsoft.FSharp.Collections match t1r with | SetNode(t1rk,t1rl,t1rr,_) -> mk (mk t1l t1k t1rl) t1rk (mk t1rr k t2) - | _ -> failwith "rebalance" else mk t1l t1k (mk t1r k t2) - | _ -> failwith "rebalance" else mk t1 k t2 let rec add (comparer: IComparer<'T>) k t = match t with + | SetNode (Size=0) -> mkLeaf k | SetNode (k2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (add comparer k l) k2 r elif c = 0 then t else rebalance l k2 (add comparer k r) - | SetEmpty -> mkLeaf k let rec balance comparer t1 k t2 = // Given t1 < k < t2 where t1 and t2 are "balanced", // return a balanced tree for . // Recall: balance means subtrees heights differ by at most "tolerance" match t1,t2 with - | SetEmpty,t2 -> add comparer k t2 // drop t1 = empty - | t1,SetEmpty -> add comparer k t1 // drop t2 = empty + | SetNode (Size=0),t2 -> add comparer k t2 // drop t1 = empty + | t1,SetNode (Size=0) -> add comparer k t1 // drop t2 = empty | SetNode(k1,t11,t12,s1),SetNode(k2,t21,t22,s2) -> // Have: (t11 < k1 < t12) < k < (t21 < k2 < t22) // Either (a) h1,h2 differ by at most 2 - no rebalance needed. @@ -155,6 +138,8 @@ namespace Microsoft.FSharp.Collections // Given a pivot and a set t // Return { x in t s.t. x < pivot }, pivot in t? , { x in t s.t. x > pivot } match t with + | SetNode(Size=0) -> + Constants.Empty,false,Constants.Empty | SetNode(k1,t11,t12,_) -> let c = comparer.Compare(pivot,k1) if c < 0 then // pivot t1 @@ -165,27 +150,25 @@ namespace Microsoft.FSharp.Collections else // pivot t2 let t12Lo,havePivot,t12Hi = split comparer pivot t12 balance comparer t11 k1 t12Lo,havePivot,t12Hi - | SetEmpty -> - SetEmpty,false,SetEmpty let rec spliceOutSuccessor t = match t with - | SetEmpty -> failwith "internal error: Set.spliceOutSuccessor" + | SetNode(Size=0) -> failwith "internal error: Set.spliceOutSuccessor" | SetNode (k2,l,r,_) -> match l with - | SetEmpty -> k2,r + | SetNode(Size=0) -> k2,r | _ -> let k3,l' = spliceOutSuccessor l in k3,mk l' k2 r let rec remove (comparer: IComparer<'T>) k t = match t with - | SetEmpty -> t + | SetNode(Size=0) -> t | SetNode (k2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (remove comparer k l) k2 r elif c = 0 then match l,r with - | SetEmpty,_ -> r - | _,SetEmpty -> l + | SetNode(Size=0),_ -> r + | _,SetNode(Size=0) -> l | _ -> let sk,r' = spliceOutSuccessor r mk l sk r' @@ -193,46 +176,46 @@ namespace Microsoft.FSharp.Collections let rec mem (comparer: IComparer<'T>) k t = match t with + | SetNode(Size=0) -> false | SetNode(k2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then mem comparer k l elif c = 0 then true else mem comparer k r - | SetEmpty -> false let rec iter f t = match t with + | SetNode(Size=0) -> () | SetNode(k2,l,r,_) -> iter f l; f k2; iter f r - | SetEmpty -> () let rec foldBackOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m x = match m with + | SetNode(Size=0) -> x | SetNode(k,l,r,_) -> foldBackOpt f l (f.Invoke(k, (foldBackOpt f r x))) - | SetEmpty -> x let foldBack f m x = foldBackOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m x let rec foldOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) x m = match m with + | SetNode(Size=0) -> x | SetNode(k,l,r,_) -> let x = foldOpt f x l in let x = f.Invoke(x, k) foldOpt f x r - | SetEmpty -> x let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) x m let rec forall f m = match m with + | SetNode(Size=0) -> true | SetNode(k2,l,r,_) -> f k2 && forall f l && forall f r - | SetEmpty -> true let rec exists f m = match m with + | SetNode(Size=0) -> false | SetNode(k2,l,r,_) -> f k2 || exists f l || exists f r - | SetEmpty -> false - let isEmpty m = match m with | SetEmpty -> true | _ -> false + let isEmpty (SetNode(Size=s)) = s = 0 let subset comparer a b = forall (fun x -> mem comparer x b) a @@ -240,26 +223,28 @@ namespace Microsoft.FSharp.Collections let rec filterAux comparer f s acc = match s with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> let acc = if f k then add comparer k acc else acc filterAux comparer f l (filterAux comparer f r acc) - | SetEmpty -> acc - let filter comparer f s = filterAux comparer f s SetEmpty + let filter comparer f s = filterAux comparer f s Constants.Empty let rec diffAux comparer m acc = match acc with - | SetEmpty -> acc + | SetNode(Size=0) -> acc | _ -> match m with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> diffAux comparer l (diffAux comparer r (remove comparer k acc)) - | SetEmpty -> acc let diff comparer a b = diffAux comparer b a let rec union comparer t1 t2 = // Perf: tried bruteForce for low heights, but nothing significant match t1,t2 with + | SetNode(Size=0),t -> t + | t,SetNode(Size=0) -> t | SetNode(k1,t11,t12,h1),SetNode(k2,t21,t22,h2) -> // (t11 < k < t12) AND (t21 < k2 < t22) // Divide and Conquer: // Suppose t1 is largest. @@ -271,56 +256,54 @@ namespace Microsoft.FSharp.Collections else let lo,_,hi = split comparer k2 t1 in balance comparer (union comparer t21 lo) k2 (union comparer t22 hi) - | SetEmpty,t -> t - | t,SetEmpty -> t let rec intersectionAux comparer b m acc = match m with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> let acc = intersectionAux comparer b r acc let acc = if mem comparer k b then add comparer k acc else acc intersectionAux comparer b l acc - | SetEmpty -> acc - let intersection comparer a b = intersectionAux comparer b a SetEmpty + let intersection comparer a b = intersectionAux comparer b a Constants.Empty let partition1 comparer f k (acc1,acc2) = if f k then (add comparer k acc1,acc2) else (acc1,add comparer k acc2) let rec partitionAux comparer f s acc = match s with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> let acc = partitionAux comparer f r acc let acc = partition1 comparer f k acc partitionAux comparer f l acc - | SetEmpty -> acc - let partition comparer f s = partitionAux comparer f s (SetEmpty,SetEmpty) + let partition comparer f s = partitionAux comparer f s (Constants.Empty,Constants.Empty) - // It's easier to get many less-important algorithms right using this active pattern - let (|MatchSetNode|MatchSetEmpty|) s = - match s with - | SetNode(k2,l,r,_) -> MatchSetNode(k2,l,r) - | SetEmpty -> MatchSetEmpty + //// It's easier to get many less-important algorithms right using this active pattern + //let (|MatchSetNode|MatchSetEmpty|) s = + // match s with + // | SetNode(Size=0) -> MatchSetEmpty + // | SetNode(k2,l,r,_) -> MatchSetNode(k2,l,r) let rec minimumElementAux s n = match s with + | SetNode(Size=0) -> n | SetNode(k,l,_,_) -> minimumElementAux l k - | SetEmpty -> n and minimumElementOpt s = match s with + | SetNode(Size=0) -> None | SetNode(k,l,_,_) -> Some(minimumElementAux l k) - | SetEmpty -> None and maximumElementAux s n = match s with + | SetNode(Size=0) -> n | SetNode(k,_,r,_) -> maximumElementAux r k - | SetEmpty -> n and maximumElementOpt s = match s with + | SetNode(Size=0) -> None | SetNode(k,_,r,_) -> Some(maximumElementAux r k) - | SetEmpty -> None let minimumElement s = match minimumElementOpt s with @@ -349,7 +332,7 @@ namespace Microsoft.FSharp.Collections let rec collapseLHS stack = match stack with | [] -> [] - | SetEmpty :: rest -> collapseLHS rest + | SetNode(Size=0) :: rest -> collapseLHS rest | SetNode(_,_,_,1) :: _ -> stack | SetNode(k,l,r,_) :: rest -> collapseLHS (l :: (mkLeaf k) :: r :: rest) @@ -394,34 +377,36 @@ namespace Microsoft.FSharp.Collections // Set comparison. This can be expensive. //-------------------------------------------------------------------------- - let rec compareStacks (comparer: IComparer<'T>) l1 l2 = + let (^^) hd tl = + match hd with + | SetNode(Size=0) -> tl + | _ -> hd::tl + + let rec compareStacks (comparer:IComparer<'T>) l1 l2 = match l1,l2 with | [],[] -> 0 | [],_ -> -1 | _ ,[] -> 1 - | (SetEmpty _ :: t1),(SetEmpty :: t2) -> compareStacks comparer t1 t2 - | (SetNode(n1k,SetEmpty,n1r,_) :: t1),(SetNode(n2k,SetEmpty,n2r,_) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer (n1r :: t1) (n2r :: t2) - | (SetNode(n1k,n1l,n1r,_) :: t1),_ -> - compareStacks comparer (n1l :: SetNode(n1k,SetEmpty,n1r,0) :: t1) l2 - | _,(SetNode(n2k,n2l,n2r,_) :: t2) -> - compareStacks comparer l1 (n2l :: SetNode(n2k,SetEmpty,n2r,0) :: t2) + | (SetNode(n1k,SetNode(Size=0),n1r,_)::t1),(SetNode(n2k,SetNode(Size=0),n2r,_)::t2) -> + match comparer.Compare (n1k,n2k) with + | 0 -> compareStacks comparer (n1r ^^ t1) (n2r ^^ t2) + | c -> c + | (SetNode(n1k,(SetNode(Size=n1ls) as n1l),n1r,_)::t1),_ when n1ls > 0 -> + compareStacks comparer (n1l ^^ (mk Constants.Empty n1k n1r) ^^ t1) l2 + | _,(SetNode(n2k,n2l,n2r,_)::t2) -> + compareStacks comparer l1 (n2l ^^ (mk Constants.Empty n2k n2r) ^^ t2) - let compare comparer s1 s2 = - match s1,s2 with - | SetEmpty,SetEmpty -> 0 - | SetEmpty,_ -> -1 - | _,SetEmpty -> 1 - | _ -> compareStacks comparer [s1] [s2] + let compare comparer s1 s2 = + if obj.ReferenceEquals (s1,s2) then 0 + else compareStacks comparer (s1 ^^ []) (s2 ^^ []) let choose s = minimumElement s let toList s = let rec loop m acc = match m with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> loop l (k :: loop r acc) - | SetEmpty -> acc loop s [] let copyToArray s (arr: _[]) i = @@ -443,9 +428,9 @@ namespace Microsoft.FSharp.Collections let ofSeq comparer (c: IEnumerable<_>) = use ie = c.GetEnumerator() - mkFromEnumerator comparer SetEmpty ie + mkFromEnumerator comparer Constants.Empty ie - let ofArray comparer l = Array.fold (fun acc k -> add comparer k acc) SetEmpty l + let ofArray comparer l = Array.fold (fun acc k -> add comparer k acc) Constants.Empty l [] @@ -476,7 +461,7 @@ namespace Microsoft.FSharp.Collections static let empty: Set<'T> = let comparer = LanguagePrimitives.FastGenericComparer<'T> - Set<'T>(comparer, SetEmpty) + Set<'T>(comparer, SetTree.Constants.Empty) #if !FX_NO_BINARY_SERIALIZATION [] @@ -541,17 +526,17 @@ namespace Microsoft.FSharp.Collections member s.Partition f : Set<'T> * Set<'T> = match s.Tree with - | SetEmpty -> s,s + | SetNode(Size=0) -> s,s | _ -> let t1,t2 = SetTree.partition s.Comparer f s.Tree in Set(s.Comparer,t1), Set(s.Comparer,t2) member s.Filter f : Set<'T> = match s.Tree with - | SetEmpty -> s + | SetNode(Size=0) -> s | _ -> Set(s.Comparer,SetTree.filter s.Comparer f s.Tree) member s.Map f : Set<'U> = let comparer = LanguagePrimitives.FastGenericComparer<'U> - Set(comparer,SetTree.fold (fun acc k -> SetTree.add comparer (f k) acc) (SetTree<_>.SetEmpty) s.Tree) + Set(comparer,SetTree.fold (fun acc k -> SetTree.add comparer (f k) acc) SetTree.Constants.Empty s.Tree) member s.Exists f = SetTree.exists f s.Tree @@ -560,10 +545,10 @@ namespace Microsoft.FSharp.Collections [] static member (-) (set1: Set<'T>, set2: Set<'T>) = match set1.Tree with - | SetEmpty -> set1 (* 0 - B = 0 *) + | SetNode(Size=0) -> set1 (* 0 - B = 0 *) | _ -> match set2.Tree with - | SetEmpty -> set1 (* A - 0 = A *) + | SetNode(Size=0) -> set1 (* A - 0 = A *) | _ -> Set(set1.Comparer,SetTree.diff set1.Comparer set1.Tree set2.Tree) [] @@ -573,18 +558,18 @@ namespace Microsoft.FSharp.Collections SetTree.numUnions <- SetTree.numUnions + 1 #endif match set2.Tree with - | SetEmpty -> set1 (* A U 0 = A *) + | SetNode(Size=0) -> set1 (* A U 0 = A *) | _ -> match set1.Tree with - | SetEmpty -> set2 (* 0 U B = B *) + | SetNode(Size=0) -> set2 (* 0 U B = B *) | _ -> Set(set1.Comparer,SetTree.union set1.Comparer set1.Tree set2.Tree) static member Intersection(a: Set<'T>, b: Set<'T>) : Set<'T> = match b.Tree with - | SetEmpty -> b (* A INTER 0 = 0 *) + | SetNode(Size=0) -> b (* A INTER 0 = 0 *) | _ -> match a.Tree with - | SetEmpty -> a (* 0 INTER B = 0 *) + | SetNode(Size=0) -> a (* 0 INTER B = 0 *) | _ -> Set(a.Comparer,SetTree.intersection a.Comparer a.Tree b.Tree) static member Union(sets:seq>) : Set<'T> = From df2e8dd09726e86ef62b71b23f8c14bbf9bd540c Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Wed, 1 Aug 2018 19:31:41 +1000 Subject: [PATCH 64/64] rebalance split and add from Map --- src/fsharp/FSharp.Core/set.fs | 74 +++++++++++++++++++---------------- 1 file changed, 41 insertions(+), 33 deletions(-) diff --git a/src/fsharp/FSharp.Core/set.fs b/src/fsharp/FSharp.Core/set.fs index a3013ba7a51..8e476e0d40c 100644 --- a/src/fsharp/FSharp.Core/set.fs +++ b/src/fsharp/FSharp.Core/set.fs @@ -74,41 +74,49 @@ namespace Microsoft.FSharp.Collections let inline mk l k r = SetNode(k,l,r,(size l) ++ (size r) + 1) - let rebalance t1 k t2 = - let t1s = size t1 - let t2s = size t2 - if (t2s >>> 1) > t1s then // right is heavier than left - match t2 with - | SetNode(t2k,t2l,t2r,_) -> - // one of the nodes must have height > height t1 + 1 - if size t2l > t1s then // balance left: combination - match t2l with - | SetNode(t2lk,t2ll,t2lr,_) -> - mk (mk t1 k t2ll) t2lk (mk t2lr t2k t2r) - else // rotate left - mk (mk t1 k t2l) t2k t2r + let private rebalanceRight l k (SetNode(rk,rl,rr,_)) = + (* one of the nodes must have height > height t1 + 1 *) + if size rl > size l then (* balance left: combination *) + match rl with + | SetNode(rlk,rll,rlr,_) -> mk (mk l k rll) rlk (mk rlr rk rr) + else (* rotate left *) + mk (mk l k rl) rk rr + + let private rebalanceLeft (SetNode(lk,ll,lr,_)) k r = + (* one of the nodes must have height > height t2 + 1 *) + if size lr > size r then + (* balance right: combination *) + match lr with + | SetNode(lrk,lrl,lrr,_) -> mk (mk ll lk lrl) lrk (mk lrr k r) + else + mk ll lk (mk lr k r) + + let inline rebalance l k r = + let ls, rs = size l, size r + if (rs >>> 1) > ls then rebalanceRight l k r + elif (ls >>> 1) > rs then rebalanceLeft l k r + else SetNode (k,l,r, ls ++ rs ++ 1) + + let rec add (comparer:IComparer<'Key>) k (SetNode(k2,l,r,s)) = + if s = 0 then mkLeaf k else - if (t1s >>> 1) > t2s then // left is heavier than right - match t1 with - | SetNode(t1k,t1l,t1r,_) -> - // one of the nodes must have height > height t2 + 1 - if size t1r > t2s then - // balance right: combination - match t1r with - | SetNode(t1rk,t1rl,t1rr,_) -> - mk (mk t1l t1k t1rl) t1rk (mk t1rr k t2) - else - mk t1l t1k (mk t1r k t2) - else mk t1 k t2 - - let rec add (comparer: IComparer<'T>) k t = - match t with - | SetNode (Size=0) -> mkLeaf k - | SetNode (k2,l,r,_) -> let c = comparer.Compare(k,k2) - if c < 0 then rebalance (add comparer k l) k2 r - elif c = 0 then t - else rebalance l k2 (add comparer k r) + if c < 0 then + let l' = add comparer k l + let l's, rs = size l', size r + if (l's >>> 1) > rs then + rebalanceLeft l' k2 r + else + SetNode (k2,l',r, l's ++ rs ++ 1) + elif c > 0 then + let r' = add comparer k r + let ls, r's = size l, size r' + if (r's >>> 1) > ls then + rebalanceRight l k2 r' + else + SetNode (k2,l,r', ls ++ r's ++ 1) + else + SetNode(k,l,r,s) let rec balance comparer t1 k t2 = // Given t1 < k < t2 where t1 and t2 are "balanced",