From d80990a8ad016a6949ff015ab573bf52520d55b0 Mon Sep 17 00:00:00 2001
From: Paul Westcott
Date: Sun, 14 Feb 2016 12:10:17 +1100
Subject: [PATCH 1/3] Reverting #513
Removal of code related to creation of hash/equals/compare that had been
implemented in #513.
---
src/fsharp/FSharp.Core/prim-types.fs | 1567 +++-----------------------
1 file changed, 148 insertions(+), 1419 deletions(-)
diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs
index bf1168b597d..69b6a46b636 100644
--- a/src/fsharp/FSharp.Core/prim-types.fs
+++ b/src/fsharp/FSharp.Core/prim-types.fs
@@ -905,10 +905,7 @@ namespace Microsoft.FSharp.Core
let anyToStringShowingNull x = anyToString "null" x
module HashCompare =
- open System.Reflection
- open System.Linq.Expressions
- open System.Runtime.CompilerServices
-
+
//-------------------------------------------------------------------------
// LangaugePrimitives.HashCompare: Physical Equality
//-------------------------------------------------------------------------
@@ -952,20 +949,13 @@ namespace Microsoft.FSharp.Core
/// This type has two instances - fsComparerER and fsComparerThrow.
/// - fsComparerER = ER semantics = no throw on NaN comparison = new GenericComparer(false) = GenericComparer = GenericComparison
/// - fsComparerPER = PER semantics = local throw on NaN comparison = new GenericComparer(true) = LessThan/GreaterThan etc.
- type ComparerType =
- | ER = 0
- | PER_lt = 1
- | PER_gt = 2
-
- type GenericComparer(comparerType:ComparerType) =
+ type GenericComparer(throwsOnPER:bool) =
interface System.Collections.IComparer
- member c.ComparerType = comparerType
+ member c.ThrowsOnPER = throwsOnPER
- let getPERNaNCompareToResult (comp:GenericComparer) =
- match comp.ComparerType with
- | ComparerType.PER_gt -> -2
- | ComparerType.PER_lt -> 2
- | _ -> raise (Exception "Invalid logic")
+ /// The unique exception object that is thrown locally when NaNs are compared in PER mode (by fsComparerPER)
+ /// This exception should never be observed by user code.
+ let NaNException = new System.Exception()
/// Implements generic comparison between two objects. This corresponds to the pseudo-code in the F#
/// specification. The treatment of NaNs is governed by "comp".
@@ -990,21 +980,17 @@ namespace Microsoft.FSharp.Core
| (:? IStructuralComparable as x),_ ->
x.CompareTo(yobj,comp)
// Check for IComparable
- | (:? System.IComparable as x),_ ->
- if comp.ComparerType.Equals ComparerType.ER then
- x.CompareTo yobj
- else
- match xobj, yobj with
- | (:? float as x), (:? float as y) ->
- if System.Double.IsNaN x || System.Double.IsNaN y
- then getPERNaNCompareToResult comp
- else x.CompareTo y
- | (:? float32 as x), (:? float32 as y) ->
- if System.Single.IsNaN x || System.Single.IsNaN y
- then getPERNaNCompareToResult comp
- else x.CompareTo y
- | _ -> x.CompareTo yobj
-
+ | (:? System.IComparable as x),_ ->
+ if comp.ThrowsOnPER then
+ match xobj,yobj with
+ | (:? float as x),(:? float as y) ->
+ if (System.Double.IsNaN x || System.Double.IsNaN y) then
+ raise NaNException
+ | (:? float32 as x),(:? float32 as y) ->
+ if (System.Single.IsNaN x || System.Single.IsNaN y) then
+ raise NaNException
+ | _ -> ()
+ x.CompareTo(yobj)
| (:? nativeint as x),(:? nativeint as y) -> if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
| (:? unativeint as x),(:? unativeint as y) -> if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
| _,(:? IStructuralComparable as yc) ->
@@ -1195,917 +1181,13 @@ namespace Microsoft.FSharp.Core
type GenericComparer with
interface System.Collections.IComparer with
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_gt = GenericComparer ComparerType.PER_gt
- let fsComparerPER_lt = GenericComparer ComparerType.PER_lt
+ let fsComparerPER = GenericComparer(true)
/// The unique object for comparing values in ER mode (where "0" is returned when NaNs are compared)
- let fsComparerER = GenericComparer ComparerType.ER :> System.Collections.IComparer
-
- // eliminate_tail_call_xxx are to elimate tail calls which are a problem with value types > 64 bits
- // and the 64-bit JIT due to the amd64 calling convention which needs to do some magic.
- let inline eliminate_tail_call_int x = 0 + x
- let inline eliminate_tail_call_bool x =
- // previously: not (not (x))
- // but found that the following also removes tail calls, although this could obviously
- // change if the fsharp optimizer is changed...
- match x with
- | true -> true
- | false -> false
-
- // Used to denote the use of a struct that is not initialized, because we are using them to
- // denote pure functions that have no state
- let phantom<'t> = unsafeDefault<'t>
-
- type IEssenceOfCompareTo<'a> =
- abstract Ensorcel : IComparer * 'a * 'a -> int
-
- type IEssenceOfEquals<'a> =
- abstract Ensorcel : IEqualityComparer * 'a * 'a -> bool
-
- type IEssenceOfGetHashCode<'a> =
- abstract Ensorcel : IEqualityComparer * 'a -> int
-
- module ComparerTypes =
- let getPERNaNResult (comp:IComparer) =
- match comp with
- | :? GenericComparer as comp -> getPERNaNCompareToResult comp
- | _ -> raise (Exception "invalid logic")
-
- []
- type FloatPER =
- interface IEssenceOfCompareTo with
- member __.Ensorcel (c,x,y) =
- if System.Double.IsNaN x || System.Double.IsNaN y
- then getPERNaNResult c
- else x.CompareTo y
-
- []
- type Float32PER =
- interface IEssenceOfCompareTo with
- member __.Ensorcel (c,x,y) =
- if System.Single.IsNaN x || System.Single.IsNaN y
- then getPERNaNResult c
- else x.CompareTo y
-
- []
- type NullableFloatPER =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (c,x,y) =
- match x.HasValue, y.HasValue with
- | false, false -> 0
- | false, _ -> -1
- | _, false -> +1
- | _ ->
- if System.Double.IsNaN x.Value || System.Double.IsNaN y.Value
- then getPERNaNResult c
- else x.Value.CompareTo y.Value
-
- []
- type NullableFloat32PER =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (c,x,y) =
- match x.HasValue, y.HasValue with
- | false, false -> 0
- | false, _ -> -1
- | _, false -> +1
- | _ ->
- if System.Single.IsNaN x.Value || System.Single.IsNaN y.Value
- then getPERNaNResult c
- else x.Value.CompareTo y.Value
-
- []
- type FloatER =
- interface IEssenceOfCompareTo with
- member __.Ensorcel (_,x,y) = x.CompareTo y
-
- []
- type Float32ER =
- interface IEssenceOfCompareTo with
- member __.Ensorcel (_,x,y) = x.CompareTo y
-
- []
- type NullableFloatER =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (_,x,y) =
- match x.HasValue, y.HasValue with
- | false, false -> 0
- | false, _ -> -1
- | _, false -> +1
- | _ -> x.Value.CompareTo y.Value
-
- []
- type NullableFloat32ER =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (_,x,y) =
- match x.HasValue, y.HasValue with
- | false, false -> 0
- | false, _ -> -1
- | _, false -> +1
- | _ -> x.Value.CompareTo y.Value
-
-
- [] type Bool = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
- [] type Sbyte = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = (# "" x : int #) - (# "" y : int #)
- [] type Int16 = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = (# "" x : int #) - (# "" y : int #)
- [] type Int32 = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
- [] type Int64 = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
- [] type Nativeint = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
- [] type Byte = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = (# "" x : int #) - (# "" y : int #)
- [] type Uint16 = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = (# "" x : int #) - (# "" y : int #)
- [] type Uint32 = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
- [] type Uint64 = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
- [] type Unativeint = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
- [] type Char = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = (# "" x : int #) - (# "" y : int #)
- [] type String = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #))
- [] type Decimal = interface IEssenceOfCompareTo with member __.Ensorcel (_,x,y) = System.Decimal.Compare((# "" x:decimal #), (# "" y:decimal #))
-
- []
- type Tuple<'a,'b,
- 'comp1,'comp2
- when 'comp1 :> IEssenceOfCompareTo<'a> and 'comp1 : (new : unit -> 'comp1) and 'comp1 : struct
- and 'comp2 :> IEssenceOfCompareTo<'b> and 'comp2 : (new : unit -> 'comp2) and 'comp2 : struct
- > =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (comparer:IComparer, x:System.Tuple<'a,'b>, y:System.Tuple<'a,'b>) =
- match x, y with
- | null, null -> 0
- | null, _ -> -1
- | _, null -> +1
- | _, _ ->
- match phantom<'comp1>.Ensorcel (comparer, x.Item1, y.Item1) with
- | x when x <> 0 -> x
- | _ ->
- eliminate_tail_call_int (phantom<'comp2>.Ensorcel (comparer, x.Item2, y.Item2))
-
- []
- type Tuple<'a,'b,'c,
- 'comp1,'comp2,'comp3
- when 'comp1 :> IEssenceOfCompareTo<'a> and 'comp1 : (new : unit -> 'comp1) and 'comp1 : struct
- and 'comp2 :> IEssenceOfCompareTo<'b> and 'comp2 : (new : unit -> 'comp2) and 'comp2 : struct
- and 'comp3 :> IEssenceOfCompareTo<'c> and 'comp3 : (new : unit -> 'comp3) and 'comp3 : struct
- > =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (comparer:IComparer, x:System.Tuple<'a,'b,'c>, y:System.Tuple<'a,'b,'c>) =
- match x, y with
- | null, null -> 0
- | null, _ -> -1
- | _, null -> +1
- | _, _ ->
- match phantom<'comp1>.Ensorcel (comparer, x.Item1, y.Item1) with
- | x when x <> 0 -> x
- | _ ->
- match phantom<'comp2>.Ensorcel (comparer, x.Item2, y.Item2) with
- | x when x <> 0 -> x
- | _ ->
- eliminate_tail_call_int (phantom<'comp3>.Ensorcel (comparer, x.Item3, y.Item3))
-
-
- []
- type Tuple<'a,'b,'c,'d,
- 'comp1,'comp2,'comp3,'comp4
- when 'comp1 :> IEssenceOfCompareTo<'a> and 'comp1 : (new : unit -> 'comp1) and 'comp1 : struct
- and 'comp2 :> IEssenceOfCompareTo<'b> and 'comp2 : (new : unit -> 'comp2) and 'comp2 : struct
- and 'comp3 :> IEssenceOfCompareTo<'c> and 'comp3 : (new : unit -> 'comp3) and 'comp3 : struct
- and 'comp4 :> IEssenceOfCompareTo<'d> and 'comp4 : (new : unit -> 'comp4) and 'comp4 : struct
- > =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (comparer:IComparer, x:System.Tuple<'a,'b,'c,'d>, y:System.Tuple<'a,'b,'c,'d>) =
- match x, y with
- | null, null -> 0
- | null, _ -> -1
- | _, null -> +1
- | _, _ ->
- match phantom<'comp1>.Ensorcel (comparer, x.Item1, y.Item1) with
- | x when x <> 0 -> x
- | _ ->
- match phantom<'comp2>.Ensorcel (comparer, x.Item2, y.Item2) with
- | x when x <> 0 -> x
- | _ ->
- match phantom<'comp3>.Ensorcel (comparer, x.Item3, y.Item3) with
- | x when x <> 0 -> x
- | _ ->
- eliminate_tail_call_int (phantom<'comp4>.Ensorcel (comparer, x.Item4, y.Item4))
-
- []
- type Tuple<'a,'b,'c,'d,'e,
- 'comp1,'comp2,'comp3,'comp4,'comp5
- when 'comp1 :> IEssenceOfCompareTo<'a> and 'comp1 : (new : unit -> 'comp1) and 'comp1 : struct
- and 'comp2 :> IEssenceOfCompareTo<'b> and 'comp2 : (new : unit -> 'comp2) and 'comp2 : struct
- and 'comp3 :> IEssenceOfCompareTo<'c> and 'comp3 : (new : unit -> 'comp3) and 'comp3 : struct
- and 'comp4 :> IEssenceOfCompareTo<'d> and 'comp4 : (new : unit -> 'comp4) and 'comp4 : struct
- and 'comp5 :> IEssenceOfCompareTo<'e> and 'comp5 : (new : unit -> 'comp5) and 'comp5 : struct
- > =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (comparer:IComparer, x:System.Tuple<'a,'b,'c,'d,'e>, y:System.Tuple<'a,'b,'c,'d,'e>) =
- match x, y with
- | null, null -> 0
- | null, _ -> -1
- | _, null -> +1
- | _, _ ->
- match phantom<'comp1>.Ensorcel (comparer, x.Item1, y.Item1) with
- | x when x <> 0 -> x
- | _ ->
- match phantom<'comp2>.Ensorcel (comparer, x.Item2, y.Item2) with
- | x when x <> 0 -> x
- | _ ->
- match phantom<'comp3>.Ensorcel (comparer, x.Item3, y.Item3) with
- | x when x <> 0 -> x
- | _ ->
- match phantom<'comp4>.Ensorcel (comparer, x.Item4, y.Item4) with
- | x when x <> 0 -> x
- | _ ->
- eliminate_tail_call_int (phantom<'comp5>.Ensorcel (comparer, x.Item5, y.Item5))
-
- module Nullable =
- []
- type StructuralComparable<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IStructuralComparable> =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (ec:IComparer, x:Nullable<'a>, y:Nullable<'a>) =
- match x.HasValue, y.HasValue with
- | false, false -> 0
- | false, _ -> -1
- | _, false -> +1
- | _, _ -> x.Value.CompareTo (box y.Value, ec)
-
- []
- type ComparableGeneric<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IComparable<'a>> =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (_:IComparer, x:Nullable<'a>, y:Nullable<'a>) =
- match x.HasValue, y.HasValue with
- | false, false -> 0
- | false, _ -> -1
- | _, false -> +1
- | _, _ -> x.Value.CompareTo y.Value
-
- []
- type Comparable<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IComparable> =
- interface IEssenceOfCompareTo> with
- member __.Ensorcel (_:IComparer, x:Nullable<'a>, y:Nullable<'a>) =
- match x.HasValue, y.HasValue with
- | false, false -> 0
- | false, _ -> -1
- | _, false -> +1
- | _, _ -> x.Value.CompareTo (box y.Value)
-
- module ValueType =
- []
- type StructuralComparable<'a when 'a : struct and 'a :> IStructuralComparable> =
- interface IEssenceOfCompareTo<'a> with
- member __.Ensorcel (ec:IComparer, x:'a, y:'a) =
- x.CompareTo (box y, ec)
-
- []
- type ComparableGeneric<'a when 'a : struct and 'a :> IComparable<'a>> =
- interface IEssenceOfCompareTo<'a> with
- member __.Ensorcel (_:IComparer, x:'a, y:'a) =
- x.CompareTo y
-
- []
- type Comparable<'a when 'a : struct and 'a :> IComparable> =
- interface IEssenceOfCompareTo<'a> with
- member __.Ensorcel (_:IComparer, x:'a, y:'a) =
- x.CompareTo y
-
- module RefType =
- []
- type StructuralComparable<'a when 'a : not struct and 'a : null and 'a :> IStructuralComparable> =
- interface IEssenceOfCompareTo<'a> with
- member __.Ensorcel (ec:IComparer, x:'a, y:'a) =
- match x, y with
- | null, null -> 0
- | null, _ -> -1
- | _, null -> +1
- | _, _ -> x.CompareTo (box y, ec)
-
- []
- type ComparableGeneric<'a when 'a : not struct and 'a : null and 'a :> IComparable<'a>> =
- interface IEssenceOfCompareTo<'a> with
- member __.Ensorcel (_:IComparer, x:'a, y:'a) =
- match x, y with
- | null, null -> 0
- | null, _ -> -1
- | _, null -> +1
- | _, _ -> x.CompareTo y
-
- []
- type Comparable<'a when 'a : not struct and 'a : null and 'a :> IComparable> =
- interface IEssenceOfCompareTo<'a> with
- member __.Ensorcel (_:IComparer, x:'a, y:'a) =
- match x, y with
- | null, null -> 0
- | null, _ -> -1
- | _, null -> +1
- | _, _ -> x.CompareTo y
-
- module EqualsTypes =
- []
- type FloatPER =
- interface IEssenceOfEquals
- with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
-
- []
- type Float32PER =
- interface IEssenceOfEquals with
- member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
-
- []
- type NullableFloatPER =
- interface IEssenceOfEquals> with
- member __.Ensorcel (_,x,y) =
- match x.HasValue, y.HasValue with
- | false, false -> true
- | false, _
- | _, false -> false
- | _ -> (# "ceq" x.Value y.Value : bool #)
-
- []
- type NullableFloat32PER =
- interface IEssenceOfEquals> with
- member __.Ensorcel (_,x,y) =
- match x.HasValue, y.HasValue with
- | false, false -> true
- | false, _
- | _, false -> false
- | _ -> (# "ceq" x.Value y.Value : bool #)
-
- []
- type FloatER =
- interface IEssenceOfEquals
- with member __.Ensorcel (_,x,y) = if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then true else (# "ceq" x y : bool #)
-
- []
- type Float32ER =
- interface IEssenceOfEquals with
- member __.Ensorcel (_,x,y) = if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then true else (# "ceq" x y : bool #)
-
- []
- type NullableFloatER =
- interface IEssenceOfEquals> with
- member __.Ensorcel (_,x,y) =
- match x.HasValue, y.HasValue with
- | false, false -> true
- | false, _
- | _, false -> false
- | _ -> if not (# "ceq" x.Value x.Value : bool #) && not (# "ceq" y.Value y.Value : bool #) then true else (# "ceq" x.Value y.Value : bool #)
-
- []
- type NullableFloat32ER =
- interface IEssenceOfEquals> with
- member __.Ensorcel (_,x,y) =
- match x.HasValue, y.HasValue with
- | false, false -> true
- | false, _
- | _, false -> false
- | _ -> if not (# "ceq" x.Value x.Value : bool #) && not (# "ceq" y.Value y.Value : bool #) then true else (# "ceq" x.Value y.Value : bool #)
-
- [] type Bool = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Sbyte = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Int16 = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Int32 = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Int64 = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Byte = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Uint16 = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Uint32 = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Uint64 = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Nativeint = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Unativeint = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type Char = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = (# "ceq" x y : bool #)
- [] type String = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = System.String.Equals((# "" x : string #),(# "" y : string #))
- [] type Decimal = interface IEssenceOfEquals with member __.Ensorcel (_,x,y) = System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #))
-
- []
- type Tuple<'a,'b,
- 'eq1,'eq2
- when 'eq1 :> IEssenceOfEquals<'a> and 'eq1 : (new : unit -> 'eq1) and 'eq1 : struct
- and 'eq2 :> IEssenceOfEquals<'b> and 'eq2 : (new : unit -> 'eq2) and 'eq2 : struct
- > =
- interface IEssenceOfEquals> with
- member __.Ensorcel (ec:IEqualityComparer, x:System.Tuple<'a,'b>, y:System.Tuple<'a,'b>) =
- match x, y with
- | null, null -> true
- | null, _ | _, null -> false
- | _, _ ->
- match phantom<'eq1>.Ensorcel (ec, x.Item1, y.Item1) with
- | false -> false
- | _ ->
- phantom<'eq2>.Ensorcel (ec, x.Item2, y.Item2)
-
- []
- type Tuple<'a,'b,'c,
- 'eq1,'eq2,'eq3
- when 'eq1 :> IEssenceOfEquals<'a> and 'eq1 : (new : unit -> 'eq1) and 'eq1 : struct
- and 'eq2 :> IEssenceOfEquals<'b> and 'eq2 : (new : unit -> 'eq2) and 'eq2 : struct
- and 'eq3 :> IEssenceOfEquals<'c> and 'eq3 : (new : unit -> 'eq3) and 'eq3 : struct
- > =
- interface IEssenceOfEquals> with
- member __.Ensorcel (ec:IEqualityComparer, x:System.Tuple<'a,'b,'c>, y:System.Tuple<'a,'b,'c>) =
- match x, y with
- | null, null -> true
- | null, _ | _, null -> false
- | _, _ ->
- match phantom<'eq1>.Ensorcel (ec, x.Item1, y.Item1) with
- | false -> false
- | _ ->
- match phantom<'eq2>.Ensorcel (ec, x.Item2, y.Item2) with
- | false -> false
- | _ ->
- phantom<'eq3>.Ensorcel (ec, x.Item3, y.Item3)
-
- []
- type Tuple<'a,'b,'c,'d,
- 'eq1,'eq2,'eq3,'eq4
- when 'eq1 :> IEssenceOfEquals<'a> and 'eq1 : (new : unit -> 'eq1) and 'eq1 : struct
- and 'eq2 :> IEssenceOfEquals<'b> and 'eq2 : (new : unit -> 'eq2) and 'eq2 : struct
- and 'eq3 :> IEssenceOfEquals<'c> and 'eq3 : (new : unit -> 'eq3) and 'eq3 : struct
- and 'eq4 :> IEssenceOfEquals<'d> and 'eq4 : (new : unit -> 'eq4) and 'eq4 : struct
- > =
- interface IEssenceOfEquals> with
- member __.Ensorcel (ec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d>, y:System.Tuple<'a,'b,'c,'d>) =
- match x, y with
- | null, null -> true
- | null, _ | _, null -> false
- | _, _ ->
- match phantom<'eq1>.Ensorcel (ec, x.Item1, y.Item1) with
- | false -> false
- | _ ->
- match phantom<'eq2>.Ensorcel (ec, x.Item2, y.Item2) with
- | false -> false
- | _ ->
- match phantom<'eq3>.Ensorcel (ec, x.Item3, y.Item3) with
- | false -> false
- | _ ->
- phantom<'eq4>.Ensorcel (ec, x.Item4, y.Item4)
-
- []
- type Tuple<'a,'b,'c,'d,'e,
- 'eq1,'eq2,'eq3,'eq4,'eq5
- when 'eq1 :> IEssenceOfEquals<'a> and 'eq1 : (new : unit -> 'eq1) and 'eq1 : struct
- and 'eq2 :> IEssenceOfEquals<'b> and 'eq2 : (new : unit -> 'eq2) and 'eq2 : struct
- and 'eq3 :> IEssenceOfEquals<'c> and 'eq3 : (new : unit -> 'eq3) and 'eq3 : struct
- and 'eq4 :> IEssenceOfEquals<'d> and 'eq4 : (new : unit -> 'eq4) and 'eq4 : struct
- and 'eq5 :> IEssenceOfEquals<'e> and 'eq5 : (new : unit -> 'eq5) and 'eq5 : struct
- > =
- interface IEssenceOfEquals> with
- member __.Ensorcel (ec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d,'e>, y:System.Tuple<'a,'b,'c,'d,'e>) =
- match x, y with
- | null, null -> true
- | null, _ | _, null -> false
- | _, _ ->
- match phantom<'eq1>.Ensorcel (ec, x.Item1, y.Item1) with
- | false -> false
- | _ ->
- match phantom<'eq2>.Ensorcel (ec, x.Item2, y.Item2) with
- | false -> false
- | _ ->
- match phantom<'eq3>.Ensorcel (ec, x.Item3, y.Item3) with
- | false -> false
- | _ ->
- match phantom<'eq4>.Ensorcel (ec, x.Item4, y.Item4) with
- | false -> false
- | _ ->
- phantom<'eq5>.Ensorcel (ec, x.Item5, y.Item5)
-
- module GetHashCodeTypes =
- [] type Bool = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Float = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Sbyte = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Int16 = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Int32 = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Int64 = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Byte = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Uint16 = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Uint32 = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Uint64 = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Nativeint = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Unativeint = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Char = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type String = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Decimal = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
- [] type Float32 = interface IEssenceOfGetHashCode with member __.Ensorcel (_,a) = a.GetHashCode()
-
-(*
- let inline mask (n:int) (m:int) = (# "and" n m : int #)
- let inline opshl (x:int) (n:int) : int = (# "shl" x (mask n 31) : int #)
- let inline opshr (x:int) (n:int) : int = (# "shr" x (mask n 31) : int #)
- let inline opxor (x:int) (y:int) : int = (# "xor" x y : int32 #)
- let inline combineTupleHashes (h1 : int) (h2 : int) = -1640531527 + (h2 + (opshl h1 6) + (opshr h1 2))
-*)
- let inline cth a b = TupleUtils.combineTupleHashes a b
-
- []
- type Tuple<'a,'b,
- 'ghc1,'ghc2
- when 'ghc1 :> IEssenceOfGetHashCode<'a> and 'ghc1 : (new : unit -> 'ghc1) and 'ghc1 : struct
- and 'ghc2 :> IEssenceOfGetHashCode<'b> and 'ghc2 : (new : unit -> 'ghc2) and 'ghc2 : struct
- > =
- interface IEssenceOfGetHashCode> with
- member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b>) =
- let a = phantom<'ghc1>.Ensorcel (iec, x.Item1)
- let b = phantom<'ghc2>.Ensorcel (iec, x.Item2)
- eliminate_tail_call_int (cth a b)
-
- []
- type Tuple<'a,'b,'c,
- 'ghc1,'ghc2,'ghc3
- when 'ghc1 :> IEssenceOfGetHashCode<'a> and 'ghc1 : (new : unit -> 'ghc1) and 'ghc1 : struct
- and 'ghc2 :> IEssenceOfGetHashCode<'b> and 'ghc2 : (new : unit -> 'ghc2) and 'ghc2 : struct
- and 'ghc3 :> IEssenceOfGetHashCode<'c> and 'ghc3 : (new : unit -> 'ghc3) and 'ghc3 : struct
- > =
- interface IEssenceOfGetHashCode> with
- member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b,'c>) =
- let a = phantom<'ghc1>.Ensorcel (iec, x.Item1)
- let b = phantom<'ghc2>.Ensorcel (iec, x.Item2)
- let c = phantom<'ghc3>.Ensorcel (iec, x.Item3)
- eliminate_tail_call_int (cth (cth a b) c)
-
- []
- type Tuple<'a,'b,'c,'d,
- 'ghc1,'ghc2,'ghc3,'ghc4
- when 'ghc1 :> IEssenceOfGetHashCode<'a> and 'ghc1 : (new : unit -> 'ghc1) and 'ghc1 : struct
- and 'ghc2 :> IEssenceOfGetHashCode<'b> and 'ghc2 : (new : unit -> 'ghc2) and 'ghc2 : struct
- and 'ghc3 :> IEssenceOfGetHashCode<'c> and 'ghc3 : (new : unit -> 'ghc3) and 'ghc3 : struct
- and 'ghc4 :> IEssenceOfGetHashCode<'d> and 'ghc4 : (new : unit -> 'ghc4) and 'ghc4 : struct
- > =
- interface IEssenceOfGetHashCode> with
- member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d>) =
- let a = phantom<'ghc1>.Ensorcel (iec, x.Item1)
- let b = phantom<'ghc2>.Ensorcel (iec, x.Item2)
- let c = phantom<'ghc3>.Ensorcel (iec, x.Item3)
- let d = phantom<'ghc4>.Ensorcel (iec, x.Item4)
- eliminate_tail_call_int (cth (cth a b) (cth c d))
-
- []
- type Tuple<'a,'b,'c,'d,'e,
- 'ghc1,'ghc2,'ghc3,'ghc4,'ghc5
- when 'ghc1 :> IEssenceOfGetHashCode<'a> and 'ghc1 : (new : unit -> 'ghc1) and 'ghc1 : struct
- and 'ghc2 :> IEssenceOfGetHashCode<'b> and 'ghc2 : (new : unit -> 'ghc2) and 'ghc2 : struct
- and 'ghc3 :> IEssenceOfGetHashCode<'c> and 'ghc3 : (new : unit -> 'ghc3) and 'ghc3 : struct
- and 'ghc4 :> IEssenceOfGetHashCode<'d> and 'ghc4 : (new : unit -> 'ghc4) and 'ghc4 : struct
- and 'ghc5 :> IEssenceOfGetHashCode<'e> and 'ghc5 : (new : unit -> 'ghc5) and 'ghc5 : struct
- > =
- interface IEssenceOfGetHashCode> with
- member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d,'e>) =
- let a = phantom<'ghc1>.Ensorcel (iec, x.Item1)
- let b = phantom<'ghc2>.Ensorcel (iec, x.Item2)
- let c = phantom<'ghc3>.Ensorcel (iec, x.Item3)
- let d = phantom<'ghc4>.Ensorcel (iec, x.Item4)
- let e = phantom<'ghc5>.Ensorcel (iec, x.Item5)
- eliminate_tail_call_int (cth (cth (cth a b) (cth c d)) e)
-
- module CommonEqualityTypes =
- module Nullable =
- []
- type StructuralEquatable<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IStructuralEquatable> =
- interface IEssenceOfEquals> with
- member __.Ensorcel (ec:IEqualityComparer, x:Nullable<'a>, y:Nullable<'a>) =
- match x.HasValue, y.HasValue with
- | false, false -> true
- | false, _ | _, false -> false
- | _, _ -> x.Value.Equals (box y.Value, ec)
-
- interface IEssenceOfGetHashCode> with
- member __.Ensorcel (ec:IEqualityComparer, x:Nullable<'a>) =
- if x.HasValue then x.Value.GetHashCode (ec)
- else 0
-
- []
- type Equatable<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IEquatable<'a>> =
- interface IEssenceOfEquals> with
- member __.Ensorcel (_:IEqualityComparer, x:Nullable<'a>, y:Nullable<'a>) =
- match x.HasValue, y.HasValue with
- | false, false -> true
- | false, _ | _, false -> false
- | _, _ -> x.Value.Equals y.Value
-
- []
- type Equality<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a : equality> =
- interface IEssenceOfEquals> with
- member __.Ensorcel (_:IEqualityComparer, x:Nullable<'a>, y:Nullable<'a>) =
- match x.HasValue, y.HasValue with
- | false, false -> true
- | false, _ | _, false -> false
- | _, _ -> x.Value.Equals y.Value
-
- interface IEssenceOfGetHashCode> with
- member __.Ensorcel (_:IEqualityComparer, x:Nullable<'a>) =
- if x.HasValue then x.Value.GetHashCode ()
- else 0
-
- module ValueType =
- []
- type StructuralEquatable<'a when 'a : struct and 'a :> IStructuralEquatable> =
- interface IEssenceOfEquals<'a> with
- member __.Ensorcel (ec:IEqualityComparer, x:'a, y:'a) =
- x.Equals (box y, ec)
- interface IEssenceOfGetHashCode<'a> with
- member __.Ensorcel (ec:IEqualityComparer, x:'a) =
- x.GetHashCode (ec)
-
- []
- type Equatable<'a when 'a : struct and 'a :> IEquatable<'a>> =
- interface IEssenceOfEquals<'a> with
- member __.Ensorcel (_:IEqualityComparer, x:'a, y:'a) =
- x.Equals y
-
- []
- type Equality<'a when 'a : struct and 'a : equality> =
- interface IEssenceOfEquals<'a> with
- member __.Ensorcel (_:IEqualityComparer, x:'a, y:'a) =
- x.Equals y
- interface IEssenceOfGetHashCode<'a> with
- member __.Ensorcel (_:IEqualityComparer, x:'a) =
- x.GetHashCode ()
-
- module RefType =
- []
- type StructuralEquatable<'a when 'a : not struct and 'a : null and 'a :> IStructuralEquatable> =
- interface IEssenceOfEquals<'a> with
- member __.Ensorcel (ec:IEqualityComparer, x:'a, y:'a) =
- match x, y with
- | null, null -> true
- | null, _ | _, null -> false
- | _, _ -> x.Equals (box y, ec)
-
- interface IEssenceOfGetHashCode<'a> with
- member __.Ensorcel (ec:IEqualityComparer, x:'a) =
- match x with
- | null -> 0
- | _ -> x.GetHashCode (ec)
-
- []
- type Equatable<'a when 'a : not struct and 'a : null and 'a :> IEquatable<'a>> =
- interface IEssenceOfEquals<'a> with
- member __.Ensorcel (_:IEqualityComparer, x:'a, y:'a) =
- match x, y with
- | null, null -> true
- | null, _ | _, null -> false
- | _, _ -> x.Equals y
-
- []
- type Equality<'a when 'a : not struct and 'a : null and 'a : equality> =
- interface IEssenceOfEquals<'a> with
- member __.Ensorcel (_:IEqualityComparer, x:'a, y:'a) =
- match x, y with
- | null, null -> true
- | null, _ | _, null -> false
- | _, _ -> x.Equals y
-
- interface IEssenceOfGetHashCode<'a> with
- member __.Ensorcel (_:IEqualityComparer, x:'a) =
- match x with
- | null -> 0
- | _ -> x.GetHashCode ()
-
- let doNotEat () = raise (Exception "not for consumption! this type only exist for getting typedef.")
- []
- type DummyValueType =
- interface IStructuralComparable with member __.CompareTo (_,_) = doNotEat ()
- interface IStructuralEquatable with member __.Equals (_,_) = doNotEat ()
- member __.GetHashCode _ = doNotEat ()
-
- type private EquivalenceRelation = class end
- type private PartialEquivalenceRelation = class end
-
- module mos =
- type IGetType =
- abstract Get : unit -> Type
-
- let makeType (ct:Type) (def:Type) : Type =
- def.MakeGenericType [|ct|]
-
- let makeGenericType<'a> tys =
- let typedef = typedefof<'a>
- typedef.MakeGenericType tys
-
- let makeEquatableType ty =
- makeGenericType> [|ty|]
-
- let makeComparableType ty =
- makeGenericType> [|ty|]
-
-// portable47 doesn't support reflection in the way I'm using it; maybe someone with greater understanding
-// of the configurations could provide a real solution
-#if FX_ATLEAST_40
- let rec private tryFindObjectsInterfaceMethod (objectType:Type) (interfaceType:Type) (methodName:string) (methodArgTypes:array) =
- if not (interfaceType.IsAssignableFrom objectType) then null
- else
- let methodInfo = interfaceType.GetMethod (methodName, methodArgTypes)
- let interfaceMap = objectType.GetInterfaceMap interfaceType
- let rec findTargetMethod index =
- if index = interfaceMap.InterfaceMethods.Length then null
- elif methodInfo.Equals (get interfaceMap.InterfaceMethods index) then (get interfaceMap.TargetMethods index)
- else findTargetMethod (index+1)
- findTargetMethod 0
-
- let rec private isCompilerGeneratedInterfaceMethod objectType interfaceType methodName methodArgTypes =
- match tryFindObjectsInterfaceMethod objectType interfaceType methodName methodArgTypes with
- | null -> false
- | m ->
- match m.GetCustomAttribute typeof with
- | null -> false
- | _ -> true
-
- let rec private isCompilerGeneratedMethod (objectType:Type) (methodName:string) (methodArgTypes:array) =
- match objectType.GetMethod (methodName, methodArgTypes) with
- | null -> false
- | m ->
- match m.GetCustomAttribute typeof with
- | null -> false
- | _ -> true
-
- let hasFSharpCompilerGeneratedEquality (ty:Type) =
- match ty.GetCustomAttribute typeof with
- | :? CompilationMappingAttribute as m when (m.SourceConstructFlags.Equals SourceConstructFlags.ObjectType(*struct*)) || (m.SourceConstructFlags.Equals SourceConstructFlags.RecordType) ->
- isCompilerGeneratedInterfaceMethod ty (makeEquatableType ty) "Equals" [|ty|]
- && isCompilerGeneratedInterfaceMethod ty typeof "Equals" [|typeof; typeof|]
- && isCompilerGeneratedMethod ty "Equals" [|typeof|]
- | _ -> false
-
- let hasFSharpCompilerGeneratedComparison (ty:Type) =
- match ty.GetCustomAttribute typeof with
- | :? CompilationMappingAttribute as m when (m.SourceConstructFlags.Equals SourceConstructFlags.ObjectType(*struct*)) || (m.SourceConstructFlags.Equals SourceConstructFlags.RecordType) ->
- isCompilerGeneratedInterfaceMethod ty (makeComparableType ty) "CompareTo" [|ty|]
- && isCompilerGeneratedInterfaceMethod ty typeof "CompareTo" [|typeof; typeof|]
- && isCompilerGeneratedInterfaceMethod ty typeof "CompareTo" [|typeof|]
- | _ -> false
-#else
- let hasFSharpCompilerGeneratedEquality (_:Type) = false
- let hasFSharpCompilerGeneratedComparison (_:Type) = false
-#endif
-
- let takeFirstNonNull items =
- let rec takeFirst idx =
- if idx = length items then raise (Exception "invalid logic")
- else
- let f = get items idx
- match f () with
- | null -> takeFirst (idx+1)
- | result -> result
- takeFirst 0
-
- let compositeType (getEssence:Type->Type) (args:Type[]) (genericCompositeEssenceType:Type) =
- let compositeArgs : Type[] = unboxPrim (Array.CreateInstance (typeof, args.Length*2))
- for i = 0 to args.Length-1 do
- let argType = get args i
- let essenceType = getEssence argType
- compositeArgs.SetValue (argType, i)
- compositeArgs.SetValue (essenceType, i+args.Length)
- genericCompositeEssenceType.MakeGenericType compositeArgs
-
- module GenericSpecializeCompareTo =
- let floatingPointTypes (tyRelation:Type) (ty:Type) =
- match tyRelation with
- | r when r.Equals typeof ->
- match ty with
- | t when t.Equals typeof -> typeof
- | t when t.Equals typeof -> typeof
- | t when t.Equals typeof> -> typeof
- | t when t.Equals typeof> -> typeof
- | _ -> null
- | r when r.Equals typeof ->
- match ty with
- | t when t.Equals typeof -> typeof
- | t when t.Equals typeof -> typeof
- | t when t.Equals typeof> -> typeof
- | t when t.Equals typeof> -> typeof
- | _ -> null
- | _ -> raise (Exception "invalid logic")
-
- let standardTypes (t:Type) : Type =
- if t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- elif t.Equals typeof then typeof
- else null
-
- let compilerGenerated tyRelation ty =
- match tyRelation with
- | r when r.Equals typeof ->
- if mos.hasFSharpCompilerGeneratedComparison ty then
- if ty.IsValueType
- then mos.makeType ty typedefof>
- else mos.makeType ty typedefof>
- else null
- | r when r.Equals typeof -> null
- | _ -> raise (Exception "invalid logic")
-
- []
- type GenericComparerObj<'a> =
- interface IEssenceOfCompareTo<'a> with
- member __.Ensorcel (comp:IComparer, x:'a, y:'a) = comp.Compare (box x, box y)
-
- let arrays (t:Type) : Type =
- if t.IsArray || typeof.IsAssignableFrom t then
- // TODO: Future; for now just default back to previous functionality
- mos.makeType t typedefof>
- else null
-
- let nullableType (t:Type) : Type =
- if t.IsGenericType && ((t.GetGenericTypeDefinition ()).Equals typedefof>) then
- let underlying = get (t.GetGenericArguments()) 0
- let comparableGeneric = mos.makeComparableType underlying
- let make = mos.makeType underlying
-
- if typeof.IsAssignableFrom underlying then make typedefof>
- elif comparableGeneric.IsAssignableFrom underlying then make typedefof>
- else make typedefof>
- else null
-
- let comparisonInterfaces (t:Type) : Type =
- let make = mos.makeType t
- let comparableGeneric = mos.makeComparableType t
-
- if t.IsValueType && typeof.IsAssignableFrom t then make typedefof>
- elif t.IsValueType && comparableGeneric.IsAssignableFrom t then make typedefof>
- elif t.IsValueType && typeof.IsAssignableFrom t then make typedefof>
-
- elif typeof