Permalink
executable file 5740 lines (4952 sloc) 320 KB
// Copyright (c) Microsoft Corporation. All Rights Reserved. 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 "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.
#nowarn "3218" // mismatch of parameter name for 'fst' and 'snd'
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
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
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
/// append 'Module' to the end of a non-unique module
| ModuleSuffix = 4
| UseNullAsTrueValue = 8
| Event = 16
[<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
[<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("")
/// This Attribute is used to make Value bindings like
/// let x = some code
/// operate like static properties.
[<AttributeUsage(AttributeTargets.Property,AllowMultiple=false)>]
[<Sealed>]
type ValueAsStaticPropertyAttribute() =
inherit System.Attribute()
[<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
/// <summary>Represents a managed pointer in F# code.</c></summary>
type byref<'T> = (# "!0&" #)
/// <summary>Represents a managed pointer in F# code.</summary>
type byref<'T, 'Kind> = (# "!0&" #)
/// Represents the types of byrefs in F# 4.5+
module ByRefKinds =
/// Represents a byref that can be written
[<Sealed>]
type Out() = class end
/// Represents a byref that can be read
[<Sealed>]
type In() = class end
/// Represents a byref that can be both read and written
[<Sealed>]
type InOut = class end
/// <summary>Represents a in-argument or readonly managed pointer in F# code. This type should only be used with F# 4.5+.</summary>
type inref<'T> = byref<'T, ByRefKinds.In>
/// <summary>Represents a out-argument managed pointer in F# code. This type should only be used with F# 4.5+.</summary>
type outref<'T> = byref<'T, ByRefKinds.Out>
#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(otherType: Type) = this.GetTypeInfo().IsAssignableFrom(otherType.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(attributeType: Type, inherits: bool) : obj[] =
unboxPrim<_> (box (CustomAttributeExtensions.GetCustomAttributes(this.GetTypeInfo(), attributeType, inherits).ToArray()))
open PrimReflectionAdapters
#endif
module internal 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 =
// 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)
//-------------------------------------------------------------------------
// The main aim here is to bootstrap 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
[<ValueAsStaticProperty>]
let AddressOpNotFirstClassString = SR.GetString(SR.addressOpNotFirstClass)
[<ValueAsStaticProperty>]
let NoNegateMinValueString = SR.GetString(SR.noNegateMinValue)
// needs to be public to be visible from inline function 'average' and others
[<ValueAsStaticProperty>]
let InputSequenceEmptyString = SR.GetString(SR.inputSequenceEmpty)
// needs to be public to be visible from inline function 'average' and others
[<ValueAsStaticProperty>]
let InputArrayEmptyString = SR.GetString(SR.arrayWasEmpty)
// needs to be public to be visible from inline function 'average' and others
[<ValueAsStaticProperty>]
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 (&) e1 e2 = if e1 then e2 else false
let (&&) e1 e2 = if e1 then e2 else false
[<CompiledName("Or")>]
let (or) e1 e2 = if e1 then true else e2
let (||) e1 e2 = if e1 then true else e2
//-------------------------------------------------------------------------
// Address-of
// Note, "raise<'T> : exn -> 'T" is manually inlined below.
// Byref usage checks prohibit type instantiations involving byrefs.
[<NoDynamicInvocation>]
let inline (~&) (obj : 'T) : byref<'T> =
ignore obj // pretend the variable is used
let e = new System.ArgumentException(ErrorStrings.AddressOpNotFirstClassString)
(# "throw" (e :> System.Exception) : byref<'T> #)
[<NoDynamicInvocation>]
let inline (~&&) (obj : 'T) : nativeptr<'T> =
ignore obj // 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 computation
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>(source: obj) =
if notnullPrim(source) or TypeInfo<'T>.TypeInfo <> TypeNullnessSemantics_NullNotLiked then
unboxPrim<'T>(source)
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>(source: obj) =
// assert not(TypeInfo<'T>.TypeInfo = TypeNullnessSemantics_NullNotLiked)
unboxPrim<'T>(source)
// worst case: nothing known about source or destination
let TypeTestGeneric<'T>(source: obj) =
if notnullPrim(isinstPrim<'T>(source)) then true
elif notnullPrim(source) then false
else (TypeInfo<'T>.TypeInfo = TypeNullnessSemantics_NullTrueValue)
// quick entry: source is NOT TypeNullnessSemantics_NullTrueValue
let inline TypeTestFast<'T>(source: obj) =
//assert not(TypeInfo<'T>.TypeInfo = TypeNullnessSemantics_NullTrueValue)
notnullPrim(isinstPrim<'T>(source))
let Dispose<'T when 'T :> IDisposable >(resource:'T) =
match box resource with
| null -> ()
| _ -> resource.Dispose()
let FailInit() : unit = raise (InvalidOperationException(SR.GetString(SR.checkInit)))
let FailStaticInit() : unit = raise (InvalidOperationException(SR.GetString(SR.checkStaticInit)))
let CheckThis (x : 'T when 'T : not struct) =
match box x with
| null -> raise (InvalidOperationException(SR.GetString(SR.checkInit)))
| _ -> x
let inline MakeDecimal low medium high isNegative scale = Decimal(low,medium,high,isNegative,scale)
let inline GetString (source: string) (index:int) = source.Chars(index)
let inline CreateInstance<'T when 'T : (new : unit -> 'T) >() =
(System.Activator.CreateInstance() : 'T)
let inline GetArray (source: 'T array) (index:int) = (# "ldelem.any !0" type ('T) source index : 'T #)
let inline SetArray (target: 'T array) (index:int) (value:'T) = (# "stelem.any !0" type ('T) target index value #)
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 (source: 'T[,]) (index1: int) (index2: int) = (# "ldelem.multi 2 !0" type ('T) source index1 index2 : 'T #)
let inline SetArray2D (target: 'T[,]) (index1: int) (index2: int) (value: 'T) = (# "stelem.multi 2 !0" type ('T) target index1 index2 value #)
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 (source: 'T[,,]) (index1: int) (index2: int) (index3: int) =
(# "ldelem.multi 3 !0" type ('T) source index1 index2 index3 : 'T #)
let inline SetArray3D (target: 'T[,,]) (index1: int) (index2: int) (index3: int) (value:'T) =
(# "stelem.multi 3 !0" type ('T) target index1 index2 index3 value #)
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 (source: 'T[,,,]) (index1: int) (index2: int) (index3: int) (index4: int) =
(# "ldelem.multi 4 !0" type ('T) source index1 index2 index3 index4 : 'T #)
let inline SetArray4D (target: 'T[,,,]) (index1: int) (index2: int) (index3: int) (index4: int) (value:'T) =
(# "stelem.multi 4 !0" type ('T) target index1 index2 index3 index4 value #)
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 =
//-------------------------------------------------------------------------
// LanguagePrimitives.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 (input: 'T) : int when 'T : not struct =
System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode(box input)
let inline PhysicalHashFast (input: 'T) =
PhysicalHashIntrinsic input
//-------------------------------------------------------------------------
// LanguagePrimitives.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(String.Format(SR.GetString(SR.genericCompareFail1), obj.GetType().ToString())))
/// This type has two instances - fsComparerER and fsComparerThrow.
/// - fsComparerER = ER semantics = no throw on NaN comparison = new GenericComparer(false) = GenericComparer = GenericComparison
/// - 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 basey0 = int64 (y.GetLowerBound(0))
let c = int64Order basex0 basey0
if c <> 0 then c else
let basex1 = int64 (x.GetLowerBound(1))
let basey1 = int64 (y.GetLowerBound(1))
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 #))
//-------------------------------------------------------------------------
// LanguagePrimitives.HashCompare: EQUALITY
//-------------------------------------------------------------------------
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityByteArray (x:byte[]) (y:byte[]) : bool=
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = byteEq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityInt32Array (x:int[]) (y:int[]) : bool=
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = int32Eq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays
let GenericEqualitySingleArray er (x:float32[]) (y:float32[]) : bool=
let lenx = x.Length
let leny = y.Length
let f32eq x y = if er && not(float32Eq x x) && not(float32Eq y y) then true else (float32Eq x y)
let c = (lenx = leny)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = f32eq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityDoubleArray er (x:float[]) (y:float[]) : bool=
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny)
let feq x y = if er && not(floatEq x x) && not(floatEq y y) then true else (floatEq x y)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = feq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityCharArray (x:char[]) (y:char[]) : bool=
let lenx = x.Length
let leny = y.Length
let c = (lenx = leny)
if not c then c
else
let mutable i = 0
let mutable res = true
while i < lenx do
let c = charEq (get x i) (get y i)
if not c then (res <- false; i <- lenx)
else i <- i + 1
res
/// optimized case: Core implementation of structural equality on arrays.
let GenericEqualityInt64Array (x:int64[]) (y:int64[]) : bool=
let 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)
//-------------------------------------------------------------------------
// LanguagePrimitives.HashCompare: HASHING.
//-------------------------------------------------------------------------
let defaultHashNodes = 18
/// The implementation of IEqualityComparer, using depth-limited for hashing and PER semantics for NaN equality.
type CountLimitedHasherPER(sz:int) =
[<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 input = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box input)
/// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals.
let LimitedGenericHashIntrinsic limit input = GenericHashParamObj (CountLimitedHasherPER(limit)) (box input)
/// 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> (comp : System.Collections.IEqualityComparer) (input : 'T) : int =
GenericHashParamObj comp (box input)
/// Direct call to GetHashCode on the string type
let inline HashString (s:string) =
match s with
| null -> 0
| _ -> (# "call instance int32 [mscorlib]System.String::GetHashCode()" s : int #)
// from mscorlib v4.0.30319
let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #)
let inline HashSByte (x:sbyte) = (# "xor" (# "shl" x 8 : int #) x : int #)
let inline HashInt16 (x:int16) = (# "or" (# "conv.u2" x : int #) (# "shl" x 16 : int #) : int #)
let inline HashInt64 (x:int64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr" x 32 : int #) : int #) : int #)
let inline HashUInt64 (x:uint64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr.un" x 32 : int #) : int #) : int #)
let inline HashIntPtr (x:nativeint) = (# "conv.i4" (# "conv.u8" x : uint64 #) : int #)
let inline HashUIntPtr (x:unativeint) = (# "and" (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) 0x7fffffff : int #)
/// Core entry into structural hashing for either limited or unlimited hashing.
//
// "iec" is assumed to be either fsEqualityComparerUnlimitedHashingER, fsEqualityComparerUnlimitedHashingPER or
// 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 e1 e2 = HashCompare.GenericEqualityFast e1 e2
let inline GenericEqualityER e1 e2 = HashCompare.GenericEqualityERFast e1 e2
let inline GenericEqualityWithComparer comp e1 e2 = HashCompare.GenericEqualityWithComparerFast comp e1 e2
let inline GenericComparison e1 e2 = HashCompare.GenericComparisonFast e1 e2
let inline GenericComparisonWithComparer comp e1 e2 = HashCompare.GenericComparisonWithComparerFast comp e1 e2
let inline GenericLessThan e1 e2 = HashCompare.GenericLessThanFast e1 e2
let inline GenericGreaterThan e1 e2 = HashCompare.GenericGreaterThanFast e1 e2
let inline GenericLessOrEqual e1 e2 = HashCompare.GenericLessOrEqualFast e1 e2
let inline GenericGreaterOrEqual e1 e2 = HashCompare.GenericGreaterOrEqualFast e1 e2
let inline retype<'T,'U> (x:'T) : 'U = (# "" x : 'U #)
let inline GenericMinimum (e1: 'T) (e2: 'T) =
if HashCompare.GenericLessThanFast e1 e2 then e1 else e2
when 'T : float = (System.Math.Min : float * float -> float)(retype<_,float> e1, retype<_,float> e2)
when 'T : float32 = (System.Math.Min : float32 * float32 -> float32)(retype<_,float32> e1, retype<_,float32> e2)
let inline GenericMaximum (e1: 'T) (e2: 'T) =
if HashCompare.GenericLessThanFast e1 e2 then e2 else e1
when 'T : float = (System.Math.Max : float * float -> float)(retype<_,float> e1, retype<_,float> e2)
when 'T : float32 = (System.Math.Max : float32 * float32 -> float32)(retype<_,float32> e1, retype<_,float32> e2)
let inline PhysicalEquality e1 e2 = HashCompare.PhysicalEqualityFast e1 e2
let inline PhysicalHash obj = HashCompare.PhysicalHashFast obj
let GenericComparer = HashCompare.fsComparerER :> IComparer
let GenericEqualityComparer = HashCompare.fsEqualityComparerUnlimitedHashingPER :> IEqualityComparer
let GenericEqualityERComparer = HashCompare.fsEqualityComparerUnlimitedHashingER :> IEqualityComparer
let inline GenericHash obj = HashCompare.GenericHashFast obj
let inline GenericLimitedHash limit obj = HashCompare.GenericLimitedHashFast limit obj
let inline GenericHashWithComparer comparer obj = HashCompare.GenericHashWithComparerFast comparer obj
//-------------------------------------------------------------------------
// 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>()
let BoolComparer = MakeGenericComparer<bool>()
/// 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)
| ty when ty.Equals(typeof<bool>) -> null
| _ -> 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)
| ty when ty.Equals(typeof<bool>) -> unboxPrim (box BoolComparer)
| _ ->
// Review: There are situations where we should be able
// to return System.Collections.Generic.Comparer<'T>.Default here.
// For example, for any value type.
MakeGenericComparer<'T>()
static member Value : System.Collections.Generic.IComparer<'T> = f
static member ValueCanBeNullIfDefaultSemantics : System.Collections.Generic.IComparer<'T> = fCanBeNull
let FastGenericComparerFromTable<'T> =
FastGenericComparerTable<'T>.Value
let 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 (value : 'T) : 'Enum when 'Enum : enum<'T> =
unboxPrim<'Enum>(box value)
// 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 value : 'Enum)
let inline EnumToValue (enum : 'Enum) : 'T when 'Enum : enum<'T> =
unboxPrim<'T>(box enum)
// 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 enum : '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 =
let c = System.Char.ToLowerInvariant c
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
then let r = System.Char.ToLowerInvariant(s.Chars(p+1)) in p <- p + 2; r
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 inline removeUnderscores (s:string) =
match s with
| null -> null
| s -> s.Replace("_", "")
let ParseUInt32 (s:string) =
if System.Object.ReferenceEquals(s,null) then
raise( new System.ArgumentNullException("s") )
let s = removeUnderscores (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 = removeUnderscores (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
match Char.ToLowerInvariant(specifier) with
| '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 = removeUnderscores (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
match Char.ToLowerInvariant(specifier) with
| '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 = removeUnderscores (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 y = GenericDivideByIntDynamicImplTable<('T)>.Result x y
let inline DivideByInt< ^T when ^T : (static member DivideByInt : ^T * int -> ^T) > (x:^T) (y:int) : ^T =
DivideByIntDynamic<'T> x y
when ^T : float = (# "div" x ((# "conv.r8" (y:int) : float #)) : float #)
when ^T : float32 = (# "div" x ((# "conv.r4" (y:int) : float32 #)) : float32 #)
when ^T : decimal = System.Decimal.Divide((retype x:decimal), System.Convert.ToDecimal(y))
when ^T : ^T = (^T : (static member DivideByInt : ^T * int -> ^T) (x, y))
// 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 y = AdditionDynamicImplTable<'T,'U,'V>.Impl x y
// 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 y = CheckedAdditionDynamicImplTable<'T,'U,'V>.Impl x y
// 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)))
| m,null | null,m -> (fun x y -> unboxPrim<_> (m.Invoke(null,[| box x; box y |])))
| _ -> raise (NotSupportedException (SR.GetString(SR.dyInvOpMultOverload)))
if aty.Equals(bty) && bty.Equals(cty) then
if aty.Equals(typeof<sbyte>) then unboxPrim<_> (box (fun (x:sbyte) (y:sbyte) -> (# "conv.i1" (# "mul" x y : int32 #) : sbyte #)))
elif aty.Equals(typeof<int16>) then unboxPrim<_> (box (fun (x:int16) (y:int16) -> (# "conv.i2" (# "mul" x y : int32 #) : int16 #)))
elif aty.Equals(typeof<int32>) then unboxPrim<_> (box (fun (x:int32) (y:int32) -> (# "mul" x y : int32 #)))
elif aty.Equals(typeof<int64>) then unboxPrim<_> (box (fun (x:int64) (y:int64) -> (# "mul" x y : int64 #)))
elif aty.Equals(typeof<nativeint>) then unboxPrim<_> (box (fun (x:nativeint) (y:nativeint) -> (# "mul" x y : nativeint #)))
elif aty.Equals(typeof<byte>) then unboxPrim<_> (box (fun (x:byte) (y:byte) -> (# "conv.u1" (# "mul" x y : uint32 #) : byte #)))
elif aty.Equals(typeof<uint16>) then unboxPrim<_> (box (fun (x:uint16) (y:uint16) -> (# "conv.u2" (# "mul" x y : uint32 #) : uint16 #)))
elif aty.Equals(typeof<uint32>) then unboxPrim<_> (box (fun (x:uint32) (y:uint32) -> (# "mul" x y : uint32 #)))
elif aty.Equals(typeof<uint64>) then unboxPrim<_> (box (fun (x:uint64) (y:uint64) -> (# "mul" x y : uint64 #)))
elif aty.Equals(typeof<unativeint>) then unboxPrim<_> (box (fun (x:unativeint) (y:unativeint) -> (# "mul" x y : unativeint #)))
elif aty.Equals(typeof<float>) then unboxPrim<_> (box (fun (x:float) (y:float) -> (# "mul" x y : float #)))
elif aty.Equals(typeof<float32>) then unboxPrim<_> (box (fun (x:float32) (y:float32) -> (# "mul" 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 MultiplyDynamic<'T,'U,