diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 489b9188a2b..972578c7f3e 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -111,11 +111,8 @@ Utilities/EditDistance.fs - - Utilities/TaggedCollections.fsi - - - Utilities/TaggedCollections.fs + + Utilities/SortKey.fs Utilities/QueueList.fs @@ -135,18 +132,6 @@ Utilities/filename.fs - - Utilities/zmap.fsi - - - Utilities/zmap.fs - - - Utilities/zset.fsi - - - Utilities/zset.fs - Utilities/bytes.fsi diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index c07408e8ab6..7a913101428 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -27,8 +27,6 @@ open Microsoft.FSharp.Core.Printf open Microsoft.FSharp.Core.ReflectionAdapters #endif -let codeLabelOrder = ComparisonIdentity.Structural - // Convert the output of convCustomAttr open Microsoft.FSharp.Compiler.AbstractIL.ILAsciiWriter let wrapCustomAttr setCustomAttr (cinfo, bytes) = @@ -284,8 +282,8 @@ type System.Reflection.Emit.ILGenerator with let inline flagsIf b x = if b then x else enum 0 -module Zmap = - let force x m str = match Zmap.tryFind x m with Some y -> y | None -> failwithf "Zmap.force: %s: x = %+A" str x +module Map = + let force x m str = match Map.tryFind x m with Some y -> y | None -> failwithf "Map.force: %s: x = %+A" str x let equalTypes (s:Type) (t:Type) = s.Equals(t) let equalTypeLists ss tt = List.lengthsEqAndForall2 equalTypes ss tt @@ -363,30 +361,25 @@ let convTypeRefAux (cenv:cenv) (tref:ILTypeRef) = /// and could be placed as hash tables in the global environment. [] type emEnv = - { emTypMap : Zmap ; - emConsMap : Zmap; - emMethMap : Zmap; - emFieldMap : Zmap; - emPropMap : Zmap; + { emTypMap : Map + emConsMap : Map; + emMethMap : Map + emFieldMap : Map + emPropMap : Map emLocals : LocalBuilder[]; - emLabels : Zmap; + emLabels : Map emTyvars : Type[] list; // stack emEntryPts : (TypeBuilder * string) list delayedFieldInits : (unit -> unit) list} -let orderILTypeRef = ComparisonIdentity.Structural -let orderILMethodRef = ComparisonIdentity.Structural -let orderILFieldRef = ComparisonIdentity.Structural -let orderILPropertyRef = ComparisonIdentity.Structural - let emEnv0 = - { emTypMap = Zmap.empty orderILTypeRef; - emConsMap = Zmap.empty orderILMethodRef; - emMethMap = Zmap.empty orderILMethodRef; - emFieldMap = Zmap.empty orderILFieldRef; - emPropMap = Zmap.empty orderILPropertyRef; + { emTypMap = Map.empty + emConsMap = Map.empty + emMethMap = Map.empty + emFieldMap = Map.empty + emPropMap = Map.empty emLocals = [| |]; - emLabels = Zmap.empty codeLabelOrder; + emLabels = Map.empty emTyvars = []; emEntryPts = [] delayedFieldInits = [] } @@ -394,13 +387,13 @@ let emEnv0 = let envBindTypeRef emEnv (tref:ILTypeRef) (typT, typB, typeDef)= match typT with | null -> failwithf "binding null type in envBindTypeRef: %s\n" tref.Name; - | _ -> {emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, None) emEnv.emTypMap} + | _ -> {emEnv with emTypMap = Map.add tref (typT, typB, typeDef, None) emEnv.emTypMap} let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = // The tref's TypeBuilder has been created, so we have a Type proper. // Update the tables to include this created type (the typT held prior to this is (i think) actually (TypeBuilder :> Type). // The (TypeBuilder :> Type) does not implement all the methods that a Type proper does. - let typT, typB, typeDef, _createdTypOpt = Zmap.force tref emEnv.emTypMap "envGetTypeDef: failed" + let typT, typB, typeDef, _createdTypOpt = Map.force tref emEnv.emTypMap "envGetTypeDef: failed" if typB.IsCreated() then let ty = typB.CreateTypeAndLog() #if ENABLE_MONO_SUPPORT @@ -415,7 +408,7 @@ let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = System.Runtime.Serialization.FormatterServices.GetUninitializedObject(ty) |> ignore with e -> () #endif - {emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, Some ty) emEnv.emTypMap} + {emEnv with emTypMap = Map.add tref (typT, typB, typeDef, Some ty) emEnv.emTypMap} else #if DEBUG printf "envUpdateCreatedTypeRef: expected type to be created\n"; @@ -424,7 +417,7 @@ let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = let convTypeRef cenv emEnv preferCreated (tref:ILTypeRef) = let res = - match Zmap.tryFind tref emEnv.emTypMap with + match Map.tryFind tref emEnv.emTypMap with | Some (_typT, _typB, _typeDef, Some createdTy) when preferCreated -> createdTy | Some (typT, _typB, _typeDef, _) -> typT | None -> convTypeRefAux cenv tref @@ -433,35 +426,35 @@ let convTypeRef cenv emEnv preferCreated (tref:ILTypeRef) = | _ -> res let envBindConsRef emEnv (mref:ILMethodRef) consB = - {emEnv with emConsMap = Zmap.add mref consB emEnv.emConsMap} + {emEnv with emConsMap = Map.add mref consB emEnv.emConsMap} let envGetConsB emEnv (mref:ILMethodRef) = - Zmap.force mref emEnv.emConsMap "envGetConsB: failed" + Map.force mref emEnv.emConsMap "envGetConsB: failed" let envBindMethodRef emEnv (mref:ILMethodRef) methB = - {emEnv with emMethMap = Zmap.add mref methB emEnv.emMethMap} + {emEnv with emMethMap = Map.add mref methB emEnv.emMethMap} let envGetMethB emEnv (mref:ILMethodRef) = - Zmap.force mref emEnv.emMethMap "envGetMethB: failed" + Map.force mref emEnv.emMethMap "envGetMethB: failed" let envBindFieldRef emEnv fref fieldB = - {emEnv with emFieldMap = Zmap.add fref fieldB emEnv.emFieldMap} + {emEnv with emFieldMap = Map.add fref fieldB emEnv.emFieldMap} let envGetFieldB emEnv fref = - Zmap.force fref emEnv.emFieldMap "- envGetMethB: failed" + Map.force fref emEnv.emFieldMap "- envGetMethB: failed" let envBindPropRef emEnv (pref:ILPropertyRef) propB = - {emEnv with emPropMap = Zmap.add pref propB emEnv.emPropMap} + {emEnv with emPropMap = Map.add pref propB emEnv.emPropMap} let envGetPropB emEnv pref = - Zmap.force pref emEnv.emPropMap "- envGetPropB: failed" + Map.force pref emEnv.emPropMap "- envGetPropB: failed" let envGetTypB emEnv (tref:ILTypeRef) = - Zmap.force tref emEnv.emTypMap "envGetTypB: failed" + Map.force tref emEnv.emTypMap "envGetTypB: failed" |> (fun (_typT, typB, _typeDef, _createdTypOpt) -> typB) let envGetTypeDef emEnv (tref:ILTypeRef) = - Zmap.force tref emEnv.emTypMap "envGetTypeDef: failed" + Map.force tref emEnv.emTypMap "envGetTypeDef: failed" |> (fun (_typT, _typB, typeDef, _createdTypOpt) -> typeDef) let envSetLocals emEnv locs = assert (emEnv.emLocals.Length = 0); // check "locals" is not yet set (scopes once only) @@ -469,11 +462,11 @@ let envSetLocals emEnv locs = assert (emEnv.emLocals.Length = 0); // check "loca let envGetLocal emEnv i = emEnv.emLocals.[i] // implicit bounds checking let envSetLabel emEnv name lab = - assert (not (Zmap.mem name emEnv.emLabels)); - {emEnv with emLabels = Zmap.add name lab emEnv.emLabels} + assert (not (Map.containsKey name emEnv.emLabels)); + {emEnv with emLabels = Map.add name lab emEnv.emLabels} let envGetLabel emEnv name = - Zmap.find name emEnv.emLabels + Map.find name emEnv.emLabels let envPushTyvars emEnv tys = {emEnv with emTyvars = tys :: emEnv.emTyvars} let envPopTyvars emEnv = {emEnv with emTyvars = List.tail emEnv.emTyvars} @@ -487,7 +480,7 @@ let envGetTyvar emEnv u16 = else tvs.[i] -let isEmittedTypeRef emEnv tref = Zmap.mem tref emEnv.emTypMap +let isEmittedTypeRef emEnv tref = Map.containsKey tref emEnv.emTypMap let envAddEntryPt emEnv mref = {emEnv with emEntryPts = mref::emEnv.emEntryPts} let envPopEntryPts emEnv = {emEnv with emEntryPts = []}, emEnv.emEntryPts @@ -2147,6 +2140,6 @@ let LookupTypeRef cenv emEnv tref = convCreatedTypeRef cenv emEnv tref let LookupType cenv emEnv ty = convCreatedType cenv emEnv ty // Lookups of ILFieldRef and MethodRef may require a similar non-Builder-fixup post Type-creation. -let LookupFieldRef emEnv fref = Zmap.tryFind fref emEnv.emFieldMap |> Option.map (fun fieldBuilder -> fieldBuilder :> FieldInfo) -let LookupMethodRef emEnv mref = Zmap.tryFind mref emEnv.emMethMap |> Option.map (fun methodBuilder -> methodBuilder :> MethodInfo) +let LookupFieldRef emEnv fref = Map.tryFind fref emEnv.emFieldMap |> Option.map (fun fieldBuilder -> fieldBuilder :> FieldInfo) +let LookupMethodRef emEnv mref = Map.tryFind mref emEnv.emMethMap |> Option.map (fun methodBuilder -> methodBuilder :> MethodInfo) diff --git a/src/absil/zmap.fs b/src/absil/zmap.fs deleted file mode 100644 index c08767e2744..00000000000 --- a/src/absil/zmap.fs +++ /dev/null @@ -1,47 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.FSharp.Compiler.AbstractIL.Internal - -open Internal.Utilities.Collections.Tagged -open System.Collections.Generic - -/// Maps with a specific comparison function -type internal Zmap<'Key,'T> = Internal.Utilities.Collections.Tagged.Map<'Key,'T> - -[] -module internal Zmap = - - let empty (ord: IComparer<'T>) = Map<_,_,_>.Empty(ord) - - let add k v (m:Zmap<_,_>) = m.Add(k,v) - let find k (m:Zmap<_,_>) = m.[k] - let tryFind k (m:Zmap<_,_>) = m.TryFind(k) - let remove k (m:Zmap<_,_>) = m.Remove(k) - let mem k (m:Zmap<_,_>) = m.ContainsKey(k) - let iter f (m:Zmap<_,_>) = m.Iterate(f) - let first f (m:Zmap<_,_>) = m.First(fun k v -> if f k v then Some (k,v) else None) - let exists f (m:Zmap<_,_>) = m.Exists(f) - let forall f (m:Zmap<_,_>) = m.ForAll(f) - let map f (m:Zmap<_,_>) = m.MapRange(f) - let mapi f (m:Zmap<_,_>) = m.Map(f) - let fold f (m:Zmap<_,_>) x = m.Fold f x - let toList (m:Zmap<_,_>) = m.ToList() - let foldSection lo hi f (m:Zmap<_,_>) x = m.FoldSection lo hi f x - - let isEmpty (m:Zmap<_,_>) = m.IsEmpty - - let foldMap f z (m:Zmap<_,_>) = - let m,z = m.FoldAndMap (fun k v z -> let z,v' = f z k v in v',z) z in - z,m - - let choose f (m:Zmap<_,_>) = m.First(f) - - let chooseL f (m:Zmap<_,_>) = - m.Fold (fun k v s -> match f k v with None -> s | Some x -> x::s) [] - - let ofList ord xs = Internal.Utilities.Collections.Tagged.Map<_,_>.FromList(ord,xs) - - let keys (m:Zmap<_,_>) = m.Fold (fun k _ s -> k::s) [] - let values (m:Zmap<_,_>) = m.Fold (fun _ v s -> v::s) [] - - let memberOf m k = mem k m diff --git a/src/absil/zmap.fsi b/src/absil/zmap.fsi deleted file mode 100644 index 12a17400029..00000000000 --- a/src/absil/zmap.fsi +++ /dev/null @@ -1,45 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.FSharp.Compiler.AbstractIL.Internal - -open Internal.Utilities -open Internal.Utilities.Collections.Tagged -open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library -open System.Collections.Generic - -/// Maps with a specific comparison function -type internal Zmap<'Key,'T> = Internal.Utilities.Collections.Tagged.Map<'Key,'T> - -[] -module internal Zmap = - - val empty : IComparer<'Key> -> Zmap<'Key,'T> - val isEmpty : Zmap<'Key,'T> -> bool - - val add : 'Key -> 'T -> Zmap<'Key,'T> -> Zmap<'Key,'T> - val remove : 'Key -> Zmap<'Key,'T> -> Zmap<'Key,'T> - val mem : 'Key -> Zmap<'Key,'T> -> bool - val memberOf : Zmap<'Key,'T> -> 'Key -> bool - val tryFind : 'Key -> Zmap<'Key,'T> -> 'T option - val find : 'Key -> Zmap<'Key,'T> -> 'T // raises KeyNotFoundException - - val map : mapping:('T -> 'U) -> Zmap<'Key,'T> -> Zmap<'Key,'U> - val mapi : ('Key -> 'T -> 'U) -> Zmap<'Key,'T> -> Zmap<'Key,'U> - val fold : ('Key -> 'T -> 'U -> 'U) -> Zmap<'Key,'T> -> 'U -> 'U - val foldMap : ('State -> 'Key -> 'T -> 'State * 'U) -> 'State -> Zmap<'Key,'T> -> 'State * Zmap<'Key,'U> - val iter : action:('T -> 'U -> unit) -> Zmap<'T, 'U> -> unit - - val foldSection: 'Key -> 'Key -> ('Key -> 'T -> 'U -> 'U) -> Zmap<'Key,'T> -> 'U -> 'U - - val first : ('Key -> 'T -> bool) -> Zmap<'Key,'T> -> ('Key * 'T) option - val exists : ('Key -> 'T -> bool) -> Zmap<'Key,'T> -> bool - val forall : ('Key -> 'T -> bool) -> Zmap<'Key,'T> -> bool - - val choose : ('Key -> 'T -> 'U option) -> Zmap<'Key,'T> -> 'U option - val chooseL : ('Key -> 'T -> 'U option) -> Zmap<'Key,'T> -> 'U list - - val toList : Zmap<'Key,'T> -> ('Key * 'T) list - val ofList : IComparer<'Key> -> ('Key * 'T) list -> Zmap<'Key,'T> - - val keys : Zmap<'Key,'T> -> 'Key list - val values : Zmap<'Key,'T> -> 'T list diff --git a/src/absil/zset.fs b/src/absil/zset.fs deleted file mode 100644 index 960caa06e36..00000000000 --- a/src/absil/zset.fs +++ /dev/null @@ -1,43 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.FSharp.Compiler.AbstractIL.Internal - -open Microsoft.FSharp.Compiler.AbstractIL -open Microsoft.FSharp.Compiler.AbstractIL.Internal -open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library -open Internal.Utilities -open Internal.Utilities.Collections.Tagged -open System.Collections.Generic - -/// Sets with a specific comparison function -type internal Zset<'T> = Internal.Utilities.Collections.Tagged.Set<'T> - -[] -module internal Zset = - - let empty (ord : IComparer<'T>) = Internal.Utilities.Collections.Tagged.Set<_,_>.Empty(ord) - - let isEmpty (s:Zset<_>) = s.IsEmpty - - let contains x (s:Zset<_>) = s.Contains(x) - let add x (s:Zset<_>) = s.Add(x) - let addList xs a = List.fold (fun a x -> add x a) a xs - - let singleton ord x = add x (empty ord) - let remove x (s:Zset<_>) = s.Remove(x) - - let fold (f : 'T -> 'b -> 'b) (s:Zset<_>) b = s.Fold f b - let iter f (s:Zset<_>) = s.Iterate f - let forall p (s:Zset<_>) = s.ForAll p - let count (s:Zset<_>) = s.Count - let exists p (s:Zset<_>) = s.Exists p - let subset (s1:Zset<_>) (s2:Zset<_>) = s1.IsSubsetOf s2 - let equal (s1:Zset<_>) (s2:Zset<_>) = Internal.Utilities.Collections.Tagged.Set<_,_>.Equality(s1,s2) - let elements (s:Zset<_>) = s.ToList() - let filter p (s:Zset<_>) = s.Filter p - - let union (s1:Zset<_>) (s2:Zset<_>) = Internal.Utilities.Collections.Tagged.Set<_,_>.Union(s1,s2) - let inter (s1:Zset<_>) (s2:Zset<_>) = Internal.Utilities.Collections.Tagged.Set<_,_>.Intersection(s1,s2) - let diff (s1:Zset<_>) (s2:Zset<_>) = Internal.Utilities.Collections.Tagged.Set<_,_>.Difference(s1,s2) - - let memberOf m k = contains k m diff --git a/src/absil/zset.fsi b/src/absil/zset.fsi deleted file mode 100644 index 094e0288128..00000000000 --- a/src/absil/zset.fsi +++ /dev/null @@ -1,42 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.FSharp.Compiler.AbstractIL.Internal - -open Internal.Utilities -open Microsoft.FSharp.Compiler.AbstractIL -open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library -open System.Collections.Generic - -/// Sets with a specific comparison function -type internal Zset<'T> = Internal.Utilities.Collections.Tagged.Set<'T> - - -[] -module internal Zset = - - val empty : IComparer<'T> -> Zset<'T> - val isEmpty : Zset<'T> -> bool - val contains : 'T -> Zset<'T> -> bool - val memberOf : Zset<'T> -> 'T -> bool - val add : 'T -> Zset<'T> -> Zset<'T> - val addList : 'T list -> Zset<'T> -> Zset<'T> - val singleton : IComparer<'T> -> 'T -> Zset<'T> - val remove : 'T -> Zset<'T> -> Zset<'T> - - val count : Zset<'T> -> int - val union : Zset<'T> -> Zset<'T> -> Zset<'T> - val inter : Zset<'T> -> Zset<'T> -> Zset<'T> - val diff : Zset<'T> -> Zset<'T> -> Zset<'T> - val equal : Zset<'T> -> Zset<'T> -> bool - val subset : Zset<'T> -> Zset<'T> -> bool - val forall : predicate:('T -> bool) -> Zset<'T> -> bool - val exists : predicate:('T -> bool) -> Zset<'T> -> bool - val filter : predicate:('T -> bool) -> Zset<'T> -> Zset<'T> - - val fold : ('T -> 'State -> 'State) -> Zset<'T> -> 'State -> 'State - val iter : ('T -> unit) -> Zset<'T> -> unit - - val elements : Zset<'T> -> 'T list - - - diff --git a/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj b/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index 1668c425ebe..23836872cba 100644 --- a/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj +++ b/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -75,11 +75,8 @@ Utilities\EditDistance.fs - - Utilities\TaggedCollections.fsi - - - Utilities\TaggedCollections.fs + + Utilities\SortKey.fs Utilities\ildiag.fsi @@ -96,18 +93,6 @@ Utilities\filename.fs - - Utilities\zmap.fsi - - - Utilities\zmap.fs - - - Utilities\zset.fsi - - - Utilities\zset.fs - Utilities\bytes.fsi diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index d54373c5548..f0fe182cdec 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -5329,11 +5329,16 @@ let CheckSimulateException(tcConfig:TcConfig) = // Type-check sets of files //-------------------------------------------------------------------------- -type RootSigs = Zmap -type RootImpls = Zset - let qnameOrder = Order.orderBy (fun (q:QualifiedNameOfFile) -> q.Text) +[] +type QNameOrder = + interface System.Collections.Generic.IComparer with + member __.Compare(v1, v2) = qnameOrder.Compare (v1,v2) + +type RootSigs = zmap +type RootImpls = zset + type TcState = { tcsCcu: CcuThunk tcsCcuType: ModuleOrNamespace @@ -5403,8 +5408,8 @@ let GetInitialTcState(m, ccuName, tcConfig:TcConfig, tcGlobals, tcImports:TcImpo tcsTcSigEnv=tcEnv0 tcsTcImplEnv=tcEnv0 tcsCreatesGeneratedProvidedTypes=false - tcsRootSigs = Zmap.empty qnameOrder - tcsRootImpls = Zset.empty qnameOrder + tcsRootSigs = Zmap.empty () + tcsRootImpls = Zset.empty () tcsCcuSig = NewEmptyModuleOrNamespaceType Namespace } @@ -5425,7 +5430,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig:TcConfig, tcImports:Tc | ParsedInput.SigFile (ParsedSigFileInput(_, qualNameOfFile, _, _, _) as file) -> // Check if we've seen this top module signature before. - if Zmap.mem qualNameOfFile tcState.tcsRootSigs then + if Zmap.containsKey qualNameOfFile tcState.tcsRootSigs then errorR(Error(FSComp.SR.buildSignatureAlreadySpecified(qualNameOfFile.Text), m.StartRange)) // Check if the implementation came first in compilation order @@ -5461,7 +5466,7 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig:TcConfig, tcImports:Tc | ParsedInput.ImplFile (ParsedImplFileInput(_, _, qualNameOfFile, _, _, _, _) as file) -> // Check if we've got an interface for this fragment - let rootSigOpt = tcState.tcsRootSigs.TryFind(qualNameOfFile) + let rootSigOpt = tcState.tcsRootSigs.TryFind {CompareObj=qualNameOfFile} // Check if we've already seen an implementation for this fragment if Zset.contains qualNameOfFile tcState.tcsRootImpls then diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index bf56deeeb7f..40dab48cb94 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -2,6 +2,8 @@ module internal Microsoft.FSharp.Compiler.Detuple +open Internal.Utilities.Collections + open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library @@ -163,7 +165,7 @@ module GlobalUsageAnalysis = let GetValsBoundInExpr expr = let folder = {ExprFolder0 with valBindingSiteIntercept = bindAccBounds} - let z0 = Zset.empty valOrder + let z0 = Zset.empty () let z = FoldExpr folder z0 expr z @@ -181,22 +183,22 @@ module GlobalUsageAnalysis = /// (b) log it's binding site representation. type Results = { /// v -> context / APP inst args - Uses : Zmap + Uses : zmap /// v -> binding repr - Defns : Zmap + Defns : zmap /// bound in a decision tree? - DecisionTreeBindings : Zset + DecisionTreeBindings : zset /// v -> v list * recursive? -- the others in the mutual binding - RecursiveBindings : Zmap - TopLevelBindings : Zset + RecursiveBindings : zmap + TopLevelBindings : zset IterationIsAtTopLevel : bool } let z0 = - { Uses = Zmap.empty valOrder - Defns = Zmap.empty valOrder - RecursiveBindings = Zmap.empty valOrder - DecisionTreeBindings = Zset.empty valOrder - TopLevelBindings = Zset.empty valOrder + { Uses = Zmap.empty () + Defns = Zmap.empty () + RecursiveBindings = Zmap.empty () + DecisionTreeBindings = Zset.empty () + TopLevelBindings = Zset.empty () IterationIsAtTopLevel = true } /// Log the use of a value with a particular tuple chape at a callsite @@ -611,7 +613,7 @@ let determineTransforms g (z : GlobalUsageAnalysis.Results) = decideTransform g z f callPatterns (m, tps, vss, rty) // make transform (if required) let vtransforms = Zmap.chooseL selectTransform z.Uses - let vtransforms = Zmap.ofList valOrder vtransforms + let vtransforms = Zmap.ofList vtransforms vtransforms @@ -622,7 +624,7 @@ let determineTransforms g (z : GlobalUsageAnalysis.Results) = type penv = { // The planned transforms - transforms : Zmap + transforms : zmap ccu : CcuThunk g : TcGlobals } diff --git a/src/fsharp/DetupleArgs.fsi b/src/fsharp/DetupleArgs.fsi index 58412315820..babe5e20ba1 100644 --- a/src/fsharp/DetupleArgs.fsi +++ b/src/fsharp/DetupleArgs.fsi @@ -2,6 +2,7 @@ module internal Microsoft.FSharp.Compiler.Detuple +open Internal.Utilities.Collections open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.TcGlobals @@ -9,7 +10,7 @@ open Microsoft.FSharp.Compiler.TcGlobals val DetupleImplFile : CcuThunk -> TcGlobals -> TypedImplFile -> TypedImplFile module GlobalUsageAnalysis = - val GetValsBoundInExpr : Expr -> Zset + val GetValsBoundInExpr : Expr -> zset type accessor @@ -18,15 +19,15 @@ module GlobalUsageAnalysis = /// Later could support "safe" change operations, and optimisations could be in terms of those. type Results = { /// v -> context / APP inst args - Uses : Zmap; + Uses : zmap /// v -> binding repr - Defns : Zmap; + Defns : zmap /// bound in a decision tree? - DecisionTreeBindings : Zset; + DecisionTreeBindings : zset /// v -> recursive? * v list -- the others in the mutual binding - RecursiveBindings : Zmap; + RecursiveBindings : zmap /// val not defined under lambdas - TopLevelBindings : Zset; + TopLevelBindings : zset /// top of expr toplevel? (true) IterationIsAtTopLevel : bool; } diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index 4b5affe091c..b2bb687f25c 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -113,11 +113,8 @@ Utilities\EditDistance.fs - - Utilities\TaggedCollections.fsi - - - Utilities\TaggedCollections.fs + + Utilities\SortKey.fs Utilities\ildiag.fsi @@ -134,18 +131,6 @@ Utilities\filename.fs - - Utilities\zmap.fsi - - - Utilities\zmap.fs - - - Utilities\zset.fsi - - - Utilities\zset.fs - Utilities\bytes.fsi diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 42297795184..343b0409c26 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -990,8 +990,12 @@ module internal Array = open System - let inline fastComparerForArraySort<'t when 't : comparison> () = - LanguagePrimitives.FastGenericComparerCanBeNull<'t> + let inline getInternalComparer<'t when 't : comparison> () = + // Previously a "comparer" was returned the could be null, which was for optimized Array.Sort + // but we now mainly return Comparer.Default (and FastGenericComparerInternal more so) + // which is also optimized in Array.Sort + // ** this comment can be destroyed sometime in the future, it is just as a breadcrumb for review ** + LanguagePrimitives.FastGenericComparerInternal<'t> // The input parameter should be checked by callers if necessary let inline zeroCreateUnchecked (count:int) = @@ -1089,26 +1093,26 @@ module internal Array = let keys = zeroCreateUnchecked array.Length for i = 0 to array.Length - 1 do keys.[i] <- projection array.[i] - Array.Sort<_,_>(keys, array, fastComparerForArraySort()) + Array.Sort<_,_>(keys, array, getInternalComparer()) let unstableSortInPlace (array : array<'T>) = let len = array.Length if len < 2 then () - else Array.Sort<_>(array, fastComparerForArraySort()) + else Array.Sort<_>(array, getInternalComparer()) - let stableSortWithKeysAndComparer (cFast:IComparer<'Key>) (c:IComparer<'Key>) (array:array<'T>) (keys:array<'Key>) = + let stableSortWithKeysAndComparer (c:IComparer<'Key>) (array:array<'T>) (keys:array<'Key>) = // 'places' is an array or integers storing the permutation performed by the sort let places = zeroCreateUnchecked array.Length for i = 0 to array.Length - 1 do places.[i] <- i - System.Array.Sort<_,_>(keys, places, cFast) + System.Array.Sort<_,_>(keys, places, c) // 'array2' is a copy of the original values let array2 = (array.Clone() :?> array<'T>) // Walk through any chunks where the keys are equal let mutable i = 0 let len = array.Length - let intCompare = fastComparerForArraySort() + let intCompare = getInternalComparer() while i < len do let mutable j = i @@ -1123,9 +1127,8 @@ module internal Array = i <- j let stableSortWithKeys (array:array<'T>) (keys:array<'Key>) = - let cFast = fastComparerForArraySort() - let c = LanguagePrimitives.FastGenericComparer<'Key> - stableSortWithKeysAndComparer cFast c array keys + let c = getInternalComparer() + stableSortWithKeysAndComparer c array keys let stableSortInPlaceBy (projection: 'T -> 'U) (array : array<'T>) = let len = array.Length @@ -1141,13 +1144,11 @@ module internal Array = let len = array.Length if len < 2 then () else - let cFast = LanguagePrimitives.FastGenericComparerCanBeNull<'T> - match cFast with - | null -> + if LanguagePrimitives.EquivalentForStableAndUnstableSort<'T> then // An optimization for the cases where the keys and values coincide and do not have identity, e.g. are integers // In this case an unstable sort is just as good as a stable sort (and faster) Array.Sort<_,_>(array, null) - | _ -> + else // 'keys' is an array storing the projected keys let keys = (array.Clone() :?> array<'T>) stableSortWithKeys array keys @@ -1158,7 +1159,7 @@ module internal Array = let keys = (array.Clone() :?> array<'T>) let comparer = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(comparer) let c = { new IComparer<'T> with member __.Compare(x,y) = comparer.Invoke(x,y) } - stableSortWithKeysAndComparer c c array keys + stableSortWithKeysAndComparer c array keys let inline subUnchecked startIndex count (array : 'T[]) = let res = zeroCreateUnchecked count : 'T[] diff --git a/src/fsharp/FSharp.Core/local.fsi b/src/fsharp/FSharp.Core/local.fsi index 3181dcbc6ec..3106c1bbc35 100644 --- a/src/fsharp/FSharp.Core/local.fsi +++ b/src/fsharp/FSharp.Core/local.fsi @@ -101,3 +101,5 @@ module internal Array = val stableSortInPlaceWith: comparer:('T -> 'T -> int) -> array:'T[] -> unit val stableSortInPlace: array:'T[] -> unit when 'T : comparison + + val stableSortWithKeysAndComparer : System.Collections.Generic.IComparer<'Key> -> array<'T> -> array<'Key> -> unit when 'Key : comparison \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 97c747e4ae5..fc9be5783db 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -8,27 +8,12 @@ namespace Microsoft.FSharp.Collections open Microsoft.FSharp.Core open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - [] [] type MapTree<'Key,'Value when 'Key : comparison > = - | MapEmpty - | MapOne of 'Key * 'Value - | MapNode of 'Key * 'Value * MapTree<'Key,'Value> * MapTree<'Key,'Value> * int - // REVIEW: performance rumour has it that the data held in MapNode and MapOne should be - // exactly one cache line. It is currently ~7 and 4 words respectively. + | MapNode of Key:'Key * Value:'Value * Left:MapTree<'Key,'Value> * Right:MapTree<'Key,'Value> * Size:int [] module MapTree = - - let rec sizeAux acc m = - match m with - | MapEmpty -> acc - | MapOne _ -> acc + 1 - | MapNode(_,_,l,r,_) -> sizeAux (sizeAux (acc+1) l) r - - let size x = sizeAux 0 x - - #if TRACE_SETS_AND_MAPS let mutable traceCount = 0 let mutable numOnes = 0 @@ -62,156 +47,135 @@ namespace Microsoft.FSharp.Collections n #endif - let empty = MapEmpty - - let height = function - | MapEmpty -> 0 - | MapOne _ -> 1 - | MapNode(_,_,_,_,h) -> h - - let isEmpty m = - match m with - | MapEmpty -> true - | _ -> false - - let mk l k v r = - match l,r with - | MapEmpty,MapEmpty -> MapOne(k,v) - | _ -> - let hl = height l - let hr = height r - let m = if hl < hr then hr else hl - MapNode(k,v,l,r,m+1) - - let rebalance t1 k v t2 = - let t1h = height t1 - let t2h = height t2 - if t2h > t1h + 2 then (* right is heavier than left *) - match t2 with - | MapNode(t2k,t2v,t2l,t2r,_) -> - (* one of the nodes must have height > height t1 + 1 *) - if height t2l > t1h + 1 then (* balance left: combination *) - match t2l with - | MapNode(t2lk,t2lv,t2ll,t2lr,_) -> - mk (mk t1 k v t2ll) t2lk t2lv (mk t2lr t2k t2v t2r) - | _ -> failwith "rebalance" - else (* rotate left *) - mk (mk t1 k v t2l) t2k t2v t2r - | _ -> failwith "rebalance" + [] + type Constants<'Key, 'Value when 'Key : comparison> private () = + static let empty = MapNode(Unchecked.defaultof<'Key>, Unchecked.defaultof<'Value>, Unchecked.defaultof>, Unchecked.defaultof>, 0) + static member Empty = empty + + let inline size (MapNode(Size=s)) = s + let inline key (MapNode(Key=k)) = k + let inline value (MapNode(Value=v)) = v + let inline left (MapNode(Left=l)) = l + let inline right (MapNode(Right=r)) = r + + let inline isEmpty (MapNode(Size=s)) = s = 0 + + let inline (++) l r = Checked.(+) l r + + let inline mk l k v r = + MapNode (k,v,l,r, size l ++ size r ++ 1) + + let inline mkLeaf k v = + MapNode (k, v, Constants.Empty, Constants.Empty, 1) + + let private rebalanceRight l k v (MapNode(rk,rv,rl,rr,_)) = + (* one of the nodes must have height > height t1 + 1 *) + if size rl > size l then (* balance left: combination *) + match rl with + | MapNode(rlk,rlv,rll,rlr,_) -> mk (mk l k v rll) rlk rlv (mk rlr rk rv rr) + else (* rotate left *) + mk (mk l k v rl) rk rv rr + + let private rebalanceLeft (MapNode(lk,lv,ll,lr,_)) k v r = + (* one of the nodes must have height > height t2 + 1 *) + if size lr > size r then + (* balance right: combination *) + match lr with + | MapNode(lrk,lrv,lrl,lrr,_) -> mk (mk ll lk lv lrl) lrk lrv (mk lrr k v r) else - if t1h > t2h + 2 then (* left is heavier than right *) - match t1 with - | MapNode(t1k,t1v,t1l,t1r,_) -> - (* one of the nodes must have height > height t2 + 1 *) - if height t1r > t2h + 1 then - (* balance right: combination *) - match t1r with - | MapNode(t1rk,t1rv,t1rl,t1rr,_) -> - mk (mk t1l t1k t1v t1rl) t1rk t1rv (mk t1rr k v t2) - | _ -> failwith "rebalance" - else - mk t1l t1k t1v (mk t1r k v t2) - | _ -> failwith "rebalance" - else mk t1 k v t2 - - let rec add (comparer: IComparer<'Value>) k v m = - match m with - | MapEmpty -> MapOne(k,v) - | MapOne(k2,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then MapNode (k,v,MapEmpty,m,2) - elif c = 0 then MapOne(k,v) - else MapNode (k,v,m,MapEmpty,2) - | MapNode(k2,v2,l,r,h) -> - let c = comparer.Compare(k,k2) - if c < 0 then rebalance (add comparer k v l) k2 v2 r - elif c = 0 then MapNode(k,v,l,r,h) - else rebalance l k2 v2 (add comparer k v r) + mk ll lk lv (mk lr k v r) - let rec find (comparer: IComparer<'Value>) k m = - match m with - | MapEmpty -> raise (KeyNotFoundException()) - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then v2 - else raise (KeyNotFoundException()) - | MapNode(k2,v2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then find comparer k l - elif c = 0 then v2 - else find comparer k r + let inline rebalance l k v r = + let ls, rs = size l, size r + if (rs >>> 1) > ls then rebalanceRight l k v r + elif (ls >>> 1) > rs then rebalanceLeft l k v r + else MapNode (k,v,l,r, ls ++ rs ++ 1) - let rec tryFind (comparer: IComparer<'Value>) k m = - match m with - | MapEmpty -> None - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then Some v2 - else None - | MapNode(k2,v2,l,r,_) -> + let rec add (comparer:IComparer<'Key>) k v (MapNode(k2,v2,l,r,s)) = + if s = 0 then mkLeaf k v + else let c = comparer.Compare(k,k2) - if c < 0 then tryFind comparer k l - elif c = 0 then Some v2 - else tryFind comparer k r - - let partition1 (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) k v (acc1,acc2) = + if c < 0 then + let l' = add comparer k v l + let l's, rs = size l', size r + if (l's >>> 1) > rs then + rebalanceLeft l' k2 v2 r + else + MapNode (k2,v2,l',r, l's ++ rs ++ 1) + elif c > 0 then + let r' = add comparer k v r + let ls, r's = size l, size r' + if (r's >>> 1) > ls then + rebalanceRight l k2 v2 r' + else + MapNode (k2,v2,l,r', ls ++ r's ++ 1) + else + MapNode(k,v,l,r,s) + + let inline private findImpl (comparer:IComparer<'Key>) k m found notfound = + let rec loop m = + if (size m) = 0 then notfound () + else + let c = comparer.Compare(k, key m) + if c < 0 then loop (left m) + elif c > 0 then loop (right m) + else found (value m) + loop m + + let find comparer k m = findImpl comparer k m id (fun () -> raise (KeyNotFoundException ())) + let tryFind comparer k m = findImpl comparer k m Some (fun () -> None) + + let partition1 (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) k v (acc1,acc2) = if f.Invoke(k, v) then (add comparer k v acc1,acc2) else (acc1,add comparer k v acc2) - let rec partitionAux (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = + let rec partitionAux (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with - | MapEmpty -> acc - | MapOne(k,v) -> partition1 comparer f k v acc + | MapNode(Size=0) -> acc | MapNode(k,v,l,r,_) -> let acc = partitionAux comparer f r acc let acc = partition1 comparer f k v acc partitionAux comparer f l acc - let partition (comparer: IComparer<'Value>) f s = partitionAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s (empty,empty) + let partition (comparer:IComparer<'Key>) f s = partitionAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s (Constants.Empty,Constants.Empty) - let filter1 (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) k v acc = if f.Invoke(k, v) then add comparer k v acc else acc + let filter1 (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) k v acc = if f.Invoke(k, v) then add comparer k v acc else acc - let rec filterAux (comparer: IComparer<'Value>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = + let rec filterAux (comparer:IComparer<'Key>) (f:OptimizedClosures.FSharpFunc<_,_,_>) s acc = match s with - | MapEmpty -> acc - | MapOne(k,v) -> filter1 comparer f k v acc + | MapNode(Size=0) -> acc | MapNode(k,v,l,r,_) -> let acc = filterAux comparer f l acc let acc = filter1 comparer f k v acc filterAux comparer f r acc - let filter (comparer: IComparer<'Value>) f s = filterAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s empty + let filter (comparer:IComparer<'Key>) f s = filterAux comparer (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) s Constants.Empty let rec spliceOutSuccessor m = match m with - | MapEmpty -> failwith "internal error: Map.spliceOutSuccessor" - | MapOne(k2,v2) -> k2,v2,MapEmpty + | MapNode(Size=0) -> failwith "internal error: Map.spliceOutSuccessor" | MapNode(k2,v2,l,r,_) -> match l with - | MapEmpty -> k2,v2,r + | MapNode(Size=0) -> k2,v2,r | _ -> let k3,v3,l' = spliceOutSuccessor l in k3,v3,mk l' k2 v2 r - let rec remove (comparer: IComparer<'Value>) k m = + let rec remove (comparer:IComparer<'Key>) k m = match m with - | MapEmpty -> empty - | MapOne(k2,_) -> - let c = comparer.Compare(k,k2) - if c = 0 then MapEmpty else m + | MapNode(Size=0) -> Constants.Empty | MapNode(k2,v2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (remove comparer k l) k2 v2 r elif c = 0 then match l,r with - | MapEmpty,_ -> r - | _,MapEmpty -> l + | MapNode(Size=0),_ -> r + | _,MapNode(Size=0) -> l | _ -> let sk,sv,r' = spliceOutSuccessor r mk l sk sv r' else rebalance l k2 v2 (remove comparer k r) - let rec mem (comparer: IComparer<'Value>) k m = + let rec mem (comparer:IComparer<'Key>) k m = match m with - | MapEmpty -> false - | MapOne(k2,_) -> (comparer.Compare(k,k2) = 0) + | MapNode(Size=0) -> false | MapNode(k2,_,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then mem comparer k l @@ -219,16 +183,14 @@ namespace Microsoft.FSharp.Collections let rec iterOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> () - | MapOne(k2,v2) -> f.Invoke(k2, v2) + | MapNode(Size=0) -> () | MapNode(k2,v2,l,r,_) -> iterOpt f l; f.Invoke(k2, v2); iterOpt f r let iter f m = iterOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m let rec tryPickOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> None - | MapOne(k2,v2) -> f.Invoke(k2, v2) + | MapNode(Size=0) -> None | MapNode(k2,v2,l,r,_) -> match tryPickOpt f l with | Some _ as res -> res @@ -242,24 +204,21 @@ namespace Microsoft.FSharp.Collections let rec existsOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> false - | MapOne(k2,v2) -> f.Invoke(k2, v2) + | MapNode(Size=0) -> false | MapNode(k2,v2,l,r,_) -> existsOpt f l || f.Invoke(k2, v2) || existsOpt f r let exists f m = existsOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m let rec forallOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> true - | MapOne(k2,v2) -> f.Invoke(k2, v2) + | MapNode(Size=0) -> true | MapNode(k2,v2,l,r,_) -> forallOpt f l && f.Invoke(k2, v2) && forallOpt f r let forall f m = forallOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m let rec map f m = match m with - | MapEmpty -> empty - | MapOne(k,v) -> MapOne(k,f v) + | MapNode(Size=0) -> Constants.Empty | MapNode(k,v,l,r,h) -> let l2 = map f l let v2 = f v @@ -268,8 +227,7 @@ namespace Microsoft.FSharp.Collections let rec mapiOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m = match m with - | MapEmpty -> empty - | MapOne(k,v) -> MapOne(k, f.Invoke(k, v)) + | MapNode(Size=0) -> Constants.Empty | MapNode(k,v,l,r,h) -> let l2 = mapiOpt f l let v2 = f.Invoke(k, v) @@ -280,8 +238,7 @@ namespace Microsoft.FSharp.Collections let rec foldBackOpt (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = match m with - | MapEmpty -> x - | MapOne(k,v) -> f.Invoke(k,v,x) + | MapNode(Size=0) -> x | MapNode(k,v,l,r,_) -> let x = foldBackOpt f r x let x = f.Invoke(k,v,x) @@ -291,8 +248,7 @@ namespace Microsoft.FSharp.Collections let rec foldOpt (f:OptimizedClosures.FSharpFunc<_,_,_,_>) x m = match m with - | MapEmpty -> x - | MapOne(k,v) -> f.Invoke(x,k,v) + | MapNode(Size=0) -> x | MapNode(k,v,l,r,_) -> let x = foldOpt f x l let x = f.Invoke(x,k,v) @@ -300,15 +256,10 @@ namespace Microsoft.FSharp.Collections let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f)) x m - let foldSectionOpt (comparer: IComparer<'Value>) lo hi (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = + let foldSectionOpt (comparer:IComparer<'Key>) lo hi (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = let rec foldFromTo (f:OptimizedClosures.FSharpFunc<_,_,_,_>) m x = match m with - | MapEmpty -> x - | MapOne(k,v) -> - let cLoKey = comparer.Compare(lo,k) - let cKeyHi = comparer.Compare(k,hi) - let x = if cLoKey <= 0 && cKeyHi <= 0 then f.Invoke(k, v, x) else x - x + | MapNode(Size=0) -> x | MapNode(k,v,l,r,_) -> let cLoKey = comparer.Compare(lo,k) let cKeyHi = comparer.Compare(k,hi) @@ -319,107 +270,167 @@ namespace Microsoft.FSharp.Collections if comparer.Compare(lo,hi) = 1 then x else foldFromTo f m x - let foldSection (comparer: IComparer<'Value>) lo hi f m x = + let foldSection (comparer:IComparer<'Key>) lo hi f m x = foldSectionOpt comparer lo hi (OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f)) m x - let toList m = - let rec loop m acc = - match m with - | MapEmpty -> acc - | MapOne(k,v) -> (k,v)::acc - | MapNode(k,v,l,r,_) -> loop l ((k,v)::loop r acc) - loop m [] - let toArray m = m |> toList |> Array.ofList - let ofList comparer l = List.fold (fun acc (k,v) -> add comparer k v acc) empty l - - let rec mkFromEnumerator comparer acc (e : IEnumerator<_>) = - if e.MoveNext() then - let (x,y) = e.Current - mkFromEnumerator comparer (add comparer x y acc) e - else acc + // create a mapping function which indexes the array, but with duplicate values removed + let private getLatestAccessor (comparer:IComparer<'Key>) (keys:IReadOnlyList<'Key>) (array:IReadOnlyList<'T>) = + let rec getFirstDuplicateKey i = + if i >= array.Count-1 then None + elif comparer.Compare (keys.[i], keys.[i+1]) = 0 then Some i + else getFirstDuplicateKey (i+1) + + match getFirstDuplicateKey 0 with + | None -> (fun i -> array.[i]), array.Count + | Some idx -> + let indexes = ResizeArray (array.Count-idx) + indexes.Add (idx+1) + for i = idx+2 to array.Count-1 do + if comparer.Compare (keys.[i-1], keys.[i]) = 0 then + indexes.[indexes.Count-1] <- i + else + indexes.Add i + (fun i -> if i < idx then array.[i] else array.[indexes.[i-idx]]), idx+indexes.Count + + let constructViaArray comparer (data:seq<'Key*'Value>) = + let array = data |> Seq.toArray + if array.Length = 0 then Constants.Empty + else + let keys = array |> Array.map fst + + Microsoft.FSharp.Primitives.Basics.Array.stableSortWithKeysAndComparer comparer array keys + + let getKV, count = + getLatestAccessor comparer keys array + + let rec loop lower upper = + assert (lower <= upper) + let mid = lower + (upper-lower)/2 + let k,v = getKV mid + if mid = upper then + mkLeaf k v + else + let right = loop (mid+1) upper + if mid = lower then + mk Constants.Empty k v right + else + let left = loop lower (mid-1) + mk left k v right + + loop 0 (count-1) + + [] + let largeObjectHeapBytes = 85000 + + let maxInitializationObjectCount<'Key, 'Value> () = + largeObjectHeapBytes * 10 / 9 / sizeof<'Key*'Value> / 2 + + let ofSeqlImpl comparer (e:IEnumerator<'Key*'Value>) = + if not (e.MoveNext()) then Constants.Empty + else + let chunk = ResizeArray () + let maxCount = maxInitializationObjectCount<'Key, 'Value> () + let rec populate () = + chunk.Add e.Current + if chunk.Count = maxCount then true + elif e.MoveNext () then populate () + else false + + let more = populate () + let chunkTree = constructViaArray comparer chunk + + if not more then + chunkTree + else + let rec addRemainder acc = + if e.MoveNext () then + let x, y = e.Current + addRemainder (add comparer x y acc) + else + acc + addRemainder chunkTree + + let ofList comparer (l:list<'Key*'Value>) = + match l with + | [] -> Constants.Empty + | l when (List.length l) <= (maxInitializationObjectCount<'Key, 'Value> ()) -> constructViaArray comparer l + | _ -> ofSeqlImpl comparer ((l:>seq<_>).GetEnumerator ()) let ofArray comparer (arr : array<_>) = - let mutable res = empty - for (x,y) in arr do - res <- add comparer x y res - res + constructViaArray comparer arr let ofSeq comparer (c : seq<'Key * 'T>) = match c with | :? array<'Key * 'T> as xs -> ofArray comparer xs | :? list<'Key * 'T> as xs -> ofList comparer xs - | _ -> - use ie = c.GetEnumerator() - mkFromEnumerator comparer empty ie - + | _ -> ofSeqlImpl comparer (c.GetEnumerator()) let copyToArray s (arr: _[]) i = let j = ref i s |> iter (fun x y -> arr.[!j] <- KeyValuePair(x,y); j := !j + 1) - - - /// Imperative left-to-right iterators. - [] - type MapIterator<'Key,'Value when 'Key : comparison > = - { /// invariant: always collapseLHS result - mutable stack: MapTree<'Key,'Value> list; - /// true when MoveNext has been called - mutable started : bool } - - // collapseLHS: - // a) Always returns either [] or a list starting with MapOne. - // b) The "fringe" of the set stack is unchanged. - let rec collapseLHS stack = - match stack with - | [] -> [] - | MapEmpty :: rest -> collapseLHS rest - | MapOne _ :: _ -> stack - | (MapNode(k,v,l,r,_)) :: rest -> collapseLHS (l :: MapOne (k,v) :: r :: rest) - let mkIterator s = { stack = collapseLHS [s]; started = false } + [] + type TreeIterator<'Key,'Value when 'Key : comparison>(root) = + let items = ResizeArray> () + let mutable depth = 0 + + let rec tryPush item = + if size item > 0 then + if depth = items.Count then + items.Add item + else + items.[depth] <- item + depth <- depth + 1 + + tryPush (left item) + + do tryPush root + + member inline __.PopCurrent f = + depth <- depth - 1 + match items.[depth] with + | MapNode(k,v,_,r,_) -> + tryPush r + f k v + + member __.MorePairs = depth > 0 + + let inline private getEnumerable f m = + seq { let iterator = TreeIterator<_,_> m + while iterator.MorePairs do + yield iterator.PopCurrent f } + + let tryGetSmallEnumerable m = + match m with + | MapNode(Size=0) -> Seq.empty + | MapNode(k,v,_,_,1) -> [ KeyValuePair (k,v) ] :> seq<_> + | MapNode(k,v,MapNode(lk,lv,_,_,1),_,2) -> [| KeyValuePair (lk,lv); KeyValuePair (k,v) |] :> seq<_> + | MapNode(k,v,_,MapNode(rk,rv,_,_,1),2) -> [| KeyValuePair (k,v); KeyValuePair (rk,rv) |] :> seq<_> + | MapNode(k,v,MapNode(lk,lv,_,_,1),MapNode(rk,rv,_,_,1),3) -> [| KeyValuePair (lk,lv); KeyValuePair (k,v); KeyValuePair (rk,rv) |] :> seq<_> + | _ -> null - let notStarted() = raise (InvalidOperationException(SR.GetString(SR.enumerationNotStarted))) - let alreadyFinished() = raise (InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))) + let getKVEnumerable m = + match tryGetSmallEnumerable m with + | null -> getEnumerable (fun k v -> KeyValuePair (k, v)) m + | small -> small - let current i = - if i.started then - match i.stack with - | MapOne (k,v) :: _ -> new KeyValuePair<_,_>(k,v) - | [] -> alreadyFinished() - | _ -> failwith "Please report error: Map iterator, unexpected stack for current" - else - notStarted() - - let rec moveNext i = - if i.started then - match i.stack with - | MapOne _ :: rest -> i.stack <- collapseLHS rest - not i.stack.IsEmpty - | [] -> false - | _ -> failwith "Please report error: Map iterator, unexpected stack for moveNext" - else - i.started <- true (* The first call to MoveNext "starts" the enumeration. *) - not i.stack.IsEmpty - - let mkIEnumerator s = - let i = ref (mkIterator s) - { new IEnumerator<_> with - member __.Current = current !i - interface System.Collections.IEnumerator with - member __.Current = box (current !i) - member __.MoveNext() = moveNext !i - member __.Reset() = i := mkIterator s - interface System.IDisposable with - member __.Dispose() = ()} + let toSeq m = + getEnumerable (fun k v -> k, v) m + let toList m = + let iterator = TreeIterator<_,_> m + List.init (size m) (fun _ -> iterator.PopCurrent (fun k v -> k, v)) + let toArray m = + let iterator = TreeIterator<_,_> m + Array.init (size m) (fun _ -> iterator.PopCurrent (fun k v -> k, v)) [>)>] [] [] [] [] - type Map<[]'Key,[]'Value when 'Key : comparison >(comparer: IComparer<'Key>, tree: MapTree<'Key,'Value>) = + type Map<[]'Key,[]'Value when 'Key : comparison >(comparer:IComparer<'Key>, tree: MapTree<'Key,'Value>) = #if !FX_NO_BINARY_SERIALIZATION [] @@ -441,7 +452,7 @@ namespace Microsoft.FSharp.Collections // set (it is just a lookup into a .NET table of type-instantiation-indexed static fields). static let empty = let comparer = LanguagePrimitives.FastGenericComparer<'Key> - new Map<'Key,'Value>(comparer,MapTree<_,_>.MapEmpty) + new Map<'Key,'Value>(comparer,MapTree.Constants.Empty) #if !FX_NO_BINARY_SERIALIZATION [] @@ -539,6 +550,8 @@ namespace Microsoft.FSharp.Collections #endif MapTree.tryFind comparer key tree + member m.ToSeq() = MapTree.toSeq tree + member m.ToList() = MapTree.toList tree member m.ToArray() = MapTree.toArray tree @@ -570,10 +583,10 @@ namespace Microsoft.FSharp.Collections override this.GetHashCode() = this.ComputeHashCode() interface IEnumerable> with - member __.GetEnumerator() = MapTree.mkIEnumerator tree + member __.GetEnumerator() = (MapTree.getKVEnumerable tree).GetEnumerator() interface System.Collections.IEnumerable with - member __.GetEnumerator() = (MapTree.mkIEnumerator tree :> System.Collections.IEnumerator) + member __.GetEnumerator() = (((MapTree.getKVEnumerable tree).GetEnumerator()) :> System.Collections.IEnumerator) interface IDictionary<'Key, 'Value> with member m.Item @@ -710,7 +723,7 @@ namespace Microsoft.FSharp.Collections let foldBack<'Key,'T,'State when 'Key : comparison> folder (table:Map<'Key,'T>) (state:'State) = MapTree.foldBack folder table.Tree state [] - let toSeq (table:Map<_,_>) = table |> Seq.map (fun kvp -> kvp.Key, kvp.Value) + let toSeq (table:Map<_,_>) = table.ToSeq() [] let findKey predicate (table : Map<_,_>) = table |> toSeq |> Seq.pick (fun (k,v) -> if predicate k v then Some(k) else None) diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index d04a8f8b45c..14e82785bdc 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -770,8 +770,548 @@ namespace Microsoft.FSharp.Core let anyToStringShowingNull x = anyToString "null" x - module HashCompare = - + module internal Reflection = + let inline flagsOr<'a> (lhs:'a) (rhs:'a) = + (# "or" lhs rhs : 'a #) + + let inline flagsAnd<'a> (lhs:'a) (rhs:'a) = + (# "and" lhs rhs : 'a #) + + let inline flagsContains<'a when 'a : equality> (flags:'a) (mask:'a) (value:'a) = + (flagsAnd flags mask).Equals value + + let inline flagsIsSet<'a when 'a : equality> (flags:'a) (value:'a) = + flagsContains flags value value + +#if FX_RESHAPED_REFLECTION + module internal ReflectionAdapters = + let toArray<'a> (s:System.Collections.Generic.IEnumerable<'a>) = + (System.Collections.Generic.List<'a> s).ToArray () + + open System + + let inline hasFlag (flag : BindingFlags) f = flagsIsSet f flag + let isDeclaredFlag f = hasFlag BindingFlags.DeclaredOnly f + let isPublicFlag f = hasFlag BindingFlags.Public f + let isStaticFlag f = hasFlag BindingFlags.Static f + let isInstanceFlag f = hasFlag BindingFlags.Instance f + let isNonPublicFlag f = hasFlag BindingFlags.NonPublic f + + let isAcceptable bindingFlags isStatic isPublic = + // 1. check if member kind (static\instance) was specified in flags + ((isStaticFlag bindingFlags && isStatic) || (isInstanceFlag bindingFlags && not isStatic)) && + // 2. check if member accessibility was specified in flags + ((isPublicFlag bindingFlags && isPublic) || (isNonPublicFlag bindingFlags && not isPublic)) + + type System.Type with + member this.GetNestedType (name, bindingFlags) = + // MSDN: http://msdn.microsoft.com/en-us/library/0dcb3ad5.aspx + // The following BindingFlags filter flags can be used to define which nested types to include in the search: + // You must specify either BindingFlags.Public or BindingFlags.NonPublic to get a return. + // Specify BindingFlags.Public to include public nested types in the search. + // Specify BindingFlags.NonPublic to include non-public nested types (that is, private, internal, and protected nested types) in the search. + // This method returns only the nested types of the current type. It does not search the base classes of the current type. + // To find types that are nested in base classes, you must walk the inheritance hierarchy, calling GetNestedType at each level. + let e = this.GetTypeInfo().DeclaredNestedTypes.GetEnumerator () + let rec f () = + if not (e.MoveNext ()) then null + else + let nestedTy = e.Current + if (String.Equals (nestedTy.Name, name)) && + ((isPublicFlag bindingFlags && nestedTy.IsNestedPublic) || + (isNonPublicFlag bindingFlags && (nestedTy.IsNestedPrivate || nestedTy.IsNestedFamily || nestedTy.IsNestedAssembly || nestedTy.IsNestedFamORAssem || nestedTy.IsNestedFamANDAssem))) then + nestedTy.AsType () + else + f () + f () + + // use different sources based on Declared flag + member this.GetMethods (bindingFlags) = + let methods = + if isDeclaredFlag bindingFlags then + this.GetTypeInfo().DeclaredMethods + else + this.GetRuntimeMethods() + + Array.FindAll (toArray methods, Predicate (fun m -> + isAcceptable bindingFlags m.IsStatic m.IsPublic)) + + // use different sources based on Declared flag + member this.GetFields (bindingFlags) = + let fields = + if isDeclaredFlag bindingFlags then + this.GetTypeInfo().DeclaredFields + else + this.GetRuntimeFields() + + Array.FindAll (toArray fields, Predicate (fun f -> + isAcceptable bindingFlags f.IsStatic f.IsPublic)) + + // use different sources based on Declared flag + member this.GetProperties (bindingFlags) = + let properties = + if isDeclaredFlag bindingFlags then + this.GetTypeInfo().DeclaredProperties + else + this.GetRuntimeProperties () + + Array.FindAll (toArray properties, Predicate (fun pi -> + let mi = + match pi.GetMethod with + | null -> pi.SetMethod + | _ -> pi.GetMethod + if obj.ReferenceEquals (mi, null) then + false + else + isAcceptable bindingFlags mi.IsStatic mi.IsPublic)) + + member this.IsGenericTypeDefinition = this.GetTypeInfo().IsGenericTypeDefinition + + type System.Reflection.MemberInfo with + member this.GetCustomAttributes(attrTy, inherits) : obj[] = + downcast box(toArray (CustomAttributeExtensions.GetCustomAttributes(this, attrTy, inherits))) + + module internal SystemAdapters = + type Converter<'TInput, 'TOutput> = delegate of 'TInput -> 'TOutput + + type System.Array with + static member ConvertAll<'TInput, 'TOutput>(input:'TInput[], conv:Converter<'TInput, 'TOutput>) = + let output = (# "newarr !0" type ('TOutput) input.Length : 'TOutput array #) + for i = 0 to input.Length-1 do + set output i (conv.Invoke (get input i)) + output + + open PrimReflectionAdapters + open ReflectionAdapters + open SystemAdapters +#endif + + +#if FX_RESHAPED_REFLECTION + let instancePropertyFlags = BindingFlags.Instance + let staticFieldFlags = BindingFlags.Static + let staticMethodFlags = BindingFlags.Static +#else + let instancePropertyFlags = flagsOr BindingFlags.GetProperty BindingFlags.Instance + let staticFieldFlags = flagsOr BindingFlags.GetField BindingFlags.Static + let staticMethodFlags = BindingFlags.Static +#endif + + let tupleNames = [| + "System.Tuple`1"; "System.Tuple`2"; "System.Tuple`3"; + "System.Tuple`4"; "System.Tuple`5"; "System.Tuple`6"; + "System.Tuple`7"; "System.Tuple`8"; "System.Tuple" + "System.ValueTuple`1"; "System.ValueTuple`2"; "System.ValueTuple`3"; + "System.ValueTuple`4"; "System.ValueTuple`5"; "System.ValueTuple`6"; + "System.ValueTuple`7"; "System.ValueTuple`8"; "System.ValueTuple" |] + + let simpleTupleNames = [| + "Tuple`1"; "Tuple`2"; "Tuple`3"; + "Tuple`4"; "Tuple`5"; "Tuple`6"; + "Tuple`7"; "Tuple`8"; + "ValueTuple`1"; "ValueTuple`2"; "ValueTuple`3"; + "ValueTuple`4"; "ValueTuple`5"; "ValueTuple`6"; + "ValueTuple`7"; "ValueTuple`8"; |] + + let isTupleType (typ:Type) = + // We need to be careful that we only rely typ.IsGenericType, typ.Namespace and typ.Name here. + // + // Historically the FSharp.Core reflection utilities get used on implementations of + // System.Type that don't have functionality such as .IsEnum and .FullName fully implemented. + // This happens particularly over TypeBuilderInstantiation types in the ProvideTypes implementation of System.TYpe + // used in F# type providers. + typ.IsGenericType && + System.String.Equals(typ.Namespace, "System") && + Array.Exists (simpleTupleNames, Predicate typ.Name.StartsWith) + +#if !FX_NO_REFLECTION_ONLY + let assemblyName = typeof.Assembly.GetName().Name + let _ = assert (System.String.Equals (assemblyName, "FSharp.Core")) + let cmaName = typeof.FullName + + let tryFindCompilationMappingAttributeFromData (attrs:System.Collections.Generic.IList, res:byref) : bool = + match attrs with + | null -> false + | _ -> + let mutable found = false + for a in attrs do + if a.Constructor.DeclaringType.FullName.Equals cmaName then + let args = a.ConstructorArguments + let flags = + match args.Count with + | 1 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), 0, 0) + | 2 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), 0) + | 3 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), (let x = args.[2] in x.Value :?> int)) + | _ -> (SourceConstructFlags.None, 0, 0) + res <- flags + found <- true + found + + let findCompilationMappingAttributeFromData attrs = + let mutable x = unsafeDefault<_> + match tryFindCompilationMappingAttributeFromData (attrs, &x) with + | false -> raise (Exception "no compilation mapping attribute") + | true -> x +#endif + let hasCustomEquality (typ:Type) = + let arr = typ.GetCustomAttributes (typeof, false) + arr.Length > 0 + + let hasCustomComparison (typ:Type) = + let arr = typ.GetCustomAttributes (typeof, false) + arr.Length > 0 + + let tryFindCompilationMappingAttribute (attrs:obj[], res:byref) : bool = + match attrs with + | null | [||] -> false + | [| :? CompilationMappingAttribute as a |] -> + res <- a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber + true + | _ -> raise (System.InvalidOperationException (SR.GetString(SR.multipleCompilationMappings))) + + let findCompilationMappingAttribute (attrs:obj[]) = + let mutable x = unsafeDefault<_> + match tryFindCompilationMappingAttribute (attrs, &x) with + | false -> raise (Exception "no compilation mapping attribute") + | true -> x + + let tryFindCompilationMappingAttributeFromType (typ:Type, res:byref) : bool = +#if !FX_NO_REFLECTION_ONLY + let assem = typ.Assembly + if (not (obj.ReferenceEquals(assem, null))) && assem.ReflectionOnly then + tryFindCompilationMappingAttributeFromData (typ.GetCustomAttributesData(), &res) + else +#endif + tryFindCompilationMappingAttribute (typ.GetCustomAttributes (typeof,false), &res) + + let tryFindCompilationMappingAttributeFromMemberInfo (info:MemberInfo, res:byref) : bool = +#if !FX_NO_REFLECTION_ONLY + let assem = info.DeclaringType.Assembly + if (not (obj.ReferenceEquals (assem, null))) && assem.ReflectionOnly then + tryFindCompilationMappingAttributeFromData (info.GetCustomAttributesData(), &res) + else +#endif + tryFindCompilationMappingAttribute (info.GetCustomAttributes (typeof,false), &res) + + let findCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = +#if !FX_NO_REFLECTION_ONLY + let assem = info.DeclaringType.Assembly + if (not (obj.ReferenceEquals (assem, null))) && assem.ReflectionOnly then + findCompilationMappingAttributeFromData (info.GetCustomAttributesData()) + else +#endif + findCompilationMappingAttribute (info.GetCustomAttributes (typeof,false)) + + let tryFindSourceConstructFlagsOfType (typ:Type, res:byref) : bool = + let mutable x = unsafeDefault<_> + if tryFindCompilationMappingAttributeFromType (typ, &x) then + let flags,_n,_vn = x + res <- flags + true + else + false + + let isKnownType (typ:Type, bindingFlags:BindingFlags, knownType:SourceConstructFlags) = + let mutable flags = unsafeDefault<_> + match tryFindSourceConstructFlagsOfType (typ, &flags) with + | false -> false + | true -> + (flagsContains flags SourceConstructFlags.KindMask knownType) && + // We see private representations only if BindingFlags.NonPublic is set + (if flagsIsSet flags SourceConstructFlags.NonPublicRepresentation then + flagsIsSet bindingFlags BindingFlags.NonPublic + else + true) + + let isRecordType (typ:Type, bindingFlags:BindingFlags) = isKnownType (typ, bindingFlags, SourceConstructFlags.RecordType) + let isObjectType (typ:Type, bindingFlags:BindingFlags) = isKnownType (typ, bindingFlags, SourceConstructFlags.ObjectType) + let isUnionType (typ:Type, bindingFlags:BindingFlags) = isKnownType (typ, bindingFlags, SourceConstructFlags.SumType) + + let isFieldProperty (prop : PropertyInfo) = + let mutable res = unsafeDefault<_> + match tryFindCompilationMappingAttributeFromMemberInfo(prop:>MemberInfo, &res) with + | false -> false + | true -> + let (flags,_n,_vn) = res + flagsContains flags SourceConstructFlags.KindMask SourceConstructFlags.Field + + let sequenceNumberOfMember (x:MemberInfo) = let (_,n,_) = findCompilationMappingAttributeFromMemberInfo x in n + let variantNumberOfMember (x:MemberInfo) = let (_,_,vn) = findCompilationMappingAttributeFromMemberInfo x in vn + + // Although this funciton is called sortFreshArray (and was so in it's previously life in reflect.fs) + // it does not create a fresh array, but rather uses the existing array. + let sortFreshArray (f:'a->int) (arr:'a[]) = + let comparer = System.Collections.Generic.Comparer.Default + System.Array.Sort (arr, { + new IComparer<'a> with + member __.Compare (lhs:'a, rhs:'a) = + comparer.Compare (f lhs, f rhs) }) + arr + + let fieldPropsOfRecordType (typ:Type, bindingFlags) = + let properties = typ.GetProperties (flagsOr instancePropertyFlags bindingFlags) + let fields = System.Array.FindAll (properties, Predicate isFieldProperty) + sortFreshArray sequenceNumberOfMember fields + + let getUnionTypeTagNameMap (typ:Type,bindingFlags:BindingFlags) : (int*string)[] = + let enumTyp = typ.GetNestedType ("Tags", bindingFlags) + // Unions with a singleton case do not get a Tags type (since there is only one tag), hence enumTyp may be null in this case + match enumTyp with + | null -> + let methods = typ.GetMethods (flagsOr staticMethodFlags bindingFlags) + let maybeTagNames = + Array.ConvertAll (methods, Converter (fun minfo -> + let mutable res = unsafeDefault<_> + match tryFindCompilationMappingAttributeFromMemberInfo (minfo:>MemberInfo, &res) with + | false -> unsafeDefault<_> + | true -> + let flags,n,_vn = res + if flagsContains flags SourceConstructFlags.KindMask SourceConstructFlags.UnionCase then + // chop "get_" or "New" off the front + let nm = + let nm = minfo.Name + if nm.StartsWith "get_" then nm.Substring 4 + elif nm.StartsWith "New" then nm.Substring 3 + else nm + (n, nm) + else + unsafeDefault<_> )) + Array.FindAll (maybeTagNames, Predicate (fun maybeTagName -> not (obj.ReferenceEquals (maybeTagName, null)))) + | _ -> + let fields = enumTyp.GetFields (flagsOr staticFieldFlags bindingFlags) + let filtered = Array.FindAll (fields, (fun (f:FieldInfo) -> f.IsStatic && f.IsLiteral)) + let sorted = sortFreshArray (fun (f:FieldInfo) -> (f.GetValue null) :?> int) filtered + Array.ConvertAll (sorted, Converter (fun tagfield -> (tagfield.GetValue(null) :?> int),tagfield.Name)) + + let getUnionCasesTyp (typ: Type, _bindingFlags) = +#if CASES_IN_NESTED_CLASS + let casesTyp = typ.GetNestedType("Cases", bindingFlags) + if casesTyp.IsGenericTypeDefinition then casesTyp.MakeGenericType(typ.GetGenericArguments()) + else casesTyp +#else + typ +#endif + + let getUnionCaseTyp (typ: Type, tag: int, bindingFlags) = + let tagFields = getUnionTypeTagNameMap(typ,bindingFlags) + let tagField = let _,f = Array.Find (tagFields, Predicate (fun (i,_) -> i = tag)) in f + + if tagFields.Length = 1 then + typ + else + // special case: two-cased DU annotated with CompilationRepresentation(UseNullAsTrueValue) + // in this case it will be compiled as one class: return self type for non-nullary case and null for nullary + let isTwoCasedDU = + if tagFields.Length = 2 then + match typ.GetCustomAttributes(typeof, false) with + | [|:? CompilationRepresentationAttribute as attr|] -> + flagsIsSet attr.Flags CompilationRepresentationFlags.UseNullAsTrueValue + | _ -> false + else + false + if isTwoCasedDU then + typ + else + let casesTyp = getUnionCasesTyp (typ, bindingFlags) + let caseTyp = casesTyp.GetNestedType(tagField, bindingFlags) // if this is null then the union is nullary + match caseTyp with + | null -> null + | _ when caseTyp.IsGenericTypeDefinition -> caseTyp.MakeGenericType(casesTyp.GetGenericArguments()) + | _ -> caseTyp + + let fieldsPropsOfUnionCase(typ:Type, tag:int, bindingFlags) = + // Lookup the type holding the fields for the union case + let caseTyp = getUnionCaseTyp (typ, tag, bindingFlags) + let caseTyp = match caseTyp with null -> typ | _ -> caseTyp + let properties = caseTyp.GetProperties (flagsOr instancePropertyFlags bindingFlags) + let filtered = Array.FindAll (properties, Predicate (fun p -> if isFieldProperty p then (variantNumberOfMember (p:>MemberInfo)) = tag else false)) + sortFreshArray (fun (p:PropertyInfo) -> sequenceNumberOfMember p) filtered + + let getAllInstanceFields (typ:Type) = + let fields = typ.GetFields (flagsOr BindingFlags.Instance (flagsOr BindingFlags.Public BindingFlags.NonPublic)) + Array.ConvertAll (fields, Converter (fun p -> p.FieldType)) + + module HashCompare = +#if FX_RESHAPED_REFLECTION + open Reflection.SystemAdapters +#endif + let isArray (ty:Type) = + ty.IsArray || (typeof.IsAssignableFrom ty) + + let canUseDotnetDefaultComparisonOrEquality isCustom hasStructuralInterface stringsRequireHandling er (rootType:Type) = + let processed = System.Collections.Generic.HashSet () + + let bindingPublicOrNonPublic = + Reflection.flagsOr BindingFlags.Public BindingFlags.NonPublic + + let rec isSuitableNullableTypeOrNotNullable (ty:Type) = + // although nullables not explicitly handled previously, they need special handling + // due to the implicit casting to their underlying generic type (i.e. could be a float) + let isNullableType = + ty.IsGenericType + && ty.GetGenericTypeDefinition().Equals typedefof> + if isNullableType then + checkType 0 (ty.GetGenericArguments ()) + else + true + + and isSuitableTupleType (ty:Type) = + ty.IsValueType && // Tuple<...> don't have implementation, but ValueTuple<...> does + Reflection.isTupleType ty && + checkType 0 (ty.GetGenericArguments ()) + + and isSuitableStructType (ty:Type) = + ty.IsValueType && + Reflection.isObjectType (ty, bindingPublicOrNonPublic) && + (not (isCustom ty)) && + checkType 0 (Reflection.getAllInstanceFields ty) + + and isSuitableRecordType (ty:Type) = + Reflection.isRecordType (ty, bindingPublicOrNonPublic) && + (not (isCustom ty)) && + ( let fields = Reflection.fieldPropsOfRecordType (ty, bindingPublicOrNonPublic) + let fieldTypes = Array.ConvertAll (fields, Converter (fun f -> f.PropertyType)) + checkType 0 fieldTypes) + + and isSuitableUnionType (ty:Type) = + Reflection.isUnionType (ty, bindingPublicOrNonPublic) && + (not (isCustom ty)) && + ( let cases = Reflection.getUnionTypeTagNameMap (ty, bindingPublicOrNonPublic) + let rec checkCases idx = + if idx = cases.Length then true + else + let tag,_ = get cases idx + let fields = Reflection.fieldsPropsOfUnionCase (ty, tag, bindingPublicOrNonPublic) + let fieldTypes = Array.ConvertAll (fields, Converter (fun f -> f.PropertyType)) + if checkType 0 fieldTypes then + checkCases (idx+1) + else + false + checkCases 0) + + and checkType idx (types:Type[]) = + if idx = types.Length then true + else + let ty = get types idx + if not (processed.Add ty) then + checkType (idx+1) types + else + ty.IsSealed // covers enum and value types; derived ref types might implement from hasStructuralInterface + && not (isArray ty) + && (not stringsRequireHandling || (not (ty.Equals typeof))) + && (er || (not (ty.Equals typeof))) + && (er || (not (ty.Equals typeof))) + && isSuitableNullableTypeOrNotNullable ty + && ((not (hasStructuralInterface ty)) + || isSuitableTupleType ty + || isSuitableStructType ty + || isSuitableRecordType ty + || isSuitableUnionType ty) + && checkType (idx+1) types + + checkType 0 [|rootType|] + + //------------------------------------------------------------------------- + // LanguagePrimitives.HashCompare: HASHING. + //------------------------------------------------------------------------- + let defaultHashNodes = 18 + + /// The implementation of IEqualityComparer, using depth-limited for hashing and PER semantics for NaN equality. + type CountLimitedHasherPER(sz:int) = + [] + val mutable nodeCount : int + + member x.Fresh() = + if (System.Threading.Interlocked.CompareExchange(&(x.nodeCount), sz, 0) = 0) then + x + else + new CountLimitedHasherPER(sz) + + interface IEqualityComparer + + /// The implementation of IEqualityComparer, using unlimited depth for hashing and ER semantics for NaN equality. + type UnlimitedHasherER() = + interface IEqualityComparer + + /// The implementation of IEqualityComparer, using unlimited depth for hashing and PER semantics for NaN equality. + type UnlimitedHasherPER() = + interface IEqualityComparer + + + /// The unique object for unlimited depth for hashing and ER semantics for equality. + let fsEqualityComparerUnlimitedHashingER = UnlimitedHasherER() + + /// The unique object for unlimited depth for hashing and PER semantics for equality. + let fsEqualityComparerUnlimitedHashingPER = UnlimitedHasherPER() + + let inline HashCombine nr x y = (x <<< 1) + y + 631 * nr + + let inline ArrayHashing<'element,'array when 'array :> System.Array> get lowerBound (f:'element->int) (x:'array) : int = + let rec loop acc i = + if i < lowerBound then acc + else loop (HashCombine i acc (f (get x i))) (i-1) + + let lastIdx = + let upperBound = lowerBound+defaultHashNodes + match lowerBound+x.Length-1 with + | oversized when oversized > upperBound -> upperBound + | good -> good + + loop 0 lastIdx + + let GenericHashObjArray (iec:System.Collections.IEqualityComparer) (x:obj[]) = ArrayHashing get 0 iec.GetHashCode x + let GenericHashByteArray (x:byte[]) = ArrayHashing get 0 intOfByte x + let GenericHashInt32Array (x:int32[]) = ArrayHashing get 0 (fun x -> x) x + let GenericHashInt64Array (x:int64[]) = ArrayHashing get 0 int32 x + + // special case - arrays do not by default have a decent structural hashing function + let GenericHashArbArray (iec : System.Collections.IEqualityComparer) (x: System.Array) : int = + match x.Rank with + | 1 -> ArrayHashing (fun a i -> a.GetValue i) (x.GetLowerBound 0) iec.GetHashCode x + | _ -> HashCombine 10 (x.GetLength(0)) (x.GetLength(1)) + + // Core implementation of structural hashing, corresponds to pseudo-code in the + // F# Language spec. Searches for the IStructuralHash interface, otherwise uses GetHashCode(). + // 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) -> + // due to the rules of the CLI type system, array casts are "assignment compatible" + // see: https://blogs.msdn.microsoft.com/ericlippert/2009/09/24/why-is-covariance-of-value-typed-arrays-inconsistent/ + // this means that the cast and comparison for byte will also handle sbyte, int32 handle uint32, + // and int64 handle uint64. The hash code of an individual array element is different for the different + // types, but it is irrelevant for the creation of the hash code - but this is to be replicated in + // the tryGetFSharpArrayEqualityComparer function. + match a with + | :? (obj[]) as oa -> GenericHashObjArray iec oa + | :? (byte[]) as ba -> GenericHashByteArray ba + | :? (int[]) as ba -> GenericHashInt32Array ba + | :? (int64[]) as ba -> GenericHashInt64Array ba + | _ -> GenericHashArbArray iec a + | :? IStructuralEquatable as a -> + a.GetHashCode(iec) + | _ -> + x.GetHashCode() + + /// Direct call to GetHashCode on the string type + let inline HashString (s:string) = + match s with + | null -> 0 + | _ -> (# "call instance int32 [mscorlib]System.String::GetHashCode()" s : int #) + + // from mscorlib v4.0.30319 + let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) + let inline HashSByte (x:sbyte) = (# "xor" (# "shl" x 8 : int #) x : int #) + let inline HashInt16 (x:int16) = (# "or" (# "conv.u2" x : int #) (# "shl" x 16 : int #) : int #) + let inline HashInt64 (x:int64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr" x 32 : int #) : int #) : int #) + let inline HashUInt64 (x:uint64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr.un" x 32 : int #) : int #) : int #) + let inline HashIntPtr (x:nativeint) = (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) + let inline HashUIntPtr (x:unativeint) = (# "and" (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) 0x7fffffff : int #) + + //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: Physical Equality //------------------------------------------------------------------------- @@ -790,7 +1330,6 @@ namespace Microsoft.FSharp.Core let inline PhysicalHashFast (input: 'T) = PhysicalHashIntrinsic input - //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: Comparison // @@ -806,7 +1345,6 @@ namespace Microsoft.FSharp.Core let FailGenericComparison (obj: obj) = raise (new System.ArgumentException(String.Format(SR.GetString(SR.genericCompareFail1), obj.GetType().ToString()))) - /// This type has two instances - fsComparerER and fsComparerThrow. /// - fsComparerER = ER semantics = no throw on NaN comparison = new GenericComparer(false) = GenericComparer = GenericComparison @@ -819,9 +1357,20 @@ namespace Microsoft.FSharp.Core /// This exception should never be observed by user code. let NaNException = new System.Exception() + let inline ArrayComparison<'T> (f:'T->'T->int) (x:'T[]) (y:'T[]) : int = + let lenx = x.Length + let leny = y.Length + let rec loop c i = + if c <> 0 then Math.Sign c + elif i = lenx then 0 + else loop (f (get x i) (get y i)) (i+1) + loop (lenx-leny) 0 + + let GenericComparisonByteArray (x:byte[]) (y:byte[]) : int = ArrayComparison (fun x y -> (# "conv.i4" x : int32 #)-(# "conv.i4" y : int32 #)) x y + /// Implements generic comparison between two objects. This corresponds to the pseudo-code in the F# /// specification. The treatment of NaNs is governed by "comp". - let rec GenericCompare (comp:GenericComparer) (xobj:obj,yobj:obj) = + let rec GenericCompare (comp:GenericComparer) (xobj:obj,yobj:obj) = (*if objEq xobj yobj then 0 else *) match xobj,yobj with | null,null -> 0 @@ -832,10 +1381,13 @@ namespace Microsoft.FSharp.Core // Permit structural comparison on arrays | (:? System.Array as arr1),_ -> match arr1,yobj with - // Fast path - | (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericComparisonObjArrayWithComparer comp arr1 arr2 - // Fast path - | (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericComparisonByteArray arr1 arr2 + | (:? (obj[]) as arr1), (:? (obj[]) as arr2)-> GenericComparisonObjArrayWithComparer comp arr1 arr2 + + // The additional equality check is required here because .net treats byte[] and sbyte[] as cast-compatible + // (but comparison is different) + | (:? (byte[]) as arr1), (:? (byte[]) as arr2) + when typeof.Equals (arr1.GetType ()) && typeof.Equals (arr2.GetType ()) -> GenericComparisonByteArray arr1 arr2 + | _ , (:? System.Array as arr2) -> GenericComparisonArbArrayWithComparer comp arr1 arr2 | _ -> FailGenericComparison xobj // Check for IStructuralComparable @@ -1010,46 +1562,211 @@ namespace Microsoft.FSharp.Core check 0 #endif - /// optimized case: Core implementation of structural comparison on object arrays. - and GenericComparisonObjArrayWithComparer (comp:GenericComparer) (x:obj[]) (y:obj[]) : int = - let lenx = x.Length - let leny = y.Length - let c = intOrder lenx leny - if c <> 0 then c - else - let mutable i = 0 - let mutable res = 0 - while i < lenx do - let c = GenericCompare comp ((get x i), (get y i)) - if c <> 0 then (res <- c; i <- lenx) - else i <- i + 1 - res - - /// optimized case: Core implementation of structural comparison on arrays. - and GenericComparisonByteArray (x:byte[]) (y:byte[]) : int = - let lenx = x.Length - let leny = y.Length - let c = intOrder lenx leny - if c <> 0 then c - else - let mutable i = 0 - let mutable res = 0 - while i < lenx do - let c = byteOrder (get x i) (get y i) - if c <> 0 then (res <- c; i <- lenx) - else i <- i + 1 - res + and GenericComparisonObjArrayWithComparer (comp:GenericComparer) (x:obj[]) (y:obj[]) : int = + ArrayComparison (fun x y -> GenericCompare comp (x, y)) x y type GenericComparer with interface System.Collections.IComparer with override c.Compare(x:obj,y:obj) = GenericCompare c (x,y) /// The unique object for comparing values in PER mode (where local exceptions are thrown when NaNs are compared) - let fsComparerPER = GenericComparer(true) + let fsComparerPER = GenericComparer(true) /// The unique object for comparing values in ER mode (where "0" is returned when NaNs are compared) let fsComparerER = GenericComparer(false) + let isStructuralComparable (ty:Type) = typeof.IsAssignableFrom ty + let isValueTypeStructuralComparable (ty:Type) = isStructuralComparable ty && ty.IsValueType + + let canUseDefaultComparer er (rootType:Type) = + // "Default" equality for strings is culturally sensitive, so needs special handling + canUseDotnetDefaultComparisonOrEquality Reflection.hasCustomComparison isStructuralComparable true er rootType + + type ComparisonUsage = + | ERUsage = 0 + | PERUsage = 1 + | LessThanUsage = 2 + | GreaterThanUsage = 3 + + [] + let LessThanUsageReturnFalse = 1 + [] + let GreaterThanUsageReturnFalse = -1 + + let inline signedComparer<'T> () = + box { new Comparer<'T>() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then -1 + else (# "cgt" x y : int #) } + + let inline unsignedComparer<'T> () = + box { new Comparer<'T>() with + member __.Compare (x,y) = + if (# "clt.un" x y : bool #) then -1 + else (# "cgt.un" x y : int #) } + + let inline floatingPointComparer<'T> onNaN = + box { new Comparer<'T>() with + member __.Compare (x,y) = + if (# "clt" x y : bool #) then -1 + elif (# "cgt" x y : bool #) then 1 + elif (# "ceq" x y : bool #) then 0 + else onNaN () } + + let tryGetFSharpComparer (usage:ComparisonUsage) (externalUse:bool) (ty:Type) : obj = + match usage, externalUse, ty with + | ComparisonUsage.ERUsage, _, ty when ty.Equals typeof -> box Comparer.Default + | ComparisonUsage.ERUsage, _, ty when ty.Equals typeof -> box Comparer.Default + + | ComparisonUsage.PERUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> raise NaNException) + | ComparisonUsage.LessThanUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> LessThanUsageReturnFalse) + | ComparisonUsage.GreaterThanUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> GreaterThanUsageReturnFalse) + + | ComparisonUsage.PERUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> raise NaNException) + | ComparisonUsage.LessThanUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> LessThanUsageReturnFalse) + | ComparisonUsage.GreaterThanUsage, _, ty when ty.Equals typeof -> floatingPointComparer (fun () -> GreaterThanUsageReturnFalse) + + // the implemention of Comparer.Default returns a current culture specific comparer + | _, _, ty when ty.Equals typeof -> + box { new Comparer() with + member __.Compare (x,y) = + System.String.CompareOrdinal (x, y) } + + | _, _, ty when ty.Equals typeof -> unsignedComparer () + | _, _, ty when ty.Equals typeof -> signedComparer () + + // these are used as external facing comparers for compatability (they always return -1/0/+1) + | _, true, ty when ty.Equals typeof -> unsignedComparer () + | _, true, ty when ty.Equals typeof -> signedComparer () + | _, true, ty when ty.Equals typeof -> signedComparer () + | _, true, ty when ty.Equals typeof -> unsignedComparer () + | _, true, ty when ty.Equals typeof -> unsignedComparer () + + | _ -> null + + let inline nullableComparer<'a when 'a : null> compare = + box { new Comparer<'a>() with + member __.Compare (x,y) = + match x, y with + | null, null -> 0 + | null, _ -> -1 + | _, null -> 1 + | _ -> compare x y } + + let tryGetFSharpArrayComparer (ty:Type) comparer : obj = + if ty.Equals typeof then nullableComparer (fun x y -> GenericComparisonObjArrayWithComparer comparer x y) + elif ty.Equals typeof then nullableComparer GenericComparisonByteArray + else null + + let arrayComparer<'T> comparer = + match tryGetFSharpArrayComparer typeof<'T> comparer with + | :? Comparer<'T> as arrayComparer -> arrayComparer + | _ -> + { new Comparer<'T>() with + member __.Compare (x, y) = + match box x, box y with + | null, null -> 0 + | null, _ -> -1 + | _, null -> 1 + | (:? System.Array as arr1), (:? System.Array as arr2) -> GenericComparisonArbArrayWithComparer comparer arr1 arr2 + | _ -> raise (Exception "invalid logic - expected System.Array") } + + let structuralComparer<'T> comparer = + { new Comparer<'T>() with + member __.Compare (x,y) = + match box x, box y with + | null, null -> 0 + | null, _ -> -1 + | _, null -> 1 + | (:? IStructuralComparable as x1), yobj -> x1.CompareTo (yobj, comparer) + | _ -> raise (Exception "invalid logic - expected IStructuralEquatable") } + + let structuralComparerValueType<'T> comparer = + { new Comparer<'T>() with + member __.Compare (x,y) = + ((box x):?>IStructuralComparable).CompareTo (y, comparer) } + + let unknownComparer<'T> comparer = + { new Comparer<'T>() with + member __.Compare (x,y) = + GenericCompare comparer (box x, box y) } + + // this wrapper is used with the comparison operators to cause a false result when a NaNException + // has been thrown somewhere in the tested objects hierarchy + let maybeNaNExceptionComparer<'T> (comparer:Comparer<'T>) valueToCauseFalse = + { new Comparer<'T>() with + member __.Compare (x,y) = + try + comparer.Compare (x,y) + with + e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> valueToCauseFalse } + + let getGenericComparison<'T> usage externalUse = + let er = match usage with ComparisonUsage.ERUsage -> true | _ -> false + + match tryGetFSharpComparer usage externalUse typeof<'T> with + | :? Comparer<'T> as comparer -> comparer + | _ when canUseDefaultComparer er typeof<'T> -> Comparer<'T>.Default + | _ -> + if er then + if isArray typeof<'T> then arrayComparer fsComparerER + elif isValueTypeStructuralComparable typeof<'T> then structuralComparerValueType fsComparerER + elif isStructuralComparable typeof<'T> then structuralComparer fsComparerER + else unknownComparer fsComparerER + else + let comparer = + if isArray typeof<'T> then arrayComparer fsComparerPER + elif isValueTypeStructuralComparable typeof<'T> then structuralComparerValueType fsComparerPER + elif isStructuralComparable typeof<'T> then structuralComparer fsComparerPER + else unknownComparer fsComparerPER + + match usage with + | ComparisonUsage.LessThanUsage -> maybeNaNExceptionComparer comparer LessThanUsageReturnFalse + | ComparisonUsage.GreaterThanUsage -> maybeNaNExceptionComparer comparer GreaterThanUsageReturnFalse + | _ -> comparer + + /// As an optimization, determine if a fast unstable sort can be used with equivalent results + let equivalentForStableAndUnstableSort (ty:Type) = + ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + || ty.Equals(typeof) + + [] + type FSharpComparer_ER<'T> private () = + static let comparer = getGenericComparison<'T> ComparisonUsage.ERUsage true + static member Comparer = comparer + + [] + type FSharpComparer_InternalUse_ER<'T> private () = + static let equivalentForStableAndUnstableSort = equivalentForStableAndUnstableSort typeof<'T> + static let comparer = getGenericComparison<'T> ComparisonUsage.ERUsage false + static member Comparer = comparer + static member EquivalentForStableAndUnstableSort = equivalentForStableAndUnstableSort + + [] + type FSharpComparer_PER<'T> private () = + static let comparer = getGenericComparison<'T> ComparisonUsage.PERUsage false + static member Comparer = comparer + + [] + type FSharpComparer_ForLessThanComparison<'T> private () = + static let comparer = getGenericComparison<'T> ComparisonUsage.LessThanUsage false + static member Comparer = comparer + + [] + type FSharpComparer_ForGreaterThanComparison<'T> private () = + static let comparer = getGenericComparison<'T> ComparisonUsage.GreaterThanUsage false + static member Comparer = comparer + /// Compare two values of the same generic type, using "comp". // // "comp" is assumed to be either fsComparerPER or fsComparerER (and hence 'Compare' is implemented via 'GenericCompare'). @@ -1057,7 +1774,12 @@ namespace Microsoft.FSharp.Core // NOTE: the compiler optimizer is aware of this function and devirtualizes in the // cases where it is known how a particular type implements generic comparison. let GenericComparisonWithComparerIntrinsic<'T> (comp:System.Collections.IComparer) (x:'T) (y:'T) : int = - comp.Compare(box x, box y) + if obj.ReferenceEquals (comp, fsComparerER) then + FSharpComparer_InternalUse_ER.Comparer.Compare (x, y) + elif obj.ReferenceEquals (comp, fsComparerPER) then + FSharpComparer_PER.Comparer.Compare (x, y) + else + comp.Compare (box x, box y) /// Compare two values of the same generic type, in either PER or ER mode, but include static optimizations /// for various well-known cases. @@ -1093,51 +1815,28 @@ namespace Microsoft.FSharp.Core System.String.CompareOrdinal((# "" x : string #) ,(# "" y : string #)) when 'T : decimal = System.Decimal.Compare((# "" x:decimal #), (# "" y:decimal #)) - /// Generic comparison. Implements ER mode (where "0" is returned when NaNs are compared) // // The compiler optimizer is aware of this function (see use of generic_comparison_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericComparisonIntrinsic<'T> (x:'T) (y:'T) : int = - GenericComparisonWithComparerIntrinsic (fsComparerER :> IComparer) x y - + FSharpComparer_ER.Comparer.Compare (x, y) - /// Generic less-than. Uses comparison implementation in PER mode but catches - /// the local exception that is thrown when NaN's are compared. + /// Generic less-than. 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 - + (# "clt" (FSharpComparer_ForLessThanComparison.Comparer.Compare (x, y)) 0 : bool #) - /// Generic greater-than. Uses comparison implementation in PER mode but catches - /// the local exception that is thrown when NaN's are compared. + /// Generic greater-than. let GenericGreaterThanIntrinsic (x:'T) (y:'T) = - try - (# "cgt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) 0 : bool #) - with - | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false - + (# "cgt" (FSharpComparer_ForGreaterThanComparison.Comparer.Compare (x, y)) 0 : bool #) - /// Generic greater-than-or-equal. Uses comparison implementation in PER mode but catches - /// the local exception that is thrown when NaN's are compared. + /// Generic greater-than-or-equal. let GenericGreaterOrEqualIntrinsic (x:'T) (y:'T) = - try - (# "cgt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) (-1) : bool #) - with - | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false - + (# "cgt" (FSharpComparer_ForGreaterThanComparison.Comparer.Compare (x, y)) -1 : bool #) - - /// Generic less-than-or-equal. Uses comparison implementation in PER mode but catches - /// the local exception that is thrown when NaN's are compared. + /// Generic less-than-or-equal. let GenericLessOrEqualIntrinsic (x:'T) (y:'T) = - try - (# "clt" (GenericComparisonWithComparerIntrinsic fsComparerPER x y) 1 : bool #) - with - | e when System.Runtime.CompilerServices.RuntimeHelpers.Equals(e, NaNException) -> false - + (# "clt" (FSharpComparer_ForLessThanComparison.Comparer.Compare (x, y)) 1 : bool #) /// Compare two values of the same generic type, in ER mode, with static optimizations /// for known cases. @@ -1247,105 +1946,30 @@ namespace Microsoft.FSharp.Core when 'T : char = not (# "clt" x y : bool #) when 'T : decimal = System.Decimal.op_GreaterThanOrEqual ((# "" x:decimal #), (# "" y:decimal #)) - //------------------------------------------------------------------------- // LanguagePrimitives.HashCompare: EQUALITY //------------------------------------------------------------------------- - - /// optimized case: Core implementation of structural equality on arrays. - let GenericEqualityByteArray (x:byte[]) (y:byte[]) : bool= + let inline ArrayEquality<'T> (f:'T->'T->bool) (x:'T[]) (y:'T[]) : bool = let lenx = x.Length let leny = y.Length - let c = (lenx = leny) - if not c then c - else - let mutable i = 0 - let mutable res = true - while i < lenx do - let c = 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 - - + let rec loop i = + if i = lenx then true + elif f (get x i) (get y i) then loop (i+1) + else false + (lenx = leny) && loop 0 + + let inline ArrayEqualityWithERFlag<'T> (er:bool) (f:'T->'T->bool) (x:'T[]) (y:'T[]) : bool = + if er + then ArrayEquality (fun x y -> (not (f x x) && not (f y y)) || (f x y)) x y + else ArrayEquality f x y + + let GenericEqualityByteArray x y = ArrayEquality byteEq x y + let GenericEqualityInt32Array x y = ArrayEquality int32Eq x y + let GenericEqualitySingleArray er x y = ArrayEqualityWithERFlag er float32Eq x y + let GenericEqualityDoubleArray er x y = ArrayEqualityWithERFlag er floatEq x y + let GenericEqualityCharArray x y = ArrayEquality charEq x y + let GenericEqualityInt64Array x y = ArrayEquality int64Eq x y /// The core implementation of generic equality between two objects. This corresponds /// to th e pseudo-code in the F# language spec. @@ -1353,8 +1977,8 @@ namespace Microsoft.FSharp.Core // Run in either PER or ER mode. In PER mode, equality involving a NaN returns "false". // In ER mode, equality on two NaNs returns "true". // - // If "er" is true the "iec" is fsEqualityComparerNoHashingER - // If "er" is false the "iec" is fsEqualityComparerNoHashingPER + // If "er" is true the "iec" is fsEqualityComparerUnlimitedHashingER + // If "er" is false the "iec" is fsEqualityComparerUnlimitedHashingPER let rec GenericEqualityObj (er:bool) (iec:System.Collections.IEqualityComparer) ((xobj:obj),(yobj:obj)) : bool = (*if objEq xobj yobj then true else *) match xobj,yobj with @@ -1364,10 +1988,12 @@ namespace Microsoft.FSharp.Core | (:? string as xs),(:? string as ys) -> System.String.Equals(xs,ys) // Permit structural equality on arrays | (:? System.Array as arr1),_ -> + // due to the rules of the CLI type system, array casts are "assignment compatible" + // see: https://blogs.msdn.microsoft.com/ericlippert/2009/09/24/why-is-covariance-of-value-typed-arrays-inconsistent/ + // this means that the cast and comparison for byte will also handle sbyte, int32 handle uint32, + // and int64 handle uint64. Equality will still be correct. match arr1,yobj with - // Fast path | (:? (obj[]) as arr1), (:? (obj[]) as arr2) -> GenericEqualityObjArray er iec arr1 arr2 - // Fast path | (:? (byte[]) as arr1), (:? (byte[]) as arr2) -> GenericEqualityByteArray arr1 arr2 | (:? (int32[]) as arr1), (:? (int32[]) as arr2) -> GenericEqualityInt32Array arr1 arr2 | (:? (int64[]) as arr1), (:? (int64[]) as arr2) -> GenericEqualityInt64Array arr1 arr2 @@ -1503,41 +2129,154 @@ namespace Microsoft.FSharp.Core #endif /// optimized case: Core implementation of structural equality on object arrays. - and GenericEqualityObjArray er iec (x:obj[]) (y:obj[]) : bool = - let lenx = x.Length - let leny = y.Length - let c = (lenx = leny ) - if not c then c - else - let mutable i = 0 - let mutable res = true - while i < lenx do - let c = GenericEqualityObj er iec ((get x i),(get y i)) - if not c then (res <- false; i <- lenx) - else i <- i + 1 - res - - - /// 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))) } + and GenericEqualityObjArray er iec (xarray:obj[]) (yarray:obj[]) : bool = + ArrayEquality (fun x y -> GenericEqualityObj er iec (x, y)) xarray yarray + + let isStructuralEquatable (ty:Type) = typeof.IsAssignableFrom ty + let isValueTypeStructuralEquatable (ty:Type) = isStructuralEquatable ty && ty.IsValueType + + let canUseDefaultEqualityComparer er (rootType:Type) = + // "Default" equality for strings is by ordinal, so needs special handling required + canUseDotnetDefaultComparisonOrEquality Reflection.hasCustomEquality isStructuralEquatable false er rootType + + let tryGetFSharpEqualityComparer (er:bool) (ty:Type) : obj = + match er, ty with + | false, ty when ty.Equals typeof -> + box { new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = x.GetHashCode () } + | false, ty when ty.Equals typeof -> + box { new EqualityComparer() with + member __.Equals (x,y) = (# "ceq" x y : bool #) + member __.GetHashCode x = x.GetHashCode () } + | true, ty when ty.Equals typeof -> box EqualityComparer.Default + | true, ty when ty.Equals typeof -> box EqualityComparer.Default + | _ -> null + + let inline nullableEqualityComparer<'a when 'a : null> equals getHashCode = + box { new EqualityComparer<'a>() with + member __.Equals (x,y) = + match x, y with + | null, null -> true + | null, _ -> false + | _, null -> false + | _ -> equals x y + + member __.GetHashCode x = + match x with + | null -> 0 + | _ -> getHashCode x } + + let inline castNullableEqualityComparer<'fromType, 'toType when 'toType : null and 'fromType : null> (equals:'toType->'toType->bool) (getHashCode:'toType->int) = + let castEquals (lhs:'fromType) (rhs:'fromType) = equals (unboxPrim lhs) (unboxPrim rhs) + let castGetHashCode (o:'fromType) = getHashCode (unboxPrim o) + nullableEqualityComparer castEquals castGetHashCode + + let tryGetFSharpArrayEqualityComparer (ty:Type) er comparer : obj = + // the casts here between byte+sbyte, int32+uint32 and int64+uint64 are here to replicate the behaviour + // in GenericHashParamObj + if ty.Equals typeof then nullableEqualityComparer (fun x y -> GenericEqualityObjArray er comparer x y) (GenericHashObjArray fsEqualityComparerUnlimitedHashingPER) + elif ty.Equals typeof then nullableEqualityComparer GenericEqualityByteArray GenericHashByteArray + elif ty.Equals typeof then castNullableEqualityComparer GenericEqualityByteArray GenericHashByteArray + elif ty.Equals typeof then nullableEqualityComparer GenericEqualityInt32Array GenericHashInt32Array + elif ty.Equals typeof then castNullableEqualityComparer GenericEqualityInt32Array GenericHashInt32Array + elif ty.Equals typeof then nullableEqualityComparer GenericEqualityInt64Array GenericHashInt64Array + elif ty.Equals typeof then castNullableEqualityComparer GenericEqualityInt64Array GenericHashInt64Array + else null + + let arrayEqualityComparer<'T> er comparer = + match tryGetFSharpArrayEqualityComparer typeof<'T> er comparer with + | :? EqualityComparer<'T> as arrayComparer -> arrayComparer + | _ -> + { new EqualityComparer<'T>() with + member __.Equals (x, y) = + let xobj, yobj = box x, box y + match xobj,yobj with + | null, null -> true + | null, _ -> false + | _, null -> false + | (:? (char[]) as arr1), (:? (char[]) as arr2) -> GenericEqualityCharArray arr1 arr2 + | _ -> + match xobj,yobj with + | (:? (float32[]) as arr1), (:? (float32[]) as arr2) -> GenericEqualitySingleArray er arr1 arr2 + | _ -> + match xobj,yobj with + | (:? (float[]) as arr1), (:? (float[])as arr2) -> GenericEqualityDoubleArray er arr1 arr2 + | _ -> + match xobj,yobj with + | (:? System.Array as arr1), (:? System.Array as arr2) -> GenericEqualityArbArray er comparer arr1 arr2 + | _ -> raise (Exception "invalid logic - expected array") + + member __.GetHashCode x = + match box x with + | null -> 0 + | :? System.Array as a -> GenericHashArbArray fsEqualityComparerUnlimitedHashingPER a + | _ -> raise (Exception "invalid logic - expected array") } + + let structuralEqualityComparer<'T> comparer = + { new EqualityComparer<'T>() with + member __.Equals (x,y) = + match box x, box y with + | null, null -> true + | null, _ -> false + | _, null -> false + | (:? IStructuralEquatable as x1), yobj -> x1.Equals (yobj, comparer) + | _ -> raise (Exception "invalid logic - expected IStructuralEquatable") + + member __.GetHashCode x = + match box x with + | null -> 0 + | :? IStructuralEquatable as a -> a.GetHashCode fsEqualityComparerUnlimitedHashingPER + | _ -> raise (Exception "invalid logic - expected IStructuralEquatable") } + + let structuralEqualityComparerValueType<'T> comparer = + { new EqualityComparer<'T>() with + member __.Equals (x,y) = ((box x):?>IStructuralEquatable).Equals (y, comparer) + member __.GetHashCode x = ((box x):?>IStructuralEquatable).GetHashCode fsEqualityComparerUnlimitedHashingPER } + + let unknownEqualityComparer<'T> er comparer = + { new EqualityComparer<'T>() with + member __.Equals (x,y) = GenericEqualityObj er comparer (box x, box y) + member __.GetHashCode x = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box x) } + + let getGenericEquality<'T> er = + match tryGetFSharpEqualityComparer er typeof<'T> with + | :? EqualityComparer<'T> as call -> call + | _ when canUseDefaultEqualityComparer er typeof<'T> -> EqualityComparer<'T>.Default + | _ when isArray typeof<'T> && er -> arrayEqualityComparer true fsEqualityComparerUnlimitedHashingER + | _ when isArray typeof<'T> -> arrayEqualityComparer false fsEqualityComparerUnlimitedHashingPER + | _ when isValueTypeStructuralEquatable typeof<'T> && er -> structuralEqualityComparerValueType fsEqualityComparerUnlimitedHashingER + | _ when isValueTypeStructuralEquatable typeof<'T> -> structuralEqualityComparerValueType fsEqualityComparerUnlimitedHashingPER + | _ when isStructuralEquatable typeof<'T> && er -> structuralEqualityComparer fsEqualityComparerUnlimitedHashingER + | _ when isStructuralEquatable typeof<'T> -> structuralEqualityComparer fsEqualityComparerUnlimitedHashingPER + | _ when er -> unknownEqualityComparer true fsEqualityComparerUnlimitedHashingER + | _ -> unknownEqualityComparer false fsEqualityComparerUnlimitedHashingPER + + [] + type FSharpEqualityComparer_ER<'T> private () = + static let comparer = getGenericEquality<'T> true + static member EqualityComparer = comparer + + [] + type FSharpEqualityComparer_PER<'T> private () = + static let comparer = getGenericEquality<'T> false + static member EqualityComparer = comparer + + let inline FSharpEqualityComparer_ER_Equals (x:'T) (y:'T) = + FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals (x, y) + + let inline FSharpEqualityComparer_PER_Equals (x:'T) (y:'T) = + FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals (x, y) + + let inline FSharpEqualityComparer_GetHashCode (x:'T) = + FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode x /// Implements generic equality between two values, with PER semantics for NaN (so equality on two NaN values returns false) // // The compiler optimizer is aware of this function (see use of generic_equality_per_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityIntrinsic (x : 'T) (y : 'T) : bool = - GenericEqualityObj false fsEqualityComparerNoHashingPER ((box x), (box y)) + FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals (x, y) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1546,16 +2285,20 @@ namespace Microsoft.FSharp.Core // The compiler optimizer is aware of this function (see use of generic_equality_er_inner_vref in opt.fs) // and devirtualizes calls to it based on "T". let GenericEqualityERIntrinsic (x : 'T) (y : 'T) : bool = - GenericEqualityObj true fsEqualityComparerNoHashingER ((box x), (box y)) + FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals (x, y) /// Implements generic equality between two values using "comp" for recursive calls. // // The compiler optimizer is aware of this function (see use of generic_equality_withc_inner_vref in opt.fs) // and devirtualizes calls to it based on "T", and under the assumption that "comp" - // is either fsEqualityComparerNoHashingER or fsEqualityComparerNoHashingPER. + // is either fsEqualityComparerUnlimitedHashingER or fsEqualityComparerUnlimitedHashingPER. let GenericEqualityWithComparerIntrinsic (comp : System.Collections.IEqualityComparer) (x : 'T) (y : 'T) : bool = - comp.Equals((box x),(box y)) - + if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then + FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals (x, y) + elif obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingER) then + FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals (x, y) + else + comp.Equals (box x, box y) /// Implements generic equality between two values, with ER semantics for NaN (so equality on two NaN values returns true) // @@ -1641,127 +2384,6 @@ namespace Microsoft.FSharp.Core let inline GenericInequalityFast (x:'T) (y:'T) = (not(GenericEqualityFast x y) : bool) let inline GenericInequalityERFast (x:'T) (y:'T) = (not(GenericEqualityERFast x y) : bool) - - //------------------------------------------------------------------------- - // LanguagePrimitives.HashCompare: HASHING. - //------------------------------------------------------------------------- - - - - let defaultHashNodes = 18 - - /// The implementation of IEqualityComparer, using depth-limited for hashing and PER semantics for NaN equality. - type CountLimitedHasherPER(sz:int) = - [] - val mutable nodeCount : int - - member x.Fresh() = - if (System.Threading.Interlocked.CompareExchange(&(x.nodeCount), sz, 0) = 0) then - x - else - new CountLimitedHasherPER(sz) - - interface IEqualityComparer - - /// The implementation of IEqualityComparer, using unlimited depth for hashing and ER semantics for NaN equality. - type UnlimitedHasherER() = - interface IEqualityComparer - - /// The implementation of IEqualityComparer, using unlimited depth for hashing and PER semantics for NaN equality. - type UnlimitedHasherPER() = - interface IEqualityComparer - - - /// The unique object for unlimited depth for hashing and ER semantics for equality. - let fsEqualityComparerUnlimitedHashingER = UnlimitedHasherER() - - /// The unique object for unlimited depth for hashing and PER semantics for equality. - let fsEqualityComparerUnlimitedHashingPER = UnlimitedHasherPER() - - let inline HashCombine nr x y = (x <<< 1) + y + 631 * nr - - 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 @@ -1777,7 +2399,6 @@ namespace Microsoft.FSharp.Core /// Fill in the implementation of UnlimitedHasherER type UnlimitedHasherER with - interface System.Collections.IEqualityComparer with override iec.Equals(x:obj,y:obj) = GenericEqualityObj true iec (x,y) override iec.GetHashCode(x:obj) = GenericHashParamObj iec x @@ -1792,10 +2413,12 @@ namespace Microsoft.FSharp.Core // // NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_inner_vref in opt.fs) // and devirtualizes calls to it based on type "T". - let GenericHashIntrinsic input = GenericHashParamObj fsEqualityComparerUnlimitedHashingPER (box input) + let GenericHashIntrinsic input = + FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode input /// Intrinsic for calls to depth-limited structural hashing that were not optimized by static conditionals. - let LimitedGenericHashIntrinsic limit input = GenericHashParamObj (CountLimitedHasherPER(limit)) (box input) + let LimitedGenericHashIntrinsic limit input = + GenericHashParamObj (CountLimitedHasherPER(limit)) (box input) /// Intrinsic for a recursive call to structural hashing that was not optimized by static conditionals. // @@ -1805,23 +2428,11 @@ namespace Microsoft.FSharp.Core // NOTE: The compiler optimizer is aware of this function (see uses of generic_hash_withc_inner_vref in opt.fs) // and devirtualizes calls to it based on type "T". let GenericHashWithComparerIntrinsic<'T> (comp : System.Collections.IEqualityComparer) (input : 'T) : int = - GenericHashParamObj comp (box input) + if obj.ReferenceEquals (comp, fsEqualityComparerUnlimitedHashingPER) then + FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode input + else + GenericHashParamObj comp (box input) - /// Direct call to GetHashCode on the string type - let inline HashString (s:string) = - match s with - | null -> 0 - | _ -> (# "call instance int32 [mscorlib]System.String::GetHashCode()" s : int #) - - // from mscorlib v4.0.30319 - let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) - let inline HashSByte (x:sbyte) = (# "xor" (# "shl" x 8 : int #) x : int #) - let inline HashInt16 (x:int16) = (# "or" (# "conv.u2" x : int #) (# "shl" x 16 : int #) : int #) - let inline HashInt64 (x:int64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr" x 32 : int #) : int #) : int #) - let inline HashUInt64 (x:uint64) = (# "xor" (# "conv.i4" x : int #) (# "conv.i4" (# "shr.un" x 32 : int #) : int #) : int #) - let inline HashIntPtr (x:nativeint) = (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) - let inline HashUIntPtr (x:unativeint) = (# "and" (# "conv.i4" (# "conv.u8" x : uint64 #) : int #) 0x7fffffff : int #) - /// Core entry into structural hashing for either limited or unlimited hashing. // // "iec" is assumed to be either fsEqualityComparerUnlimitedHashingER, fsEqualityComparerUnlimitedHashingPER or @@ -2082,7 +2693,6 @@ namespace Microsoft.FSharp.Core // LanguagePrimitives: PUBLISH IEqualityComparer AND IComparer OBJECTS //------------------------------------------------------------------------- - let inline MakeGenericEqualityComparer<'T>() = // type-specialize some common cases to generate more efficient functions { new System.Collections.Generic.IEqualityComparer<'T> with @@ -2095,47 +2705,8 @@ namespace Microsoft.FSharp.Core member self.GetHashCode(x) = GenericLimitedHash limit x member self.Equals(x,y) = GenericEquality x y } - let BoolIEquality = MakeGenericEqualityComparer() - let CharIEquality = MakeGenericEqualityComparer() - let StringIEquality = MakeGenericEqualityComparer() - let SByteIEquality = MakeGenericEqualityComparer() - let Int16IEquality = MakeGenericEqualityComparer() - let Int32IEquality = MakeGenericEqualityComparer() - let Int64IEquality = MakeGenericEqualityComparer() - let IntPtrIEquality = MakeGenericEqualityComparer() - let ByteIEquality = MakeGenericEqualityComparer() - let UInt16IEquality = MakeGenericEqualityComparer() - let UInt32IEquality = MakeGenericEqualityComparer() - let UInt64IEquality = MakeGenericEqualityComparer() - let UIntPtrIEquality = MakeGenericEqualityComparer() - let FloatIEquality = MakeGenericEqualityComparer() - let Float32IEquality = MakeGenericEqualityComparer() - let DecimalIEquality = MakeGenericEqualityComparer() - - [] - type FastGenericEqualityComparerTable<'T>() = - static let f : System.Collections.Generic.IEqualityComparer<'T> = - match typeof<'T> with - | ty when ty.Equals(typeof) -> unboxPrim (box BoolIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box ByteIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box Int32IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt32IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box CharIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box SByteIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box Int16IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box Int64IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box IntPtrIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt16IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt64IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box UIntPtrIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box FloatIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box Float32IEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box DecimalIEquality) - | ty when ty.Equals(typeof) -> unboxPrim (box StringIEquality) - | _ -> MakeGenericEqualityComparer<'T>() - static member Function : System.Collections.Generic.IEqualityComparer<'T> = f - - let FastGenericEqualityComparerFromTable<'T> = FastGenericEqualityComparerTable<'T>.Function + let FastGenericEqualityComparerFromTable<'T> = + HashCompare.FSharpEqualityComparer_PER<'T>.EqualityComparer :> IEqualityComparer<'T> // This is the implementation of HashIdentity.Structural. In most cases this just becomes // FastGenericEqualityComparerFromTable. @@ -2173,93 +2744,9 @@ namespace Microsoft.FSharp.Core let inline MakeGenericComparer<'T>() = { new System.Collections.Generic.IComparer<'T> with member __.Compare(x,y) = GenericComparison x y } - - let CharComparer = MakeGenericComparer() - let StringComparer = MakeGenericComparer() - let SByteComparer = MakeGenericComparer() - let Int16Comparer = MakeGenericComparer() - let Int32Comparer = MakeGenericComparer() - let Int64Comparer = MakeGenericComparer() - let IntPtrComparer = MakeGenericComparer() - let ByteComparer = MakeGenericComparer() - let UInt16Comparer = MakeGenericComparer() - let UInt32Comparer = MakeGenericComparer() - let UInt64Comparer = MakeGenericComparer() - let UIntPtrComparer = MakeGenericComparer() - let FloatComparer = MakeGenericComparer() - let Float32Comparer = MakeGenericComparer() - let DecimalComparer = MakeGenericComparer() - let BoolComparer = MakeGenericComparer() - - /// Use a type-indexed table to ensure we only create a single FastStructuralComparison function - /// for each type - [] - type FastGenericComparerTable<'T>() = - - // The CLI implementation of mscorlib optimizes array sorting - // when the comparer is either null or precisely - // reference-equals to System.Collections.Generic.Comparer<'T>.Default. - // This is an indication that a "fast" array sorting helper can be used. - // - // So, for all the types listed below, we want to pass in a value of "null" for - // the comparer object. Note that F# generic comparison coincides precisely with - // System.Collections.Generic.Comparer<'T>.Default for these types. - // - // A "null" comparer is only valid if the values do not have identity, e.g. integers. - // That is, an unstable sort of the array must be the semantically the - // same as a stable sort of the array. See Array.stableSortInPlace. - // - // REVIEW: in a future version we could extend this to include additional types - static let fCanBeNull : System.Collections.Generic.IComparer<'T> = - match typeof<'T> with - | ty when ty.Equals(typeof) -> unboxPrim (box IntPtrComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UIntPtrComparer) - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> null - | ty when ty.Equals(typeof) -> unboxPrim (box StringComparer) - | ty when ty.Equals(typeof) -> null - | _ -> MakeGenericComparer<'T>() - - static let f : System.Collections.Generic.IComparer<'T> = - match typeof<'T> with - | ty when ty.Equals(typeof) -> unboxPrim (box ByteComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box CharComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box SByteComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box Int16Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box Int32Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box Int64Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box IntPtrComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt16Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt32Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UInt64Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box UIntPtrComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box FloatComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box Float32Comparer) - | ty when ty.Equals(typeof) -> unboxPrim (box DecimalComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box StringComparer) - | ty when ty.Equals(typeof) -> unboxPrim (box BoolComparer) - | _ -> - // Review: There are situations where we should be able - // to return System.Collections.Generic.Comparer<'T>.Default here. - // For example, for any value type. - MakeGenericComparer<'T>() - - static member Value : System.Collections.Generic.IComparer<'T> = f - - static member ValueCanBeNullIfDefaultSemantics : System.Collections.Generic.IComparer<'T> = fCanBeNull - let FastGenericComparerFromTable<'T> = - FastGenericComparerTable<'T>.Value + let FastGenericComparerFromTable<'T> : IComparer<'T> = + HashCompare.FSharpComparer_ER<'T>.Comparer :> IComparer<'T> let inline FastGenericComparer<'T> = // This gets used is 'T can't be resolved to anything interesting @@ -2290,7 +2777,10 @@ namespace Microsoft.FSharp.Core // which are then optimized for the particular nominal type involved. when 'T : 'T = MakeGenericComparer<'T>() - let FastGenericComparerCanBeNull<'T> = FastGenericComparerTable<'T>.ValueCanBeNullIfDefaultSemantics + let FastGenericComparerInternal<'T> : Comparer<'T> = + HashCompare.FSharpComparer_InternalUse_ER<'T>.Comparer + let EquivalentForStableAndUnstableSort<'T> : bool = + HashCompare.FSharpComparer_InternalUse_ER<'T>.EquivalentForStableAndUnstableSort //------------------------------------------------------------------------- // LanguagePrimitives: ENUMS diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 54fdf39ba2c..c233f80d23f 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -952,7 +952,10 @@ namespace Microsoft.FSharp.Core val inline FastGenericComparer<'T> : System.Collections.Generic.IComparer<'T> when 'T : comparison /// Make an F# comparer object for the given type, where it can be null if System.Collections.Generic.Comparer<'T>.Default - val internal FastGenericComparerCanBeNull<'T> : System.Collections.Generic.IComparer<'T> when 'T : comparison + val internal FastGenericComparerInternal<'T> : System.Collections.Generic.Comparer<'T> when 'T : comparison + + /// As an optimization, determine if a fast unstable sort can be used with equivalent results + val internal EquivalentForStableAndUnstableSort<'T> : bool /// Make an F# hash/equality object for the given type val inline FastGenericEqualityComparer<'T> : System.Collections.Generic.IEqualityComparer<'T> when 'T : equality @@ -1236,8 +1239,38 @@ namespace Microsoft.FSharp.Core //[] val inline SetArray4D : target:'T[,,,] -> index1:int -> index2:int -> index3:int -> index4:int -> value:'T -> unit + module internal Reflection = + val internal tupleNames : string [] + val internal isTupleType : Type -> bool + val internal tryFindSourceConstructFlagsOfType : Type * byref -> bool + val internal fieldPropsOfRecordType : Type * System.Reflection.BindingFlags -> System.Reflection.PropertyInfo[] + val internal isRecordType : Type * System.Reflection.BindingFlags -> bool + val internal getUnionTypeTagNameMap : Type * System.Reflection.BindingFlags -> (int*string)[] + val internal fieldsPropsOfUnionCase : Type * int* System.Reflection.BindingFlags -> System.Reflection.PropertyInfo[] + val internal isUnionType : Type * System.Reflection.BindingFlags -> bool + /// The F# compiler emits calls to some of the functions in this module as part of the compiled form of some language constructs module HashCompare = + [] + type FSharpEqualityComparer_ER<'T> = + static member EqualityComparer : System.Collections.Generic.EqualityComparer<'T> + + [] + type FSharpEqualityComparer_PER<'T> = + static member EqualityComparer : System.Collections.Generic.EqualityComparer<'T> + + /// A primitive entry point used by the F# compiler for optimization purposes. + [] + val inline FSharpEqualityComparer_ER_Equals : x:'T -> y:'T -> bool + + /// A primitive entry point used by the F# compiler for optimization purposes. + [] + val inline FSharpEqualityComparer_PER_Equals : x:'T -> y:'T -> bool + + /// A primitive entry point used by the F# compiler for optimization purposes. + [] + val inline FSharpEqualityComparer_GetHashCode : x:'T -> int + /// A primitive entry point used by the F# compiler for optimization purposes. [] val PhysicalHashIntrinsic : input:'T -> int when 'T : not struct diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 78528294f5c..ef019303f61 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -83,153 +83,17 @@ module internal Impl = //----------------------------------------------------------------- // ATTRIBUTE DECOMPILATION - let tryFindCompilationMappingAttribute (attrs:obj[]) = - match attrs with - | null | [| |] -> None - | [| res |] -> let a = (res :?> CompilationMappingAttribute) in Some (a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber) - | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.multipleCompilationMappings)) - - let findCompilationMappingAttribute (attrs:obj[]) = - match tryFindCompilationMappingAttribute attrs with - | None -> failwith "no compilation mapping attribute" - | Some a -> a - -#if !FX_NO_REFLECTION_ONLY - let cmaName = typeof.FullName - let assemblyName = typeof.Assembly.GetName().Name - let _ = assert (assemblyName = "FSharp.Core") - - let tryFindCompilationMappingAttributeFromData (attrs:System.Collections.Generic.IList) = - match attrs with - | null -> None - | _ -> - let mutable res = None - for a in attrs do - if a.Constructor.DeclaringType.FullName = cmaName then - let args = a.ConstructorArguments - let flags = - match args.Count with - | 1 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), 0, 0) - | 2 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), 0) - | 3 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), (let x = args.[2] in x.Value :?> int)) - | _ -> (enum 0, 0, 0) - res <- Some flags - res - - let findCompilationMappingAttributeFromData attrs = - match tryFindCompilationMappingAttributeFromData attrs with - | None -> failwith "no compilation mapping attribute" - | Some a -> a -#endif - - let tryFindCompilationMappingAttributeFromType (typ:Type) = -#if !FX_NO_REFLECTION_ONLY - let assem = typ.Assembly - if (not (isNull assem)) && assem.ReflectionOnly then - tryFindCompilationMappingAttributeFromData ( typ.GetCustomAttributesData()) - else -#endif - tryFindCompilationMappingAttribute ( typ.GetCustomAttributes (typeof,false)) - - let tryFindCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = -#if !FX_NO_REFLECTION_ONLY - let assem = info.DeclaringType.Assembly - if (not (isNull assem)) && assem.ReflectionOnly then - tryFindCompilationMappingAttributeFromData (info.GetCustomAttributesData()) - else -#endif - tryFindCompilationMappingAttribute (info.GetCustomAttributes (typeof,false)) - - let findCompilationMappingAttributeFromMemberInfo (info:MemberInfo) = -#if !FX_NO_REFLECTION_ONLY - let assem = info.DeclaringType.Assembly - if (not (isNull assem)) && assem.ReflectionOnly then - findCompilationMappingAttributeFromData (info.GetCustomAttributesData()) + let tryFindSourceConstructFlagsOfType (typ:Type) = + let mutable res = Unchecked.defaultof<_> + if LanguagePrimitives.Reflection.tryFindSourceConstructFlagsOfType (typ, &res) then + Some res else -#endif - findCompilationMappingAttribute (info.GetCustomAttributes (typeof,false)) - - let sequenceNumberOfMember (x: MemberInfo) = let (_,n,_) = findCompilationMappingAttributeFromMemberInfo x in n - let variantNumberOfMember (x: MemberInfo) = let (_,_,vn) = findCompilationMappingAttributeFromMemberInfo x in vn - - let sortFreshArray f arr = Array.sortInPlaceWith f arr; arr - - let isFieldProperty (prop : PropertyInfo) = - match tryFindCompilationMappingAttributeFromMemberInfo(prop) with - | None -> false - | Some (flags,_n,_vn) -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Field - - let tryFindSourceConstructFlagsOfType (typ:Type) = - match tryFindCompilationMappingAttributeFromType typ with - | None -> None - | Some (flags,_n,_vn) -> Some flags + None //----------------------------------------------------------------- // UNION DECOMPILATION - // Get the type where the type definitions are stored - let getUnionCasesTyp (typ: Type, _bindingFlags) = -#if CASES_IN_NESTED_CLASS - let casesTyp = typ.GetNestedType("Cases", bindingFlags) - if casesTyp.IsGenericTypeDefinition then casesTyp.MakeGenericType(typ.GetGenericArguments()) - else casesTyp -#else - typ -#endif - - let getUnionTypeTagNameMap (typ:Type,bindingFlags) = - let enumTyp = typ.GetNestedType("Tags", bindingFlags) - // Unions with a singleton case do not get a Tags type (since there is only one tag), hence enumTyp may be null in this case - match enumTyp with - | null -> - typ.GetMethods(staticMethodFlags ||| bindingFlags) - |> Array.choose (fun minfo -> - match tryFindCompilationMappingAttributeFromMemberInfo(minfo) with - | None -> None - | Some (flags,n,_vn) -> - if (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.UnionCase then - let nm = minfo.Name - // chop "get_" or "New" off the front - let nm = - if not (isListType typ) && not (isOptionType typ) then - if nm.Length > 4 && nm.[0..3] = "get_" then nm.[4..] - elif nm.Length > 3 && nm.[0..2] = "New" then nm.[3..] - else nm - else nm - Some (n, nm) - else - None) - | _ -> - enumTyp.GetFields(staticFieldFlags ||| bindingFlags) - |> Array.filter (fun (f:FieldInfo) -> f.IsStatic && f.IsLiteral) - |> sortFreshArray (fun f1 f2 -> compare (f1.GetValue(null) :?> int) (f2.GetValue(null) :?> int)) - |> Array.map (fun tagfield -> (tagfield.GetValue(null) :?> int),tagfield.Name) - - let getUnionCaseTyp (typ: Type, tag: int, bindingFlags) = - let tagFields = getUnionTypeTagNameMap(typ,bindingFlags) - let tagField = tagFields |> Array.pick (fun (i,f) -> if i = tag then Some f else None) - if tagFields.Length = 1 then - typ - else - // special case: two-cased DU annotated with CompilationRepresentation(UseNullAsTrueValue) - // in this case it will be compiled as one class: return self type for non-nullary case and null for nullary - let isTwoCasedDU = - if tagFields.Length = 2 then - match typ.GetCustomAttributes(typeof, false) with - | [|:? CompilationRepresentationAttribute as attr|] -> - (attr.Flags &&& CompilationRepresentationFlags.UseNullAsTrueValue) = CompilationRepresentationFlags.UseNullAsTrueValue - | _ -> false - else - false - if isTwoCasedDU then - typ - else - let casesTyp = getUnionCasesTyp (typ, bindingFlags) - let caseTyp = casesTyp.GetNestedType(tagField, bindingFlags) // if this is null then the union is nullary - match caseTyp with - | null -> null - | _ when caseTyp.IsGenericTypeDefinition -> caseTyp.MakeGenericType(casesTyp.GetGenericArguments()) - | _ -> caseTyp + let getUnionTypeTagNameMap (typ:Type,bindingFlags) = LanguagePrimitives.Reflection.getUnionTypeTagNameMap (typ, bindingFlags) let getUnionTagConverter (typ:Type,bindingFlags) = if isOptionType typ then (fun tag -> match tag with 0 -> "None" | 1 -> "Some" | _ -> invalidArg "tag" (SR.GetString(SR.outOfRange))) @@ -239,17 +103,11 @@ module internal Impl = (fun tag -> tagfieldmap.[tag]) let isUnionType (typ:Type,bindingFlags:BindingFlags) = + // isOptionType & isListType are not necessary. There were here before the code was refactored into prim-types + // presumably as an optimization, so have not been removed (no performance testing run at this time) isOptionType typ || - isListType typ || - match tryFindSourceConstructFlagsOfType(typ) with - | None -> false - | Some(flags) -> - (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.SumType && - // We see private representations only if BindingFlags.NonPublic is set - (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum(0) then - (bindingFlags &&& BindingFlags.NonPublic) <> enum(0) - else - true) + isListType typ || + LanguagePrimitives.Reflection.isUnionType (typ, bindingFlags) // Check the base type - if it is also an F# type then // for the moment we know it is a Discriminated Union @@ -273,14 +131,7 @@ module internal Impl = | 1 (* Cons *) -> getInstancePropertyInfos (typ,[| "Head"; "Tail" |],bindingFlags) | _ -> failwith "fieldsPropsOfUnionCase" else - // Lookup the type holding the fields for the union case - let caseTyp = getUnionCaseTyp (typ, tag, bindingFlags) - let caseTyp = match caseTyp with null -> typ | _ -> caseTyp - caseTyp.GetProperties(instancePropertyFlags ||| bindingFlags) - |> Array.filter isFieldProperty - |> Array.filter (fun prop -> variantNumberOfMember prop = tag) - |> sortFreshArray (fun p1 p2 -> compare (sequenceNumberOfMember p1) (sequenceNumberOfMember p2)) - + LanguagePrimitives.Reflection.fieldsPropsOfUnionCase (typ, tag, bindingFlags) let getUnionCaseRecordReader (typ:Type,tag:int,bindingFlags) = let props = fieldsPropsOfUnionCase(typ,tag,bindingFlags) @@ -349,32 +200,9 @@ module internal Impl = //----------------------------------------------------------------- // TUPLE DECOMPILATION - let tupleNames = [| - "System.Tuple`1"; "System.Tuple`2"; "System.Tuple`3"; - "System.Tuple`4"; "System.Tuple`5"; "System.Tuple`6"; - "System.Tuple`7"; "System.Tuple`8"; "System.Tuple" - "System.ValueTuple`1"; "System.ValueTuple`2"; "System.ValueTuple`3"; - "System.ValueTuple`4"; "System.ValueTuple`5"; "System.ValueTuple`6"; - "System.ValueTuple`7"; "System.ValueTuple`8"; "System.ValueTuple" |] - - let simpleTupleNames = [| - "Tuple`1"; "Tuple`2"; "Tuple`3"; - "Tuple`4"; "Tuple`5"; "Tuple`6"; - "Tuple`7"; "Tuple`8"; - "ValueTuple`1"; "ValueTuple`2"; "ValueTuple`3"; - "ValueTuple`4"; "ValueTuple`5"; "ValueTuple`6"; - "ValueTuple`7"; "ValueTuple`8"; |] - - let isTupleType (typ:Type) = - // We need to be careful that we only rely typ.IsGenericType, typ.Namespace and typ.Name here. - // - // Historically the FSharp.Core reflection utilities get used on implementations of - // System.Type that don't have functionality such as .IsEnum and .FullName fully implemented. - // This happens particularly over TypeBuilderInstantiation types in the ProvideTypes implementation of System.TYpe - // used in F# type providers. - typ.IsGenericType && - typ.Namespace = "System" && - simpleTupleNames |> Seq.exists typ.Name.StartsWith + let tupleNames = LanguagePrimitives.Reflection.tupleNames + + let isTupleType (typ:Type) = LanguagePrimitives.Reflection.isTupleType typ let maxTuple = 8 // Which field holds the nested tuple? @@ -598,21 +426,9 @@ module internal Impl = //----------------------------------------------------------------- // RECORD DECOMPILATION - let isRecordType (typ:Type,bindingFlags:BindingFlags) = - match tryFindSourceConstructFlagsOfType(typ) with - | None -> false - | Some(flags) -> - (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.RecordType && - // We see private representations only if BindingFlags.NonPublic is set - (if (flags &&& SourceConstructFlags.NonPublicRepresentation) <> enum(0) then - (bindingFlags &&& BindingFlags.NonPublic) <> enum(0) - else - true) - - let fieldPropsOfRecordType(typ:Type,bindingFlags) = - typ.GetProperties(instancePropertyFlags ||| bindingFlags) - |> Array.filter isFieldProperty - |> sortFreshArray (fun p1 p2 -> compare (sequenceNumberOfMember p1) (sequenceNumberOfMember p2)) + let isRecordType (typ:Type,bindingFlags:BindingFlags) = LanguagePrimitives.Reflection.isRecordType (typ, bindingFlags) + + let fieldPropsOfRecordType (typ:Type, bindingFlags) = LanguagePrimitives.Reflection.fieldPropsOfRecordType (typ, bindingFlags) let getRecordReader(typ:Type,bindingFlags) = let props = fieldPropsOfRecordType(typ,bindingFlags) diff --git a/src/fsharp/FSharp.Core/set.fs b/src/fsharp/FSharp.Core/set.fs index 85c04a2c241..8e476e0d40c 100644 --- a/src/fsharp/FSharp.Core/set.fs +++ b/src/fsharp/FSharp.Core/set.fs @@ -13,28 +13,12 @@ namespace Microsoft.FSharp.Collections (* A classic functional language implementation of binary trees *) - [] [] type SetTree<'T> when 'T: comparison = - | SetEmpty // height = 0 - | SetNode of 'T * SetTree<'T> * SetTree<'T> * int // height = int - | SetOne of 'T // height = 1 - // OPTIMIZATION: store SetNode(k,SetEmpty,SetEmpty,1) ---> SetOne(k) - // REVIEW: performance rumour has it that the data held in SetNode and SetOne should be - // exactly one cache line on typical architectures. They are currently - // ~6 and 3 words respectively. - + | SetNode of 'T * SetTree<'T> * SetTree<'T> * Size:int [] module internal SetTree = - let rec countAux s acc = - match s with - | SetNode(_,l,r,_) -> countAux l (countAux r (acc+1)) - | SetOne(_) -> acc+1 - | SetEmpty -> acc - - let count s = countAux s 0 - #if TRACE_SETS_AND_MAPS let mutable traceCount = 0 let mutable numOnes = 0 @@ -63,18 +47,14 @@ namespace Microsoft.FSharp.Collections let n = SetTree.SetNode(x,l,r,h) totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (count n); n - #else - let SetOne n = SetTree.SetOne n - let SetNode (x,l,r,h) = SetTree.SetNode(x,l,r,h) - #endif - - let height t = - match t with - | SetEmpty -> 0 - | SetOne _ -> 1 - | SetNode (_,_,_,h) -> h + [] + type Constants<'Key when 'Key : comparison> private () = + static let empty = SetNode(Unchecked.defaultof<'Key>, Unchecked.defaultof>, Unchecked.defaultof>, 0) + static member Empty = empty + + let size (SetNode (Size=s)) = s #if CHECKED let rec checkInvariant t = @@ -88,82 +68,73 @@ namespace Microsoft.FSharp.Collections (-2 <= (h1 - h2) && (h1 - h2) <= 2) && checkInvariant t1 && checkInvariant t2 #endif - let tolerance = 2 + let inline (++) l r = Checked.(+) l r - let mk l k r = - match l,r with - | SetEmpty,SetEmpty -> SetOne (k) - | _ -> - let hl = height l - let hr = height r - let m = if hl < hr then hr else hl - SetNode(k,l,r,m+1) - - let rebalance t1 k t2 = - let t1h = height t1 - let t2h = height t2 - if t2h > t1h + tolerance then // right is heavier than left - match t2 with - | SetNode(t2k,t2l,t2r,_) -> - // one of the nodes must have height > height t1 + 1 - if height t2l > t1h + 1 then // balance left: combination - match t2l with - | SetNode(t2lk,t2ll,t2lr,_) -> - mk (mk t1 k t2ll) t2lk (mk t2lr t2k t2r) - | _ -> failwith "rebalance" - else // rotate left - mk (mk t1 k t2l) t2k t2r - | _ -> failwith "rebalance" + let inline mkLeaf k = SetNode (k, Constants.Empty, Constants.Empty, 1) + + let inline mk l k r = SetNode(k,l,r,(size l) ++ (size r) + 1) + + let private rebalanceRight l k (SetNode(rk,rl,rr,_)) = + (* one of the nodes must have height > height t1 + 1 *) + if size rl > size l then (* balance left: combination *) + match rl with + | SetNode(rlk,rll,rlr,_) -> mk (mk l k rll) rlk (mk rlr rk rr) + else (* rotate left *) + mk (mk l k rl) rk rr + + let private rebalanceLeft (SetNode(lk,ll,lr,_)) k r = + (* one of the nodes must have height > height t2 + 1 *) + if size lr > size r then + (* balance right: combination *) + match lr with + | SetNode(lrk,lrl,lrr,_) -> mk (mk ll lk lrl) lrk (mk lrr k r) + else + mk ll lk (mk lr k r) + + let inline rebalance l k r = + let ls, rs = size l, size r + if (rs >>> 1) > ls then rebalanceRight l k r + elif (ls >>> 1) > rs then rebalanceLeft l k r + else SetNode (k,l,r, ls ++ rs ++ 1) + + let rec add (comparer:IComparer<'Key>) k (SetNode(k2,l,r,s)) = + if s = 0 then mkLeaf k else - if t1h > t2h + tolerance then // left is heavier than right - match t1 with - | SetNode(t1k,t1l,t1r,_) -> - // one of the nodes must have height > height t2 + 1 - if height t1r > t2h + 1 then - // balance right: combination - match t1r with - | SetNode(t1rk,t1rl,t1rr,_) -> - mk (mk t1l t1k t1rl) t1rk (mk t1rr k t2) - | _ -> failwith "rebalance" - else - mk t1l t1k (mk t1r k t2) - | _ -> failwith "rebalance" - else mk t1 k t2 - - let rec add (comparer: IComparer<'T>) k t = - match t with - | SetNode (k2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then rebalance (add comparer k l) k2 r - elif c = 0 then t - else rebalance l k2 (add comparer k r) - | SetOne(k2) -> - // nb. no check for rebalance needed for small trees, also be sure to reuse node already allocated let c = comparer.Compare(k,k2) - if c < 0 then SetNode (k,SetEmpty,t,2) - elif c = 0 then t - else SetNode (k,t,SetEmpty,2) - | SetEmpty -> SetOne(k) + if c < 0 then + let l' = add comparer k l + let l's, rs = size l', size r + if (l's >>> 1) > rs then + rebalanceLeft l' k2 r + else + SetNode (k2,l',r, l's ++ rs ++ 1) + elif c > 0 then + let r' = add comparer k r + let ls, r's = size l, size r' + if (r's >>> 1) > ls then + rebalanceRight l k2 r' + else + SetNode (k2,l,r', ls ++ r's ++ 1) + else + SetNode(k,l,r,s) let rec balance comparer t1 k t2 = // Given t1 < k < t2 where t1 and t2 are "balanced", // return a balanced tree for . // Recall: balance means subtrees heights differ by at most "tolerance" match t1,t2 with - | SetEmpty,t2 -> add comparer k t2 // drop t1 = empty - | t1,SetEmpty -> add comparer k t1 // drop t2 = empty - | SetOne k1,t2 -> add comparer k (add comparer k1 t2) - | t1,SetOne k2 -> add comparer k (add comparer k2 t1) - | SetNode(k1,t11,t12,h1),SetNode(k2,t21,t22,h2) -> + | SetNode (Size=0),t2 -> add comparer k t2 // drop t1 = empty + | t1,SetNode (Size=0) -> add comparer k t1 // drop t2 = empty + | SetNode(k1,t11,t12,s1),SetNode(k2,t21,t22,s2) -> // Have: (t11 < k1 < t12) < k < (t21 < k2 < t22) // Either (a) h1,h2 differ by at most 2 - no rebalance needed. // (b) h1 too small, i.e. h1+2 < h2 // (c) h2 too small, i.e. h2+2 < h1 - if h1+tolerance < h2 then + if s1 < (s2 >>> 1) then // case: b, h1 too small // push t1 into low side of t2, may increase height by 1 so rebalance rebalance (balance comparer t1 k t21) k2 t22 - elif h2+tolerance < h1 then + elif s2 < (s1 >>> 1) then // case: c, h2 too small // push t2 into high side of t1, may increase height by 1 so rebalance rebalance t11 k1 (balance comparer t12 k t2) @@ -175,6 +146,8 @@ namespace Microsoft.FSharp.Collections // Given a pivot and a set t // Return { x in t s.t. x < pivot }, pivot in t? , { x in t s.t. x > pivot } match t with + | SetNode(Size=0) -> + Constants.Empty,false,Constants.Empty | SetNode(k1,t11,t12,_) -> let c = comparer.Compare(pivot,k1) if c < 0 then // pivot t1 @@ -185,37 +158,25 @@ namespace Microsoft.FSharp.Collections else // pivot t2 let t12Lo,havePivot,t12Hi = split comparer pivot t12 balance comparer t11 k1 t12Lo,havePivot,t12Hi - | SetOne k1 -> - let c = comparer.Compare(k1,pivot) - if c < 0 then t ,false,SetEmpty // singleton under pivot - elif c = 0 then SetEmpty,true ,SetEmpty // singleton is pivot - else SetEmpty,false,t // singleton over pivot - | SetEmpty -> - SetEmpty,false,SetEmpty let rec spliceOutSuccessor t = match t with - | SetEmpty -> failwith "internal error: Set.spliceOutSuccessor" - | SetOne (k2) -> k2,SetEmpty + | SetNode(Size=0) -> failwith "internal error: Set.spliceOutSuccessor" | SetNode (k2,l,r,_) -> match l with - | SetEmpty -> k2,r + | SetNode(Size=0) -> k2,r | _ -> let k3,l' = spliceOutSuccessor l in k3,mk l' k2 r let rec remove (comparer: IComparer<'T>) k t = match t with - | SetEmpty -> t - | SetOne (k2) -> - let c = comparer.Compare(k,k2) - if c = 0 then SetEmpty - else t + | SetNode(Size=0) -> t | SetNode (k2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then rebalance (remove comparer k l) k2 r elif c = 0 then match l,r with - | SetEmpty,_ -> r - | _,SetEmpty -> l + | SetNode(Size=0),_ -> r + | _,SetNode(Size=0) -> l | _ -> let sk,r' = spliceOutSuccessor r mk l sk r' @@ -223,52 +184,46 @@ namespace Microsoft.FSharp.Collections let rec mem (comparer: IComparer<'T>) k t = match t with + | SetNode(Size=0) -> false | SetNode(k2,l,r,_) -> let c = comparer.Compare(k,k2) if c < 0 then mem comparer k l elif c = 0 then true else mem comparer k r - | SetOne(k2) -> (comparer.Compare(k,k2) = 0) - | SetEmpty -> false let rec iter f t = match t with + | SetNode(Size=0) -> () | SetNode(k2,l,r,_) -> iter f l; f k2; iter f r - | SetOne(k2) -> f k2 - | SetEmpty -> () let rec foldBackOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) m x = match m with + | SetNode(Size=0) -> x | SetNode(k,l,r,_) -> foldBackOpt f l (f.Invoke(k, (foldBackOpt f r x))) - | SetOne(k) -> f.Invoke(k, x) - | SetEmpty -> x let foldBack f m x = foldBackOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) m x let rec foldOpt (f:OptimizedClosures.FSharpFunc<_,_,_>) x m = match m with + | SetNode(Size=0) -> x | SetNode(k,l,r,_) -> let x = foldOpt f x l in let x = f.Invoke(x, k) foldOpt f x r - | SetOne(k) -> f.Invoke(x, k) - | SetEmpty -> x let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f)) x m let rec forall f m = match m with + | SetNode(Size=0) -> true | SetNode(k2,l,r,_) -> f k2 && forall f l && forall f r - | SetOne(k2) -> f k2 - | SetEmpty -> true let rec exists f m = match m with + | SetNode(Size=0) -> false | SetNode(k2,l,r,_) -> f k2 || exists f l || exists f r - | SetOne(k2) -> f k2 - | SetEmpty -> false - let isEmpty m = match m with | SetEmpty -> true | _ -> false + let isEmpty (SetNode(Size=s)) = s = 0 let subset comparer a b = forall (fun x -> mem comparer x b) a @@ -276,28 +231,28 @@ namespace Microsoft.FSharp.Collections let rec filterAux comparer f s acc = match s with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> let acc = if f k then add comparer k acc else acc filterAux comparer f l (filterAux comparer f r acc) - | SetOne(k) -> if f k then add comparer k acc else acc - | SetEmpty -> acc - let filter comparer f s = filterAux comparer f s SetEmpty + let filter comparer f s = filterAux comparer f s Constants.Empty let rec diffAux comparer m acc = match acc with - | SetEmpty -> acc + | SetNode(Size=0) -> acc | _ -> match m with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> diffAux comparer l (diffAux comparer r (remove comparer k acc)) - | SetOne(k) -> remove comparer k acc - | SetEmpty -> acc let diff comparer a b = diffAux comparer b a let rec union comparer t1 t2 = // Perf: tried bruteForce for low heights, but nothing significant match t1,t2 with + | SetNode(Size=0),t -> t + | t,SetNode(Size=0) -> t | SetNode(k1,t11,t12,h1),SetNode(k2,t21,t22,h2) -> // (t11 < k < t12) AND (t21 < k2 < t22) // Divide and Conquer: // Suppose t1 is largest. @@ -309,66 +264,54 @@ namespace Microsoft.FSharp.Collections else let lo,_,hi = split comparer k2 t1 in balance comparer (union comparer t21 lo) k2 (union comparer t22 hi) - | SetEmpty,t -> t - | t,SetEmpty -> t - | SetOne k1,t2 -> add comparer k1 t2 - | t1,SetOne k2 -> add comparer k2 t1 let rec intersectionAux comparer b m acc = match m with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> let acc = intersectionAux comparer b r acc let acc = if mem comparer k b then add comparer k acc else acc intersectionAux comparer b l acc - | SetOne(k) -> - if mem comparer k b then add comparer k acc else acc - | SetEmpty -> acc - let intersection comparer a b = intersectionAux comparer b a SetEmpty + let intersection comparer a b = intersectionAux comparer b a Constants.Empty let partition1 comparer f k (acc1,acc2) = if f k then (add comparer k acc1,acc2) else (acc1,add comparer k acc2) let rec partitionAux comparer f s acc = match s with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> let acc = partitionAux comparer f r acc let acc = partition1 comparer f k acc partitionAux comparer f l acc - | SetOne(k) -> partition1 comparer f k acc - | SetEmpty -> acc - let partition comparer f s = partitionAux comparer f s (SetEmpty,SetEmpty) + let partition comparer f s = partitionAux comparer f s (Constants.Empty,Constants.Empty) - // It's easier to get many less-important algorithms right using this active pattern - let (|MatchSetNode|MatchSetEmpty|) s = - match s with - | SetNode(k2,l,r,_) -> MatchSetNode(k2,l,r) - | SetOne(k2) -> MatchSetNode(k2,SetEmpty,SetEmpty) - | SetEmpty -> MatchSetEmpty + //// It's easier to get many less-important algorithms right using this active pattern + //let (|MatchSetNode|MatchSetEmpty|) s = + // match s with + // | SetNode(Size=0) -> MatchSetEmpty + // | SetNode(k2,l,r,_) -> MatchSetNode(k2,l,r) let rec minimumElementAux s n = match s with + | SetNode(Size=0) -> n | SetNode(k,l,_,_) -> minimumElementAux l k - | SetOne(k) -> k - | SetEmpty -> n and minimumElementOpt s = match s with + | SetNode(Size=0) -> None | SetNode(k,l,_,_) -> Some(minimumElementAux l k) - | SetOne(k) -> Some k - | SetEmpty -> None and maximumElementAux s n = match s with + | SetNode(Size=0) -> n | SetNode(k,_,r,_) -> maximumElementAux r k - | SetOne(k) -> k - | SetEmpty -> n and maximumElementOpt s = match s with + | SetNode(Size=0) -> None | SetNode(k,_,r,_) -> Some(maximumElementAux r k) - | SetOne(k) -> Some(k) - | SetEmpty -> None let minimumElement s = match minimumElementOpt s with @@ -397,9 +340,9 @@ namespace Microsoft.FSharp.Collections let rec collapseLHS stack = match stack with | [] -> [] - | SetEmpty :: rest -> collapseLHS rest - | SetOne _ :: _ -> stack - | SetNode(k,l,r,_) :: rest -> collapseLHS (l :: SetOne k :: r :: rest) + | SetNode(Size=0) :: rest -> collapseLHS rest + | SetNode(_,_,_,1) :: _ -> stack + | SetNode(k,l,r,_) :: rest -> collapseLHS (l :: (mkLeaf k) :: r :: rest) let mkIterator s = { stack = collapseLHS [s]; started = false } @@ -409,7 +352,7 @@ namespace Microsoft.FSharp.Collections let current i = if i.started then match i.stack with - | SetOne k :: _ -> k + | SetNode(k,_,_,1) :: _ -> k | [] -> alreadyFinished() | _ -> failwith "Please report error: Set iterator, unexpected stack for current" else @@ -418,7 +361,7 @@ namespace Microsoft.FSharp.Collections let rec moveNext i = if i.started then match i.stack with - | SetOne _ :: rest -> + | SetNode(_,_,_,1) :: rest -> i.stack <- collapseLHS rest; not i.stack.IsEmpty | [] -> false @@ -442,48 +385,36 @@ namespace Microsoft.FSharp.Collections // Set comparison. This can be expensive. //-------------------------------------------------------------------------- - let rec compareStacks (comparer: IComparer<'T>) l1 l2 = + let (^^) hd tl = + match hd with + | SetNode(Size=0) -> tl + | _ -> hd::tl + + let rec compareStacks (comparer:IComparer<'T>) l1 l2 = match l1,l2 with | [],[] -> 0 | [],_ -> -1 | _ ,[] -> 1 - | (SetEmpty _ :: t1),(SetEmpty :: t2) -> compareStacks comparer t1 t2 - | (SetOne(n1k) :: t1),(SetOne(n2k) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer t1 t2 - | (SetOne(n1k) :: t1),(SetNode(n2k,SetEmpty,n2r,_) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer (SetEmpty :: t1) (n2r :: t2) - | (SetNode(n1k,(SetEmpty as emp),n1r,_) :: t1),(SetOne(n2k) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer (n1r :: t1) (emp :: t2) - | (SetNode(n1k,SetEmpty,n1r,_) :: t1),(SetNode(n2k,SetEmpty,n2r,_) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer (n1r :: t1) (n2r :: t2) - | (SetOne(n1k) :: t1),_ -> - compareStacks comparer (SetEmpty :: SetOne(n1k) :: t1) l2 - | (SetNode(n1k,n1l,n1r,_) :: t1),_ -> - compareStacks comparer (n1l :: SetNode(n1k,SetEmpty,n1r,0) :: t1) l2 - | _,(SetOne(n2k) :: t2) -> - compareStacks comparer l1 (SetEmpty :: SetOne(n2k) :: t2) - | _,(SetNode(n2k,n2l,n2r,_) :: t2) -> - compareStacks comparer l1 (n2l :: SetNode(n2k,SetEmpty,n2r,0) :: t2) + | (SetNode(n1k,SetNode(Size=0),n1r,_)::t1),(SetNode(n2k,SetNode(Size=0),n2r,_)::t2) -> + match comparer.Compare (n1k,n2k) with + | 0 -> compareStacks comparer (n1r ^^ t1) (n2r ^^ t2) + | c -> c + | (SetNode(n1k,(SetNode(Size=n1ls) as n1l),n1r,_)::t1),_ when n1ls > 0 -> + compareStacks comparer (n1l ^^ (mk Constants.Empty n1k n1r) ^^ t1) l2 + | _,(SetNode(n2k,n2l,n2r,_)::t2) -> + compareStacks comparer l1 (n2l ^^ (mk Constants.Empty n2k n2r) ^^ t2) - let compare comparer s1 s2 = - match s1,s2 with - | SetEmpty,SetEmpty -> 0 - | SetEmpty,_ -> -1 - | _,SetEmpty -> 1 - | _ -> compareStacks comparer [s1] [s2] + let compare comparer s1 s2 = + if obj.ReferenceEquals (s1,s2) then 0 + else compareStacks comparer (s1 ^^ []) (s2 ^^ []) let choose s = minimumElement s let toList s = let rec loop m acc = match m with + | SetNode(Size=0) -> acc | SetNode(k,l,r,_) -> loop l (k :: loop r acc) - | SetOne(k) -> k ::acc - | SetEmpty -> acc loop s [] let copyToArray s (arr: _[]) i = @@ -491,7 +422,7 @@ namespace Microsoft.FSharp.Collections iter (fun x -> arr.[!j] <- x; j := !j + 1) s let toArray s = - let n = (count s) + let n = size s let res = Array.zeroCreate n copyToArray s res 0; res @@ -505,9 +436,9 @@ namespace Microsoft.FSharp.Collections let ofSeq comparer (c: IEnumerable<_>) = use ie = c.GetEnumerator() - mkFromEnumerator comparer SetEmpty ie + mkFromEnumerator comparer Constants.Empty ie - let ofArray comparer l = Array.fold (fun acc k -> add comparer k acc) SetEmpty l + let ofArray comparer l = Array.fold (fun acc k -> add comparer k acc) Constants.Empty l [] @@ -538,7 +469,7 @@ namespace Microsoft.FSharp.Collections static let empty: Set<'T> = let comparer = LanguagePrimitives.FastGenericComparer<'T> - Set<'T>(comparer, SetEmpty) + Set<'T>(comparer, SetTree.Constants.Empty) #if !FX_NO_BINARY_SERIALIZATION [] @@ -582,7 +513,7 @@ namespace Microsoft.FSharp.Collections #endif Set<'T>(s.Comparer,SetTree.remove s.Comparer value s.Tree) - member s.Count = SetTree.count s.Tree + member s.Count = SetTree.size s.Tree member s.Contains(value) = #if TRACE_SETS_AND_MAPS @@ -603,17 +534,17 @@ namespace Microsoft.FSharp.Collections member s.Partition f : Set<'T> * Set<'T> = match s.Tree with - | SetEmpty -> s,s + | SetNode(Size=0) -> s,s | _ -> let t1,t2 = SetTree.partition s.Comparer f s.Tree in Set(s.Comparer,t1), Set(s.Comparer,t2) member s.Filter f : Set<'T> = match s.Tree with - | SetEmpty -> s + | SetNode(Size=0) -> s | _ -> Set(s.Comparer,SetTree.filter s.Comparer f s.Tree) member s.Map f : Set<'U> = let comparer = LanguagePrimitives.FastGenericComparer<'U> - Set(comparer,SetTree.fold (fun acc k -> SetTree.add comparer (f k) acc) (SetTree<_>.SetEmpty) s.Tree) + Set(comparer,SetTree.fold (fun acc k -> SetTree.add comparer (f k) acc) SetTree.Constants.Empty s.Tree) member s.Exists f = SetTree.exists f s.Tree @@ -622,10 +553,10 @@ namespace Microsoft.FSharp.Collections [] static member (-) (set1: Set<'T>, set2: Set<'T>) = match set1.Tree with - | SetEmpty -> set1 (* 0 - B = 0 *) + | SetNode(Size=0) -> set1 (* 0 - B = 0 *) | _ -> match set2.Tree with - | SetEmpty -> set1 (* A - 0 = A *) + | SetNode(Size=0) -> set1 (* A - 0 = A *) | _ -> Set(set1.Comparer,SetTree.diff set1.Comparer set1.Tree set2.Tree) [] @@ -635,18 +566,18 @@ namespace Microsoft.FSharp.Collections SetTree.numUnions <- SetTree.numUnions + 1 #endif match set2.Tree with - | SetEmpty -> set1 (* A U 0 = A *) + | SetNode(Size=0) -> set1 (* A U 0 = A *) | _ -> match set1.Tree with - | SetEmpty -> set2 (* 0 U B = B *) + | SetNode(Size=0) -> set2 (* 0 U B = B *) | _ -> Set(set1.Comparer,SetTree.union set1.Comparer set1.Tree set2.Tree) static member Intersection(a: Set<'T>, b: Set<'T>) : Set<'T> = match b.Tree with - | SetEmpty -> b (* A INTER 0 = 0 *) + | SetNode(Size=0) -> b (* A INTER 0 = 0 *) | _ -> match a.Tree with - | SetEmpty -> a (* 0 INTER B = 0 *) + | SetNode(Size=0) -> a (* 0 INTER B = 0 *) | _ -> Set(a.Comparer,SetTree.intersection a.Comparer a.Tree b.Tree) static member Union(sets:seq>) : Set<'T> = diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index e78e41212dd..4f2f29d46c1 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -13,6 +13,7 @@ open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.TypeRelations +open Internal.Utilities.Collections type env = Nix diff --git a/src/fsharp/Fsc-proto/Fsc-proto.fsproj b/src/fsharp/Fsc-proto/Fsc-proto.fsproj index 5cccf4f17a2..d18c720f5fa 100644 --- a/src/fsharp/Fsc-proto/Fsc-proto.fsproj +++ b/src/fsharp/Fsc-proto/Fsc-proto.fsproj @@ -97,11 +97,8 @@ Utilities\EditDistance.fs - - TaggedCollections.fsi - - - TaggedCollections.fs + + SortKey.fs Utilities\ildiag.fsi @@ -118,18 +115,6 @@ filename.fs - - zmap.fsi - - - zmap.fs - - - zset.fsi - - - zset.fs - bytes.fsi diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 23c4af9526f..ecc76f8eb33 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -86,13 +86,13 @@ let ChooseFreeVarNames takenNames ts = let tns = List.map (fun t -> (t,None)) ts let rec chooseName names (t,nOpt) = let tn = match nOpt with None -> t | Some n -> t + string n - if Zset.contains tn names then + if Set.contains tn names then chooseName names (t,Some(match nOpt with None -> 0 | Some n -> (n+1))) else - let names = Zset.add tn names + let names = Set.add tn names tn,names - let names = Zset.empty String.order |> Zset.addList takenNames + let names = Set.ofList takenNames let ts,_names = List.mapFold chooseName names tns ts @@ -696,8 +696,7 @@ and IlxGenEnv = /// Full list of enclosing bound values. First non-compiler-generated element is used to help give nice names for closures and other expressions. letBoundVars: ValRef list /// The set of IL local variable indexes currently in use by lexically scoped variables, to allow reuse on different branches. - /// Really an integer set. - liveLocals: IntMap + liveLocals: Set /// Are we under the scope of a try, catch or finally? If so we can't tailcall. SEH = structured exception handling withinSEH: bool } @@ -1588,7 +1587,7 @@ let CodeGenThen cenv mgbuf (entryPointInfo,methodName,eenv,alreadyUsedArgs,alrea (* Call the given code generator *) codeGenFunction cgbuf {eenv with withinSEH=false - liveLocals=IntMap.empty() + liveLocals=Set.empty innerVals = innerVals} let locals,maxStack,lab2pc,code,exnSpecs,hasSequencePoints = cgbuf.Close() @@ -3664,7 +3663,7 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType,baseValOpt,basecall,overri and GenSequenceExpr cenv (cgbuf:CodeGenBuffer) eenvouter (nextEnumeratorValRef:ValRef,pcvref:ValRef,currvref:ValRef,stateVars,generateNextExpr,closeExpr,checkCloseExpr:Expr,seqElemTy, m) sequel = let stateVars = [ pcvref; currvref ] @ stateVars - let stateVarsSet = stateVars |> List.map (fun vref -> vref.Deref) |> Zset.ofList valOrder + let stateVarsSet = stateVars |> List.map (fun vref -> vref.Deref) |> Zset.ofList // pretend that the state variables are bound let eenvouter = @@ -3702,7 +3701,7 @@ and GenSequenceExpr cenv (cgbuf:CodeGenBuffer) eenvouter (nextEnumeratorValRef:V ... *) /// State variables always get zero-initialized - if stateVarsSet.Contains fv then + if stateVarsSet |> Zset.contains fv then GenDefaultValue cenv cgbuf eenv (fv.Type,m) else GenGetLocalVal cenv cgbuf eenv m fv None @@ -3744,7 +3743,7 @@ and GenSequenceExpr cenv (cgbuf:CodeGenBuffer) eenvouter (nextEnumeratorValRef:V for fv in cloFreeVars do /// State variables always get zero-initialized - if stateVarsSet.Contains fv then + if stateVarsSet |> Zset.contains fv then GenDefaultValue cenv cgbuf eenvouter (fv.Type,m) else GenGetLocalVal cenv cgbuf eenvouter m fv None @@ -3925,7 +3924,7 @@ and GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr = // -- "internal" ones, which get used internally in the implementation let cloContractFreeTyvarSet = (freeInType CollectTypars (tyOfExpr cenv.g expr)).FreeTypars - let cloInternalFreeTyvars = Zset.diff cloFreeVarResults.FreeTyvars.FreeTypars cloContractFreeTyvarSet |> Zset.elements + let cloInternalFreeTyvars = Set.diff cloFreeVarResults.FreeTyvars.FreeTypars cloContractFreeTyvarSet |> Zset.elements let cloContractFreeTyvars = cloContractFreeTyvarSet |> Zset.elements let cloFreeTyvars = cloContractFreeTyvars @ cloInternalFreeTyvars @@ -4309,11 +4308,11 @@ and GenMatch cenv cgbuf eenv (spBind,_exprm,tree,targets,m,ty) sequel = // Accumulate the decision graph as we go and GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeatSP sequel = - let targetInfos = GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv tree targets repeatSP (IntMap.empty()) sequel + let targetInfos = GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv tree targets repeatSP Map.empty sequel GenPostponedDecisionTreeTargets cenv cgbuf stackAtTargets targetInfos sequel and TryFindTargetInfo targetInfos n = - match IntMap.tryFind n targetInfos with + match Map.tryFind n targetInfos with | Some (targetInfo,_) -> Some targetInfo | None -> None @@ -4389,7 +4388,7 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkBeforeBinds.CodeLabel) true - let targetInfos = IntMap.add targetIdx (targetInfo,isTargetPostponed) targetInfos + let targetInfos = Map.add targetIdx (targetInfo,isTargetPostponed) targetInfos targetInfos and GenPostponedDecisionTreeTargets cenv cgbuf stackAtTargets targetInfos sequel = @@ -4652,7 +4651,7 @@ and GenLetRecBindings cenv cgbuf eenv (allBinds: Bindings,m) = let fixups = ref [] - let recursiveVars = Zset.addList (bindsPossiblyRequiringFixup |> List.map (fun v -> v.Var)) (Zset.empty valOrder) + let recursiveVars = Zset.ofList (bindsPossiblyRequiringFixup |> List.map (fun v -> v.Var)) let _ = (recursiveVars, bindsPossiblyRequiringFixup) ||> List.fold (fun forwardReferenceSet (bind:Binding) -> // Compute fixups @@ -5582,9 +5581,9 @@ and AllocLocal cenv cgbuf eenv compgen (v,ty,isFixed) (scopeMarks: Mark * Mark) // Get an index for the local let j = if cenv.opts.localOptimizationsAreOn - then cgbuf.ReallocLocal((fun i (_,ty',isFixed') -> not isFixed' && not isFixed && not (IntMap.mem i eenv.liveLocals) && (ty = ty')),ranges,ty,isFixed) + then cgbuf.ReallocLocal((fun i (_,ty',isFixed') -> not isFixed' && not isFixed && not (Set.contains i eenv.liveLocals) && (ty = ty')),ranges,ty,isFixed) else cgbuf.AllocLocal(ranges,ty,isFixed) - j, { eenv with liveLocals = IntMap.add j () eenv.liveLocals } + j, { eenv with liveLocals = Set.add j eenv.liveLocals } and AllocLocalVal cenv cgbuf v eenv repr scopeMarks = let repr,eenv = @@ -6918,7 +6917,7 @@ let GetEmptyIlxGenEnv (ilg : ILGlobals) ccu = someTypeInThisAssembly=ilg.typ_Object (* dummy value *) isFinalFile = false letBoundVars=[] - liveLocals=IntMap.empty() + liveLocals=Set.empty innerVals = [] sigToImplRemapInfo = [] (* "module remap info" *) withinSEH = false } diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index da5c49f4bb7..a1f5aa6fdab 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -2,6 +2,7 @@ module internal Microsoft.FSharp.Compiler.InnerLambdasToTopLevelFuncs +open Internal.Utilities.Collections open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library @@ -25,10 +26,10 @@ let verboseTLR = false let internalError str = dprintf "Error: %s\n" str;raise (Failure str) module Zmap = - let force k mp (str,soK) = + let force (k:'Key) (mp:zmap<'Key,'Comparer,'T>) (str,soK) = try Zmap.find k mp with e -> - dprintf "Zmap.force: %s %s\n" str (soK k); + dprintf "Map.force: %s %s\n" str (soK k); PreserveStackTrace(e) raise e @@ -134,10 +135,10 @@ let mkLocalNameTypeArity compgen m name ty topValInfo = let GetValsBoundUnderMustInline xinfo = let accRejectFrom (v:Val) repr rejectS = if v.InlineInfo = ValInline.PseudoVal then - Zset.union (GetValsBoundInExpr repr) rejectS + Set.union (GetValsBoundInExpr repr) rejectS else rejectS - let rejectS = Zset.empty valOrder - let rejectS = Zmap.fold accRejectFrom xinfo.Defns rejectS + let rejectS = Zset.empty () + let rejectS = Zmap.foldBack accRejectFrom xinfo.Defns rejectS rejectS //------------------------------------------------------------------------- @@ -212,17 +213,17 @@ module Pass1_DetermineTLRAndArities = let rejectS = GetValsBoundUnderMustInline xinfo let fArities = List.filter (fun (v,_) -> not (Zset.contains v rejectS)) fArities (*-*) - let tlrS = Zset.ofList valOrder (List.map fst fArities) + let tlrS = Zset.ofList (List.map fst fArities) let topValS = xinfo.TopLevelBindings (* genuinely top level *) let topValS = Zset.filter (IsMandatoryNonTopLevel g >> not) topValS (* restrict *) (* REPORT MISSED CASES *) #if DEBUG if verboseTLR then - let missed = Zset.diff xinfo.TopLevelBindings tlrS + let missed = Set.diff xinfo.TopLevelBindings tlrS missed |> Zset.iter (fun v -> dprintf "TopLevel but not TLR = %s\n" v.LogicalName) #endif (* REPORT OVER *) - let arityM = Zmap.ofList valOrder fArities + let arityM = Zmap.ofList fArities #if DEBUG if verboseTLR then DumpArity arityM #endif @@ -291,11 +292,11 @@ module Pass1_DetermineTLRAndArities = /// [Each fclass has an env, the fclass are the handles to envs.] type BindingGroupSharingSameReqdItems(bindings: Bindings) = let vals = valsOfBinds bindings - let vset = Zset.addList vals (Zset.empty valOrder) + let vset = Zset.ofList vals member fclass.Vals = vals - member fclass.Contains (v: Val) = vset.Contains v + member fclass.Contains (v: Val) = vset |> Zset.contains v member fclass.IsEmpty = isNil vals @@ -303,8 +304,13 @@ type BindingGroupSharingSameReqdItems(bindings: Bindings) = override fclass.ToString() = "+" + String.concat "+" (List.map nameOfVal vals) -let fclassOrder = Order.orderOn (fun (b: BindingGroupSharingSameReqdItems) -> b.Vals) (List.order valOrder) +let fclassOrder = Order.orderOn (fun (b: BindingGroupSharingSameReqdItems) -> b.Vals) (List.order (ValOrder ())) +[] +type FclassOrder = + interface System.Collections.Generic.IComparer with + member __.Compare(v1, v2) = fclassOrder.Compare (v1,v2) + /// It is required to make the TLR closed wrt it's freevars (the env reqdVals0). /// For gv a generator, /// An arity-met gv occurrence contributes the env required for that gv call. @@ -323,17 +329,22 @@ let reqdItemOrder = | ReqdSubEnv v -> true ,v | ReqdVal v -> false,v - Order.orderOn rep (Pair.order (Bool.order,valOrder)) + Order.orderOn rep (Pair.order (Bool.order, (ValOrder ()))) + +[] +type ReqdItemOrder = + interface System.Collections.Generic.IComparer with + member __.Compare(v1, v2) = reqdItemOrder.Compare (v1,v2) /// An env says what is needed to close the corresponding defn(s). /// The reqdTypars are the free reqdTypars of the defns, and those required by any direct TLR arity-met calls. /// The reqdItems are the ids/subEnvs required from calls to freeVars. type ReqdItemsForDefn = - { reqdTypars : Zset - reqdItems : Zset + { reqdTypars : zset + reqdItems : zset m : Range.range } - member env.ReqdSubEnvs = [ for x in env.reqdItems do match x with | ReqdSubEnv f -> yield f | ReqdVal _ -> () ] - member env.ReqdVals = [ for x in env.reqdItems do match x with | ReqdSubEnv _ -> () | ReqdVal v -> yield v ] + member env.ReqdSubEnvs = [ for x in env.reqdItems do match x.CompareObj with | ReqdSubEnv f -> yield f | ReqdVal _ -> () ] + member env.ReqdVals = [ for x in env.reqdItems do match x.CompareObj with | ReqdSubEnv _ -> () | ReqdVal v -> yield v ] member env.Extend (typars,items) = {env with @@ -341,8 +352,8 @@ type ReqdItemsForDefn = reqdItems = Zset.addList items env.reqdItems} static member Initial typars m = - {reqdTypars = Zset.addList typars (Zset.empty typarOrder) - reqdItems = Zset.empty reqdItemOrder + {reqdTypars = Zset.ofList typars + reqdItems = Zset.empty () m = m } override env.ToString() = @@ -356,7 +367,7 @@ type ReqdItemsForDefn = // pass2: collector - state //------------------------------------------------------------------------- -type Generators = Zset +type Generators = zset /// check a named function value applied to sufficient arguments let IsArityMet (vref:ValRef) wf (tys: TypeInst) args = @@ -415,18 +426,18 @@ module Pass2_DetermineReqdItems = /// recShortCalls to f will require a binding for f in terms of fHat within the fHatBody. type state = { stack : (BindingGroupSharingSameReqdItems * Generators * ReqdItemsForDefn) list - reqdItemsMap : Zmap - fclassM : Zmap + reqdItemsMap : zmap + fclassM : zmap revDeclist : BindingGroupSharingSameReqdItems list - recShortCallS : Zset + recShortCallS : zset } let state0 = { stack = [] - reqdItemsMap = Zmap.empty fclassOrder - fclassM = Zmap.empty valOrder + reqdItemsMap = Zmap.empty () + fclassM = Zmap.empty () revDeclist = [] - recShortCallS = Zset.empty valOrder } + recShortCallS = Zset.empty () } /// PUSH = start collecting for fclass let PushFrame (fclass: BindingGroupSharingSameReqdItems) (reqdTypars0,reqdVals0,m) state = @@ -453,9 +464,9 @@ module Pass2_DetermineReqdItems = /// Log requirements for gv in the relevant stack frames let LogRequiredFrom gv items state = - let logIntoFrame (fclass, reqdVals0:Zset, env: ReqdItemsForDefn) = + let logIntoFrame (fclass, reqdVals0:zset, env: ReqdItemsForDefn) = let env = - if reqdVals0.Contains gv then + if reqdVals0 |> Zset.contains gv then env.Extend ([],items) else env @@ -513,7 +524,7 @@ module Pass2_DetermineReqdItems = let reqdVals0 = frees.FreeLocals |> Zset.elements // tlrBs are not reqdVals0 for themselves let reqdVals0 = reqdVals0 |> List.filter (fun gv -> not (fclass.Contains gv)) - let reqdVals0 = reqdVals0 |> Zset.ofList valOrder + let reqdVals0 = reqdVals0 |> Zset.ofList // collect into env over bodies let z = PushFrame fclass (reqdTypars0,reqdVals0,m) z let z = (z,tlrBs) ||> List.fold (foldOn (fun b -> b.Expr) exprF) @@ -561,12 +572,12 @@ module Pass2_DetermineReqdItems = let closeStep reqdItemsMap changed fc (env: ReqdItemsForDefn) = let directCallReqdEnvs = env.ReqdSubEnvs let directCallReqdTypars = directCallReqdEnvs |> List.map (fun f -> - let fc = Zmap.force f fclassM ("reqdTyparsFor",nameOfVal) + let fc = Zmap.force f fclassM ("reqdTyparsFor",nameOfVal) let env = Zmap.force fc reqdItemsMap ("reqdTyparsFor",string) env.reqdTypars) let reqdTypars0 = env.reqdTypars - let reqdTypars = List.fold Zset.union reqdTypars0 directCallReqdTypars + let reqdTypars = List.fold Set.union reqdTypars0 directCallReqdTypars let changed = changed || (not (Zset.equal reqdTypars0 reqdTypars)) let env = {env with reqdTypars = reqdTypars} #if DEBUG @@ -582,7 +593,7 @@ module Pass2_DetermineReqdItems = let rec fixpoint reqdItemsMap = let changed = false - let changed,reqdItemsMap = Zmap.foldMap (closeStep reqdItemsMap) changed reqdItemsMap + let changed,reqdItemsMap = Zmap.foldBackMap (closeStep reqdItemsMap) changed reqdItemsMap if changed then fixpoint reqdItemsMap else @@ -680,7 +691,7 @@ exception AbortTLR of Range.range /// and TBIND(asubEnvi = aenvFor(v)) for each (asubEnvi,v) in cmap(subEnvk) ranging over required subEnvk. /// where /// aenvFor(v) = aenvi where (v,aenvi) in cmap. -let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap) = +let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: zmap) = let fclassOf f = Zmap.force f fclassM ("fclassM",nameOfVal) let packEnv carrierMaps (fc:BindingGroupSharingSameReqdItems) = if verboseTLR then dprintf "\ntlr: packEnv fc=%A\n" fc @@ -692,7 +703,7 @@ let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap Zset.ofList |> Zset.elements // noRepeats // Remove genuinely toplevel, no need to close over these let vals = vals |> List.filter (IsMandatoryTopLevel >> not) @@ -738,7 +749,7 @@ let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap List.map (fun v -> (v,(mkCompGenLocal env.m v.LogicalName v.Type |> fst))) - let cmap = Zmap.ofList valOrder cmapPairs + let cmap = Zmap.ofList cmapPairs let aenvFor v = Zmap.force v cmap ("aenvFor",nameOfVal) let aenvExprFor v = exprForVal env.m (aenvFor v) @@ -773,9 +784,9 @@ let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap () let envPacks,_carriedMaps = List.mapFold packEnv carriedMaps declist (* List.mapFold in dec order *) - let envPacks = Zmap.ofList fclassOrder envPacks + let envPacks = Zmap.ofList envPacks envPacks @@ -841,7 +852,7 @@ let CreateNewValuesForTLR g tlrS arityM fclassM envPackM = let fs = Zset.elements tlrS let ffHats = List.map (fun f -> f,createFHat f) fs - let fHatM = Zmap.ofList valOrder ffHats + let fHatM = Zmap.ofList ffHats fHatM @@ -854,14 +865,14 @@ module Pass4_RewriteAssembly = type RewriteContext = { ccu : CcuThunk g : TcGlobals - tlrS : Zset - topValS : Zset - arityM : Zmap - fclassM : Zmap - recShortCallS : Zset - envPackM : Zmap + tlrS : zset + topValS : zset + arityM : zmap + fclassM : zmap + recShortCallS : zset + envPackM : zmap /// The mapping from 'f' values to 'fHat' values - fHatM : Zmap + fHatM : zmap } @@ -1003,7 +1014,7 @@ module Pass4_RewriteAssembly = let fHatBind = mkMultiLambdaBind fHat letSeqPtOpt m fHat_tps fHat_args (fHat_body,rty) fHatBind let rebinds = binds |> List.map fRebinding - let shortRecBinds = rebinds |> List.filter (fun b -> penv.recShortCallS.Contains(b.Var)) + let shortRecBinds = rebinds |> List.filter (fun b -> penv.recShortCallS |> Zset.contains b.Var) let newBinds = binds |> List.map (fHatNewBinding shortRecBinds) newBinds,rebinds @@ -1023,7 +1034,7 @@ module Pass4_RewriteAssembly = // QUERY: yes and no - if we don't, we have an unrealizable term, and many decisions must // QUERY: correlate with LowerCallsAndSeqs. let forceTopBindToHaveArity (bind:Binding) = - if penv.topValS.Contains(bind.Var) then ConvertBind penv.g bind + if penv.topValS |> Zset.contains bind.Var then ConvertBind penv.g bind else bind let nonTlrBs = nonTlrBs |> List.map forceTopBindToHaveArity diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index 6fc9b6065e6..792f1088bbb 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -17,6 +17,7 @@ open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.InfoReader open Microsoft.FSharp.Compiler.MethodCalls +open Internal.Utilities.Collections //---------------------------------------------------------------------------- // Eta-expansion of calls to top-level-methods diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index d51bbe953c0..0b41199b8a5 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -353,7 +353,7 @@ type CalledMeth<'T> let names = namedCallerArgs |> List.map (fun (CallerNamedArg(nm, _)) -> nm.idText) - if (List.noRepeats String.order names).Length <> namedCallerArgs.Length then + if (names |> Set.ofList |> Set.count) <> namedCallerArgs.Length then errorR(Error(FSComp.SR.typrelNamedArgumentHasBeenAssignedMoreThenOnce(), m)) let argSet = { UnnamedCalledArgs=unnamedCalledArgs; UnnamedCallerArgs=unnamedCallerArgs; ParamArrayCalledArgOpt=paramArrayCalledArgOpt; ParamArrayCallerArgs=paramArrayCallerArgs; AssignedNamedArgs=assignedNamedArgs } diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index cf4d50c4a27..a68263bea39 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -5,6 +5,7 @@ module internal Microsoft.FSharp.Compiler.NameResolution open Internal.Utilities +open Internal.Utilities.Collections open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Ast @@ -27,6 +28,8 @@ open System.Collections.Generic #if !NO_EXTENSIONTYPING open Microsoft.FSharp.Compiler.ExtensionTyping +open Internal.Utilities.Collections + #endif /// An object that captures the logical context for name resolution. @@ -1663,7 +1666,7 @@ let CheckAllTyparsInferrable amap m item = let freeInArgsAndRetType = accFreeInTypes CollectTyparsNoCaching (pinfo.GetParamTypes(amap,m)) (freeInType CollectTyparsNoCaching (pinfo.GetPropertyType(amap,m))) - let free = Zset.diff freeInDeclaringType.FreeTypars freeInArgsAndRetType.FreeTypars + let free = Set.diff freeInDeclaringType.FreeTypars freeInArgsAndRetType.FreeTypars free.IsEmpty) | Item.MethodGroup(_,minfos,_) -> @@ -1675,7 +1678,7 @@ let CheckAllTyparsInferrable amap m item = List.foldBack (accFreeInTypes CollectTyparsNoCaching) (minfo.GetParamTypes(amap, m, fminst)) (accFreeInTypes CollectTyparsNoCaching (minfo.GetObjArgTypes(amap, m, fminst)) (freeInType CollectTyparsNoCaching (minfo.GetFSharpReturnTy(amap, m, fminst)))) - let free = Zset.diff freeInDeclaringType.FreeTypars freeInArgsAndRetType.FreeTypars + let free = Set.diff freeInDeclaringType.FreeTypars freeInArgsAndRetType.FreeTypars free.IsEmpty) | Item.CtorGroup _ @@ -3509,7 +3512,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso yield einfo.RemoveMethod.DisplayName ] else [] - let suppressedMethNames = Zset.ofList String.order (pinfoMethNames @ einfoMethNames) + let suppressedMethNames = Set.ofList (pinfoMethNames @ einfoMethNames) let pinfos = pinfosIncludingUnseen @@ -4148,7 +4151,7 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( yield einfo.AddMethod.DisplayName yield einfo.RemoveMethod.DisplayName ] - let suppressedMethNames = Zset.ofList String.order (pinfoMethNames @ einfoMethNames) + let suppressedMethNames = Set.ofList (pinfoMethNames @ einfoMethNames) let pinfos = pinfosIncludingUnseen diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index f0964312245..e6c067fdc9d 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -6,6 +6,7 @@ module internal Microsoft.FSharp.Compiler.NicePrint +open Internal.Utilities.Collections open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Internal diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index da19114bcc7..21a481d5c39 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -32,6 +32,7 @@ open Microsoft.FSharp.Compiler.Layout.TaggedTextOps open Microsoft.FSharp.Compiler.TypeRelations open System.Collections.Generic +open Internal.Utilities.Collections #if DEBUG let verboseOptimizationInfo = @@ -330,7 +331,7 @@ type IncrementalOptimizationEnv = { // An identifier to help with name generation latestBoundId: Ident option // The set of lambda IDs we've inlined to reach this point. Helps to prevent recursive inlining - dontInline: Zset + dontInline: Set // Recursively bound vars. If an sub-expression that is a candidate for method splitting // contains any of these variables then don't split it, for fear of mucking up tailcalls. // See FSharp 1.0 bug 2892 @@ -345,7 +346,7 @@ type IncrementalOptimizationEnv = static member Empty = { latestBoundId = None - dontInline = Zset.empty Int64.order + dontInline = Set.empty typarInfos = [] functionVal = None dontSplitVars = ValMap.Empty @@ -2328,12 +2329,15 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = // REVIEW: GenericEqualityIntrinsic (which has no comparer) implements PER semantics (5537: this should be ER semantics) // We are devirtualizing to a Equals(T) method which also implements PER semantics (5537: this should be ER semantics) | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_er_inner_vref ty args -> - + let tyargsOriginal = tyargs let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsValues with | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) - | _ -> None - + | _ -> + // if type of generic argument has no generated equality operators, covert to "FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals" + match cenv.g.fsharpEqualityComparer_ER_Equals_vref.TryDeref with + | ValueNone -> None // referencing old version of FSharp.Core.dll + | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_ER_Equals_vref ty tyargsOriginal args m) // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerFast | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_withc_inner_vref ty args -> @@ -2345,23 +2349,33 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) | _ -> None - // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparer + // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_per_inner_vref ty args && not(isRefTupleTy cenv.g ty) -> + let tyargsOriginal = tyargs let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, _, withcEqualsVal), [x; y] -> let args2 = [x; mkRefTupledNoTypes cenv.g m [mkCoerceExpr(y, cenv.g.obj_ty, m, ty); (mkCallGetGenericPEREqualityComparer cenv.g m)]] Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) - | _ -> None + | _ -> + // if type of generic argument has no generated equality operators, covert to "FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals" + match cenv.g.fsharpEqualityComparer_PER_Equals_vref.TryDeref with + | ValueNone -> None // referencing old version of FSharp.Core.dll + | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_PER_Equals_vref ty tyargsOriginal args m) // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashIntrinsic | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_inner_vref ty args -> + let tyargsOriginal = tyargs let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, withcGetHashCodeVal, _), [x] -> let args2 = [x; mkCallGetGenericEREqualityComparer cenv.g m] Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m) - | _ -> None + | _ -> + // if type of generic argument has no generated equality operators, covert to "FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode" + match cenv.g.fsharpEqualityComparer_GetHashCode_vref.TryDeref with + | ValueNone -> None // referencing old version of FSharp.Core.dll + | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_GetHashCode_vref ty tyargsOriginal args m) // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_withc_inner_vref ty args -> @@ -2416,6 +2430,24 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = match vref with | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) | None -> None + + // "GenericEqualityIntrinsic" when found in a generic context, convert to "FSharpEqualityComparer_PER<'T>.EqualityComparer.Equals" + | Expr.Val(v, _, _), [(TType_var t) as ty], _ when (not cenv.g.compilingFslib) && valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref && t.Rigidity = TyparRigidity.Rigid -> + match cenv.g.fsharpEqualityComparer_PER_Equals_vref.TryDeref with + | ValueNone -> None // referencing old version of FSharp.Core.dll + | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_PER_Equals_vref ty tyargs args m) + + // "GenericEqualityERIntrinsic" when found in a generic context, convert to "FSharpEqualityComparer_ER<'T>.EqualityComparer.Equals" + | Expr.Val(v, _, _), [(TType_var t) as ty], _ when (not cenv.g.compilingFslib) && valRefEq cenv.g v cenv.g.generic_equality_er_inner_vref && t.Rigidity = TyparRigidity.Rigid -> + match cenv.g.fsharpEqualityComparer_ER_Equals_vref.TryDeref with + | ValueNone -> None // referencing old version of FSharp.Core.dll + | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_ER_Equals_vref ty tyargs args m) + + // "GenericHashIntrinsic" when found in a generic context, convert to "FSharpEqualityComparer_PER<'T>.EqualityComparer.GetHashCode" + | Expr.Val(v, _, _), [(TType_var t) as ty], _ when (not cenv.g.compilingFslib) && valRefEq cenv.g v cenv.g.generic_hash_inner_vref && t.Rigidity = TyparRigidity.Rigid -> + match cenv.g.fsharpEqualityComparer_GetHashCode_vref.TryDeref with + | ValueNone -> None // referencing old version of FSharp.Core.dll + | _ -> Some (DevirtualizeApplication cenv env cenv.g.fsharpEqualityComparer_GetHashCode_vref ty tyargs args m) // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_comparison_withc_inner_vref && isRefTupleTy cenv.g ty -> @@ -2497,7 +2529,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) cenv.settings.InlineLambdas () && not finfo.HasEffect && // Don't inline recursively! - not (Zset.contains lambdaId env.dontInline) && + not (Set.contains lambdaId env.dontInline) && (// Check the number of argument groups is enough to saturate the lambdas of the target. (if tyargs |> List.exists (fun t -> match t with TType_measure _ -> false | _ -> true) then 1 else 0) + args.Length = arities && (// Enough args @@ -2559,7 +2591,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) // Inlining: beta reducing let expr' = MakeApplicationAndBetaReduce cenv.g (f2', f2ty, [tyargs], args', m) // Inlining: reoptimizing - Some (OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} expr') + Some (OptimizeExpr cenv {env with dontInline= Set.add lambdaId env.dontInline} expr') | _ -> None @@ -2697,7 +2729,7 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = | None -> CurriedLambdaValue (lambdaId, arities, bsize, expr', ety) | Some baseVal -> let fvs = freeInExpr CollectLocals body' - if fvs.UsesMethodLocalConstructs || fvs.FreeLocals.Contains baseVal then + if fvs.UsesMethodLocalConstructs || (fvs.FreeLocals |> Zset.contains baseVal) then UnknownValue else let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (body', bodyty) @@ -3044,12 +3076,12 @@ and OptimizeModuleExpr cenv env x = not (ValueIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) (bind, binfo)) && // Check the thing is hidden by the signature (if any) - hidden.mhiVals.Contains bind.Var && + (hidden.mhiVals |> Zset.contains bind.Var) && // Check the thing is not compiled as a static field or property, since reflected definitions and other reflective stuff might need it not (IsCompiledAsStaticProperty cenv.g bind.Var)) - let deadSet = Zset.addList (dead |> List.map (fun (bind, _) -> bind.Var)) (Zset.empty valOrder) + let deadSet = Zset.ofList (dead |> List.map (fun (bind, _) -> bind.Var)) // Eliminate dead private bindings from a module type by mutation. Note that the optimizer doesn't // actually copy the entire term - it copies the expression portions of the term and leaves the diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 55fca9c2102..b951479431b 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -24,6 +24,7 @@ open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.PrettyNaming open Microsoft.FSharp.Compiler.InfoReader open Microsoft.FSharp.Compiler.TypeRelations +open Internal.Utilities.Collections //-------------------------------------------------------------------------- // TestHooks - for dumping range to support source transforms diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 9c7bc53e333..d02865def5e 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -219,7 +219,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let idx = cenv.exprSplices.Count let ty = tyOfExpr cenv.g expr - match (freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals |> Seq.tryPick (fun v -> if env.vs.ContainsVal v then Some v else None) with + match (freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals |> Seq.tryPick (fun {CompareObj=v} -> if env.vs.ContainsVal v then Some v else None) with | Some v -> errorR(Error(FSComp.SR.crefBoundVarUsedInSplice(v.DisplayName), v.Range)) | None -> () diff --git a/src/fsharp/SignatureConformance.fs b/src/fsharp/SignatureConformance.fs index 8b0981451ef..a998b5d0132 100644 --- a/src/fsharp/SignatureConformance.fs +++ b/src/fsharp/SignatureConformance.fs @@ -16,6 +16,7 @@ open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Infos +open Internal.Utilities.Collections #if !NO_EXTENSIONTYPING open Microsoft.FSharp.Compiler.ExtensionTyping @@ -435,11 +436,11 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = and checkTypeRepr m aenv (implTycon:Tycon) sigTypeRepr = let reportNiceError k s1 s2 = - let aset = NameSet.ofList s1 - let fset = NameSet.ofList s2 - match Zset.elements (Zset.diff aset fset) with + let aset = Set.ofList s1 + let fset = Set.ofList s2 + match Set.toList (Set.diff aset fset) with | [] -> - match Zset.elements (Zset.diff fset aset) with + match Set.toList (Set.diff fset aset) with | [] -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNumbersDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k),m)); false) | l -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureDefinesButImplDoesNot(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k, String.concat ";" l),m)); false) | l -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesButSignatureDoesNot(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k, String.concat ";" l),m)); false) diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index db888dd8f9c..9c290ddd64a 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -5,6 +5,7 @@ module internal Microsoft.FSharp.Compiler.Tastops open System.Collections.Generic open Internal.Utilities +open Internal.Utilities.Collections open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX @@ -1018,27 +1019,6 @@ let rec getErasedTypes g ty = | TType_measure _ -> [ty] - -//--------------------------------------------------------------------------- -// Standard orderings, e.g. for order set/map keys -//--------------------------------------------------------------------------- - -let valOrder = { new IComparer with member __.Compare(v1, v2) = compare v1.Stamp v2.Stamp } -let tyconOrder = { new IComparer with member __.Compare(tc1, tc2) = compare tc1.Stamp tc2.Stamp } -let recdFieldRefOrder = - { new IComparer with - member __.Compare(RFRef(tcref1, nm1), RFRef(tcref2, nm2)) = - let c = tyconOrder.Compare (tcref1.Deref, tcref2.Deref) - if c <> 0 then c else - compare nm1 nm2 } - -let unionCaseRefOrder = - { new IComparer with - member __.Compare(UCRef(tcref1, nm1), UCRef(tcref2, nm2)) = - let c = tyconOrder.Compare (tcref1.Deref, tcref2.Deref) - if c <> 0 then c else - compare nm1 nm2 } - //--------------------------------------------------------------------------- // Make some common types //--------------------------------------------------------------------------- @@ -1834,39 +1814,11 @@ let ValRefIsExplicitImpl g (vref:ValRef) = ValIsExplicitImpl g vref.Deref // an equation assigned by type inference. //--------------------------------------------------------------------------- -let emptyFreeLocals = Zset.empty valOrder -let unionFreeLocals s1 s2 = - if s1 === emptyFreeLocals then s2 - elif s2 === emptyFreeLocals then s1 - else Zset.union s1 s2 - -let emptyFreeRecdFields = Zset.empty recdFieldRefOrder -let unionFreeRecdFields s1 s2 = - if s1 === emptyFreeRecdFields then s2 - elif s2 === emptyFreeRecdFields then s1 - else Zset.union s1 s2 - -let emptyFreeUnionCases = Zset.empty unionCaseRefOrder -let unionFreeUnionCases s1 s2 = - if s1 === emptyFreeUnionCases then s2 - elif s2 === emptyFreeUnionCases then s1 - else Zset.union s1 s2 - -let emptyFreeTycons = Zset.empty tyconOrder -let unionFreeTycons s1 s2 = - if s1 === emptyFreeTycons then s2 - elif s2 === emptyFreeTycons then s1 - else Zset.union s1 s2 - -let typarOrder = - { new System.Collections.Generic.IComparer with - member x.Compare (v1:Typar, v2:Typar) = compare v1.Stamp v2.Stamp } - -let emptyFreeTypars = Zset.empty typarOrder -let unionFreeTypars s1 s2 = - if s1 === emptyFreeTypars then s2 - elif s2 === emptyFreeTypars then s1 - else Zset.union s1 s2 +let emptyFreeLocals = Zset.empty () +let emptyFreeRecdFields = Zset.empty () +let emptyFreeUnionCases = Zset.empty () +let emptyFreeTycons = Zset.empty () +let emptyFreeTypars = Zset.empty () let emptyFreeTyvars = { FreeTycons = emptyFreeTycons @@ -1881,9 +1833,9 @@ let isEmptyFreeTyvars ftyvs = let unionFreeTyvars fvs1 fvs2 = if fvs1 === emptyFreeTyvars then fvs2 else if fvs2 === emptyFreeTyvars then fvs1 else - { FreeTycons = unionFreeTycons fvs1.FreeTycons fvs2.FreeTycons - FreeTraitSolutions = unionFreeLocals fvs1.FreeTraitSolutions fvs2.FreeTraitSolutions - FreeTypars = unionFreeTypars fvs1.FreeTypars fvs2.FreeTypars } + { FreeTycons = Set.union fvs1.FreeTycons fvs2.FreeTycons + FreeTraitSolutions = Set.union fvs1.FreeTraitSolutions fvs2.FreeTraitSolutions + FreeTypars = Set.union fvs1.FreeTypars fvs2.FreeTypars } type FreeVarOptions = { canCache: bool @@ -2526,31 +2478,31 @@ module SimplifyTypes = | TType_measure _ -> z let incM x m = - if Zmap.mem x m then Zmap.add x (1 + Zmap.find x m) m + if Zmap.containsKey x m then Zmap.add x (1 + Zmap.find x m) m else Zmap.add x 1 m let accTyparCounts z ty = // Walk type to determine typars and their counts (for pprinting decisions) foldTypeButNotConstraints (fun z ty -> match ty with | TType_var tp when tp.Rigidity = TyparRigidity.Rigid -> incM tp z | _ -> z) z ty - let emptyTyparCounts = Zmap.empty typarOrder + let emptyTyparCounts = Zmap.empty () // print multiple fragments of the same type using consistent naming and formatting let accTyparCountsMulti acc l = List.fold accTyparCounts acc l type TypeSimplificationInfo = - { singletons : Typar Zset - inplaceConstraints : Zmap + { singletons : zset + inplaceConstraints : zmap postfixConstraints : (Typar * TyparConstraint) list } let typeSimplificationInfo0 = - { singletons = Zset.empty typarOrder - inplaceConstraints = Zmap.empty typarOrder + { singletons = Zset.empty () + inplaceConstraints = Zmap.empty () postfixConstraints = [] } let categorizeConstraints simplify m cxs = let singletons = if simplify then Zmap.chooseL (fun tp n -> if n = 1 then Some tp else None) m else [] - let singletons = Zset.addList singletons (Zset.empty typarOrder) + let singletons = Zset.ofList singletons // Here, singletons are typars that occur once in the type. // However, they may also occur in a type constraint. // If they do, they are really multiple occurrence - so we should remove them. @@ -2567,7 +2519,7 @@ module SimplifyTypes = let inplace = inplace |> List.map (function (tp, TyparConstraint.CoercesTo(ty, _)) -> tp, ty | _ -> failwith "not isTTyparCoercesToType") { singletons = singletons - inplaceConstraints = Zmap.ofList typarOrder inplace + inplaceConstraints = Zmap.ofList inplace postfixConstraints = postfix } let CollectInfo simplify tys cxs = categorizeConstraints simplify (accTyparCountsMulti emptyTyparCounts tys) cxs @@ -3816,18 +3768,18 @@ type SignatureRepackageInfo = static member Empty = { mrpiVals = []; mrpiEntities= [] } type SignatureHidingInfo = - { mhiTycons : Zset; - mhiTyconReprs : Zset; - mhiVals : Zset; - mhiRecdFields : Zset; - mhiUnionCases : Zset } + { mhiTycons : zset; + mhiTyconReprs : zset; + mhiVals : zset + mhiRecdFields : zset; + mhiUnionCases : zset } static member Empty = - { mhiTycons = Zset.empty tyconOrder; - mhiTyconReprs = Zset.empty tyconOrder; - mhiVals = Zset.empty valOrder; - mhiRecdFields = Zset.empty recdFieldRefOrder; - mhiUnionCases = Zset.empty unionCaseRefOrder } + { mhiTycons = Zset.empty () + mhiTyconReprs = Zset.empty () + mhiVals = Zset.empty () + mhiRecdFields = Zset.empty () + mhiUnionCases = Zset.empty () } let addValRemap v v' tmenv = { tmenv with valRemap= tmenv.valRemap.Add v (mkLocalValRef v') } @@ -4062,7 +4014,7 @@ let ComputeHidingInfoAtAssemblyBoundary mty acc = //-------------------------------------------------------------------------- // Compute instances of the above for mexpr -> mty //-------------------------------------------------------------------------- - + let IsHidden setF accessF remapF debugF = let rec check mrmi x = if verbose then dprintf "IsHidden %s ??\n" (showL (debugF x)); @@ -4160,13 +4112,13 @@ let emptyFreeVars = let unionFreeVars fvs1 fvs2 = if fvs1 === emptyFreeVars then fvs2 else if fvs2 === emptyFreeVars then fvs1 else - { FreeLocals = unionFreeLocals fvs1.FreeLocals fvs2.FreeLocals; + { FreeLocals = Set.union fvs1.FreeLocals fvs2.FreeLocals; FreeTyvars = unionFreeTyvars fvs1.FreeTyvars fvs2.FreeTyvars; UsesMethodLocalConstructs = fvs1.UsesMethodLocalConstructs || fvs2.UsesMethodLocalConstructs; UsesUnboundRethrow = fvs1.UsesUnboundRethrow || fvs2.UsesUnboundRethrow; - FreeLocalTyconReprs = unionFreeTycons fvs1.FreeLocalTyconReprs fvs2.FreeLocalTyconReprs; - FreeRecdFields = unionFreeRecdFields fvs1.FreeRecdFields fvs2.FreeRecdFields; - FreeUnionCases = unionFreeUnionCases fvs1.FreeUnionCases fvs2.FreeUnionCases; } + FreeLocalTyconReprs = Set.union fvs1.FreeLocalTyconReprs fvs2.FreeLocalTyconReprs; + FreeRecdFields = Set.union fvs1.FreeRecdFields fvs2.FreeRecdFields; + FreeUnionCases = Set.union fvs1.FreeUnionCases fvs2.FreeUnionCases; } let inline accFreeTyvars (opts:FreeVarOptions) f v acc = if not opts.collectInTypes then acc else @@ -7731,14 +7683,14 @@ type PrettyNaming.ActivePatternInfo with // not by their argument types. let doesActivePatternHaveFreeTypars g (v:ValRef) = let vty = v.TauType - let vtps = v.Typars |> Zset.ofList typarOrder + let vtps = v.Typars |> Zset.ofList if not (isFunTy g v.TauType) then errorR(Error(FSComp.SR.activePatternIdentIsNotFunctionTyped(v.LogicalName), v.Range)) let argtys, resty = stripFunTy g vty let argtps, restps= (freeInTypes CollectTypars argtys).FreeTypars, (freeInType CollectTypars resty).FreeTypars // Error if an active pattern is generic in type variables that only occur in the result Choice<_, ...>. // Note: The test restricts to v.Typars since typars from the closure are considered fixed. - not (Zset.isEmpty (Zset.inter (Zset.diff restps argtps) vtps)) + not (Zset.isEmpty (Zset.inter (Set.diff restps argtps) vtps)) //--------------------------------------------------------------------------- // RewriteExpr: rewrite bottom up with interceptors diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index d2a532c37a9..140342e2fad 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -6,6 +6,7 @@ module internal Microsoft.FSharp.Compiler.Tastops open System.Text open System.Collections.Generic open Internal.Utilities +open Internal.Utilities.Collections open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Internal @@ -374,15 +375,6 @@ type TyconRefMultiMap<'T> = static member OfList : (TyconRef * 'T) list -> TyconRefMultiMap<'T> -//------------------------------------------------------------------------- -// Orderings on Tycon, Val, RecdFieldRef, Typar -//------------------------------------------------------------------------- - -val valOrder : IComparer -val tyconOrder : IComparer -val recdFieldRefOrder : IComparer -val typarOrder : IComparer - //------------------------------------------------------------------------- // Equality on Tycon and Val //------------------------------------------------------------------------- @@ -558,17 +550,14 @@ val applyTys : TcGlobals -> TType -> TType list * 'T list -> TType //------------------------------------------------------------------------- val emptyFreeTypars : FreeTypars -val unionFreeTypars : FreeTypars -> FreeTypars -> FreeTypars val emptyFreeTycons : FreeTycons -val unionFreeTycons : FreeTycons -> FreeTycons -> FreeTycons val emptyFreeTyvars : FreeTyvars val isEmptyFreeTyvars : FreeTyvars -> bool val unionFreeTyvars : FreeTyvars -> FreeTyvars -> FreeTyvars val emptyFreeLocals : FreeLocals -val unionFreeLocals : FreeLocals -> FreeLocals -> FreeLocals type FreeVarOptions @@ -752,8 +741,8 @@ val prefixOfRigidTypar : Typar -> string /// Utilities used in simplifying types for visual presentation module SimplifyTypes = type TypeSimplificationInfo = - { singletons : Typar Zset; - inplaceConstraints : Zmap; + { singletons : zset + inplaceConstraints : zmap postfixConstraints : TyparConstraintsWithTypars; } val typeSimplificationInfo0 : TypeSimplificationInfo val CollectInfo : bool -> TType list -> TyparConstraintsWithTypars -> TypeSimplificationInfo @@ -857,11 +846,11 @@ type SignatureRepackageInfo = static member Empty : SignatureRepackageInfo type SignatureHidingInfo = - { mhiTycons : Zset; - mhiTyconReprs : Zset; - mhiVals : Zset; - mhiRecdFields : Zset; - mhiUnionCases : Zset } + { mhiTycons : zset + mhiTyconReprs : zset + mhiVals : zset + mhiRecdFields : zset + mhiUnionCases : zset } static member Empty : SignatureHidingInfo val ComputeRemappingFromInferredSignatureToExplicitSignature : TcGlobals -> ModuleOrNamespaceType -> ModuleOrNamespaceType -> SignatureRepackageInfo * SignatureHidingInfo diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index d6fb7cd3c73..70ff2912bfb 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -583,6 +583,10 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let v_generic_comparison_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericComparisonIntrinsic" , None , None , [vara], mk_compare_sig varaTy) let v_generic_comparison_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericComparisonWithComparerIntrinsic", None , None , [vara], mk_compare_withc_sig varaTy) + let v_FSharpEqualityComparer_PER_Equals_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FSharpEqualityComparer_PER_Equals" , None , None , [vara], mk_rel_sig varaTy) + let v_FSharpEqualityComparer_GetHashCode_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FSharpEqualityComparer_GetHashCode", None , None , [vara], mk_hash_sig varaTy) + let v_FSharpEqualityComparer_ER_Equals_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FSharpEqualityComparer_ER_Equals" , None , None , [vara], mk_rel_sig varaTy) + let v_generic_hash_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericHashIntrinsic" , None , None , [vara], mk_hash_sig varaTy) let v_generic_hash_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericHashWithComparerIntrinsic" , None , None , [vara], mk_hash_withc_sig varaTy) @@ -1220,6 +1224,9 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member __.generic_hash_withc_outer_info = v_generic_hash_withc_outer_info member val generic_hash_inner_vref = ValRefForIntrinsic v_generic_hash_inner_info member val generic_hash_withc_inner_vref = ValRefForIntrinsic v_generic_hash_withc_inner_info + member val fsharpEqualityComparer_ER_Equals_vref = ValRefForIntrinsic v_FSharpEqualityComparer_ER_Equals_info + member val fsharpEqualityComparer_PER_Equals_vref = ValRefForIntrinsic v_FSharpEqualityComparer_PER_Equals_info + member val fsharpEqualityComparer_GetHashCode_vref = ValRefForIntrinsic v_FSharpEqualityComparer_GetHashCode_info member val reference_equality_inner_vref = ValRefForIntrinsic v_reference_equality_inner_info diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 658baff82f4..153c66ebe2f 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -8,6 +8,7 @@ open System open System.Collections.Generic open Internal.Utilities +open Internal.Utilities.Collections open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL @@ -2062,7 +2063,7 @@ module GeneralizationHelpers = for ftp in ftps do acc.Add(ftp) - Zset.Create(typarOrder, acc) + acc |> Set.ofSeq let ComputeUnabstractableTycons env = @@ -2071,7 +2072,7 @@ module GeneralizationHelpers = if item.WillNeverHaveFreeTypars then item.CachedFreeLocalTycons else let ftyvs = item.GetFreeTyvars() ftyvs.FreeTycons - if ftycs.IsEmpty then acc else unionFreeTycons ftycs acc + if ftycs.IsEmpty then acc else Set.union ftycs acc List.fold acc_in_free_item emptyFreeTycons env.eUngeneralizableItems @@ -2081,7 +2082,7 @@ module GeneralizationHelpers = if item.WillNeverHaveFreeTypars then item.CachedFreeTraitSolutions else let ftyvs = item.GetFreeTyvars() ftyvs.FreeTraitSolutions - if ftycs.IsEmpty then acc else unionFreeLocals ftycs acc + if ftycs.IsEmpty then acc else Set.union ftycs acc List.fold acc_in_free_item emptyFreeLocals env.eUngeneralizableItems @@ -2166,7 +2167,7 @@ module GeneralizationHelpers = generalizedTypars, freeInEnv else let freeInEnv = - unionFreeTypars + Set.union (accFreeInTypars CollectAllNoCaching ungeneralizableTypars1 (accFreeInTypars CollectAllNoCaching ungeneralizableTypars2 (accFreeInTypars CollectAllNoCaching ungeneralizableTypars3 emptyFreeTyvars))).FreeTypars @@ -6365,13 +6366,13 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = error(Error(FSComp.SR.tcFieldRequiresAssignment(fspec.rfield_id.idText, fullDisplayTextOfTyconRef tcref), m))) // Other checks (overlap with above check now clear) - let ns1 = NameSet.ofList (List.map fst fldsList) - let ns2 = NameSet.ofList (List.map (fun x -> x.rfield_id.idText) fspecs) + let ns1 = Set.ofList (List.map fst fldsList) + let ns2 = Set.ofList (List.map (fun x -> x.rfield_id.idText) fspecs) - if Option.isNone optOrigExpr && not (Zset.subset ns2 ns1) then - error (MissingFields(Zset.elements (Zset.diff ns2 ns1), m)) + if Option.isNone optOrigExpr && not (Set.isSubset ns2 ns1) then + error (MissingFields(Set.toList (Set.diff ns2 ns1), m)) - if not (Zset.subset ns1 ns2) then + if not (Set.isSubset ns1 ns2) then error (Error(FSComp.SR.tcExtraneousFieldsGivenValues(), m)) // Build record @@ -11587,14 +11588,14 @@ and TcIncrementalLetRecGeneralization cenv scopem //printfn "(failed generalization test 1 for binding for %s)" pgrbind.RecBindingInfo.Val.DisplayName // Any declared type parameters in an type are always generalizable - let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) + let freeInBinding = Set.diff freeInBinding (Zset.ofList (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) if freeInBinding.IsEmpty then true else //printfn "(failed generalization test 2 for binding for %s)" pgrbind.RecBindingInfo.Val.DisplayName // Any declared method parameters can always be generalized - let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.RecBindingInfo.DeclaredTypars)) + let freeInBinding = Set.diff freeInBinding (Zset.ofList (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.RecBindingInfo.DeclaredTypars)) if freeInBinding.IsEmpty then true else @@ -11602,7 +11603,7 @@ and TcIncrementalLetRecGeneralization cenv scopem // Type variables free in the non-recursive environment do not stop us generalizing the binding, // since they can't be generalized anyway - let freeInBinding = Zset.diff freeInBinding freeInEnv + let freeInBinding = Set.diff freeInBinding freeInEnv if freeInBinding.IsEmpty then true else @@ -11650,9 +11651,9 @@ and TcIncrementalLetRecGeneralization cenv scopem freeInEnv else let freeInBinding = (freeInType CollectAllNoCaching pgrbind.RecBindingInfo.Val.TauType).FreeTypars - let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) - let freeInBinding = Zset.diff freeInBinding (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.RecBindingInfo.DeclaredTypars)) - Zset.union freeInBinding freeInEnv) + let freeInBinding = Set.diff freeInBinding (Zset.ofList (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) + let freeInBinding = Set.diff freeInBinding (Zset.ofList (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.RecBindingInfo.DeclaredTypars)) + Set.union freeInBinding freeInEnv) // Process the bindings marked for transition from PreGeneralization --> PostGeneralization let newGeneralizedRecBinds, tpenv = @@ -11685,7 +11686,7 @@ and TcIncrementalLetRecGeneralization cenv scopem /// Compute the type variables which may be generalized and perform the generalization and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgrbind : PreGeneralizationRecursiveBinding) = - let freeInEnv = Zset.diff freeInEnv (Zset.ofList typarOrder (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) + let freeInEnv = Set.diff freeInEnv (Zset.ofList (NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g pgrbind.ExtraGeneralizableTypars)) let rbinfo = pgrbind.RecBindingInfo let vspec = rbinfo.Val @@ -12419,15 +12420,15 @@ module IncrClassChecking = TakenFieldNames:Set RepInfoTcGlobals:TcGlobals /// vals mapped to representations - ValReprs : Zmap + ValReprs : zmap /// vals represented as fields or members from this point on - ValsWithRepresentation : Zset } + ValsWithRepresentation : zset } static member Empty(g, names) = { TakenFieldNames=Set.ofList names RepInfoTcGlobals=g - ValReprs = Zmap.empty valOrder - ValsWithRepresentation = Zset.empty valOrder } + ValReprs = Zmap.empty () + ValsWithRepresentation = Zset.empty () } /// Find the representation of a value member localRep.LookupRepr (v:Val) = @@ -12490,7 +12491,7 @@ module IncrClassChecking = // All struct variables are forced into fields. Structs may not contain "let" bindings, so no new variables can be // introduced. - if v.IsMutable || relevantForcedFieldVars.Contains v || tcref.IsStructOrEnumTycon then + if v.IsMutable || (relevantForcedFieldVars |> Zset.contains v) || tcref.IsStructOrEnumTycon then //dprintfn "Representing %s as a field %s" v.LogicalName name let rfref = RFRef(tcref, name) reportIfUnused() @@ -12550,7 +12551,7 @@ module IncrClassChecking = {localRep with ValsWithRepresentation = Zset.add v localRep.ValsWithRepresentation} member localRep.IsValWithRepresentation (v:Val) = - localRep.ValsWithRepresentation.Contains(v) + localRep.ValsWithRepresentation |> Zset.contains v member localRep.IsValRepresentedAsLocalVar (v:Val) = match localRep.LookupRepr v with @@ -12629,7 +12630,7 @@ module IncrClassChecking = member localRep.PublishIncrClassFields (cenv, denv, cpath, ctorInfo:IncrClassCtorLhs, safeStaticInitInfo) = let tcref = ctorInfo.TyconRef let rfspecs = - [ for KeyValue(v, repr) in localRep.ValReprs do + [ for KeyValue({CompareObj=v}, repr) in localRep.ValReprs do match repr with | InField(isStatic, _, rfref) -> // Instance fields for structs are published earlier because the full set of fields is determined syntactically from the implicit @@ -13874,9 +13875,9 @@ module MutRecBindingChecking = unsolvedTypars |> List.filter (fun tp -> let freeInTypar = (freeInType CollectAllNoCaching (mkTyparTy tp)).FreeTypars // Check it is not one of the generalized variables... - not (genSet.Contains tp) && + not (genSet |> Zset.contains tp) && // Check it involves a generalized variable in one of its constraints... - freeInTypar.Exists(fun otherTypar -> genSet.Contains otherTypar)) + freeInTypar |> Zset.exists (fun otherTypar -> genSet |> Zset.contains otherTypar)) //printfn "unsolvedTyparsInvolvingGeneralizedVariables.Length = %d" unsolvedTyparsInvolvingGeneralizedVariables.Length //for x in unsolvedTypars do // printfn "unsolvedTyparsInvolvingGeneralizedVariable : %s #%d" x.DisplayName x.Stamp @@ -15978,7 +15979,7 @@ module TcDeclarations = else let isInSameModuleOrNamespace = match envForDecls.eModuleOrNamespaceTypeAccumulator.Value.TypesByMangledName.TryFind(tcref.LogicalName) with - | Some tycon -> (tyconOrder.Compare(tcref.Deref, tycon) = 0) + | Some tycon -> (TyconOrder.Compare tcref.Deref tycon) = 0 | None -> //false // There is a special case we allow when compiling FSharp.Core.dll which permits interface implementations across namespace fragments diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs index 43944d7a92f..5fead660a3f 100755 --- a/src/fsharp/TypeRelations.fs +++ b/src/fsharp/TypeRelations.fs @@ -12,6 +12,7 @@ open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.PrettyNaming +open Internal.Utilities.Collections //------------------------------------------------------------------------- // a :> b without coercion based on finalized (no type variable) types diff --git a/src/fsharp/autobox.fs b/src/fsharp/autobox.fs index 4c929e006ce..f403d840256 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/autobox.fs @@ -10,6 +10,7 @@ open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.TypeRelations +open Internal.Utilities.Collections //---------------------------------------------------------------------------- // Decide the set of mutable locals to promote to heap-allocated reference cells @@ -84,7 +85,7 @@ let DecideExpr cenv exprF z expr = let CheckMethod z (TObjExprMethod(_, _attribs, _tps, vs, body, _m)) = let vs = List.concat vs let syntacticArgs = (match baseValOpt with Some x -> x:: vs | None -> vs) - let z = Zset.union z (DecideEscapes syntacticArgs body) + let z = Set.union z (DecideEscapes syntacticArgs body) exprF z body let CheckMethods z l = (z, l) ||> List.fold CheckMethod @@ -167,14 +168,16 @@ let TransformBinding g (nvs: ValMap<_>) exprF (TBind(v, expr, m)) = /// Rewrite mutable locals to reference cells across an entire implementation file let TransformImplFile g amap implFile = let fvs = DecideImplFile g amap implFile - if Zset.isEmpty fvs then + if Set.isEmpty fvs then implFile else for fv in fvs do + let fv = fv.CompareObj warning (Error(FSComp.SR.abImplicitHeapAllocation(fv.DisplayName), fv.Range)) let nvs = [ for fv in fvs do + let fv = fv.CompareObj let nty = mkRefCellTy g fv.Type let nv, nve = if fv.IsCompilerGenerated then mkCompGenLocal fv.Range fv.LogicalName nty diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 3d5e854aff8..16f48f195ed 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -74,9 +74,6 @@ module Filename = module Bool = let order = LanguagePrimitives.FastGenericComparer -module Int32 = - let order = LanguagePrimitives.FastGenericComparer - module Int64 = let order = LanguagePrimitives.FastGenericComparer @@ -88,17 +85,9 @@ module Pair = if res1 <> 0 then res1 else compare2.Compare (a2, aa2) } -type NameSet = Zset -[] -module NameSet = - let ofList l : NameSet = List.foldBack Zset.add l (Zset.empty String.order) - [] module NameMap = - let domain m = Map.foldBack (fun x _ acc -> Zset.add x acc) m (Zset.empty String.order) - let domainL m = Zset.elements (domain m) - - + let domainL (m:Map<_,_>) = (m, []) ||> Map.foldBack (fun k _ acc -> k :: acc) //--------------------------------------------------------------------------- // Library: Pre\Post checks @@ -133,24 +122,6 @@ module Check = if s.Length = 0 then raise (new System.ArgumentNullException(argname)) -//------------------------------------------------------------------------- -// Library -//------------------------------------------------------------------------ - -type IntMap<'T> = Zmap -module IntMap = - let empty () = Zmap.empty Int32.order - - let add k v (t:IntMap<'T>) = Zmap.add k v t - let find k (t:IntMap<'T>) = Zmap.find k t - let tryFind k (t:IntMap<'T>) = Zmap.tryFind k t - let remove k (t:IntMap<'T>) = Zmap.remove k t - let mem k (t:IntMap<'T>) = Zmap.mem k t - let iter f (t:IntMap<'T>) = Zmap.iter f t - let map f (t:IntMap<'T>) = Zmap.map f t - let fold f (t:IntMap<'T>) z = Zmap.fold f t z - - //------------------------------------------------------------------------- // Library: generalized association lists //------------------------------------------------------------------------ @@ -277,36 +248,6 @@ let mapTriple (f1,f2,f3) (a1,a2,a3) = (f1 a1, f2 a2, f3 a3) let mapQuadruple (f1,f2,f3,f4) (a1,a2,a3,a4) = (f1 a1, f2 a2, f3 a3, f4 a4) let fmap2Of2 f z (a1,a2) = let z,a2 = f z a2 in z,(a1,a2) -module List = - let noRepeats xOrder xs = - let s = Zset.addList xs (Zset.empty xOrder) // build set - Zset.elements s // get elements... no repeats - -//--------------------------------------------------------------------------- -// Zmap rebinds -//------------------------------------------------------------------------- - -module Zmap = - let force k mp = match Zmap.tryFind k mp with Some x -> x | None -> failwith "Zmap.force: lookup failed" - - let mapKey key f mp = - match f (Zmap.tryFind key mp) with - | Some fx -> Zmap.add key fx mp - | None -> Zmap.remove key mp - -//--------------------------------------------------------------------------- -// Zset -//------------------------------------------------------------------------- - -module Zset = - let ofList order xs = Zset.addList xs (Zset.empty order) - - // CLEANUP NOTE: move to Zset? - let rec fixpoint f (s as s0) = - let s = f s - if Zset.equal s s0 then s0 (* fixed *) - else fixpoint f s (* iterate *) - //--------------------------------------------------------------------------- // Misc //------------------------------------------------------------------------- diff --git a/src/fsharp/range.fs b/src/fsharp/range.fs index 8649b700867..b4fc973e168 100755 --- a/src/fsharp/range.fs +++ b/src/fsharp/range.fs @@ -197,6 +197,9 @@ let mkRange f b e = let mkFileIndexRange fi b e = range (fi, b, e) (* end representation, start derived ops *) + +module Int32 = + let order = LanguagePrimitives.FastGenericComparer let posOrder = Order.orderOn (fun (p:pos) -> p.Line, p.Column) (Pair.order (Int32.order, Int32.order)) (* rangeOrder: not a total order, but enough to sort on ranges *) diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 68bdcae2f53..ce3017c7b01 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -999,7 +999,7 @@ and FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = match other with | :? FSharpField as uc -> match d, uc.V with - | RecdOrClass r1, RecdOrClass r2 -> recdFieldRefOrder.Compare(r1, r2) = 0 + | RecdOrClass r1, RecdOrClass r2 -> (RecdFieldRefOrder.Compare r1 r2) = 0 | Union (u1, n1), Union (u2, n2) -> cenv.g.unionCaseRefEq u1 u2 && n1 = n2 | _ -> false | _ -> false diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index ffef5fc82b0..740194c8568 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -1934,6 +1934,31 @@ and [] and ModuleOrNamespace = Entity and Tycon = Entity +and [] TyconOrder = + static member inline Compare (v1:Tycon) (v2:Tycon) = + v1.Stamp.CompareTo v2.Stamp + + interface IComparer with + member __.Compare(v1, v2) = + TyconOrder.Compare v1 v2 + +and [] RecdFieldRefOrder = + static member Compare (RFRef(tcref1, nm1)) (RFRef(tcref2, nm2)) = + let c = TyconOrder.Compare tcref1.Deref tcref2.Deref + if c <> 0 then c else + compare nm1 nm2 + + interface IComparer with + member __.Compare (lhs, rhs) = RecdFieldRefOrder.Compare lhs rhs + +and [] UnionCaseRefOrder = + interface IComparer with + member __.Compare(UCRef(tcref1, nm1), UCRef(tcref2, nm2)) = + let c = TyconOrder.Compare tcref1.Deref tcref2.Deref + if c <> 0 then c else + compare nm1 nm2 + + /// A set of static methods for constructing types. and Construct = @@ -2279,6 +2304,11 @@ and override x.ToString() = x.Name +and [] TyparOrder = + interface IComparer with + member __.Compare(v1: Typar, v2: Typar): int = + v1.Stamp.CompareTo v2.Stamp + and [] TyparConstraint = @@ -2962,7 +2992,14 @@ and [] member x.DebugText = x.ToString() override x.ToString() = x.LogicalName - + +and [] ValOrder = + static member inline Compare (v1:Val) (v2:Val) = + v1.Stamp.CompareTo v2.Stamp + + interface IComparer with + member __.Compare(v1, v2) = + ValOrder.Compare v1 v2 and /// Represents the extra information stored for a member @@ -4961,21 +4998,21 @@ and //--------------------------------------------------------------------------- /// Represents a set of free local values. -and FreeLocals = Zset +and FreeLocals = Internal.Utilities.Collections.zset /// Represents a set of free type parameters -and FreeTypars = Zset +and FreeTypars = Internal.Utilities.Collections.zset /// Represents a set of 'free' named type definitions. Used to collect the named type definitions referred to /// from a type or expression. -and FreeTycons = Zset +and FreeTycons = Internal.Utilities.Collections.zset /// Represents a set of 'free' record field definitions. Used to collect the record field definitions referred to /// from an expression. -and FreeRecdFields = Zset +and FreeRecdFields = Internal.Utilities.Collections.zset /// Represents a set of 'free' union cases. Used to collect the union cases referred to from an expression. -and FreeUnionCases = Zset +and FreeUnionCases = Internal.Utilities.Collections.zset /// Represents a set of 'free' type-related elements, including named types, trait solutions, union cases and /// record fields. diff --git a/src/utils/SortKey.fs b/src/utils/SortKey.fs new file mode 100644 index 00000000000..52a1b943786 --- /dev/null +++ b/src/utils/SortKey.fs @@ -0,0 +1,161 @@ +namespace Internal.Utilities.Collections + +open System +open System.Collections.Generic + +[] +type SortKey<'Key, 'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> = { + CompareObj : 'Key +} +with + interface IComparable> with + member lhs.CompareTo (rhs:SortKey<'Key, 'Comparer>): int = + Unchecked.defaultof<'Comparer>.Compare(lhs.CompareObj, rhs.CompareObj) + + static member fail () = failwith "Invalid logic. No method other than IComparable<_>.CompareTo is valid for SortKey" + override __.GetHashCode () = SortKey<'Key,'Comparer>.fail () + override __.Equals _ = SortKey<'Key,'Comparer>.fail () + +#if THIS_SHOULD_JUST_THROW_AN_EXCEPTION + interface IComparable with member __.CompareTo _ = SortKey<'Key,'Comparer>.fail () +#else + // tests run with an old version of FSharp.Core that doesn't using the non-boxing IComparable + interface IComparable with + member lhs.CompareTo rhs = + Unchecked.defaultof<'Comparer>.Compare(lhs.CompareObj, (rhs:?>SortKey<'Key,'Comparer>).CompareObj) +#endif + +type zmap<'Key,'Comparer,'Value when 'Comparer :> IComparer<'Key> and 'Comparer : struct> = Map,'Value> + +[] +type Zmap<'Key,'Value>() = + static member empty<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct>() : zmap<'Key,'Comparer,'Value> = + Map.empty, 'Value> + + static member ofList<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> lst : zmap<'Key,'Comparer,'Value> = + lst + |> List.map (fun (k,v) -> {CompareObj=k},v) + |> Map.ofList + + static member inline chooseL<'Comparer, 'U when 'Comparer :> IComparer<'Key> and 'Comparer : struct> f (m:zmap<'Key,'Comparer,'Value>) = + Map.foldBack (fun k v (s:list<'U>) -> match f k.CompareObj v with None -> s | Some x -> x::s) m [] + + static member inline tryFind<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (k:'Key) (m:zmap<'Key,'Comparer,'Value>) = + Map.tryFind {CompareObj=k} m + + static member inline containsKey<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (k:'Key) (m:zmap<'Key,'Comparer,'Value>) = + Map.containsKey {CompareObj=k} m + + static member inline memberOf<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (m:zmap<'Key,'Comparer,'Value>) (k:'Key) = + Map.containsKey {CompareObj=k} m + + static member inline add<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (k:'Key) (v:'Value) (m:zmap<'Key,'Comparer,'Value>) = + Map.add {CompareObj=k} v m + + static member inline find<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (k:'Key) (m:zmap<'Key,'Comparer,'Value>) = + Map.find {CompareObj=k} m + + static member inline foldBack<'Comparer, 'State when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (folder:'Key->'Value->'State->'State) (m:zmap<'Key,'Comparer,'Value>) (state:'State) : 'State = + Map.foldBack (fun {CompareObj=k} t s -> folder k t s) m state + + static member inline remove<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (k:'Key) (m:zmap<'Key,'Comparer,'Value>) = + Map.remove {CompareObj=k} m + + static member inline keys<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (m:zmap<'Key,'Comparer,'Value>) = + Map.foldBack (fun {CompareObj=k} _ s -> k::s) m [] + + static member inline values<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (m:zmap<'Key,'Comparer,'Value>) = + Map.foldBack (fun _ v s -> v::s) m [] + + static member inline toList<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (m:zmap<'Key,'Comparer,'Value>) = + Map.foldBack (fun {CompareObj=k} v acc -> (k,v) :: acc) m [] + + static member inline iter<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (f:'Key->'Value->unit) (m:zmap<'Key,'Comparer,'Value>) = + Map.iter (fun {CompareObj=k} v -> f k v) m + + static member foldBackMap<'Comparer, 'State, 'U when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (folder:'State->'Key->'Value->'State*'U) (initialState:'State) (initialMap:zmap<'Key,'Comparer,'Value>) : 'State * zmap<'Key,'Comparer,'U> = + let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt folder + let struct (finalState, finalMap) = + (initialMap, struct (initialState, Zmap.empty<'Comparer> ())) + ||> Map.foldBack (fun {CompareObj=k} v struct (acc, m) -> + let acc', v' = f.Invoke (acc, k, v) + let m' = Map.add {CompareObj=k} v' m + struct (acc', m')) + finalState, finalMap + +module Set = + let diff a b = + if Set.isEmpty a || Set.isEmpty b then a + else Set.fold (fun a k -> Set.remove k a) a b + +type zset<'Key,'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> = Set> + +[] +type Zset<'Key>() = + static member empty<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct>() : zset<'Key,'Comparer> = + Set.empty> + + static member inline isEmpty<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (s:zset<'Key,'Comparer>) = + Set.isEmpty s + + static member ofList<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> lst : zset<'Key,'Comparer> = + lst + |> List.map (fun k -> {CompareObj=k}) + |> Set.ofList + + static member ofSeq<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> lst : zset<'Key,'Comparer> = + lst + |> Seq.map (fun k -> {CompareObj=k}) + |> Set.ofSeq + + static member inline contains<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (k:'Key) (s:zset<'Key,'Comparer>) = + Set.contains {CompareObj=k} s + + static member inline exists<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (f:'Key->bool) (s:zset<'Key,'Comparer>) = + Set.exists (fun {CompareObj=k} -> f k) s + + static member inline add<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (k:'Key) (s:zset<'Key,'Comparer>) = + Set.add {CompareObj=k} s + + static member inline remove<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (k:'Key) (s:zset<'Key,'Comparer>) = + Set.remove {CompareObj=k} s + + static member inline forall<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (f:'Key->bool) (s:zset<'Key,'Comparer>) = + Set.forall (fun {CompareObj=k} -> f k) s + + static member inline memberOf<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (s:zset<'Key,'Comparer>) (k:'Key) = + Set.contains {CompareObj=k} s + + static member inline elements<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (s:zset<'Key,'Comparer>) = + Set.foldBack (fun e l -> e.CompareObj::l) s [] + + static member inline filter<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (f:'Key->bool) (s:zset<'Key,'Comparer>) = + Set.filter (fun {CompareObj=k} -> f k) s + + static member inline union<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (set1:zset<'Key,'Comparer>) (set2:zset<'Key,'Comparer>) = + Set.union set1 set2 + + static member inline fold<'Comparer, 'State when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (folder:'Key->'State->'State) (s:zset<'Key,'Comparer>) (state:'State) : 'State = + Set.fold (fun acc {CompareObj=k} -> folder k acc) state s + + static member inline addList<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (xs:list<'Key>) (s:zset<'Key,'Comparer>) = + List.fold (fun acc x -> Set.add {CompareObj=x} acc) s xs + + static member inline inter<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (a:zset<'Key,'Comparer>) (b:zset<'Key,'Comparer>) = + Set.intersect a b + + static member inline equal<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (a:zset<'Key,'Comparer>) (b:zset<'Key,'Comparer>) = + if obj.ReferenceEquals (a,b) then true + else + let lhs = (a:>seq<_>).GetEnumerator () + let rhs = (b:>seq<_>).GetEnumerator () + let rec loop () = + match lhs.MoveNext (), rhs.MoveNext () with + | true, true when Unchecked.defaultof<'Comparer>.Compare (lhs.Current.CompareObj, rhs.Current.CompareObj) = 0 -> loop () + | false, false -> true + | _ -> false + loop () + + static member inline iter<'Comparer when 'Comparer :> IComparer<'Key> and 'Comparer : struct> (f:'Key->unit) (m:zset<'Key,'Comparer>) = + Set.iter (fun {CompareObj=k} -> f k) m + diff --git a/src/utils/TaggedCollections.fs b/src/utils/TaggedCollections.fs deleted file mode 100644 index 232d3b75053..00000000000 --- a/src/utils/TaggedCollections.fs +++ /dev/null @@ -1,1172 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Internal.Utilities.Collections.Tagged - - #nowarn "51" - #nowarn "69" // interface implementations in augmentations - #nowarn "60" // override implementations in augmentations - - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open System - open System.Collections.Generic - open Internal.Utilities - open Internal.Utilities.Collections - - - [] - [] - type SetTree<'T> = - | SetEmpty // height = 0 - | SetNode of 'T * SetTree<'T> * SetTree<'T> * int // height = int -#if ONE - | SetOne of 'T // height = 1 -#endif - // OPTIMIZATION: store SetNode(k,SetEmpty,SetEmpty,1) ---> SetOne(k) - - - // CONSIDER: SetTree<'T> = SetEmpty | SetNode of 'T * SetTree<'T> * SetTree<'T> * int - // with SetOne = SetNode of (x,null,null,1) - - [] - module SetTree = - let empty = SetEmpty - - let height t = - match t with - | SetEmpty -> 0 -#if ONE - | SetOne _ -> 1 -#endif - | SetNode (_,_,_,h) -> h - -#if CHECKED - let rec checkInvariant t = - // A good sanity check, loss of balance can hit perf - match t with - | SetEmpty -> true - | SetOne _ -> true - | SetNode (k,t1,t2,h) -> - let h1 = height t1 in - let h2 = height t2 in - (-2 <= (h1 - h2) && (h1 - h2) <= 2) && checkInvariant t1 && checkInvariant t2 -#else - let inline SetOne(x) = SetNode(x,SetEmpty,SetEmpty,1) -#endif - - let tolerance = 2 - - let mk l hl k r hr = -#if ONE - if hl = 0 && hr = 0 then SetOne (k) - else -#endif - let m = if hl < hr then hr else hl - SetNode(k,l,r,m+1) - - let rebalance t1 k t2 = - let t1h = height t1 - let t2h = height t2 - if t2h > t1h + tolerance then // right is heavier than left - match t2 with - | SetNode(t2k,t2l,t2r,_) -> - // one of the nodes must have height > height t1 + 1 - let t2lh = height t2l - if t2lh > t1h + 1 then // balance left: combination - match t2l with - | SetNode(t2lk,t2ll,t2lr,_) -> - let l = mk t1 t1h k t2ll (height t2ll) - let r = mk t2lr (height t2lr) t2k t2r (height t2r) - mk l (height l) t2lk r (height r) - | _ -> failwith "rebalance" - else // rotate left - let l = mk t1 t1h k t2l t2lh - mk l (height l) t2k t2r (height t2r) - | _ -> failwith "rebalance" - else - if t1h > t2h + tolerance then // left is heavier than right - match t1 with - | SetNode(t1k,t1l,t1r,_) -> - // one of the nodes must have height > height t2 + 1 - let t1rh = height t1r - if t1rh > t2h + 1 then - // balance right: combination - match t1r with - | SetNode(t1rk,t1rl,t1rr,_) -> - let l = mk t1l (height t1l) t1k t1rl (height t1rl) - let r = mk t1rr (height t1rr) k t2 t2h - mk l (height l) t1rk r (height r) - | _ -> failwith "rebalance" - else - let r = mk t1r t1rh k t2 t2h - mk t1l (height t1l) t1k r (height r) - | _ -> failwith "rebalance" - else mk t1 t1h k t2 t2h - - let rec add (comparer: IComparer<'T>) k t = - match t with - | SetNode (k2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then rebalance (add comparer k l) k2 r - elif c = 0 then t - else rebalance l k2 (add comparer k r) -#if ONE - | SetOne(k2) -> - // nb. no check for rebalance needed for small trees, also be sure to reuse node already allocated - let c = comparer.Compare(k,k2) - if c < 0 then SetNode (k,SetEmpty,t,2) - elif c = 0 then t - else SetNode (k,t,SetEmpty,2) -#endif - | SetEmpty -> SetOne(k) - - let rec balance comparer t1 k t2 = - // Given t1 < k < t2 where t1 and t2 are "balanced", - // return a balanced tree for . - // Recall: balance means subtrees heights differ by at most "tolerance" - match t1,t2 with - | SetEmpty,t2 -> add comparer k t2 // drop t1 = empty - | t1,SetEmpty -> add comparer k t1 // drop t2 = empty -#if ONE - | SetOne k1,t2 -> add comparer k (add comparer k1 t2) - | t1,SetOne k2 -> add comparer k (add comparer k2 t1) -#endif - | SetNode(k1,t11,t12,t1h),SetNode(k2,t21,t22,t2h) -> - // Have: (t11 < k1 < t12) < k < (t21 < k2 < t22) - // Either (a) h1,h2 differ by at most 2 - no rebalance needed. - // (b) h1 too small, i.e. h1+2 < h2 - // (c) h2 too small, i.e. h2+2 < h1 - if t1h+tolerance < t2h then - // case: b, h1 too small - // push t1 into low side of t2, may increase height by 1 so rebalance - rebalance (balance comparer t1 k t21) k2 t22 - elif t2h+tolerance < t1h then - // case: c, h2 too small - // push t2 into high side of t1, may increase height by 1 so rebalance - rebalance t11 k1 (balance comparer t12 k t2) - else - // case: a, h1 and h2 meet balance requirement - mk t1 t1h k t2 t2h - - let rec split (comparer : IComparer<'T>) pivot t = - // Given a pivot and a set t - // Return { x in t s.t. x < pivot }, pivot in t? , { x in t s.t. x > pivot } - match t with - | SetNode(k1,t11,t12,_) -> - let c = comparer.Compare(pivot,k1) - if c < 0 then // pivot t1 - let t11_lo,havePivot,t11_hi = split comparer pivot t11 - t11_lo,havePivot,balance comparer t11_hi k1 t12 - elif c = 0 then // pivot is k1 - t11,true,t12 - else // pivot t2 - let t12_lo,havePivot,t12_hi = split comparer pivot t12 - balance comparer t11 k1 t12_lo,havePivot,t12_hi -#if ONE - | SetOne k1 -> - let c = comparer.Compare(k1,pivot) - if c < 0 then t ,false,SetEmpty // singleton under pivot - elif c = 0 then SetEmpty,true ,SetEmpty // singleton is pivot - else SetEmpty,false,t // singleton over pivot -#endif - | SetEmpty -> - SetEmpty,false,SetEmpty - - let rec spliceOutSuccessor t = - match t with - | SetEmpty -> failwith "internal error: Map.splice_out_succ_or_pred" -#if ONE - | SetOne (k2) -> k2,empty -#endif - | SetNode (k2,l,r,_) -> - match l with - | SetEmpty -> k2,r - | _ -> let k3,l' = spliceOutSuccessor l in k3,mk l' (height l') k2 r (height r) - - let rec remove (comparer: IComparer<'T>) k t = - match t with - | SetEmpty -> t -#if ONE - | SetOne (k2) -> - let c = comparer.Compare(k,k2) - if c = 0 then empty - else t -#endif - | SetNode (k2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then rebalance (remove comparer k l) k2 r - elif c = 0 then - match l,r with - | SetEmpty,_ -> r - | _,SetEmpty -> l - | _ -> - let sk,r' = spliceOutSuccessor r - mk l (height l) sk r' (height r') - else rebalance l k2 (remove comparer k r) - - let rec contains (comparer: IComparer<'T>) k t = - match t with - | SetNode(k2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then contains comparer k l - elif c = 0 then true - else contains comparer k r -#if ONE - | SetOne(k2) -> (comparer.Compare(k,k2) = 0) -#endif - | SetEmpty -> false - - let rec iter f t = - match t with - | SetNode(k2,l,r,_) -> iter f l; f k2; iter f r -#if ONE - | SetOne(k2) -> f k2 -#endif - | SetEmpty -> () - - // Fold, left-to-right. - // - // NOTE: This differs from the behaviour of Map.fold which folds right-to-left. - let rec fold f m x = - match m with - | SetNode(k,l,r,_) -> fold f r (f k (fold f l x)) -#if ONE - | SetOne(k) -> f k x -#endif - | SetEmpty -> x - - let rec forAll f m = - match m with - | SetNode(k2,l,r,_) -> f k2 && forAll f l && forAll f r -#if ONE - | SetOne(k2) -> f k2 -#endif - | SetEmpty -> true - - let rec exists f m = - match m with - | SetNode(k2,l,r,_) -> f k2 || exists f l || exists f r -#if ONE - | SetOne(k2) -> f k2 -#endif - | SetEmpty -> false - - let isEmpty m = match m with | SetEmpty -> true | _ -> false - - let subset comparer a b = forAll (fun x -> contains comparer x b) a - - let rec elementsAux m acc = - match m with - | SetNode(k2,l,r,_) -> k2 :: (elementsAux l (elementsAux r acc)) -#if ONE - | SetOne(k2) -> k2 :: acc -#endif - | SetEmpty -> acc - - let elements a = elementsAux a [] - - let rec filterAux comparer f s acc = - match s with - | SetNode(k,l,r,_) -> - let acc = if f k then add comparer k acc else acc - filterAux comparer f l (filterAux comparer f r acc) -#if ONE - | SetOne(k) -> if f k then add comparer k acc else acc -#endif - | SetEmpty -> acc - - let filter comparer f s = filterAux comparer f s empty - - let rec diffAux comparer m acc = - match m with - | SetNode(k,l,r,_) -> diffAux comparer l (diffAux comparer r (remove comparer k acc)) -#if ONE - | SetOne(k) -> remove comparer k acc -#endif - | SetEmpty -> acc - - let diff comparer a b = diffAux comparer b a - - let rec countAux s acc = - match s with - | SetNode(_,l,r,_) -> countAux l (countAux r (acc+1)) -#if ONE - | SetOne(k) -> acc+1 -#endif - | SetEmpty -> acc - - let count s = countAux s 0 - - let rec union comparer t1 t2 = - // Perf: tried bruteForce for low heights, but nothing significant - match t1,t2 with - | SetNode(k1,t11,t12,h1),SetNode(k2,t21,t22,h2) -> // (t11 < k < t12) AND (t21 < k2 < t22) - // Divide and Conquer: - // Suppose t1 is largest. - // Split t2 using pivot k1 into lo and hi. - // Union disjoint subproblems and then combine. - if h1 > h2 then - let lo,_,hi = split comparer k1 t2 in - balance comparer (union comparer t11 lo) k1 (union comparer t12 hi) - else - let lo,_,hi = split comparer k2 t1 in - balance comparer (union comparer t21 lo) k2 (union comparer t22 hi) - | SetEmpty,t -> t - | t,SetEmpty -> t -#if ONE - | SetOne k1,t2 -> add comparer k1 t2 - | t1,SetOne k2 -> add comparer k2 t1 -#endif - - let rec intersectionAux comparer b m acc = - match m with - | SetNode(k,l,r,_) -> - let acc = intersectionAux comparer b r acc - let acc = if contains comparer k b then add comparer k acc else acc - intersectionAux comparer b l acc -#if ONE - | SetOne(k) -> - if contains comparer k b then add comparer k acc else acc -#endif - | SetEmpty -> acc - - let intersection comparer a b = intersectionAux comparer b a empty - - let partition1 comparer f k (acc1,acc2) = - if f k then (add comparer k acc1,acc2) - else (acc1,add comparer k acc2) - - let rec partitionAux comparer f s acc = - match s with - | SetNode(k,l,r,_) -> - let acc = partitionAux comparer f r acc - let acc = partition1 comparer f k acc - partitionAux comparer f l acc -#if ONE - | SetOne(k) -> partition1 comparer f k acc -#endif - | SetEmpty -> acc - - let partition comparer f s = partitionAux comparer f s (empty,empty) - - // It's easier to get many less-important algorithms right using this active pattern - let (|MatchSetNode|MatchSetEmpty|) s = - match s with - | SetNode(k2,l,r,_) -> MatchSetNode(k2,l,r) -#if ONE - | SetOne(k2) -> MatchSetNode(k2,SetEmpty,SetEmpty) -#endif - | SetEmpty -> MatchSetEmpty - - let rec nextElemCont (comparer: IComparer<'T>) k s cont = - match s with - | MatchSetNode(k2,l,r) -> - let c = comparer.Compare(k,k2) - if c < 0 then nextElemCont comparer k l (function None -> cont(Some(k2)) | res -> res) - elif c = 0 then cont(minimumElementOpt r) - else nextElemCont comparer k r cont - | MatchSetEmpty -> cont(None) - - and nextElem comparer k s = nextElemCont comparer k s (fun res -> res) - - and prevElemCont (comparer: IComparer<'T>) k s cont = - match s with - | MatchSetNode(k2,l,r) -> - let c = comparer.Compare(k,k2) - if c > 0 then prevElemCont comparer k r (function None -> cont(Some(k2)) | res -> res) - elif c = 0 then cont(maximumElementOpt r) - else prevElemCont comparer k l cont - | MatchSetEmpty -> cont(None) - - and prevElem comparer k s = prevElemCont comparer k s (fun res -> res) - - and minimumElementAux s n = - match s with - | SetNode(k,l,_,_) -> minimumElementAux l k -#if ONE - | SetOne(k) -> k -#endif - | SetEmpty -> n - - and minimumElementOpt s = - match s with - | SetNode(k,l,_,_) -> Some(minimumElementAux l k) -#if ONE - | SetOne(k) -> Some k -#endif - | SetEmpty -> None - - and maximumElementAux s n = - match s with - | SetNode(k,_,r,_) -> maximumElementAux r k -#if ONE - | SetOne(k) -> k -#endif - | SetEmpty -> n - - and maximumElementOpt s = - match s with - | SetNode(k,_,r,_) -> Some(maximumElementAux r k) -#if ONE - | SetOne(k) -> Some(k) -#endif - | SetEmpty -> None - - let minimumElement s = - match minimumElementOpt s with - | Some(k) -> k - | None -> failwith "minimumElement" - - let maximumElement s = - match maximumElementOpt s with - | Some(k) -> k - | None -> failwith "maximumElement" - - - //-------------------------------------------------------------------------- - // Imperative left-to-right iterators. - //-------------------------------------------------------------------------- - - type SetIterator<'T>(s:SetTree<'T>) = - - // collapseLHS: - // a) Always returns either [] or a list starting with SetOne. - // b) The "fringe" of the set stack is unchanged. - let rec collapseLHS stack = - match stack with - | [] -> [] - | SetEmpty :: rest -> collapseLHS rest -#if ONE - | SetOne k :: rest -> stack -#else - | SetNode(_,SetEmpty,SetEmpty,_) :: _ -> stack -#endif - | SetNode(k,l,r,_) :: rest -> collapseLHS (l :: SetOne k :: r :: rest) - - // invariant: always collapseLHS result - let mutable stack = collapseLHS [s] - // true when MoveNext has been called - let mutable started = false - - let notStarted() = raise (new System.InvalidOperationException("Enumeration has not started. Call MoveNext.")) - let alreadyFinished() = raise (new System.InvalidOperationException("Enumeration already finished.")) - - member i.Current = - if started then - match stack with -#if ONE - | SetOne k :: _ -> k -#else - | SetNode( k,_,_,_) :: _ -> k -#endif - | [] -> alreadyFinished() - | _ -> failwith "Please report error: Set iterator, unexpected stack for current" - else - notStarted() - - member i.MoveNext() = - if started then - match stack with -#if ONE - | SetOne _ :: rest -> -#else - | SetNode _ :: rest -> -#endif - stack <- collapseLHS rest; - not stack.IsEmpty - | [] -> false - | _ -> failwith "Please report error: Set iterator, unexpected stack for moveNext" - else - started <- true; // The first call to MoveNext "starts" the enumeration. - not stack.IsEmpty - - let toSeq s = - let i = ref (SetIterator s) - { new IEnumerator<_> with - member __.Current = (!i).Current - interface System.Collections.IEnumerator with - member __.Current = box (!i).Current - member __.MoveNext() = (!i).MoveNext() - member __.Reset() = i := SetIterator s - interface System.IDisposable with - member __.Dispose() = () } - - //-------------------------------------------------------------------------- - // Set comparison. This can be expensive. - //-------------------------------------------------------------------------- - - let rec compareStacks (comparer: IComparer<'T>) l1 l2 = - match l1,l2 with - | [],[] -> 0 - | [],_ -> -1 - | _ ,[] -> 1 - | (SetEmpty _ :: t1),(SetEmpty :: t2) -> compareStacks comparer t1 t2 -#if ONE - | (SetOne(n1k) :: t1),(SetOne(n2k) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer t1 t2 - | (SetOne(n1k) :: t1),(SetNode(n2k,SetEmpty,n2r,_) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer (empty :: t1) (n2r :: t2) - | (SetNode(n1k,(SetEmpty as emp),n1r,_) :: t1),(SetOne(n2k) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer (n1r :: t1) (emp :: t2) -#endif - | (SetNode(n1k,SetEmpty,n1r,_) :: t1),(SetNode(n2k,SetEmpty,n2r,_) :: t2) -> - let c = comparer.Compare(n1k,n2k) - if c <> 0 then c else compareStacks comparer (n1r :: t1) (n2r :: t2) -#if ONE - | (SetOne(n1k) :: t1),_ -> - compareStacks comparer (empty :: SetOne(n1k) :: t1) l2 -#endif - | (SetNode(n1k,n1l,n1r,_) :: t1),_ -> - compareStacks comparer (n1l :: SetNode(n1k,empty,n1r,0) :: t1) l2 -#if ONE - | _,(SetOne(n2k) :: t2) -> - compareStacks comparer l1 (empty :: SetOne(n2k) :: t2) -#endif - | _,(SetNode(n2k,n2l,n2r,_) :: t2) -> - compareStacks comparer l1 (n2l :: SetNode(n2k,empty,n2r,0) :: t2) - - let compare comparer s1 s2 = - match s1,s2 with - | SetEmpty,SetEmpty -> 0 - | SetEmpty,_ -> -1 - | _,SetEmpty -> 1 - | _ -> compareStacks comparer [s1] [s2] - - let choose s = minimumElement s - - let toList s = - let rec loop m x = - match m with - | SetNode(k,l,r,_) -> loop l (k :: (loop r x)) -#if ONE - | SetOne(k) -> k :: x -#endif - | SetEmpty -> x - loop s [] - - let copyToArray s (arr: _[]) i = - let j = ref i - iter (fun x -> arr.[!j] <- x; j := !j + 1) s - - let toArray s = - let n = (count s) - let res = Array.zeroCreate n - copyToArray s res 0; - res - - let rec mkFromEnumerator comparer acc (e : IEnumerator<_>) = - if e.MoveNext() then - mkFromEnumerator comparer (add comparer e.Current acc) e - else acc - - let ofSeq comparer (c : IEnumerable<_>) = - use ie = c.GetEnumerator() - mkFromEnumerator comparer empty ie - - let ofArray comparer l = Array.fold (fun acc k -> add comparer k acc) empty l - - - [] - [] - type internal Set<'T,'ComparerTag> when 'ComparerTag :> IComparer<'T>(comparer: IComparer<'T>, tree: SetTree<'T>) = - - static let refresh (s:Set<_,_>) t = Set<_,_>(comparer=s.Comparer, tree=t) - - member s.Tree = tree - member s.Comparer : IComparer<'T> = comparer - - static member Empty(comparer: 'ComparerTag) : Set<'T,'ComparerTag> = - Set<_,_>(comparer=comparer, tree=SetTree.empty) - - - member s.Add(x) : Set<'T,'ComparerTag> = refresh s (SetTree.add comparer x tree) - member s.Remove(x) : Set<'T,'ComparerTag> = refresh s (SetTree.remove comparer x tree) - member s.Count = SetTree.count tree - member s.Contains(x) = SetTree.contains comparer x tree - member s.Iterate(x) = SetTree.iter x tree - member s.Fold f x = SetTree.fold f tree x - -#if CHECKED - member s.CheckBalanceInvariant = checkInvariant tree // diagnostics... -#endif - member s.IsEmpty = SetTree.isEmpty tree - - member s.Partition f : Set<'T,'ComparerTag> * Set<'T,'ComparerTag> = - match tree with - | SetEmpty -> s,s - | _ -> - let t1,t2 = SetTree.partition comparer f tree - refresh s t1, refresh s t2 - - member s.Filter f : Set<'T,'ComparerTag> = - match tree with - | SetEmpty -> s - | _ -> SetTree.filter comparer f tree |> refresh s - - member s.Exists f = SetTree.exists f tree - - member s.ForAll f = SetTree.forAll f tree - - static member (-) ((a: Set<'T,'ComparerTag>),(b: Set<'T,'ComparerTag>)) = Set<_,_>.Difference(a,b) - - static member (+) ((a: Set<'T,'ComparerTag>),(b: Set<'T,'ComparerTag>)) = Set<_,_>.Union(a,b) - - static member Intersection((a: Set<'T,'ComparerTag>),(b: Set<'T,'ComparerTag>)) : Set<'T,'ComparerTag> = - match b.Tree with - | SetEmpty -> b // A INTER 0 = 0 - | _ -> - match a.Tree with - | SetEmpty -> a // 0 INTER B = 0 - | _ -> SetTree.intersection a.Comparer a.Tree b.Tree |> refresh a - - static member Union(a: Set<'T,'ComparerTag>,b: Set<'T,'ComparerTag>) : Set<'T,'ComparerTag> = - match b.Tree with - | SetEmpty -> a // A U 0 = A - | _ -> - match a.Tree with - | SetEmpty -> b // 0 U B = B - | _ -> SetTree.union a.Comparer a.Tree b.Tree |> refresh a - - static member Difference(a: Set<'T,'ComparerTag>,b: Set<'T,'ComparerTag>) : Set<'T,'ComparerTag> = - match a.Tree with - | SetEmpty -> a // 0 - B = 0 - | _ -> - match b.Tree with - | SetEmpty -> a // A - 0 = A - | _ -> SetTree.diff a.Comparer a.Tree b.Tree |> refresh a - - static member Equality(a: Set<'T,'ComparerTag>,b: Set<'T,'ComparerTag>) = - (SetTree.compare a.Comparer a.Tree b.Tree = 0) - - static member Compare(a: Set<'T,'ComparerTag>,b: Set<'T,'ComparerTag>) = - SetTree.compare a.Comparer a.Tree b.Tree - - member s.Choose = SetTree.choose tree - - member s.MinimumElement = SetTree.minimumElement tree - - member s.MaximumElement = SetTree.maximumElement tree - - member s.IsSubsetOf((y: Set<'T,'ComparerTag>)) = SetTree.subset comparer tree y.Tree - - member s.IsSupersetOf((y: Set<'T,'ComparerTag>)) = SetTree.subset comparer y.Tree tree - - member s.ToList () = SetTree.toList tree - - member s.ToArray () = SetTree.toArray tree - - override this.Equals(that) = - match that with - // Cast to the exact same type as this, otherwise not equal. - | :? Set<'T,'ComparerTag> as that -> ((this :> System.IComparable).CompareTo(that) = 0) - | _ -> false - - interface System.IComparable with - // Cast s2 to the exact same type as s1, see 4884. - // It is not OK to cast s2 to seq<'T>, since different compares could permute the elements. - member s1.CompareTo(s2: obj) = SetTree.compare s1.Comparer s1.Tree ((s2 :?> Set<'T,'ComparerTag>).Tree) - - member this.ComputeHashCode() = - let combineHash x y = (x <<< 1) + y + 631 - let mutable res = 0 - for x in this do - res <- combineHash res (Unchecked.hash x) - abs res - - override this.GetHashCode() = this.ComputeHashCode() - - interface ICollection<'T> with - member s.Add(_) = raise (new System.NotSupportedException("ReadOnlyCollection")) - member s.Clear() = raise (new System.NotSupportedException("ReadOnlyCollection")) - member s.Remove(_) = raise (new System.NotSupportedException("ReadOnlyCollection")) - member s.Contains(x) = SetTree.contains comparer x tree - member s.CopyTo(arr,i) = SetTree.copyToArray tree arr i - member s.IsReadOnly = true - member s.Count = SetTree.count tree - - interface IEnumerable<'T> with - member s.GetEnumerator() = SetTree.toSeq tree - - interface System.Collections.IEnumerable with - override s.GetEnumerator() = (SetTree.toSeq tree :> System.Collections.IEnumerator) - - static member Singleton(comparer,x) : Set<'T,'ComparerTag> = - Set<_,_>.Empty(comparer).Add(x) - - static member Create(comparer : 'ComparerTag,l : seq<'T>) : Set<'T,'ComparerTag> = - Set<_,_>(comparer=comparer, tree=SetTree.ofSeq comparer l) - - - [] - [] - type MapTree<'Key,'T> = - | MapEmpty -#if ONE - | MapOne of 'Key * 'T -#endif - | MapNode of 'Key * 'T * MapTree<'Key,'T> * MapTree<'Key,'T> * int - - - [] - module MapTree = - - let empty = MapEmpty - - let inline height x = - match x with - | MapEmpty -> 0 -#if ONE - | MapOne _ -> 1 -#endif - | MapNode(_,_,_,_,h) -> h - - let inline isEmpty m = - match m with - | MapEmpty -> true - | _ -> false - - let inline mk l k v r = -#if ONE - match l,r with - | MapEmpty,MapEmpty -> MapOne(k,v) - | _ -> -#endif - let hl = height l - let hr = height r - let m = if hl < hr then hr else hl - MapNode(k,v,l,r,m+1) - - let rebalance t1 k v t2 = - let t1h = height t1 - let t2h = height t2 - if t2h > t1h + 2 then // right is heavier than left - match t2 with - | MapNode(t2k,t2v,t2l,t2r,_) -> - // one of the nodes must have height > height t1 + 1 - if height t2l > t1h + 1 then // balance left: combination - match t2l with - | MapNode(t2lk,t2lv,t2ll,t2lr,_) -> - mk (mk t1 k v t2ll) t2lk t2lv (mk t2lr t2k t2v t2r) - | _ -> failwith "rebalance" - else // rotate left - mk (mk t1 k v t2l) t2k t2v t2r - | _ -> failwith "rebalance" - else - if t1h > t2h + 2 then // left is heavier than right - match t1 with - | MapNode(t1k,t1v,t1l,t1r,_) -> - // one of the nodes must have height > height t2 + 1 - if height t1r > t2h + 1 then - // balance right: combination - match t1r with - | MapNode(t1rk,t1rv,t1rl,t1rr,_) -> - mk (mk t1l t1k t1v t1rl) t1rk t1rv (mk t1rr k v t2) - | _ -> failwith "rebalance" - else - mk t1l t1k t1v (mk t1r k v t2) - | _ -> failwith "rebalance" - else mk t1 k v t2 - - let rec sizeAux acc m = - match m with - | MapEmpty -> acc -#if ONE - | MapOne _ -> acc + 1 -#endif - | MapNode(_,_,l,r,_) -> sizeAux (sizeAux (acc+1) l) r - -#if ONE -#else - let MapOne(k,v) = MapNode(k,v,MapEmpty,MapEmpty,1) -#endif - - let count x = sizeAux 0 x - - let rec add (comparer: IComparer<'T>) k v m = - match m with - | MapEmpty -> MapOne(k,v) -#if ONE - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c < 0 then MapNode (k,v,MapEmpty,m,2) - elif c = 0 then MapOne(k,v) - else MapNode (k,v,m,MapEmpty,2) -#endif - | MapNode(k2,v2,l,r,h) -> - let c = comparer.Compare(k,k2) - if c < 0 then rebalance (add comparer k v l) k2 v2 r - elif c = 0 then MapNode(k,v,l,r,h) - else rebalance l k2 v2 (add comparer k v r) - - let indexNotFound() = raise (new System.Collections.Generic.KeyNotFoundException("An index satisfying the predicate was not found in the collection")) - - let rec find (comparer: IComparer<'T>) k m = - match m with - | MapEmpty -> indexNotFound() -#if ONE - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then v2 - else indexNotFound() -#endif - | MapNode(k2,v2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then find comparer k l - elif c = 0 then v2 - else find comparer k r - - let rec tryFind (comparer: IComparer<'T>) k m = - match m with - | MapEmpty -> None -#if ONE - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then Some v2 - else None -#endif - | MapNode(k2,v2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then tryFind comparer k l - elif c = 0 then Some v2 - else tryFind comparer k r - - let partition1 (comparer: IComparer<'T>) f k v (acc1,acc2) = - if f k v then (add comparer k v acc1,acc2) else (acc1,add comparer k v acc2) - - let rec partitionAux (comparer: IComparer<'T>) f s acc = - match s with - | MapEmpty -> acc -#if ONE - | MapOne(k,v) -> partition1 comparer f k v acc -#endif - | MapNode(k,v,l,r,_) -> - let acc = partitionAux comparer f r acc - let acc = partition1 comparer f k v acc - partitionAux comparer f l acc - - let partition (comparer: IComparer<'T>) f s = partitionAux comparer f s (empty,empty) - - let filter1 (comparer: IComparer<'T>) f k v acc = if f k v then add comparer k v acc else acc - - let rec filterAux (comparer: IComparer<'T>) f s acc = - match s with - | MapEmpty -> acc -#if ONE - | MapOne(k,v) -> filter1 comparer f k v acc -#endif - | MapNode(k,v,l,r,_) -> - let acc = filterAux comparer f l acc - let acc = filter1 comparer f k v acc - filterAux comparer f r acc - - let filter (comparer: IComparer<'T>) f s = filterAux comparer f s empty - - let rec spliceOutSuccessor m = - match m with - | MapEmpty -> failwith "internal error: Map.splice_out_succ_or_pred" -#if ONE - | MapOne(k2,v2) -> k2,v2,MapEmpty -#endif - | MapNode(k2,v2,l,r,_) -> - match l with - | MapEmpty -> k2,v2,r - | _ -> let k3,v3,l' = spliceOutSuccessor l in k3,v3,mk l' k2 v2 r - - let rec remove (comparer: IComparer<'T>) k m = - match m with - | MapEmpty -> empty -#if ONE - | MapOne(k2,v2) -> - let c = comparer.Compare(k,k2) - if c = 0 then MapEmpty else m -#endif - | MapNode(k2,v2,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then rebalance (remove comparer k l) k2 v2 r - elif c = 0 then - match l,r with - | MapEmpty,_ -> r - | _,MapEmpty -> l - | _ -> - let sk,sv,r' = spliceOutSuccessor r - mk l sk sv r' - else rebalance l k2 v2 (remove comparer k r) - - let rec containsKey (comparer: IComparer<'T>) k m = - match m with - | MapEmpty -> false -#if ONE - | MapOne(k2,v2) -> (comparer.Compare(k,k2) = 0) -#endif - | MapNode(k2,_,l,r,_) -> - let c = comparer.Compare(k,k2) - if c < 0 then containsKey comparer k l - else (c = 0 || containsKey comparer k r) - - let rec iter f m = - match m with - | MapEmpty -> () -#if ONE - | MapOne(k2,v2) -> f k2 v2 -#endif - | MapNode(k2,v2,l,r,_) -> iter f l; f k2 v2; iter f r - - let rec first f m = - match m with - | MapEmpty -> None -#if ONE - | MapOne(k2,v2) -> f k2 v2 -#endif - | MapNode(k2,v2,l,r,_) -> - match first f l with - | Some _ as res -> res - | None -> - match f k2 v2 with - | Some _ as res -> res - | None -> first f r - - let rec exists f m = - match m with - | MapEmpty -> false -#if ONE - | MapOne(k2,v2) -> f k2 v2 -#endif - | MapNode(k2,v2,l,r,_) -> f k2 v2 || exists f l || exists f r - - let rec forAll f m = - match m with - | MapEmpty -> true -#if ONE - | MapOne(k2,v2) -> f k2 v2 -#endif - | MapNode(k2,v2,l,r,_) -> f k2 v2 && forAll f l && forAll f r - - let rec map f m = - match m with - | MapEmpty -> empty -#if ONE - | MapOne(k,v) -> MapOne(k,f v) -#endif - | MapNode(k,v,l,r,h) -> let v2 = f v in MapNode(k,v2,map f l, map f r,h) - - let rec mapi f m = - match m with - | MapEmpty -> empty -#if ONE - | MapOne(k,v) -> MapOne(k,f k v) -#endif - | MapNode(k,v,l,r,h) -> let v2 = f k v in MapNode(k,v2, mapi f l, mapi f r,h) - - // Fold, right-to-left. - // - // NOTE: This differs from the behaviour of Set.fold which folds left-to-right. - let rec fold f m x = - match m with - | MapEmpty -> x -#if ONE - | MapOne(k,v) -> f k v x -#endif - | MapNode(k,v,l,r,_) -> fold f l (f k v (fold f r x)) - - let foldSection (comparer: IComparer<'T>) lo hi f m x = - let rec fold_from_to f m x = - match m with - | MapEmpty -> x -#if ONE - | MapOne(k,v) -> - let clo_k = comparer.Compare(lo,k) - let ck_hi = comparer.Compare(k,hi) - let x = if clo_k <= 0 && ck_hi <= 0 then f k v x else x - x -#endif - | MapNode(k,v,l,r,_) -> - let clo_k = comparer.Compare(lo,k) - let ck_hi = comparer.Compare(k,hi) - let x = if clo_k < 0 then fold_from_to f l x else x - let x = if clo_k <= 0 && ck_hi <= 0 then f k v x else x - let x = if ck_hi < 0 then fold_from_to f r x else x - x - - if comparer.Compare(lo,hi) = 1 then x else fold_from_to f m x - - let rec foldMap (comparer: IComparer<'T>) f m z acc = - match m with - | MapEmpty -> acc,z -#if ONE - | MapOne(k,v) -> - let v',z = f k v z - add comparer k v' acc,z -#endif - | MapNode(k,v,l,r,_) -> - let acc,z = foldMap comparer f r z acc - let v',z = f k v z - let acc = add comparer k v' acc - foldMap comparer f l z acc - - let toList m = fold (fun k v acc -> (k,v) :: acc) m [] - let toArray m = m |> toList |> Array.ofList - let ofList comparer l = List.fold (fun acc (k,v) -> add comparer k v acc) empty l - - - let rec mkFromEnumerator comparer acc (e : IEnumerator<_>) = - if e.MoveNext() then - let (x,y) = e.Current - mkFromEnumerator comparer (add comparer x y acc) e - else acc - - let ofSeq comparer (c : seq<_>) = - use ie = c.GetEnumerator() - mkFromEnumerator comparer empty ie - - let copyToArray s (arr: _[]) i = - let j = ref i - s |> iter (fun x y -> arr.[!j] <- KeyValuePair(x,y); j := !j + 1) - - - /// Imperative left-to-right iterators. - type MapIterator<'Key,'T>(s:MapTree<'Key,'T>) = - // collapseLHS: - // a) Always returns either [] or a list starting with SetOne. - // b) The "fringe" of the set stack is unchanged. - let rec collapseLHS stack = - match stack with - | [] -> [] - | MapEmpty :: rest -> collapseLHS rest -#if ONE - | MapOne _ :: _ -> stack -#else - | (MapNode(_,_,MapEmpty,MapEmpty,_)) :: _ -> stack -#endif - | (MapNode(k,v,l,r,_)) :: rest -> collapseLHS (l :: MapOne (k,v) :: r :: rest) - - /// invariant: always collapseLHS result - let mutable stack = collapseLHS [s] - /// true when MoveNext has been called - let mutable started = false - - let notStarted() = raise (new System.InvalidOperationException("Enumeration has not started. Call MoveNext.")) - let alreadyFinished() = raise (new System.InvalidOperationException("Enumeration already finished.")) - - member i.Current = - if started then - match stack with -#if ONE - | MapOne (k,v) :: _ -> new KeyValuePair<_,_>(k,v) -#else - | (MapNode(k,v,MapEmpty,MapEmpty,_)) :: _ -> new KeyValuePair<_,_>(k,v) -#endif - | [] -> alreadyFinished() - | _ -> failwith "Please report error: Map iterator, unexpected stack for current" - else - notStarted() - - member i.MoveNext() = - if started then - match stack with -#if ONE - | MapOne _ :: rest -> -#else - | (MapNode(_,_,MapEmpty,MapEmpty,_)) :: rest -> -#endif - stack <- collapseLHS rest; - not stack.IsEmpty - | [] -> false - | _ -> failwith "Please report error: Map iterator, unexpected stack for moveNext" - else - // The first call to MoveNext "starts" the enumeration. - started <- true; - not stack.IsEmpty - - let toSeq s = - let i = ref (MapIterator(s)) - { new IEnumerator<_> with - member self.Current = (!i).Current - interface System.Collections.IEnumerator with - member self.Current = box (!i).Current - member self.MoveNext() = (!i).MoveNext() - member self.Reset() = i := MapIterator(s) - interface System.IDisposable with - member self.Dispose() = ()} - - - [] - [] - type internal Map<'Key,'T,'ComparerTag> when 'ComparerTag :> IComparer<'Key>( comparer: IComparer<'Key>, tree: MapTree<'Key,'T>) = - - static let refresh (m:Map<_,_,'ComparerTag>) t = - Map<_,_,'ComparerTag>(comparer=m.Comparer, tree=t) - - member s.Tree = tree - member s.Comparer : IComparer<'Key> = comparer - - static member Empty(comparer : 'ComparerTag) = Map<'Key,'T,'ComparerTag>(comparer=comparer, tree=MapTree.empty) - member m.Add(k,v) = refresh m (MapTree.add comparer k v tree) - member m.IsEmpty = MapTree.isEmpty tree - member m.Item with get(k : 'Key) = MapTree.find comparer k tree - member m.First(f) = MapTree.first f tree - member m.Exists(f) = MapTree.exists f tree - member m.Filter(f) = MapTree.filter comparer f tree |> refresh m - member m.ForAll(f) = MapTree.forAll f tree - member m.Fold f acc = MapTree.fold f tree acc - member m.FoldSection lo hi f acc = MapTree.foldSection comparer lo hi f tree acc - member m.FoldAndMap f z = - let tree,z = MapTree.foldMap comparer f tree z MapTree.empty - refresh m tree, z - member m.Iterate f = MapTree.iter f tree - member m.MapRange f = refresh m (MapTree.map f tree) - member m.Map f = refresh m (MapTree.mapi f tree) - member m.Partition(f) = - let r1,r2 = MapTree.partition comparer f tree - refresh m r1, refresh m r2 - member m.Count = MapTree.count tree - member m.ContainsKey(k) = MapTree.containsKey comparer k tree - member m.Remove(k) = refresh m (MapTree.remove comparer k tree) - member m.TryFind(k) = MapTree.tryFind comparer k tree - member m.ToList() = MapTree.toList tree - member m.ToArray() = MapTree.toArray tree - - static member FromList(comparer : 'ComparerTag,l) : Map<'Key,'T,'ComparerTag> = - Map<_,_,_>(comparer=comparer, tree=MapTree.ofList comparer l) - - static member Create(comparer : 'ComparerTag, ie : seq<_>) : Map<'Key,'T,'ComparerTag> = - Map<_,_,_>(comparer=comparer, tree=MapTree.ofSeq comparer ie) - - interface IEnumerable> with - member s.GetEnumerator() = MapTree.toSeq tree - - interface System.Collections.IEnumerable with - override s.GetEnumerator() = (MapTree.toSeq tree :> System.Collections.IEnumerator) - - override this.Equals(that) = - match that with - // Cast to the exact same type as this, otherwise not equal. - | :? Map<'Key,'T,'ComparerTag> as that -> ((this :> System.IComparable).CompareTo(that) = 0) - | _ -> false - - interface System.IComparable with - member m1.CompareTo(m2: obj) = - Seq.compareWith - (fun (kvp1 : KeyValuePair<_,_>) (kvp2 : KeyValuePair<_,_>)-> - let c = m1.Comparer.Compare(kvp1.Key,kvp2.Key) in - if c <> 0 then c else Unchecked.compare kvp1.Value kvp2.Value) - // Cast m2 to the exact same type as m1, see 4884. - // It is not OK to cast m2 to seq>, since different compares could permute the KVPs. - m1 (m2 :?> Map<'Key,'T,'ComparerTag>) - - member this.ComputeHashCode() = - let combineHash x y = (x <<< 1) + y + 631 - let mutable res = 0 - for KeyValue(x,y) in this do - res <- combineHash res (Unchecked.hash x) - res <- combineHash res (Unchecked.hash y) - abs res - - override this.GetHashCode() = this.ComputeHashCode() - - - type internal Map<'Key,'T> = Map<'Key, 'T, IComparer<'Key>> - type internal Set<'T> = Set<'T, IComparer<'T>> diff --git a/src/utils/TaggedCollections.fsi b/src/utils/TaggedCollections.fsi deleted file mode 100644 index c877cbe7eb5..00000000000 --- a/src/utils/TaggedCollections.fsi +++ /dev/null @@ -1,224 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -/// This namespace contains FSharp.PowerPack extensions for the F# collection types -namespace Internal.Utilities.Collections.Tagged - - open System - open System.Collections.Generic - - /// Immutable sets based on binary trees, default tag - - /// Immutable sets where a constraint tag carries information about the class of key-comparer being used. - [] - type internal Set<'T,'ComparerTag> when 'ComparerTag :> IComparer<'T> = - - /// A useful shortcut for Set.add. Note this operation produces a new set - /// and does not mutate the original set. The new set will share many storage - /// nodes with the original. See the Set module for further operations on sets. - member Add : 'T -> Set<'T,'ComparerTag> - - /// A useful shortcut for Set.remove. Note this operation produces a new set - /// and does not mutate the original set. The new set will share many storage - /// nodes with the original. See the Set module for further operations on sets. - member Remove : 'T -> Set<'T,'ComparerTag> - - /// Return the number of elements in the set. - member Count : int - - /// A useful shortcut for Set.contains. See the Set module for further operations on sets. - member Contains : 'T -> bool - - /// A useful shortcut for Set.isEmpty. See the Set module for further operations on sets. - member IsEmpty : bool - - /// Apply the given function to each binding in the collection. - member Iterate : ('T -> unit) -> unit - - /// Apply the given accumulating function to all the elements of the set. - member Fold : ('T -> 'State -> 'State) -> 'State -> 'State - - /// Build two new sets, one containing the elements for which the given predicate returns True, - /// and another with the remaining elements. - member Partition: predicate:('T -> bool) -> Set<'T,'ComparerTag> * Set<'T,'ComparerTag> - - /// Return a new collection containing only the elements of the collection - /// for which the given predicate returns True. - member Filter: predicate:('T -> bool) -> Set<'T,'ComparerTag> - - /// Test if any element of the collection satisfies the given predicate. - /// If the input function is f and the elements are i0...iN then computes - /// p i0 or ... or p iN. - member Exists: predicate:('T -> bool) -> bool - - /// Test if all elements of the collection satisfy the given predicate. - /// If the input function is f and the elements are i0...iN and j0...jN then - /// computes p i0 && ... && p iN. - member ForAll: predicate:('T -> bool) -> bool - - /// A set based on the given comparer containing the given initial elements. - static member Create: 'ComparerTag * seq<'T> -> Set<'T,'ComparerTag> - - /// The empty set based on the given comparer. - static member Empty: 'ComparerTag -> Set<'T,'ComparerTag> - - /// A singleton set based on the given comparison operator. - static member Singleton: 'ComparerTag * 'T -> Set<'T,'ComparerTag> - - /// Compares two sets and returns True if they are equal or False otherwise. - static member Equality : Set<'T,'ComparerTag> * Set<'T,'ComparerTag> -> bool - - /// Compares a and b and returns 1 if a > b, -1 if b < a and 0 if a = b. - static member Compare : a:Set<'T,'ComparerTag> * b:Set<'T,'ComparerTag> -> int - - /// Return a new set with the elements of the second set removed from the first. - static member (-) : Set<'T,'ComparerTag> * Set<'T,'ComparerTag> -> Set<'T,'ComparerTag> - - /// Compute the union of the two sets. - static member (+) : Set<'T,'ComparerTag> * Set<'T,'ComparerTag> -> Set<'T,'ComparerTag> - - /// Compute the intersection of the two sets. - static member Intersection : Set<'T,'ComparerTag> * Set<'T,'ComparerTag> -> Set<'T,'ComparerTag> - - /// Compute the union of the two sets. - static member Union : Set<'T,'ComparerTag> * Set<'T,'ComparerTag> -> Set<'T,'ComparerTag> - - /// Return a new set with the elements of the second set removed from the first. - static member Difference: Set<'T,'ComparerTag> * Set<'T,'ComparerTag> -> Set<'T,'ComparerTag> - - /// The number of elements in the set. - member Choose : 'T - - /// Returns the lowest element in the set according to the ordering being used for the set. - member MinimumElement: 'T - - /// Returns the highest element in the set according to the ordering being used for the set. - member MaximumElement: 'T - - /// Evaluates to True if all elements of the second set are in the first. - member IsSubsetOf: Set<'T,'ComparerTag> -> bool - - /// Evaluates to True if all elements of the first set are in the second. - member IsSupersetOf: Set<'T,'ComparerTag> -> bool - - /// The elements of the set as a list. - member ToList : unit -> 'T list - - /// The elements of the set as an array. - member ToArray: unit -> 'T array - - interface ICollection<'T> - - interface IEnumerable<'T> - - interface System.Collections.IEnumerable - - interface System.IComparable - - override Equals : obj -> bool - - type internal Set<'T> = Set<'T, IComparer<'T>> - - /// Immutable maps. Keys are ordered by construction function specified - /// when creating empty maps or by F# structural comparison if no - /// construction function is specified. - /// - /// - /// Maps based on structural comparison are - /// efficient for small keys. They are not a suitable choice if keys are recursive data structures - /// or require non-structural comparison semantics. - /// - - /// Immutable maps. A constraint tag carries information about the class of key-comparers being used. - [] - type internal Map<'Key,'Value,'ComparerTag> when 'ComparerTag :> IComparer<'Key> = - - /// Return a new map with the binding added to the given map. - member Add: 'Key * 'Value -> Map<'Key,'Value,'ComparerTag> - - /// Return True if there are no bindings in the map. - member IsEmpty: bool - - /// The empty map, and use the given comparer comparison function for all operations associated - /// with any maps built from this map. - static member Empty: 'ComparerTag -> Map<'Key,'Value,'ComparerTag> - - static member FromList : 'ComparerTag * ('Key * 'Value) list -> Map<'Key,'Value,'ComparerTag> - - /// Build a map that contains the bindings of the given IEnumerable - /// and where comparison of elements is based on the given comparison function. - static member Create: 'ComparerTag * seq<'Key * 'Value> -> Map<'Key,'Value,'ComparerTag> - - /// Test is an element is in the domain of the map. - member ContainsKey: 'Key -> bool - - /// The number of bindings in the map. - member Count: int - - /// Lookup an element in the map. Raise KeyNotFoundException if no binding - /// exists in the map. - member Item : 'Key -> 'Value with get - - /// Search the map looking for the first element where the given function returns a Some value. - member First: ('Key -> 'Value -> 'T option) -> 'T option - - /// Return True if the given predicate returns true for all of the - /// bindings in the map. Always returns true if the map is empty. - member ForAll: ('Key -> 'Value -> bool) -> bool - - /// Return True if the given predicate returns true for one of the - /// bindings in the map. Always returns false if the map is empty. - member Exists: ('Key -> 'Value -> bool) -> bool - - /// Build a new map containing the bindings for which the given predicate returns True. - member Filter: ('Key -> 'Value -> bool) -> Map<'Key,'Value,'ComparerTag> - - /// Fold over the bindings in the map. - member Fold: folder:('Key -> 'Value -> 'State -> 'State) -> 'State -> 'State - - /// Given the start and end points of a key range, - /// Fold over the bindings in the map that are in the range, - /// and the end points are included if present (the range is considered a closed interval). - member FoldSection: 'Key -> 'Key -> ('Key -> 'Value -> 'State -> 'State) -> 'State -> 'State - - /// Fold over the bindings in the map. - member FoldAndMap: ('Key -> 'Value -> 'State -> 'T * 'State) -> 'State -> Map<'Key,'T,'ComparerTag> * 'State - - /// Apply the given function to each binding in the dictionary. - member Iterate: action:('Key -> 'Value -> unit) -> unit - - /// Build a new collection whose elements are the results of applying the given function - /// to each of the elements of the collection. The index passed to the - /// function indicates the index of element being transformed. - member Map: mapping:('Key -> 'Value -> 'T) -> Map<'Key,'T,'ComparerTag> - - /// Build a new collection whose elements are the results of applying the given function - /// to each of the elements of the collection. - member MapRange: mapping:('Value -> 'T) -> Map<'Key,'T,'ComparerTag> - - /// Build two new maps, one containing the bindings for which the given predicate returns True, - /// and another for the remaining bindings. - member Partition: ('Key -> 'Value -> bool) -> Map<'Key,'Value,'ComparerTag> * Map<'Key,'Value,'ComparerTag> - - /// Remove an element from the domain of the map. No exception is raised if the element is not present. - member Remove: 'Key -> Map<'Key,'Value,'ComparerTag> - - /// Lookup an element in the map, returning a Some value if the element is in the domain - /// of the map and None if not. - member TryFind: 'Key -> 'Value option - - /// The elements of the set as a list. - member ToList : unit -> ('Key * 'Value) list - - /// The elements of the set as an array. - member ToArray: unit -> ('Key * 'Value) array - - interface IEnumerable> - - interface System.Collections.IEnumerable - - interface System.IComparable - - override Equals : obj -> bool - - type internal Map<'Key,'Value> = Map<'Key, 'Value, IComparer<'Key>> - diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs index 4333e5316af..b9aa3b5a290 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs @@ -5183,41 +5183,47 @@ type GeneratedTestSuite () = [] member __.``SBytes.Collection.ArrayArray C.I.compare``() = validate (SBytes.Collection.ArrayArray) C.I.compare [| - 0;1;-1;1;1;-1;-1;-1;-1;-1;-1;0;-1;1;1;-1;-1;-1;-1;-1;1;1;0;1;1;-1;-1;-1;-1;-1;-1;-1;-1;0;-1;-1;-1;-1;-1;-1; - -1;-1;-1;1;0;-1;-1;-1;-1;-1;1;1;1;1;1;0;1;-1;1;1;1;1;1;1;1;-1;0;-1;1;1;1;1;1;1;1;1;1;0;1;1; - 1;1;1;1;1;-1;-1;-1;0;-1;1;1;1;1;1;-1;-1;-1;1;0 - |] + 0;-255;-127;-128;-129;-1;-1;-1;-1;-1;255;0;128;127;126;-1;-1; + -1;-1;-1;127;-128;0;-1;-2;-1;-1;-1;-1;-1;128;-127;1;0;-1;-1; + -1;-1;-1;-1;129;-126;2;1;0;-1;-1;-1;-1;-1;1;1;1;1;1;0;-255; + -127;-128;-129;1;1;1;1;1;255;0;128;127;126;1;1;1;1;1;127; + -128;0;-1;-2;1;1;1;1;1;128;-127;1;0;-1;1;1;1;1;1;129;-126; + 2;1;0|] [] member __.``SBytes.Collection.ArrayArray C.I.less_than``() = validate (SBytes.Collection.ArrayArray) C.I.less_than [| - 0;0;1;0;0;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1; - 1;1;1;0;0;1;1;1;1;1;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;0;1;0;0;0;0;0;0;0;0;0;0;0;0; - 0;0;0;0;0;1;1;1;0;1;0;0;0;0;0;1;1;1;0;0 + 0;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;0;1;0;1;1;1; + 1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;1;0;0;0;1;1;1;1;1;0;0; + 0;0;0;0;1;1;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0; + 1;1;0;0;0;0;0;0;1;0;0;1;0;0;0;0;0;0;1;0;0;0 |] [] member __.``SBytes.Collection.ArrayArray C.I.less_or_equal``() = validate (SBytes.Collection.ArrayArray) C.I.less_or_equal [| - 1;0;1;0;0;1;1;1;1;1;1;1;1;0;0;1;1;1;1;1;0;0;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; - 1;1;1;0;1;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;0;0;0;0;0;1;1;1;0;0;0;0;0;0;0;0;0;1;0;0; - 0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;1;1;1;0;1 + 1;1;1;1;1;1;1;1;1;1;0;1;0;0;0;1;1;1;1;1;0;1;1;1;1;1; + 1;1;1;1;0;1;0;1;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;0; + 0;0;0;1;1;1;1;1;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;1;1; + 1;1;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;0;0;1 |] [] member __.``SBytes.Collection.ArrayArray C.I.greater_than``() = validate (SBytes.Collection.ArrayArray) C.I.greater_than [| - 0;1;0;1;1;0;0;0;0;0;0;0;0;1;1;0;0;0;0;0;1;1;0;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; - 0;0;0;1;0;0;0;0;0;0;1;1;1;1;1;0;1;0;1;1;1;1;1;1;1;0;0;0;1;1;1;1;1;1;1;1;1;0;1;1; - 1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;0;0;0;1;0 + 0;0;0;0;0;0;0;0;0;0;1;0;1;1;1;0;0;0;0;0;1;0;0;0;0;0; + 0;0;0;0;1;0;1;0;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;1; + 1;1;1;0;0;0;0;0;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;0;0; + 0;0;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;1;1;0 |] [] member __.``SBytes.Collection.ArrayArray C.I.greater_or_equal``() = validate (SBytes.Collection.ArrayArray) C.I.greater_or_equal [| - 1;1;0;1;1;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0; - 0;0;0;1;1;0;0;0;0;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1; - 1;1;1;1;1;0;0;0;1;0;1;1;1;1;1;0;0;0;1;1 + 1;0;0;0;0;0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;0; + 0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;0;1;1;1;0;0;0;0;0;1;1; + 1;1;1;1;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1; + 0;0;1;1;1;1;1;1;0;1;1;0;1;1;1;1;1;1;0;1;1;1 |] [] @@ -5247,41 +5253,48 @@ type GeneratedTestSuite () = [] member __.``SBytes.Collection.ArrayArray C.N.compare``() = validate (SBytes.Collection.ArrayArray) C.N.compare [| - 0;1;-1;1;1;-1;-1;-1;-1;-1;-1;0;-1;1;1;-1;-1;-1;-1;-1;1;1;0;1;1;-1;-1;-1;-1;-1;-1;-1;-1;0;-1;-1;-1;-1;-1;-1; - -1;-1;-1;1;0;-1;-1;-1;-1;-1;1;1;1;1;1;0;1;-1;1;1;1;1;1;1;1;-1;0;-1;1;1;1;1;1;1;1;1;1;0;1;1; - 1;1;1;1;1;-1;-1;-1;0;-1;1;1;1;1;1;-1;-1;-1;1;0 + 0;-255;-127;-128;-129;-1;-1;-1;-1;-1;255;0;128;127;126;-1;-1; + -1;-1;-1;127;-128;0;-1;-2;-1;-1;-1;-1;-1;128;-127;1;0;-1;-1; + -1;-1;-1;-1;129;-126;2;1;0;-1;-1;-1;-1;-1;1;1;1;1;1;0;-255; + -127;-128;-129;1;1;1;1;1;255;0;128;127;126;1;1;1;1;1;127; + -128;0;-1;-2;1;1;1;1;1;128;-127;1;0;-1;1;1;1;1;1;129;-126; + 2;1;0 |] [] member __.``SBytes.Collection.ArrayArray C.N.less_than``() = validate (SBytes.Collection.ArrayArray) C.N.less_than [| - 0;0;1;0;0;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1; - 1;1;1;0;0;1;1;1;1;1;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;0;1;0;0;0;0;0;0;0;0;0;0;0;0; - 0;0;0;0;0;1;1;1;0;1;0;0;0;0;0;1;1;1;0;0 + 0;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;0;1;0;1;1;1; + 1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;1;0;0;0;1;1;1;1;1;0;0; + 0;0;0;0;1;1;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0; + 1;1;0;0;0;0;0;0;1;0;0;1;0;0;0;0;0;0;1;0;0;0 |] [] member __.``SBytes.Collection.ArrayArray C.N.less_or_equal``() = validate (SBytes.Collection.ArrayArray) C.N.less_or_equal [| - 1;0;1;0;0;1;1;1;1;1;1;1;1;0;0;1;1;1;1;1;0;0;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; - 1;1;1;0;1;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;0;0;0;0;0;1;1;1;0;0;0;0;0;0;0;0;0;1;0;0; - 0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;1;1;1;0;1 + 1;1;1;1;1;1;1;1;1;1;0;1;0;0;0;1;1;1;1;1;0;1;1;1;1;1; + 1;1;1;1;0;1;0;1;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;0; + 0;0;0;1;1;1;1;1;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;1;1; + 1;1;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;0;0;1 |] [] member __.``SBytes.Collection.ArrayArray C.N.greater_than``() = validate (SBytes.Collection.ArrayArray) C.N.greater_than [| - 0;1;0;1;1;0;0;0;0;0;0;0;0;1;1;0;0;0;0;0;1;1;0;1;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; - 0;0;0;1;0;0;0;0;0;0;1;1;1;1;1;0;1;0;1;1;1;1;1;1;1;0;0;0;1;1;1;1;1;1;1;1;1;0;1;1; - 1;1;1;1;1;0;0;0;0;0;1;1;1;1;1;0;0;0;1;0 + 0;0;0;0;0;0;0;0;0;0;1;0;1;1;1;0;0;0;0;0;1;0;0;0;0;0; + 0;0;0;0;1;0;1;0;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;1; + 1;1;1;0;0;0;0;0;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;0;0; + 0;0;1;1;1;1;1;1;0;1;0;0;1;1;1;1;1;1;0;1;1;0 |] [] member __.``SBytes.Collection.ArrayArray C.N.greater_or_equal``() = validate (SBytes.Collection.ArrayArray) C.N.greater_or_equal [| - 1;1;0;1;1;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0; - 0;0;0;1;1;0;0;0;0;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1; - 1;1;1;1;1;0;0;0;1;0;1;1;1;1;1;0;0;0;1;1 + 1;0;0;0;0;0;0;0;0;0;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;0; + 0;0;0;0;1;0;1;1;0;0;0;0;0;0;1;0;1;1;1;0;0;0;0;0;1;1; + 1;1;1;1;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1; + 0;0;1;1;1;1;1;1;0;1;1;0;1;1;1;1;1;1;0;1;1;1 |] [] diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index 0f36e747976..ef363486f12 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -2229,11 +2229,25 @@ Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_InputMu Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_InputSequenceEmptyString() Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_NoNegateMinValueString() Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.Type GetType() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Collections.Generic.EqualityComparer`1[T] EqualityComparer +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Collections.Generic.EqualityComparer`1[T] get_EqualityComparer() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.String ToString() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Type GetType() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Collections.Generic.EqualityComparer`1[T] EqualityComparer +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Collections.Generic.EqualityComparer`1[T] get_EqualityComparer() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.String ToString() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Type GetType() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean Equals(System.Object) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple2[T1,T2](System.Collections.IEqualityComparer, System.Tuple`2[T1,T2], System.Tuple`2[T1,T2]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple3[T1,T2,T3](System.Collections.IEqualityComparer, System.Tuple`3[T1,T2,T3], System.Tuple`3[T1,T2,T3]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple4[T1,T2,T3,T4](System.Collections.IEqualityComparer, System.Tuple`4[T1,T2,T3,T4], System.Tuple`4[T1,T2,T3,T4]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple5[T1,T2,T3,T4,T5](System.Collections.IEqualityComparer, System.Tuple`5[T1,T2,T3,T4,T5], System.Tuple`5[T1,T2,T3,T4,T5]) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FSharpEqualityComparer_ER_Equals[T](T, T) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FSharpEqualityComparer_PER_Equals[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityERIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityWithComparerIntrinsic[T](System.Collections.IEqualityComparer, T, T) @@ -2250,6 +2264,7 @@ Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple2[T1,T2 Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple3[T1,T2,T3](System.Collections.IEqualityComparer, System.Tuple`3[T1,T2,T3]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple4[T1,T2,T3,T4](System.Collections.IEqualityComparer, System.Tuple`4[T1,T2,T3,T4]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple5[T1,T2,T3,T4,T5](System.Collections.IEqualityComparer, System.Tuple`5[T1,T2,T3,T4,T5]) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FSharpEqualityComparer_GetHashCode[T](T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericComparisonIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericComparisonWithComparerIntrinsic[T](System.Collections.IComparer, T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericHashIntrinsic[T](T) @@ -2257,6 +2272,8 @@ Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericHashWithCompa Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GetHashCode() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 LimitedGenericHashIntrinsic[T](Int32, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 PhysicalHashIntrinsic[T](T) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T] +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T] Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: System.String ToString() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: System.Type GetType() Microsoft.FSharp.Core.LanguagePrimitives+IntrinsicFunctions: Boolean Equals(System.Object) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index 54038feab93..7f08a8900ac 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -2316,11 +2316,25 @@ Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_InputMu Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_InputSequenceEmptyString() Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.String get_NoNegateMinValueString() Microsoft.FSharp.Core.LanguagePrimitives+ErrorStrings: System.Type GetType() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Collections.Generic.EqualityComparer`1[T] EqualityComparer +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Collections.Generic.EqualityComparer`1[T] get_EqualityComparer() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.String ToString() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T]: System.Type GetType() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: Boolean Equals(System.Object) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: Int32 GetHashCode() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Collections.Generic.EqualityComparer`1[T] EqualityComparer +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Collections.Generic.EqualityComparer`1[T] get_EqualityComparer() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.String ToString() +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T]: System.Type GetType() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean Equals(System.Object) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple2[T1,T2](System.Collections.IEqualityComparer, System.Tuple`2[T1,T2], System.Tuple`2[T1,T2]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple3[T1,T2,T3](System.Collections.IEqualityComparer, System.Tuple`3[T1,T2,T3], System.Tuple`3[T1,T2,T3]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple4[T1,T2,T3,T4](System.Collections.IEqualityComparer, System.Tuple`4[T1,T2,T3,T4], System.Tuple`4[T1,T2,T3,T4]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FastEqualsTuple5[T1,T2,T3,T4,T5](System.Collections.IEqualityComparer, System.Tuple`5[T1,T2,T3,T4,T5], System.Tuple`5[T1,T2,T3,T4,T5]) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FSharpEqualityComparer_ER_Equals[T](T, T) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean FSharpEqualityComparer_PER_Equals[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityERIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Boolean GenericEqualityWithComparerIntrinsic[T](System.Collections.IEqualityComparer, T, T) @@ -2337,6 +2351,7 @@ Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple2[T1,T2 Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple3[T1,T2,T3](System.Collections.IEqualityComparer, System.Tuple`3[T1,T2,T3]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple4[T1,T2,T3,T4](System.Collections.IEqualityComparer, System.Tuple`4[T1,T2,T3,T4]) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FastHashTuple5[T1,T2,T3,T4,T5](System.Collections.IEqualityComparer, System.Tuple`5[T1,T2,T3,T4,T5]) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 FSharpEqualityComparer_GetHashCode[T](T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericComparisonIntrinsic[T](T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericComparisonWithComparerIntrinsic[T](System.Collections.IComparer, T, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericHashIntrinsic[T](T) @@ -2344,6 +2359,8 @@ Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GenericHashWithCompa Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 GetHashCode() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 LimitedGenericHashIntrinsic[T](Int32, T) Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Int32 PhysicalHashIntrinsic[T](T) +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_ER`1[T] +Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: Microsoft.FSharp.Core.LanguagePrimitives+HashCompare+FSharpEqualityComparer_PER`1[T] Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: System.String ToString() Microsoft.FSharp.Core.LanguagePrimitives+HashCompare: System.Type GetType() Microsoft.FSharp.Core.LanguagePrimitives+IntrinsicFunctions: Boolean Equals(System.Object) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Joins01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Joins01.il.bsl index 22342da9b92..603c997764a 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Joins01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Linq101Joins01.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly extern Utils { @@ -38,20 +38,20 @@ } .mresource public FSharpSignatureData.Linq101Joins01 { - // Offset: 0x00000000 Length: 0x000002F4 + // Offset: 0x00000000 Length: 0x00000326 } .mresource public FSharpOptimizationData.Linq101Joins01 { - // Offset: 0x000002F8 Length: 0x000000C3 + // Offset: 0x00000330 Length: 0x000000C3 } .module Linq101Joins01.exe -// MVID: {5A1F62A6-151B-685E-A745-0383A6621F5A} +// MVID: {5B2D78B8-151B-685E-A745-0383B8782D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x03830000 +// Image base: 0x027D0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -81,7 +81,7 @@ // Code size 2 (0x2) .maxstack 8 .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 14,14 : 32,33 'C:\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\QueryExpressionStepping\\Linq101Joins01.fs' + .line 14,14 : 32,33 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\QueryExpressionStepping\\Linq101Joins01.fs' IL_0000: ldarg.1 IL_0001: ret } // end of method q@14::Invoke @@ -790,54 +790,67 @@ .method public strict virtual instance class [FSharp.Core]Microsoft.FSharp.Linq.QuerySource`2,class [Utils]Utils/Product,string>,object> Invoke(class [Utils]Utils/Product _arg2) cil managed { - // Code size 69 (0x45) + // Code size 86 (0x56) .maxstack 9 .locals init ([0] class [Utils]Utils/Product p, - [1] string t) + [1] string t, + [2] object V_2, + [3] object V_3, + [4] object V_4, + [5] object V_5) .line 40,40 : 9,40 '' IL_0000: ldarg.1 IL_0001: stloc.0 .line 41,41 : 17,39 '' IL_0002: ldloc.0 IL_0003: box [Utils]Utils/Product - IL_0008: ldnull - IL_0009: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityIntrinsic(!!0, - !!0) - IL_000e: brfalse.s IL_0012 - - IL_0010: br.s IL_0014 - - IL_0012: br.s IL_001c + IL_0008: stloc.2 + IL_0009: ldnull + IL_000a: stloc.3 + IL_000b: ldloc.2 + IL_000c: stloc.s V_4 + IL_000e: ldloc.3 + IL_000f: stloc.s V_5 + IL_0011: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_0016: ldloc.s V_4 + IL_0018: ldloc.s V_5 + IL_001a: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_001f: brfalse.s IL_0023 + + IL_0021: br.s IL_0025 + + IL_0023: br.s IL_002d .line 41,41 : 40,55 '' - IL_0014: ldstr "(No products)" + IL_0025: ldstr "(No products)" .line 100001,100001 : 0,0 '' - IL_0019: nop - IL_001a: br.s IL_0023 + IL_002a: nop + IL_002b: br.s IL_0034 .line 41,41 : 61,74 '' - IL_001c: ldloc.0 - IL_001d: callvirt instance string [Utils]Utils/Product::get_ProductName() + IL_002d: ldloc.0 + IL_002e: callvirt instance string [Utils]Utils/Product::get_ProductName() .line 100001,100001 : 0,0 '' - IL_0022: nop + IL_0033: nop .line 100001,100001 : 0,0 '' - IL_0023: stloc.1 + IL_0034: stloc.1 .line 42,42 : 9,22 '' - IL_0024: ldarg.0 - IL_0025: ldfld class [FSharp.Core]Microsoft.FSharp.Linq.QueryBuilder Linq101Joins01/'q4@40-4'::builder@ - IL_002a: ldarg.0 - IL_002b: ldfld string Linq101Joins01/'q4@40-4'::c - IL_0030: ldarg.0 - IL_0031: ldfld class [mscorlib]System.Collections.Generic.IEnumerable`1 Linq101Joins01/'q4@40-4'::ps - IL_0036: ldloc.0 - IL_0037: ldloc.1 - IL_0038: newobj instance void class [mscorlib]System.Tuple`4,class [Utils]Utils/Product,string>::.ctor(!0, + IL_0035: ldarg.0 + IL_0036: ldfld class [FSharp.Core]Microsoft.FSharp.Linq.QueryBuilder Linq101Joins01/'q4@40-4'::builder@ + IL_003b: ldarg.0 + IL_003c: ldfld string Linq101Joins01/'q4@40-4'::c + IL_0041: ldarg.0 + IL_0042: ldfld class [mscorlib]System.Collections.Generic.IEnumerable`1 Linq101Joins01/'q4@40-4'::ps + IL_0047: ldloc.0 + IL_0048: ldloc.1 + IL_0049: newobj instance void class [mscorlib]System.Tuple`4,class [Utils]Utils/Product,string>::.ctor(!0, !1, !2, !3) - IL_003d: tail. - IL_003f: callvirt instance class [FSharp.Core]Microsoft.FSharp.Linq.QuerySource`2 [FSharp.Core]Microsoft.FSharp.Linq.QueryBuilder::Yield,class [Utils]Utils/Product,string>,object>(!!0) - IL_0044: ret + IL_004e: tail. + IL_0050: callvirt instance class [FSharp.Core]Microsoft.FSharp.Linq.QuerySource`2 [FSharp.Core]Microsoft.FSharp.Linq.QueryBuilder::Yield,class [Utils]Utils/Product,string>,object>(!!0) + IL_0055: ret } // end of method 'q4@40-4'::Invoke } // end of class 'q4@40-4' diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/StaticInit/StaticInit_Struct01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/StaticInit/StaticInit_Struct01.il.bsl index 55664ad8b3a..17ce5430574 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/StaticInit/StaticInit_Struct01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/StaticInit/StaticInit_Struct01.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly StaticInit_Struct01 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.StaticInit_Struct01 { - // Offset: 0x00000000 Length: 0x000007B1 + // Offset: 0x00000000 Length: 0x000007B5 } .mresource public FSharpOptimizationData.StaticInit_Struct01 { - // Offset: 0x000007B8 Length: 0x0000021F + // Offset: 0x000007C0 Length: 0x0000021F } .module StaticInit_Struct01.dll -// MVID: {59B19250-05F6-D6CB-A745-03835092B159} +// MVID: {5B2D78C5-05F6-D6CB-A745-0383C5782D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02BA0000 +// Image base: 0x02C80000 // =============== CLASS MEMBERS DECLARATION =================== @@ -71,7 +71,7 @@ .maxstack 5 .locals init ([0] valuetype StaticInit_Struct01/C& V_0) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 4,4 : 6,7 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\StaticInit\\StaticInit_Struct01.fs' + .line 4,4 : 6,7 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\StaticInit\\StaticInit_Struct01.fs' IL_0000: ldarga.s obj IL_0002: stloc.0 IL_0003: call class [mscorlib]System.Collections.IComparer [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives::get_GenericComparer() @@ -256,20 +256,33 @@ instance bool Equals(valuetype StaticInit_Struct01/C obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 23 (0x17) - .maxstack 4 - .locals init ([0] valuetype StaticInit_Struct01/C& V_0) + // Code size 38 (0x26) + .maxstack 5 + .locals init ([0] valuetype StaticInit_Struct01/C& V_0, + [1] valuetype [mscorlib]System.DateTime V_1, + [2] valuetype [mscorlib]System.DateTime V_2, + [3] valuetype [mscorlib]System.DateTime V_3, + [4] valuetype [mscorlib]System.DateTime V_4) .line 4,4 : 6,7 '' IL_0000: ldarga.s obj IL_0002: stloc.0 IL_0003: ldarg.0 IL_0004: ldfld valuetype [mscorlib]System.DateTime StaticInit_Struct01/C::s - IL_0009: ldloc.0 - IL_000a: ldfld valuetype [mscorlib]System.DateTime StaticInit_Struct01/C::s - IL_000f: tail. - IL_0011: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0016: ret + IL_0009: stloc.1 + IL_000a: ldloc.0 + IL_000b: ldfld valuetype [mscorlib]System.DateTime StaticInit_Struct01/C::s + IL_0010: stloc.2 + IL_0011: ldloc.1 + IL_0012: stloc.3 + IL_0013: ldloc.2 + IL_0014: stloc.s V_4 + IL_0016: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_001b: ldloc.3 + IL_001c: ldloc.s V_4 + IL_001e: tail. + IL_0020: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_0025: ret } // end of method C::Equals .method public hidebysig virtual final diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl index 70335b05d20..cb04fa9fb46 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Compare07.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Compare07 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Compare07 { - // Offset: 0x00000000 Length: 0x0000089A + // Offset: 0x00000000 Length: 0x0000089E } .mresource public FSharpOptimizationData.Compare07 { - // Offset: 0x000008A0 Length: 0x00000692 + // Offset: 0x000008A8 Length: 0x0000069A } .module Compare07.dll -// MVID: {59B18AEE-05DE-F88E-A745-0383EE8AB159} +// MVID: {5B2D7B11-05DE-F88E-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x02BA0000 +// Image base: 0x02640000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare07.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Compare07.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -560,8 +560,8 @@ instance bool Equals(class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 77 (0x4d) - .maxstack 4 + // Code size 87 (0x57) + .maxstack 5 .locals init ([0] class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 V_0, [1] class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1 V_1, [2] !a V_2, @@ -570,13 +570,13 @@ IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un - IL_0004: brfalse.s IL_0045 + IL_0004: brfalse.s IL_004f .line 16707566,16707566 : 0,0 '' IL_0006: ldarg.1 IL_0007: ldnull IL_0008: cgt.un - IL_000a: brfalse.s IL_0043 + IL_000a: brfalse.s IL_004d .line 16707566,16707566 : 0,0 '' IL_000c: ldarg.0 @@ -592,41 +592,43 @@ IL_0019: ldloc.1 IL_001a: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item1 IL_001f: stloc.3 - IL_0020: ldloc.2 - IL_0021: ldloc.3 - IL_0022: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0027: brfalse.s IL_0041 - - .line 16707566,16707566 : 0,0 '' - IL_0029: ldloc.0 - IL_002a: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_002f: stloc.2 - IL_0030: ldloc.1 - IL_0031: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_0036: stloc.3 - IL_0037: ldloc.2 - IL_0038: ldloc.3 - IL_0039: tail. - IL_003b: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0040: ret + IL_0020: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0025: ldloc.2 + IL_0026: ldloc.3 + IL_0027: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_002c: brfalse.s IL_004b + + .line 16707566,16707566 : 0,0 '' + IL_002e: ldloc.0 + IL_002f: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_0034: stloc.2 + IL_0035: ldloc.1 + IL_0036: ldfld !0 class Compare07/CompareMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_003b: stloc.3 + IL_003c: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0041: ldloc.2 + IL_0042: ldloc.3 + IL_0043: tail. + IL_0045: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_004a: ret .line 16707566,16707566 : 0,0 '' - IL_0041: ldc.i4.0 - IL_0042: ret + IL_004b: ldc.i4.0 + IL_004c: ret .line 16707566,16707566 : 0,0 '' - IL_0043: ldc.i4.0 - IL_0044: ret + IL_004d: ldc.i4.0 + IL_004e: ret .line 16707566,16707566 : 0,0 '' - IL_0045: ldarg.1 - IL_0046: ldnull - IL_0047: cgt.un - IL_0049: ldc.i4.0 - IL_004a: ceq - IL_004c: ret + IL_004f: ldarg.1 + IL_0050: ldnull + IL_0051: cgt.un + IL_0053: ldc.i4.0 + IL_0054: ceq + IL_0056: ret } // end of method GenericKey`1::Equals .method public hidebysig virtual final diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl index 91247bff24d..e575063fd39 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals06.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Equals06 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals06 { - // Offset: 0x00000000 Length: 0x00000896 + // Offset: 0x00000000 Length: 0x0000089A } .mresource public FSharpOptimizationData.Equals06 { - // Offset: 0x000008A0 Length: 0x0000068E + // Offset: 0x000008A0 Length: 0x00000696 } .module Equals06.dll -// MVID: {59B18AEE-0759-31EC-A745-0383EE8AB159} +// MVID: {5B2D7B11-0759-31EC-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01B90000 +// Image base: 0x02980000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals06.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals06.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -560,8 +560,8 @@ instance bool Equals(class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 77 (0x4d) - .maxstack 4 + // Code size 87 (0x57) + .maxstack 5 .locals init ([0] class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 V_0, [1] class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1 V_1, [2] !a V_2, @@ -570,13 +570,13 @@ IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un - IL_0004: brfalse.s IL_0045 + IL_0004: brfalse.s IL_004f .line 16707566,16707566 : 0,0 '' IL_0006: ldarg.1 IL_0007: ldnull IL_0008: cgt.un - IL_000a: brfalse.s IL_0043 + IL_000a: brfalse.s IL_004d .line 16707566,16707566 : 0,0 '' IL_000c: ldarg.0 @@ -592,41 +592,43 @@ IL_0019: ldloc.1 IL_001a: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item1 IL_001f: stloc.3 - IL_0020: ldloc.2 - IL_0021: ldloc.3 - IL_0022: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0027: brfalse.s IL_0041 - - .line 16707566,16707566 : 0,0 '' - IL_0029: ldloc.0 - IL_002a: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_002f: stloc.2 - IL_0030: ldloc.1 - IL_0031: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_0036: stloc.3 - IL_0037: ldloc.2 - IL_0038: ldloc.3 - IL_0039: tail. - IL_003b: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0040: ret + IL_0020: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0025: ldloc.2 + IL_0026: ldloc.3 + IL_0027: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_002c: brfalse.s IL_004b + + .line 16707566,16707566 : 0,0 '' + IL_002e: ldloc.0 + IL_002f: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_0034: stloc.2 + IL_0035: ldloc.1 + IL_0036: ldfld !0 class Equals06/EqualsMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_003b: stloc.3 + IL_003c: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0041: ldloc.2 + IL_0042: ldloc.3 + IL_0043: tail. + IL_0045: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_004a: ret .line 16707566,16707566 : 0,0 '' - IL_0041: ldc.i4.0 - IL_0042: ret + IL_004b: ldc.i4.0 + IL_004c: ret .line 16707566,16707566 : 0,0 '' - IL_0043: ldc.i4.0 - IL_0044: ret + IL_004d: ldc.i4.0 + IL_004e: ret .line 16707566,16707566 : 0,0 '' - IL_0045: ldarg.1 - IL_0046: ldnull - IL_0047: cgt.un - IL_0049: ldc.i4.0 - IL_004a: ceq - IL_004c: ret + IL_004f: ldarg.1 + IL_0050: ldnull + IL_0051: cgt.un + IL_0053: ldc.i4.0 + IL_0054: ceq + IL_0056: ret } // end of method GenericKey`1::Equals .method public hidebysig virtual final diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals07.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals07.il.bsl index 91f97c289a2..1ce42f2b348 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals07.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals07.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Equals07 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals07 { - // Offset: 0x00000000 Length: 0x0000022D + // Offset: 0x00000000 Length: 0x00000245 } .mresource public FSharpOptimizationData.Equals07 { - // Offset: 0x00000238 Length: 0x000000AF + // Offset: 0x00000250 Length: 0x000000AF } .module Equals07.dll -// MVID: {59B18AEE-0759-AE27-A745-0383EE8AB159} +// MVID: {5B2D7B11-0759-AE27-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01C80000 +// Image base: 0x02D80000 // =============== CLASS MEMBERS DECLARATION =================== @@ -57,14 +57,14 @@ .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .method public static bool f7() cil managed { - // Code size 68 (0x44) + // Code size 73 (0x49) .maxstack 5 .locals init ([0] bool x, [1] uint8[] t1, [2] uint8[] t2, [3] int32 i) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 5,5 : 8,29 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals07.fsx' + .line 5,5 : 8,29 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals07.fsx' IL_0000: ldc.i4.0 IL_0001: stloc.0 .line 6,6 : 8,35 '' @@ -90,26 +90,27 @@ .line 8,8 : 8,32 '' IL_002a: ldc.i4.0 IL_002b: stloc.3 - IL_002c: br.s IL_003a + IL_002c: br.s IL_003f .line 9,9 : 12,26 '' - IL_002e: ldloc.1 - IL_002f: ldloc.2 - IL_0030: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityIntrinsic(!!0, - !!0) - IL_0035: stloc.0 - IL_0036: ldloc.3 - IL_0037: ldc.i4.1 - IL_0038: add - IL_0039: stloc.3 + IL_002e: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_0033: ldloc.1 + IL_0034: ldloc.2 + IL_0035: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_003a: stloc.0 + IL_003b: ldloc.3 + IL_003c: ldc.i4.1 + IL_003d: add + IL_003e: stloc.3 .line 8,8 : 8,32 '' - IL_003a: ldloc.3 - IL_003b: ldc.i4 0x989681 - IL_0040: blt.s IL_002e + IL_003f: ldloc.3 + IL_0040: ldc.i4 0x989681 + IL_0045: blt.s IL_002e .line 10,10 : 8,9 '' - IL_0042: ldloc.0 - IL_0043: ret + IL_0047: ldloc.0 + IL_0048: ret } // end of method EqualsMicroPerfAndCodeGenerationTests::f7 } // end of class EqualsMicroPerfAndCodeGenerationTests diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals08.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals08.il.bsl index 55da6ee102e..39e19138617 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals08.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Equals08.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Equals08 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Equals08 { - // Offset: 0x00000000 Length: 0x0000022D + // Offset: 0x00000000 Length: 0x00000245 } .mresource public FSharpOptimizationData.Equals08 { - // Offset: 0x00000238 Length: 0x000000AF + // Offset: 0x00000250 Length: 0x000000AF } .module Equals08.dll -// MVID: {59B18AEE-0759-659E-A745-0383EE8AB159} +// MVID: {5B2D7B11-0759-659E-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01090000 +// Image base: 0x02FD0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -57,14 +57,14 @@ .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .method public static bool f8() cil managed { - // Code size 68 (0x44) + // Code size 73 (0x49) .maxstack 5 .locals init ([0] bool x, [1] int32[] t1, [2] int32[] t2, [3] int32 i) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 5,5 : 8,29 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals08.fsx' + .line 5,5 : 8,29 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Equals08.fsx' IL_0000: ldc.i4.0 IL_0001: stloc.0 .line 6,6 : 8,31 '' @@ -90,26 +90,27 @@ .line 8,8 : 8,32 '' IL_002a: ldc.i4.0 IL_002b: stloc.3 - IL_002c: br.s IL_003a + IL_002c: br.s IL_003f .line 9,9 : 12,26 '' - IL_002e: ldloc.1 - IL_002f: ldloc.2 - IL_0030: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityIntrinsic(!!0, - !!0) - IL_0035: stloc.0 - IL_0036: ldloc.3 - IL_0037: ldc.i4.1 - IL_0038: add - IL_0039: stloc.3 + IL_002e: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_0033: ldloc.1 + IL_0034: ldloc.2 + IL_0035: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_003a: stloc.0 + IL_003b: ldloc.3 + IL_003c: ldc.i4.1 + IL_003d: add + IL_003e: stloc.3 .line 8,8 : 8,32 '' - IL_003a: ldloc.3 - IL_003b: ldc.i4 0x989681 - IL_0040: blt.s IL_002e + IL_003f: ldloc.3 + IL_0040: ldc.i4 0x989681 + IL_0045: blt.s IL_002e .line 10,10 : 8,9 '' - IL_0042: ldloc.0 - IL_0043: ret + IL_0047: ldloc.0 + IL_0048: ret } // end of method EqualsMicroPerfAndCodeGenerationTests::f8 } // end of class EqualsMicroPerfAndCodeGenerationTests diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl index df7b115d207..726d2aea5e8 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash09.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Hash09 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash09 { - // Offset: 0x00000000 Length: 0x0000088E + // Offset: 0x00000000 Length: 0x00000892 } .mresource public FSharpOptimizationData.Hash09 { - // Offset: 0x00000898 Length: 0x00000686 + // Offset: 0x00000898 Length: 0x0000068E } .module Hash09.dll -// MVID: {59B18AEE-9642-77DB-A745-0383EE8AB159} +// MVID: {5B2D7B11-9642-77DB-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00690000 +// Image base: 0x02990000 // =============== CLASS MEMBERS DECLARATION =================== @@ -187,7 +187,7 @@ [4] !a V_4, [5] !a V_5) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 16707566,16707566 : 0,0 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash09.fsx' + .line 16707566,16707566 : 0,0 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash09.fsx' IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un @@ -560,8 +560,8 @@ instance bool Equals(class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 obj) cil managed { .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - // Code size 77 (0x4d) - .maxstack 4 + // Code size 87 (0x57) + .maxstack 5 .locals init ([0] class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 V_0, [1] class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1 V_1, [2] !a V_2, @@ -570,13 +570,13 @@ IL_0000: ldarg.0 IL_0001: ldnull IL_0002: cgt.un - IL_0004: brfalse.s IL_0045 + IL_0004: brfalse.s IL_004f .line 16707566,16707566 : 0,0 '' IL_0006: ldarg.1 IL_0007: ldnull IL_0008: cgt.un - IL_000a: brfalse.s IL_0043 + IL_000a: brfalse.s IL_004d .line 16707566,16707566 : 0,0 '' IL_000c: ldarg.0 @@ -592,41 +592,43 @@ IL_0019: ldloc.1 IL_001a: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item1 IL_001f: stloc.3 - IL_0020: ldloc.2 - IL_0021: ldloc.3 - IL_0022: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0027: brfalse.s IL_0041 - - .line 16707566,16707566 : 0,0 '' - IL_0029: ldloc.0 - IL_002a: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_002f: stloc.2 - IL_0030: ldloc.1 - IL_0031: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item2 - IL_0036: stloc.3 - IL_0037: ldloc.2 - IL_0038: ldloc.3 - IL_0039: tail. - IL_003b: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityERIntrinsic(!!0, - !!0) - IL_0040: ret + IL_0020: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0025: ldloc.2 + IL_0026: ldloc.3 + IL_0027: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_002c: brfalse.s IL_004b + + .line 16707566,16707566 : 0,0 '' + IL_002e: ldloc.0 + IL_002f: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_0034: stloc.2 + IL_0035: ldloc.1 + IL_0036: ldfld !0 class Hash09/HashMicroPerfAndCodeGenerationTests/GenericKey`1::item2 + IL_003b: stloc.3 + IL_003c: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_ER`1::get_EqualityComparer() + IL_0041: ldloc.2 + IL_0042: ldloc.3 + IL_0043: tail. + IL_0045: callvirt instance bool class [mscorlib]System.Collections.Generic.EqualityComparer`1::Equals(!0, + !0) + IL_004a: ret .line 16707566,16707566 : 0,0 '' - IL_0041: ldc.i4.0 - IL_0042: ret + IL_004b: ldc.i4.0 + IL_004c: ret .line 16707566,16707566 : 0,0 '' - IL_0043: ldc.i4.0 - IL_0044: ret + IL_004d: ldc.i4.0 + IL_004e: ret .line 16707566,16707566 : 0,0 '' - IL_0045: ldarg.1 - IL_0046: ldnull - IL_0047: cgt.un - IL_0049: ldc.i4.0 - IL_004a: ceq - IL_004c: ret + IL_004f: ldarg.1 + IL_0050: ldnull + IL_0051: cgt.un + IL_0053: ldc.i4.0 + IL_0054: ceq + IL_0056: ret } // end of method GenericKey`1::Equals .method public hidebysig virtual final diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash10.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash10.il.bsl index 20c3ceeb8f6..029eaf7814a 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash10.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash10.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Hash10 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash10 { - // Offset: 0x00000000 Length: 0x00000219 + // Offset: 0x00000000 Length: 0x00000231 } .mresource public FSharpOptimizationData.Hash10 { - // Offset: 0x00000220 Length: 0x000000A9 + // Offset: 0x00000238 Length: 0x000000A9 } .module Hash10.dll -// MVID: {59B18AEE-9661-78B4-A745-0383EE8AB159} +// MVID: {5B2D7B11-9661-78B4-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x01080000 +// Image base: 0x01690000 // =============== CLASS MEMBERS DECLARATION =================== @@ -57,13 +57,13 @@ .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .method public static void f7() cil managed { - // Code size 44 (0x2c) + // Code size 49 (0x31) .maxstack 5 .locals init ([0] uint8[] arr, [1] int32 i, [2] int32 V_2) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 6,6 : 8,36 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash10.fsx' + .line 6,6 : 8,36 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash10.fsx' IL_0000: ldc.i4.0 IL_0001: ldc.i4.1 IL_0002: ldc.i4.s 100 @@ -76,22 +76,23 @@ .line 7,7 : 8,32 '' IL_0014: ldc.i4.0 IL_0015: stloc.1 - IL_0016: br.s IL_0023 + IL_0016: br.s IL_0028 .line 8,8 : 12,30 '' - IL_0018: ldloc.0 - IL_0019: call int32 [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericHashIntrinsic(!!0) - IL_001e: stloc.2 - IL_001f: ldloc.1 - IL_0020: ldc.i4.1 - IL_0021: add - IL_0022: stloc.1 + IL_0018: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_001d: ldloc.0 + IL_001e: callvirt instance int32 class [mscorlib]System.Collections.Generic.EqualityComparer`1::GetHashCode(!0) + IL_0023: stloc.2 + IL_0024: ldloc.1 + IL_0025: ldc.i4.1 + IL_0026: add + IL_0027: stloc.1 .line 7,7 : 8,32 '' - IL_0023: ldloc.1 - IL_0024: ldc.i4 0x989681 - IL_0029: blt.s IL_0018 + IL_0028: ldloc.1 + IL_0029: ldc.i4 0x989681 + IL_002e: blt.s IL_0018 - IL_002b: ret + IL_0030: ret } // end of method HashMicroPerfAndCodeGenerationTests::f7 } // end of class HashMicroPerfAndCodeGenerationTests diff --git a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash11.il.bsl b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash11.il.bsl index f4eb5020175..9848907a1b1 100644 --- a/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash11.il.bsl +++ b/tests/fsharpqa/Source/Optimizations/GenericComparison/Hash11.il.bsl @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 4:4:3:0 } .assembly Hash11 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.Hash11 { - // Offset: 0x00000000 Length: 0x00000219 + // Offset: 0x00000000 Length: 0x00000231 } .mresource public FSharpOptimizationData.Hash11 { - // Offset: 0x00000220 Length: 0x000000A9 + // Offset: 0x00000238 Length: 0x000000A9 } .module Hash11.dll -// MVID: {59B18AEE-9661-78D3-A745-0383EE8AB159} +// MVID: {5B2D7B11-9661-78D3-A745-0383117B2D5B} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x002D0000 +// Image base: 0x027C0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -57,13 +57,13 @@ .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .method public static void f8() cil managed { - // Code size 44 (0x2c) + // Code size 49 (0x31) .maxstack 5 .locals init ([0] int32[] arr, [1] int32 i, [2] int32 V_2) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 6,6 : 8,32 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash11.fsx' + .line 6,6 : 8,32 'C:\\src\\manofstick\\visualfsharp-nobox\\tests\\fsharpqa\\Source\\Optimizations\\GenericComparison\\Hash11.fsx' IL_0000: ldc.i4.0 IL_0001: ldc.i4.1 IL_0002: ldc.i4.s 100 @@ -76,22 +76,23 @@ .line 7,7 : 8,32 '' IL_0014: ldc.i4.0 IL_0015: stloc.1 - IL_0016: br.s IL_0023 + IL_0016: br.s IL_0028 .line 8,8 : 12,30 '' - IL_0018: ldloc.0 - IL_0019: call int32 [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericHashIntrinsic(!!0) - IL_001e: stloc.2 - IL_001f: ldloc.1 - IL_0020: ldc.i4.1 - IL_0021: add - IL_0022: stloc.1 + IL_0018: call class [mscorlib]System.Collections.Generic.EqualityComparer`1 class [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare/FSharpEqualityComparer_PER`1::get_EqualityComparer() + IL_001d: ldloc.0 + IL_001e: callvirt instance int32 class [mscorlib]System.Collections.Generic.EqualityComparer`1::GetHashCode(!0) + IL_0023: stloc.2 + IL_0024: ldloc.1 + IL_0025: ldc.i4.1 + IL_0026: add + IL_0027: stloc.1 .line 7,7 : 8,32 '' - IL_0023: ldloc.1 - IL_0024: ldc.i4 0x989681 - IL_0029: blt.s IL_0018 + IL_0028: ldloc.1 + IL_0029: ldc.i4 0x989681 + IL_002e: blt.s IL_0018 - IL_002b: ret + IL_0030: ret } // end of method HashMicroPerfAndCodeGenerationTests::f8 } // end of class HashMicroPerfAndCodeGenerationTests