Skip to content

Instantly share code, notes, and snippets.

@manofstick

manofstick/comparers.fs

Created August 5, 2015 10:01
Show Gist options
  • Save manofstick/fe42efa23c307eb49302 to your computer and use it in GitHub Desktop.
Save manofstick/fe42efa23c307eb49302 to your computer and use it in GitHub Desktop.
Download ZIP
The dynamic comparers generator
Raw
comparers.fs
namespace Test
module HackedOutOfPrimTypes =
open System
open System.Collections
open System.Collections.Generic
open System.Reflection
open System.Runtime.CompilerServices
type ComparerType =
| ER = 0
| PER_lt = 1
| PER_gt = 2
type GenericComparer(comparerType:ComparerType) =
member c.ComparerType = comparerType
interface System.Collections.IComparer with
override c.Compare(x:obj,y:obj) = failwith "Not implemented"
let getPERNaNCompareToResult (comp:GenericComparer) =
match comp.ComparerType with
| ComparerType.PER_gt -> -2
| ComparerType.PER_lt -> 2
| _ -> raise (Exception "Invalid logic")
/// 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
/// 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> = Unchecked.defaultof<'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")
[<Struct; NoComparison; NoEquality>]
type FloatPER =
interface IEssenceOfCompareTo<float> with
member __.Ensorcel (c,x,y) =
if System.Double.IsNaN x || System.Double.IsNaN y
then getPERNaNResult c
else x.CompareTo y
[<Struct; NoComparison; NoEquality>]
type Float32PER =
interface IEssenceOfCompareTo<float32> with
member __.Ensorcel (c,x,y) =
if System.Single.IsNaN x || System.Single.IsNaN y
then getPERNaNResult c
else x.CompareTo y
[<Struct; NoComparison; NoEquality>]
type NullableFloatPER =
interface IEssenceOfCompareTo<Nullable<float>> 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
[<Struct; NoComparison; NoEquality>]
type NullableFloat32PER =
interface IEssenceOfCompareTo<Nullable<float32>> 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
[<Struct; NoComparison; NoEquality>]
type FloatER =
interface IEssenceOfCompareTo<float> with
member __.Ensorcel (_,x,y) = x.CompareTo y
[<Struct; NoComparison; NoEquality>]
type Float32ER =
interface IEssenceOfCompareTo<float32> with
member __.Ensorcel (_,x,y) = x.CompareTo y
[<Struct; NoComparison; NoEquality>]
type NullableFloatER =
interface IEssenceOfCompareTo<Nullable<float>> with
member __.Ensorcel (_,x,y) =
match x.HasValue, y.HasValue with
| false, false -> 0
| false, _ -> -1
| _, false -> +1
| _ -> x.Value.CompareTo y.Value
[<Struct; NoComparison; NoEquality>]
type NullableFloat32ER =
interface IEssenceOfCompareTo<Nullable<float32>> with
member __.Ensorcel (_,x,y) =
match x.HasValue, y.HasValue with
| false, false -> 0
| false, _ -> -1
| _, false -> +1
| _ -> x.Value.CompareTo y.Value
[<Struct; NoComparison; NoEquality>] type Bool = interface IEssenceOfCompareTo<bool > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Sbyte = interface IEssenceOfCompareTo<sbyte > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Int16 = interface IEssenceOfCompareTo<int16 > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Int32 = interface IEssenceOfCompareTo<int32 > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Int64 = interface IEssenceOfCompareTo<int64 > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Nativeint = interface IEssenceOfCompareTo<nativeint > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Byte = interface IEssenceOfCompareTo<byte > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Uint16 = interface IEssenceOfCompareTo<uint16 > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Uint32 = interface IEssenceOfCompareTo<uint32 > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Uint64 = interface IEssenceOfCompareTo<uint64 > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Unativeint = interface IEssenceOfCompareTo<unativeint> with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type Char = interface IEssenceOfCompareTo<char > with member __.Ensorcel (_,x,y) = if x < y then -1 elif x > y then 1 else 0
[<Struct; NoComparison; NoEquality>] type String = interface IEssenceOfCompareTo<string > with member __.Ensorcel (_,x,y) = System.String.CompareOrdinal (x, y)
[<Struct; NoComparison; NoEquality>] type Decimal = interface IEssenceOfCompareTo<decimal > with member __.Ensorcel (_,x,y) = System.Decimal.Compare (x, y)
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,
'comp1
when 'comp1 :> IEssenceOfCompareTo<'a> and 'comp1 : (new : unit -> 'comp1) and 'comp1 : struct
> =
interface IEssenceOfCompareTo<System.Tuple<'a>> with
member __.Ensorcel (comparer:IComparer, x:System.Tuple<'a>, y:System.Tuple<'a>) =
match x, y with
| null, null -> 0
| null, _ -> -1
| _, null -> +1
| _, _ ->
eliminate_tail_call_int (phantom<'comp1>.Ensorcel (comparer, x.Item1, y.Item1))
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b>> 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))
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b,'c>> 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))
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b,'c,'d>> 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))
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b,'c,'d,'e>> 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))
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,'b,'c,'d,'e,'f,
'comp1,'comp2,'comp3,'comp4,'comp5,'comp6
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
and 'comp6 :> IEssenceOfCompareTo<'f> and 'comp6 : (new : unit -> 'comp6) and 'comp6 : struct
> =
interface IEssenceOfCompareTo<System.Tuple<'a,'b,'c,'d,'e,'f>> with
member __.Ensorcel (comparer:IComparer, x:System.Tuple<'a,'b,'c,'d,'e,'f>, y:System.Tuple<'a,'b,'c,'d,'e,'f>) =
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
| _ ->
match phantom<'comp5>.Ensorcel (comparer, x.Item5, y.Item5) with
| x when x <> 0 -> x
| _ ->
eliminate_tail_call_int (phantom<'comp6>.Ensorcel (comparer, x.Item6, y.Item6))
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,'b,'c,'d,'e,'f,'g,
'comp1,'comp2,'comp3,'comp4,'comp5,'comp6,'comp7
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
and 'comp6 :> IEssenceOfCompareTo<'f> and 'comp6 : (new : unit -> 'comp6) and 'comp6 : struct
and 'comp7 :> IEssenceOfCompareTo<'g> and 'comp7 : (new : unit -> 'comp7) and 'comp7 : struct
> =
interface IEssenceOfCompareTo<System.Tuple<'a,'b,'c,'d,'e,'f,'g>> with
member __.Ensorcel (comparer:IComparer, x:System.Tuple<'a,'b,'c,'d,'e,'f,'g>, y:System.Tuple<'a,'b,'c,'d,'e,'f,'g>) =
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
| _ ->
match phantom<'comp5>.Ensorcel (comparer, x.Item5, y.Item5) with
| x when x <> 0 -> x
| _ ->
match phantom<'comp6>.Ensorcel (comparer, x.Item6, y.Item6) with
| x when x <> 0 -> x
| _ ->
eliminate_tail_call_int (phantom<'comp7>.Ensorcel (comparer, x.Item7, y.Item7))
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,'b,'c,'d,'e,'f,'g,'h,
'comp1,'comp2,'comp3,'comp4,'comp5,'comp6,'comp7,'comp8
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
and 'comp6 :> IEssenceOfCompareTo<'f> and 'comp6 : (new : unit -> 'comp6) and 'comp6 : struct
and 'comp7 :> IEssenceOfCompareTo<'g> and 'comp7 : (new : unit -> 'comp7) and 'comp7 : struct
and 'comp8 :> IEssenceOfCompareTo<'h> and 'comp8 : (new : unit -> 'comp8) and 'comp8 : struct
> =
interface IEssenceOfCompareTo<System.Tuple<'a,'b,'c,'d,'e,'f,'g,'h>> with
member __.Ensorcel (comparer:IComparer, x:System.Tuple<'a,'b,'c,'d,'e,'f,'g,'h>, y:System.Tuple<'a,'b,'c,'d,'e,'f,'g,'h>) =
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
| _ ->
match phantom<'comp5>.Ensorcel (comparer, x.Item5, y.Item5) with
| x when x <> 0 -> x
| _ ->
match phantom<'comp6>.Ensorcel (comparer, x.Item6, y.Item6) with
| x when x <> 0 -> x
| _ ->
match phantom<'comp7>.Ensorcel (comparer, x.Item7, y.Item7) with
| x when x <> 0 -> x
| _ ->
eliminate_tail_call_int (phantom<'comp8>.Ensorcel (comparer, x.Rest, y.Rest))
module Nullable =
[<Struct; NoComparison; NoEquality>]
type StructuralComparable<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IStructuralComparable> =
interface IEssenceOfCompareTo<Nullable<'a>> 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)
[<Struct; NoComparison; NoEquality>]
type ComparableGeneric<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IComparable<'a>> =
interface IEssenceOfCompareTo<Nullable<'a>> 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
[<Struct; NoComparison; NoEquality>]
type Comparable<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IComparable> =
interface IEssenceOfCompareTo<Nullable<'a>> 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 =
[<Struct; NoComparison; NoEquality>]
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)
[<Struct; NoComparison; NoEquality>]
type ComparableGeneric<'a when 'a : struct and 'a :> IComparable<'a>> =
interface IEssenceOfCompareTo<'a> with
member __.Ensorcel (_:IComparer, x:'a, y:'a) =
x.CompareTo y
[<Struct; NoComparison; NoEquality>]
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 =
[<Struct; NoComparison; NoEquality>]
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)
[<Struct; NoComparison; NoEquality>]
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
[<Struct; NoComparison; NoEquality>]
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 =
[<Struct; NoComparison; NoEquality>]
type FloatPER =
interface IEssenceOfEquals<float>
with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>]
type Float32PER =
interface IEssenceOfEquals<float32> with
member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>]
type NullableFloatPER =
interface IEssenceOfEquals<Nullable<float>> with
member __.Ensorcel (_,x,y) =
match x.HasValue, y.HasValue with
| false, false -> true
| false, _
| _, false -> false
| _ -> x.Value = y.Value
[<Struct; NoComparison; NoEquality>]
type NullableFloat32PER =
interface IEssenceOfEquals<Nullable<float32>> with
member __.Ensorcel (_,x,y) =
match x.HasValue, y.HasValue with
| false, false -> true
| false, _
| _, false -> false
| _ -> x.Value = y.Value
[<Struct; NoComparison; NoEquality>]
type FloatER =
interface IEssenceOfEquals<float>
with member __.Ensorcel (_,x,y) = x.Equals y
[<Struct; NoComparison; NoEquality>]
type Float32ER =
interface IEssenceOfEquals<float32> with
member __.Ensorcel (_,x,y) = x.Equals y
[<Struct; NoComparison; NoEquality>]
type NullableFloatER =
interface IEssenceOfEquals<Nullable<float>> with
member __.Ensorcel (_,x,y) =
match x.HasValue, y.HasValue with
| false, false -> true
| false, _
| _, false -> false
| _ -> x.Value.Equals y.Value
[<Struct; NoComparison; NoEquality>]
type NullableFloat32ER =
interface IEssenceOfEquals<Nullable<float32>> with
member __.Ensorcel (_,x,y) =
match x.HasValue, y.HasValue with
| false, false -> true
| false, _
| _, false -> false
| _ -> x.Value.Equals y.Value
[<Struct; NoComparison; NoEquality>] type Bool = interface IEssenceOfEquals<bool > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Sbyte = interface IEssenceOfEquals<sbyte > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Int16 = interface IEssenceOfEquals<int16 > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Int32 = interface IEssenceOfEquals<int32 > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Int64 = interface IEssenceOfEquals<int64 > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Byte = interface IEssenceOfEquals<byte > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Uint16 = interface IEssenceOfEquals<uint16 > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Uint32 = interface IEssenceOfEquals<uint32 > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Uint64 = interface IEssenceOfEquals<uint64 > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Nativeint = interface IEssenceOfEquals<nativeint > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Unativeint = interface IEssenceOfEquals<unativeint> with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type Char = interface IEssenceOfEquals<char > with member __.Ensorcel (_,x,y) = x = y
[<Struct; NoComparison; NoEquality>] type String = interface IEssenceOfEquals<string > with member __.Ensorcel (_,x,y) = System.String.Equals(x, y)
[<Struct; NoComparison; NoEquality>] type Decimal = interface IEssenceOfEquals<decimal > with member __.Ensorcel (_,x,y) = System.Decimal.op_Equality(x, y)
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,
'eq1
when 'eq1 :> IEssenceOfEquals<'a> and 'eq1 : (new : unit -> 'eq1) and 'eq1 : struct
> =
interface IEssenceOfEquals<System.Tuple<'a>> with
member __.Ensorcel (ec:IEqualityComparer, x:System.Tuple<'a>, y:System.Tuple<'a>) =
match x, y with
| null, null -> true
| null, _ | _, null -> false
| _, _ ->
phantom<'eq1>.Ensorcel (ec, x.Item1, y.Item1)
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b>> 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)
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b,'c>> 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)
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b,'c,'d>> 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)
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b,'c,'d,'e>> 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)
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,'b,'c,'d,'e,'f,
'eq1,'eq2,'eq3,'eq4,'eq5,'eq6
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
and 'eq6 :> IEssenceOfEquals<'f> and 'eq6 : (new : unit -> 'eq6) and 'eq6 : struct
> =
interface IEssenceOfEquals<System.Tuple<'a,'b,'c,'d,'e,'f>> with
member __.Ensorcel (ec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d,'e,'f>, y:System.Tuple<'a,'b,'c,'d,'e,'f>) =
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
| _ ->
match phantom<'eq5>.Ensorcel (ec, x.Item5, y.Item5) with
| false -> false
| _ ->
phantom<'eq6>.Ensorcel (ec, x.Item6, y.Item6)
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,'b,'c,'d,'e,'f,'g,
'eq1,'eq2,'eq3,'eq4,'eq5,'eq6,'eq7
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
and 'eq6 :> IEssenceOfEquals<'f> and 'eq6 : (new : unit -> 'eq6) and 'eq6 : struct
and 'eq7 :> IEssenceOfEquals<'g> and 'eq7 : (new : unit -> 'eq7) and 'eq7 : struct
> =
interface IEssenceOfEquals<System.Tuple<'a,'b,'c,'d,'e,'f,'g>> with
member __.Ensorcel (ec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d,'e,'f,'g>, y:System.Tuple<'a,'b,'c,'d,'e,'f,'g>) =
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
| _ ->
match phantom<'eq5>.Ensorcel (ec, x.Item5, y.Item5) with
| false -> false
| _ ->
match phantom<'eq6>.Ensorcel (ec, x.Item6, y.Item6) with
| false -> false
| _ ->
phantom<'eq7>.Ensorcel (ec, x.Item7, y.Item7)
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,'b,'c,'d,'e,'f,'g,'h,
'eq1,'eq2,'eq3,'eq4,'eq5,'eq6,'eq7,'eq8
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
and 'eq6 :> IEssenceOfEquals<'f> and 'eq6 : (new : unit -> 'eq6) and 'eq6 : struct
and 'eq7 :> IEssenceOfEquals<'g> and 'eq7 : (new : unit -> 'eq7) and 'eq7 : struct
and 'eq8 :> IEssenceOfEquals<'h> and 'eq8 : (new : unit -> 'eq8) and 'eq8 : struct
> =
interface IEssenceOfEquals<System.Tuple<'a,'b,'c,'d,'e,'f,'g,'h>> with
member __.Ensorcel (ec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d,'e,'f,'g,'h>, y:System.Tuple<'a,'b,'c,'d,'e,'f,'g,'h>) =
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
| _ ->
match phantom<'eq5>.Ensorcel (ec, x.Item5, y.Item5) with
| false -> false
| _ ->
match phantom<'eq6>.Ensorcel (ec, x.Item6, y.Item6) with
| false -> false
| _ ->
match phantom<'eq7>.Ensorcel (ec, x.Item7, y.Item7) with
| false -> false
| _ ->
phantom<'eq8>.Ensorcel (ec, x.Rest, y.Rest)
module GetHashCodeTypes =
[<Struct; NoComparison; NoEquality>] type Bool = interface IEssenceOfGetHashCode<bool > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Float = interface IEssenceOfGetHashCode<float > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Sbyte = interface IEssenceOfGetHashCode<sbyte > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Int16 = interface IEssenceOfGetHashCode<int16 > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Int32 = interface IEssenceOfGetHashCode<int32 > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Int64 = interface IEssenceOfGetHashCode<int64 > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Byte = interface IEssenceOfGetHashCode<byte > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Uint16 = interface IEssenceOfGetHashCode<uint16 > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Uint32 = interface IEssenceOfGetHashCode<uint32 > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Uint64 = interface IEssenceOfGetHashCode<uint64 > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Nativeint = interface IEssenceOfGetHashCode<nativeint > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Unativeint = interface IEssenceOfGetHashCode<unativeint> with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Char = interface IEssenceOfGetHashCode<char > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type String = interface IEssenceOfGetHashCode<string > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Decimal = interface IEssenceOfGetHashCode<decimal > with member __.Ensorcel (_,a) = a.GetHashCode()
[<Struct; NoComparison; NoEquality>] type Float32 = interface IEssenceOfGetHashCode<float32 > 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 murmur3 (h:int32) =
let mutable h = uint32 h
h <- h ^^^ (h >>> 16);
h <- h * 0x85ebca6bu;
h <- h ^^^ (h >>> 13);
h <- h * 0xc2b2ae35u;
h <- h ^^^ (h >>> 16);
int h
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,
'ghc1
when 'ghc1 :> IEssenceOfGetHashCode<'a> and 'ghc1 : (new : unit -> 'ghc1) and 'ghc1 : struct
> =
interface IEssenceOfGetHashCode<System.Tuple<'a>> with
member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a>) =
(murmur3 (phantom<'ghc1>.Ensorcel (iec, x.Item1)))
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b>> with
member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b>) =
(murmur3 (phantom<'ghc1>.Ensorcel (iec, x.Item1))) +
(murmur3 (phantom<'ghc2>.Ensorcel (iec, x.Item2)))
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b,'c>> with
member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b,'c>) =
(murmur3 (phantom<'ghc1>.Ensorcel (iec, x.Item1))) +
(murmur3 (phantom<'ghc2>.Ensorcel (iec, x.Item2))) +
(murmur3 (phantom<'ghc3>.Ensorcel (iec, x.Item3)))
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b,'c,'d>> with
member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d>) =
(murmur3 (phantom<'ghc1>.Ensorcel (iec, x.Item1))) +
(murmur3 (phantom<'ghc2>.Ensorcel (iec, x.Item2))) +
(murmur3 (phantom<'ghc3>.Ensorcel (iec, x.Item3))) +
(murmur3 (phantom<'ghc4>.Ensorcel (iec, x.Item4)))
[<Struct; NoComparison; NoEquality>]
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<System.Tuple<'a,'b,'c,'d,'e>> with
member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d,'e>) =
(murmur3 (phantom<'ghc1>.Ensorcel (iec, x.Item1))) +
(murmur3 (phantom<'ghc2>.Ensorcel (iec, x.Item2))) +
(murmur3 (phantom<'ghc3>.Ensorcel (iec, x.Item3))) +
(murmur3 (phantom<'ghc4>.Ensorcel (iec, x.Item4))) +
(murmur3 (phantom<'ghc5>.Ensorcel (iec, x.Item5)))
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,'b,'c,'d,'e,'f,
'ghc1,'ghc2,'ghc3,'ghc4,'ghc5,'ghc6
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
and 'ghc6 :> IEssenceOfGetHashCode<'f> and 'ghc6 : (new : unit -> 'ghc6) and 'ghc6 : struct
> =
interface IEssenceOfGetHashCode<System.Tuple<'a,'b,'c,'d,'e,'f>> with
member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d,'e,'f>) =
(murmur3 (phantom<'ghc1>.Ensorcel (iec, x.Item1))) +
(murmur3 (phantom<'ghc2>.Ensorcel (iec, x.Item2))) +
(murmur3 (phantom<'ghc3>.Ensorcel (iec, x.Item3))) +
(murmur3 (phantom<'ghc4>.Ensorcel (iec, x.Item4))) +
(murmur3 (phantom<'ghc5>.Ensorcel (iec, x.Item5))) +
(murmur3 (phantom<'ghc6>.Ensorcel (iec, x.Item6)))
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,'b,'c,'d,'e,'f,'g,
'ghc1,'ghc2,'ghc3,'ghc4,'ghc5,'ghc6,'ghc7
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
and 'ghc6 :> IEssenceOfGetHashCode<'f> and 'ghc6 : (new : unit -> 'ghc6) and 'ghc6 : struct
and 'ghc7 :> IEssenceOfGetHashCode<'g> and 'ghc7 : (new : unit -> 'ghc7) and 'ghc7 : struct
> =
interface IEssenceOfGetHashCode<System.Tuple<'a,'b,'c,'d,'e,'f,'g>> with
member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d,'e,'f,'g>) =
(murmur3 (phantom<'ghc1>.Ensorcel (iec, x.Item1))) +
(murmur3 (phantom<'ghc2>.Ensorcel (iec, x.Item2))) +
(murmur3 (phantom<'ghc3>.Ensorcel (iec, x.Item3))) +
(murmur3 (phantom<'ghc4>.Ensorcel (iec, x.Item4))) +
(murmur3 (phantom<'ghc5>.Ensorcel (iec, x.Item5))) +
(murmur3 (phantom<'ghc6>.Ensorcel (iec, x.Item6))) +
(murmur3 (phantom<'ghc7>.Ensorcel (iec, x.Item7)))
[<Struct; NoComparison; NoEquality>]
type Tuple<'a,'b,'c,'d,'e,'f,'g,'h,
'ghc1,'ghc2,'ghc3,'ghc4,'ghc5,'ghc6,'ghc7,'ghc8
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
and 'ghc6 :> IEssenceOfGetHashCode<'f> and 'ghc6 : (new : unit -> 'ghc6) and 'ghc6 : struct
and 'ghc7 :> IEssenceOfGetHashCode<'g> and 'ghc7 : (new : unit -> 'ghc7) and 'ghc7 : struct
and 'ghc8 :> IEssenceOfGetHashCode<'h> and 'ghc8 : (new : unit -> 'ghc8) and 'ghc8 : struct
> =
interface IEssenceOfGetHashCode<System.Tuple<'a,'b,'c,'d,'e,'f,'g,'h>> with
member __.Ensorcel (iec:IEqualityComparer, x:System.Tuple<'a,'b,'c,'d,'e,'f,'g,'h>) =
(murmur3 (phantom<'ghc1>.Ensorcel (iec, x.Item1))) +
(murmur3 (phantom<'ghc2>.Ensorcel (iec, x.Item2))) +
(murmur3 (phantom<'ghc3>.Ensorcel (iec, x.Item3))) +
(murmur3 (phantom<'ghc4>.Ensorcel (iec, x.Item4))) +
(murmur3 (phantom<'ghc5>.Ensorcel (iec, x.Item5))) +
(murmur3 (phantom<'ghc6>.Ensorcel (iec, x.Item6))) +
(murmur3 (phantom<'ghc7>.Ensorcel (iec, x.Item7))) +
(murmur3 (phantom<'ghc8>.Ensorcel (iec, x.Rest)))
module CommonEqualityTypes =
module Nullable =
[<Struct; NoComparison; NoEquality>]
type StructuralEquatable<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IStructuralEquatable> =
interface IEssenceOfEquals<Nullable<'a>> 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<Nullable<'a>> with
member __.Ensorcel (ec:IEqualityComparer, x:Nullable<'a>) =
if x.HasValue then x.Value.GetHashCode (ec)
else 0
[<Struct; NoComparison; NoEquality>]
type Equatable<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a :> IEquatable<'a>> =
interface IEssenceOfEquals<Nullable<'a>> 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
[<Struct; NoComparison; NoEquality>]
type Equality<'a when 'a : struct and 'a : (new : unit -> 'a) and 'a :> ValueType and 'a : equality> =
interface IEssenceOfEquals<Nullable<'a>> 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<Nullable<'a>> with
member __.Ensorcel (_:IEqualityComparer, x:Nullable<'a>) =
if x.HasValue then x.Value.GetHashCode ()
else 0
module ValueType =
[<Struct; NoComparison; NoEquality>]
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)
[<Struct; NoComparison; NoEquality>]
type Equatable<'a when 'a : struct and 'a :> IEquatable<'a>> =
interface IEssenceOfEquals<'a> with
member __.Ensorcel (_:IEqualityComparer, x:'a, y:'a) =
x.Equals y
[<Struct; NoComparison; NoEquality>]
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 =
[<Struct; NoComparison; NoEquality>]
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)
[<Struct; NoComparison; NoEquality>]
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
[<Struct; NoComparison; NoEquality>]
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.")
[<Struct; CustomComparison; CustomEquality>]
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<IEquatable<_>> [|ty|]
let makeComparableType ty =
makeGenericType<IComparable<_>> [|ty|]
let rec private tryFindObjectsInterfaceMethod (objectType:Type) (interfaceType:Type) (methodName:string) (methodArgTypes:array<Type>) =
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 (interfaceMap.InterfaceMethods.[index]) then (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<CompilerGeneratedAttribute> with
| null -> false
| _ -> true
let rec private isCompilerGeneratedMethod (objectType:Type) (methodName:string) (methodArgTypes:array<Type>) =
match objectType.GetMethod (methodName, methodArgTypes) with
| null -> false
| m ->
match m.GetCustomAttribute typeof<CompilerGeneratedAttribute> with
| null -> false
| _ -> true
let hasFSharpCompilerGeneratedEquality (ty:Type) =
match ty.GetCustomAttribute typeof<CompilationMappingAttribute> 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<IStructuralEquatable> "Equals" [|typeof<obj>; typeof<IEqualityComparer>|]
&& isCompilerGeneratedMethod ty "Equals" [|typeof<obj>|]
| _ -> false
let hasFSharpCompilerGeneratedComparison (ty:Type) =
match ty.GetCustomAttribute typeof<CompilationMappingAttribute> 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<IStructuralComparable> "CompareTo" [|typeof<obj>; typeof<IComparer>|]
&& isCompilerGeneratedInterfaceMethod ty typeof<IComparable> "CompareTo" [|typeof<obj>|]
| _ -> false
let takeFirstNonNull (items:array<_>) =
let rec takeFirst idx =
if idx = items.Length then raise (Exception "invalid logic")
else
let f = 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[] =
match box (Array.CreateInstance (typeof<Type>, args.Length*2)) with
| :? array<Type> as t -> t
| _ -> failwith ""
for i = 0 to args.Length-1 do
let argType = 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<PartialEquivalenceRelation> ->
match ty with
| t when t.Equals typeof<float> -> typeof<ComparerTypes.FloatPER>
| t when t.Equals typeof<float32> -> typeof<ComparerTypes.Float32PER>
| t when t.Equals typeof<Nullable<float>> -> typeof<ComparerTypes.NullableFloatPER>
| t when t.Equals typeof<Nullable<float32>> -> typeof<ComparerTypes.NullableFloat32PER>
| _ -> null
| r when r.Equals typeof<EquivalenceRelation> ->
match ty with
| t when t.Equals typeof<float> -> typeof<ComparerTypes.FloatER>
| t when t.Equals typeof<float32> -> typeof<ComparerTypes.Float32ER>
| t when t.Equals typeof<Nullable<float>> -> typeof<ComparerTypes.NullableFloatER>
| t when t.Equals typeof<Nullable<float32>> -> typeof<ComparerTypes.NullableFloat32ER>
| _ -> null
| _ -> raise (Exception "invalid logic")
let standardTypes (t:Type) : Type =
if t.Equals typeof<bool> then typeof<ComparerTypes.Bool>
elif t.Equals typeof<sbyte> then typeof<ComparerTypes.Sbyte>
elif t.Equals typeof<int16> then typeof<ComparerTypes.Int16>
elif t.Equals typeof<int32> then typeof<ComparerTypes.Int32>
elif t.Equals typeof<int64> then typeof<ComparerTypes.Int64>
elif t.Equals typeof<nativeint> then typeof<ComparerTypes.Nativeint>
elif t.Equals typeof<byte> then typeof<ComparerTypes.Byte>
elif t.Equals typeof<uint16> then typeof<ComparerTypes.Uint16>
elif t.Equals typeof<uint32> then typeof<ComparerTypes.Uint32>
elif t.Equals typeof<uint64> then typeof<ComparerTypes.Uint64>
elif t.Equals typeof<unativeint> then typeof<ComparerTypes.Unativeint>
elif t.Equals typeof<char> then typeof<ComparerTypes.Char>
elif t.Equals typeof<string> then typeof<ComparerTypes.String>
elif t.Equals typeof<decimal> then typeof<ComparerTypes.Decimal>
else null
let compilerGenerated tyRelation ty =
match tyRelation with
| r when r.Equals typeof<EquivalenceRelation> ->
if mos.hasFSharpCompilerGeneratedComparison ty then
if ty.IsValueType
then mos.makeType ty typedefof<ComparerTypes.ValueType.ComparableGeneric<int>>
else mos.makeType ty typedefof<ComparerTypes.RefType. ComparableGeneric<string>>
else null
| r when r.Equals typeof<PartialEquivalenceRelation> -> null
| _ -> raise (Exception "invalid logic")
[<Struct;NoComparison;NoEquality>]
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<System.Array>.IsAssignableFrom t then
// TODO: Future; for now just default back to previous functionality
mos.makeType t typedefof<GenericComparerObj<_>>
else null
let nullableType (t:Type) : Type =
if t.IsGenericType && ((t.GetGenericTypeDefinition ()).Equals typedefof<System.Nullable<_>>) then
let underlying = (t.GetGenericArguments()).[0]
let comparableGeneric = mos.makeComparableType underlying
let make = mos.makeType underlying
if typeof<IStructuralComparable>.IsAssignableFrom underlying then make typedefof<ComparerTypes.Nullable. StructuralComparable<DummyValueType>>
elif comparableGeneric.IsAssignableFrom underlying then make typedefof<ComparerTypes.Nullable. ComparableGeneric<int>>
else make typedefof<ComparerTypes.Nullable. Comparable<int>>
else null
let comparisonInterfaces (t:Type) : Type =
let make = mos.makeType t
let comparableGeneric = mos.makeComparableType t
if t.IsValueType && typeof<IStructuralComparable>.IsAssignableFrom t then make typedefof<ComparerTypes.ValueType.StructuralComparable<DummyValueType>>
elif t.IsValueType && comparableGeneric.IsAssignableFrom t then make typedefof<ComparerTypes.ValueType.ComparableGeneric<int>>
elif t.IsValueType && typeof<IComparable>.IsAssignableFrom t then make typedefof<ComparerTypes.ValueType.Comparable<int>>
elif typeof<IStructuralComparable>.IsAssignableFrom t then make typedefof<ComparerTypes.RefType. StructuralComparable<Tuple<int,int>>>
// only sealed as a derived class might inherit from IStructuralComparable
elif t.IsSealed && comparableGeneric.IsAssignableFrom t then make typedefof<ComparerTypes.RefType. ComparableGeneric<string>>
elif t.IsSealed && typeof<IComparable>.IsAssignableFrom t then make typedefof<ComparerTypes.RefType. Comparable<string>>
else null
let defaultCompare ty =
mos.makeType ty typedefof<GenericComparerObj<_>>
let getCompareEssenceType (tyRelation:Type) (ty:Type) tuples : Type =
mos.takeFirstNonNull [|
fun () -> tuples tyRelation ty
fun () -> floatingPointTypes tyRelation ty
fun () -> standardTypes ty
fun () -> compilerGenerated tyRelation ty
fun () -> arrays ty
fun () -> nullableType ty
fun () -> comparisonInterfaces ty
fun () -> defaultCompare ty
|]
[<AbstractClass>]
type ComparerInvoker<'a>() =
class
abstract Invoke : IComparer * 'a * 'a -> int
end
[<Sealed>]
type EssenceOfCompareWrapper<'a, 'comp
when 'comp :> IEssenceOfCompareTo<'a> and 'comp : (new : unit -> 'comp) and 'comp : struct>() =
inherit ComparerInvoker<'a>()
override __.Invoke (comp, x:'a, y:'a) =
phantom<'comp>.Ensorcel (comp, x, y)
let makeComparerInvoker (ty:Type) comp =
let wrapperTypeDef = typedefof<EssenceOfCompareWrapper<int,ComparerTypes.Int32>>
let wrapperType = wrapperTypeDef.MakeGenericType [| ty; comp |]
Activator.CreateInstance wrapperType
type t = ComparerTypes.Int32
type Function<'relation, 'a>() =
static let essenceType : Type =
getCompareEssenceType typeof<'relation> typeof<'a> Helpers.tuplesCompareTo
static let invoker : ComparerInvoker<'a> =
match (makeComparerInvoker typeof<'a> essenceType) with
| :? ComparerInvoker<'a> as c -> c
| _ -> failwith ""
static member Invoker = invoker
interface mos.IGetType with
member __.Get () = essenceType
and Helpers =
static member getEssenceOfCompareToType (tyRelation:Type) (ty:Type) =
let compareTo = mos.makeGenericType<Function<_,_>> [|tyRelation; ty|]
match Activator.CreateInstance compareTo with
| :? mos.IGetType as getter -> getter.Get ()
| _ -> raise (Exception "invalid logic")
static member tuplesCompareTo (tyRelation:Type) (ty:Type) : Type =
if ty.IsGenericType then
let tyDef = ty.GetGenericTypeDefinition ()
let tyDefArgs = ty.GetGenericArguments ()
let create = mos.compositeType (Helpers.getEssenceOfCompareToType tyRelation) tyDefArgs
if tyDef.Equals typedefof<Tuple<_>> then create typedefof<ComparerTypes.Tuple<int,t>>
elif tyDef.Equals typedefof<Tuple<_,_>> then create typedefof<ComparerTypes.Tuple<int,int,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_>> then create typedefof<ComparerTypes.Tuple<int,int,int,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_>> then create typedefof<ComparerTypes.Tuple<int,int,int,int,t,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_>> then create typedefof<ComparerTypes.Tuple<int,int,int,int,int,t,t,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_,_>> then create typedefof<ComparerTypes.Tuple<int,int,int,int,int,int,t,t,t,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_,_,_>> then create typedefof<ComparerTypes.Tuple<int,int,int,int,int,int,int,t,t,t,t,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_,_,_,_>> then create typedefof<ComparerTypes.Tuple<int,int,int,int,int,int,int,int,t,t,t,t,t,t,t,t>>
else null
else null
// let GenericComparisonForInequality comp x y =
// GenericSpecializeCompareTo.Function<PartialEquivalenceRelation,_>.Invoker.Invoke (comp, x, y)
// functionality of GenericSpecializedHash should match GenericHashParamObj, or return null
// for fallback to that funciton.
module GenericSpecializeHash =
let standardTypes (t:Type) : Type =
if t.Equals typeof<bool> then typeof<GetHashCodeTypes.Bool>
elif t.Equals typeof<float> then typeof<GetHashCodeTypes.Float>
elif t.Equals typeof<sbyte> then typeof<GetHashCodeTypes.Sbyte>
elif t.Equals typeof<int16> then typeof<GetHashCodeTypes.Int16>
elif t.Equals typeof<int32> then typeof<GetHashCodeTypes.Int32>
elif t.Equals typeof<int64> then typeof<GetHashCodeTypes.Int64>
elif t.Equals typeof<byte> then typeof<GetHashCodeTypes.Byte>
elif t.Equals typeof<uint16> then typeof<GetHashCodeTypes.Uint16>
elif t.Equals typeof<uint32> then typeof<GetHashCodeTypes.Uint32>
elif t.Equals typeof<uint64> then typeof<GetHashCodeTypes.Uint64>
elif t.Equals typeof<nativeint> then typeof<GetHashCodeTypes.Nativeint>
elif t.Equals typeof<unativeint> then typeof<GetHashCodeTypes.Unativeint>
elif t.Equals typeof<char> then typeof<GetHashCodeTypes.Char>
elif t.Equals typeof<string> then typeof<GetHashCodeTypes.String>
elif t.Equals typeof<decimal> then typeof<GetHashCodeTypes.Decimal>
elif t.Equals typeof<float32> then typeof<GetHashCodeTypes.Float32>
else null
[<Struct;NoComparison;NoEquality>]
type GenericHashParamObject<'a> =
interface IEssenceOfGetHashCode<'a> with
member __.Ensorcel (iec:IEqualityComparer, x:'a) = failwith ""
let arrays (t:Type) : Type =
if t.IsArray || typeof<System.Array>.IsAssignableFrom t then
// TODO: Future; for now just default back to previous functionality
mos.makeType t typedefof<GenericHashParamObject<_>>
else null
let nullableType (t:Type) : Type =
if t.IsGenericType && ((t.GetGenericTypeDefinition ()).Equals typedefof<System.Nullable<_>>) then
let underlying = (t.GetGenericArguments()).[0]
let make = mos.makeType underlying
if typeof<IStructuralEquatable>.IsAssignableFrom underlying then make typedefof<CommonEqualityTypes.Nullable. StructuralEquatable<DummyValueType>>
else make typedefof<CommonEqualityTypes.Nullable.Equality<int>>
else null
let structualEquatable (t:Type): Type =
let make = mos.makeType t
if t.IsValueType && typeof<IStructuralEquatable>.IsAssignableFrom t then make typedefof<CommonEqualityTypes.ValueType.StructuralEquatable<DummyValueType>>
elif typeof<IStructuralEquatable>.IsAssignableFrom t then make typedefof<CommonEqualityTypes.RefType.StructuralEquatable<Tuple<int,int>>>
else null
let sealedTypes (t:Type): Type =
let make = mos.makeType t
if t.IsValueType then make typedefof<CommonEqualityTypes.ValueType.Equality<int>>
elif t.IsSealed then make typedefof<CommonEqualityTypes.RefType.Equality<string>>
else null
let defaultGetHashCode ty =
mos.makeType ty typedefof<GenericHashParamObject<_>>
let getGetHashCodeEssenceType (t:Type) tuples : Type =
mos.takeFirstNonNull [|
fun () -> tuples t
fun () -> standardTypes t
fun () -> arrays t
fun () -> nullableType t
fun () -> structualEquatable t
fun () -> sealedTypes t
fun () -> defaultGetHashCode t
|]
[<AbstractClass>]
type GetHashCodeInvoker<'a>() =
class
abstract Invoke : IEqualityComparer * 'a -> int
end
[<Sealed>]
type EssenceOfGetHashCodeWrapper<'a, 'ghc
when 'ghc :> IEssenceOfGetHashCode<'a> and 'ghc : (new : unit -> 'ghc) and 'ghc : struct>() =
inherit GetHashCodeInvoker<'a>()
override __.Invoke (comp, x:'a) =
phantom<'ghc>.Ensorcel (comp, x)
let makeGetHashCodeWrapper (ty:Type) comp =
let wrapperTypeDef = typedefof<EssenceOfGetHashCodeWrapper<int,GetHashCodeTypes.Int32>>
let wrapperType = wrapperTypeDef.MakeGenericType [| ty; comp |]
Activator.CreateInstance wrapperType
type t = GetHashCodeTypes.Int32
type Function<'a>() =
static let essenceType : Type =
getGetHashCodeEssenceType typeof<'a> Helpers.tuplesGetHashCode
static let invoker : GetHashCodeInvoker<'a> =
match (makeGetHashCodeWrapper typeof<'a> essenceType) with
| :? GetHashCodeInvoker<'a> as x -> x
| _ -> failwith ""
static member Invoker = invoker
interface mos.IGetType with
member __.Get () = essenceType
and Helpers =
static member getEssenceOfGetHashCodeType ty =
let getHashCode = mos.makeGenericType<Function<_>> [|ty|]
match Activator.CreateInstance getHashCode with
| :? mos.IGetType as getter -> getter.Get ()
| _ -> raise (Exception "invalid logic")
static member tuplesGetHashCode (ty:Type) : Type =
if ty.IsGenericType then
let tyDef = ty.GetGenericTypeDefinition ()
let tyDefArgs = ty.GetGenericArguments ()
let create = mos.compositeType Helpers.getEssenceOfGetHashCodeType tyDefArgs
if tyDef.Equals typedefof<Tuple<_>> then create typedefof<GetHashCodeTypes.Tuple<int,t>>
elif tyDef.Equals typedefof<Tuple<_,_>> then create typedefof<GetHashCodeTypes.Tuple<int,int,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_>> then create typedefof<GetHashCodeTypes.Tuple<int,int,int,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_>> then create typedefof<GetHashCodeTypes.Tuple<int,int,int,int,t,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_>> then create typedefof<GetHashCodeTypes.Tuple<int,int,int,int,int,t,t,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_,_>> then create typedefof<GetHashCodeTypes.Tuple<int,int,int,int,int,int,t,t,t,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_,_,_>> then create typedefof<GetHashCodeTypes.Tuple<int,int,int,int,int,int,int,t,t,t,t,t,t,t>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_,_,_,_>> then create typedefof<GetHashCodeTypes.Tuple<int,int,int,int,int,int,int,int,t,t,t,t,t,t,t,t>>
else null
else null
type EqualityComparerInfo =
| PER = 0
| ER = 1
type IEqualityComparerInfo =
abstract Info : EqualityComparerInfo
let fsEqualityComparerNoHashingPER =
{ new System.Collections.IEqualityComparer with
override iec.Equals(x:obj,y:obj) = failwith ""
override iec.GetHashCode(x:obj) = failwith ""
interface IEqualityComparerInfo with
member __.Info = EqualityComparerInfo.PER }
/// 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) = failwith ""
override iec.GetHashCode(x:obj) = failwith ""
interface IEqualityComparerInfo with
member __.Info = EqualityComparerInfo.ER }
module GenericSpecializeEquals =
let floatingPointTypes (tyRelation:Type) (ty:Type) =
match tyRelation with
| r when r.Equals typeof<PartialEquivalenceRelation> ->
match ty with
| t when t.Equals typeof<float> -> typeof<EqualsTypes.FloatPER>
| t when t.Equals typeof<float32> -> typeof<EqualsTypes.Float32PER>
| t when t.Equals typeof<Nullable<float>> -> typeof<EqualsTypes.NullableFloatPER>
| t when t.Equals typeof<Nullable<float32>> -> typeof<EqualsTypes.NullableFloat32PER>
| _ -> null
| r when r.Equals typeof<EquivalenceRelation> ->
match ty with
| t when t.Equals typeof<float> -> typeof<EqualsTypes.FloatER>
| t when t.Equals typeof<float32> -> typeof<EqualsTypes.Float32ER>
| t when t.Equals typeof<Nullable<float>> -> typeof<EqualsTypes.NullableFloatER>
| t when t.Equals typeof<Nullable<float32>> -> typeof<EqualsTypes.NullableFloat32ER>
| _ -> null
| _ -> raise (Exception "invalid logic")
let standardTypes (t:Type) : Type =
if t.Equals typeof<bool> then typeof<EqualsTypes.Bool>
elif t.Equals typeof<sbyte> then typeof<EqualsTypes.Sbyte>
elif t.Equals typeof<int16> then typeof<EqualsTypes.Int16>
elif t.Equals typeof<int32> then typeof<EqualsTypes.Int32>
elif t.Equals typeof<int64> then typeof<EqualsTypes.Int64>
elif t.Equals typeof<byte> then typeof<EqualsTypes.Byte>
elif t.Equals typeof<uint16> then typeof<EqualsTypes.Uint16>
elif t.Equals typeof<uint32> then typeof<EqualsTypes.Uint32>
elif t.Equals typeof<uint64> then typeof<EqualsTypes.Uint64>
elif t.Equals typeof<nativeint> then typeof<EqualsTypes.Nativeint>
elif t.Equals typeof<unativeint> then typeof<EqualsTypes.Unativeint>
elif t.Equals typeof<char> then typeof<EqualsTypes.Char>
elif t.Equals typeof<string> then typeof<EqualsTypes.String>
elif t.Equals typeof<decimal> then typeof<EqualsTypes.Decimal>
else null
let compilerGenerated tyRelation ty =
// if we are using the ER comparer, and we are a standard f# record or value type with compiler generated
// equality operators, then we can avoid the boxing of IStructuralEquatable and just call the
// IEquatable<'a>.Equals method.
match tyRelation with
| r when r.Equals typeof<EquivalenceRelation> ->
if mos.hasFSharpCompilerGeneratedEquality ty then
if ty.IsValueType
then mos.makeType ty typedefof<CommonEqualityTypes.ValueType.Equatable<int>>
else mos.makeType ty typedefof<CommonEqualityTypes.RefType.Equatable<string>>
else null
| r when r.Equals typeof<PartialEquivalenceRelation> -> null
| _ -> raise (Exception "invalid logic")
[<Struct;NoComparison;NoEquality>]
type GenericEqualityObj_ER<'a> =
interface IEssenceOfEquals<'a> with
member __.Ensorcel (ec:IEqualityComparer, x:'a, y:'a) = failwith ""
[<Struct;NoComparison;NoEquality>]
type GenericEqualityObj_PER<'a> =
interface IEssenceOfEquals<'a> with
member __.Ensorcel (ec:IEqualityComparer, x:'a, y:'a) = failwith ""
let arrays (tyRelation:Type) (t:Type) : Type =
if t.IsArray || typeof<System.Array>.IsAssignableFrom t then
// TODO: Future; for now just default back to previous functionality
match tyRelation with
| r when r.Equals typeof<PartialEquivalenceRelation> -> mos.makeType t typedefof<GenericEqualityObj_PER<_>>
| r when r.Equals typeof<EquivalenceRelation> -> mos.makeType t typedefof<GenericEqualityObj_ER<_>>
| _ -> raise (Exception "invalid logic")
else null
let nullableType (t:Type) : Type =
if t.IsGenericType && ((t.GetGenericTypeDefinition ()).Equals typedefof<System.Nullable<_>>) then
let underlying = (t.GetGenericArguments()).[0]
let equatable = mos.makeEquatableType underlying
let make = mos.makeType underlying
if typeof<IStructuralEquatable>.IsAssignableFrom underlying then make typedefof<CommonEqualityTypes.Nullable. StructuralEquatable<DummyValueType>>
elif equatable.IsAssignableFrom underlying then make typedefof<CommonEqualityTypes.Nullable.Equatable<int>>
else make typedefof<CommonEqualityTypes.Nullable.Equality<int>>
else null
let equalityInterfaces (t:Type) : Type =
let make = mos.makeType t
let equatable = mos.makeEquatableType t
if t.IsValueType && typeof<IStructuralEquatable>.IsAssignableFrom t then make typedefof<CommonEqualityTypes.ValueType.StructuralEquatable<DummyValueType>>
elif t.IsValueType && equatable.IsAssignableFrom t then make typedefof<CommonEqualityTypes.ValueType.Equatable<int>>
elif t.IsValueType then make typedefof<CommonEqualityTypes.ValueType.Equality<int>>
elif typeof<IStructuralEquatable>.IsAssignableFrom t then make typedefof<CommonEqualityTypes.RefType.StructuralEquatable<Tuple<int,int>>>
// only sealed as a derived class might inherit from IStructuralEquatable
elif t.IsSealed && equatable.IsAssignableFrom t then make typedefof<CommonEqualityTypes.RefType.Equatable<string>>
elif t.IsSealed then make typedefof<CommonEqualityTypes.RefType.Equality<string>>
else null
let defaultEquality tyRelation ty =
match tyRelation with
| r when r.Equals typeof<PartialEquivalenceRelation> -> mos.makeType ty typedefof<GenericEqualityObj_PER<_>>
| r when r.Equals typeof<EquivalenceRelation> -> mos.makeType ty typedefof<GenericEqualityObj_ER<_>>
| _ -> raise (Exception "invalid logic")
let getEqualsEssenceType (tyRelation:Type) (ty:Type) tuples : Type =
mos.takeFirstNonNull [|
fun () -> tuples tyRelation ty
fun () -> floatingPointTypes tyRelation ty
fun () -> standardTypes ty
fun () -> compilerGenerated tyRelation ty
fun () -> arrays tyRelation ty
fun () -> nullableType ty
fun () -> equalityInterfaces ty
fun () -> defaultEquality tyRelation ty
|]
[<AbstractClass>]
type EqualsInvoker<'a>() =
class
abstract Invoke : IEqualityComparer * 'a * 'a -> bool
end
[<Sealed>]
type EssenceOfEqualsWrapper<'a, 'eq
when 'eq :> IEssenceOfEquals<'a> and 'eq : (new : unit -> 'eq) and 'eq : struct>() =
inherit EqualsInvoker<'a>()
override __.Invoke (comp, x:'a, y:'a) =
phantom<'eq>.Ensorcel (comp, x, y)
let makeEqualsWrapper (ty:Type) comp =
let wrapperTypeDef = typedefof<EssenceOfEqualsWrapper<int,EqualsTypes.Int32>>
let wrapperType = wrapperTypeDef.MakeGenericType [| ty; comp |]
Activator.CreateInstance wrapperType
type u = EqualsTypes.Int32
type Function<'relation, 'a>() =
static let essenceType : Type =
getEqualsEssenceType typeof<'relation> typeof<'a> Helpers.tuplesEquals
static let invoker : EqualsInvoker<'a> =
match (makeEqualsWrapper typeof<'a> essenceType) with
| :? EqualsInvoker<'a> as x -> x
| _ -> failwith "boom"
static member Invoker = invoker
interface mos.IGetType with
member __.Get () = essenceType
and Helpers =
static member getEssenceOfEqualsType tyRelation ty =
let equals = mos.makeGenericType<Function<_,_>> [| tyRelation; ty|]
match Activator.CreateInstance equals with
| :? mos.IGetType as getter -> getter.Get ()
| _ -> raise (Exception "invalid logic")
static member tuplesEquals (tyRelation:Type) (ty:Type) : Type =
if ty.IsGenericType then
let tyDef = ty.GetGenericTypeDefinition ()
let tyDefArgs = ty.GetGenericArguments ()
let create = mos.compositeType (Helpers.getEssenceOfEqualsType tyRelation) tyDefArgs
if tyDef.Equals typedefof<Tuple<_>> then create typedefof<EqualsTypes.Tuple<int,u>>
elif tyDef.Equals typedefof<Tuple<_,_>> then create typedefof<EqualsTypes.Tuple<int,int,u,u>>
elif tyDef.Equals typedefof<Tuple<_,_,_>> then create typedefof<EqualsTypes.Tuple<int,int,int,u,u,u>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_>> then create typedefof<EqualsTypes.Tuple<int,int,int,int,u,u,u,u>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_>> then create typedefof<EqualsTypes.Tuple<int,int,int,int,int,u,u,u,u,u>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_,_>> then create typedefof<EqualsTypes.Tuple<int,int,int,int,int,int,u,u,u,u,u,u>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_,_,_>> then create typedefof<EqualsTypes.Tuple<int,int,int,int,int,int,int,u,u,u,u,u,u,u>>
elif tyDef.Equals typedefof<Tuple<_,_,_,_,_,_,_,_>> then create typedefof<EqualsTypes.Tuple<int,int,int,int,int,int,int,int,u,u,u,u,u,u,u,u>>
else null
else null
/// 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 =
eliminate_tail_call_bool (GenericSpecializeEquals.Function<PartialEquivalenceRelation,_>.Invoker.Invoke (fsEqualityComparerNoHashingPER, x, y))
/// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true)
//
// ER semantics is used for recursive calls when implementing .Equals(that) for structural data, see the code generated for record and union types in augment.fs
//
// 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 =
eliminate_tail_call_bool (GenericSpecializeEquals.Function<EquivalenceRelation,_>.Invoker.Invoke (fsEqualityComparerNoHashingER, 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.
//
// <<manofstick>> I think the above compiler optimization is misplaced, as it means that you can end
// up with differing functionality of generic and non-generic types when the IStructuralEquatable
// this is doucmented here- https://github.com/Microsoft/visualfsharp/pull/513#issuecomment-117995410
let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool =
match comp with
| :? IEqualityComparerInfo as info ->
match info.Info with
| EqualityComparerInfo.ER -> eliminate_tail_call_bool (GenericEqualityERIntrinsic x y)
| EqualityComparerInfo.PER -> eliminate_tail_call_bool (GenericEqualityIntrinsic x y)
| _ -> raise (Exception "invalid logic")
| c when obj.ReferenceEquals (c, EqualityComparer<'T>.Default) ->
eliminate_tail_call_bool (EqualityComparer<'T>.Default.Equals (x, y))
| _ ->
eliminate_tail_call_bool (comp.Equals (box x, box y))
type UnlimitedHasherPER() =
interface System.Collections.IEqualityComparer with
override iec.Equals(x:obj,y:obj) = failwith ""
override iec.GetHashCode(x:obj) = failwith ""
interface IEqualityComparerInfo with
member __.Info = EqualityComparerInfo.PER
let fsEqualityComparerUnlimitedHashingPER = UnlimitedHasherPER() :> IEqualityComparer
[<Sealed>]
type EssenceOfEqualityComparer<'a, 'eq, 'ghc
when 'eq :> IEssenceOfEquals<'a> and 'eq : (new : unit -> 'eq) and 'eq : struct
and 'ghc :> IEssenceOfGetHashCode<'a> and 'ghc : (new : unit -> 'ghc) and 'ghc : struct>() =
interface IEqualityComparer<'a> with
member __.Equals (x:'a, y:'a) =
phantom<'eq>.Ensorcel (fsEqualityComparerNoHashingPER, x, y)
member __.GetHashCode (x:'a) =
phantom<'ghc>.Ensorcel (fsEqualityComparerUnlimitedHashingPER, x)
[<Sealed>]
type EssenceOfComparer<'a, 'comp
when 'comp :> IEssenceOfCompareTo<'a> and 'comp : (new : unit -> 'comp) and 'comp : struct>() =
interface IComparer<'a> with
member __.Compare (x:'a, y:'a) =
phantom<'comp>.Ensorcel (fsComparerER, x, y)
let makeEqualityComparer (ty:Type) =
let eq = GenericSpecializeEquals.Helpers.getEssenceOfEqualsType typeof<EquivalenceRelation> ty
let ghc = GenericSpecializeHash.Helpers.getEssenceOfGetHashCodeType ty
let equalityComparerDef = typedefof<EssenceOfEqualityComparer<int,EqualsTypes.Int32,GetHashCodeTypes.Int32>>
let equalityComparer = equalityComparerDef.MakeGenericType [| ty; eq; ghc |]
Activator.CreateInstance equalityComparer
let makeComparer (ty:Type) =
let comp = GenericSpecializeCompareTo.Helpers.getEssenceOfCompareToType typeof<EquivalenceRelation> ty
let comparerDef = typedefof<EssenceOfComparer<int,ComparerTypes.Int32>>
let comparer = comparerDef.MakeGenericType [| ty; comp |]
Activator.CreateInstance comparer
module Comparers =
open System
open System.Collections
open System.Collections.Generic
open System.Reflection
open System.Runtime.CompilerServices
open HackedOutOfPrimTypes
type EqualityComparer<'a>() =
static let f : IEqualityComparer<'a> =
match makeEqualityComparer typeof<'a> with
| :? IEqualityComparer<'a> as ec -> ec
| _ -> failwith ""
static member Default = f
type Comparer<'a>() =
static let f : IComparer<'a> =
match makeComparer typeof<'a> with
| :? IComparer<'a> as ec -> ec
| _ -> failwith ""
static member Default = f
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment