Skip to content
executable file 6462 lines (5614 sloc) 379 KB
// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information.
#nowarn "25" // Incomplete match expressions
#nowarn "35" // This construct is deprecated: the treatment of this operator is now handled directly by the F# compiler and its meaning may not be redefined.
#nowarn "44" // This construct is deprecated. This function is for use by compiled F# code and should not be used directly
#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation
#nowarn "60" // Override implementations in augmentations are now deprecated. Override implementations should be given as part of the initial declaration of a type.
#nowarn "61" // The containing type can use 'null' as a representation value for its nullary union case. This member will be compiled as a static member.
#nowarn "62" // The syntax 'module ... : sig .. end' is for ML compatibility. Consider using 'module ... = begin .. end'.
#nowarn "69" // Interface implementations in augmentations are now deprecated. Interface implementations should be given on the initial declaration of a type.
#nowarn "77" // Member constraints with the name 'Exp' are given special status by the F# compiler as certain .NET types are implicitly augmented with this member. This may result in compilation failures if you attempt to invoke the member constraint from your own code.
namespace Microsoft.FSharp.Core
open System
open System.Collections
open System.Collections.Generic
open System.Diagnostics
open System.Globalization
open System.Reflection
open System.Text
//-------------------------------------------------------------------------
// Unit
[<CodeAnalysis.SuppressMessage("Microsoft.Design", "CA1036:OverrideMethodsOnComparableTypes")>] // No op_equality on unit
type Unit() =
override x.GetHashCode() = 0
override x.Equals(obj:obj) =
match obj with null -> true | :? Unit -> true | _ -> false
interface System.IComparable with
member x.CompareTo(_obj:obj) = 0
and unit = Unit
#if FX_NO_STRUCTURAL_EQUALITY
namespace System.Collections
open System
open Microsoft.FSharp.Core
//-------------------------------------------------------------------------
// Structural equality
type IStructuralEquatable =
interface
abstract Equals: o:System.Object * comp:System.Collections.IEqualityComparer -> bool
abstract GetHashCode: comp:System.Collections.IEqualityComparer -> int
end
//-------------------------------------------------------------------------
// Structural comparison
and IStructuralComparable =
interface
abstract CompareTo: o:System.Object * comp:System.Collections.IComparer -> int
end
#else
#endif
namespace Microsoft.FSharp.Core
open System
open System.Collections
open System.Collections.Generic
open System.Diagnostics
open System.Globalization
open System.Text
//-------------------------------------------------------------------------
// enumerations
type SourceConstructFlags =
| None = 0
| SumType = 1
| RecordType = 2
| ObjectType = 3
| Field = 4
| Exception = 5
| Closure = 6
| Module = 7
| UnionCase = 8
| Value = 9
| KindMask = 31
| NonPublicRepresentation = 32
[<Flags>]
type CompilationRepresentationFlags =
| None = 0
| Static = 1
| Instance = 2
| ModuleSuffix = 4 // append 'Module' to the end of a non-unique module
| UseNullAsTrueValue = 8 // Note if you change this then change CompilationRepresentationFlags_PermitNull further below
| Event = 16
#if FX_NO_ICLONEABLE
module ICloneableExtensions =
type System.Array with
member x.Clone() =
let ty = (x.GetType()).GetElementType()
let clone = System.Array.CreateInstance(ty,x.Length)
x.CopyTo(clone,0)
clone
open ICloneableExtensions
#endif
[<AttributeUsage(AttributeTargets.Class,AllowMultiple=false)>]
type SealedAttribute(value:bool) =
inherit System.Attribute()
member x.Value = value
new() = new SealedAttribute(true)
[<AttributeUsage(AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type AbstractClassAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.GenericParameter,AllowMultiple=false)>]
[<Sealed>]
type EqualityConditionalOnAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.GenericParameter,AllowMultiple=false)>]
[<Sealed>]
type ComparisonConditionalOnAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type AllowNullLiteralAttribute(value: bool) =
inherit System.Attribute()
member x.Value = value
new () = new AllowNullLiteralAttribute(true)
[<AttributeUsage(AttributeTargets.Field,AllowMultiple=false)>]
[<Sealed>]
type VolatileFieldAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type DefaultAugmentationAttribute(value:bool) =
inherit System.Attribute()
member x.Value = value
[<AttributeUsage (AttributeTargets.Property,AllowMultiple=false)>]
[<Sealed>]
type CLIEventAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type CLIMutableAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type AutoSerializableAttribute(value:bool) =
inherit System.Attribute()
member x.Value = value
[<AttributeUsage (AttributeTargets.Field,AllowMultiple=false)>]
[<Sealed>]
type DefaultValueAttribute(check:bool) =
inherit System.Attribute()
member x.Check = check
new() = new DefaultValueAttribute(true)
[<AttributeUsage (AttributeTargets.Method,AllowMultiple=false)>]
[<Sealed>]
type EntryPointAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type ReferenceEqualityAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type StructuralComparisonAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type StructuralEqualityAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class ||| AttributeTargets.Interface ||| AttributeTargets.Delegate ||| AttributeTargets.Struct ||| AttributeTargets.Enum,AllowMultiple=false)>]
[<Sealed>]
type NoEqualityAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class ||| AttributeTargets.Struct,AllowMultiple=false)>]
[<Sealed>]
type CustomEqualityAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class ||| AttributeTargets.Struct,AllowMultiple=false)>]
[<Sealed>]
type CustomComparisonAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class ||| AttributeTargets.Interface ||| AttributeTargets.Delegate ||| AttributeTargets.Struct ||| AttributeTargets.Enum,AllowMultiple=false)>]
[<Sealed>]
type NoComparisonAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class ||| AttributeTargets.Parameter ||| AttributeTargets.Method ||| AttributeTargets.Property ||| AttributeTargets.Constructor,AllowMultiple=false)>]
[<Sealed>]
type ReflectedDefinitionAttribute(includeValue: bool) =
inherit System.Attribute()
new() = ReflectedDefinitionAttribute(false)
member x.IncludeValue = includeValue
[<AttributeUsage (AttributeTargets.Method ||| AttributeTargets.Class ||| AttributeTargets.Field ||| AttributeTargets.Interface ||| AttributeTargets.Struct ||| AttributeTargets.Delegate ||| AttributeTargets.Enum ||| AttributeTargets.Property,AllowMultiple=false)>]
[<Sealed>]
type CompiledNameAttribute(compiledName:string) =
inherit System.Attribute()
member x.CompiledName = compiledName
[<AttributeUsage (AttributeTargets.Struct,AllowMultiple=false)>]
[<Sealed>]
type StructAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.GenericParameter ||| AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type MeasureAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type MeasureAnnotatedAbbreviationAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Interface,AllowMultiple=false)>]
[<Sealed>]
type InterfaceAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type ClassAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.Field,AllowMultiple=false)>]
[<Sealed>]
type LiteralAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.Assembly,AllowMultiple=false)>]
[<Sealed>]
type FSharpInterfaceDataVersionAttribute(major:int,minor:int,release:int) =
inherit System.Attribute()
member x.Major = major
member x.Minor = minor
member x.Release = release
[<AttributeUsage(AttributeTargets.All,AllowMultiple=false)>]
[<Sealed>]
type CompilationMappingAttribute(sourceConstructFlags:SourceConstructFlags,
variantNumber:int,
sequenceNumber:int,
resourceName:string,
typeDefinitions:System.Type[]) =
inherit System.Attribute()
member x.SourceConstructFlags = sourceConstructFlags
member x.SequenceNumber = sequenceNumber
member x.VariantNumber = variantNumber
new(sourceConstructFlags) = CompilationMappingAttribute(sourceConstructFlags,0,0)
new(sourceConstructFlags,sequenceNumber) = CompilationMappingAttribute(sourceConstructFlags,0,sequenceNumber)
new(sourceConstructFlags,variantNumber,sequenceNumber) = CompilationMappingAttribute(sourceConstructFlags,variantNumber,sequenceNumber,null,null)
new(resourceName, typeDefinitions) = CompilationMappingAttribute(SourceConstructFlags.None,0,0,resourceName, typeDefinitions)
member x.TypeDefinitions = typeDefinitions
member x.ResourceName = resourceName
[<AttributeUsage(AttributeTargets.All,AllowMultiple=false)>]
[<Sealed>]
type CompilationSourceNameAttribute(sourceName:string) =
inherit System.Attribute()
member x.SourceName = sourceName
//-------------------------------------------------------------------------
[<AttributeUsage(AttributeTargets.All,AllowMultiple=false)>]
[<Sealed>]
type CompilationRepresentationAttribute (flags : CompilationRepresentationFlags) =
inherit System.Attribute()
member x.Flags = flags
[<AttributeUsage(AttributeTargets.All,AllowMultiple=false)>]
[<Sealed>]
type ExperimentalAttribute(message:string) =
inherit System.Attribute()
member x.Message = message
[<AttributeUsage(AttributeTargets.Method,AllowMultiple=false)>]
[<Sealed>]
type CompilationArgumentCountsAttribute(counts:int[]) =
inherit System.Attribute()
member x.Counts =
let unboxPrim(x:obj) = (# "unbox.any !0" type ('T) x : 'T #)
(unboxPrim(counts.Clone()) : System.Collections.Generic.IEnumerable<int>)
[<AttributeUsage(AttributeTargets.Method,AllowMultiple=false)>]
[<Sealed>]
type CustomOperationAttribute(name:string) =
inherit System.Attribute()
let mutable isBinary = false
let mutable allowInto = false
let mutable isJoin = false
let mutable isGroupJoin = false
let mutable maintainsVarSpace = false
let mutable maintainsVarSpaceWithBind = false
let mutable joinOnWord = ""
member x.Name = name
member x.AllowIntoPattern with get() = allowInto and set v = allowInto <- v
member x.IsLikeZip with get() = isBinary and set v = isBinary <- v
member x.IsLikeJoin with get() = isJoin and set v = isJoin <- v
member x.IsLikeGroupJoin with get() = isGroupJoin and set v = isGroupJoin <- v
member x.JoinConditionWord with get() = joinOnWord and set v = joinOnWord <- v
member x.MaintainsVariableSpace with get() = maintainsVarSpace and set v = maintainsVarSpace <- v
member x.MaintainsVariableSpaceUsingBind with get() = maintainsVarSpaceWithBind and set v = maintainsVarSpaceWithBind <- v
[<AttributeUsage(AttributeTargets.Parameter,AllowMultiple=false)>]
[<Sealed>]
type ProjectionParameterAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.Class ||| AttributeTargets.Interface ||| AttributeTargets.Struct ||| AttributeTargets.Delegate ||| AttributeTargets.Enum,AllowMultiple=false)>]
[<Sealed>]
type StructuredFormatDisplayAttribute(value:string) =
inherit System.Attribute()
member x.Value = value
[<AttributeUsage(AttributeTargets.All,AllowMultiple=false)>]
[<Sealed>]
type CompilerMessageAttribute(message:string, messageNumber : int) =
inherit System.Attribute()
let mutable isError = false
let mutable isHidden = false
member x.Message = message
member x.MessageNumber = messageNumber
member x.IsError with get() = isError and set v = isError <- v
member x.IsHidden with get() = isHidden and set v = isHidden <- v
new (message, messageNumber) = CompilerMessageAttribute(message, messageNumber)
[<AttributeUsage(AttributeTargets.Method ||| AttributeTargets.Property,AllowMultiple=false)>]
[<Sealed>]
type UnverifiableAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.Method ||| AttributeTargets.Property,AllowMultiple=false)>]
[<Sealed>]
type NoDynamicInvocationAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.Parameter,AllowMultiple=false)>]
[<Sealed>]
type OptionalArgumentAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.Method,AllowMultiple=false)>]
[<Sealed>]
type GeneralizableValueAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.Method,AllowMultiple=false)>]
[<Sealed>]
type RequiresExplicitTypeArgumentsAttribute() =
inherit System.Attribute()
[<AttributeUsage(AttributeTargets.Class,AllowMultiple=false)>]
[<Sealed>]
type RequireQualifiedAccessAttribute() =
inherit System.Attribute()
[<AttributeUsage (AttributeTargets.Class ||| AttributeTargets.Assembly,AllowMultiple=true)>]
[<Sealed>]
type AutoOpenAttribute(path:string) =
inherit System.Attribute()
member x.Path = path
new() = AutoOpenAttribute("")
[<MeasureAnnotatedAbbreviation>] type float<[<Measure>] 'Measure> = float
[<MeasureAnnotatedAbbreviation>] type float32<[<Measure>] 'Measure> = float32
[<MeasureAnnotatedAbbreviation>] type decimal<[<Measure>] 'Measure> = decimal
[<MeasureAnnotatedAbbreviation>] type int<[<Measure>] 'Measure> = int
[<MeasureAnnotatedAbbreviation>] type sbyte<[<Measure>] 'Measure> = sbyte
[<MeasureAnnotatedAbbreviation>] type int16<[<Measure>] 'Measure> = int16
[<MeasureAnnotatedAbbreviation>] type int64<[<Measure>] 'Measure> = int64
#if FX_RESHAPED_REFLECTION
module PrimReflectionAdapters =
open System.Reflection
open System.Linq
// copied from BasicInlinedOperations
let inline box (x:'T) = (# "box !0" type ('T) x : obj #)
let inline unboxPrim<'T>(x:obj) = (# "unbox.any !0" type ('T) x : 'T #)
type System.Type with
member inline this.IsGenericType = this.GetTypeInfo().IsGenericType
member inline this.IsValueType = this.GetTypeInfo().IsValueType
member inline this.IsSealed = this.GetTypeInfo().IsSealed
member inline this.IsAssignableFrom(otherTy : Type) = this.GetTypeInfo().IsAssignableFrom(otherTy.GetTypeInfo())
member inline this.GetGenericArguments() = this.GetTypeInfo().GenericTypeArguments
member inline this.GetProperty(name) = this.GetRuntimeProperty(name)
member inline this.GetMethod(name, parameterTypes) = this.GetRuntimeMethod(name, parameterTypes)
member inline this.GetCustomAttributes(attrTy : Type, inherits : bool) : obj[] =
unboxPrim<_> (box (CustomAttributeExtensions.GetCustomAttributes(this.GetTypeInfo(), attrTy, inherits).ToArray()))
open PrimReflectionAdapters
#endif
module BasicInlinedOperations =
let inline unboxPrim<'T>(x:obj) = (# "unbox.any !0" type ('T) x : 'T #)
let inline box (x:'T) = (# "box !0" type ('T) x : obj #)
let inline not (b:bool) = (# "ceq" b false : bool #)
let inline (=) (x:int) (y:int) = (# "ceq" x y : bool #)
let inline (<>) (x:int) (y:int) = not(# "ceq" x y : bool #)
let inline (>=) (x:int) (y:int) = not(# "clt" x y : bool #)
let inline (>=.) (x:int64) (y:int64) = not(# "clt" x y : bool #)
let inline (>=...) (x:char) (y:char) = not(# "clt" x y : bool #)
let inline (<=...) (x:char) (y:char) = not(# "cgt" x y : bool #)
let inline (/) (x:int) (y:int) = (# "div" x y : int #)
let inline (+) (x:int) (y:int) = (# "add" x y : int #)
let inline (+.) (x:int64) (y:int64) = (# "add" x y : int64 #)
let inline (+..) (x:uint64) (y:uint64) = (# "add" x y : uint64 #)
let inline ( *. ) (x:int64) (y:int64) = (# "mul" x y : int64 #)
let inline ( *.. ) (x:uint64) (y:uint64) = (# "mul" x y : uint64 #)
let inline (^) (x:string) (y:string) = System.String.Concat(x,y)
let inline (<<<) (x:int) (y:int) = (# "shl" x y : int #)
let inline ( * ) (x:int) (y:int) = (# "mul" x y : int #)
let inline (-) (x:int) (y:int) = (# "sub" x y : int #)
let inline (-.) (x:int64) (y:int64) = (# "sub" x y : int64 #)
let inline (-..) (x:uint64) (y:uint64) = (# "sub" x y : uint64 #)
let inline (>) (x:int) (y:int) = (# "cgt" x y : bool #)
let inline (<) (x:int) (y:int) = (# "clt" x y : bool #)
let inline ignore _ = ()
let inline intOfByte (b:byte) = (# "" b : int #)
let inline raise (e: System.Exception) = (# "throw" e : 'U #)
let inline length (x: 'T[]) = (# "ldlen conv.i4" x : int #)
let inline zeroCreate (n:int) = (# "newarr !0" type ('T) n : 'T[] #)
let inline get (arr: 'T[]) (n:int) = (# "ldelem.any !0" type ('T) arr n : 'T #)
let set (arr: 'T[]) (n:int) (x:'T) = (# "stelem.any !0" type ('T) arr n x #)
let inline objEq (xobj:obj) (yobj:obj) = (# "ceq" xobj yobj : bool #)
let inline int64Eq (x:int64) (y:int64) = (# "ceq" x y : bool #)
let inline int32Eq (x:int32) (y:int32) = (# "ceq" x y : bool #)
let inline floatEq (x:float) (y:float) = (# "ceq" x y : bool #)
let inline float32Eq (x:float32) (y:float32) = (# "ceq" x y : bool #)
let inline charEq (x:char) (y:char) = (# "ceq" x y : bool #)
let inline intOrder (x:int) (y:int) = if (# "clt" x y : bool #) then (0-1) else (# "cgt" x y : int #)
let inline int64Order (x:int64) (y:int64) = if (# "clt" x y : bool #) then (0-1) else (# "cgt" x y : int #)
let inline byteOrder (x:byte) (y:byte) = if (# "clt" x y : bool #) then (0-1) else (# "cgt" x y : int #)
let inline byteEq (x:byte) (y:byte) = (# "ceq" x y : bool #)
let inline int64 (x:int) = (# "conv.i8" x : int64 #)
let inline int32 (x:int64) = (# "conv.i4" x : int32 #)
let inline typeof<'T> =
let tok = (# "ldtoken !0" type('T) : System.RuntimeTypeHandle #)
System.Type.GetTypeFromHandle(tok)
let inline typedefof<'T> =
let ty = typeof<'T>
if ty.IsGenericType then ty.GetGenericTypeDefinition() else ty
let inline sizeof<'T> =
(# "sizeof !0" type('T) : int #)
let inline unsafeDefault<'T> : 'T = (# "ilzero !0" type ('T) : 'T #)
let inline isinstPrim<'T>(x:obj) = (# "isinst !0" type ('T) x : obj #)
let inline castclassPrim<'T>(x:obj) = (# "castclass !0" type ('T) x : 'T #)
let inline notnullPrim<'T when 'T : not struct>(x:'T) = (# "ldnull cgt.un" x : bool #)
let inline iscastPrim<'T when 'T : not struct>(x:obj) = (# "isinst !0" type ('T) x : 'T #)
open BasicInlinedOperations
module TupleUtils =
open BasicInlinedOperations
// adapted from System.Tuple::CombineHashCodes
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 opxor (x:int) (y:int) : int = (# "xor" x y : int32 #)
let inline combineTupleHashes (h1 : int) (h2 : int) = (opxor ((opshl h1 5) + h1) h2)
let combineTupleHashCodes (codes : int []) =
let mutable (num : int32) = codes.Length - 1
while (num > 1) do
let mutable i = 0
while ((i * 2) < (num+1)) do
let index = i * 2
let num' = index + 1
if index = num then
set codes i (get codes index)
num <- i
else
set codes i (combineTupleHashes (get codes index) (get codes num))
if num' = num then
num <- i
i <- i + 1
combineTupleHashes (get codes 0) (get codes 1)
#if FX_NO_TUPLE
namespace System
open Microsoft.FSharp.Core.BasicInlinedOperations
open System
open System.Collections
open System.Collections.Generic
open System.Diagnostics
open System.Globalization
open System.Text
type Tuple<'T1>(t1:'T1) =
member t.Item1 = t1
interface IStructuralComparable
interface IStructuralEquatable
interface IComparable
#if TUPLE_STRUXT
// NOTE: Tuple`2 is a struct type.
// WARNING: If you change additional tuple types to be structs then you must change 'highestTupleStructType' in tastops.ml
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerDisplay("({Item1},{Item2})")>]
#endif
[<Struct>]
type Tuple<'T1,'T2> =
new (v1,v2) = { Item1 = v1; Item2 = v2 }
val Item1 : 'T1
val Item2 : 'T2
#else
type Tuple<'T1,'T2>(t1:'T1, t2:'T2) =
member t.Item1 = t1
member t.Item2 = t2
interface IStructuralComparable
interface IStructuralEquatable
interface IComparable
#endif
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerDisplay("({Item1},{Item2},{Item3})")>]
#endif
type Tuple<'T1,'T2,'T3>(t1:'T1,t2:'T2,t3:'T3) =
member t.Item1 = t1
member t.Item2 = t2
member t.Item3 = t3
interface IStructuralComparable
interface IStructuralEquatable
interface IComparable
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerDisplay("({Item1},{Item2},{Item3},{Item4})")>]
#endif
type Tuple<'T1,'T2,'T3,'T4>(t1:'T1,t2:'T2,t3:'T3,t4:'T4) =
member t.Item1 = t1
member t.Item2 = t2
member t.Item3 = t3
member t.Item4 = t4
interface IStructuralComparable
interface IStructuralEquatable
interface IComparable
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerDisplay("({Item1},{Item2},{Item3},{Item4},{Item5})")>]
#endif
type Tuple<'T1,'T2,'T3,'T4,'T5>(t1:'T1,t2:'T2,t3:'T3,t4:'T4,t5:'T5) =
member t.Item1 = t1
member t.Item2 = t2
member t.Item3 = t3
member t.Item4 = t4
member t.Item5 = t5
interface IStructuralComparable
interface IStructuralEquatable
interface IComparable
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerDisplay("({Item1},{Item2},{Item3},{Item4},{Item5},{Item6})")>]
#endif
type Tuple<'T1,'T2,'T3,'T4,'T5,'T6>(t1:'T1,t2:'T2,t3:'T3,t4:'T4,t5:'T5,t6:'T6) =
member t.Item1 = t1
member t.Item2 = t2
member t.Item3 = t3
member t.Item4 = t4
member t.Item5 = t5
member t.Item6 = t6
interface IStructuralComparable
interface IStructuralEquatable
interface IComparable
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerDisplay("({Item1},{Item2},{Item3},{Item4},{Item5},{Item6},{Item7})")>]
#endif
type Tuple<'T1,'T2,'T3,'T4,'T5,'T6,'T7>(t1:'T1,t2:'T2,t3:'T3,t4:'T4,t5:'T5,t6:'T6,t7:'T7) =
member t.Item1 = t1
member t.Item2 = t2
member t.Item3 = t3
member t.Item4 = t4
member t.Item5 = t5
member t.Item6 = t6
member t.Item7 = t7
interface IStructuralComparable
interface IStructuralEquatable
interface IComparable
#if FX_NO_DEBUG_DISPLAYS
#else
[<DebuggerDisplay("({Item1},{Item2},{Item3},{Item4},{Item5},{Item6},{Item7},{Rest})")>]
#endif
type Tuple<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'TRest>(t1:'T1,t2:'T2,t3:'T3,t4:'T4,t5:'T5,t6:'T6,t7:'T7,rest:'TRest) =
member t.Item1 = t1
member t.Item2 = t2
member t.Item3 = t3
member t.Item4 = t4
member t.Item5 = t5
member t.Item6 = t6
member t.Item7 = t7
member t.Rest = rest
interface IStructuralComparable
interface IStructuralEquatable
interface IComparable
#else
#endif
namespace Microsoft.FSharp.Core
open System
open System.Collections
open System.Collections.Generic
open System.Diagnostics
open System.Globalization
open System.Linq
open System.Text
open Microsoft.FSharp.Core
open Microsoft.FSharp.Core.BasicInlinedOperations
//-------------------------------------------------------------------------
// The main aim here is to bootsrap the definition of structural hashing
// and comparison. Calls to these form part of the auto-generated
// code for each new datatype.
module LanguagePrimitives =
module (* internal *) ErrorStrings =
// inline functions cannot call GetString, so we must make these bits public
let AddressOpNotFirstClassString = SR.GetString(SR.addressOpNotFirstClass)
let NoNegateMinValueString = SR.GetString(SR.noNegateMinValue)
// needs to be public to be visible from inline function 'average' and others
let InputSequenceEmptyString = SR.GetString(SR.inputSequenceEmpty)
// needs to be public to be visible from inline function 'average' and others
let InputArrayEmptyString = SR.GetString(SR.arrayWasEmpty)
// needs to be public to be visible from inline function 'average' and others
let InputMustBeNonNegativeString = SR.GetString(SR.inputMustBeNonNegative)
[<CodeAnalysis.SuppressMessage("Microsoft.Design", "CA1034:NestedTypesShouldNotBeVisible")>] // nested module OK
module IntrinsicOperators =
//-------------------------------------------------------------------------
// Lazy and/or. Laziness added by the F# compiler.
let (&) x y = if x then y else false
let (&&) x y = if x then y else false
[<CompiledName("Or")>]
let (or) x y = if x then true else y
let (||) x y = if x then true else y
//-------------------------------------------------------------------------
// Address-of
// Note, "raise<'T> : exn -> 'T" is manually inlined below.
// Byref usage checks prohibit type instantiations involving byrefs.
[<NoDynamicInvocation>]
let inline (~&) (x : 'T) : 'T byref =
ignore x // pretend the variable is used
let e = new System.ArgumentException(ErrorStrings.AddressOpNotFirstClassString)
(# "throw" (e :> System.Exception) : 'T byref #)
[<NoDynamicInvocation>]
let inline (~&&) (x : 'T) : nativeptr<'T> =
ignore x // pretend the variable is used
let e = new System.ArgumentException(ErrorStrings.AddressOpNotFirstClassString)
(# "throw" (e :> System.Exception) : nativeptr<'T> #)
open IntrinsicOperators
#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
#endif
[<CodeAnalysis.SuppressMessage("Microsoft.Design", "CA1034:NestedTypesShouldNotBeVisible")>] // nested module OK
module IntrinsicFunctions =
// Unboxing, type casts, type tests
type TypeNullnessSemantics = int
// CLI reference types
let TypeNullnessSemantics_NullIsExtraValue = 1
// F# types with [<UseNullAsTrueValue>]
let TypeNullnessSemantics_NullTrueValue = 2
// F# record, union, tuple, function types
let TypeNullnessSemantics_NullNotLiked = 3
// structs
let TypeNullnessSemantics_NullNever = 4
// duplicated from above since we're using integers in this section
let CompilationRepresentationFlags_PermitNull = 8
let getTypeInfo (ty:Type) =
if ty.IsValueType
then TypeNullnessSemantics_NullNever else
let mappingAttrs = ty.GetCustomAttributes(typeof<CompilationMappingAttribute>, false)
if mappingAttrs.Length = 0
then TypeNullnessSemantics_NullIsExtraValue
elif ty.Equals(typeof<unit>) then
TypeNullnessSemantics_NullTrueValue
elif typeof<Delegate>.IsAssignableFrom(ty) then
TypeNullnessSemantics_NullIsExtraValue
elif ty.GetCustomAttributes(typeof<AllowNullLiteralAttribute>, false).Length > 0 then
TypeNullnessSemantics_NullIsExtraValue
else
let reprAttrs = ty.GetCustomAttributes(typeof<CompilationRepresentationAttribute>, false)
if reprAttrs.Length = 0 then
TypeNullnessSemantics_NullNotLiked
else
let reprAttr = get reprAttrs 0
let reprAttr = (# "unbox.any !0" type (CompilationRepresentationAttribute) reprAttr : CompilationRepresentationAttribute #)
if (# "and" reprAttr.Flags CompilationRepresentationFlags_PermitNull : int #) = 0
then TypeNullnessSemantics_NullNotLiked
else TypeNullnessSemantics_NullTrueValue
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type TypeInfo<'T>() =
// Compute an on-demand per-instantiation static field
static let info = getTypeInfo typeof<'T>
// Publish the results of that compuation
static member TypeInfo = info
// Note: cheap nullness test for generic value:
// IL_0000: ldarg.1
// IL_0001: box !TKey
// IL_0006: brtrue.s IL_000e
// worst case: nothing known about source or destination
let UnboxGeneric<'T>(x:obj) =
if notnullPrim(x) or TypeInfo<'T>.TypeInfo <> TypeNullnessSemantics_NullNotLiked then
unboxPrim<'T>(x)
else
//System.Console.WriteLine("UnboxGeneric, x = {0}, 'T = {1}", x, typeof<'T>)
raise (System.NullReferenceException())
// better: source is NOT TypeNullnessSemantics_NullNotLiked
let inline UnboxFast<'T>(x:obj) =
// assert not(TypeInfo<'T>.TypeInfo = TypeNullnessSemantics_NullNotLiked)
unboxPrim<'T>(x)
// worst case: nothing known about source or destination
let TypeTestGeneric<'T>(x:obj) =
if notnullPrim(isinstPrim<'T>(x)) then true
elif notnullPrim(x) then false
else (TypeInfo<'T>.TypeInfo = TypeNullnessSemantics_NullTrueValue)
// quick entry: source is NOT TypeNullnessSemantics_NullTrueValue
let inline TypeTestFast<'T>(x:obj) =
//assert not(TypeInfo<'T>.TypeInfo = TypeNullnessSemantics_NullTrueValue)
notnullPrim(isinstPrim<'T>(x))
let Dispose<'T when 'T :> System.IDisposable >(x:'T) =
match box x with
| null -> ()
| _ -> x.Dispose()
let FailInit() : unit = raise (System.InvalidOperationException(SR.GetString(SR.checkInit)))
let FailStaticInit() : unit = raise (System.InvalidOperationException(SR.GetString(SR.checkStaticInit)))
let CheckThis (x : 'T when 'T : not struct) =
match box x with
| null -> raise (System.InvalidOperationException(SR.GetString(SR.checkInit)))
| _ -> x
let inline MakeDecimal lo med hi isNegative scale = new System.Decimal(lo,med,hi,isNegative,scale)
let inline GetString (s: string) (n:int) = s.Chars(n)
let inline CreateInstance<'T when 'T : (new : unit -> 'T) >() =
(System.Activator.CreateInstance() : 'T)
let inline GetArray (arr: 'T array) (n:int) = (# "ldelem.any !0" type ('T) arr n : 'T #)
let inline SetArray (arr: 'T array) (n:int) (x:'T) = (# "stelem.any !0" type ('T) arr n x #)
let inline GetArraySub arr (start:int) (len:int) =
let len = if len < 0 then 0 else len
let dst = zeroCreate len
for i = 0 to len - 1 do
SetArray dst i (GetArray arr (start + i))
dst
let inline SetArraySub arr (start:int) (len:int) (src:_[]) =
for i = 0 to len - 1 do
SetArray arr (start+i) (GetArray src i)
let inline GetArray2D (arr: 'T[,]) (n1:int) (n2:int) = (# "ldelem.multi 2 !0" type ('T) arr n1 n2 : 'T #)
let inline SetArray2D (arr: 'T[,]) (n1:int) (n2:int) (x:'T) = (# "stelem.multi 2 !0" type ('T) arr n1 n2 x #)
let inline GetArray2DLength1 (arr: 'T[,]) = (# "ldlen.multi 2 0" arr : int #)
let inline GetArray2DLength2 (arr: 'T[,]) = (# "ldlen.multi 2 1" arr : int #)
let inline Array2DZeroCreate (n:int) (m:int) = (# "newarr.multi 2 !0" type ('T) n m : 'T[,] #)
let GetArray2DSub (src: 'T[,]) src1 src2 len1 len2 =
let len1 = (if len1 < 0 then 0 else len1)
let len2 = (if len2 < 0 then 0 else len2)
let dst = Array2DZeroCreate len1 len2
for i = 0 to len1 - 1 do
for j = 0 to len2 - 1 do
SetArray2D dst i j (GetArray2D src (src1 + i) (src2 + j))
dst
let SetArray2DSub (dst: 'T[,]) src1 src2 len1 len2 src =
for i = 0 to len1 - 1 do
for j = 0 to len2 - 1 do
SetArray2D dst (src1+i) (src2+j) (GetArray2D src i j)
let inline GetArray3D (arr: 'T[,,]) (n1:int) (n2:int) (n3:int) = (# "ldelem.multi 3 !0" type ('T) arr n1 n2 n3 : 'T #)
let inline SetArray3D (arr: 'T[,,]) (n1:int) (n2:int) (n3:int) (x:'T) = (# "stelem.multi 3 !0" type ('T) arr n1 n2 n3 x #)
let inline GetArray3DLength1 (arr: 'T[,,]) = (# "ldlen.multi 3 0" arr : int #)
let inline GetArray3DLength2 (arr: 'T[,,]) = (# "ldlen.multi 3 1" arr : int #)
let inline GetArray3DLength3 (arr: 'T[,,]) = (# "ldlen.multi 3 2" arr : int #)
let inline Array3DZeroCreate (n1:int) (n2:int) (n3:int) = (# "newarr.multi 3 !0" type ('T) n1 n2 n3 : 'T[,,] #)
let GetArray3DSub (src: 'T[,,]) src1 src2 src3 len1 len2 len3 =
let len1 = (if len1 < 0 then 0 else len1)
let len2 = (if len2 < 0 then 0 else len2)
let len3 = (if len3 < 0 then 0 else len3)
let dst = Array3DZeroCreate len1 len2 len3
for i = 0 to len1 - 1 do
for j = 0 to len2 - 1 do
for k = 0 to len3 - 1 do
SetArray3D dst i j k (GetArray3D src (src1+i) (src2+j) (src3+k))
dst
let SetArray3DSub (dst: 'T[,,]) src1 src2 src3 len1 len2 len3 src =
for i = 0 to len1 - 1 do
for j = 0 to len2 - 1 do
for k = 0 to len3 - 1 do
SetArray3D dst (src1+i) (src2+j) (src3+k) (GetArray3D src i j k)
let inline GetArray4D (arr: 'T[,,,]) (n1:int) (n2:int) (n3:int) (n4:int) = (# "ldelem.multi 4 !0" type ('T) arr n1 n2 n3 n4 : 'T #)
let inline SetArray4D (arr: 'T[,,,]) (n1:int) (n2:int) (n3:int) (n4:int) (x:'T) = (# "stelem.multi 4 !0" type ('T) arr n1 n2 n3 n4 x #)
let inline Array4DLength1 (arr: 'T[,,,]) = (# "ldlen.multi 4 0" arr : int #)
let inline Array4DLength2 (arr: 'T[,,,]) = (# "ldlen.multi 4 1" arr : int #)
let inline Array4DLength3 (arr: 'T[,,,]) = (# "ldlen.multi 4 2" arr : int #)
let inline Array4DLength4 (arr: 'T[,,,]) = (# "ldlen.multi 4 3" arr : int #)
let inline Array4DZeroCreate (n1:int) (n2:int) (n3:int) (n4:int) = (# "newarr.multi 4 !0" type ('T) n1 n2 n3 n4 : 'T[,,,] #)
let GetArray4DSub (src: 'T[,,,]) src1 src2 src3 src4 len1 len2 len3 len4 =
let len1 = (if len1 < 0 then 0 else len1)
let len2 = (if len2 < 0 then 0 else len2)
let len3 = (if len3 < 0 then 0 else len3)
let len4 = (if len4 < 0 then 0 else len4)
let dst = Array4DZeroCreate len1 len2 len3 len4
for i = 0 to len1 - 1 do
for j = 0 to len2 - 1 do
for k = 0 to len3 - 1 do
for m = 0 to len4 - 1 do
SetArray4D dst i j k m (GetArray4D src (src1+i) (src2+j) (src3+k) (src4+m))
dst
let SetArray4DSub (dst: 'T[,,,]) src1 src2 src3 src4 len1 len2 len3 len4 src =
for i = 0 to len1 - 1 do
for j = 0 to len2 - 1 do
for k = 0 to len3 - 1 do
for m = 0 to len4 - 1 do
SetArray4D dst (src1+i) (src2+j) (src3+k) (src4+m) (GetArray4D src i j k m)
let inline anyToString nullStr x =
match box x with
| null -> nullStr
| :? System.IFormattable as f -> f.ToString(null,System.Globalization.CultureInfo.InvariantCulture)
| obj -> obj.ToString()
let anyToStringShowingNull x = anyToString "null" x
module HashCompare =
//-------------------------------------------------------------------------
// LangaugePrimitives.HashCompare: Physical Equality
//-------------------------------------------------------------------------
// NOTE: compiler/optimizer is aware of this function and optimizes calls to it in many situations
// where it is known that PhysicalEqualityObj is identical to reference comparison
let PhysicalEqualityIntrinsic (x:'T) (y:'T) : bool when 'T : not struct =
objEq (box x) (box y)
let inline PhysicalEqualityFast (x:'T) (y:'T) : bool when 'T : not struct =
PhysicalEqualityIntrinsic x y
let PhysicalHashIntrinsic (x: 'T) : int when 'T : not struct =
#if FX_NO_GET_HASH_CODE_HELPER
(box x).GetHashCode()
#else
System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode(box x)
#endif
let inline PhysicalHashFast (x: 'T) =
PhysicalHashIntrinsic x
//-------------------------------------------------------------------------
// LangaugePrimitives.HashCompare: Comparison
//
// Bi-modal generic comparison helper implementation.
//
// The comparison implementation is run in either Equivalence Relation or Partial
// Equivalence Relation (PER) mode which governs what happens when NaNs are compared.
//
// Some representations chosen by F# are legitimately allowed to be null, e.g. the None value.
// However, null values don't support the polymorphic virtual comparison operation CompareTo
// so the test for nullness must be made on the caller side.
//-------------------------------------------------------------------------
let FailGenericComparison (obj: obj) =
raise (new System.ArgumentException(SR.GetString1(SR.genericCompareFail1, obj.GetType().ToString())))
/// This type has two instances - fsComparerER and fsComparerThrow.
/// - fsComparerER = ER semantics = no throw on NaN comparison = new GenericComparer(false) = GenericComparer = GenericComparison
/// - fsComparerPER = PER semantics = local throw on NaN comparison = new GenericComparer(true) = LessThan/GreaterThan etc.
type GenericComparer(throwsOnPER:bool) =
interface System.Collections.IComparer
member c.ThrowsOnPER = throwsOnPER
/// 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".
let rec GenericCompare (comp:GenericComparer) (xobj:obj,yobj:obj) =
(*if objEq xobj yobj then 0 else *)
match xobj,yobj with
| null,null -> 0
| null,_ -> -1
| _,null -> 1
// Use Ordinal comparison for strings
| (:? string as x),(:? string as y) -> System.String.CompareOrdinal(x, y)
// Permit structural comparison on arrays
| (:? System.Array as arr1),_ ->
match arr1,yobj with
// Fast path
| (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericComparisonObjArrayWithComparer comp arr1 arr2
// Fast path
| (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericComparisonByteArray arr1 arr2
| _ , (:? System.Array as arr2) -> GenericComparisonArbArrayWithComparer comp arr1 arr2
| _ -> FailGenericComparison xobj
// Check for IStructuralComparable
| (:? IStructuralComparable as x),_ ->
x.CompareTo(yobj,comp)
// Check for IComparable
| (:? 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) ->
let res = yc.CompareTo(xobj,comp)
if res < 0 then 1 elif res > 0 then -1 else 0
| _,(:? System.IComparable as yc) ->
// Note -c doesn't work here: be careful of comparison function returning minint
let c = yc.CompareTo(xobj) in
if c < 0 then 1 elif c > 0 then -1 else 0
| _ -> FailGenericComparison xobj
/// specialcase: Core implementation of structural comparison on arbitrary arrays.
and GenericComparisonArbArrayWithComparer (comp:GenericComparer) (x:System.Array) (y:System.Array) : int =
#if FX_NO_ARRAY_LONG_LENGTH
if x.Rank = 1 && y.Rank = 1 then
let lenx = x.Length
let leny = y.Length
let c = intOrder lenx leny
if c <> 0 then c else
let basex = (x.GetLowerBound(0))
let basey = (y.GetLowerBound(0))
let c = intOrder basex basey
if c <> 0 then c else
let rec check i =
if i >= lenx then 0 else
let c = GenericCompare comp ((x.GetValue(i + basex)),(y.GetValue(i + basey)))
if c <> 0 then c else check (i + 1)
check 0
elif x.Rank = 2 && y.Rank = 2 then
let lenx0 = x.GetLength(0)
let leny0 = y.GetLength(0)
let c = intOrder lenx0 leny0
if c <> 0 then c else
let lenx1 = x.GetLength(1)
let leny1 = y.GetLength(1)
let c = intOrder lenx1 leny1
if c <> 0 then c else
let basex0 = (x.GetLowerBound(0))
let basex1 = (x.GetLowerBound(1))
let basey0 = (y.GetLowerBound(0))
let basey1 = (y.GetLowerBound(1))
let c = intOrder basex0 basey0
if c <> 0 then c else
let c = intOrder basex1 basey1
if c <> 0 then c else
let rec check0 i =
let rec check1 j =
if j >= lenx1 then 0 else
let c = GenericCompare comp ((x.GetValue(i + basex0,j + basex1)), (y.GetValue(i + basey0,j + basey1)))
if c <> 0 then c else check1 (j + 1)
if i >= lenx0 then 0 else
let c = check1 0
if c <> 0 then c else
check0 (i + 1)
check0 0
else
let c = intOrder x.Rank y.Rank
if c <> 0 then c else
let ndims = x.Rank
// check lengths
let rec precheck k =
if k >= ndims then 0 else
let c = intOrder (x.GetLength(k)) (y.GetLength(k))
if c <> 0 then c else
let c = intOrder (x.GetLowerBound(k)) (y.GetLowerBound(k))
if c <> 0 then c else
precheck (k+1)
let c = precheck 0
if c <> 0 then c else
let idxs : int[] = zeroCreate ndims
let rec checkN k baseIdx i lim =
if i >= lim then 0 else
set idxs k (baseIdx + i)
let c =
if k = ndims - 1
then GenericCompare comp ((x.GetValue(idxs)), (y.GetValue(idxs)))
else check (k+1)
if c <> 0 then c else
checkN k baseIdx (i + 1) lim
and check k =
if k >= ndims then 0 else
let baseIdx = x.GetLowerBound(k)
checkN k baseIdx 0 (x.GetLength(k))
check 0
#else
if x.Rank = 1 && y.Rank = 1 then
let lenx = x.LongLength
let leny = y.LongLength
let c = int64Order lenx leny
if c <> 0 then c else
let basex = int64 (x.GetLowerBound(0))
let basey = int64 (y.GetLowerBound(0))
let c = int64Order basex basey
if c <> 0 then c else
let rec check i =
if i >=. lenx then 0 else
let c = GenericCompare comp ((x.GetValue(i +. basex)), (y.GetValue(i +. basey)))
if c <> 0 then c else check (i +. 1L)
check 0L
elif x.Rank = 2 && y.Rank = 2 then
let lenx0 = x.GetLongLength(0)
let leny0 = y.GetLongLength(0)
let c = int64Order lenx0 leny0
if c <> 0 then c else
let lenx1 = x.GetLongLength(1)
let leny1 = y.GetLongLength(1)
let c = int64Order lenx1 leny1
if c <> 0 then c else
let basex0 = int64 (x.GetLowerBound(0))
let basex1 = int64 (x.GetLowerBound(1))
let basey0 = int64 (y.GetLowerBound(0))
let basey1 = int64 (y.GetLowerBound(1))
let c = int64Order basex0 basey0
if c <> 0 then c else
let c = int64Order basex1 basey1
if c <> 0 then c else
let rec check0 i =
let rec check1 j =
if j >=. lenx1 then 0 else
let c = GenericCompare comp ((x.GetValue(i +. basex0,j +. basex1)), (y.GetValue(i +. basey0,j +. basey1)))
if c <> 0 then c else check1 (j +. 1L)
if i >=. lenx0 then 0 else
let c = check1 0L
if c <> 0 then c else
check0 (i +. 1L)
check0 0L
else
let c = intOrder x.Rank y.Rank
if c <> 0 then c else
let ndims = x.Rank
// check lengths
let rec precheck k =
if k >= ndims then 0 else
let c = int64Order (x.GetLongLength(k)) (y.GetLongLength(k))
if c <> 0 then c else
let c = intOrder (x.GetLowerBound(k)) (y.GetLowerBound(k))
if c <> 0 then c else
precheck (k+1)
let c = precheck 0
if c <> 0 then c else
let idxs : int64[] = zeroCreate ndims
let rec checkN k baseIdx i lim =
if i >=. lim then 0 else
set idxs k (baseIdx +. i)
let c =
if k = ndims - 1
then GenericCompare comp ((x.GetValue(idxs)), (y.GetValue(idxs)))
else check (k+1)
if c <> 0 then c else
checkN k baseIdx (i +. 1L) lim
and check k =
if k >= ndims then 0 else
let baseIdx = x.GetLowerBound(k)
checkN k (int64 baseIdx) 0L (x.GetLongLength(k))
check 0
#endif
/// optimized case: Core implementation of structural comparison on object arrays.
and GenericComparisonObjArrayWithComparer (comp:GenericComparer) (x:obj[]) (y:obj[]) : int =
let lenx = x.Length
let leny = y.Length
let c = intOrder lenx leny
if c <> 0 then c
else
let mutable i = 0
let mutable res = 0
while i < lenx do
let c = GenericCompare comp ((get x i), (get y i))
if c <> 0 then (res <- c; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural comparison on arrays.
and GenericComparisonByteArray (x:byte[]) (y:byte[]) : int =
let lenx = x.Length
let leny = y.Length
let c = intOrder lenx leny
if c <> 0 then c
else
let mutable i = 0
let mutable res = 0
while i < lenx do
let c = byteOrder (get x i) (get y i)
if c <> 0 then (res <- c; i <- lenx)
else i <- i + 1
res
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 = GenericComparer(true)
/// The unique object for comparing values in ER mode (where "0" is returned when NaNs are compared)
let fsComparerER = GenericComparer(false)
/// Compare two values of the same generic type, using "comp".
//
// "comp" is assumed to be either fsComparerPER or fsComparerER (and hence 'Compare' is implemented via 'GenericCompare').
//
// NOTE: the compiler optimizer is aware of this function and devirtualizes in the
// cases where it is known how a particular type implements generic comparison.
let GenericComparisonWithComparerIntrinsic<'T> (comp:System.Collections.IComparer) (x:'T) (y:'T) : int =
comp.Compare(box x, box y)
/// Compare two values of the same generic type, in either PER or ER mode, but include static optimizations
/// for various well-known cases.
//
// "comp" is assumed to be either fsComparerPER or fsComparerER (and hence 'Compare' is implemented via 'GenericCompare').
//
let inline GenericComparisonWithComparerFast<'T> (comp:System.Collections.IComparer) (x:'T) (y:'T) : int =
GenericComparisonWithComparerIntrinsic comp x y
when 'T : bool = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : sbyte = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : int16 = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : int32 = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : int64 = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : nativeint = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : byte = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : uint16 = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : uint32 = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : uint64 = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : unativeint = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
// Note, these bail out to GenericComparisonWithComparerIntrinsic if called with NaN values, because clt and cgt and ceq all return "false" for that case.
when 'T : float = if (# "clt" x y : bool #) then (-1)
elif (# "cgt" x y : bool #) then (1)
elif (# "ceq" x y : bool #) then (0)
else GenericComparisonWithComparerIntrinsic comp x y
when 'T : float32 = if (# "clt" x y : bool #) then (-1)
elif (# "cgt" x y : bool #) then (1)
elif (# "ceq" x y : bool #) then (0)
else GenericComparisonWithComparerIntrinsic comp x y
when 'T : char = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : string =
// NOTE: we don't have to null check here because System.String.CompareOrdinal
// gives reliable results on null values.
System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #))
when 'T : decimal = System.Decimal.Compare((# "" x:decimal #), (# "" y:decimal #))
/// Generic comparison. Implements ER mode (where "0" is returned when NaNs are compared)
//
// The compiler optimizer is aware of this function (see use of generic_comparison_inner_vref in opt.fs)
// and devirtualizes calls to it based on "T".
let GenericComparisonIntrinsic<'T> (x:'T) (y:'T) : int =
GenericComparisonWithComparerIntrinsic (fsComparerER :> IComparer) x y
/// Generic less-than. Uses comparison implementation in PER mode but catches
/// the local exception that is thrown when NaN's are compared.
let GenericLessThanIntrinsic (x:'T) (y:'T) =
try
(# "clt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) 0 : bool #)
with
| e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false
/// Generic greater-than. Uses comparison implementation in PER mode but catches
/// the local exception that is thrown when NaN's are compared.
let GenericGreaterThanIntrinsic (x:'T) (y:'T) =
try
(# "cgt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) 0 : bool #)
with
| e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false
/// Generic greater-than-or-equal. Uses comparison implementation in PER mode but catches
/// the local exception that is thrown when NaN's are compared.
let GenericGreaterOrEqualIntrinsic (x:'T) (y:'T) =
try
(# "cgt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) (-1) : bool #)
with
| e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false
/// Generic less-than-or-equal. Uses comparison implementation in PER mode but catches
/// the local exception that is thrown when NaN's are compared.
let GenericLessOrEqualIntrinsic (x:'T) (y:'T) =
try
(# "clt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) 1 : bool #)
with
| e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false
/// Compare two values of the same generic type, in ER mode, with static optimizations
/// for known cases.
let inline GenericComparisonFast<'T> (x:'T) (y:'T) : int =
GenericComparisonIntrinsic x y
when 'T : bool = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : sbyte = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : int16 = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : int32 = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : int64 = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : nativeint = if (# "clt" x y : bool #) then (-1) else (# "cgt" x y : int #)
when 'T : byte = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : uint16 = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : uint32 = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : uint64 = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : unativeint = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : float = if (# "clt" x y : bool #) then (-1)
elif (# "cgt" x y : bool #) then (1)
elif (# "ceq" x y : bool #) then (0)
elif (# "ceq" y y : bool #) then (-1)
else (# "ceq" x x : int #)
when 'T : float32 = if (# "clt" x y : bool #) then (-1)
elif (# "cgt" x y : bool #) then (1)
elif (# "ceq" x y : bool #) then (0)
elif (# "ceq" y y : bool #) then (-1)
else (# "ceq" x x : int #)
when 'T : char = if (# "clt.un" x y : bool #) then (-1) else (# "cgt.un" x y : int #)
when 'T : string =
// NOTE: we don't have to null check here because System.String.CompareOrdinal
// gives reliable results on null values.
System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #))
when 'T : decimal = System.Decimal.Compare((# "" x:decimal #), (# "" y:decimal #))
/// Generic less-than with static optimizations for some well-known cases.
let inline GenericLessThanFast (x:'T) (y:'T) =
GenericLessThanIntrinsic x y
when 'T : bool = (# "clt" x y : bool #)
when 'T : sbyte = (# "clt" x y : bool #)
when 'T : int16 = (# "clt" x y : bool #)
when 'T : int32 = (# "clt" x y : bool #)
when 'T : int64 = (# "clt" x y : bool #)
when 'T : byte = (# "clt.un" x y : bool #)
when 'T : uint16 = (# "clt.un" x y : bool #)
when 'T : uint32 = (# "clt.un" x y : bool #)
when 'T : uint64 = (# "clt.un" x y : bool #)
when 'T : unativeint = (# "clt.un" x y : bool #)
when 'T : nativeint = (# "clt" x y : bool #)
when 'T : float = (# "clt" x y : bool #)
when 'T : float32= (# "clt" x y : bool #)
when 'T : char = (# "clt" x y : bool #)
when 'T : decimal = System.Decimal.op_LessThan ((# "" x:decimal #), (# "" y:decimal #))
/// Generic greater-than with static optimizations for some well-known cases.
let inline GenericGreaterThanFast (x:'T) (y:'T) =
GenericGreaterThanIntrinsic x y
when 'T : bool = (# "cgt" x y : bool #)
when 'T : sbyte = (# "cgt" x y : bool #)
when 'T : int16 = (# "cgt" x y : bool #)
when 'T : int32 = (# "cgt" x y : bool #)
when 'T : int64 = (# "cgt" x y : bool #)
when 'T : nativeint = (# "cgt" x y : bool #)
when 'T : byte = (# "cgt.un" x y : bool #)
when 'T : uint16 = (# "cgt.un" x y : bool #)
when 'T : uint32 = (# "cgt.un" x y : bool #)
when 'T : uint64 = (# "cgt.un" x y : bool #)
when 'T : unativeint = (# "cgt.un" x y : bool #)
when 'T : float = (# "cgt" x y : bool #)
when 'T : float32 = (# "cgt" x y : bool #)
when 'T : char = (# "cgt" x y : bool #)
when 'T : decimal = System.Decimal.op_GreaterThan ((# "" x:decimal #), (# "" y:decimal #))
/// Generic less-than-or-equal with static optimizations for some well-known cases.
let inline GenericLessOrEqualFast (x:'T) (y:'T) =
GenericLessOrEqualIntrinsic x y
when 'T : bool = not (# "cgt" x y : bool #)
when 'T : sbyte = not (# "cgt" x y : bool #)
when 'T : int16 = not (# "cgt" x y : bool #)
when 'T : int32 = not (# "cgt" x y : bool #)
when 'T : int64 = not (# "cgt" x y : bool #)
when 'T : nativeint = not (# "cgt" x y : bool #)
when 'T : byte = not (# "cgt.un" x y : bool #)
when 'T : uint16 = not (# "cgt.un" x y : bool #)
when 'T : uint32 = not (# "cgt.un" x y : bool #)
when 'T : uint64 = not (# "cgt.un" x y : bool #)
when 'T : unativeint = not (# "cgt.un" x y : bool #)
when 'T : float = not (# "cgt.un" x y : bool #)
when 'T : float32 = not (# "cgt.un" x y : bool #)
when 'T : char = not(# "cgt" x y : bool #)
when 'T : decimal = System.Decimal.op_LessThanOrEqual ((# "" x:decimal #), (# "" y:decimal #))
/// Generic greater-than-or-equal with static optimizations for some well-known cases.
let inline GenericGreaterOrEqualFast (x:'T) (y:'T) =
GenericGreaterOrEqualIntrinsic x y
when 'T : bool = not (# "clt" x y : bool #)
when 'T : sbyte = not (# "clt" x y : bool #)
when 'T : int16 = not (# "clt" x y : bool #)
when 'T : int32 = not (# "clt" x y : bool #)
when 'T : int64 = not (# "clt" x y : bool #)
when 'T : nativeint = not (# "clt" x y : bool #)
when 'T : byte = not (# "clt.un" x y : bool #)
when 'T : uint16 = not (# "clt.un" x y : bool #)
when 'T : uint32 = not (# "clt.un" x y : bool #)
when 'T : uint64 = not (# "clt.un" x y : bool #)
when 'T : unativeint = not (# "clt.un" x y : bool #)
when 'T : float = not (# "clt.un" x y : bool #)
when 'T : float32 = not (# "clt.un" x y : bool #)
when 'T : char = not (# "clt" x y : bool #)
when 'T : decimal = System.Decimal.op_GreaterThanOrEqual ((# "" x:decimal #), (# "" y:decimal #))
//-------------------------------------------------------------------------
// LangaugePrimitives.HashCompare: EQUALITY
//-------------------------------------------------------------------------
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityByteArray (x:byte[]) (y:byte[]) : bool=
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = byteEq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityInt32Array (x:int[]) (y:int[]) : bool=
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = int32Eq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays
let GenericEqualitySingleArray er (x:float32[]) (y:float32[]) : bool=
let lenx = x.Length
let leny = y.Length
let f32eq x y = if er && not(float32Eq x x) && not(float32Eq y y) then true else (float32Eq x y)
let c = (lenx = leny)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = f32eq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityDoubleArray er (x:float[]) (y:float[]) : bool=
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny)
let feq x y = if er && not(floatEq x x) && not(floatEq y y) then true else (floatEq x y)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = feq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityCharArray (x:char[]) (y:char[]) : bool=
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = charEq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityInt64Array (x:int64[]) (y:int64[]) : bool=
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = int64Eq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// The core implementation of generic equality between two objects. This corresponds
/// to th e pseudo-code in the F# language spec.
//
// Run in either PER or ER mode. In PER mode, equality involving a NaN returns "false".
// In ER mode, equality on two NaNs returns "true".
//
// If "er" is true the "iec" is fsEqualityComparerNoHashingER
// If "er" is false the "iec" is fsEqualityComparerNoHashingPER
let rec GenericEqualityObj (er:bool) (iec:System.Collections.IEqualityComparer) ((xobj:obj),(yobj:obj)) : bool =
(*if objEq xobj yobj then true else *)
match xobj,yobj with
| null,null -> true
| null,_ -> false
| _,null -> false
| (:? string as xs),(:? string as ys) -> System.String.Equals(xs,ys)
// Permit structural equality on arrays
| (:? System.Array as arr1),_ ->
match arr1,yobj with
// Fast path
| (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericEqualityObjArray er iec arr1 arr2
// Fast path
| (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericEqualityByteArray arr1 arr2
| (:? (int32[]) as arr1), (:? (int32[]) as arr2) -> GenericEqualityInt32Array arr1 arr2
| (:? (int64[]) as arr1), (:? (int64[]) as arr2) -> GenericEqualityInt64Array arr1 arr2
| (:? (char[]) as arr1), (:? (char[]) as arr2) -> GenericEqualityCharArray arr1 arr2
| (:? (float32[]) as arr1), (:? (float32[]) as arr2) -> GenericEqualitySingleArray er arr1 arr2
| (:? (float[]) as arr1), (:? (float[]) as arr2) -> GenericEqualityDoubleArray er arr1 arr2
| _ , (:? System.Array as arr2) -> GenericEqualityArbArray er iec arr1 arr2
| _ -> xobj.Equals(yobj)
| (:? IStructuralEquatable as x1),_ -> x1.Equals(yobj,iec)
// Ensure ER NaN semantics on recursive calls
| (:? float as f1), (:? float as f2) ->
if er && (not (# "ceq" f1 f1 : bool #)) && (not (# "ceq" f2 f2 : bool #)) then true // NAN with ER semantics
else (# "ceq" f1 f2 : bool #) // PER semantics
| (:? float32 as f1), (:? float32 as f2) ->
if er && (not (# "ceq" f1 f1 : bool #)) && (not (# "ceq" f2 f2 : bool #)) then true // NAN with ER semantics
else (# "ceq" f1 f2 : bool #) // PER semantics
| _ -> xobj.Equals(yobj)
/// specialcase: Core implementation of structural equality on arbitrary arrays.
and GenericEqualityArbArray er (iec:System.Collections.IEqualityComparer) (x:System.Array) (y:System.Array) : bool =
#if FX_NO_ARRAY_LONG_LENGTH
if x.Rank = 1 && y.Rank = 1 then
// check lengths
let lenx = x.Length
let leny = y.Length
(int32Eq lenx leny) &&
// check contents
let basex = x.GetLowerBound(0)
let basey = y.GetLowerBound(0)
(int32Eq basex basey) &&
let rec check i = (i >= lenx) || (GenericEqualityObj er iec ((x.GetValue(basex + i)),(y.GetValue(basey + i))) && check (i + 1))
check 0
elif x.Rank = 2 && y.Rank = 2 then
// check lengths
let lenx0 = x.GetLength(0)
let leny0 = y.GetLength(0)
(int32Eq lenx0 leny0) &&
let lenx1 = x.GetLength(1)
let leny1 = y.GetLength(1)
(int32Eq lenx1 leny1) &&
let basex0 = x.GetLowerBound(0)
let basex1 = x.GetLowerBound(1)
let basey0 = y.GetLowerBound(0)
let basey1 = y.GetLowerBound(1)
(int32Eq basex0 basey0) &&
(int32Eq basex1 basey1) &&
// check contents
let rec check0 i =
let rec check1 j = (j >= lenx1) || (GenericEqualityObj er iec ((x.GetValue(basex0 + i,basex1 + j)), (y.GetValue(basey0 + i,basey1 + j))) && check1 (j + 1))
(i >= lenx0) || (check1 0 && check0 (i + 1))
check0 0
else
(x.Rank = y.Rank) &&
let ndims = x.Rank
// check lengths
let rec precheck k =
(k >= ndims) ||
(int32Eq (x.GetLength(k)) (y.GetLength(k)) &&
int32Eq (x.GetLowerBound(k)) (y.GetLowerBound(k)) &&
precheck (k+1))
precheck 0 &&
let idxs : int32[] = zeroCreate ndims
// check contents
let rec checkN k baseIdx i lim =
(i >= lim) ||
(set idxs k (baseIdx + i);
(if k = ndims - 1
then GenericEqualityObj er iec ((x.GetValue(idxs)),(y.GetValue(idxs)))
else check (k+1)) &&
checkN k baseIdx (i + 1) lim)
and check k =
(k >= ndims) ||
(let baseIdx = x.GetLowerBound(k)
checkN k baseIdx 0 (x.GetLength(k)))
check 0
#else
if x.Rank = 1 && y.Rank = 1 then
// check lengths
let lenx = x.LongLength
let leny = y.LongLength
(int64Eq lenx leny) &&
// check contents
let basex = int64 (x.GetLowerBound(0))
let basey = int64 (y.GetLowerBound(0))
(int64Eq basex basey) &&
let rec check i = (i >=. lenx) || (GenericEqualityObj er iec ((x.GetValue(basex +. i)),(y.GetValue(basey +. i))) && check (i +. 1L))
check 0L
elif x.Rank = 2 && y.Rank = 2 then
// check lengths
let lenx0 = x.GetLongLength(0)
let leny0 = y.GetLongLength(0)
(int64Eq lenx0 leny0) &&
let lenx1 = x.GetLongLength(1)
let leny1 = y.GetLongLength(1)
(int64Eq lenx1 leny1) &&
let basex0 = int64 (x.GetLowerBound(0))
let basex1 = int64 (x.GetLowerBound(1))
let basey0 = int64 (y.GetLowerBound(0))
let basey1 = int64 (y.GetLowerBound(1))
(int64Eq basex0 basey0) &&
(int64Eq basex1 basey1) &&
// check contents
let rec check0 i =
let rec check1 j = (j >=. lenx1) || (GenericEqualityObj er iec ((x.GetValue(basex0 +. i,basex1 +. j)),(y.GetValue(basey0 +. i,basey1 +. j))) && check1 (j +. 1L))
(i >=. lenx0) || (check1 0L && check0 (i +. 1L))
check0 0L
else
(x.Rank = y.Rank) &&
let ndims = x.Rank
// check lengths
let rec precheck k =
(k >= ndims) ||
(int64Eq (x.GetLongLength(k)) (y.GetLongLength(k)) &&
int32Eq (x.GetLowerBound(k)) (y.GetLowerBound(k)) &&
precheck (k+1))
precheck 0 &&
let idxs : int64[] = zeroCreate ndims
// check contents
let rec checkN k baseIdx i lim =
(i >=. lim) ||
(set idxs k (baseIdx +. i);
(if k = ndims - 1
then GenericEqualityObj er iec ((x.GetValue(idxs)),(y.GetValue(idxs)))
else check (k+1)) &&
checkN k baseIdx (i +. 1L) lim)
and check k =
(k >= ndims) ||
(let baseIdx = x.GetLowerBound(k)
checkN k (int64 baseIdx) 0L (x.GetLongLength(k)))
check 0
#endif
/// optimized case: Core implementation of structural equality on object arrays.
and GenericEqualityObjArray er iec (x:obj[]) (y:obj[]) : bool =
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny )
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = GenericEqualityObj er iec ((get x i),(get y i))
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// One of the two unique instances of System.Collections.IEqualityComparer. Implements PER semantics
/// where equality on NaN returns "false".
let fsEqualityComparerNoHashingPER =
{ new System.Collections.IEqualityComparer with
override iec.Equals(x:obj,y:obj) = GenericEqualityObj false iec (x,y) // PER Semantics
override iec.GetHashCode(x:obj) = raise (InvalidOperationException (SR.GetString(SR.notUsedForHashing))) }
/// One of the two unique instances of System.Collections.IEqualityComparer. Implements ER semantics
/// where equality on NaN returns "true".
let fsEqualityComparerNoHashingER =
{ new System.Collections.IEqualityComparer with
override iec.Equals(x:obj,y:obj) = GenericEqualityObj true iec (x,y) // ER Semantics
override iec.GetHashCode(x:obj) = raise (InvalidOperationException (SR.GetString(SR.notUsedForHashing))) }
/// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false)
//
// The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs)
// and devirtualizes calls to it based on "T".
let GenericEqualityIntrinsic (x : 'T) (y : 'T) : bool =
GenericEqualityObj false fsEqualityComparerNoHashingPER ((box x), (box y))
/// 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 =
GenericEqualityObj true fsEqualityComparerNoHashingER ((box x), (box 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.
let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool =
comp.Equals((box x),(box y))
/// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true)
//
// 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
//
// If no static optimization applies, this becomes GenericEqualityERIntrinsic.
let inline GenericEqualityERFast (x : 'T) (y : 'T) : bool =
GenericEqualityERIntrinsic x y
when 'T : bool = (# "ceq" x y : bool #)
when 'T : sbyte = (# "ceq" x y : bool #)
when 'T : int16 = (# "ceq" x y : bool #)
when 'T : int32 = (# "ceq" x y : bool #)
when 'T : int64 = (# "ceq" x y : bool #)
when 'T : byte = (# "ceq" x y : bool #)
when 'T : uint16 = (# "ceq" x y : bool #)
when 'T : uint32 = (# "ceq" x y : bool #)
when 'T : uint64 = (# "ceq" x y : bool #)
when 'T : nativeint = (# "ceq" x y : bool #)
when 'T : unativeint = (# "ceq" x y : bool #)
when 'T : float =
if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then
true
else
(# "ceq" x y : bool #)
when 'T : float32 =
if not (# "ceq" x x : bool #) && not (# "ceq" y y : bool #) then
true
else
(# "ceq" x y : bool #)
when 'T : char = (# "ceq" x y : bool #)
when 'T : string = System.String.Equals((# "" x : string #),(# "" y : string #))
when 'T : decimal = System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #))
/// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false)
//
// If no static optimization applies, this becomes GenericEqualityIntrinsic.
let inline GenericEqualityFast (x : 'T) (y : 'T) : bool =
GenericEqualityIntrinsic x y
when 'T : bool = (# "ceq" x y : bool #)
when 'T : sbyte = (# "ceq" x y : bool #)
when 'T : int16 = (# "ceq" x y : bool #)
when 'T : int32 = (# "ceq" x y : bool #)
when 'T : int64 = (# "ceq" x y : bool #)
when 'T : byte = (# "ceq" x y : bool #)
when 'T : uint16 = (# "ceq" x y : bool #)
when 'T : uint32 = (# "ceq" x y : bool #)
when 'T : uint64 = (# "ceq" x y : bool #)
when 'T : float = (# "ceq" x y : bool #)
when 'T : float32 = (# "ceq" x y : bool #)
when 'T : char = (# "ceq" x y : bool #)
when 'T : nativeint = (# "ceq" x y : bool #)
when 'T : unativeint = (# "ceq" x y : bool #)
when 'T : string = System.String.Equals((# "" x : string #),(# "" y : string #))
when 'T : decimal = System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #))
/// A compiler intrinsic generated during optimization of calls to GenericEqualityIntrinsic on tuple values.
//
// If no static optimization applies, this becomes GenericEqualityIntrinsic.
//
// Note, although this function says "WithComparer", the static optimization conditionals for float and float32
// mean that it has PER semantics. This is OK because calls to this function are only generated by
// the F# compiler, ultimately stemming from an optimization of GenericEqualityIntrinsic when used on a tuple type.
let inline GenericEqualityWithComparerFast (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool =
GenericEqualityWithComparerIntrinsic comp x y
when 'T : bool = (# "ceq" x y : bool #)
when 'T : sbyte = (# "ceq" x y : bool #)
when 'T : int16 = (# "ceq" x y : bool #)
when 'T : int32 = (# "ceq" x y : bool #)
when 'T : int64 = (# "ceq" x y : bool #)
when 'T : byte = (# "ceq" x y : bool #)
when 'T : uint16 = (# "ceq" x y : bool #)
when 'T : uint32 = (# "ceq" x y : bool #)
when 'T : uint64 = (# "ceq" x y : bool #)
when 'T : float = (# "ceq" x y : bool #)
when 'T : float32 = (# "ceq" x y : bool #)
when 'T : char = (# "ceq" x y : bool #)
when 'T : nativeint = (# "ceq" x y : bool #)
when 'T : unativeint = (# "ceq" x y : bool #)
when 'T : string = System.String.Equals((# "" x : string #),(# "" y : string #))
when 'T : decimal = System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #))
let inline GenericInequalityFast (x:'T) (y:'T) = (not(GenericEqualityFast x y) : bool)
let inline GenericInequalityERFast (x:'T) (y:'T) = (not(GenericEqualityERFast x y) : bool)
//-------------------------------------------------------------------------
// LangaugePrimitives.HashCompare: HASHING.
//-------------------------------------------------------------------------
let defaultHashNodes = 18
/// The implementation of IEqualityComparer, using depth-limited for hashing and PER semantics for NaN equality.
type CountLimitedHasherPER(sz:int) =
[<DefaultValue>]
val mutable nodeCount : int
member x.Fresh() =
if (System.Threading.Interlocked.CompareExchange(&(x.nodeCount), sz, 0) = 0) then
x
else
new CountLimitedHasherPER(sz)
interface IEqualityComparer
/// The implementation of IEqualityComparer, using unlimited depth for hashing and ER semantics for NaN equality.
type UnlimitedHasherER() =
interface IEqualityComparer
/// The implementation of IEqualityComparer, using unlimited depth for hashing and PER semantics for NaN equality.
type UnlimitedHasherPER() =
interface IEqualityComparer
/// The unique object for unlimited depth for hashing and ER semantics for equality.
let fsEqualityComparerUnlimitedHashingER = UnlimitedHasherER()
/// The unique object for unlimited depth for hashing and PER semantics for equality.
let fsEqualityComparerUnlimitedHashingPER = UnlimitedHasherPER()
let inline HashCombine nr x y = (x <<< 1) + y + 631 * nr
let GenericHashObjArray (iec : System.Collections.IEqualityComparer) (x: obj[]) : int =
let len = x.Length
let mutable i = len - 1
if i > defaultHashNodes then i <- defaultHashNodes // limit the hash
let mutable acc = 0
while (i >= 0) do
// NOTE: GenericHash* call decreases nr
acc <- HashCombine i acc (iec.GetHashCode(x.GetValue(i)));
i <- i - 1
acc
// optimized case - byte arrays
let GenericHashByteArray (x: byte[]) : int =
let len = length x
let mutable i = len - 1
if i > defaultHashNodes then i <- defaultHashNodes // limit the hash
let mutable acc = 0
while (i >= 0) do
acc <- HashCombine i acc (intOfByte (get x i));
i <- i - 1
acc
// optimized case - int arrays
let GenericHashInt32Array (x: int[]) : int =
let len = length x
let mutable i = len - 1
if i > defaultHashNodes then i <- defaultHashNodes // limit the hash
let mutable acc = 0
while (i >= 0) do
acc <- HashCombine i acc (get x i);
i <- i - 1
acc
// optimized case - int arrays
let GenericHashInt64Array (x: int64[]) : int =
let len = length x
let mutable i = len - 1
if i > defaultHashNodes then i <- defaultHashNodes // limit the hash
let mutable acc = 0
while (i >= 0) do
acc <- HashCombine i acc (int32 (get x i));
i <- i - 1
acc
// special case - arrays do not by default have a decent structural hashing function
let GenericHashArbArray (iec : System.Collections.IEqualityComparer) (x: System.Array) : int =
match x.Rank with
| 1 ->
let b = x.GetLowerBound(0)
let len = x.Length
let mutable i = b + len - 1
if i > b + defaultHashNodes then i <- b + defaultHashNodes // limit the hash
let mutable acc = 0
while (i >= b) do
// NOTE: GenericHash* call decreases nr
acc <- HashCombine i acc (iec.GetHashCode(x.GetValue(i)));
i <- i - 1
acc
| _ ->
HashCombine 10 (x.GetLength(0)) (x.GetLength(1))
// Core implementation of structural hashing, corresponds to pseudo-code in the
// F# Language spec. Searches for the IStructuralHash interface, otherwise uses GetHashCode().
// Arrays are structurally hashed through a separate technique.
//
// "iec" is either fsEqualityComparerUnlimitedHashingER, fsEqualityComparerUnlimitedHashingPER or a CountLimitedHasherPER.
let rec GenericHashParamObj (iec : System.Collections.IEqualityComparer) (x: obj) : int =
match x with
| null -> 0
| (:? System.Array as a) ->
match a with
| :? (obj[]) as oa -> GenericHashObjArray iec oa
| :? (byte[]) as ba -> GenericHashByteArray ba
| :? (int[]) as ba -> GenericHashInt32Array ba
| :? (int64[]) as ba -> GenericHashInt64Array ba
| _ -> GenericHashArbArray iec a
| :? IStructuralEquatable as a ->
a.GetHashCode(iec)
| _ ->
x.GetHashCode()
/// Fill in the implementation of CountLimitedHasherPER
type CountLimitedHasherPER with
interface System.Collections.IEqualityComparer with
override iec.Equals(x:obj,y:obj) =
GenericEqualityObj false iec (x,y)
override iec.GetHashCode(x:obj) =
iec.nodeCount <- iec.nodeCount - 1
if iec.nodeCount > 0 then
GenericHashParamObj iec x
else
-1
/// Fill in the implementation of UnlimitedHasherER
type UnlimitedHasherER with
interface System.Collections.IEqualityComparer with
override iec.Equals(x:obj,y:obj) = GenericEqualityObj true iec (x,y)
override iec.GetHashCode(x:obj) = GenericHashParamObj iec x
/// Fill in the implementation of UnlimitedHasherPER
type UnlimitedHasherPER with
interface System.Collections.IEqualityComparer with
override iec.Equals(x:obj,y:obj) = GenericEqualityObj false iec (x,y)
override iec.GetHashCode(x:obj) = GenericHashParamObj iec x
/// Intrinsic for calls to depth-unlimited structural hashing that were not optimized by static conditionals.
//
// NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_inner_vref in opt.fs)
// and devirtualizes calls to it based on type "T".
let GenericHashIntrinsic x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box(x))
/// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals.
let LimitedGenericHashIntrinsic limit x = GenericHashParamObj (CountLimitedHasherPER(limit)) (box(x))
/// Intrinsic for a recursive call to structural hashing that was not optimized by static conditionals.
//
// "iec" is assumed to be either fsEqualityComparerUnlimitedHashingER, fsEqualityComparerUnlimitedHashingPER or
// a CountLimitedHasherPER.
//
// NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_withc_inner_vref in opt.fs)
// and devirtualizes calls to it based on type "T".
let GenericHashWithComparerIntrinsic<'T> (iec : System.Collections.IEqualityComparer) (x : 'T) : int =
GenericHashParamObj iec (box(x))
/// Direct call to GetHashCode on the string type
let inline HashString (s:string) =
match s with
| null -> 0
| _ -> (# "call instance int32 [mscorlib]System.String::GetHashCode()" s : int #)
// from mscorlib v4.0.30319
let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #)
let inline HashSByte (x:sbyte) = (# "xor" (# "shl" x 8 : int #) x : int #)
let inline HashInt16 (x:int16) = (# "or" (# "conv.u2" x : int #) (# "shl" x 16 : int #) : int #)
let inline HashInt64 (x:int64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr" x 32 : int #) : int #) : int #)
let inline HashUInt64 (x:uint64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr.un" x 32 : int #) : int #) : int #)
let inline HashIntPtr (x:nativeint) = (# "conv.i4" (# "conv.u8" x : uint64 #) : int #)
let inline HashUIntPtr (x:unativeint) = (# "and" (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) 0x7fffffff : int #)
/// Core entry into structural hashing for either limited or unlimited hashing.
//
// "iec" is assumed to be either fsEqualityComparerUnlimitedHashingER, fsEqualityComparerUnlimitedHashingPER or
// a CountLimitedHasherPER.
let inline GenericHashWithComparerFast (iec : System.Collections.IEqualityComparer) (x:'T) : int =
GenericHashWithComparerIntrinsic iec x
when 'T : bool = (# "" x : int #)
when 'T : int32 = (# "" x : int #)
when 'T : byte = (# "" x : int #)
when 'T : uint32 = (# "" x : int #)
when 'T : char = HashChar (# "" x : char #)
when 'T : sbyte = HashSByte (# "" x : sbyte #)
when 'T : int16 = HashInt16 (# "" x : int16 #)
when 'T : int64 = HashInt64 (# "" x : int64 #)
when 'T : uint64 = HashUInt64 (# "" x : uint64 #)
when 'T : nativeint = HashIntPtr (# "" x : nativeint #)
when 'T : unativeint = HashUIntPtr (# "" x : unativeint #)
when 'T : uint16 = (# "" x : int #)
when 'T : string = HashString (# "" x : string #)
/// Core entry into depth-unlimited structural hashing. Hash to a given depth limit.
let inline GenericHashFast (x:'T) : int =
GenericHashIntrinsic x
when 'T : bool = (# "" x : int #)
when 'T : int32 = (# "" x : int #)
when 'T : byte = (# "" x : int #)
when 'T : uint32 = (# "" x : int #)
when 'T : char = HashChar (# "" x : char #)
when 'T : sbyte = HashSByte (# "" x : sbyte #)
when 'T : int16 = HashInt16 (# "" x : int16 #)
when 'T : int64 = HashInt64 (# "" x : int64 #)
when 'T : uint64 = HashUInt64 (# "" x : uint64 #)
when 'T : nativeint = HashIntPtr (# "" x : nativeint #)
when 'T : unativeint = HashUIntPtr (# "" x : unativeint #)
when 'T : uint16 = (# "" x : int #)
when 'T : string = HashString (# "" x : string #)
/// Core entry into depth-limited structural hashing.
let inline GenericLimitedHashFast (limit:int) (x:'T) : int =
LimitedGenericHashIntrinsic limit x
when 'T : bool = (# "" x : int #)
when 'T : int32 = (# "" x : int #)
when 'T : byte = (# "" x : int #)
when 'T : uint32 = (# "" x : int #)
when 'T : char = HashChar (# "" x : char #)
when 'T : sbyte = HashSByte (# "" x : sbyte #)
when 'T : int16 = HashInt16 (# "" x : int16 #)
when 'T : int64 = HashInt64 (# "" x : int64 #)
when 'T : uint64 = HashUInt64 (# "" x : uint64 #)
when 'T : nativeint = HashIntPtr (# "" x : nativeint #)
when 'T : unativeint = HashUIntPtr (# "" x : unativeint #)
when 'T : uint16 = (# "" x : int #)
when 'T : string = HashString (# "" x : string #)
/// Compiler intrinsic generated for devirtualized calls to structural hashing on tuples.
//
// The F# compiler optimizer generates calls to this function when GenericHashWithComparerIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericHashWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastHashTuple2 (comparer:System.Collections.IEqualityComparer) (x1,x2) =
TupleUtils.combineTupleHashes (GenericHashWithComparerFast comparer x1) (GenericHashWithComparerFast comparer x2)
/// Compiler intrinsic generated for devirtualized calls to structural hashing on tuples.
//
// The F# compiler optimizer generates calls to this function when GenericHashWithComparerIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericHashWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastHashTuple3 (comparer:System.Collections.IEqualityComparer) (x1,x2,x3) =
TupleUtils.combineTupleHashes (TupleUtils.combineTupleHashes (GenericHashWithComparerFast comparer x1) (GenericHashWithComparerFast comparer x2)) (GenericHashWithComparerFast comparer x3)
/// Compiler intrinsic generated for devirtualized calls to structural hashing on tuples.
//
// The F# compiler optimizer generates calls to this function when GenericHashWithComparerIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericHashWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastHashTuple4 (comparer:System.Collections.IEqualityComparer) (x1,x2,x3,x4) =
TupleUtils.combineTupleHashes (TupleUtils.combineTupleHashes (GenericHashWithComparerFast comparer x1) (GenericHashWithComparerFast comparer x2)) (TupleUtils.combineTupleHashes (GenericHashWithComparerFast comparer x3) (GenericHashWithComparerFast comparer x4))
/// Compiler intrinsic generated for devirtualized calls to structural hashing on tuples.
//
// The F# compiler optimizer generates calls to this function when GenericHashWithComparerIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericHashWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastHashTuple5 (comparer:System.Collections.IEqualityComparer) (x1,x2,x3,x4,x5) =
TupleUtils.combineTupleHashes (TupleUtils.combineTupleHashes (TupleUtils.combineTupleHashes (GenericHashWithComparerFast comparer x1) (GenericHashWithComparerFast comparer x2)) (TupleUtils.combineTupleHashes (GenericHashWithComparerFast comparer x3) (GenericHashWithComparerFast comparer x4))) (GenericHashWithComparerFast comparer x5)
/// Compiler intrinsic generated for devirtualized calls to PER-semantic structural equality on tuples
//
// The F# compiler optimizer generates calls to this function when GenericEqualityIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericEqualityWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastEqualsTuple2 (comparer:System.Collections.IEqualityComparer) (x1,x2) (y1,y2) =
GenericEqualityWithComparerFast comparer x1 y1 &&
GenericEqualityWithComparerFast comparer x2 y2
/// Compiler intrinsic generated for devirtualized calls to PER-semantic structural equality on tuples.
//
// The F# compiler optimizer generates calls to this function when GenericEqualityIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericEqualityWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastEqualsTuple3 (comparer:System.Collections.IEqualityComparer) (x1,x2,x3) (y1,y2,y3) =
GenericEqualityWithComparerFast comparer x1 y1 &&
GenericEqualityWithComparerFast comparer x2 y2 &&
GenericEqualityWithComparerFast comparer x3 y3
/// Compiler intrinsic generated for devirtualized calls to PER-semantic structural equality on tuples (with PER semantics).
//
// The F# compiler optimizer generates calls to this function when GenericEqualityIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericEqualityWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastEqualsTuple4 (comparer:System.Collections.IEqualityComparer) (x1,x2,x3,x4) (y1,y2,y3,y4) =
GenericEqualityWithComparerFast comparer x1 y1 &&
GenericEqualityWithComparerFast comparer x2 y2 &&
GenericEqualityWithComparerFast comparer x3 y3 &&
GenericEqualityWithComparerFast comparer x4 y4
/// Compiler intrinsic generated for devirtualized calls to PER-semantic structural equality on tuples.
//
// The F# compiler optimizer generates calls to this function when GenericEqualityIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericEqualityWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastEqualsTuple5 (comparer:System.Collections.IEqualityComparer) (x1,x2,x3,x4,x5) (y1,y2,y3,y4,y5) =
GenericEqualityWithComparerFast comparer x1 y1 &&
GenericEqualityWithComparerFast comparer x2 y2 &&
GenericEqualityWithComparerFast comparer x3 y3 &&
GenericEqualityWithComparerFast comparer x4 y4 &&
GenericEqualityWithComparerFast comparer x5 y5
/// Compiler intrinsic generated for devirtualized calls to structural comparison on tuples (with ER semantics)
//
// The F# compiler optimizer generates calls to this function when GenericComparisonIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericComparisonWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastCompareTuple2 (comparer:System.Collections.IComparer) (x1,x2) (y1,y2) =
let n = GenericComparisonWithComparerFast comparer x1 y1
if n <> 0 then n else
GenericComparisonWithComparerFast comparer x2 y2
/// Compiler intrinsic generated for devirtualized calls to structural comparison on tuples (with ER semantics)
//
// The F# compiler optimizer generates calls to this function when GenericComparisonIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericComparisonWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastCompareTuple3 (comparer:System.Collections.IComparer) (x1,x2,x3) (y1,y2,y3) =
let n = GenericComparisonWithComparerFast comparer x1 y1
if n <> 0 then n else
let n = GenericComparisonWithComparerFast comparer x2 y2
if n <> 0 then n else
GenericComparisonWithComparerFast comparer x3 y3
/// Compiler intrinsic generated for devirtualized calls to structural comparison on tuples (with ER semantics)
//
// The F# compiler optimizer generates calls to this function when GenericComparisonIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericComparisonWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastCompareTuple4 (comparer:System.Collections.IComparer) (x1,x2,x3,x4) (y1,y2,y3,y4) =
let n = GenericComparisonWithComparerFast comparer x1 y1
if n <> 0 then n else
let n = GenericComparisonWithComparerFast comparer x2 y2
if n <> 0 then n else
let n = GenericComparisonWithComparerFast comparer x3 y3
if n <> 0 then n else
GenericComparisonWithComparerFast comparer x4 y4
/// Compiler intrinsic generated for devirtualized calls to structural comparison on tuples (with ER semantics)
//
// The F# compiler optimizer generates calls to this function when GenericComparisonIntrinsic is used
// statically with a tuple type.
//
// Because the function subsequently gets inlined, the calls to GenericComparisonWithComparerFast can be
// often statically optimized or devirtualized based on the statically known type.
let inline FastCompareTuple5 (comparer:System.Collections.IComparer) (x1,x2,x3,x4,x5) (y1,y2,y3,y4,y5) =
let n = GenericComparisonWithComparerFast comparer x1 y1
if n <> 0 then n else
let n = GenericComparisonWithComparerFast comparer x2 y2
if n <> 0 then n else
let n = GenericComparisonWithComparerFast comparer x3 y3
if n <> 0 then n else
let n = GenericComparisonWithComparerFast comparer x4 y4
if n <> 0 then n else
GenericComparisonWithComparerFast comparer x5 y5
//-------------------------------------------------------------------------
// LanguagePrimitives: PUBLISH HASH, EQUALITY AND COMPARISON FUNCTIONS.
//-------------------------------------------------------------------------
// Publish the intrinsic plus the static optimization conditionals
let inline GenericEquality x y = HashCompare.GenericEqualityFast x y
let inline GenericEqualityER x y = HashCompare.GenericEqualityERFast x y
let inline GenericEqualityWithComparer comp x y = HashCompare.GenericEqualityWithComparerFast comp x y
let inline GenericComparison x y = HashCompare.GenericComparisonFast x y
let inline GenericComparisonWithComparer comp x y = HashCompare.GenericComparisonWithComparerFast comp x y
let inline GenericLessThan x y = HashCompare.GenericLessThanFast x y
let inline GenericGreaterThan x y = HashCompare.GenericGreaterThanFast x y
let inline GenericLessOrEqual x y = HashCompare.GenericLessOrEqualFast x y
let inline GenericGreaterOrEqual x y = HashCompare.GenericGreaterOrEqualFast x y
let inline retype<'T,'U> (x:'T) : 'U = (# "" x : 'U #)
let inline GenericMinimum (x:'T) (y:'T) =
if HashCompare.GenericLessThanFast x y then x else y
when 'T : float = (System.Math.Min : float * float -> float)(retype<_,float> x, retype<_,float> y)
when 'T : float32 = (System.Math.Min : float32 * float32 -> float32)(retype<_,float32> x, retype<_,float32> y)
let inline GenericMaximum (x:'T) (y:'T) =
if HashCompare.GenericLessThanFast x y then y else x
when 'T : float = (System.Math.Max : float * float -> float)(retype<_,float> x, retype<_,float> y)
when 'T : float32 = (System.Math.Max : float32 * float32 -> float32)(retype<_,float32> x, retype<_,float32> y)
let inline PhysicalEquality x y = HashCompare.PhysicalEqualityFast x y
let inline PhysicalHash x = HashCompare.PhysicalHashFast x
let GenericComparer = HashCompare.fsComparerER :> System.Collections.IComparer
let GenericEqualityComparer = HashCompare.fsEqualityComparerUnlimitedHashingPER :> System.Collections.IEqualityComparer
let GenericEqualityERComparer = HashCompare.fsEqualityComparerUnlimitedHashingER :> System.Collections.IEqualityComparer
let inline GenericHash x = HashCompare.GenericHashFast x
let inline GenericLimitedHash limit x = HashCompare.GenericLimitedHashFast limit x
let inline GenericHashWithComparer comp x = HashCompare.GenericHashWithComparerFast comp x
//-------------------------------------------------------------------------
// LanguagePrimitives: PUBLISH IEqualityComparer AND IComparer OBJECTS
//-------------------------------------------------------------------------
let inline MakeGenericEqualityComparer<'T>() =
// type-specialize some common cases to generate more efficient functions
{ new System.Collections.Generic.IEqualityComparer<'T> with
member self.GetHashCode(x) = GenericHash x
member self.Equals(x,y) = GenericEquality x y }
let inline MakeGenericLimitedEqualityComparer<'T>(limit:int) =
// type-specialize some common cases to generate more efficient functions
{ new System.Collections.Generic.IEqualityComparer<'T> with
member self.GetHashCode(x) = GenericLimitedHash limit x
member self.Equals(x,y) = GenericEquality x y }
let BoolIEquality = MakeGenericEqualityComparer<bool>()
let CharIEquality = MakeGenericEqualityComparer<char>()
let StringIEquality = MakeGenericEqualityComparer<string>()
let SByteIEquality = MakeGenericEqualityComparer<sbyte>()
let Int16IEquality = MakeGenericEqualityComparer<int16>()
let Int32IEquality = MakeGenericEqualityComparer<int32>()
let Int64IEquality = MakeGenericEqualityComparer<int64>()
let IntPtrIEquality = MakeGenericEqualityComparer<nativeint>()
let ByteIEquality = MakeGenericEqualityComparer<byte>()
let UInt16IEquality = MakeGenericEqualityComparer<uint16>()
let UInt32IEquality = MakeGenericEqualityComparer<uint32>()
let UInt64IEquality = MakeGenericEqualityComparer<uint64>()
let UIntPtrIEquality = MakeGenericEqualityComparer<unativeint>()
let FloatIEquality = MakeGenericEqualityComparer<float>()
let Float32IEquality = MakeGenericEqualityComparer<float32>()
let DecimalIEquality = MakeGenericEqualityComparer<decimal>()
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type FastGenericEqualityComparerTable<'T>() =
static let f : System.Collections.Generic.IEqualityComparer<'T> =
match typeof<'T> with
| ty when ty.Equals(typeof<bool>) -> unboxPrim (box BoolIEquality)
| ty when ty.Equals(typeof<byte>) -> unboxPrim (box ByteIEquality)
| ty when ty.Equals(typeof<int32>) -> unboxPrim (box Int32IEquality)
| ty when ty.Equals(typeof<uint32>) -> unboxPrim (box UInt32IEquality)
| ty when ty.Equals(typeof<char>) -> unboxPrim (box CharIEquality)
| ty when ty.Equals(typeof<sbyte>) -> unboxPrim (box SByteIEquality)
| ty when ty.Equals(typeof<int16>) -> unboxPrim (box Int16IEquality)
| ty when ty.Equals(typeof<int64>) -> unboxPrim (box Int64IEquality)
| ty when ty.Equals(typeof<nativeint>) -> unboxPrim (box IntPtrIEquality)
| ty when ty.Equals(typeof<uint16>) -> unboxPrim (box UInt16IEquality)
| ty when ty.Equals(typeof<uint64>) -> unboxPrim (box UInt64IEquality)
| ty when ty.Equals(typeof<unativeint>) -> unboxPrim (box UIntPtrIEquality)
| ty when ty.Equals(typeof<float>) -> unboxPrim (box FloatIEquality)
| ty when ty.Equals(typeof<float32>) -> unboxPrim (box Float32IEquality)
| ty when ty.Equals(typeof<decimal>) -> unboxPrim (box DecimalIEquality)
| ty when ty.Equals(typeof<string>) -> unboxPrim (box StringIEquality)
| _ -> MakeGenericEqualityComparer<'T>()
static member Function : System.Collections.Generic.IEqualityComparer<'T> = f
let FastGenericEqualityComparerFromTable<'T> = FastGenericEqualityComparerTable<'T>.Function
// This is the implementation of HashIdentity.Structural. In most cases this just becomes
// FastGenericEqualityComparerFromTable.
let inline FastGenericEqualityComparer<'T> =
// This gets used if 'T can't be resolved to anything interesting
FastGenericEqualityComparerFromTable<'T>
// When 'T is a primitive, just use the fixed entry in the table
when 'T : bool = FastGenericEqualityComparerFromTable<'T>
when 'T : int32 = FastGenericEqualityComparerFromTable<'T>
when 'T : byte = FastGenericEqualityComparerFromTable<'T>
when 'T : uint32 = FastGenericEqualityComparerFromTable<'T>
when 'T : string = FastGenericEqualityComparerFromTable<'T>
when 'T : sbyte = FastGenericEqualityComparerFromTable<'T>
when 'T : int16 = FastGenericEqualityComparerFromTable<'T>
when 'T : int64 = FastGenericEqualityComparerFromTable<'T>
when 'T : nativeint = FastGenericEqualityComparerFromTable<'T>
when 'T : uint16 = FastGenericEqualityComparerFromTable<'T>
when 'T : uint64 = FastGenericEqualityComparerFromTable<'T>
when 'T : unativeint = FastGenericEqualityComparerFromTable<'T>
when 'T : float = FastGenericEqualityComparerFromTable<'T>
when 'T : float32 = FastGenericEqualityComparerFromTable<'T>
when 'T : char = FastGenericEqualityComparerFromTable<'T>
when 'T : decimal = FastGenericEqualityComparerFromTable<'T>
// According to the somewhat subtle rules of static optimizations,
// this condition is used whenever 'T is resolved to a nominal or tuple type
// and none of the other rules above apply.
//
// When 'T is statically known to be nominal or tuple, it is better to inline the implementation of
// MakeGenericEqualityComparer. This is then reduced by further inlining to the primitives
// known to the F# compiler which are then often optimized for the particular nominal type involved.
when 'T : 'T = MakeGenericEqualityComparer<'T>()
let inline FastLimitedGenericEqualityComparer<'T>(limit) = MakeGenericLimitedEqualityComparer<'T>(limit)
let inline MakeGenericComparer<'T>() =
{ new System.Collections.Generic.IComparer<'T> with
member __.Compare(x,y) = GenericComparison x y }
let CharComparer = MakeGenericComparer<char>()
let StringComparer = MakeGenericComparer<string>()
let SByteComparer = MakeGenericComparer<sbyte>()
let Int16Comparer = MakeGenericComparer<int16>()
let Int32Comparer = MakeGenericComparer<int32>()
let Int64Comparer = MakeGenericComparer<int64>()
let IntPtrComparer = MakeGenericComparer<nativeint>()
let ByteComparer = MakeGenericComparer<byte>()
let UInt16Comparer = MakeGenericComparer<uint16>()
let UInt32Comparer = MakeGenericComparer<uint32>()
let UInt64Comparer = MakeGenericComparer<uint64>()
let UIntPtrComparer = MakeGenericComparer<unativeint>()
let FloatComparer = MakeGenericComparer<float>()
let Float32Comparer = MakeGenericComparer<float32>()
let DecimalComparer = MakeGenericComparer<decimal>()
/// Use a type-indexed table to ensure we only create a single FastStructuralComparison function
/// for each type
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type FastGenericComparerTable<'T>() =
// The CLI implementation of mscorlib optimizes array sorting
// when the comparer is either null or precisely
// reference-equals to System.Collections.Generic.Comparer<'T>.Default.
// This is an indication that a "fast" array sorting helper can be used.
//
// So, for all the types listed below, we want to pass in a value of "null" for
// the comparer object. Note that F# generic comparison coincides precisely with
// System.Collections.Generic.Comparer<'T>.Default for these types.
//
// A "null" comparer is only valid if the values do not have identity, e.g. integers.
// That is, an unstable sort of the array must be the semantically the
// same as a stable sort of the array. See Array.stableSortInPlace.
//
// REVIEW: in a future version we could extend this to include additional types
static let fCanBeNull : System.Collections.Generic.IComparer<'T> =
match typeof<'T> with
| ty when ty.Equals(typeof<nativeint>) -> unboxPrim (box IntPtrComparer)
| ty when ty.Equals(typeof<unativeint>) -> unboxPrim (box UIntPtrComparer)
| ty when ty.Equals(typeof<byte>) -> null
| ty when ty.Equals(typeof<char>) -> null
| ty when ty.Equals(typeof<sbyte>) -> null
| ty when ty.Equals(typeof<int16>) -> null
| ty when ty.Equals(typeof<int32>) -> null
| ty when ty.Equals(typeof<int64>) -> null
| ty when ty.Equals(typeof<uint16>) -> null
| ty when ty.Equals(typeof<uint32>) -> null
| ty when ty.Equals(typeof<uint64>) -> null
| ty when ty.Equals(typeof<float>) -> null
| ty when ty.Equals(typeof<float32>) -> null
| ty when ty.Equals(typeof<decimal>) -> null
| ty when ty.Equals(typeof<string>) -> unboxPrim (box StringComparer)
| _ -> MakeGenericComparer<'T>()
static let f : System.Collections.Generic.IComparer<'T> =
match typeof<'T> with
| ty when ty.Equals(typeof<byte>) -> unboxPrim (box ByteComparer)
| ty when ty.Equals(typeof<char>) -> unboxPrim (box CharComparer)
| ty when ty.Equals(typeof<sbyte>) -> unboxPrim (box SByteComparer)
| ty when ty.Equals(typeof<int16>) -> unboxPrim (box Int16Comparer)
| ty when ty.Equals(typeof<int32>) -> unboxPrim (box Int32Comparer)
| ty when ty.Equals(typeof<int64>) -> unboxPrim (box Int64Comparer)
| ty when ty.Equals(typeof<nativeint>) -> unboxPrim (box IntPtrComparer)
| ty when ty.Equals(typeof<uint16>) -> unboxPrim (box UInt16Comparer)
| ty when ty.Equals(typeof<uint32>) -> unboxPrim (box UInt32Comparer)
| ty when ty.Equals(typeof<uint64>) -> unboxPrim (box UInt64Comparer)
| ty when ty.Equals(typeof<unativeint>) -> unboxPrim (box UIntPtrComparer)
| ty when ty.Equals(typeof<float>) -> unboxPrim (box FloatComparer)
| ty when ty.Equals(typeof<float32>) -> unboxPrim (box Float32Comparer)
| ty when ty.Equals(typeof<decimal>) -> unboxPrim (box DecimalComparer)
| ty when ty.Equals(typeof<string>) -> unboxPrim (box StringComparer)
| _ ->
// Review: There are situations where we should be able
// to return System.Collections.Generic.Comparer<'T>.Default here.
// For example, for any value type.
MakeGenericComparer<'T>()
static member Value : System.Collections.Generic.IComparer<'T> = f
static member ValueCanBeNullIfDefaultSemantics : System.Collections.Generic.IComparer<'T> = fCanBeNull
let FastGenericComparerFromTable<'T> =
FastGenericComparerTable<'T>.Value
let inline FastGenericComparer<'T> =
// This gets used is 'T can't be resolved to anything interesting
FastGenericComparerFromTable<'T>
// When 'T is a primitive, just use the fixed entry in the table
when 'T : bool = FastGenericComparerFromTable<'T>
when 'T : sbyte = FastGenericComparerFromTable<'T>
when 'T : int16 = FastGenericComparerFromTable<'T>
when 'T : int32 = FastGenericComparerFromTable<'T>
when 'T : int64 = FastGenericComparerFromTable<'T>
when 'T : nativeint = FastGenericComparerFromTable<'T>
when 'T : byte = FastGenericComparerFromTable<'T>
when 'T : uint16 = FastGenericComparerFromTable<'T>
when 'T : uint32 = FastGenericComparerFromTable<'T>
when 'T : uint64 = FastGenericComparerFromTable<'T>
when 'T : unativeint = FastGenericComparerFromTable<'T>
when 'T : float = FastGenericComparerFromTable<'T>
when 'T : float32 = FastGenericComparerFromTable<'T>
when 'T : char = FastGenericComparerFromTable<'T>
when 'T : string = FastGenericComparerFromTable<'T>
when 'T : decimal = FastGenericComparerFromTable<'T>
// According to the somewhat subtle rules of static optimizations,
// this condition is used whenever 'T is resolved by inlining to be a nominal type
// and none of the other rules above apply
//
// In this case it is better to inline the implementation of MakeGenericComparer so that
// the comparison object is eventually reduced to the primitives known to the F# compiler
// which are then optimized for the particular nominal type involved.
when 'T : 'T = MakeGenericComparer<'T>()
let FastGenericComparerCanBeNull<'T> = FastGenericComparerTable<'T>.ValueCanBeNullIfDefaultSemantics
//-------------------------------------------------------------------------
// LanguagePrimitives: ENUMS
//-------------------------------------------------------------------------
let inline EnumOfValue (u : 'T) : 'Enum when 'Enum : enum<'T> =
unboxPrim<'Enum>(box u)
// According to the somewhat subtle rules of static optimizations,
// this condition is used whenever 'Enum is resolved to a nominal type
when 'Enum : 'Enum = (retype u : 'Enum)
let inline EnumToValue (e : 'Enum) : 'T when 'Enum : enum<'T> =
unboxPrim<'T>(box e)
// According to the somewhat subtle rules of static optimizations,
// this condition is used whenever 'Enum is resolved to a nominal type
when 'Enum : 'Enum = (retype e : 'T)
//-------------------------------------------------------------------------
// LanguagePrimitives: MEASURES
//-------------------------------------------------------------------------
let inline FloatWithMeasure (f : float) : float<'Measure> = retype f
let inline Float32WithMeasure (f : float32) : float32<'Measure> = retype f
let inline DecimalWithMeasure (f : decimal) : decimal<'Measure> = retype f
let inline Int32WithMeasure (f : int) : int<'Measure> = retype f
let inline Int16WithMeasure (f : int16) : int16<'Measure> = retype f
let inline SByteWithMeasure (f : sbyte) : sbyte<'Measure> = retype f
let inline Int64WithMeasure (f : int64) : int64<'Measure> = retype f
let inline formatError() = raise (new System.FormatException(SR.GetString(SR.badFormatString)))
// Parse formats
// DDDDDDDD
// -DDDDDDDD
// 0xHHHHHHHH
// -0xHHHHHHHH
// 0bBBBBBBB
// -0bBBBBBBB
// 0oOOOOOOO
// -0oOOOOOOO
// without leading/trailing spaces.
///
// Note: Parse defaults to NumberStyles.Integer = AllowLeadingWhite ||| AllowTrailingWhite ||| AllowLeadingSign
// However, that is not the required behaviour of 'int32', 'int64' etc. when used on string
// arguments: we explicitly disallow AllowLeadingWhite ||| AllowTrailingWhite
// and only request AllowLeadingSign.
let isOXB c =
#if FX_NO_TO_LOWER_INVARIANT
let c = System.Char.ToLower c
#else
let c = System.Char.ToLowerInvariant c
#endif
charEq c 'x' || charEq c 'o' || charEq c 'b'
let is0OXB (s:string) p l =
l >= p + 2 && charEq (s.Chars(p)) '0' && isOXB (s.Chars(p+1))
let get0OXB (s:string) (p:byref<int>) l =
if is0OXB s p l
#if FX_NO_TO_LOWER_INVARIANT
then let r = System.Char.ToLower(s.Chars(p+1) ) in p <- p + 2; r
#else
then let r = System.Char.ToLowerInvariant(s.Chars(p+1)) in p <- p + 2; r
#endif
else 'd'
let getSign32 (s:string) (p:byref<int>) l =
if (l >= p + 1 && charEq (s.Chars(p)) '-')
then p <- p + 1; -1
else 1
let getSign64 (s:string) (p:byref<int>) l =
if (l >= p + 1 && charEq (s.Chars(p)) '-')
then p <- p + 1; -1L
else 1L
let parseOctalUInt64 (s:string) p l =
let rec parse n acc = if n < l then parse (n+1) (acc *.. 8UL +.. (let c = s.Chars(n) in if c >=... '0' && c <=... '7' then Convert.ToUInt64(c) -.. Convert.ToUInt64('0') else formatError())) else acc in
parse p 0UL
let parseBinaryUInt64 (s:string) p l =
let rec parse n acc = if n < l then parse (n+1) (acc *.. 2UL +.. (match s.Chars(n) with '0' -> 0UL | '1' -> 1UL | _ -> formatError())) else acc in
parse p 0UL
let ParseUInt32 (s:string) =
if System.Object.ReferenceEquals(s,null) then
raise( new System.ArgumentNullException("s") )
let s = s.Trim()
let l = s.Length
let mutable p = 0
let specifier = get0OXB s &p l
if p >= l then formatError() else
match specifier with
| 'x' -> UInt32.Parse( s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture)
| 'b' -> Convert.ToUInt32(parseBinaryUInt64 s p l)
| 'o' -> Convert.ToUInt32(parseOctalUInt64 s p l)
| _ -> UInt32.Parse(s.Substring(p), NumberStyles.Integer, CultureInfo.InvariantCulture) in
let inline int32OfUInt32 (x:uint32) = (# "" x : int32 #)
let inline int64OfUInt64 (x:uint64) = (# "" x : int64 #)
let ParseInt32 (s:string) =
if System.Object.ReferenceEquals(s,null) then
raise( new System.ArgumentNullException("s") )
let s = s.Trim()
let l = s.Length
let mutable p = 0
let sign = getSign32 s &p l
let specifier = get0OXB s &p l
if p >= l then formatError() else
#if FX_NO_TO_LOWER_INVARIANT
match Char.ToLower(specifier, CultureInfo.InvariantCulture(*FxCop:1304*)) with
#else
match Char.ToLowerInvariant(specifier) with
#endif
| 'x' -> sign * (int32OfUInt32 (Convert.ToUInt32(UInt64.Parse(s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture))))
| 'b' -> sign * (int32OfUInt32 (Convert.ToUInt32(parseBinaryUInt64 s p l)))
| 'o' -> sign * (int32OfUInt32 (Convert.ToUInt32(parseOctalUInt64 s p l)))
| _ -> Int32.Parse(s, NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture)
let ParseInt64 (s:string) =
if System.Object.ReferenceEquals(s,null) then
raise( new System.ArgumentNullException("s") )
let s = s.Trim()
let l = s.Length
let mutable p = 0
let sign = getSign64 s &p l
let specifier = get0OXB s &p l
if p >= l then formatError() else
#if FX_NO_TO_LOWER_INVARIANT
match Char.ToLower(specifier, CultureInfo.InvariantCulture(*FxCop:1304*)) with
#else
match Char.ToLowerInvariant(specifier) with
#endif
| 'x' -> sign *. Int64.Parse(s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture)
| 'b' -> sign *. (int64OfUInt64 (parseBinaryUInt64 s p l))
| 'o' -> sign *. (int64OfUInt64 (parseOctalUInt64 s p l))
| _ -> Int64.Parse(s, NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture)
let ParseUInt64 (s:string) : uint64 =
if System.Object.ReferenceEquals(s,null) then
raise( new System.ArgumentNullException("s") )
let s = s.Trim()
let l = s.Length
let mutable p = 0
let specifier = get0OXB s &p l
if p >= l then formatError() else
match specifier with
| 'x' -> UInt64.Parse(s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture)
| 'b' -> parseBinaryUInt64 s p l
| 'o' -> parseOctalUInt64 s p l
| _ -> UInt64.Parse(s.Substring(p), NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture)
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type GenericZeroDynamicImplTable<'T>() =
static let result : 'T =
// The dynamic implementation
let aty = typeof<'T>
if aty.Equals(typeof<sbyte>) then unboxPrim<'T> (box 0y)
elif aty.Equals(typeof<int16>) then unboxPrim<'T> (box 0s)
elif aty.Equals(typeof<int32>) then unboxPrim<'T> (box 0)
elif aty.Equals(typeof<int64>) then unboxPrim<'T> (box 0L)
elif aty.Equals(typeof<nativeint>) then unboxPrim<'T> (box 0n)
elif aty.Equals(typeof<byte>) then unboxPrim<'T> (box 0uy)
elif aty.Equals(typeof<uint16>) then unboxPrim<'T> (box 0us)
elif aty.Equals(typeof<uint32>) then unboxPrim<'T> (box 0u)
elif aty.Equals(typeof<uint64>) then unboxPrim<'T> (box 0UL)
elif aty.Equals(typeof<unativeint>) then unboxPrim<'T> (box 0un)
elif aty.Equals(typeof<decimal>) then unboxPrim<'T> (box 0M)
elif aty.Equals(typeof<float>) then unboxPrim<'T> (box 0.0)
elif aty.Equals(typeof<float32>) then unboxPrim<'T> (box 0.0f)
else
let pinfo = aty.GetProperty("Zero")
unboxPrim<'T> (pinfo.GetValue(null,null))
static member Result : 'T = result
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type GenericOneDynamicImplTable<'T>() =
static let result : 'T =
// The dynamic implementation
let aty = typeof<'T>
if aty.Equals(typeof<sbyte>) then unboxPrim<'T> (box 1y)
elif aty.Equals(typeof<int16>) then unboxPrim<'T> (box 1s)
elif aty.Equals(typeof<int32>) then unboxPrim<'T> (box 1)
elif aty.Equals(typeof<int64>) then unboxPrim<'T> (box 1L)
elif aty.Equals(typeof<nativeint>) then unboxPrim<'T> (box 1n)
elif aty.Equals(typeof<byte>) then unboxPrim<'T> (box 1uy)
elif aty.Equals(typeof<uint16>) then unboxPrim<'T> (box 1us)
elif aty.Equals(typeof<char>) then unboxPrim<'T> (box (retype 1us : char))
elif aty.Equals(typeof<uint32>) then unboxPrim<'T> (box 1u)
elif aty.Equals(typeof<uint64>) then unboxPrim<'T> (box 1UL)
elif aty.Equals(typeof<unativeint>) then unboxPrim<'T> (box 1un)
elif aty.Equals(typeof<decimal>) then unboxPrim<'T> (box 1M)
elif aty.Equals(typeof<float>) then unboxPrim<'T> (box 1.0)
elif aty.Equals(typeof<float32>) then unboxPrim<'T> (box 1.0f)
else
let pinfo = aty.GetProperty("One")
unboxPrim<'T> (pinfo.GetValue(null,null))
static member Result : 'T = result
let GenericZeroDynamic<'T>() : 'T = GenericZeroDynamicImplTable<'T>.Result
let GenericOneDynamic<'T>() : 'T = GenericOneDynamicImplTable<'T>.Result
let inline GenericZero< ^T when ^T : (static member Zero : ^T) > : ^T =
GenericZeroDynamic<(^T)>()
when ^T : int32 = 0
when ^T : float = 0.0
when ^T : float32 = 0.0f
when ^T : int64 = 0L
when ^T : uint64 = 0UL
when ^T : uint32 = 0ul
when ^T : nativeint = 0n
when ^T : unativeint = 0un
when ^T : int16 = 0s
when ^T : uint16 = 0us
when ^T : sbyte = 0y
when ^T : byte = 0uy
when ^T : decimal = 0M
// According to the somewhat subtle rules of static optimizations,
// this condition is used whenever ^T is resolved to a nominal type
when ^T : ^T = (^T : (static member Zero : ^T) ())
let inline GenericOne< ^T when ^T : (static member One : ^T) > : ^T =
GenericOneDynamic<(^T)>()
when ^T : int32 = 1
when ^T : float = 1.0
when ^T : float32 = 1.0f
when ^T : int64 = 1L
when ^T : uint64 = 1UL
when ^T : uint32 = 1ul
when ^T : nativeint = 1n
when ^T : unativeint = 1un
when ^T : int16 = 1s
when ^T : uint16 = 1us
when ^T : char = (retype 1us : char)
when ^T : sbyte = 1y
when ^T : byte = 1uy
when ^T : decimal = 1M
// According to the somewhat subtle rules of static optimizations,
// this condition is used whenever ^T is resolved to a nominal type
// That is, not in the generic implementation of '+'
when ^T : ^T = (^T : (static member One : ^T) ())
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type GenericDivideByIntDynamicImplTable<'T>() =
static let result : ('T -> int -> 'T) =
// The dynamic implementation
let aty = typeof<'T>
if aty.Equals(typeof<decimal>) then unboxPrim<_> (box (fun (x:decimal) (n:int) -> System.Decimal.Divide(x, System.Convert.ToDecimal(n))))
elif aty.Equals(typeof<float>) then unboxPrim<_> (box (fun (x:float) (n:int) -> (# "div" x ((# "conv.r8" n : float #)) : float #)))
elif aty.Equals(typeof<float32>) then unboxPrim<_> (box (fun (x:float32) (n:int) -> (# "div" x ((# "conv.r4" n : float32 #)) : float32 #)))
else
match aty.GetMethod("DivideByInt",[| aty; typeof<int> |]) with
| null -> raise (NotSupportedException (SR.GetString(SR.dyInvDivByIntCoerce)))
| m -> (fun x n -> unboxPrim<_> (m.Invoke(null,[| box x; box n |])))
static member Result : ('T -> int -> 'T) = result
let DivideByIntDynamic<'T> x n = GenericDivideByIntDynamicImplTable<('T)>.Result x n
let inline DivideByInt< ^T when ^T : (static member DivideByInt : ^T * int -> ^T) > (x:^T) (n:int) : ^T =
DivideByIntDynamic<'T> x n
when ^T : float = (# "div" x ((# "conv.r8" (n:int) : float #)) : float #)
when ^T : float32 = (# "div" x ((# "conv.r4" (n:int) : float32 #)) : float32 #)
when ^T : decimal = System.Decimal.Divide((retype x:decimal), System.Convert.ToDecimal(n))
when ^T : ^T = (^T : (static member DivideByInt : ^T * int -> ^T) (x, n))
// Dynamic implementation of addition operator resolution
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type AdditionDynamicImplTable<'T,'U,'V>() =
static let impl : ('T -> 'U -> 'V) =
// The dynamic implementation
let aty = typeof<'T>
let bty = typeof<'U>
let cty = typeof<'V>
let dyn() =
let ameth = aty.GetMethod("op_Addition",[| aty; bty |])
let bmeth = if aty.Equals(bty) then null else bty.GetMethod("op_Addition",[| aty; bty |])
match ameth,bmeth with
| null, null -> raise (NotSupportedException (SR.GetString(SR.dyInvOpAddCoerce)))
| m,null | null,m -> (fun x y -> unboxPrim<_> (m.Invoke(null,[| box x; box y |])))
| _ -> raise (NotSupportedException (SR.GetString(SR.dyInvOpAddOverload)))
if aty.Equals(bty) && bty.Equals(cty) then
if aty.Equals(typeof<sbyte>) then unboxPrim<_> (box (fun (x:sbyte) (y:sbyte) -> (# "conv.i1" (# "add" x y : int32 #) : sbyte #)))
elif aty.Equals(typeof<int16>) then unboxPrim<_> (box (fun (x:int16) (y:int16) -> (# "conv.i2" (# "add" x y : int32 #) : int16 #)))
elif aty.Equals(typeof<int32>) then unboxPrim<_> (box (fun (x:int32) (y:int32) -> (# "add" x y : int32 #)))
elif aty.Equals(typeof<int64>) then unboxPrim<_> (box (fun (x:int64) (y:int64) -> (# "add" x y : int64 #)))
elif aty.Equals(typeof<nativeint>) then unboxPrim<_> (box (fun (x:nativeint) (y:nativeint) -> (# "add" x y : nativeint #)))
elif aty.Equals(typeof<byte>) then unboxPrim<_> (box (fun (x:byte) (y:byte) -> (# "conv.u1" (# "add" x y : uint32 #) : byte #)))
elif aty.Equals(typeof<uint16>) then unboxPrim<_> (box (fun (x:uint16) (y:uint16) -> (# "conv.u2" (# "add" x y : uint32 #) : uint16 #)))
elif aty.Equals(typeof<uint32>) then unboxPrim<_> (box (fun (x:uint32) (y:uint32) -> (# "add" x y : uint32 #)))
elif aty.Equals(typeof<uint64>) then unboxPrim<_> (box (fun (x:uint64) (y:uint64) -> (# "add" x y : uint64 #)))
elif aty.Equals(typeof<unativeint>) then unboxPrim<_> (box (fun (x:unativeint) (y:unativeint) -> (# "add" x y : unativeint #)))
elif aty.Equals(typeof<float>) then unboxPrim<_> (box (fun (x:float) (y:float) -> (# "add" x y : float #)))
elif aty.Equals(typeof<float32>) then unboxPrim<_> (box (fun (x:float32) (y:float32) -> (# "add" x y : float32 #)))
elif aty.Equals(typeof<string>) then unboxPrim<_> (box (fun (x:string) (y:string) -> System.String.Concat(x,y)))
else dyn()
else dyn()
static member Impl : ('T -> 'U -> 'V) = impl
let AdditionDynamic<'T,'U,'V> x n = AdditionDynamicImplTable<'T,'U,'V>.Impl x n
// Dynamic implementation of checked addition operator resolution
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type CheckedAdditionDynamicImplTable<'T,'U,'V>() =
static let impl : ('T -> 'U -> 'V) =
// The dynamic implementation
let aty = typeof<'T>
let bty = typeof<'U>
let cty = typeof<'V>
let dyn() =
let ameth = aty.GetMethod("op_Addition",[| aty; bty |])
let bmeth = if aty.Equals(bty) then null else bty.GetMethod("op_Addition",[| aty; bty |])
match ameth,bmeth with
| null, null -> raise (NotSupportedException (SR.GetString(SR.dyInvOpAddCoerce)))
| m,null | null,m -> (fun x y -> unboxPrim<_> (m.Invoke(null,[| box x; box y |])))
| _ -> raise (NotSupportedException (SR.GetString(SR.dyInvOpAddOverload)))
if aty.Equals(bty) && bty.Equals(cty) then
if aty.Equals(typeof<sbyte>) then unboxPrim<_> (box (fun (x:sbyte) (y:sbyte) -> (# "conv.ovf.i1" (# "add.ovf" x y : int32 #) : sbyte #)))
elif aty.Equals(typeof<int16>) then unboxPrim<_> (box (fun (x:int16) (y:int16) -> (# "conv.ovf.i2" (# "add.ovf" x y : int32 #) : int16 #)))
elif aty.Equals(typeof<int32>) then unboxPrim<_> (box (fun (x:int32) (y:int32) -> (# "add.ovf" x y : int32 #)))
elif aty.Equals(typeof<int64>) then unboxPrim<_> (box (fun (x:int64) (y:int64) -> (# "add.ovf" x y : int64 #)))
elif aty.Equals(typeof<nativeint>) then unboxPrim<_> (box (fun (x:nativeint) (y:nativeint) -> (# "add.ovf" x y : nativeint #)))
elif aty.Equals(typeof<byte>) then unboxPrim<_> (box (fun (x:byte) (y:byte) -> (# "conv.ovf.u1.un" (# "add.ovf.un" x y : uint32 #) : byte #)))
elif aty.Equals(typeof<uint16>) then unboxPrim<_> (box (fun (x:uint16) (y:uint16) -> (# "conv.ovf.u2.un" (# "add.ovf.un" x y : uint32 #) : uint16 #)))
elif aty.Equals(typeof<char>) then unboxPrim<_> (box (fun (x:char) (y:char) -> (# "conv.ovf.u2.un" (# "add.ovf.un" x y : uint32 #) : char #)))
elif aty.Equals(typeof<uint32>) then unboxPrim<_> (box (fun (x:uint32) (y:uint32) -> (# "add.ovf.un" x y : uint32 #)))
elif aty.Equals(typeof<uint64>) then unboxPrim<_> (box (fun (x:uint64) (y:uint64) -> (# "add.ovf.un" x y : uint64 #)))
elif aty.Equals(typeof<unativeint>) then unboxPrim<_> (box (fun (x:unativeint) (y:unativeint) -> (# "add.ovf.un" x y : unativeint #)))
elif aty.Equals(typeof<float>) then unboxPrim<_> (box (fun (x:float) (y:float) -> (# "add" x y : float #)))
elif aty.Equals(typeof<float32>) then unboxPrim<_> (box (fun (x:float32) (y:float32) -> (# "add" x y : float32 #)))
elif aty.Equals(typeof<string>) then unboxPrim<_> (box (fun (x:string) (y:string) -> System.String.Concat(x,y)))
else dyn()
else dyn()
static member Impl : ('T -> 'U -> 'V) = impl
let CheckedAdditionDynamic<'T,'U,'V> x n = CheckedAdditionDynamicImplTable<'T,'U,'V>.Impl x n
// Dynamic implementation of addition operator resolution
[<CodeAnalysis.SuppressMessage("Microsoft.Performance","CA1812:AvoidUninstantiatedInternalClasses")>]
type MultiplyDynamicImplTable<'T,'U,'V>() =
static let impl : ('T -> 'U -> 'V) =
// The dynamic implementation
let aty = typeof<'T>
let bty = typeof<'U>
let cty = typeof<'V>
let dyn() =
let ameth = aty.GetMethod("op_Multiply",[| aty; bty |])
let bmeth = if aty.Equals(bty) then null else bty.GetMethod("op_Multiply",[| aty; bty |])
match ameth,bmeth with
| null, null -> raise (NotSupportedException (SR.GetString(SR.dyInvOpMultCoerce)))