From c1f98de2616dca7429d6c5c683d2e34452b6d802 Mon Sep 17 00:00:00 2001 From: Victor Baybekov Date: Sat, 26 Sep 2020 00:33:58 +0200 Subject: [PATCH 1/5] FSharp.Core: Map: optimize tree layout Following discussion and POC code from https://github.com/dotnet/fsharp/pull/5360#issuecomment-496818508 Changes are very straightforward and do not touch public API: * Performance improves by a huge margin * Code size is smaller or same * Memory is same * No low level tricks, just simple code (see `asNode` comments for potential micro-optimizations, which are not visible after all; these comments are to be deleted) Benchmarks code is here: https://github.com/buybackoff/fsharp-benchmarks | Method | Job | BuildConfiguration | Size | Mean | Error | StdDev | Rank | Gen 0 | Gen 1 | Gen 2 | Allocated | Code Size | |------------ |------- |------------------- |--------- |------------------:|-----------------:|-----------------:|-----:|-----------:|---------:|--------:|------------:|----------:| | getItem | After | LocalBuild | 100 | 36.21 ns | 0.199 ns | 0.167 ns | 1 | - | - | - | - | 126 B | | getItem | Before | Default | 100 | 62.51 ns | 0.143 ns | 0.127 ns | 2 | - | - | - | - | 126 B | | getItem | After | LocalBuild | 10000 | 76.57 ns | 0.140 ns | 0.124 ns | 3 | - | - | - | - | 126 B | | getItem | Before | Default | 10000 | 120.02 ns | 0.182 ns | 0.170 ns | 4 | - | - | - | - | 126 B | | getItem | After | LocalBuild | 10000000 | 129.45 ns | 0.126 ns | 0.118 ns | 5 | - | - | - | - | 126 B | | getItem | Before | Default | 10000000 | 209.35 ns | 0.496 ns | 0.464 ns | 6 | - | - | - | - | 126 B | | | | | | | | | | | | | | | | containsKey | After | LocalBuild | 100 | 35.63 ns | 0.201 ns | 0.188 ns | 1 | - | - | - | - | 177 B | | containsKey | Before | Default | 100 | 64.01 ns | 0.351 ns | 0.328 ns | 2 | - | - | - | - | 276 B | | containsKey | After | LocalBuild | 10000 | 65.63 ns | 0.150 ns | 0.125 ns | 3 | - | - | - | - | 177 B | | containsKey | Before | Default | 10000 | 123.82 ns | 0.149 ns | 0.139 ns | 5 | - | - | - | - | 276 B | | containsKey | After | LocalBuild | 10000000 | 95.05 ns | 0.082 ns | 0.072 ns | 4 | - | - | - | - | 177 B | | containsKey | Before | Default | 10000000 | 204.39 ns | 0.338 ns | 0.282 ns | 6 | - | - | - | - | 276 B | | | | | | | | | | | | | | | | itemCount | After | LocalBuild | 100 | 231.39 ns | 0.406 ns | 0.360 ns | 1 | - | - | - | - | 96 B | | itemCount | Before | Default | 100 | 539.74 ns | 1.923 ns | 1.798 ns | 2 | - | - | - | - | 151 B | | itemCount | After | LocalBuild | 10000 | 33,160.50 ns | 194.709 ns | 182.131 ns | 3 | - | - | - | - | 96 B | | itemCount | Before | Default | 10000 | 63,074.34 ns | 138.682 ns | 129.724 ns | 4 | - | - | - | - | 151 B | | itemCount | After | LocalBuild | 10000000 | 62,332,911.90 ns | 252,973.481 ns | 224,254.402 ns | 5 | - | - | - | 148 B | 96 B | | itemCount | Before | Default | 10000000 | 94,745,625.56 ns | 205,640.690 ns | 192,356.429 ns | 6 | - | - | - | - | 151 B | | | | | | | | | | | | | | | | iterForeach | After | LocalBuild | 100 | 3,355.75 ns | 9.540 ns | 7.448 ns | 1 | 0.9727 | - | - | 6120 B | 291 B | | iterForeach | Before | Default | 100 | 3,866.56 ns | 10.148 ns | 8.996 ns | 2 | 0.9689 | - | - | 6120 B | 291 B | | iterForeach | After | LocalBuild | 10000 | 348,359.43 ns | 1,148.753 ns | 959.260 ns | 3 | 95.2148 | - | - | 600120 B | 291 B | | iterForeach | Before | Default | 10000 | 398,419.61 ns | 513.959 ns | 480.758 ns | 4 | 95.2148 | - | - | 600120 B | 291 B | | iterForeach | After | LocalBuild | 10000000 | 391,889,200.00 ns | 1,604,306.946 ns | 1,500,669.712 ns | 5 | 95000.0000 | - | - | 600000120 B | 321 B | | iterForeach | Before | Default | 10000000 | 445,099,028.57 ns | 1,380,498.715 ns | 1,223,776.153 ns | 6 | 95000.0000 | - | - | 600000120 B | 321 B | | | | | | | | | | | | | | | | addItem | After | LocalBuild | 100 | 181.25 ns | 0.961 ns | 0.899 ns | 1 | 0.0586 | 0.0003 | - | 369 B | 621 B | | addItem | Before | Default | 100 | 311.85 ns | 0.601 ns | 0.562 ns | 2 | 0.0586 | - | - | 369 B | 697 B | | addItem | After | LocalBuild | 10000 | 40,893.49 ns | 174.683 ns | 163.398 ns | 3 | 11.0156 | 3.2813 | - | 69324 B | 621 B | | addItem | Before | Default | 10000 | 71,746.33 ns | 130.309 ns | 121.891 ns | 4 | 11.0156 | 3.3594 | - | 69324 B | 697 B | | addItem | After | LocalBuild | 10000000 | 87,178,251.47 ns | 250,148.324 ns | 233,988.898 ns | 5 | 18680.0000 | 960.0000 | 10.0000 | 117146915 B | 621 B | | addItem | Before | Default | 10000000 | 146,799,424.80 ns | 286,531.195 ns | 268,021.458 ns | 6 | 18680.0000 | 960.0000 | 10.0000 | 117146915 B | 697 B | | | | | | | | | | | | | | | | removeItem | After | LocalBuild | 100 | 13.64 ns | 0.112 ns | 0.105 ns | 1 | 0.0064 | - | - | 40 B | 469 B | | removeItem | Before | Default | 100 | 16.38 ns | 0.071 ns | 0.067 ns | 2 | 0.0064 | - | - | 40 B | 519 B | | removeItem | After | LocalBuild | 10000 | 1,329.24 ns | 9.087 ns | 8.056 ns | 3 | 0.6372 | - | - | 4000 B | 469 B | | removeItem | Before | Default | 10000 | 1,607.21 ns | 5.566 ns | 5.206 ns | 4 | 0.6372 | - | - | 4000 B | 519 B | | removeItem | After | LocalBuild | 10000000 | 1,232,230.00 ns | 6,303.414 ns | 5,896.218 ns | 5 | 630.0000 | - | - | 4000000 B | 469 B | | removeItem | Before | Default | 10000000 | 1,801,088.33 ns | 8,945.674 ns | 8,367.789 ns | 6 | 630.0000 | - | - | 4000000 B | 519 B | --- .gitignore | 2 + src/fsharp/FSharp.Core/map.fs | 563 ++++++++++++++++++---------------- 2 files changed, 298 insertions(+), 267 deletions(-) diff --git a/.gitignore b/.gitignore index 264c1fb71bc..4ed92b94bb7 100644 --- a/.gitignore +++ b/.gitignore @@ -138,3 +138,5 @@ msbuild.binlog _NCrunch_* .*crunch*.local.xml nCrunchTemp_* + +.idea diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 079c5cac585..173a5d5b932 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -5,25 +5,43 @@ 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 MapTree<'Key, 'Value when 'Key : comparison > = - | MapEmpty - | MapOne of 'Key * 'Value - | MapNode of 'Key * 'Value * MapTree<'Key, 'Value> * MapTree<'Key, 'Value> * int +[] +type internal MapTree<'Key, 'Value> = + val Key: 'Key + val Value: 'Value + new(k:'Key, v:'Value) = {Key = k; Value = v} +[] +[] +[] +type internal MapTreeNode<'Key, 'Value> = + inherit MapTree<'Key,'Value> + val Left: MapTree<'Key, 'Value> + val Right: MapTree<'Key, 'Value> + val Height: int + new(k:'Key, v:'Value, left:MapTree<'Key, 'Value>, right: MapTree<'Key, 'Value>, h: int) = + {inherit MapTree<'Key,'Value>(k,v); Left = left; Right = right; Height = h} + [] 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 empty = null + + let inline isEmpty (m:MapTree<'Key, 'Value>) = isNull m + + 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 let size x = sizeAux 0 x @@ -55,97 +73,88 @@ module MapTree = report() numOnes <- numOnes + 1 totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 - MapTree.MapOne n + MapTree n let MapNode (x, l, v, r, h) = report() numNodes <- numNodes + 1 - let n = MapTree.MapNode (x, l, v, r, h) + let n = MapTreeNode (x, l, v, r, h) totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (size n) n #endif - let empty = MapEmpty - - let height (m: MapTree<'Key, 'Value>) = - match m with - | MapEmpty -> 0 - | MapOne _ -> 1 - | MapNode (_, _, _, _, h) -> h - - let isEmpty (m: MapTree<'Key, 'Value>) = - match m with - | MapEmpty -> true - | _ -> false - + let inline height (m: MapTree<'Key, 'Value>) = + if isEmpty m then 0 + else + match m with + | :? MapTreeNode<'Key, 'Value> as mn -> mn.Height + | _ -> 1 + let mk l k v r : MapTree<'Key, 'Value> = - 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: 'Key) (v: 'Value) t2 = - let t1h = height t1 + let hl = height l + let hr = height r + let m = max hl hr + if m = 0 then // m=0 ~ isEmpty l && isEmpty r + 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> = + // F# is "too smart" and eliminates the inlined IL call, but that should be left to JIT, otherwise stuff breaks + // (# "ret" value: MapTreeNode<'Key,'Value> #) + // Ideally we need ldarg.0;ret without S.R.CS.U dependency + // :?> also works, but it's not free, while the usage guarantees correct unsafe casts + // when this is implemented, S.R.CS.U could be removed for inline IL: https://github.com/fsharp/fslang-suggestions/issues/838 + // Unsafe.As>(value) + value :?> MapTreeNode<'Key,'Value> // this is not visible for performance + + let rebalance t1 (k: 'Key) (v: 'Value) t2 : MapTree<'Key, 'Value> = + 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" + let t2' = asNode(t2) + (* one of the nodes must have height > height t1 + 1 *) + if height t2'.Left > t1h + 1 then (* balance left: combination *) + let t2l = asNode(t2'.Left) + mk (mk t1 k v t2l.Left) t2l.Key t2l.Value (mk t2l.Right t2'.Key t2'.Value t2'.Right) + else (* rotate left *) + mk (mk t1 k v t2'.Left) t2'.Key t2'.Value t2'.Right 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" + let t1' = asNode(t1) + (* one of the nodes must have height > height t2 + 1 *) + if height t1'.Right > t2h + 1 then + (* balance right: combination *) + let t1r = asNode(t1'.Right) + mk (mk t1'.Left t1'.Key t1'.Value t1r.Left) t1r.Key t1r.Value (mk t1r.Right k v t2) + else + mk t1'.Left t1'.Key t1'.Value (mk t1'.Right k v t2) else mk t1 k v t2 - - let rec add (comparer: IComparer<'Key>) k (v: 'Value) (m: MapTree<'Key, 'Value>) = - 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) - - let rec tryGetValue (comparer: IComparer<'Key>) k (v: byref<'Value>) (m: MapTree<'Key, 'Value>) = - match m with - | MapEmpty -> false - | MapOne (k2, v2) -> - let c = comparer.Compare(k, k2) - if c = 0 then v <- v2; true - else false - | MapNode (k2, v2, l, r, _) -> - let c = comparer.Compare(k, k2) - if c < 0 then tryGetValue comparer k &v l - elif c = 0 then v <- v2; true - else tryGetValue comparer k &v r + + let rec add (comparer: IComparer<'Key>) k (v: 'Value) (m: MapTree<'Key, 'Value>) : MapTree<'Key, 'Value> = + 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) + | _ -> + 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 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 -> + tryGetValue comparer k &v (if c < 0 then mn.Left else mn.Right) + | _ -> false let find (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = let mutable v = Unchecked.defaultof<'Value> @@ -164,14 +173,15 @@ module MapTree = 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<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) m acc = - match m with - | MapEmpty -> acc - | MapOne (k, v) -> partition1 comparer f k v 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 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 -> + 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) @@ -179,209 +189,221 @@ module MapTree = 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<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) m acc = - match m with - | MapEmpty -> acc - | MapOne (k, v) -> filter1 comparer f k v 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 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 -> + 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 let rec spliceOutSuccessor (m: MapTree<'Key, 'Value>) = - match m with - | MapEmpty -> failwith "internal error: Map.spliceOutSuccessor" - | MapOne (k2, v2) -> k2, v2, MapEmpty - | 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 + if isEmpty m then failwith "internal error: Map.spliceOutSuccessor" + else + match m with + | :? MapTreeNode<'Key, 'Value> as mn -> + if isEmpty mn 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>) = - match m with - | MapEmpty -> empty - | MapOne (k2, _) -> - let c = comparer.Compare(k, k2) - if c = 0 then MapEmpty else m - | 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 change (comparer: IComparer<'Key>) k (u: 'Value option -> 'Value option) (m: MapTree<'Key, 'Value>) = - match m with - | MapEmpty -> + if isEmpty m then empty + else + let c = comparer.Compare(k, m.Key) + match m with + | :? MapTreeNode<'Key, 'Value> as mn -> + 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 + elif isEmpty mn.Right then mn.Left + else + 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 match u None with - | None -> m - | Some v -> MapOne (k, v) - | MapOne (k2, v2) -> - let c = comparer.Compare(k, k2) - if c < 0 then - match u None with - | None -> m - | Some v -> MapNode (k, v, MapEmpty, m, 2) - elif c = 0 then - match u (Some v2) with - | None -> MapEmpty - | Some v -> MapOne (k, v) - else - match u None with | None -> m - | Some v -> MapNode (k, v, m, MapEmpty, 2) - | MapNode (k2, v2, l, r, h) -> - let c = comparer.Compare(k, k2) - if c < 0 then - rebalance (change comparer k u l) k2 v2 r - elif c = 0 then - match u (Some v2) with - | None -> - match l, r with - | MapEmpty, _ -> r - | _, MapEmpty -> l - | _ -> - let sk, sv, r' = spliceOutSuccessor r - mk l sk sv r' - | Some v -> MapNode (k, v, l, r, h) - else - rebalance l k2 v2 (change comparer k u r) + | Some v -> MapTree (k, v) + else + match m with + | :? MapTreeNode<'Key, 'Value> as mn -> + let c = comparer.Compare(k, mn.Key) + if c < 0 then + rebalance (change comparer k u mn.Left) mn.Key mn.Value mn.Right + elif c = 0 then + match u (Some mn.Value) with + | None -> + if isEmpty mn.Left then mn.Right + elif isEmpty mn.Right then mn.Left + else + let sk, sv, r' = spliceOutSuccessor mn.Right + mk mn.Left sk sv r' + | 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>) = - match m with - | MapEmpty -> false - | MapOne (k2, _) -> (comparer.Compare(k, k2) = 0) - | MapNode (k2, _, l, r, _) -> - let c = comparer.Compare(k, k2) - if c < 0 then mem comparer k l - else (c = 0 || mem comparer k r) + if isEmpty m then false + else + let c = comparer.Compare(k, m.Key) + match m with + | :? MapTreeNode<'Key, 'Value> as mn -> + 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>) = - match m with - | MapEmpty -> () - | MapOne (k2, v2) -> f.Invoke (k2, v2) - | MapNode (k2, v2, l, r, _) -> iterOpt f l; f.Invoke (k2, v2); iterOpt f r + 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) 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 (k2, v2, l, r, _) -> - match tryPickOpt f l with - | Some _ as res -> res - | None -> - match f.Invoke (k2, v2) with - | Some _ as res -> res - | None -> - tryPickOpt f r + 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 tryPickOpt f mn.Left with + | Some _ as res -> res + | None -> + match f.Invoke (mn.Key, mn.Value) with + | 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 - let rec existsOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) m = - match m with - | MapEmpty -> false - | MapOne (k2, v2) -> f.Invoke (k2, v2) - | MapNode (k2, v2, l, r, _) -> existsOpt f l || f.Invoke (k2, v2) || existsOpt f r + 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) 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 (k2, v2, l, r, _) -> forallOpt f l && f.Invoke (k2, v2) && forallOpt f r + 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) + 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 (k, v, l, r, h) -> - let l2 = map f l - let v2 = f v - let r2 = map f r - MapNode (k, v2, l2, r2, h) - - let rec mapiOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) m = - match m with - | MapEmpty -> empty - | MapOne (k, v) -> MapOne (k, f.Invoke (k, v)) - | MapNode (k, v, l, r, h) -> - let l2 = mapiOpt f l - let v2 = f.Invoke (k, v) - let r2 = mapiOpt f r - MapNode (k, v2, l2, r2, h) + 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 -> + 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 -> + 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 - let rec foldBackOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) m x = - match m with - | MapEmpty -> x - | MapOne (k, v) -> f.Invoke (k, v, x) - | MapNode (k, v, l, r, _) -> - let x = foldBackOpt f r x - let x = f.Invoke (k, v, x) - foldBackOpt f l x + 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 -> + 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 - let rec foldOpt (f: OptimizedClosures.FSharpFunc<_, _, _, _>) x m = - match m with - | MapEmpty -> x - | MapOne (k, v) -> f.Invoke (x, k, v) - | MapNode (k, v, l, r, _) -> - let x = foldOpt f x l - let x = f.Invoke (x, k, v) - foldOpt f x r + 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 -> + 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 - 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 (k, v, l, r, _) -> - let cLoKey = comparer.Compare(lo, k) - let cKeyHi = comparer.Compare(k, hi) - let x = if cLoKey < 0 then foldFromTo f l x else x - let x = if cLoKey <= 0 && cKeyHi <= 0 then f.Invoke (k, v, x) else x - let x = if cKeyHi < 0 then foldFromTo f r x else x - x + let foldSectionOpt (comparer: IComparer<'Key>) lo hi (f: OptimizedClosures.FSharpFunc<_, _, _, _>) (m: MapTree<'Key, 'Value>) x = + 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 -> + 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 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) + let toList (m: MapTree<'Key, 'Value>) = + 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 loop m [] let toArray m = @@ -396,7 +418,7 @@ module MapTree = mkFromEnumerator comparer (add comparer x y acc) e else acc - let ofArray comparer (arr : array<_>) = + let ofArray comparer (arr : array<'Key * 'Value>) = let mutable res = empty for (x, y) in arr do res <- add comparer x y res @@ -426,12 +448,15 @@ module MapTree = // collapseLHS: // a) Always returns either [] or a list starting with MapOne. // b) The "fringe" of the set stack is unchanged. - let rec collapseLHS stack = + let rec collapseLHS (stack:MapTree<'Key, 'Value> list) = match stack with | [] -> [] - | MapEmpty :: rest -> collapseLHS rest - | MapOne _ :: _ -> stack - | (MapNode (k, v, l, r, _)) :: rest -> collapseLHS (l :: MapOne (k, v) :: r :: rest) + | 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 let mkIterator m = { stack = collapseLHS [m]; started = false } @@ -445,20 +470,24 @@ module MapTree = 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" + | [] -> alreadyFinished() + | m :: _ -> + match m with + | :? MapTreeNode<'Key, 'Value> -> failwith "Please report error: Map iterator, unexpected stack for current" + | _ -> new KeyValuePair<_, _>(m.Key, m.Value) 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" + | m :: rest -> + match m with + | :? MapTreeNode<'Key, 'Value> -> failwith "Please report error: Map iterator, unexpected stack for moveNext" + | _ -> + i.stack <- collapseLHS rest + not i.stack.IsEmpty else i.started <- true (* The first call to MoveNext "starts" the enumeration. *) not i.stack.IsEmpty @@ -501,7 +530,7 @@ type Map<[]'Key, [ - new Map<'Key, 'Value>(comparer, MapTree<_, _>.MapEmpty) + new Map<'Key, 'Value>(comparer, MapTree.empty) [] member __.OnSerializing(context: System.Runtime.Serialization.StreamingContext) = @@ -585,8 +614,8 @@ type Map<[]'Key, [(comparer, MapTree.map f tree) + member m.MapRange (f:'Value->'Result) = + new Map<'Key, 'Result>(comparer, MapTree.map f tree) member m.Map f = new Map<'Key, 'b>(comparer, MapTree.mapi f tree) From 029158a7e8359b0fb2046b65116e262dd7e33dde Mon Sep 17 00:00:00 2001 From: Victor Baybekov Date: Sat, 26 Sep 2020 01:38:45 +0200 Subject: [PATCH 2/5] Simplify node ctors --- src/fsharp/FSharp.Core/map.fs | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 173a5d5b932..dc0ba3abf02 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -12,21 +12,19 @@ open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators [] [] -type internal MapTree<'Key, 'Value> = - val Key: 'Key - val Value: 'Value - new(k:'Key, v:'Value) = {Key = k; Value = v} +type internal MapTree<'Key, 'Value>(k: 'Key, v: 'Value) = + member _.Key = k + member _.Value = v [] [] [] -type internal MapTreeNode<'Key, 'Value> = - inherit MapTree<'Key,'Value> - val Left: MapTree<'Key, 'Value> - val Right: MapTree<'Key, 'Value> - val Height: int - new(k:'Key, v:'Value, left:MapTree<'Key, 'Value>, right: MapTree<'Key, 'Value>, h: int) = - {inherit MapTree<'Key,'Value>(k,v); Left = left; Right = right; Height = h} +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) + + member _.Left = left + member _.Right = right + member _.Height = h [] module MapTree = From d264de13e1af8a60313970444b261df5ee96c831 Mon Sep 17 00:00:00 2001 From: Victor Baybekov Date: Sat, 26 Sep 2020 01:43:03 +0200 Subject: [PATCH 3/5] FSharp.Core: Map: delete notes in asNode --- src/fsharp/FSharp.Core/map.fs | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index dc0ba3abf02..262fc5a1659 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -98,13 +98,7 @@ module MapTree = 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> = - // F# is "too smart" and eliminates the inlined IL call, but that should be left to JIT, otherwise stuff breaks - // (# "ret" value: MapTreeNode<'Key,'Value> #) - // Ideally we need ldarg.0;ret without S.R.CS.U dependency - // :?> also works, but it's not free, while the usage guarantees correct unsafe casts - // when this is implemented, S.R.CS.U could be removed for inline IL: https://github.com/fsharp/fslang-suggestions/issues/838 - // Unsafe.As>(value) - value :?> MapTreeNode<'Key,'Value> // this is not visible for performance + value :?> MapTreeNode<'Key,'Value> let rebalance t1 (k: 'Key) (v: 'Value) t2 : MapTree<'Key, 'Value> = let t1h = height t1 From 9f047461ea26e3a225354109e429c67372ce7f9a Mon Sep 17 00:00:00 2001 From: Victor Baybekov Date: Sat, 26 Sep 2020 09:49:32 +0200 Subject: [PATCH 4/5] FSharp.Core: Map: fix typo in spliceOutSuccessor --- src/fsharp/FSharp.Core/map.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 262fc5a1659..b115ad16a74 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -199,7 +199,7 @@ module MapTree = else match m with | :? MapTreeNode<'Key, 'Value> as mn -> - if isEmpty mn then mn.Key, mn.Value, mn.Right + 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 From 8c6652e36f31a6194217fdc2328794adfdf95cc1 Mon Sep 17 00:00:00 2001 From: Victor Baybekov Date: Sat, 26 Sep 2020 11:17:09 +0200 Subject: [PATCH 5/5] FSharp.Core: Map: remove unused open --- src/fsharp/FSharp.Core/map.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index b115ad16a74..f88c751bf75 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -5,7 +5,6 @@ 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