From 9f21d518dd0345940a4f614c5538be3b2c64d894 Mon Sep 17 00:00:00 2001 From: Victor Baybekov Date: Wed, 6 Jan 2021 23:41:35 +0100 Subject: [PATCH 1/3] Map: Optimize away `ininst` check Store height in leaves. Compared to the old discussion, when Left/Right were proposed to be stored in a universal node, this adds 4 bytes to leaves or 2 bytes per item on average (vs 16/8). --- src/fsharp/FSharp.Core/map.fs | 243 ++++++++++++++++++++-------------- 1 file changed, 140 insertions(+), 103 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index c0f28b9715a..92338fd63bf 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -5,25 +5,27 @@ namespace Microsoft.FSharp.Collections open System open System.Collections.Generic open System.Diagnostics +open System.Runtime.CompilerServices open System.Text open Microsoft.FSharp.Core open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators [] [] -type internal MapTree<'Key, 'Value>(k: 'Key, v: 'Value) = +type internal MapTree<'Key, 'Value>(k: 'Key, v: 'Value, h: int) = + member _.Height = h member _.Key = k member _.Value = v - + new(k: 'Key, v: 'Value) = MapTree(k,v,1) + [] [] [] type internal MapTreeNode<'Key, 'Value>(k:'Key, v:'Value, left:MapTree<'Key, 'Value>, right: MapTree<'Key, 'Value>, h: int) = - inherit MapTree<'Key,'Value>(k, v) - + inherit MapTree<'Key,'Value>(k, v, h) member _.Left = left member _.Right = right - member _.Height = h + [] module MapTree = @@ -32,14 +34,17 @@ module MapTree = let inline isEmpty (m:MapTree<'Key, 'Value>) = isNull m + let inline private asNode(value:MapTree<'Key,'Value>) : MapTreeNode<'Key,'Value> = + value :?> MapTreeNode<'Key,'Value> + let rec sizeAux acc (m:MapTree<'Key, 'Value>) = if isEmpty m then acc else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> sizeAux (sizeAux (acc+1) mn.Left) mn.Right - | _ -> acc + 1 - + match m.Height with + | 1 -> acc + 1 + | _ -> let mn = asNode m in sizeAux (sizeAux (acc+1) mn.Left) mn.Right + let size x = sizeAux 0 x #if TRACE_SETS_AND_MAPS @@ -82,10 +87,7 @@ module MapTree = let inline height (m: MapTree<'Key, 'Value>) = if isEmpty m then 0 - else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> mn.Height - | _ -> 1 + else m.Height [] let tolerance = 2 @@ -98,9 +100,6 @@ module MapTree = MapTree(k,v) else MapTreeNode(k,v,l,r,m+1) :> MapTree<'Key, 'Value> // new map is higher by 1 than the highest - - let inline private asNode(value:MapTree<'Key,'Value>) : MapTreeNode<'Key,'Value> = - value :?> MapTreeNode<'Key,'Value> let rebalance t1 (k: 'Key) (v: 'Value) t2 : MapTree<'Key, 'Value> = let t1h = height t1 @@ -129,33 +128,39 @@ module MapTree = if isEmpty m then MapTree(k,v) else let c = comparer.Compare(k,m.Key) - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> - if c < 0 then rebalance (add comparer k v mn.Left) mn.Key mn.Value mn.Right - elif c = 0 then MapTreeNode(k,v,mn.Left,mn.Right,mn.Height) :> MapTree<'Key, 'Value> - else rebalance mn.Left mn.Key mn.Value (add comparer k v mn.Right) - | _ -> + match m.Height with + | 1 -> if c < 0 then MapTreeNode (k,v,empty,m,2) :> MapTree<'Key, 'Value> elif c = 0 then MapTree(k,v) else MapTreeNode (k,v,m,empty,2) :> MapTree<'Key, 'Value> - + | _ -> + let mn = asNode m + if c < 0 then rebalance (add comparer k v mn.Left) mn.Key mn.Value mn.Right + elif c = 0 then MapTreeNode(k,v,mn.Left,mn.Right,mn.Height) :> MapTree<'Key, 'Value> + else rebalance mn.Left mn.Key mn.Value (add comparer k v mn.Right) + let rec tryGetValue (comparer: IComparer<'Key>) k (v: byref<'Value>) (m: MapTree<'Key, 'Value>) = if isEmpty m then false else let c = comparer.Compare(k, m.Key) if c = 0 then v <- m.Value; true else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> false + | _ -> + let mn = asNode m tryGetValue comparer k &v (if c < 0 then mn.Left else mn.Right) - | _ -> false - + + [] + let throwKeyNotFound() = raise (KeyNotFoundException()) + + [] let find (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = let mutable v = Unchecked.defaultof<'Value> if tryGetValue comparer k &v m then v else - raise (KeyNotFoundException()) + throwKeyNotFound() let tryFind (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = let mutable v = Unchecked.defaultof<'Value> @@ -170,12 +175,14 @@ module MapTree = let rec partitionAux (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) acc = if isEmpty m then acc else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> partition1 comparer f m.Key m.Value acc + | _ -> + let mn = asNode m let acc = partitionAux comparer f mn.Right acc let acc = partition1 comparer f mn.Key mn.Value acc partitionAux comparer f mn.Left acc - | _ -> partition1 comparer f m.Key m.Value acc + let partition (comparer: IComparer<'Key>) f m = partitionAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m (empty, empty) @@ -186,12 +193,14 @@ module MapTree = let rec filterAux (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) acc = if isEmpty m then acc else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> filter1 comparer f m.Key m.Value acc + | _ -> + let mn = asNode m let acc = filterAux comparer f mn.Left acc let acc = filter1 comparer f mn.Key mn.Value acc filterAux comparer f mn.Right acc - | _ -> filter1 comparer f m.Key m.Value acc + let filter (comparer: IComparer<'Key>) f m = filterAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m empty @@ -199,18 +208,21 @@ module MapTree = let rec spliceOutSuccessor (m: MapTree<'Key, 'Value>) = if isEmpty m then failwith "internal error: Map.spliceOutSuccessor" else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> m.Key, m.Value, empty + | _ -> + let mn = asNode m if isEmpty mn.Left then mn.Key, mn.Value, mn.Right else let k3, v3, l' = spliceOutSuccessor mn.Left in k3, v3, mk l' mn.Key mn.Value mn.Right - | _ -> m.Key, m.Value, empty let rec remove (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = if isEmpty m then empty else let c = comparer.Compare(k, m.Key) - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> if c = 0 then empty else m + | _ -> + let mn = asNode m if c < 0 then rebalance (remove comparer k mn.Left) mn.Key mn.Value mn.Right elif c = 0 then if isEmpty mn.Left then mn.Right @@ -219,8 +231,7 @@ module MapTree = let sk, sv, r' = spliceOutSuccessor mn.Right mk mn.Left sk sv r' else rebalance mn.Left mn.Key mn.Value (remove comparer k mn.Right) - | _ -> - if c = 0 then empty else m + let rec change (comparer: IComparer<'Key>) k (u: 'Value option -> 'Value option) (m: MapTree<'Key, 'Value>) : MapTree<'Key,'Value> = if isEmpty m then @@ -228,8 +239,23 @@ module MapTree = | None -> m | Some v -> MapTree (k, v) else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> + let c = comparer.Compare(k, m.Key) + if c < 0 then + match u None with + | None -> m + | Some v -> MapTreeNode (k, v, empty, m, 2) :> MapTree<'Key,'Value> + elif c = 0 then + match u (Some m.Value) with + | None -> empty + | Some v -> MapTree (k, v) + else + match u None with + | None -> m + | Some v -> MapTreeNode (k, v, m, empty, 2) :> MapTree<'Key,'Value> + | _ -> + let mn = asNode m let c = comparer.Compare(k, mn.Key) if c < 0 then rebalance (change comparer k u mn.Left) mn.Key mn.Value mn.Right @@ -244,37 +270,28 @@ module MapTree = | Some v -> MapTreeNode (k, v, mn.Left, mn.Right, mn.Height) :> MapTree<'Key,'Value> else rebalance mn.Left mn.Key mn.Value (change comparer k u mn.Right) - | _ -> - let c = comparer.Compare(k, m.Key) - if c < 0 then - match u None with - | None -> m - | Some v -> MapTreeNode (k, v, empty, m, 2) :> MapTree<'Key,'Value> - elif c = 0 then - match u (Some m.Value) with - | None -> empty - | Some v -> MapTree (k, v) - else - match u None with - | None -> m - | Some v -> MapTreeNode (k, v, m, empty, 2) :> MapTree<'Key,'Value> let rec mem (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = if isEmpty m then false else let c = comparer.Compare(k, m.Key) - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> c = 0 + | _ -> + let mn = asNode m if c < 0 then mem comparer k mn.Left else (c = 0 || mem comparer k mn.Right) - | _ -> c = 0 + let rec iterOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = if isEmpty m then () else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> iterOpt f mn.Left; f.Invoke (mn.Key, mn.Value); iterOpt f mn.Right - | _ -> f.Invoke (m.Key, m.Value) + match m.Height with + | 1 -> f.Invoke (m.Key, m.Value) + | _ -> + let mn = asNode m + iterOpt f mn.Left; f.Invoke (mn.Key, mn.Value); iterOpt f mn.Right + let iter f m = iterOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m @@ -282,8 +299,10 @@ module MapTree = let rec tryPickOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = if isEmpty m then None else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> f.Invoke (m.Key, m.Value) + | _ -> + let mn = asNode m match tryPickOpt f mn.Left with | Some _ as res -> res | None -> @@ -291,7 +310,7 @@ module MapTree = | Some _ as res -> res | None -> tryPickOpt f mn.Right - | _ -> f.Invoke (m.Key, m.Value) + let tryPick f m = tryPickOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m @@ -299,9 +318,12 @@ module MapTree = let rec existsOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = if isEmpty m then false else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> existsOpt f mn.Left || f.Invoke (mn.Key, mn.Value) || existsOpt f mn.Right - | _ -> f.Invoke (m.Key, m.Value) + match m.Height with + | 1 -> f.Invoke (m.Key, m.Value) + | _ -> + let mn = asNode m + existsOpt f mn.Left || f.Invoke (mn.Key, mn.Value) || existsOpt f mn.Right + let exists f m = existsOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m @@ -309,9 +331,12 @@ module MapTree = let rec forallOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = if isEmpty m then true else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> forallOpt f mn.Left && f.Invoke (mn.Key, mn.Value) && forallOpt f mn.Right - | _ -> f.Invoke (m.Key, m.Value) + match m.Height with + | 1 -> f.Invoke (m.Key, m.Value) + | _ -> + let mn = asNode m + forallOpt f mn.Left && f.Invoke (mn.Key, mn.Value) && forallOpt f mn.Right + let forall f m = @@ -320,24 +345,27 @@ module MapTree = let rec map (f:'Value -> 'Result) (m: MapTree<'Key, 'Value>) : MapTree<'Key, 'Result> = if isEmpty m then empty else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> MapTree (m.Key, f m.Value) + | _ -> + let mn = asNode m let l2 = map f mn.Left let v2 = f mn.Value let r2 = map f mn.Right MapTreeNode (mn.Key, v2, l2, r2, mn.Height) :> MapTree<'Key, 'Result> - | _ -> MapTree (m.Key, f m.Value) let rec mapiOpt (f: OptimizedClosures.FSharpFunc<'Key, 'Value, 'Result>) (m: MapTree<'Key, 'Value>) = if isEmpty m then empty else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> MapTree (m.Key, f.Invoke (m.Key, m.Value)) + | _ -> + let mn = asNode m let l2 = mapiOpt f mn.Left let v2 = f.Invoke (mn.Key, mn.Value) let r2 = mapiOpt f mn.Right MapTreeNode (mn.Key, v2, l2, r2, mn.Height) :> MapTree<'Key, 'Result> - | _ -> MapTree (m.Key, f.Invoke (m.Key, m.Value)) + let mapi f m = mapiOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m @@ -345,12 +373,14 @@ module MapTree = let rec foldBackOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) (m: MapTree<'Key, 'Value>) x = if isEmpty m then x else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> f.Invoke (m.Key, m.Value, x) + | _ -> + let mn = asNode m let x = foldBackOpt f mn.Right x let x = f.Invoke (mn.Key, mn.Value, x) foldBackOpt f mn.Left x - | _ -> f.Invoke (m.Key, m.Value, x) + let foldBack f m x = foldBackOpt (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) m x @@ -358,12 +388,13 @@ module MapTree = let rec foldOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) x (m: MapTree<'Key, 'Value>) = if isEmpty m then x else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> f.Invoke (x, m.Key, m.Value) + | _ -> + let mn = asNode m let x = foldOpt f x mn.Left let x = f.Invoke (x, mn.Key, mn.Value) foldOpt f x mn.Right - | _ -> f.Invoke (x, m.Key, m.Value) let fold f x m = foldOpt (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) x m @@ -372,19 +403,20 @@ module MapTree = let rec foldFromTo (f: OptimizedClosures.FSharpFunc<_, _, _, _>) (m: MapTree<'Key, 'Value>) x = if isEmpty m then x else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> + match m.Height with + | 1 -> + let cLoKey = comparer.Compare(lo, m.Key) + let cKeyHi = comparer.Compare(m.Key, hi) + let x = if cLoKey <= 0 && cKeyHi <= 0 then f.Invoke (m.Key, m.Value, x) else x + x + | _ -> + let mn = asNode m let cLoKey = comparer.Compare(lo, mn.Key) let cKeyHi = comparer.Compare(mn.Key, hi) let x = if cLoKey < 0 then foldFromTo f mn.Left x else x let x = if cLoKey <= 0 && cKeyHi <= 0 then f.Invoke (mn.Key, mn.Value, x) else x let x = if cKeyHi < 0 then foldFromTo f mn.Right x else x x - | _ -> - let cLoKey = comparer.Compare(lo, m.Key) - let cKeyHi = comparer.Compare(m.Key, hi) - let x = if cLoKey <= 0 && cKeyHi <= 0 then f.Invoke (m.Key, m.Value, x) else x - x if comparer.Compare(lo, hi) = 1 then x else foldFromTo f m x @@ -395,9 +427,12 @@ module MapTree = let rec loop (m: MapTree<'Key, 'Value>) acc = if isEmpty m then acc else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> loop mn.Left ((mn.Key, mn.Value) :: loop mn.Right acc) - | _ -> (m.Key, m.Value) :: acc + match m.Height with + | 1 -> (m.Key, m.Value) :: acc + | _ -> + let mn = asNode m + loop mn.Left ((mn.Key, mn.Value) :: loop mn.Right acc) + loop m [] let toArray m = @@ -448,9 +483,11 @@ module MapTree = | m :: rest -> if isEmpty m then collapseLHS rest else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> collapseLHS (mn.Left :: MapTree (mn.Key, mn.Value) :: mn.Right :: rest) - | _ -> stack + match m.Height with + | 1 -> stack + | _ -> + let mn = asNode m + collapseLHS (mn.Left :: MapTree (mn.Key, mn.Value) :: mn.Right :: rest) let mkIterator m = { stack = collapseLHS [m]; started = false } @@ -466,9 +503,9 @@ module MapTree = match i.stack with | [] -> alreadyFinished() | m :: _ -> - match m with - | :? MapTreeNode<'Key, 'Value> -> failwith "Please report error: Map iterator, unexpected stack for current" - | _ -> new KeyValuePair<_, _>(m.Key, m.Value) + match m.Height with + | 1 -> new KeyValuePair<_, _>(m.Key, m.Value) + | _ -> failwith "Please report error: Map iterator, unexpected stack for current" else notStarted() @@ -477,11 +514,11 @@ module MapTree = match i.stack with | [] -> false | m :: rest -> - match m with - | :? MapTreeNode<'Key, 'Value> -> failwith "Please report error: Map iterator, unexpected stack for moveNext" - | _ -> + match m.Height with + | 1 -> i.stack <- collapseLHS rest not i.stack.IsEmpty + | _ -> 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 From aa0572c18e1cb07f86f786cbb9c60e3cf5272de5 Mon Sep 17 00:00:00 2001 From: Victor Baybekov Date: Thu, 7 Jan 2021 13:55:44 +0100 Subject: [PATCH 2/3] Map: use `if` instead of `match` `Match` produces `sub 1` and `switch` instruction. Here, for any non-trivial count, nodes are more frequent than leaves on the path, so branch prediction should be beneficial. --- src/fsharp/FSharp.Core/map.fs | 135 +++++++++++++++++----------------- 1 file changed, 68 insertions(+), 67 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 92338fd63bf..3f657c5d94b 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -41,9 +41,11 @@ module MapTree = if isEmpty m then acc else - match m.Height with - | 1 -> acc + 1 - | _ -> let mn = asNode m in sizeAux (sizeAux (acc+1) mn.Left) mn.Right + if m.Height = 1 then + acc + 1 + else + let mn = asNode m + sizeAux (sizeAux (acc+1) mn.Left) mn.Right let size x = sizeAux 0 x @@ -128,12 +130,11 @@ module MapTree = if isEmpty m then MapTree(k,v) else let c = comparer.Compare(k,m.Key) - match m.Height with - | 1 -> + if m.Height = 1 then if c < 0 then MapTreeNode (k,v,empty,m,2) :> MapTree<'Key, 'Value> elif c = 0 then MapTree(k,v) else MapTreeNode (k,v,m,empty,2) :> MapTree<'Key, 'Value> - | _ -> + else let mn = asNode m if c < 0 then rebalance (add comparer k v mn.Left) mn.Key mn.Value mn.Right elif c = 0 then MapTreeNode(k,v,mn.Left,mn.Right,mn.Height) :> MapTree<'Key, 'Value> @@ -145,9 +146,8 @@ module MapTree = let c = comparer.Compare(k, m.Key) if c = 0 then v <- m.Value; true else - match m.Height with - | 1 -> false - | _ -> + if m.Height = 1 then false + else let mn = asNode m tryGetValue comparer k &v (if c < 0 then mn.Left else mn.Right) @@ -175,15 +175,14 @@ module MapTree = let rec partitionAux (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) acc = if isEmpty m then acc else - match m.Height with - | 1 -> partition1 comparer f m.Key m.Value acc - | _ -> + if m.Height = 1 then + partition1 comparer f m.Key m.Value acc + else let mn = asNode m let acc = partitionAux comparer f mn.Right acc let acc = partition1 comparer f mn.Key mn.Value acc partitionAux comparer f mn.Left acc - let partition (comparer: IComparer<'Key>) f m = partitionAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m (empty, empty) @@ -193,9 +192,9 @@ module MapTree = let rec filterAux (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) acc = if isEmpty m then acc else - match m.Height with - | 1 -> filter1 comparer f m.Key m.Value acc - | _ -> + if m.Height = 1 then + filter1 comparer f m.Key m.Value acc + else let mn = asNode m let acc = filterAux comparer f mn.Left acc let acc = filter1 comparer f mn.Key mn.Value acc @@ -208,9 +207,9 @@ module MapTree = let rec spliceOutSuccessor (m: MapTree<'Key, 'Value>) = if isEmpty m then failwith "internal error: Map.spliceOutSuccessor" else - match m.Height with - | 1 -> m.Key, m.Value, empty - | _ -> + if m.Height = 1 then + m.Key, m.Value, empty + else let mn = asNode m if isEmpty mn.Left then mn.Key, mn.Value, mn.Right else let k3, v3, l' = spliceOutSuccessor mn.Left in k3, v3, mk l' mn.Key mn.Value mn.Right @@ -219,9 +218,9 @@ module MapTree = if isEmpty m then empty else let c = comparer.Compare(k, m.Key) - match m.Height with - | 1 -> if c = 0 then empty else m - | _ -> + if m.Height = 1 then + if c = 0 then empty else m + else let mn = asNode m if c < 0 then rebalance (remove comparer k mn.Left) mn.Key mn.Value mn.Right elif c = 0 then @@ -239,8 +238,7 @@ module MapTree = | None -> m | Some v -> MapTree (k, v) else - match m.Height with - | 1 -> + if m.Height = 1 then let c = comparer.Compare(k, m.Key) if c < 0 then match u None with @@ -254,7 +252,7 @@ module MapTree = match u None with | None -> m | Some v -> MapTreeNode (k, v, m, empty, 2) :> MapTree<'Key,'Value> - | _ -> + else let mn = asNode m let c = comparer.Compare(k, mn.Key) if c < 0 then @@ -275,9 +273,9 @@ module MapTree = if isEmpty m then false else let c = comparer.Compare(k, m.Key) - match m.Height with - | 1 -> c = 0 - | _ -> + if m.Height = 1 then + c = 0 + else let mn = asNode m if c < 0 then mem comparer k mn.Left else (c = 0 || mem comparer k mn.Right) @@ -286,9 +284,9 @@ module MapTree = let rec iterOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = if isEmpty m then () else - match m.Height with - | 1 -> f.Invoke (m.Key, m.Value) - | _ -> + if m.Height = 1 then + f.Invoke (m.Key, m.Value) + else let mn = asNode m iterOpt f mn.Left; f.Invoke (mn.Key, mn.Value); iterOpt f mn.Right @@ -299,9 +297,9 @@ module MapTree = let rec tryPickOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = if isEmpty m then None else - match m.Height with - | 1 -> f.Invoke (m.Key, m.Value) - | _ -> + if m.Height = 1 then + f.Invoke (m.Key, m.Value) + else let mn = asNode m match tryPickOpt f mn.Left with | Some _ as res -> res @@ -318,9 +316,9 @@ module MapTree = let rec existsOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = if isEmpty m then false else - match m.Height with - | 1 -> f.Invoke (m.Key, m.Value) - | _ -> + if m.Height = 1 then + f.Invoke (m.Key, m.Value) + else let mn = asNode m existsOpt f mn.Left || f.Invoke (mn.Key, mn.Value) || existsOpt f mn.Right @@ -331,9 +329,9 @@ module MapTree = let rec forallOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) (m: MapTree<'Key, 'Value>) = if isEmpty m then true else - match m.Height with - | 1 -> f.Invoke (m.Key, m.Value) - | _ -> + if m.Height = 1 then + f.Invoke (m.Key, m.Value) + else let mn = asNode m forallOpt f mn.Left && f.Invoke (mn.Key, mn.Value) && forallOpt f mn.Right @@ -345,9 +343,9 @@ module MapTree = let rec map (f:'Value -> 'Result) (m: MapTree<'Key, 'Value>) : MapTree<'Key, 'Result> = if isEmpty m then empty else - match m.Height with - | 1 -> MapTree (m.Key, f m.Value) - | _ -> + if m.Height = 1 then + MapTree (m.Key, f m.Value) + else let mn = asNode m let l2 = map f mn.Left let v2 = f mn.Value @@ -357,9 +355,9 @@ module MapTree = let rec mapiOpt (f: OptimizedClosures.FSharpFunc<'Key, 'Value, 'Result>) (m: MapTree<'Key, 'Value>) = if isEmpty m then empty else - match m.Height with - | 1 -> MapTree (m.Key, f.Invoke (m.Key, m.Value)) - | _ -> + if m.Height = 1 then + MapTree (m.Key, f.Invoke (m.Key, m.Value)) + else let mn = asNode m let l2 = mapiOpt f mn.Left let v2 = f.Invoke (mn.Key, mn.Value) @@ -373,9 +371,9 @@ module MapTree = let rec foldBackOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) (m: MapTree<'Key, 'Value>) x = if isEmpty m then x else - match m.Height with - | 1 -> f.Invoke (m.Key, m.Value, x) - | _ -> + if m.Height = 1 then + f.Invoke (m.Key, m.Value, x) + else let mn = asNode m let x = foldBackOpt f mn.Right x let x = f.Invoke (mn.Key, mn.Value, x) @@ -388,9 +386,9 @@ module MapTree = let rec foldOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) x (m: MapTree<'Key, 'Value>) = if isEmpty m then x else - match m.Height with - | 1 -> f.Invoke (x, m.Key, m.Value) - | _ -> + if m.Height = 1 then + f.Invoke (x, m.Key, m.Value) + else let mn = asNode m let x = foldOpt f x mn.Left let x = f.Invoke (x, mn.Key, mn.Value) @@ -403,13 +401,12 @@ module MapTree = let rec foldFromTo (f: OptimizedClosures.FSharpFunc<_, _, _, _>) (m: MapTree<'Key, 'Value>) x = if isEmpty m then x else - match m.Height with - | 1 -> + if m.Height = 1 then let cLoKey = comparer.Compare(lo, m.Key) let cKeyHi = comparer.Compare(m.Key, hi) let x = if cLoKey <= 0 && cKeyHi <= 0 then f.Invoke (m.Key, m.Value, x) else x x - | _ -> + else let mn = asNode m let cLoKey = comparer.Compare(lo, mn.Key) let cKeyHi = comparer.Compare(mn.Key, hi) @@ -427,9 +424,9 @@ module MapTree = let rec loop (m: MapTree<'Key, 'Value>) acc = if isEmpty m then acc else - match m.Height with - | 1 -> (m.Key, m.Value) :: acc - | _ -> + if m.Height = 1 then + (m.Key, m.Value) :: acc + else let mn = asNode m loop mn.Left ((mn.Key, mn.Value) :: loop mn.Right acc) @@ -483,9 +480,9 @@ module MapTree = | m :: rest -> if isEmpty m then collapseLHS rest else - match m.Height with - | 1 -> stack - | _ -> + if m.Height = 1 then + stack + else let mn = asNode m collapseLHS (mn.Left :: MapTree (mn.Key, mn.Value) :: mn.Right :: rest) @@ -497,15 +494,20 @@ module MapTree = let alreadyFinished() = raise (InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))) + + let unexpectedStackForCurrent() = + failwith "Please report error: Map iterator, unexpected stack for current" + + let unexpectedStackForMoveNext() = + failwith "Please report error: Map iterator, unexpected stack for moveNext" let current i = if i.started then match i.stack with | [] -> alreadyFinished() | m :: _ -> - match m.Height with - | 1 -> new KeyValuePair<_, _>(m.Key, m.Value) - | _ -> failwith "Please report error: Map iterator, unexpected stack for current" + if m.Height = 1 then KeyValuePair<_, _>(m.Key, m.Value) + else unexpectedStackForCurrent() else notStarted() @@ -514,11 +516,10 @@ module MapTree = match i.stack with | [] -> false | m :: rest -> - match m.Height with - | 1 -> + if m.Height = 1 then i.stack <- collapseLHS rest not i.stack.IsEmpty - | _ -> failwith "Please report error: Map iterator, unexpected stack for moveNext" + else unexpectedStackForMoveNext() else i.started <- true (* The first call to MoveNext "starts" the enumeration. *) not i.stack.IsEmpty From bc2825896193c7769980c8ddbaff36e829f8e259 Mon Sep 17 00:00:00 2001 From: Victor Baybekov Date: Sun, 10 Jan 2021 02:03:15 +0100 Subject: [PATCH 3/3] Map: Optimize away `ininst` check: fix trace --- src/fsharp/FSharp.Core/map.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 3f657c5d94b..062bb1424da 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -73,11 +73,11 @@ module MapTree = (totalSizeOnMapLookup / float numLookups)) System.Console.WriteLine("#largestMapSize = {0}, largestMapStackTrace = {1}", largestMapSize, largestMapStackTrace) - let MapTree n = + let MapTree (k,v) = report() numOnes <- numOnes + 1 totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 - MapTree n + MapTree (k,v) let MapTreeNode (x, l, v, r, h) = report()