From 47ae60ce39c051b81b2e5ce69be43b41af18f0d1 Mon Sep 17 00:00:00 2001 From: Georg Haaser Date: Mon, 21 Dec 2020 12:55:51 +0100 Subject: [PATCH 1/5] replaced Map implementation with https://github.com/krauthaufen/MapNew --- src/fsharp/FSharp.Core/FSharp.Core.fsproj | 1 + src/fsharp/FSharp.Core/map.fs | 3332 ++++++++++++++++----- 2 files changed, 2556 insertions(+), 777 deletions(-) diff --git a/src/fsharp/FSharp.Core/FSharp.Core.fsproj b/src/fsharp/FSharp.Core/FSharp.Core.fsproj index f7267fe0d84..74b348768b1 100644 --- a/src/fsharp/FSharp.Core/FSharp.Core.fsproj +++ b/src/fsharp/FSharp.Core/FSharp.Core.fsproj @@ -222,6 +222,7 @@ + diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index bbe38a40140..1eebd40b6d3 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -3,895 +3,2673 @@ namespace Microsoft.FSharp.Collections open System +open System.Collections open System.Collections.Generic open System.Diagnostics open System.Text open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.LanguagePrimitives open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Collections + +module Sorting = + + + let inline private mergeSeq (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : ('Key * 'Value)[]) (dst : ('Key * 'Value)[]) (length : int) = + let le = ri + let re = min length (ri + len) + let mutable oi = li + let mutable li = li + let mutable ri = ri + + while li < le && ri < re do + let lv = src.[li] + let rv = src.[ri] + let c = cmp.Compare(fst lv, fst rv) + if c <= 0 then + dst.[oi] <- lv + oi <- oi + 1 + li <- li + 1 + else + dst.[oi] <- rv + oi <- oi + 1 + ri <- ri + 1 + + while li < le do + dst.[oi] <- src.[li] + oi <- oi + 1 + li <- li + 1 + + while ri < re do + dst.[oi] <- src.[ri] + oi <- oi + 1 + ri <- ri + 1 + + let inline private mergeSeqHandleDuplicates (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : ('Key * 'Value)[]) (dst : ('Key * 'Value)[]) (length : int) = + let le = ri + let re = min length (ri + len) + let start = li + let mutable oi = li + let mutable li = li + let mutable ri = ri + let mutable lastValue = Unchecked.defaultof<'Key * 'Value> + + let inline append (v : ('Key * 'Value)) = + if oi > start && cmp.Compare(fst v, fst lastValue) = 0 then + dst.[oi-1] <- v + lastValue <- v + else + dst.[oi] <- v + lastValue <- v + oi <- oi + 1 + + while li < le && ri < re do + let lv = src.[li] + let rv = src.[ri] + let c = cmp.Compare(fst lv, fst rv) + if c <= 0 then + append lv + li <- li + 1 + else + append rv + ri <- ri + 1 + + while li < le do + append src.[li] + li <- li + 1 + + while ri < re do + append src.[ri] + ri <- ri + 1 + + oi + + // assumes length > 2 + let mergeSortHandleDuplicates (mutateArray : bool) (cmp : IComparer<'Key>) (arr : ('Key * 'Value)[]) (length : int) = + let mutable src = Array.zeroCreate length + let mutable dst = + // mutateArray => allowed to mutate arr + if mutateArray then arr + else Array.zeroCreate length + + // copy to sorted pairs + let mutable i0 = 0 + let mutable i1 = 1 + while i1 < length do + let va = arr.[i0] + let vb = arr.[i1] + let c = cmp.Compare(fst va, fst vb) + if c <= 0 then + src.[i0] <- va + src.[i1] <- vb + else + src.[i0] <- vb + src.[i1] <- va + + i0 <- i0 + 2 + i1 <- i1 + 2 + + if i0 < length then + src.[i0] <- arr.[i0] + i0 <- i0 + 1 + + + // merge sorted parts of length `sortedLength` + let mutable sortedLength = 2 + let mutable sortedLengthDbl = 4 + while sortedLengthDbl < length do + let mutable li = 0 + let mutable ri = sortedLength + + // merge case + while ri < length do + mergeSeq cmp li ri sortedLength src dst length + li <- ri + sortedLength + ri <- li + sortedLength + + // right got empty + while li < length do + dst.[li] <- src.[li] + li <- li + 1 + + // sortedLength * 2 + sortedLength <- sortedLengthDbl + sortedLengthDbl <- sortedLengthDbl <<< 1 + // swap src and dst + let t = dst + dst <- src + src <- t + + // final merge-dedup run + let cnt = mergeSeqHandleDuplicates cmp 0 sortedLength sortedLength src dst length + struct(dst, cnt) + + let inline private mergeSeqV (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : struct('Key * 'Value)[]) (dst : struct('Key * 'Value)[]) (length : int) = + let le = ri + let re = min length (ri + len) + let mutable oi = li + let mutable li = li + let mutable ri = ri + + while li < le && ri < re do + let struct(lk, lv) = src.[li] + let struct(rk, rv) = src.[ri] + let c = cmp.Compare(lk, rk) + if c <= 0 then + dst.[oi] <- struct(lk, lv) + oi <- oi + 1 + li <- li + 1 + else + dst.[oi] <- struct(rk, rv) + oi <- oi + 1 + ri <- ri + 1 + + while li < le do + dst.[oi] <- src.[li] + oi <- oi + 1 + li <- li + 1 + + while ri < re do + dst.[oi] <- src.[ri] + oi <- oi + 1 + ri <- ri + 1 + + let inline private mergeSeqHandleDuplicatesV (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : struct('Key * 'Value)[]) (dst : struct('Key * 'Value)[]) (length : int) = + let le = ri + let re = min length (ri + len) + let start = li + let mutable oi = li + let mutable li = li + let mutable ri = ri + let mutable lastKey = Unchecked.defaultof<'Key> + + let inline append k v = + if oi > start && cmp.Compare(k, lastKey) = 0 then + dst.[oi-1] <- struct(k,v) + lastKey <- k + else + dst.[oi] <- struct(k,v) + lastKey <- k + oi <- oi + 1 + + while li < le && ri < re do + let struct(lk, lv) = src.[li] + let struct(rk, rv) = src.[ri] + let c = cmp.Compare(lk, rk) + if c <= 0 then + append lk lv + li <- li + 1 + else + append rk rv + ri <- ri + 1 + + while li < le do + let struct(k,v) = src.[li] + append k v + li <- li + 1 + + while ri < re do + let struct(k,v) = src.[ri] + append k v + ri <- ri + 1 + + oi + + // assumes length > 2 + let mergeSortHandleDuplicatesV (mutateArray : bool) (cmp : IComparer<'Key>) (arr : struct('Key * 'Value)[]) (length : int) = + let mutable src = Array.zeroCreate length + let mutable dst = + // mutateArray => allowed to mutate arr + if mutateArray then arr + else Array.zeroCreate length + + // copy to sorted pairs + let mutable i0 = 0 + let mutable i1 = 1 + while i1 < length do + let struct(ka,va) = arr.[i0] + let struct(kb,vb) = arr.[i1] + + let c = cmp.Compare(ka, kb) + if c <= 0 then + src.[i0] <- struct(ka, va) + src.[i1] <- struct(kb, vb) + else + src.[i0] <- struct(kb, vb) + src.[i1] <- struct(ka, va) + + i0 <- i0 + 2 + i1 <- i1 + 2 + + if i0 < length then + src.[i0] <- arr.[i0] + i0 <- i0 + 1 + + + // merge sorted parts of length `sortedLength` + let mutable sortedLength = 2 + let mutable sortedLengthDbl = 4 + while sortedLengthDbl < length do + let mutable li = 0 + let mutable ri = sortedLength + + // merge case + while ri < length do + mergeSeqV cmp li ri sortedLength src dst length + li <- ri + sortedLength + ri <- li + sortedLength + + // right got empty + while li < length do + dst.[li] <- src.[li] + li <- li + 1 + + // sortedLength * 2 + sortedLength <- sortedLengthDbl + sortedLengthDbl <- sortedLengthDbl <<< 1 + // swap src and dst + let t = dst + dst <- src + src <- t + + + // final merge-dedup run + let cnt = mergeSeqHandleDuplicatesV cmp 0 sortedLength sortedLength src dst length + struct(dst, cnt) + + + let sortHandleDuplicates (mutateArray : bool) (cmp : IComparer<'T>) (arr : 'T[]) (length : int) = + if length <= 0 then + struct(arr, 0) + else + let arr = + if mutateArray then arr + else arr.[0 .. length-1] + System.Array.Sort(arr, 0, length, cmp) + + let mutable i = 1 + let mutable oi = 1 + let mutable last = arr.[0] + while i < length do + let v = arr.[i] + let c = cmp.Compare(last, v) + last <- v + i <- i + 1 + if c = 0 then + arr.[oi-1] <- v + else + arr.[oi] <- v + oi <- oi + 1 -[] -[] -type internal MapTree<'Key, 'Value>(k: 'Key, v: 'Value) = - member _.Key = k - member _.Value = v + struct(arr, oi) + -[] -[] -[] -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) +module MapImplementation = - member _.Left = left - member _.Right = right - member _.Height = h - -[] -module MapTree = - let empty = null - - let inline isEmpty (m:MapTree<'Key, 'Value>) = isNull m + + [] + type MapNode<'Key, 'Value>() = + abstract member Count : int + abstract member Height : int + + abstract member Add : comparer : IComparer<'Key> * key : 'Key * value : 'Value -> MapNode<'Key, 'Value> + abstract member AddIfNotPresent : comparer : IComparer<'Key> * key : 'Key * value : 'Value -> MapNode<'Key, 'Value> + abstract member Remove : comparer : IComparer<'Key> * key : 'Key -> MapNode<'Key, 'Value> + abstract member AddInPlace : comparer : IComparer<'Key> * key : 'Key * value : 'Value -> MapNode<'Key, 'Value> + abstract member TryRemove : comparer : IComparer<'Key> * key : 'Key -> option * 'Value> + abstract member TryRemoveV : comparer : IComparer<'Key> * key : 'Key -> voption * 'Value)> + + abstract member Map : mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, 'T> -> MapNode<'Key, 'T> + abstract member Filter : predicate : OptimizedClosures.FSharpFunc<'Key, 'Value, bool> -> MapNode<'Key, 'Value> + abstract member Choose : mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, option<'T>> -> MapNode<'Key, 'T> + abstract member ChooseV : mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>> -> MapNode<'Key, 'T> + + abstract member UnsafeRemoveHeadV : unit -> struct('Key * 'Value * MapNode<'Key, 'Value>) + abstract member UnsafeRemoveTailV : unit -> struct(MapNode<'Key, 'Value> * '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 - - let size x = sizeAux 0 x - -#if TRACE_SETS_AND_MAPS - let mutable traceCount = 0 - let mutable numOnes = 0 - let mutable numNodes = 0 - let mutable numAdds = 0 - let mutable numRemoves = 0 - let mutable numLookups = 0 - let mutable numUnions = 0 - let mutable totalSizeOnNodeCreation = 0.0 - let mutable totalSizeOnMapAdd = 0.0 - let mutable totalSizeOnMapLookup = 0.0 - let mutable largestMapSize = 0 - let mutable largestMapStackTrace = Unchecked.defaultof<_> - - let report() = - traceCount <- traceCount + 1 - if traceCount % 1000000 = 0 then - System.Console.WriteLine( - "#MapOne = {0}, #MapNode = {1}, #Add = {2}, #Remove = {3}, #Unions = {4}, #Lookups = {5}, avMapTreeSizeOnNodeCreation = {6}, avMapSizeOnCreation = {7}, avMapSizeOnLookup = {8}", - numOnes, numNodes, numAdds, numRemoves, numUnions, numLookups, - (totalSizeOnNodeCreation / float (numNodes + numOnes)), (totalSizeOnMapAdd / float numAdds), - (totalSizeOnMapLookup / float numLookups)) - System.Console.WriteLine("#largestMapSize = {0}, largestMapStackTrace = {1}", largestMapSize, largestMapStackTrace) - - let MapTree n = - report() - numOnes <- numOnes + 1 - totalSizeOnNodeCreation <- totalSizeOnNodeCreation + 1.0 - MapTree n - - let MapTreeNode (x, l, v, r, h) = - report() - numNodes <- numNodes + 1 - let n = MapTreeNode (x, l, v, r, h) - totalSizeOnNodeCreation <- totalSizeOnNodeCreation + float (size n) - n -#endif - - 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 tolerance = 2 - - let mk l k v r : MapTree<'Key, 'Value> = - let hl = height l - let hr = height r - let m = if hl < hr then hr else hl - 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> = - value :?> MapTreeNode<'Key,'Value> - - let rebalance t1 (k: 'Key) (v: 'Value) t2 : MapTree<'Key, 'Value> = - let t1h = height t1 - let t2h = height t2 - if t2h > t1h + tolerance then (* right is heavier than left *) - 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 + tolerance then (* left is heavier than right *) - 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 + abstract member GetViewBetween : comparer : IComparer<'Key> * min : 'Key * minInclusive : bool * max : 'Key * maxInclusive : bool -> MapNode<'Key, 'Value> + abstract member WithMin : comparer : IComparer<'Key> * min : 'Key * minInclusive : bool -> MapNode<'Key, 'Value> + abstract member WithMax : comparer : IComparer<'Key> * max : 'Key * maxInclusive : bool -> MapNode<'Key, 'Value> + abstract member SplitV : comparer : IComparer<'Key> * key : 'Key -> struct(MapNode<'Key, 'Value> * MapNode<'Key, 'Value> * voption<'Value>) + + abstract member Change : comparer : IComparer<'Key> * key : 'Key * (option<'Value> -> option<'Value>) -> MapNode<'Key, 'Value> + abstract member ChangeV : comparer : IComparer<'Key> * key : 'Key * (voption<'Value> -> voption<'Value>) -> MapNode<'Key, 'Value> + + //// find, findKey tryFindKey, pick, partition, tryPick + //abstract member TryFindKey : pick : OptimizedClosures.FSharpFunc<'Key, 'Value, bool> -> option<'Key> + //abstract member TryFindKeyV : pick : OptimizedClosures.FSharpFunc<'Key, 'Value, bool> -> voption<'Key> + //abstract member TryPick : pick : OptimizedClosures.FSharpFunc<'Key, 'Value, option<'T>> -> option<'T> + //abstract member TryPickV : pick : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>> -> voption<'T> + + + and [] + MapEmpty<'Key, 'Value> private() = + inherit MapNode<'Key, 'Value>() + + static let instance = MapEmpty<'Key, 'Value>() :> MapNode<_,_> + + static member Instance : MapNode<'Key, 'Value> = instance + + override x.Count = 0 + override x.Height = 0 + override x.Add(_, key, value) = + MapLeaf(key, value) :> MapNode<_,_> - 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> + override x.AddIfNotPresent(_, key, value) = + MapLeaf(key, value) :> MapNode<_,_> - 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> - if tryGetValue comparer k &v m then - v - else - raise (KeyNotFoundException()) + override x.AddInPlace(_, key, value) = + MapLeaf(key, value) :> MapNode<_,_> - let tryFind (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = - let mutable v = Unchecked.defaultof<'Value> - if tryGetValue comparer k &v m then - Some v - else + override x.Remove(_,_) = + x :> MapNode<_,_> + + override x.TryRemove(_,_) = 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) + override x.TryRemoveV(_,_) = + ValueNone - 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 + override x.Map(_) = MapEmpty.Instance + override x.Filter(_) = x :> MapNode<_,_> + override x.Choose(_) = MapEmpty.Instance + override x.ChooseV(_) = MapEmpty.Instance - let partition (comparer: IComparer<'Key>) f m = - partitionAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m (empty, empty) + override x.UnsafeRemoveHeadV() = failwith "empty" + override x.UnsafeRemoveTailV() = failwith "empty" - let filter1 (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) k v acc = - if f.Invoke (k, v) then add comparer k v acc else acc + override x.GetViewBetween(_comparer : IComparer<'Key>, _min : 'Key, _minInclusive : bool, _max : 'Key, _maxInclusive : bool) = + x :> MapNode<_,_> + override x.WithMin(_comparer : IComparer<'Key>, _min : 'Key, _minInclusive : bool) = + x :> MapNode<_,_> + override x.WithMax(_comparer : IComparer<'Key>, _max : 'Key, _maxInclusive : bool) = + x :> MapNode<_,_> - 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>) = - if isEmpty m then failwith "internal error: Map.spliceOutSuccessor" - else - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> - 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 -> - 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 + override x.SplitV(_,_) = + (x :> MapNode<_,_>, x :> MapNode<_,_>, ValueNone) - 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 -> 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> + override x.Change(_comparer, key, update) = + match update None with + | None -> x :> MapNode<_,_> + | Some v -> MapLeaf(key, v) :> MapNode<_,_> + + override x.ChangeV(_comparer, key, update) = + match update ValueNone with + | ValueNone -> x :> MapNode<_,_> + | ValueSome v -> MapLeaf(key, v) :> MapNode<_,_> + + and [] + MapLeaf<'Key, 'Value> = + class + inherit MapNode<'Key, 'Value> + val mutable public Key : 'Key + val mutable public Value : 'Value + + override x.Height = + 1 + + override x.Count = + 1 + + override x.Add(comparer, key, value) = + let c = comparer.Compare(key, x.Key) + + if c > 0 then + MapInner(x, key, value, MapEmpty.Instance) :> MapNode<'Key,'Value> + elif c < 0 then + MapInner(MapEmpty.Instance, key, value, x) :> MapNode<'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) + MapLeaf(key, value) :> MapNode<'Key,'Value> + + override x.AddIfNotPresent(comparer, key, value) = + let c = comparer.Compare(key, x.Key) + + if c > 0 then + MapInner(x, key, value, MapEmpty.Instance) :> MapNode<'Key,'Value> + elif c < 0 then + MapInner(MapEmpty.Instance, key, value, x) :> MapNode<'Key,'Value> + else + x :> MapNode<'Key,'Value> + + override x.AddInPlace(comparer, key, value) = + let c = comparer.Compare(key, x.Key) + + if c > 0 then + MapInner(x, key, value, MapEmpty.Instance) :> MapNode<'Key,'Value> + elif c < 0 then + MapInner(MapEmpty.Instance, key, value, x) :> MapNode<'Key,'Value> else - match u None with - | None -> m - | Some v -> MapTreeNode (k, v, m, empty, 2) :> MapTree<'Key,'Value> + x.Key <- key + x.Value <- value + x :> MapNode<'Key,'Value> + + + override x.Remove(comparer, key) = + if comparer.Compare(key, x.Key) = 0 then MapEmpty.Instance + else x :> MapNode<_,_> + + override x.TryRemove(comparer, key) = + if comparer.Compare(key, x.Key) = 0 then Some(MapEmpty.Instance, x.Value) + else None + + override x.TryRemoveV(comparer, key) = + if comparer.Compare(key, x.Key) = 0 then ValueSome(MapEmpty.Instance, x.Value) + else ValueNone + + override x.Map(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, 'T>) = + MapLeaf(x.Key, mapping.Invoke(x.Key, x.Value)) :> MapNode<_,_> + + override x.Filter(predicate : OptimizedClosures.FSharpFunc<'Key, 'Value, bool>) = + if predicate.Invoke(x.Key, x.Value) then + x :> MapNode<_,_> + else + MapEmpty.Instance - 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 -> - 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) + override x.Choose(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, option<'T>>) = + match mapping.Invoke(x.Key, x.Value) with + | Some v -> + MapLeaf(x.Key, v) :> MapNode<_,_> + | None -> + MapEmpty.Instance - let iter f m = - iterOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m + override x.ChooseV(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>>) = + match mapping.Invoke(x.Key, x.Value) with + | ValueSome v -> + MapLeaf(x.Key, v) :> MapNode<_,_> + | ValueNone -> + MapEmpty.Instance - 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: 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) + override x.UnsafeRemoveHeadV() = + struct(x.Key, x.Value, MapEmpty<'Key, 'Value>.Instance) - let exists f m = - existsOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m + override x.UnsafeRemoveTailV() = + struct(MapEmpty<'Key, 'Value>.Instance, x.Key, x.Value) - 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) + override x.GetViewBetween(comparer : IComparer<'Key>, min : 'Key, minInclusive : bool, max : 'Key, maxInclusive : bool) = + let cMin = comparer.Compare(x.Key, min) + if (if minInclusive then cMin >= 0 else cMin > 0) then + let cMax = comparer.Compare(x.Key, max) + if (if maxInclusive then cMax <= 0 else cMax < 0) then + x :> MapNode<_,_> + else + MapEmpty.Instance + else + MapEmpty.Instance + + override x.WithMin(comparer : IComparer<'Key>, min : 'Key, minInclusive : bool) = + let cMin = comparer.Compare(x.Key, min) + if (if minInclusive then cMin >= 0 else cMin > 0) then + x :> MapNode<_,_> + else + MapEmpty.Instance + + override x.WithMax(comparer : IComparer<'Key>, max : 'Key, maxInclusive : bool) = + let cMax = comparer.Compare(x.Key, max) + if (if maxInclusive then cMax <= 0 else cMax < 0) then + x :> MapNode<_,_> + else + MapEmpty.Instance + + override x.SplitV(comparer : IComparer<'Key>, key : 'Key) = + let c = comparer.Compare(x.Key, key) + if c > 0 then + struct(MapEmpty.Instance, x :> MapNode<_,_>, ValueNone) + elif c < 0 then + struct(x :> MapNode<_,_>, MapEmpty.Instance, ValueNone) + else + struct(MapEmpty.Instance, MapEmpty.Instance, ValueSome x.Value) + + override x.Change(comparer, key, update) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + match update None with + | None -> x :> MapNode<_,_> + | Some v -> MapInner(x, key, v, MapEmpty.Instance) :> MapNode<_,_> + elif c < 0 then + match update None with + | None -> x :> MapNode<_,_> + | Some v -> MapInner(MapEmpty.Instance, key, v, x) :> MapNode<_,_> + else + match update (Some x.Value) with + | Some v -> + MapLeaf(key, v) :> MapNode<_,_> + | None -> + MapEmpty.Instance + + override x.ChangeV(comparer, key, update) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + match update ValueNone with + | ValueNone -> x :> MapNode<_,_> + | ValueSome v -> MapInner(x, key, v, MapEmpty.Instance) :> MapNode<_,_> + elif c < 0 then + match update ValueNone with + | ValueNone -> x :> MapNode<_,_> + | ValueSome v -> MapInner(MapEmpty.Instance, key, v, x) :> MapNode<_,_> + else + match update (ValueSome x.Value) with + | ValueSome v -> + MapLeaf(key, v) :> MapNode<_,_> + | ValueNone -> + MapEmpty.Instance + + new(k : 'Key, v : 'Value) = { Key = k; Value = v} + end + + and [] + MapInner<'Key, 'Value> = + class + inherit MapNode<'Key, 'Value> + + val mutable public Left : MapNode<'Key, 'Value> + val mutable public Right : MapNode<'Key, 'Value> + val mutable public Key : 'Key + val mutable public Value : 'Value + val mutable public _Count : int + val mutable public _Height : int + + static member Create(l : MapNode<'Key, 'Value>, k : 'Key, v : 'Value, r : MapNode<'Key, 'Value>) = + let lh = l.Height + let rh = r.Height + let b = rh - lh + + if lh = 0 && rh = 0 then + MapLeaf(k, v) :> MapNode<_,_> + elif b > 2 then + // right heavy + let r = r :?> MapInner<'Key, 'Value> // must work + + if r.Right.Height >= r.Left.Height then + // right right case + MapInner.Create( + MapInner.Create(l, k, v, r.Left), + r.Key, r.Value, + r.Right + ) + else + // right left case + match r.Left with + | :? MapInner<'Key, 'Value> as rl -> + //let rl = r.Left :?> MapInner<'Key, 'Value> + let t1 = l + let t2 = rl.Left + let t3 = rl.Right + let t4 = r.Right + + MapInner.Create( + MapInner.Create(t1, k, v, t2), + rl.Key, rl.Value, + MapInner.Create(t3, r.Key, r.Value, t4) + ) + | _ -> + failwith "impossible" + + + elif b < -2 then + let l = l :?> MapInner<'Key, 'Value> // must work + + if l.Left.Height >= l.Right.Height then + MapInner.Create( + l.Left, + l.Key, l.Value, + MapInner.Create(l.Right, k, v, r) + ) - let forall f m = - forallOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m + else + match l.Right with + | :? MapInner<'Key, 'Value> as lr -> + let t1 = l.Left + let t2 = lr.Left + let t3 = lr.Right + let t4 = r + MapInner.Create( + MapInner.Create(t1, l.Key, l.Value, t2), + lr.Key, lr.Value, + MapInner.Create(t3, k, v, t4) + ) + | _ -> + failwith "impossible" - 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: 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: 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: 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 + else + MapInner(l, k, v, r) :> MapNode<_,_> + + static member Join(l : MapNode<'Key, 'Value>, r : MapNode<'Key, 'Value>) = + if l.Height = 0 then r + elif r.Height = 0 then l + elif l.Height > r.Height then + let struct(l1, k, v) = l.UnsafeRemoveTailV() + MapInner.Create(l1, k, v, r) + else + let struct(k, v, r1) = r.UnsafeRemoveHeadV() + MapInner.Create(l, k, v, r1) - if comparer.Compare(lo, hi) = 1 then x else foldFromTo f m x + override x.Count = + x._Count - let foldSection (comparer: IComparer<'Key>) lo hi f m x = - foldSectionOpt comparer lo hi (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) m x + override x.Height = + x._Height + + override x.Add(comparer : IComparer<'Key>, key : 'Key, value : 'Value) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + MapInner.Create( + x.Left, + x.Key, x.Value, + x.Right.Add(comparer, key, value) + ) + elif c < 0 then + MapInner.Create( + x.Left.Add(comparer, key, value), + x.Key, x.Value, + x.Right + ) + else + MapInner( + x.Left, + key, value, + x.Right + ) :> MapNode<_,_> + + override x.AddIfNotPresent(comparer : IComparer<'Key>, key : 'Key, value : 'Value) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + MapInner.Create( + x.Left, + x.Key, x.Value, + x.Right.AddIfNotPresent(comparer, key, value) + ) + elif c < 0 then + MapInner.Create( + x.Left.AddIfNotPresent(comparer, key, value), + x.Key, x.Value, + x.Right + ) + else + x :> MapNode<_,_> + + override x.AddInPlace(comparer : IComparer<'Key>, key : 'Key, value : 'Value) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + x.Right <- x.Right.AddInPlace(comparer, key, value) + + let bal = abs (x.Right.Height - x.Left.Height) + if bal < 2 then + x._Height <- 1 + max x.Left.Height x.Right.Height + x._Count <- 1 + x.Right.Count + x.Left.Count + x :> MapNode<_,_> + else + MapInner.Create( + x.Left, + x.Key, x.Value, + x.Right + ) + elif c < 0 then + x.Left <- x.Left.AddInPlace(comparer, key, value) + + let bal = abs (x.Right.Height - x.Left.Height) + if bal < 2 then + x._Height <- 1 + max x.Left.Height x.Right.Height + x._Count <- 1 + x.Right.Count + x.Left.Count + x :> MapNode<_,_> + else + MapInner.Create( + x.Left, + x.Key, x.Value, + x.Right + ) + else + x.Key <- key + x.Value <- value + x :> MapNode<_,_> + + override x.Remove(comparer : IComparer<'Key>, key : 'Key) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + MapInner.Create( + x.Left, + x.Key, x.Value, + x.Right.Remove(comparer, key) + ) + elif c < 0 then + MapInner.Create( + x.Left.Remove(comparer, key), + x.Key, x.Value, + x.Right + ) + else + MapInner.Join(x.Left, x.Right) + + override x.TryRemove(comparer : IComparer<'Key>, key : 'Key) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + match x.Right.TryRemoveV(comparer, key) with + | ValueSome struct(newRight, value) -> + let newNode = + MapInner.Create( + x.Left, + x.Key, x.Value, + newRight + ) + Some(newNode, value) + | ValueNone -> + None + elif c < 0 then + match x.Left.TryRemoveV(comparer, key) with + | ValueSome struct(newLeft, value) -> + let newNode = + MapInner.Create( + newLeft, + x.Key, x.Value, + x.Right + ) + Some(newNode, value) + | ValueNone -> + None + else + Some(MapInner.Join(x.Left, x.Right), x.Value) + + override x.TryRemoveV(comparer : IComparer<'Key>, key : 'Key) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + match x.Right.TryRemoveV(comparer, key) with + | ValueSome struct(newRight, value) -> + let newNode = + MapInner.Create( + x.Left, + x.Key, x.Value, + newRight + ) + ValueSome(newNode, value) + | ValueNone -> + ValueNone + elif c < 0 then + match x.Left.TryRemoveV(comparer, key) with + | ValueSome struct(newLeft, value) -> + let newNode = + MapInner.Create( + newLeft, + x.Key, x.Value, + x.Right + ) + ValueSome(newNode, value) + | ValueNone -> + ValueNone + else + ValueSome(MapInner.Join(x.Left, x.Right), x.Value) + + override x.Map(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, 'T>) = + MapInner( + x.Left.Map(mapping), + x.Key, mapping.Invoke(x.Key, x.Value), + x.Right.Map(mapping) + ) :> MapNode<_,_> + + override x.Filter(predicate : OptimizedClosures.FSharpFunc<'Key, 'Value, bool>) = + let l = x.Left.Filter(predicate) + let self = predicate.Invoke(x.Key, x.Value) + let r = x.Right.Filter(predicate) + + if self then + MapInner.Create(l, x.Key, x.Value, r) + else + MapInner.Join(l, r) + + override x.Choose(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, option<'T>>) = + let l = x.Left.Choose(mapping) + let self = mapping.Invoke(x.Key, x.Value) + let r = x.Right.Choose(mapping) + match self with + | Some value -> + MapInner.Create(l, x.Key, value, r) + | None -> + MapInner.Join(l, r) + + + override x.ChooseV(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>>) = + let l = x.Left.ChooseV(mapping) + let self = mapping.Invoke(x.Key, x.Value) + let r = x.Right.ChooseV(mapping) + match self with + | ValueSome value -> + MapInner.Create(l, x.Key, value, r) + | ValueNone -> + MapInner.Join(l, r) + + override x.UnsafeRemoveHeadV() = + if x.Left.Count = 0 then + struct(x.Key, x.Value, x.Right) + else + let struct(k,v,l1) = x.Left.UnsafeRemoveHeadV() + struct(k, v, MapInner.Create(l1, x.Key, x.Value, x.Right)) - 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 = - 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 ofArray comparer (arr : array<'Key * 'Value>) = - let mutable res = empty - for (x, y) in arr do - res <- add comparer x y res - res - - 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 - - let copyToArray m (arr: _[]) i = - let mutable j = i - m |> 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:MapTree<'Key, 'Value> list) = - match stack with - | [] -> [] - | 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 } - - let notStarted() = - raise (InvalidOperationException(SR.GetString(SR.enumerationNotStarted))) - - let alreadyFinished() = - raise (InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))) - - let current i = - if i.started then - 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) - else - notStarted() - - let rec moveNext i = - if i.started then - match i.stack with - | [] -> false - | 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 + override x.UnsafeRemoveTailV() = + if x.Right.Count = 0 then + struct(x.Left, x.Key, x.Value) + else + let struct(r1,k,v) = x.Right.UnsafeRemoveTailV() + struct(MapInner.Create(x.Left, x.Key, x.Value, r1), k, v) + + + override x.WithMin(comparer : IComparer<'Key>, min : 'Key, minInclusive : bool) = + let c = comparer.Compare(x.Key, min) + let greaterMin = if minInclusive then c >= 0 else c > 0 + if greaterMin then + MapInner.Create( + x.Left.WithMin(comparer, min, minInclusive), + x.Key, x.Value, + x.Right + ) + else + x.Right.WithMin(comparer, min, minInclusive) + + + override x.WithMax(comparer : IComparer<'Key>, max : 'Key, maxInclusive : bool) = + let c = comparer.Compare(x.Key, max) + let smallerMax = if maxInclusive then c <= 0 else c < 0 + if smallerMax then + MapInner.Create( + x.Left, + x.Key, x.Value, + x.Right.WithMax(comparer, max, maxInclusive) + ) + else + x.Left.WithMax(comparer, max, maxInclusive) + + + override x.SplitV(comparer : IComparer<'Key>, key : 'Key) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + let struct(rl, rr, rv) = x.Right.SplitV(comparer, key) + struct(MapInner.Create(x.Left, x.Key, x.Value, rl), rr, rv) + elif c < 0 then + let struct(ll, lr, lv) = x.Left.SplitV(comparer, key) + struct(ll, MapInner.Create(lr, x.Key, x.Value, x.Right), lv) + else + struct(x.Left, x.Right, ValueSome x.Value) - let mkIEnumerator m = - let mutable i = mkIterator m - { new IEnumerator<_> with - member __.Current = current i + override x.GetViewBetween(comparer : IComparer<'Key>, min : 'Key, minInclusive : bool, max : 'Key, maxInclusive : bool) = + let cMin = comparer.Compare(x.Key, min) + let cMax = comparer.Compare(x.Key, max) - interface System.Collections.IEnumerator with - member __.Current = box (current i) - member __.MoveNext() = moveNext i - member __.Reset() = i <- mkIterator m + let greaterMin = if minInclusive then cMin >= 0 else cMin > 0 + let smallerMax = if maxInclusive then cMax <= 0 else cMax < 0 - interface System.IDisposable with - member __.Dispose() = ()} + if not greaterMin then + x.Right.GetViewBetween(comparer, min, minInclusive, max, maxInclusive) -[>)>] -[] -[] -[] + elif not smallerMax then + x.Left.GetViewBetween(comparer, min, minInclusive, max, maxInclusive) + + elif greaterMin && smallerMax then + let l = x.Left.WithMin(comparer, min, minInclusive) + let r = x.Right.WithMax(comparer, max, maxInclusive) + MapInner.Create(l, x.Key, x.Value, r) + + elif greaterMin then + let l = x.Left.GetViewBetween(comparer, min, minInclusive, max, maxInclusive) + let r = x.Right.WithMax(comparer, max, maxInclusive) + MapInner.Create(l, x.Key, x.Value, r) + + elif smallerMax then + let l = x.Left.WithMin(comparer, min, minInclusive) + let r = x.Right.GetViewBetween(comparer, min, minInclusive, max, maxInclusive) + MapInner.Create(l, x.Key, x.Value, r) + + else + failwith "invalid range" + + override x.Change(comparer, key, update) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + MapInner.Create( + x.Left, + x.Key, x.Value, + x.Right.Change(comparer, key, update) + ) + elif c < 0 then + MapInner.Create( + x.Left.Change(comparer, key, update), + x.Key, x.Value, + x.Right + ) + else + match update (Some x.Value) with + | Some v -> + MapInner( + x.Left, + key, v, + x.Right + ) :> MapNode<_,_> + | None -> + MapInner.Join(x.Left, x.Right) + + override x.ChangeV(comparer, key, update) = + let c = comparer.Compare(key, x.Key) + if c > 0 then + MapInner.Create( + x.Left, + x.Key, x.Value, + x.Right.ChangeV(comparer, key, update) + ) + elif c < 0 then + MapInner.Create( + x.Left.ChangeV(comparer, key, update), + x.Key, x.Value, + x.Right + ) + else + match update (ValueSome x.Value) with + | ValueSome v -> + MapInner( + x.Left, + key, v, + x.Right + ) :> MapNode<_,_> + | ValueNone -> + MapInner.Join(x.Left, x.Right) + + new(l : MapNode<'Key, 'Value>, k : 'Key, v : 'Value, r : MapNode<'Key, 'Value>) = + assert(l.Count > 0 || r.Count > 0) // not both empty + assert(abs (r.Height - l.Height) <= 2) // balanced + { + Left = l + Right = r + Key = k + Value = v + _Count = 1 + l.Count + r.Count + _Height = 1 + max l.Height r.Height + } + end + + + let inline combineHash (a: int) (b: int) = + uint32 a ^^^ uint32 b + 0x9e3779b9u + ((uint32 a) <<< 6) + ((uint32 a) >>> 2) |> int + + + let hash (n : MapNode<'K, 'V>) = + let rec hash (acc : int) (n : MapNode<'K, 'V>) = + match n with + | :? MapLeaf<'K, 'V> as n -> + combineHash acc (combineHash (Unchecked.hash n.Key) (Unchecked.hash n.Value)) + + | :? MapInner<'K, 'V> as n -> + let acc = hash acc n.Left + let acc = combineHash acc (combineHash (Unchecked.hash n.Key) (Unchecked.hash n.Value)) + hash acc n.Right + | _ -> + acc + + hash 0 n + + let rec equals (cmp : IComparer<'K>) (l : MapNode<'K,'V>) (r : MapNode<'K,'V>) = + if l.Count <> r.Count then + false + else + // counts identical + match l with + | :? MapLeaf<'K, 'V> as l -> + let r = r :?> MapLeaf<'K, 'V> // has to hold (r.Count = 1) + cmp.Compare(l.Key, r.Key) = 0 && + Unchecked.equals l.Value r.Value + + | :? MapInner<'K, 'V> as l -> + match r with + | :? MapInner<'K, 'V> as r -> + let struct(ll, lr, lv) = l.SplitV(cmp, r.Key) + match lv with + | ValueSome lv when Unchecked.equals lv r.Value -> + equals cmp ll r.Left && + equals cmp lr r.Right + | _ -> + false + | _ -> + false + | _ -> + true + +open MapImplementation +open System.Diagnostics +open System.Runtime.InteropServices + +[] +[] [] -type Map<[]'Key, []'Value when 'Key : comparison >(comparer: IComparer<'Key>, tree: MapTree<'Key, 'Value>) = +[] +type Map< [] 'Key, [] 'Value when 'Key : comparison> private(comparer : IComparer<'Key>, root : MapNode<'Key, 'Value>) = + + static let defaultComparer = LanguagePrimitives.FastGenericComparer<'Key> + static let empty = Map<'Key, 'Value>(defaultComparer, MapEmpty.Instance) - [] + [] // This type is logically immutable. This field is only mutated during deserialization. let mutable comparer = comparer - - [] + + [] // This type is logically immutable. This field is only mutated during deserialization. - let mutable tree = tree + let mutable root = root - // This type is logically immutable. This field is only mutated during serialization and deserialization. - // // WARNING: The compiled name of this field may never be changed because it is part of the logical // WARNING: permanent serialization format for this type. let mutable serializedData = null - // We use .NET generics per-instantiation static fields to avoid allocating a new object for each empty - // 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.empty) + static let toKeyValueArray(root : MapNode<_,_>) = + let arr = Array.zeroCreate root.Count + let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let i = copyTo arr index n.Left + arr.[i] <- KeyValuePair(n.Key, n.Value) + + copyTo arr (i+1) n.Right + | :? MapLeaf<'Key, 'Value> as n -> + arr.[index] <- KeyValuePair(n.Key, n.Value) + index + 1 + | _ -> + index + + copyTo arr 0 root |> ignore + arr + + static let fromArray (elements : struct('Key * 'Value)[]) = + let cmp = defaultComparer + match elements.Length with + | 0 -> + MapEmpty.Instance + | 1 -> + let struct(k,v) = elements.[0] + MapLeaf(k, v) :> MapNode<_,_> + | 2 -> + let struct(k0,v0) = elements.[0] + let struct(k1,v1) = elements.[1] + let c = cmp.Compare(k0, k1) + if c > 0 then MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0)) :> MapNode<_,_> + elif c < 0 then MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance) :> MapNode<_,_> + else MapLeaf(k1, v1):> MapNode<_,_> + | 3 -> + let struct(k0,v0) = elements.[0] + let struct(k1,v1) = elements.[1] + let struct(k2,v2) = elements.[2] + MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2) + | 4 -> + let struct(k0,v0) = elements.[0] + let struct(k1,v1) = elements.[1] + let struct(k2,v2) = elements.[2] + let struct(k3,v3) = elements.[3] + MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3) + | 5 -> + let struct(k0,v0) = elements.[0] + let struct(k1,v1) = elements.[1] + let struct(k2,v2) = elements.[2] + let struct(k3,v3) = elements.[3] + let struct(k4,v4) = elements.[4] + MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4) + | _ -> + let struct(arr, cnt) = Sorting.mergeSortHandleDuplicatesV false cmp elements elements.Length + Map.CreateRoot(arr, cnt) [] member __.OnSerializing(context: System.Runtime.Serialization.StreamingContext) = ignore context - serializedData <- MapTree.toArray tree |> Array.map (fun (k, v) -> KeyValuePair(k, v)) - - // Do not set this to null, since concurrent threads may also be serializing the data - //[] - //member __.OnSerialized(context: System.Runtime.Serialization.StreamingContext) = - // serializedData <- null + serializedData <- toKeyValueArray root [] member __.OnDeserialized(context: System.Runtime.Serialization.StreamingContext) = ignore context - comparer <- LanguagePrimitives.FastGenericComparer<'Key> - tree <- serializedData |> Array.map (fun kvp -> kvp.Key, kvp.Value) |> MapTree.ofArray comparer + comparer <- defaultComparer serializedData <- null + root <- serializedData |> Array.map (fun kvp -> struct(kvp.Key, kvp.Value)) |> fromArray - static member Empty : Map<'Key, 'Value> = - empty - - static member Create(ie : IEnumerable<_>) : Map<'Key, 'Value> = - let comparer = LanguagePrimitives.FastGenericComparer<'Key> - new Map<_, _>(comparer, MapTree.ofSeq comparer ie) - - new (elements : seq<_>) = - let comparer = LanguagePrimitives.FastGenericComparer<'Key> - new Map<_, _>(comparer, MapTree.ofSeq comparer elements) - - [] - member internal m.Comparer = comparer - - //[] - member internal m.Tree = tree - - member m.Add(key, value) : Map<'Key, 'Value> = -#if TRACE_SETS_AND_MAPS - MapTree.report() - MapTree.numAdds <- MapTree.numAdds + 1 - let size = MapTree.size m.Tree + 1 - MapTree.totalSizeOnMapAdd <- MapTree.totalSizeOnMapAdd + float size - if size > MapTree.largestMapSize then - MapTree.largestMapSize <- size - MapTree.largestMapStackTrace <- System.Diagnostics.StackTrace().ToString() -#endif - new Map<'Key, 'Value>(comparer, MapTree.add comparer key value tree) - - member m.Change(key, f) : Map<'Key, 'Value> = - new Map<'Key, 'Value>(comparer, MapTree.change comparer key f tree) - - [] - member m.IsEmpty = MapTree.isEmpty tree - - member m.Item - with get(key : 'Key) = -#if TRACE_SETS_AND_MAPS - MapTree.report() - MapTree.numLookups <- MapTree.numLookups + 1 - MapTree.totalSizeOnMapLookup <- MapTree.totalSizeOnMapLookup + float (MapTree.size tree) -#endif - MapTree.find comparer key tree - - member m.TryPick f = - MapTree.tryPick f tree - - member m.Exists predicate = - MapTree.exists predicate tree - - member m.Filter predicate = - new Map<'Key, 'Value>(comparer, MapTree.filter comparer predicate tree) - - member m.ForAll predicate = - MapTree.forall predicate tree - - member m.Fold f acc = - MapTree.foldBack f tree acc - - member m.FoldSection (lo:'Key) (hi:'Key) f (acc:'z) = - MapTree.foldSection comparer lo hi f tree acc - - member m.Iterate f = - MapTree.iter 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) - - member m.Partition predicate : Map<'Key, 'Value> * Map<'Key, 'Value> = - let r1, r2 = MapTree.partition comparer predicate tree - new Map<'Key, 'Value>(comparer, r1), new Map<'Key, 'Value>(comparer, r2) - - member m.Count = - MapTree.size tree - - member m.ContainsKey key = -#if TRACE_SETS_AND_MAPS - MapTree.report() - MapTree.numLookups <- MapTree.numLookups + 1 - MapTree.totalSizeOnMapLookup <- MapTree.totalSizeOnMapLookup + float (MapTree.size tree) -#endif - MapTree.mem comparer key tree - - member m.Remove key = - new Map<'Key, 'Value>(comparer, MapTree.remove comparer key tree) - - member m.TryGetValue(key, [] value: byref<'Value>) = - MapTree.tryGetValue comparer key &value tree - - member m.TryFind key = -#if TRACE_SETS_AND_MAPS - MapTree.report() - MapTree.numLookups <- MapTree.numLookups + 1 - MapTree.totalSizeOnMapLookup <- MapTree.totalSizeOnMapLookup + float (MapTree.size tree) -#endif - MapTree.tryFind comparer key tree - - member m.ToList() = - MapTree.toList tree - - member m.ToArray() = - MapTree.toArray tree - - static member ofList l : Map<'Key, 'Value> = - let comparer = LanguagePrimitives.FastGenericComparer<'Key> - new Map<_, _>(comparer, MapTree.ofList comparer l) - - 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 (hash x) - res <- combineHash res (Unchecked.hash y) - res - - override this.Equals that = - match that with - | :? Map<'Key, 'Value> as that -> - use e1 = (this :> seq<_>).GetEnumerator() - use e2 = (that :> seq<_>).GetEnumerator() - let rec loop () = - let m1 = e1.MoveNext() - let m2 = e2.MoveNext() - (m1 = m2) && (not m1 || - (let e1c = e1.Current - let e2c = e2.Current - ((e1c.Key = e2c.Key) && (Unchecked.equals e1c.Value e2c.Value) && loop()))) - loop() - | _ -> false - - override this.GetHashCode() = this.ComputeHashCode() - - interface IEnumerable> with - member __.GetEnumerator() = MapTree.mkIEnumerator tree - - interface System.Collections.IEnumerable with - member __.GetEnumerator() = (MapTree.mkIEnumerator tree :> System.Collections.IEnumerator) + static member Empty = empty - interface IDictionary<'Key, 'Value> with - member m.Item - with get x = m.[x] - and set x v = ignore(x, v); raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) + static member private CreateTree(cmp : IComparer<'Key>, arr : ('Key * 'Value)[], cnt : int)= + let rec create (arr : ('Key * 'Value)[]) (l : int) (r : int) = + if l > r then + MapEmpty.Instance + elif l = r then + let (k,v) = arr.[l] + MapLeaf(k, v) :> MapNode<_,_> + else + let m = (l+r)/2 + let (k,v) = arr.[m] + MapInner( + create arr l (m-1), + k, v, + create arr (m+1) r + ) :> MapNode<_,_> + + Map(cmp, create arr 0 (cnt-1)) + + static member private CreateTree(cmp : IComparer<'Key>, arr : struct('Key * 'Value)[], cnt : int)= + let rec create (arr : struct('Key * 'Value)[]) (l : int) (r : int) = + if l = r then + let struct(k,v) = arr.[l] + MapLeaf(k, v) :> MapNode<_,_> + elif l > r then + MapEmpty.Instance + else + let m = (l+r)/2 + let struct(k,v) = arr.[m] + MapInner( + create arr l (m-1), + k, v, + create arr (m+1) r + ) :> MapNode<_,_> + + Map(cmp, create arr 0 (cnt-1)) + + static member private CreateRoot(arr : struct('Key * 'Value)[], cnt : int)= + let rec create (arr : struct('Key * 'Value)[]) (l : int) (r : int) = + if l = r then + let struct(k,v) = arr.[l] + MapLeaf(k, v) :> MapNode<_,_> + elif l > r then + MapEmpty.Instance + else + let m = (l+r)/2 + let struct(k,v) = arr.[m] + MapInner( + create arr l (m-1), + k, v, + create arr (m+1) r + ) :> MapNode<_,_> + + create arr 0 (cnt-1) + + static member FromArray (elements : array<'Key * 'Value>) = + let cmp = defaultComparer + match elements.Length with + | 0 -> + Map(cmp, MapEmpty.Instance) + | 1 -> + let (k,v) = elements.[0] + Map(cmp, MapLeaf(k, v)) + | 2 -> + let (k0,v0) = elements.[0] + let (k1,v1) = elements.[1] + let c = cmp.Compare(k0, k1) + if c > 0 then Map(cmp, MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0))) + elif c < 0 then Map(cmp, MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance)) + else Map(cmp, MapLeaf(k1, v1)) + | 3 -> + let (k0,v0) = elements.[0] + let (k1,v1) = elements.[1] + let (k2,v2) = elements.[2] + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2)) + | 4 -> + let (k0,v0) = elements.[0] + let (k1,v1) = elements.[1] + let (k2,v2) = elements.[2] + let (k3,v3) = elements.[3] + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3)) + | 5 -> + let (k0,v0) = elements.[0] + let (k1,v1) = elements.[1] + let (k2,v2) = elements.[2] + let (k3,v3) = elements.[3] + let (k4,v4) = elements.[4] + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4)) + | _ -> + let struct(arr, cnt) = Sorting.mergeSortHandleDuplicates false cmp elements elements.Length + Map.CreateTree(cmp, arr, cnt) + + static member FromArrayV (elements : array) = + let cmp = defaultComparer + match elements.Length with + | 0 -> + Map(cmp, MapEmpty.Instance) + | 1 -> + let struct(k,v) = elements.[0] + Map(cmp, MapLeaf(k, v)) + | 2 -> + let struct(k0,v0) = elements.[0] + let struct(k1,v1) = elements.[1] + let c = cmp.Compare(k0, k1) + if c > 0 then Map(cmp, MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0))) + elif c < 0 then Map(cmp, MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance)) + else Map(cmp, MapLeaf(k1, v1)) + | 3 -> + let struct(k0,v0) = elements.[0] + let struct(k1,v1) = elements.[1] + let struct(k2,v2) = elements.[2] + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2)) + | 4 -> + let struct(k0,v0) = elements.[0] + let struct(k1,v1) = elements.[1] + let struct(k2,v2) = elements.[2] + let struct(k3,v3) = elements.[3] + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3)) + | 5 -> + let struct(k0,v0) = elements.[0] + let struct(k1,v1) = elements.[1] + let struct(k2,v2) = elements.[2] + let struct(k3,v3) = elements.[3] + let struct(k4,v4) = elements.[4] + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4)) + | _ -> + let struct(arr, cnt) = Sorting.mergeSortHandleDuplicatesV false cmp elements elements.Length + Map.CreateTree(cmp, arr, cnt) + + static member FromList (elements : list<'Key * 'Value>) = + let rec atMost (cnt : int) (l : list<_>) = + match l with + | [] -> true + | _ :: t -> + if cnt > 0 then atMost (cnt - 1) t + else false + + let cmp = defaultComparer + match elements with + | [] -> + // cnt = 0 + Map(cmp, MapEmpty.Instance) + + | ((k0, v0) as t0) :: rest -> + // cnt >= 1 + match rest with + | [] -> + // cnt = 1 + Map(cmp, MapLeaf(k0, v0)) + | ((k1, v1) as t1) :: rest -> + // cnt >= 2 + match rest with + | [] -> + // cnt = 2 + let c = cmp.Compare(k0, k1) + if c < 0 then Map(cmp, MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance)) + elif c > 0 then Map(cmp, MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0))) + else Map(cmp, MapLeaf(k1, v1)) + | ((k2, v2) as t2) :: rest -> + // cnt >= 3 + match rest with + | [] -> + // cnt = 3 + Map(cmp, MapLeaf(k0,v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2)) + | ((k3, v3) as t3) :: rest -> + // cnt >= 4 + match rest with + | [] -> + // cnt = 4 + Map(cmp, MapLeaf(k0,v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3)) + | ((k4, v4) as t4) :: rest -> + // cnt >= 5 + match rest with + | [] -> + // cnt = 5 + Map(cmp, MapLeaf(k0,v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4)) + | t5 :: rest -> + // cnt >= 6 + let mutable arr = Array.zeroCreate 16 + let mutable cnt = 6 + arr.[0] <- t0 + arr.[1] <- t1 + arr.[2] <- t2 + arr.[3] <- t3 + arr.[4] <- t4 + arr.[5] <- t5 + for t in rest do + if cnt >= arr.Length then System.Array.Resize(&arr, arr.Length <<< 1) + arr.[cnt] <- t + cnt <- cnt + 1 + + let struct(arr1, cnt1) = Sorting.mergeSortHandleDuplicates true cmp arr cnt + Map.CreateTree(cmp, arr1, cnt1) + + + + + + static member FromListV (elements : list) = + let rec atMost (cnt : int) (l : list<_>) = + match l with + | [] -> true + | _ :: t -> + if cnt > 0 then atMost (cnt - 1) t + else false + + let cmp = defaultComparer + match elements with + | [] -> + // cnt = 0 + Map(cmp, MapEmpty.Instance) + + | struct(k0, v0) :: rest -> + // cnt >= 1 + match rest with + | [] -> + // cnt = 1 + Map(cmp, MapLeaf(k0, v0)) + | struct(k1, v1) :: rest -> + // cnt >= 2 + match rest with + | [] -> + // cnt = 2 + let c = cmp.Compare(k0, k1) + if c < 0 then Map(cmp, MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance)) + elif c > 0 then Map(cmp, MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0))) + else Map(cmp, MapLeaf(k1, v1)) + | struct(k2, v2) :: rest -> + // cnt >= 3 + match rest with + | [] -> + // cnt = 3 + Map(cmp, MapLeaf(k0,v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2)) + | struct(k3, v3) :: rest -> + // cnt >= 4 + match rest with + | [] -> + // cnt = 4 + Map(cmp, MapLeaf(k0,v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3)) + | struct(k4, v4) :: rest -> + // cnt >= 5 + match rest with + | [] -> + // cnt = 5 + Map(cmp, MapLeaf(k0,v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4)) + | t5 :: rest -> + // cnt >= 6 + let mutable arr = Array.zeroCreate 16 + let mutable cnt = 6 + arr.[0] <- struct(k0, v0) + arr.[1] <- struct(k1, v1) + arr.[2] <- struct(k2, v2) + arr.[3] <- struct(k3, v3) + arr.[4] <- struct(k4, v4) + arr.[5] <- t5 + for t in rest do + if cnt >= arr.Length then System.Array.Resize(&arr, arr.Length <<< 1) + arr.[cnt] <- t + cnt <- cnt + 1 + + let struct(arr1, cnt1) = Sorting.mergeSortHandleDuplicatesV true cmp arr cnt + Map.CreateTree(cmp, arr1, cnt1) + + static member FromSeq (elements : seq<'Key * 'Value>) = + match elements with + | :? array<'Key * 'Value> as e -> Map.FromArray e + | :? list<'Key * 'Value> as e -> Map.FromList e + | _ -> + let cmp = defaultComparer + use e = elements.GetEnumerator() + if e.MoveNext() then + // cnt >= 1 + let t0 = e.Current + let (k0,v0) = t0 + if e.MoveNext() then + // cnt >= 2 + let t1 = e.Current + let (k1,v1) = t1 + if e.MoveNext() then + // cnt >= 3 + let t2 = e.Current + let (k2,v2) = t2 + if e.MoveNext() then + // cnt >= 4 + let t3 = e.Current + let (k3, v3) = t3 + if e.MoveNext() then + // cnt >= 5 + let t4 = e.Current + let (k4, v4) = t4 + if e.MoveNext() then + // cnt >= 6 + let mutable arr = Array.zeroCreate 16 + let mutable cnt = 6 + arr.[0] <- t0 + arr.[1] <- t1 + arr.[2] <- t2 + arr.[3] <- t3 + arr.[4] <- t4 + arr.[5] <- e.Current + + while e.MoveNext() do + if cnt >= arr.Length then System.Array.Resize(&arr, arr.Length <<< 1) + arr.[cnt] <- e.Current + cnt <- cnt + 1 + + let struct(arr1, cnt1) = Sorting.mergeSortHandleDuplicates true cmp arr cnt + Map.CreateTree(cmp, arr1, cnt1) + + else + // cnt = 5 + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4)) + + else + // cnt = 4 + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3)) + else + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2)) + else + // cnt = 2 + let c = cmp.Compare(k0, k1) + if c < 0 then Map(cmp, MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance)) + elif c > 0 then Map(cmp, MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0))) + else Map(cmp, MapLeaf(k1, v1)) + else + // cnt = 1 + Map(cmp, MapLeaf(k0, v0)) - // REVIEW: this implementation could avoid copying the Values to an array - member m.Keys = ([| for kvp in m -> kvp.Key |] :> ICollection<'Key>) + else + Map(cmp, MapEmpty.Instance) + + static member FromSeqV (elements : seq) = + match elements with + | :? array as e -> Map.FromArrayV e + | :? list as e -> Map.FromListV e + | _ -> + let cmp = defaultComparer + use e = elements.GetEnumerator() + if e.MoveNext() then + // cnt >= 1 + let struct(k0,v0) = e.Current + if e.MoveNext() then + // cnt >= 2 + let struct(k1,v1) = e.Current + if e.MoveNext() then + // cnt >= 3 + let struct(k2,v2) = e.Current + if e.MoveNext() then + // cnt >= 4 + let struct(k3, v3) = e.Current + if e.MoveNext() then + // cnt >= 5 + let struct(k4, v4) = e.Current + if e.MoveNext() then + // cnt >= 6 + let mutable arr = Array.zeroCreate 16 + let mutable cnt = 6 + arr.[0] <- struct(k0, v0) + arr.[1] <- struct(k1, v1) + arr.[2] <- struct(k2, v2) + arr.[3] <- struct(k3, v3) + arr.[4] <- struct(k4, v4) + arr.[5] <- e.Current + + while e.MoveNext() do + if cnt >= arr.Length then System.Array.Resize(&arr, arr.Length <<< 1) + arr.[cnt] <- e.Current + cnt <- cnt + 1 + + let struct(arr1, cnt1) = Sorting.mergeSortHandleDuplicatesV true cmp arr cnt + Map.CreateTree(cmp, arr1, cnt1) + + else + // cnt = 5 + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4)) + + else + // cnt = 4 + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3)) + else + Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2)) + else + // cnt = 2 + let c = cmp.Compare(k0, k1) + if c < 0 then Map(cmp, MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance)) + elif c > 0 then Map(cmp, MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0))) + else Map(cmp, MapLeaf(k1, v1)) + else + // cnt = 1 + Map(cmp, MapLeaf(k0, v0)) - // REVIEW: this implementation could avoid copying the Values to an array - member m.Values = ([| for kvp in m -> kvp.Value |] :> ICollection<'Value>) + else + Map(cmp, MapEmpty.Instance) + + static member Union(l : Map<'Key, 'Value>, r : Map<'Key, 'Value>) = + let rec union (cmp : IComparer<'Key>) (l : MapNode<'Key, 'Value>) (r : MapNode<'Key, 'Value>) = + match l with + | :? MapEmpty<'Key, 'Value> -> + r + | :? MapLeaf<'Key, 'Value> as l -> + r.AddIfNotPresent(cmp, l.Key, l.Value) + | :? MapInner<'Key, 'Value> as l -> + match r with + | :? MapEmpty<'Key, 'Value> -> + l :> MapNode<_,_> + | :? MapLeaf<'Key, 'Value> as r -> + l.Add(cmp, r.Key, r.Value) + | :? MapInner<'Key, 'Value> as r -> + if l.Count > r.Count then + let struct(rl, rr, rv) = r.SplitV(cmp, l.Key) + match rv with + | ValueSome rv -> + MapInner.Create( + union cmp l.Left rl, + l.Key, rv, + union cmp l.Right rr + ) + | ValueNone -> + MapInner.Create( + union cmp l.Left rl, + l.Key, l.Value, + union cmp l.Right rr + ) + else + let struct(ll, lr, _lv) = l.SplitV(cmp, r.Key) + MapInner.Create( + union cmp ll r.Left, + r.Key, r.Value, + union cmp lr r.Right + ) + | _ -> + failwith "unexpected node" + | _ -> + failwith "unexpected node" - member m.Add(k, v) = ignore(k, v); raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) + let cmp = defaultComparer + Map(cmp, union cmp l.Root r.Root) - member m.ContainsKey k = m.ContainsKey k + static member UnionWith(l : Map<'Key, 'Value>, r : Map<'Key, 'Value>, resolve : 'Key -> 'Value -> 'Value -> 'Value) = + let resolve = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt resolve + + let rec union (cmp : IComparer<'Key>) (resolve : OptimizedClosures.FSharpFunc<_,_,_,_>) (l : MapNode<'Key, 'Value>) (r : MapNode<'Key, 'Value>) = + match l with + | :? MapEmpty<'Key, 'Value> -> + r + | :? MapLeaf<'Key, 'Value> as l -> + r.ChangeV(cmp, l.Key, function + | ValueSome rv -> resolve.Invoke(l.Key, l.Value, rv) |> ValueSome + | ValueNone -> l.Value |> ValueSome + ) + | :? MapInner<'Key, 'Value> as l -> + match r with + | :? MapEmpty<'Key, 'Value> -> + l :> MapNode<_,_> + | :? MapLeaf<'Key, 'Value> as r -> + l.ChangeV(cmp, r.Key, function + | ValueSome lv -> resolve.Invoke(r.Key, lv, r.Value) |> ValueSome + | ValueNone -> r.Value |> ValueSome + ) + | :? MapInner<'Key, 'Value> as r -> + if l.Count > r.Count then + let struct(rl, rr, rv) = r.SplitV(cmp, l.Key) + match rv with + | ValueSome rv -> + MapInner.Create( + union cmp resolve l.Left rl, + l.Key, resolve.Invoke(l.Key, l.Value, rv), + union cmp resolve l.Right rr + ) + | ValueNone -> + MapInner.Create( + union cmp resolve l.Left rl, + l.Key, l.Value, + union cmp resolve l.Right rr + ) + else + let struct(ll, lr, lv) = l.SplitV(cmp, r.Key) + match lv with + | ValueSome lv -> + MapInner.Create( + union cmp resolve ll r.Left, + r.Key, resolve.Invoke(r.Key, lv, r.Value), + union cmp resolve lr r.Right + ) + | ValueNone -> + MapInner.Create( + union cmp resolve ll r.Left, + r.Key, r.Value, + union cmp resolve lr r.Right + ) + + | _ -> + failwith "unexpected node" + | _ -> + failwith "unexpected node" - member m.TryGetValue(k, r) = m.TryGetValue(k, &r) + let cmp = defaultComparer + Map(cmp, union cmp resolve l.Root r.Root) + + member x.Count = root.Count + member x.IsEmpty = root.Count = 0 + member x.Root = root + member x.Comparer = comparer - member m.Remove(k : 'Key) = ignore k; (raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) : bool) + static member ComputeDelta<'T>(l : Map<'Key, 'Value>, r : Map<'Key, 'Value>, add : Map<'Key, 'Value> -> Map<'Key, 'T>, remove : Map<'Key, 'Value> -> Map<'Key, 'T>, update : 'Key -> 'Value -> 'Value -> voption<'T>) : Map<'Key, 'T> = + + let inline add (cmp : IComparer<_>) (a : MapNode<'Key, 'Value>) = + if a.Count > 0 then add(Map<'Key, 'Value>(cmp, a)).Root + else MapEmpty.Instance + + let inline remove (cmp : IComparer<_>) (a : MapNode<'Key, 'Value>) = + if a.Count > 0 then remove(Map<'Key, 'Value>(cmp, a)).Root + else MapEmpty.Instance + + let rec computeDelta (cmp : IComparer<_>) (update : OptimizedClosures.FSharpFunc<_,_,_,_>) (l : MapNode<'Key, 'Value>) (r : MapNode<'Key, 'Value>) = + match l with + | :? MapLeaf<'Key, 'Value> as l -> + match r with + | :? MapLeaf<'Key, 'Value> as r -> + let c = cmp.Compare(l.Key, r.Key) + if c < 0 then + MapInner<'Key, 'T>.Join(remove cmp l, add cmp r) + elif c > 0 then + MapInner<'Key, 'T>.Join(add cmp r, remove cmp l) + else + match update.Invoke(l.Key, l.Value, r.Value) with + | ValueSome o -> MapLeaf(l.Key, o) :> MapNode<_,_> + | ValueNone -> MapEmpty.Instance + | :? MapInner<'Key, 'Value> as r -> + let struct(rl, rr, rv) = r.SplitV(cmp, l.Key) + + let a = computeDelta cmp update MapEmpty.Instance rl + let splitter = + match rv with + | ValueSome rv -> update.Invoke(l.Key, l.Value, rv) + | ValueNone -> ValueNone + let b = computeDelta cmp update MapEmpty.Instance rr + + match splitter with + | ValueSome v -> MapInner.Create(a, l.Key, v, b) + | ValueNone -> MapInner.Join(a, b) + | _ -> + remove cmp l + + | :? MapInner<'Key, 'Value> as l -> + match r with + | :? MapLeaf<'Key, 'Value> as r -> + let struct(ll, lr, lv) = l.SplitV(cmp, r.Key) + let a = computeDelta cmp update ll MapEmpty.Instance + let splitter = + match lv with + | ValueSome lv -> update.Invoke(l.Key, lv, r.Value) + | ValueNone -> ValueNone + let b = computeDelta cmp update lr MapEmpty.Instance + + match splitter with + | ValueSome v -> MapInner.Create(a, l.Key, v, b) + | ValueNone -> MapInner.Join(a, b) + | :? MapInner<'Key, 'Value> as r -> + if l.Count > r.Count then + let struct(rl, rr, rv) = r.SplitV(cmp, l.Key) + let a = computeDelta cmp update l.Left rl + let splitter = + match rv with + | ValueSome rv -> update.Invoke(l.Key, l.Value, rv) + | ValueNone -> ValueNone + let b = computeDelta cmp update l.Right rr + match splitter with + | ValueSome v -> MapInner.Create(a, l.Key, v, b) + | ValueNone -> MapInner.Join(a, b) + else + let struct(ll, lr, lv) = l.SplitV(cmp, r.Key) + let a = computeDelta cmp update ll r.Left + let splitter = + match lv with + | ValueSome lv -> update.Invoke(r.Key, lv, r.Value) + | ValueNone -> ValueNone + let b = computeDelta cmp update lr r.Right + match splitter with + | ValueSome v -> MapInner.Create(a, r.Key, v, b) + | ValueNone -> MapInner.Join(a, b) + | _ -> + remove cmp l + | _ -> + add cmp r + + let cmp = defaultComparer + let update = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt update + + Map(cmp, computeDelta cmp update l.Root r.Root) + + + member x.Add(key : 'Key, value : 'Value) = + Map(comparer, root.Add(comparer, key, value)) + + member x.AddMatch(key : 'Key, value : 'Value) = + let rec add (cmp : IComparer<'Key>) (key : 'Key) (value : 'Value) (n : MapNode<'Key, 'Value>) = + match n with + | :? MapLeaf<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c > 0 then + MapInner(n, key, value, MapEmpty.Instance) :> MapNode<_,_> + elif c < 0 then + MapInner(MapEmpty.Instance, key, value, n) :> MapNode<_,_> + else + MapLeaf(key, value) :> MapNode<_,_> + | :? MapInner<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c > 0 then + MapInner.Create( + n.Left, + n.Key, n.Value, + add cmp key value n.Right + ) + elif c < 0 then + MapInner.Create( + add cmp key value n.Left, + n.Key, n.Value, + n.Right + ) + else + MapInner( + n.Left, + key, value, + n.Right + ) :> MapNode<_,_> + | _ -> + MapLeaf(key, value) :> MapNode<_,_> + + Map(comparer, add comparer key value root) + + member x.Remove(key : 'Key) = + Map(comparer, root.Remove(comparer, key)) + + member x.RemoveMatch(key : 'Key) = + + let rec remove (cmp : IComparer<'Key>) (key : 'Key) (n : MapNode<'Key, 'Value>) = + match n with + | :? MapLeaf<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c = 0 then MapEmpty.Instance + else n :> MapNode<_,_> + | :? MapInner<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c > 0 then + MapInner.Create( + n.Left, + n.Key, n.Value, + remove cmp key n.Right + ) + elif c < 0 then + MapInner.Create( + remove cmp key n.Left, + n.Key, n.Value, + n.Right + ) + else + MapInner.Join(n.Left, n.Right) + | _ -> + MapEmpty.Instance + + Map(comparer, remove comparer key root) + + member x.Iter(action : 'Key -> 'Value -> unit) = + let action = OptimizedClosures.FSharpFunc<_,_,_>.Adapt action + let rec iter (action : OptimizedClosures.FSharpFunc<_,_,_>) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + iter action n.Left + action.Invoke(n.Key, n.Value) + iter action n.Right + | :? MapLeaf<'Key, 'Value> as n -> + action.Invoke(n.Key, n.Value) + | _ -> + () + iter action root - interface ICollection> with - member __.Add x = ignore x; raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) + member x.Map(mapping : 'Key -> 'Value -> 'T) = + let mapping = OptimizedClosures.FSharpFunc<_,_,_>.Adapt mapping + Map(comparer, root.Map(mapping)) + + member x.Filter(predicate : 'Key -> 'Value -> bool) = + let predicate = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate + Map(comparer, root.Filter(predicate)) + + member x.Choose(mapping : 'Key -> 'Value -> option<'T>) = + let mapping = OptimizedClosures.FSharpFunc<_,_,_>.Adapt mapping + Map(comparer, root.Choose(mapping)) + + member x.ChooseV(mapping : 'Key -> 'Value -> voption<'T>) = + let mapping = OptimizedClosures.FSharpFunc<_,_,_>.Adapt mapping + Map(comparer, root.ChooseV(mapping)) + + member x.Exists(predicate : 'Key -> 'Value -> bool) = + let predicate = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate + let rec exists (predicate : OptimizedClosures.FSharpFunc<_,_,_>) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + exists predicate n.Left || + predicate.Invoke(n.Key, n.Value) || + exists predicate n.Right + | :? MapLeaf<'Key, 'Value> as n -> + predicate.Invoke(n.Key, n.Value) + | _ -> + false + exists predicate root + + member x.Forall(predicate : 'Key -> 'Value -> bool) = + let rec forall (predicate : OptimizedClosures.FSharpFunc<_,_,_>) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + forall predicate n.Left && + predicate.Invoke(n.Key, n.Value) && + forall predicate n.Right + | :? MapLeaf<'Key, 'Value> as n -> + predicate.Invoke(n.Key, n.Value) + | _ -> + true + let predicate = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate + forall predicate root + + member x.Fold(folder : 'State -> 'Key -> 'Value -> 'State, seed : 'State) = + let folder = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt folder + + let rec fold (folder : OptimizedClosures.FSharpFunc<_,_,_,_>) seed (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let s1 = fold folder seed n.Left + let s2 = folder.Invoke(s1, n.Key, n.Value) + fold folder s2 n.Right + | :? MapLeaf<'Key, 'Value> as n -> + folder.Invoke(seed, n.Key, n.Value) + | _ -> + seed - member __.Clear() = raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) + fold folder seed root + + member x.FoldBack(folder : 'Key -> 'Value -> 'State -> 'State, seed : 'State) = + let folder = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt folder + + let rec foldBack (folder : OptimizedClosures.FSharpFunc<_,_,_,_>) seed (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let s1 = foldBack folder seed n.Right + let s2 = folder.Invoke(n.Key, n.Value, s1) + foldBack folder s2 n.Left + | :? MapLeaf<'Key, 'Value> as n -> + folder.Invoke(n.Key, n.Value, seed) + | _ -> + seed - member __.Remove x = ignore x; raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) + foldBack folder seed root + + member x.TryFind(key : 'Key) = + let rec tryFind (cmp : IComparer<_>) key (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c > 0 then tryFind cmp key n.Right + elif c < 0 then tryFind cmp key n.Left + else Some n.Value + | :? MapLeaf<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c = 0 then Some n.Value + else None + | _ -> + None + tryFind comparer key root + + member x.Find(key : 'Key) : 'Value = + let rec run (cmp : IComparer<_>) key (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c > 0 then run cmp key n.Right + elif c < 0 then run cmp key n.Left + else n.Value + | :? MapLeaf<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c = 0 then n.Value + else raise <| KeyNotFoundException() + | _ -> + raise <| KeyNotFoundException() + run comparer key root + - member m.Contains x = m.ContainsKey x.Key && Unchecked.equals m.[x.Key] x.Value + member x.Item + with get(key : 'Key) : 'Value = x.Find key + + member x.TryFindV(key : 'Key) = + let rec tryFind (cmp : IComparer<_>) key (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c > 0 then tryFind cmp key n.Right + elif c < 0 then tryFind cmp key n.Left + else ValueSome n.Value + | :? MapLeaf<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c = 0 then ValueSome n.Value + else ValueNone + | _ -> + ValueNone + tryFind comparer key root + + member x.TryFindKey(predicate : 'Key -> 'Value -> bool) = + let rec run (predicate : OptimizedClosures.FSharpFunc<'Key, 'Value, bool>) (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + if predicate.Invoke(l.Key, l.Value) then Some l.Key + else None + | :? MapInner<'Key, 'Value> as n -> + match run predicate n.Left with + | None -> + if predicate.Invoke(n.Key, n.Value) then Some n.Key + else run predicate n.Right + | res -> + res + | _ -> + None + run (OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate) root + + member x.TryFindKeyV(predicate : 'Key -> 'Value -> bool) = + let rec run (predicate : OptimizedClosures.FSharpFunc<'Key, 'Value, bool>) (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + if predicate.Invoke(l.Key, l.Value) then ValueSome l.Key + else ValueNone + | :? MapInner<'Key, 'Value> as n -> + match run predicate n.Left with + | ValueNone -> + if predicate.Invoke(n.Key, n.Value) then ValueSome n.Key + else run predicate n.Right + | res -> + res + | _ -> + ValueNone + run (OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate) root + + member x.FindKey(predicate : 'Key -> 'Value -> bool) = + match x.TryFindKeyV predicate with + | ValueSome k -> k + | ValueNone -> raise <| KeyNotFoundException() + + member x.TryPick(mapping : 'Key -> 'Value -> option<'T>) = + let rec run (mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, option<'T>>) (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + mapping.Invoke(l.Key, l.Value) + + | :? MapInner<'Key, 'Value> as n -> + match run mapping n.Left with + | None -> + match mapping.Invoke(n.Key, n.Value) with + | Some _ as res -> res + | None -> run mapping n.Right + | res -> + res + | _ -> + None + run (OptimizedClosures.FSharpFunc<_,_,_>.Adapt mapping) root + + //member x.Keys() = + // let rec run (n : MapNode<'Key, 'Value>) = + // match n with + // | :? MapInner<'Key, 'Value> as n -> + // SetNewImplementation.SetInner( + // run n.Left, + // n.Key, + // run n.Right + // ) :> SetNewImplementation.SetNode<_> + // | :? MapLeaf<'Key, 'Value> as n -> + // SetNewImplementation.SetLeaf(n.Key) :> SetNewImplementation.SetNode<_> + // | _ -> + // SetNewImplementation.SetEmpty.Instance + // SetNew(comparer, run root) + + member x.TryPickV(mapping : 'Key -> 'Value -> voption<'T>) = + let rec run (mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>>) (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + mapping.Invoke(l.Key, l.Value) + + | :? MapInner<'Key, 'Value> as n -> + match run mapping n.Left with + | ValueNone -> + match mapping.Invoke(n.Key, n.Value) with + | ValueSome _ as res -> res + | ValueNone -> run mapping n.Right + | res -> + res + | _ -> + ValueNone + run (OptimizedClosures.FSharpFunc<_,_,_>.Adapt mapping) root + + member x.Pick(mapping : 'Key -> 'Value -> option<'T>) = + match x.TryPick mapping with + | Some k -> k + | None -> raise <| KeyNotFoundException() + + member x.PickV(mapping : 'Key -> 'Value -> voption<'T>) = + match x.TryPickV mapping with + | ValueSome k -> k + | ValueNone -> raise <| KeyNotFoundException() + + member x.Partition(predicate : 'Key -> 'Value -> bool) = + let predicate = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate + + let cnt = x.Count + let a0 = Array.zeroCreate cnt + let a1 = Array.zeroCreate cnt + x.CopyToV(a0, 0) + + let mutable i1 = 0 + let mutable i0 = 0 + for i in 0 .. cnt - 1 do + let struct(k,v) = a0.[i] + if predicate.Invoke(k, v) then + a0.[i0] <- struct(k,v) + i0 <- i0 + 1 + else + a1.[i1] <- struct(k,v) + i1 <- i1 + 1 + + Map.CreateTree(comparer, a0, i0), Map.CreateTree(comparer, a1, i1) + + member x.ContainsKey(key : 'Key) = + let rec contains (cmp : IComparer<_>) key (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c > 0 then contains cmp key n.Right + elif c < 0 then contains cmp key n.Left + else true + | :? MapLeaf<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c = 0 then true + else false - member __.CopyTo(arr, i) = MapTree.copyToArray tree arr i + | _ -> + false + contains comparer key root + + member x.GetEnumerator() = new MapEnumerator<_,_>(root) + + member x.ToList() = + let rec toList acc (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + toList ((n.Key, n.Value) :: toList acc n.Right) n.Left + | :? MapLeaf<'Key, 'Value> as n -> + (n.Key, n.Value) :: acc + | _ -> + acc + toList [] root + + member x.ToListV() = + let rec toList acc (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + toList (struct(n.Key, n.Value) :: toList acc n.Right) n.Left + | :? MapLeaf<'Key, 'Value> as n -> + struct(n.Key, n.Value) :: acc + | _ -> + acc + toList [] root + + member x.ToArray() = + let arr = Array.zeroCreate x.Count + let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let index = copyTo arr index n.Left + arr.[index] <- (n.Key, n.Value) + copyTo arr (index + 1) n.Right + | :? MapLeaf<'Key, 'Value> as n -> + arr.[index] <- (n.Key, n.Value) + index + 1 + | _ -> + index + + copyTo arr 0 root |> ignore + arr + + member x.ToArrayV() = + let arr = Array.zeroCreate x.Count + let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let index = copyTo arr index n.Left + arr.[index] <- struct(n.Key, n.Value) + copyTo arr (index + 1) n.Right + | :? MapLeaf<'Key, 'Value> as n -> + arr.[index] <- struct(n.Key, n.Value) + index + 1 + | _ -> + index + + copyTo arr 0 root |> ignore + arr + + member x.CopyTo(array : ('Key * 'Value)[], startIndex : int) = + if startIndex < 0 || startIndex + x.Count > array.Length then raise <| System.IndexOutOfRangeException("Map.CopyTo") + let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let index = copyTo arr index n.Left + arr.[index] <- (n.Key, n.Value) + copyTo arr (index + 1) n.Right + | :? MapLeaf<'Key, 'Value> as n -> + arr.[index] <- (n.Key, n.Value) + index + 1 + | _ -> + index + copyTo array startIndex root |> ignore + + member x.CopyToV(array : struct('Key * 'Value)[], startIndex : int) = + if startIndex < 0 || startIndex + x.Count > array.Length then raise <| System.IndexOutOfRangeException("Map.CopyTo") + let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let index = copyTo arr index n.Left + arr.[index] <- struct(n.Key, n.Value) + copyTo arr (index + 1) n.Right + | :? MapLeaf<'Key, 'Value> as n -> + arr.[index] <- struct(n.Key, n.Value) + index + 1 + | _ -> + index + copyTo array startIndex root |> ignore + + member x.GetViewBetween(minInclusive : 'Key, maxInclusive : 'Key) = + Map(comparer, root.GetViewBetween(comparer, minInclusive, true, maxInclusive, true)) + + member x.GetSlice(min : option<'Key>, max : option<'Key>) = + match min with + | Some min -> + match max with + | Some max -> + x.GetViewBetween(min, max) + | None -> + x.WithMin min + | None -> + match max with + | Some max -> + x.WithMax max + | None -> + x + + member x.WithMin(minInclusive : 'Key) = + Map(comparer, root.WithMin(comparer, minInclusive, true)) + + member x.WithMax(maxInclusive : 'Key) = + Map(comparer, root.WithMax(comparer, maxInclusive, true)) + + member x.TryMinKeyValue() = + let rec run (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + Some (l.Key, l.Value) + | :? MapInner<'Key, 'Value> as n -> + if n.Left.Count = 0 then Some (n.Key, n.Value) + else run n.Left + | _ -> + None + + run root + + member x.TryMinKeyValueV() = + let rec run (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + ValueSome struct(l.Key, l.Value) + | :? MapInner<'Key, 'Value> as n -> + if n.Left.Count = 0 then ValueSome struct(n.Key, n.Value) + else run n.Left + | _ -> + ValueNone + run root + + member x.TryMaxKeyValue() = + let rec run (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + Some (l.Key, l.Value) + | :? MapInner<'Key, 'Value> as n -> + if n.Right.Count = 0 then Some (n.Key, n.Value) + else run n.Right + | _ -> + None + + run root + + member x.TryMaxKeyValueV() = + let rec run (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + ValueSome struct(l.Key, l.Value) + | :? MapInner<'Key, 'Value> as n -> + if n.Right.Count = 0 then ValueSome struct(n.Key, n.Value) + else run n.Right + | _ -> + ValueNone + run root - member __.IsReadOnly = true + member x.Change(key : 'Key, f : option<'Value> -> option<'Value>) = + Map(comparer, root.Change(comparer, key, f)) + + member x.ChangeV(key : 'Key, update : voption<'Value> -> voption<'Value>) = + Map(comparer, root.ChangeV(comparer, key, update)) + + member x.TryAt(index : int) = + if index < 0 || index >= root.Count then None + else + let rec search (index : int) (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + if index = 0 then Some(l.Key, l.Value) + else None + | :? MapInner<'Key, 'Value> as n -> + let lc = index - n.Left.Count + if lc < 0 then search index n.Left + elif lc > 0 then search (lc - 1) n.Right + else Some (n.Key, n.Value) + | _ -> + None + search index root + + member x.TryAtV(index : int) = + if index < 0 || index >= root.Count then ValueNone + else + let rec search (index : int) (node : MapNode<'Key, 'Value>) = + match node with + | :? MapLeaf<'Key, 'Value> as l -> + if index = 0 then ValueSome(struct(l.Key, l.Value)) + else ValueNone + | :? MapInner<'Key, 'Value> as n -> + let lc = index - n.Left.Count + if lc < 0 then search index n.Left + elif lc > 0 then search (lc - 1) n.Right + else ValueSome (struct(n.Key, n.Value)) + | _ -> + ValueNone + search index root + + member x.CompareTo(other : Map<'Key, 'Value>) = + let mutable le = x.GetEnumerator() + let mutable re = other.GetEnumerator() + + let mutable result = 0 + let mutable run = true + while run do + if le.MoveNext() then + if re.MoveNext() then + let c = comparer.Compare(le.Current.Key, re.Current.Key) + if c <> 0 then + result <- c + run <- false + else + let c = Unchecked.compare le.Current.Value re.Current.Value + if c <> 0 then + result <- c + run <- false + else + result <- 1 + run <- false + elif re.MoveNext() then + result <- -1 + run <- false + else + run <- false + result - member m.Count = m.Count + override x.GetHashCode() = + hash root - interface System.IComparable with - member m.CompareTo(obj: obj) = - match obj with - | :? Map<'Key, 'Value> as m2-> - Seq.compareWith - (fun (kvp1 : KeyValuePair<_, _>) (kvp2 : KeyValuePair<_, _>)-> - let c = comparer.Compare(kvp1.Key, kvp2.Key) in - if c <> 0 then c else Unchecked.compare kvp1.Value kvp2.Value) - m m2 - | _ -> - invalidArg "obj" (SR.GetString(SR.notComparable)) + override x.Equals o = + match o with + | :? Map<'Key, 'Value> as o -> equals comparer root o.Root + | _ -> false - interface IReadOnlyCollection> with - member m.Count = m.Count + member x.TryGetValue(key : 'Key, [] value : byref<'Value>) = + match x.TryFindV key with + | ValueSome v -> + value <- v + true + | ValueNone -> + false - interface IReadOnlyDictionary<'Key, 'Value> with + interface System.IComparable with + member x.CompareTo o = x.CompareTo (o :?> Map<_,_>) + + //interface System.IComparable> with + // member x.CompareTo o = x.CompareTo o - member m.Item with get key = m.[key] + interface System.Collections.IEnumerable with + member x.GetEnumerator() = new MapEnumerator<_,_>(root) :> _ - member m.Keys = seq { for kvp in m -> kvp.Key } + interface System.Collections.Generic.IEnumerable> with + member x.GetEnumerator() = new MapEnumerator<_,_>(root) :> _ + + interface System.Collections.Generic.ICollection> with + member x.Count = x.Count + member x.IsReadOnly = true + member x.Clear() = failwith "readonly" + member x.Add(_) = failwith "readonly" + member x.Remove(_) = failwith "readonly" + member x.Contains(kvp : KeyValuePair<'Key, 'Value>) = + match x.TryFindV kvp.Key with + | ValueSome v -> Unchecked.equals v kvp.Value + | ValueNone -> false + member x.CopyTo(array : KeyValuePair<'Key, 'Value>[], startIndex : int) = + if startIndex < 0 || startIndex + x.Count > array.Length then raise <| System.IndexOutOfRangeException("Map.CopyTo") + let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let index = copyTo arr index n.Left + arr.[index] <- KeyValuePair(n.Key, n.Value) + copyTo arr (index + 1) n.Right + | :? MapLeaf<'Key, 'Value> as n -> + arr.[index] <- KeyValuePair(n.Key, n.Value) + index + 1 + | _ -> + index + copyTo array startIndex root |> ignore + + interface System.Collections.Generic.IReadOnlyCollection> with + member x.Count = x.Count - member m.TryGetValue(key, value: byref<'Value>) = m.TryGetValue(key, &value) + interface System.Collections.Generic.IReadOnlyDictionary<'Key, 'Value> with + member x.Item + with get(k : 'Key) = x.[k] - member m.Values = seq { for kvp in m -> kvp.Value } + member x.ContainsKey k = x.ContainsKey k + member x.Keys = x |> Seq.map (fun (KeyValue(k,_v)) -> k) + member x.Values = x |> Seq.map (fun (KeyValue(_k,v)) -> v) + member x.TryGetValue(key : 'Key, [] value : byref<'Value>) = x.TryGetValue(key, &value) - member m.ContainsKey key = m.ContainsKey key + interface System.Collections.Generic.IDictionary<'Key, 'Value> with + member x.TryGetValue(key : 'Key, [] value : byref<'Value>) = x.TryGetValue(key, &value) - override x.ToString() = - match List.ofSeq (Seq.truncate 4 x) with - | [] -> "map []" - | [KeyValue h1] -> - let txt1 = LanguagePrimitives.anyToStringShowingNull h1 - StringBuilder().Append("map [").Append(txt1).Append("]").ToString() - | [KeyValue h1; KeyValue h2] -> - let txt1 = LanguagePrimitives.anyToStringShowingNull h1 - let txt2 = LanguagePrimitives.anyToStringShowingNull h2 - StringBuilder().Append("map [").Append(txt1).Append("; ").Append(txt2).Append("]").ToString() - | [KeyValue h1; KeyValue h2; KeyValue h3] -> - let txt1 = LanguagePrimitives.anyToStringShowingNull h1 - let txt2 = LanguagePrimitives.anyToStringShowingNull h2 - let txt3 = LanguagePrimitives.anyToStringShowingNull h3 - StringBuilder().Append("map [").Append(txt1).Append("; ").Append(txt2).Append("; ").Append(txt3).Append("]").ToString() - | KeyValue h1 :: KeyValue h2 :: KeyValue h3 :: _ -> - let txt1 = LanguagePrimitives.anyToStringShowingNull h1 - let txt2 = LanguagePrimitives.anyToStringShowingNull h2 - let txt3 = LanguagePrimitives.anyToStringShowingNull h3 - StringBuilder().Append("map [").Append(txt1).Append("; ").Append(txt2).Append("; ").Append(txt3).Append("; ... ]").ToString() + member x.Add(_,_) = + failwith "readonly" -and - [] - MapDebugView<'Key, 'Value when 'Key : comparison>(v: Map<'Key, 'Value>) = + member x.Remove(_) = + failwith "readonly" - [] - member x.Items = - v |> Seq.truncate 10000 |> Seq.map KeyValuePairDebugFriendly |> Seq.toArray + member x.Keys = + failwith "implement me" + + member x.Values = + failwith "implement me" + + member x.ContainsKey key = + x.ContainsKey key + + member x.Item + with get (key : 'Key) = x.TryFindV key |> ValueOption.get + and set _ _ = failwith "readonly" + + new(comparer : IComparer<'Key>) = + Map<'Key, 'Value>(comparer, MapEmpty.Instance) + + new(elements : seq<'Key * 'Value>) = + let m = Map.FromSeq elements + Map<'Key, 'Value>(m.Comparer, m.Root) + +and [] + MapEnumerator<'Key, 'Value> = + struct + val mutable public Root : MapNode<'Key, 'Value> + val mutable public Stack : list * bool)> + val mutable public Value : KeyValuePair<'Key, 'Value> + + member x.Current : KeyValuePair<'Key, 'Value> = x.Value + + member x.Reset() = + if x.Root.Height > 0 then + x.Stack <- [struct(x.Root, true)] + x.Value <- Unchecked.defaultof<_> + + member x.Dispose() = + x.Root <- MapEmpty.Instance + x.Stack <- [] + x.Value <- Unchecked.defaultof<_> + + member inline private x.MoveNext(deep : bool, top : MapNode<'Key, 'Value>) = + let mutable top = top + let mutable run = true + + while run do + match top with + | :? MapLeaf<'Key, 'Value> as n -> + x.Value <- KeyValuePair(n.Key, n.Value) + run <- false + + | :? MapInner<'Key, 'Value> as n -> + if deep then + if n.Left.Height = 0 then + if n.Right.Height > 0 then x.Stack <- struct(n.Right, true) :: x.Stack + x.Value <- KeyValuePair(n.Key, n.Value) + run <- false + else + if n.Right.Height > 0 then x.Stack <- struct(n.Right, true) :: x.Stack + x.Stack <- struct(n :> MapNode<_,_>, false) :: x.Stack + top <- n.Left + else + x.Value <- KeyValuePair(n.Key, n.Value) + run <- false -and + | _ -> + failwith "empty node" + + + member x.MoveNext() : bool = + match x.Stack with + | struct(n, deep) :: rest -> + x.Stack <- rest + x.MoveNext(deep, n) + true + | [] -> + false + + + interface System.Collections.IEnumerator with + member x.MoveNext() = x.MoveNext() + member x.Reset() = x.Reset() + member x.Current = x.Current :> obj + + interface System.Collections.Generic.IEnumerator> with + member x.Dispose() = x.Dispose() + member x.Current = x.Current + + + + new(r : MapNode<'Key, 'Value>) = + if r.Height = 0 then + { + Root = r + Stack = [] + Value = Unchecked.defaultof<_> + } + else + { + Root = r + Stack = [struct(r, true)] + Value = Unchecked.defaultof<_> + } + + end + +and internal MapDebugView<'Key, 'Value when 'Key : comparison> = + + [] + val mutable public Entries : KeyValuePairDebugFriendly<'Key, 'Value>[] + + new(m : Map<'Key, 'Value>) = + { + Entries = Seq.toArray (Seq.map KeyValuePairDebugFriendly (Seq.truncate 10000 m)) + } + +and [] - KeyValuePairDebugFriendly<'Key, 'Value>(keyValue : KeyValuePair<'Key, 'Value>) = + internal KeyValuePairDebugFriendly<'Key, 'Value>(keyValue : KeyValuePair<'Key, 'Value>) = [] member x.KeyValue = keyValue -[] -[] -module Map = +[] +module Map = + [] + let empty<'Key, 'Value when 'Key : comparison> = Map<'Key, 'Value>.Empty + [] - let isEmpty (table: Map<_, _>) = - table.IsEmpty - + let isEmpty (table : Map<'Key, 'Value>) = table.Count <= 0 + + [] + let count (table : Map<'Key, 'Value>) = table.Count + [] - let add key value (table: Map<_, _>) = - table.Add (key, value) + let add (key : 'Key) (value : 'Value) (table : Map<'Key, 'Value>) = table.Add(key, value) + + [] + let remove (key : 'Key) (table : Map<'Key, 'Value>) = table.Remove(key) [] - let change key f (table: Map<_, _>) = - table.Change (key, f) - - [] - let find key (table: Map<_, _>) = - table.[key] + let change (key : 'Key) (f : option<'Value> -> option<'Value>) (table : Map<'Key, 'Value>) = table.Change(key, f) + + [] + let changeV (key : 'Key) (update : voption<'Value> -> voption<'Value>) (map : Map<'Key, 'Value>) = map.ChangeV(key, update) [] - let tryFind key (table: Map<_, _>) = - table.TryFind key - - [] - let remove key (table: Map<_, _>) = - table.Remove key - + let tryFind (key : 'Key) (table : Map<'Key, 'Value>) = table.TryFind(key) + + [] + let tryFindV (key : 'Key) (map : Map<'Key, 'Value>) = map.TryFindV(key) + [] - let containsKey key (table: Map<_, _>) = - table.ContainsKey key - + let containsKey (key : 'Key) (table : Map<'Key, 'Value>) = table.ContainsKey(key) + [] - let iter action (table: Map<_, _>) = - table.Iterate action - - [] - let tryPick chooser (table: Map<_, _>) = - table.TryPick chooser - - [] - let pick chooser (table: Map<_, _>) = - match tryPick chooser table with - | None -> raise (KeyNotFoundException()) - | Some res -> res - - [] - let exists predicate (table: Map<_, _>) = - table.Exists predicate + let iter (action : 'Key -> 'Value -> unit) (table : Map<'Key, 'Value>) = table.Iter(action) + + [] + let map (mapping : 'Key -> 'Value -> 'T) (table : Map<'Key, 'Value>) = table.Map(mapping) + + [] + let choose (mapping : 'Key -> 'Value -> option<'T>) (map : Map<'Key, 'Value>) = map.Choose(mapping) + + [] + let chooseV (mapping : 'Key -> 'Value -> voption<'T>) (map : Map<'Key, 'Value>) = map.ChooseV(mapping) [] - let filter predicate (table: Map<_, _>) = - table.Filter predicate - - [] - let partition predicate (table: Map<_, _>) = - table.Partition predicate + let filter (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = table.Filter(predicate) + [] + let exists (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = table.Exists(predicate) + [] - let forall predicate (table: Map<_, _>) = - table.ForAll predicate - - [] - let map mapping (table: Map<_, _>) = - table.Map mapping + let forall (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = table.Forall(predicate) [] - let fold<'Key, 'T, 'State when 'Key : comparison> folder (state:'State) (table: Map<'Key, 'T>) = - MapTree.fold folder state table.Tree - + let fold<'Key,'Value,'State when 'Key : comparison> (folder : 'State -> 'Key -> 'Value -> 'State) (state : 'State) (table : Map<'Key, 'Value>) = + table.Fold(folder, state) + [] - let foldBack<'Key, 'T, 'State when 'Key : comparison> folder (table: Map<'Key, 'T>) (state:'State) = - MapTree.foldBack folder table.Tree state + let foldBack (folder : 'Key -> 'Value -> 'State -> 'State) (table : Map<'Key, 'Value>) (state : 'State) = + table.FoldBack(folder, state) + + [] + let ofSeq (elements : seq<'Key * 'Value>) = Map.FromSeq elements + + [] + let ofList (elements : list<'Key * 'Value>) = Map.FromList elements + + [] + let ofArray (elements : ('Key * 'Value)[]) = Map.FromArray elements + + [] + let ofSeqV (values : seq) = Map.FromSeqV values + + [] + let ofListV (values : list) = Map.FromListV values + + [] + let ofArrayV (values : struct('Key * 'Value)[]) = Map.FromArrayV values [] - let toSeq (table: Map<_, _>) = - table |> Seq.map (fun kvp -> kvp.Key, kvp.Value) + let toSeq (table : Map<'Key, 'Value>) = table |> Seq.map (fun (KeyValue(k,v)) -> k, v) - [] - let findKey predicate (table : Map<_, _>) = - table |> Seq.pick (fun kvp -> let k = kvp.Key in if predicate k kvp.Value then Some k else None) + [] + let toSeqV (map : Map<'Key, 'Value>) = map |> Seq.map (fun (KeyValue(k,v)) -> struct (k, v)) - [] - let tryFindKey predicate (table : Map<_, _>) = - table |> Seq.tryPick (fun kvp -> let k = kvp.Key in if predicate k kvp.Value then Some k else None) + [] + let toList (table : Map<'Key, 'Value>) = table.ToList() + + [] + let toListV (map : Map<'Key, 'Value>) = map.ToListV() + + [] + let toArray (table : Map<'Key, 'Value>) = table.ToArray() + + [] + let toArrayV (map : Map<'Key, 'Value>) = map.ToArrayV() - [] - let ofList (elements: ('Key * 'Value) list) = - Map<_, _>.ofList elements + //[] + //let keys (map : Map<'Key, 'Value>) = map.Keys() - [] - let ofSeq elements = - Map<_, _>.Create elements + [] + let withMin (minInclusive : 'Key) (map : Map<'Key, 'Value>) = map.WithMin(minInclusive) + + [] + let withMax (maxInclusive : 'Key) (map : Map<'Key, 'Value>) = map.WithMax(maxInclusive) + + [] + let withRange (minInclusive : 'Key) (maxInclusive : 'Key) (map : Map<'Key, 'Value>) = map.GetViewBetween(minInclusive, maxInclusive) + + [] + let union (map1 : Map<'Key, 'Value>) (map2 : Map<'Key, 'Value>) = Map.Union(map1, map2) + + [] + let unionMany (maps : #seq>) = + use e = (maps :> seq<_>).GetEnumerator() + if e.MoveNext() then + let mutable m = e.Current + while e.MoveNext() do + m <- union m e.Current + m + else + empty + + [] + let unionWith (resolve : 'Key -> 'Value -> 'Value -> 'Value) (map1 : Map<'Key, 'Value>) (map2 : Map<'Key, 'Value>) = Map.UnionWith(map1, map2, resolve) + + [] + let tryMax (map : Map<'Key, 'Value>) = map.TryMaxKeyValue() - [] - let ofArray (elements: ('Key * 'Value) array) = - let comparer = LanguagePrimitives.FastGenericComparer<'Key> - new Map<_, _>(comparer, MapTree.ofArray comparer elements) + [] + let tryMin (map : Map<'Key, 'Value>) = map.TryMinKeyValue() - [] - let toList (table: Map<_, _>) = - table.ToList() + [] + let tryMaxV (map : Map<'Key, 'Value>) = map.TryMaxKeyValueV() - [] - let toArray (table: Map<_, _>) = - table.ToArray() + [] + let tryMinV (map : Map<'Key, 'Value>) = map.TryMinKeyValueV() + + [] + let tryAt (index : int) (map : Map<'Key, 'Value>) = map.TryAt index + + [] + let tryAtV (index : int) (map : Map<'Key, 'Value>) = + map.TryAtV index + + [] + let find (key : 'Key) (table : Map<'Key, 'Value>) = + table.Find key + + [] + let findKey (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = + table.FindKey(predicate) + + [] + let tryFindKey (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = + table.TryFindKey(predicate) + + [] + let tryFindKeyV (predicate : 'Key -> 'Value -> bool) (map : Map<'Key, 'Value>) = + map.TryFindKeyV(predicate) - [] - let empty<'Key, 'Value when 'Key : comparison> = - Map<'Key, 'Value>.Empty + [] + let tryPick (chooser : 'Key -> 'Value -> option<'T>) (table : Map<'Key, 'Value>) = + table.TryPick(chooser) + + [] + let tryPickV (mapping : 'Key -> 'Value -> voption<'T>) (map : Map<'Key, 'Value>) = + map.TryPickV(mapping) + + [] + let pick (chooser : 'Key -> 'Value -> option<'T>) (table : Map<'Key, 'Value>) = + table.Pick(chooser) + + [] + let pickV (mapping : 'Key -> 'Value -> voption<'T>) (map : Map<'Key, 'Value>) = + map.PickV(mapping) + + [] + let partition (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = + table.Partition(predicate) - [] - let count (table: Map<_, _>) = - table.Count From 1ea6e2cf50656cadd45afd103d2e76ef78381666 Mon Sep 17 00:00:00 2001 From: Georg Haaser Date: Mon, 21 Dec 2020 13:59:38 +0100 Subject: [PATCH 2/5] raising expected exceptions (no messages atm.) --- src/fsharp/FSharp.Core/map.fs | 85 +++++++++++++++++++++++++++++------ 1 file changed, 71 insertions(+), 14 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 1eebd40b6d3..d17c8b77ca5 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -2304,6 +2304,28 @@ type Map< [] 'Key, [ as o -> equals comparer root o.Root | _ -> false + override x.ToString() = + match List.ofSeq (Seq.truncate 4 x) with + | [] -> "map []" + | [KeyValue h1] -> + let txt1 = LanguagePrimitives.anyToStringShowingNull h1 + StringBuilder().Append("map [").Append(txt1).Append("]").ToString() + | [KeyValue h1; KeyValue h2] -> + let txt1 = LanguagePrimitives.anyToStringShowingNull h1 + let txt2 = LanguagePrimitives.anyToStringShowingNull h2 + StringBuilder().Append("map [").Append(txt1).Append("; ").Append(txt2).Append("]").ToString() + | [KeyValue h1; KeyValue h2; KeyValue h3] -> + let txt1 = LanguagePrimitives.anyToStringShowingNull h1 + let txt2 = LanguagePrimitives.anyToStringShowingNull h2 + let txt3 = LanguagePrimitives.anyToStringShowingNull h3 + StringBuilder().Append("map [").Append(txt1).Append("; ").Append(txt2).Append("; ").Append(txt3).Append("]").ToString() + | KeyValue h1 :: KeyValue h2 :: KeyValue h3 :: _ -> + let txt1 = LanguagePrimitives.anyToStringShowingNull h1 + let txt2 = LanguagePrimitives.anyToStringShowingNull h2 + let txt3 = LanguagePrimitives.anyToStringShowingNull h3 + StringBuilder().Append("map [").Append(txt1).Append("; ").Append(txt2).Append("; ").Append(txt3).Append("; ... ]").ToString() + + member x.TryGetValue(key : 'Key, [] value : byref<'Value>) = match x.TryFindV key with | ValueSome v -> @@ -2313,8 +2335,11 @@ type Map< [] 'Key, [ Map<_,_>) - + member x.CompareTo o = + match o with + | :? Map<'Key, 'Value> as o -> x.CompareTo o + | _ -> raise <| ArgumentException() + //interface System.IComparable> with // member x.CompareTo o = x.CompareTo o @@ -2327,9 +2352,9 @@ type Map< [] 'Key, [> with member x.Count = x.Count member x.IsReadOnly = true - member x.Clear() = failwith "readonly" - member x.Add(_) = failwith "readonly" - member x.Remove(_) = failwith "readonly" + member x.Clear() = raise <| NotSupportedException() + member x.Add(_) = raise <| NotSupportedException() + member x.Remove(_) = raise <| NotSupportedException() member x.Contains(kvp : KeyValuePair<'Key, 'Value>) = match x.TryFindV kvp.Key with | ValueSome v -> Unchecked.equals v kvp.Value @@ -2364,17 +2389,40 @@ type Map< [] 'Key, [ with member x.TryGetValue(key : 'Key, [] value : byref<'Value>) = x.TryGetValue(key, &value) - member x.Add(_,_) = - failwith "readonly" - - member x.Remove(_) = - failwith "readonly" + member x.Add(_,_) = raise <| NotSupportedException() + member x.Remove(_) = raise <| NotSupportedException() member x.Keys = - failwith "implement me" + let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let i = copyTo arr index n.Left + arr.[i] <- n.Key + copyTo arr (i+1) n.Right + | :? MapLeaf<'Key, 'Value> as n -> + arr.[index] <- n.Key + index + 1 + | _ -> + index + let arr = Array.zeroCreate x.Count + copyTo arr 0 root |> ignore + arr :> _ member x.Values = - failwith "implement me" + let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let i = copyTo arr index n.Left + arr.[i] <- n.Value + copyTo arr (i+1) n.Right + | :? MapLeaf<'Key, 'Value> as n -> + arr.[index] <- n.Value + index + 1 + | _ -> + index + let arr = Array.zeroCreate x.Count + copyTo arr 0 root |> ignore + arr :> _ member x.ContainsKey key = x.ContainsKey key @@ -2396,18 +2444,23 @@ and [] val mutable public Root : MapNode<'Key, 'Value> val mutable public Stack : list * bool)> val mutable public Value : KeyValuePair<'Key, 'Value> + val mutable public Valid : bool - member x.Current : KeyValuePair<'Key, 'Value> = x.Value + member x.Current : KeyValuePair<'Key, 'Value> = + if x.Valid then x.Value + else raise <| InvalidOperationException() member x.Reset() = if x.Root.Height > 0 then x.Stack <- [struct(x.Root, true)] x.Value <- Unchecked.defaultof<_> + x.Valid <- false member x.Dispose() = x.Root <- MapEmpty.Instance x.Stack <- [] x.Value <- Unchecked.defaultof<_> + x.Valid <- false member inline private x.MoveNext(deep : bool, top : MapNode<'Key, 'Value>) = let mutable top = top @@ -2442,8 +2495,10 @@ and [] | struct(n, deep) :: rest -> x.Stack <- rest x.MoveNext(deep, n) + x.Valid <- true true | [] -> + x.Valid <- false false @@ -2460,13 +2515,15 @@ and [] new(r : MapNode<'Key, 'Value>) = if r.Height = 0 then - { + { + Valid = false Root = r Stack = [] Value = Unchecked.defaultof<_> } else { + Valid = false Root = r Stack = [struct(r, true)] Value = Unchecked.defaultof<_> From 898686bf9ef77cdd506806445d38f989e4e416ef Mon Sep 17 00:00:00 2001 From: Georg Haaser Date: Mon, 21 Dec 2020 14:13:44 +0100 Subject: [PATCH 3/5] all tests running --- 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 d17c8b77ca5..aa6cee1c6f6 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -2428,8 +2428,8 @@ type Map< [] 'Key, [ ValueOption.get - and set _ _ = failwith "readonly" + with get (key : 'Key) = x.Find key + and set _ _ = raise <| NotSupportedException() new(comparer : IComparer<'Key>) = Map<'Key, 'Value>(comparer, MapEmpty.Instance) From 3eb3d9928b5f51c4b2b88e591ba67d2dbdc60823 Mon Sep 17 00:00:00 2001 From: Georg Haaser Date: Tue, 22 Dec 2020 10:15:29 +0100 Subject: [PATCH 4/5] * minified Map implementation * removed System.ValueTuple reference --- src/fsharp/FSharp.Core/FSharp.Core.fsproj | 1 - src/fsharp/FSharp.Core/map.fs | 1705 +++++---------------- 2 files changed, 343 insertions(+), 1363 deletions(-) diff --git a/src/fsharp/FSharp.Core/FSharp.Core.fsproj b/src/fsharp/FSharp.Core/FSharp.Core.fsproj index 74b348768b1..f7267fe0d84 100644 --- a/src/fsharp/FSharp.Core/FSharp.Core.fsproj +++ b/src/fsharp/FSharp.Core/FSharp.Core.fsproj @@ -222,7 +222,6 @@ - diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index aa6cee1c6f6..f4172908947 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -2,6 +2,7 @@ namespace Microsoft.FSharp.Collections + open System open System.Collections open System.Collections.Generic @@ -12,302 +13,271 @@ open Microsoft.FSharp.Core.LanguagePrimitives open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Collections +open System.Runtime.InteropServices -module Sorting = - - - let inline private mergeSeq (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : ('Key * 'Value)[]) (dst : ('Key * 'Value)[]) (length : int) = - let le = ri - let re = min length (ri + len) - let mutable oi = li - let mutable li = li - let mutable ri = ri +module MapImplementation = + module Sorting = + + let inline private mergeSeq (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : ('Key * 'Value)[]) (dst : ('Key * 'Value)[]) (length : int) = + let le = ri + let re = min length (ri + len) + let mutable oi = li + let mutable li = li + let mutable ri = ri + + while li < le && ri < re do + let lv = src.[li] + let rv = src.[ri] + let c = cmp.Compare(fst lv, fst rv) + if c <= 0 then + dst.[oi] <- lv + oi <- oi + 1 + li <- li + 1 + else + dst.[oi] <- rv + oi <- oi + 1 + ri <- ri + 1 - while li < le && ri < re do - let lv = src.[li] - let rv = src.[ri] - let c = cmp.Compare(fst lv, fst rv) - if c <= 0 then - dst.[oi] <- lv + while li < le do + dst.[oi] <- src.[li] oi <- oi + 1 li <- li + 1 - else - dst.[oi] <- rv + + while ri < re do + dst.[oi] <- src.[ri] oi <- oi + 1 ri <- ri + 1 - while li < le do - dst.[oi] <- src.[li] - oi <- oi + 1 - li <- li + 1 - - while ri < re do - dst.[oi] <- src.[ri] - oi <- oi + 1 - ri <- ri + 1 - - let inline private mergeSeqHandleDuplicates (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : ('Key * 'Value)[]) (dst : ('Key * 'Value)[]) (length : int) = - let le = ri - let re = min length (ri + len) - let start = li - let mutable oi = li - let mutable li = li - let mutable ri = ri - let mutable lastValue = Unchecked.defaultof<'Key * 'Value> - - let inline append (v : ('Key * 'Value)) = - if oi > start && cmp.Compare(fst v, fst lastValue) = 0 then - dst.[oi-1] <- v - lastValue <- v - else - dst.[oi] <- v - lastValue <- v - oi <- oi + 1 + let inline private mergeSeqHandleDuplicates (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : ('Key * 'Value)[]) (dst : ('Key * 'Value)[]) (length : int) = + let le = ri + let re = min length (ri + len) + let start = li + let mutable oi = li + let mutable li = li + let mutable ri = ri + let mutable lastValue = Unchecked.defaultof<'Key * 'Value> + + let inline append (v : ('Key * 'Value)) = + if oi > start && cmp.Compare(fst v, fst lastValue) = 0 then + dst.[oi-1] <- v + lastValue <- v + else + dst.[oi] <- v + lastValue <- v + oi <- oi + 1 - while li < le && ri < re do - let lv = src.[li] - let rv = src.[ri] - let c = cmp.Compare(fst lv, fst rv) - if c <= 0 then - append lv - li <- li + 1 - else - append rv - ri <- ri + 1 + while li < le && ri < re do + let lv = src.[li] + let rv = src.[ri] + let c = cmp.Compare(fst lv, fst rv) + if c <= 0 then + append lv + li <- li + 1 + else + append rv + ri <- ri + 1 - while li < le do - append src.[li] - li <- li + 1 + while li < le do + append src.[li] + li <- li + 1 - while ri < re do - append src.[ri] - ri <- ri + 1 + while ri < re do + append src.[ri] + ri <- ri + 1 - oi + oi - // assumes length > 2 - let mergeSortHandleDuplicates (mutateArray : bool) (cmp : IComparer<'Key>) (arr : ('Key * 'Value)[]) (length : int) = - let mutable src = Array.zeroCreate length - let mutable dst = - // mutateArray => allowed to mutate arr - if mutateArray then arr - else Array.zeroCreate length - - // copy to sorted pairs - let mutable i0 = 0 - let mutable i1 = 1 - while i1 < length do - let va = arr.[i0] - let vb = arr.[i1] - let c = cmp.Compare(fst va, fst vb) - if c <= 0 then - src.[i0] <- va - src.[i1] <- vb - else - src.[i0] <- vb - src.[i1] <- va + // assumes length > 2 + let mergeSortHandleDuplicates (mutateArray : bool) (cmp : IComparer<'Key>) (arr : ('Key * 'Value)[]) (length : int) = + let mutable src = Array.zeroCreate length + let mutable dst = + // mutateArray => allowed to mutate arr + if mutateArray then arr + else Array.zeroCreate length + + // copy to sorted pairs + let mutable i0 = 0 + let mutable i1 = 1 + while i1 < length do + let va = arr.[i0] + let vb = arr.[i1] + let c = cmp.Compare(fst va, fst vb) + if c <= 0 then + src.[i0] <- va + src.[i1] <- vb + else + src.[i0] <- vb + src.[i1] <- va - i0 <- i0 + 2 - i1 <- i1 + 2 - - if i0 < length then - src.[i0] <- arr.[i0] - i0 <- i0 + 1 - - - // merge sorted parts of length `sortedLength` - let mutable sortedLength = 2 - let mutable sortedLengthDbl = 4 - while sortedLengthDbl < length do - let mutable li = 0 - let mutable ri = sortedLength - - // merge case - while ri < length do - mergeSeq cmp li ri sortedLength src dst length - li <- ri + sortedLength - ri <- li + sortedLength - - // right got empty - while li < length do - dst.[li] <- src.[li] - li <- li + 1 + i0 <- i0 + 2 + i1 <- i1 + 2 + + if i0 < length then + src.[i0] <- arr.[i0] + i0 <- i0 + 1 + + // merge sorted parts of length `sortedLength` + let mutable sortedLength = 2 + let mutable sortedLengthDbl = 4 + while sortedLengthDbl < length do + let mutable li = 0 + let mutable ri = sortedLength + + // merge case + while ri < length do + mergeSeq cmp li ri sortedLength src dst length + li <- ri + sortedLength + ri <- li + sortedLength + + // right got empty + while li < length do + dst.[li] <- src.[li] + li <- li + 1 - // sortedLength * 2 - sortedLength <- sortedLengthDbl - sortedLengthDbl <- sortedLengthDbl <<< 1 - // swap src and dst - let t = dst - dst <- src - src <- t - - // final merge-dedup run - let cnt = mergeSeqHandleDuplicates cmp 0 sortedLength sortedLength src dst length - struct(dst, cnt) - - let inline private mergeSeqV (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : struct('Key * 'Value)[]) (dst : struct('Key * 'Value)[]) (length : int) = - let le = ri - let re = min length (ri + len) - let mutable oi = li - let mutable li = li - let mutable ri = ri - - while li < le && ri < re do - let struct(lk, lv) = src.[li] - let struct(rk, rv) = src.[ri] - let c = cmp.Compare(lk, rk) - if c <= 0 then - dst.[oi] <- struct(lk, lv) + // sortedLength * 2 + sortedLength <- sortedLengthDbl + sortedLengthDbl <- sortedLengthDbl <<< 1 + // swap src and dst + let t = dst + dst <- src + src <- t + + // final merge-dedup run + let cnt = mergeSeqHandleDuplicates cmp 0 sortedLength sortedLength src dst length + struct(dst, cnt) + + let inline private mergeSeqV (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : KeyValuePair<'Key, 'Value>[]) (dst : KeyValuePair<'Key, 'Value>[]) (length : int) = + let le = ri + let re = min length (ri + len) + let mutable oi = li + let mutable li = li + let mutable ri = ri + + while li < le && ri < re do + let (KeyValue(lk, lv)) = src.[li] + let (KeyValue(rk, rv)) = src.[ri] + let c = cmp.Compare(lk, rk) + if c <= 0 then + dst.[oi] <- KeyValuePair(lk, lv) + oi <- oi + 1 + li <- li + 1 + else + dst.[oi] <- KeyValuePair(rk, rv) + oi <- oi + 1 + ri <- ri + 1 + + while li < le do + dst.[oi] <- src.[li] oi <- oi + 1 li <- li + 1 - else - dst.[oi] <- struct(rk, rv) + + while ri < re do + dst.[oi] <- src.[ri] oi <- oi + 1 ri <- ri + 1 - while li < le do - dst.[oi] <- src.[li] - oi <- oi + 1 - li <- li + 1 - - while ri < re do - dst.[oi] <- src.[ri] - oi <- oi + 1 - ri <- ri + 1 - - let inline private mergeSeqHandleDuplicatesV (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : struct('Key * 'Value)[]) (dst : struct('Key * 'Value)[]) (length : int) = - let le = ri - let re = min length (ri + len) - let start = li - let mutable oi = li - let mutable li = li - let mutable ri = ri - let mutable lastKey = Unchecked.defaultof<'Key> - - let inline append k v = - if oi > start && cmp.Compare(k, lastKey) = 0 then - dst.[oi-1] <- struct(k,v) - lastKey <- k - else - dst.[oi] <- struct(k,v) - lastKey <- k - oi <- oi + 1 + let inline private mergeSeqHandleDuplicatesV (cmp : IComparer<'Key>) (li : int) (ri : int) (len : int) (src : KeyValuePair<'Key, 'Value>[]) (dst : KeyValuePair<'Key, 'Value>[]) (length : int) = + let le = ri + let re = min length (ri + len) + let start = li + let mutable oi = li + let mutable li = li + let mutable ri = ri + let mutable lastKey = Unchecked.defaultof<'Key> + + let inline append k v = + if oi > start && cmp.Compare(k, lastKey) = 0 then + dst.[oi-1] <- KeyValuePair(k,v) + lastKey <- k + else + dst.[oi] <- KeyValuePair(k,v) + lastKey <- k + oi <- oi + 1 - while li < le && ri < re do - let struct(lk, lv) = src.[li] - let struct(rk, rv) = src.[ri] - let c = cmp.Compare(lk, rk) - if c <= 0 then - append lk lv - li <- li + 1 - else - append rk rv - ri <- ri + 1 + while li < le && ri < re do + let (KeyValue(lk, lv)) = src.[li] + let (KeyValue(rk, rv)) = src.[ri] + let c = cmp.Compare(lk, rk) + if c <= 0 then + append lk lv + li <- li + 1 + else + append rk rv + ri <- ri + 1 - while li < le do - let struct(k,v) = src.[li] - append k v - li <- li + 1 + while li < le do + let (KeyValue(k,v)) = src.[li] + append k v + li <- li + 1 - while ri < re do - let struct(k,v) = src.[ri] - append k v - ri <- ri + 1 + while ri < re do + let (KeyValue(k,v)) = src.[ri] + append k v + ri <- ri + 1 - oi + oi - // assumes length > 2 - let mergeSortHandleDuplicatesV (mutateArray : bool) (cmp : IComparer<'Key>) (arr : struct('Key * 'Value)[]) (length : int) = - let mutable src = Array.zeroCreate length - let mutable dst = - // mutateArray => allowed to mutate arr - if mutateArray then arr - else Array.zeroCreate length - - // copy to sorted pairs - let mutable i0 = 0 - let mutable i1 = 1 - while i1 < length do - let struct(ka,va) = arr.[i0] - let struct(kb,vb) = arr.[i1] - - let c = cmp.Compare(ka, kb) - if c <= 0 then - src.[i0] <- struct(ka, va) - src.[i1] <- struct(kb, vb) - else - src.[i0] <- struct(kb, vb) - src.[i1] <- struct(ka, va) - - i0 <- i0 + 2 - i1 <- i1 + 2 - - if i0 < length then - src.[i0] <- arr.[i0] - i0 <- i0 + 1 - - - // merge sorted parts of length `sortedLength` - let mutable sortedLength = 2 - let mutable sortedLengthDbl = 4 - while sortedLengthDbl < length do - let mutable li = 0 - let mutable ri = sortedLength - - // merge case - while ri < length do - mergeSeqV cmp li ri sortedLength src dst length - li <- ri + sortedLength - ri <- li + sortedLength - - // right got empty - while li < length do - dst.[li] <- src.[li] - li <- li + 1 + // assumes length > 2 + let mergeSortHandleDuplicatesV (mutateArray : bool) (cmp : IComparer<'Key>) (arr : KeyValuePair<'Key, 'Value>[]) (length : int) = + let mutable src = Array.zeroCreate length + let mutable dst = + // mutateArray => allowed to mutate arr + if mutateArray then arr + else Array.zeroCreate length + + // copy to sorted pairs + let mutable i0 = 0 + let mutable i1 = 1 + while i1 < length do + let (KeyValue(ka,va)) = arr.[i0] + let (KeyValue(kb,vb)) = arr.[i1] + + let c = cmp.Compare(ka, kb) + if c <= 0 then + src.[i0] <- KeyValuePair(ka, va) + src.[i1] <- KeyValuePair(kb, vb) + else + src.[i0] <- KeyValuePair(kb, vb) + src.[i1] <- KeyValuePair(ka, va) - // sortedLength * 2 - sortedLength <- sortedLengthDbl - sortedLengthDbl <- sortedLengthDbl <<< 1 - // swap src and dst - let t = dst - dst <- src - src <- t - - - // final merge-dedup run - let cnt = mergeSeqHandleDuplicatesV cmp 0 sortedLength sortedLength src dst length - struct(dst, cnt) + i0 <- i0 + 2 + i1 <- i1 + 2 + if i0 < length then + src.[i0] <- arr.[i0] + i0 <- i0 + 1 - let sortHandleDuplicates (mutateArray : bool) (cmp : IComparer<'T>) (arr : 'T[]) (length : int) = - if length <= 0 then - struct(arr, 0) - else - let arr = - if mutateArray then arr - else arr.[0 .. length-1] - System.Array.Sort(arr, 0, length, cmp) - - let mutable i = 1 - let mutable oi = 1 - let mutable last = arr.[0] - while i < length do - let v = arr.[i] - let c = cmp.Compare(last, v) - last <- v - i <- i + 1 - if c = 0 then - arr.[oi-1] <- v - else - arr.[oi] <- v - oi <- oi + 1 + // merge sorted parts of length `sortedLength` + let mutable sortedLength = 2 + let mutable sortedLengthDbl = 4 + while sortedLengthDbl < length do + let mutable li = 0 + let mutable ri = sortedLength + + // merge case + while ri < length do + mergeSeqV cmp li ri sortedLength src dst length + li <- ri + sortedLength + ri <- li + sortedLength + + // right got empty + while li < length do + dst.[li] <- src.[li] + li <- li + 1 + + // sortedLength * 2 + sortedLength <- sortedLengthDbl + sortedLengthDbl <- sortedLengthDbl <<< 1 + // swap src and dst + let t = dst + dst <- src + src <- t - struct(arr, oi) - -module MapImplementation = + // final merge-dedup run + let cnt = mergeSeqHandleDuplicatesV cmp 0 sortedLength sortedLength src dst length + struct(dst, cnt) - [] type MapNode<'Key, 'Value>() = @@ -315,34 +285,18 @@ module MapImplementation = abstract member Height : int abstract member Add : comparer : IComparer<'Key> * key : 'Key * value : 'Value -> MapNode<'Key, 'Value> - abstract member AddIfNotPresent : comparer : IComparer<'Key> * key : 'Key * value : 'Value -> MapNode<'Key, 'Value> abstract member Remove : comparer : IComparer<'Key> * key : 'Key -> MapNode<'Key, 'Value> abstract member AddInPlace : comparer : IComparer<'Key> * key : 'Key * value : 'Value -> MapNode<'Key, 'Value> - abstract member TryRemove : comparer : IComparer<'Key> * key : 'Key -> option * 'Value> - abstract member TryRemoveV : comparer : IComparer<'Key> * key : 'Key -> voption * 'Value)> + abstract member Change : comparer : IComparer<'Key> * key : 'Key * (option<'Value> -> option<'Value>) -> MapNode<'Key, 'Value> abstract member Map : mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, 'T> -> MapNode<'Key, 'T> abstract member Filter : predicate : OptimizedClosures.FSharpFunc<'Key, 'Value, bool> -> MapNode<'Key, 'Value> abstract member Choose : mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, option<'T>> -> MapNode<'Key, 'T> - abstract member ChooseV : mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>> -> MapNode<'Key, 'T> abstract member UnsafeRemoveHeadV : unit -> struct('Key * 'Value * MapNode<'Key, 'Value>) abstract member UnsafeRemoveTailV : unit -> struct(MapNode<'Key, 'Value> * 'Key * 'Value) - - abstract member GetViewBetween : comparer : IComparer<'Key> * min : 'Key * minInclusive : bool * max : 'Key * maxInclusive : bool -> MapNode<'Key, 'Value> - abstract member WithMin : comparer : IComparer<'Key> * min : 'Key * minInclusive : bool -> MapNode<'Key, 'Value> - abstract member WithMax : comparer : IComparer<'Key> * max : 'Key * maxInclusive : bool -> MapNode<'Key, 'Value> abstract member SplitV : comparer : IComparer<'Key> * key : 'Key -> struct(MapNode<'Key, 'Value> * MapNode<'Key, 'Value> * voption<'Value>) - abstract member Change : comparer : IComparer<'Key> * key : 'Key * (option<'Value> -> option<'Value>) -> MapNode<'Key, 'Value> - abstract member ChangeV : comparer : IComparer<'Key> * key : 'Key * (voption<'Value> -> voption<'Value>) -> MapNode<'Key, 'Value> - - //// find, findKey tryFindKey, pick, partition, tryPick - //abstract member TryFindKey : pick : OptimizedClosures.FSharpFunc<'Key, 'Value, bool> -> option<'Key> - //abstract member TryFindKeyV : pick : OptimizedClosures.FSharpFunc<'Key, 'Value, bool> -> voption<'Key> - //abstract member TryPick : pick : OptimizedClosures.FSharpFunc<'Key, 'Value, option<'T>> -> option<'T> - //abstract member TryPickV : pick : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>> -> voption<'T> - and [] MapEmpty<'Key, 'Value> private() = @@ -357,36 +311,19 @@ module MapImplementation = override x.Add(_, key, value) = MapLeaf(key, value) :> MapNode<_,_> - override x.AddIfNotPresent(_, key, value) = - MapLeaf(key, value) :> MapNode<_,_> - override x.AddInPlace(_, key, value) = MapLeaf(key, value) :> MapNode<_,_> override x.Remove(_,_) = x :> MapNode<_,_> - - override x.TryRemove(_,_) = - None - - override x.TryRemoveV(_,_) = - ValueNone override x.Map(_) = MapEmpty.Instance override x.Filter(_) = x :> MapNode<_,_> override x.Choose(_) = MapEmpty.Instance - override x.ChooseV(_) = MapEmpty.Instance override x.UnsafeRemoveHeadV() = failwith "empty" override x.UnsafeRemoveTailV() = failwith "empty" - override x.GetViewBetween(_comparer : IComparer<'Key>, _min : 'Key, _minInclusive : bool, _max : 'Key, _maxInclusive : bool) = - x :> MapNode<_,_> - override x.WithMin(_comparer : IComparer<'Key>, _min : 'Key, _minInclusive : bool) = - x :> MapNode<_,_> - override x.WithMax(_comparer : IComparer<'Key>, _max : 'Key, _maxInclusive : bool) = - x :> MapNode<_,_> - override x.SplitV(_,_) = (x :> MapNode<_,_>, x :> MapNode<_,_>, ValueNone) @@ -394,11 +331,6 @@ module MapImplementation = match update None with | None -> x :> MapNode<_,_> | Some v -> MapLeaf(key, v) :> MapNode<_,_> - - override x.ChangeV(_comparer, key, update) = - match update ValueNone with - | ValueNone -> x :> MapNode<_,_> - | ValueSome v -> MapLeaf(key, v) :> MapNode<_,_> and [] MapLeaf<'Key, 'Value> = @@ -422,17 +354,7 @@ module MapImplementation = MapInner(MapEmpty.Instance, key, value, x) :> MapNode<'Key,'Value> else MapLeaf(key, value) :> MapNode<'Key,'Value> - - override x.AddIfNotPresent(comparer, key, value) = - let c = comparer.Compare(key, x.Key) - if c > 0 then - MapInner(x, key, value, MapEmpty.Instance) :> MapNode<'Key,'Value> - elif c < 0 then - MapInner(MapEmpty.Instance, key, value, x) :> MapNode<'Key,'Value> - else - x :> MapNode<'Key,'Value> - override x.AddInPlace(comparer, key, value) = let c = comparer.Compare(key, x.Key) @@ -449,14 +371,6 @@ module MapImplementation = override x.Remove(comparer, key) = if comparer.Compare(key, x.Key) = 0 then MapEmpty.Instance else x :> MapNode<_,_> - - override x.TryRemove(comparer, key) = - if comparer.Compare(key, x.Key) = 0 then Some(MapEmpty.Instance, x.Value) - else None - - override x.TryRemoveV(comparer, key) = - if comparer.Compare(key, x.Key) = 0 then ValueSome(MapEmpty.Instance, x.Value) - else ValueNone override x.Map(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, 'T>) = MapLeaf(x.Key, mapping.Invoke(x.Key, x.Value)) :> MapNode<_,_> @@ -474,45 +388,12 @@ module MapImplementation = | None -> MapEmpty.Instance - override x.ChooseV(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>>) = - match mapping.Invoke(x.Key, x.Value) with - | ValueSome v -> - MapLeaf(x.Key, v) :> MapNode<_,_> - | ValueNone -> - MapEmpty.Instance - override x.UnsafeRemoveHeadV() = struct(x.Key, x.Value, MapEmpty<'Key, 'Value>.Instance) override x.UnsafeRemoveTailV() = struct(MapEmpty<'Key, 'Value>.Instance, x.Key, x.Value) - - override x.GetViewBetween(comparer : IComparer<'Key>, min : 'Key, minInclusive : bool, max : 'Key, maxInclusive : bool) = - let cMin = comparer.Compare(x.Key, min) - if (if minInclusive then cMin >= 0 else cMin > 0) then - let cMax = comparer.Compare(x.Key, max) - if (if maxInclusive then cMax <= 0 else cMax < 0) then - x :> MapNode<_,_> - else - MapEmpty.Instance - else - MapEmpty.Instance - - override x.WithMin(comparer : IComparer<'Key>, min : 'Key, minInclusive : bool) = - let cMin = comparer.Compare(x.Key, min) - if (if minInclusive then cMin >= 0 else cMin > 0) then - x :> MapNode<_,_> - else - MapEmpty.Instance - - override x.WithMax(comparer : IComparer<'Key>, max : 'Key, maxInclusive : bool) = - let cMax = comparer.Compare(x.Key, max) - if (if maxInclusive then cMax <= 0 else cMax < 0) then - x :> MapNode<_,_> - else - MapEmpty.Instance - override x.SplitV(comparer : IComparer<'Key>, key : 'Key) = let c = comparer.Compare(x.Key, key) if c > 0 then @@ -539,23 +420,6 @@ module MapImplementation = | None -> MapEmpty.Instance - override x.ChangeV(comparer, key, update) = - let c = comparer.Compare(key, x.Key) - if c > 0 then - match update ValueNone with - | ValueNone -> x :> MapNode<_,_> - | ValueSome v -> MapInner(x, key, v, MapEmpty.Instance) :> MapNode<_,_> - elif c < 0 then - match update ValueNone with - | ValueNone -> x :> MapNode<_,_> - | ValueSome v -> MapInner(MapEmpty.Instance, key, v, x) :> MapNode<_,_> - else - match update (ValueSome x.Value) with - | ValueSome v -> - MapLeaf(key, v) :> MapNode<_,_> - | ValueNone -> - MapEmpty.Instance - new(k : 'Key, v : 'Value) = { Key = k; Value = v} end @@ -672,24 +536,7 @@ module MapImplementation = key, value, x.Right ) :> MapNode<_,_> - - override x.AddIfNotPresent(comparer : IComparer<'Key>, key : 'Key, value : 'Value) = - let c = comparer.Compare(key, x.Key) - if c > 0 then - MapInner.Create( - x.Left, - x.Key, x.Value, - x.Right.AddIfNotPresent(comparer, key, value) - ) - elif c < 0 then - MapInner.Create( - x.Left.AddIfNotPresent(comparer, key, value), - x.Key, x.Value, - x.Right - ) - else - x :> MapNode<_,_> - + override x.AddInPlace(comparer : IComparer<'Key>, key : 'Key, value : 'Value) = let c = comparer.Compare(key, x.Key) if c > 0 then @@ -741,64 +588,6 @@ module MapImplementation = ) else MapInner.Join(x.Left, x.Right) - - override x.TryRemove(comparer : IComparer<'Key>, key : 'Key) = - let c = comparer.Compare(key, x.Key) - if c > 0 then - match x.Right.TryRemoveV(comparer, key) with - | ValueSome struct(newRight, value) -> - let newNode = - MapInner.Create( - x.Left, - x.Key, x.Value, - newRight - ) - Some(newNode, value) - | ValueNone -> - None - elif c < 0 then - match x.Left.TryRemoveV(comparer, key) with - | ValueSome struct(newLeft, value) -> - let newNode = - MapInner.Create( - newLeft, - x.Key, x.Value, - x.Right - ) - Some(newNode, value) - | ValueNone -> - None - else - Some(MapInner.Join(x.Left, x.Right), x.Value) - - override x.TryRemoveV(comparer : IComparer<'Key>, key : 'Key) = - let c = comparer.Compare(key, x.Key) - if c > 0 then - match x.Right.TryRemoveV(comparer, key) with - | ValueSome struct(newRight, value) -> - let newNode = - MapInner.Create( - x.Left, - x.Key, x.Value, - newRight - ) - ValueSome(newNode, value) - | ValueNone -> - ValueNone - elif c < 0 then - match x.Left.TryRemoveV(comparer, key) with - | ValueSome struct(newLeft, value) -> - let newNode = - MapInner.Create( - newLeft, - x.Key, x.Value, - x.Right - ) - ValueSome(newNode, value) - | ValueNone -> - ValueNone - else - ValueSome(MapInner.Join(x.Left, x.Right), x.Value) override x.Map(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, 'T>) = MapInner( @@ -827,17 +616,6 @@ module MapImplementation = | None -> MapInner.Join(l, r) - - override x.ChooseV(mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>>) = - let l = x.Left.ChooseV(mapping) - let self = mapping.Invoke(x.Key, x.Value) - let r = x.Right.ChooseV(mapping) - match self with - | ValueSome value -> - MapInner.Create(l, x.Key, value, r) - | ValueNone -> - MapInner.Join(l, r) - override x.UnsafeRemoveHeadV() = if x.Left.Count = 0 then struct(x.Key, x.Value, x.Right) @@ -852,33 +630,6 @@ module MapImplementation = let struct(r1,k,v) = x.Right.UnsafeRemoveTailV() struct(MapInner.Create(x.Left, x.Key, x.Value, r1), k, v) - - override x.WithMin(comparer : IComparer<'Key>, min : 'Key, minInclusive : bool) = - let c = comparer.Compare(x.Key, min) - let greaterMin = if minInclusive then c >= 0 else c > 0 - if greaterMin then - MapInner.Create( - x.Left.WithMin(comparer, min, minInclusive), - x.Key, x.Value, - x.Right - ) - else - x.Right.WithMin(comparer, min, minInclusive) - - - override x.WithMax(comparer : IComparer<'Key>, max : 'Key, maxInclusive : bool) = - let c = comparer.Compare(x.Key, max) - let smallerMax = if maxInclusive then c <= 0 else c < 0 - if smallerMax then - MapInner.Create( - x.Left, - x.Key, x.Value, - x.Right.WithMax(comparer, max, maxInclusive) - ) - else - x.Left.WithMax(comparer, max, maxInclusive) - - override x.SplitV(comparer : IComparer<'Key>, key : 'Key) = let c = comparer.Compare(key, x.Key) if c > 0 then @@ -890,37 +641,6 @@ module MapImplementation = else struct(x.Left, x.Right, ValueSome x.Value) - override x.GetViewBetween(comparer : IComparer<'Key>, min : 'Key, minInclusive : bool, max : 'Key, maxInclusive : bool) = - let cMin = comparer.Compare(x.Key, min) - let cMax = comparer.Compare(x.Key, max) - - let greaterMin = if minInclusive then cMin >= 0 else cMin > 0 - let smallerMax = if maxInclusive then cMax <= 0 else cMax < 0 - - if not greaterMin then - x.Right.GetViewBetween(comparer, min, minInclusive, max, maxInclusive) - - elif not smallerMax then - x.Left.GetViewBetween(comparer, min, minInclusive, max, maxInclusive) - - elif greaterMin && smallerMax then - let l = x.Left.WithMin(comparer, min, minInclusive) - let r = x.Right.WithMax(comparer, max, maxInclusive) - MapInner.Create(l, x.Key, x.Value, r) - - elif greaterMin then - let l = x.Left.GetViewBetween(comparer, min, minInclusive, max, maxInclusive) - let r = x.Right.WithMax(comparer, max, maxInclusive) - MapInner.Create(l, x.Key, x.Value, r) - - elif smallerMax then - let l = x.Left.WithMin(comparer, min, minInclusive) - let r = x.Right.GetViewBetween(comparer, min, minInclusive, max, maxInclusive) - MapInner.Create(l, x.Key, x.Value, r) - - else - failwith "invalid range" - override x.Change(comparer, key, update) = let c = comparer.Compare(key, x.Key) if c > 0 then @@ -946,31 +666,6 @@ module MapImplementation = | None -> MapInner.Join(x.Left, x.Right) - override x.ChangeV(comparer, key, update) = - let c = comparer.Compare(key, x.Key) - if c > 0 then - MapInner.Create( - x.Left, - x.Key, x.Value, - x.Right.ChangeV(comparer, key, update) - ) - elif c < 0 then - MapInner.Create( - x.Left.ChangeV(comparer, key, update), - x.Key, x.Value, - x.Right - ) - else - match update (ValueSome x.Value) with - | ValueSome v -> - MapInner( - x.Left, - key, v, - x.Right - ) :> MapNode<_,_> - | ValueNone -> - MapInner.Join(x.Left, x.Right) - new(l : MapNode<'Key, 'Value>, k : 'Key, v : 'Value, r : MapNode<'Key, 'Value>) = assert(l.Count > 0 || r.Count > 0) // not both empty assert(abs (r.Height - l.Height) <= 2) // balanced @@ -988,7 +683,6 @@ module MapImplementation = let inline combineHash (a: int) (b: int) = uint32 a ^^^ uint32 b + 0x9e3779b9u + ((uint32 a) <<< 6) + ((uint32 a) >>> 2) |> int - let hash (n : MapNode<'K, 'V>) = let rec hash (acc : int) (n : MapNode<'K, 'V>) = match n with @@ -1031,10 +725,8 @@ module MapImplementation = true open MapImplementation -open System.Diagnostics -open System.Runtime.InteropServices -[] +[] [] [] [] @@ -1055,6 +747,7 @@ type Map< [] 'Key, [) = let arr = Array.zeroCreate root.Count let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = @@ -1073,38 +766,39 @@ type Map< [] 'Key, [ ignore arr - static let fromArray (elements : struct('Key * 'Value)[]) = + // helper for deserialization + static let fromArray (elements : KeyValuePair<'Key, 'Value>[]) = let cmp = defaultComparer match elements.Length with | 0 -> MapEmpty.Instance | 1 -> - let struct(k,v) = elements.[0] + let (KeyValue(k,v)) = elements.[0] MapLeaf(k, v) :> MapNode<_,_> | 2 -> - let struct(k0,v0) = elements.[0] - let struct(k1,v1) = elements.[1] + let (KeyValue(k0,v0)) = elements.[0] + let (KeyValue(k1,v1)) = elements.[1] let c = cmp.Compare(k0, k1) if c > 0 then MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0)) :> MapNode<_,_> elif c < 0 then MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance) :> MapNode<_,_> else MapLeaf(k1, v1):> MapNode<_,_> | 3 -> - let struct(k0,v0) = elements.[0] - let struct(k1,v1) = elements.[1] - let struct(k2,v2) = elements.[2] + let (KeyValue(k0,v0)) = elements.[0] + let (KeyValue(k1,v1)) = elements.[1] + let (KeyValue(k2,v2)) = elements.[2] MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2) | 4 -> - let struct(k0,v0) = elements.[0] - let struct(k1,v1) = elements.[1] - let struct(k2,v2) = elements.[2] - let struct(k3,v3) = elements.[3] + let (KeyValue(k0,v0)) = elements.[0] + let (KeyValue(k1,v1)) = elements.[1] + let (KeyValue(k2,v2)) = elements.[2] + let (KeyValue(k3,v3)) = elements.[3] MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3) | 5 -> - let struct(k0,v0) = elements.[0] - let struct(k1,v1) = elements.[1] - let struct(k2,v2) = elements.[2] - let struct(k3,v3) = elements.[3] - let struct(k4,v4) = elements.[4] + let (KeyValue(k0,v0)) = elements.[0] + let (KeyValue(k1,v1)) = elements.[1] + let (KeyValue(k2,v2)) = elements.[2] + let (KeyValue(k3,v3)) = elements.[3] + let (KeyValue(k4,v4)) = elements.[4] MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4) | _ -> let struct(arr, cnt) = Sorting.mergeSortHandleDuplicatesV false cmp elements elements.Length @@ -1120,64 +814,51 @@ type Map< [] 'Key, [ Array.map (fun kvp -> struct(kvp.Key, kvp.Value)) |> fromArray + root <- serializedData |> fromArray static member Empty = empty - static member private CreateTree(cmp : IComparer<'Key>, arr : ('Key * 'Value)[], cnt : int)= - let rec create (arr : ('Key * 'Value)[]) (l : int) (r : int) = - if l > r then - MapEmpty.Instance - elif l = r then - let (k,v) = arr.[l] - MapLeaf(k, v) :> MapNode<_,_> - else - let m = (l+r)/2 - let (k,v) = arr.[m] - MapInner( - create arr l (m-1), - k, v, - create arr (m+1) r - ) :> MapNode<_,_> - - Map(cmp, create arr 0 (cnt-1)) - - static member private CreateTree(cmp : IComparer<'Key>, arr : struct('Key * 'Value)[], cnt : int)= - let rec create (arr : struct('Key * 'Value)[]) (l : int) (r : int) = + static member private CreateRoot(arr : KeyValuePair<'Key, 'Value>[], cnt : int)= + let rec create (arr : KeyValuePair<'Key, 'Value>[]) (l : int) (r : int) = if l = r then - let struct(k,v) = arr.[l] - MapLeaf(k, v) :> MapNode<_,_> + let kvp = arr.[l] + MapLeaf(kvp.Key, kvp.Value) :> MapNode<_,_> elif l > r then MapEmpty.Instance else let m = (l+r)/2 - let struct(k,v) = arr.[m] + let kvp = arr.[m] MapInner( create arr l (m-1), - k, v, + kvp.Key, kvp.Value, create arr (m+1) r ) :> MapNode<_,_> - Map(cmp, create arr 0 (cnt-1)) - - static member private CreateRoot(arr : struct('Key * 'Value)[], cnt : int)= - let rec create (arr : struct('Key * 'Value)[]) (l : int) (r : int) = - if l = r then - let struct(k,v) = arr.[l] - MapLeaf(k, v) :> MapNode<_,_> - elif l > r then + create arr 0 (cnt-1) + + static member private CreateRoot(arr : ('Key * 'Value)[], cnt : int)= + let rec create (arr : ('Key * 'Value)[]) (l : int) (r : int) = + if l > r then MapEmpty.Instance + elif l = r then + let (k,v) = arr.[l] + MapLeaf(k, v) :> MapNode<_,_> else let m = (l+r)/2 - let struct(k,v) = arr.[m] + let (k,v) = arr.[m] MapInner( create arr l (m-1), k, v, create arr (m+1) r ) :> MapNode<_,_> - create arr 0 (cnt-1) + static member private CreateTree(cmp : IComparer<'Key>, arr : ('Key * 'Value)[], cnt : int) = + Map(cmp, Map.CreateRoot(arr, cnt)) + + static member private CreateTree(cmp : IComparer<'Key>, arr : KeyValuePair<'Key, 'Value>[], cnt : int) = + Map(cmp, Map.CreateRoot(arr, cnt)) + static member FromArray (elements : array<'Key * 'Value>) = let cmp = defaultComparer match elements.Length with @@ -1214,44 +895,7 @@ type Map< [] 'Key, [ let struct(arr, cnt) = Sorting.mergeSortHandleDuplicates false cmp elements elements.Length Map.CreateTree(cmp, arr, cnt) - - static member FromArrayV (elements : array) = - let cmp = defaultComparer - match elements.Length with - | 0 -> - Map(cmp, MapEmpty.Instance) - | 1 -> - let struct(k,v) = elements.[0] - Map(cmp, MapLeaf(k, v)) - | 2 -> - let struct(k0,v0) = elements.[0] - let struct(k1,v1) = elements.[1] - let c = cmp.Compare(k0, k1) - if c > 0 then Map(cmp, MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0))) - elif c < 0 then Map(cmp, MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance)) - else Map(cmp, MapLeaf(k1, v1)) - | 3 -> - let struct(k0,v0) = elements.[0] - let struct(k1,v1) = elements.[1] - let struct(k2,v2) = elements.[2] - Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2)) - | 4 -> - let struct(k0,v0) = elements.[0] - let struct(k1,v1) = elements.[1] - let struct(k2,v2) = elements.[2] - let struct(k3,v3) = elements.[3] - Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3)) - | 5 -> - let struct(k0,v0) = elements.[0] - let struct(k1,v1) = elements.[1] - let struct(k2,v2) = elements.[2] - let struct(k3,v3) = elements.[3] - let struct(k4,v4) = elements.[4] - Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4)) - | _ -> - let struct(arr, cnt) = Sorting.mergeSortHandleDuplicatesV false cmp elements elements.Length - Map.CreateTree(cmp, arr, cnt) - + static member FromList (elements : list<'Key * 'Value>) = let rec atMost (cnt : int) (l : list<_>) = match l with @@ -1312,179 +956,47 @@ type Map< [] 'Key, [= arr.Length then System.Array.Resize(&arr, arr.Length <<< 1) arr.[cnt] <- t - cnt <- cnt + 1 - - let struct(arr1, cnt1) = Sorting.mergeSortHandleDuplicates true cmp arr cnt - Map.CreateTree(cmp, arr1, cnt1) - - - - - - static member FromListV (elements : list) = - let rec atMost (cnt : int) (l : list<_>) = - match l with - | [] -> true - | _ :: t -> - if cnt > 0 then atMost (cnt - 1) t - else false - - let cmp = defaultComparer - match elements with - | [] -> - // cnt = 0 - Map(cmp, MapEmpty.Instance) - - | struct(k0, v0) :: rest -> - // cnt >= 1 - match rest with - | [] -> - // cnt = 1 - Map(cmp, MapLeaf(k0, v0)) - | struct(k1, v1) :: rest -> - // cnt >= 2 - match rest with - | [] -> - // cnt = 2 - let c = cmp.Compare(k0, k1) - if c < 0 then Map(cmp, MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance)) - elif c > 0 then Map(cmp, MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0))) - else Map(cmp, MapLeaf(k1, v1)) - | struct(k2, v2) :: rest -> - // cnt >= 3 - match rest with - | [] -> - // cnt = 3 - Map(cmp, MapLeaf(k0,v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2)) - | struct(k3, v3) :: rest -> - // cnt >= 4 - match rest with - | [] -> - // cnt = 4 - Map(cmp, MapLeaf(k0,v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3)) - | struct(k4, v4) :: rest -> - // cnt >= 5 - match rest with - | [] -> - // cnt = 5 - Map(cmp, MapLeaf(k0,v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4)) - | t5 :: rest -> - // cnt >= 6 - let mutable arr = Array.zeroCreate 16 - let mutable cnt = 6 - arr.[0] <- struct(k0, v0) - arr.[1] <- struct(k1, v1) - arr.[2] <- struct(k2, v2) - arr.[3] <- struct(k3, v3) - arr.[4] <- struct(k4, v4) - arr.[5] <- t5 - for t in rest do - if cnt >= arr.Length then System.Array.Resize(&arr, arr.Length <<< 1) - arr.[cnt] <- t - cnt <- cnt + 1 - - let struct(arr1, cnt1) = Sorting.mergeSortHandleDuplicatesV true cmp arr cnt - Map.CreateTree(cmp, arr1, cnt1) - - static member FromSeq (elements : seq<'Key * 'Value>) = - match elements with - | :? array<'Key * 'Value> as e -> Map.FromArray e - | :? list<'Key * 'Value> as e -> Map.FromList e - | _ -> - let cmp = defaultComparer - use e = elements.GetEnumerator() - if e.MoveNext() then - // cnt >= 1 - let t0 = e.Current - let (k0,v0) = t0 - if e.MoveNext() then - // cnt >= 2 - let t1 = e.Current - let (k1,v1) = t1 - if e.MoveNext() then - // cnt >= 3 - let t2 = e.Current - let (k2,v2) = t2 - if e.MoveNext() then - // cnt >= 4 - let t3 = e.Current - let (k3, v3) = t3 - if e.MoveNext() then - // cnt >= 5 - let t4 = e.Current - let (k4, v4) = t4 - if e.MoveNext() then - // cnt >= 6 - let mutable arr = Array.zeroCreate 16 - let mutable cnt = 6 - arr.[0] <- t0 - arr.[1] <- t1 - arr.[2] <- t2 - arr.[3] <- t3 - arr.[4] <- t4 - arr.[5] <- e.Current - - while e.MoveNext() do - if cnt >= arr.Length then System.Array.Resize(&arr, arr.Length <<< 1) - arr.[cnt] <- e.Current - cnt <- cnt + 1 - - let struct(arr1, cnt1) = Sorting.mergeSortHandleDuplicates true cmp arr cnt - Map.CreateTree(cmp, arr1, cnt1) - - else - // cnt = 5 - Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3).AddInPlace(cmp, k4, v4)) - - else - // cnt = 4 - Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2).AddInPlace(cmp, k3, v3)) - else - Map(cmp, MapLeaf(k0, v0).AddInPlace(cmp, k1, v1).AddInPlace(cmp, k2, v2)) - else - // cnt = 2 - let c = cmp.Compare(k0, k1) - if c < 0 then Map(cmp, MapInner(MapLeaf(k0, v0), k1, v1, MapEmpty.Instance)) - elif c > 0 then Map(cmp, MapInner(MapEmpty.Instance, k1, v1, MapLeaf(k0, v0))) - else Map(cmp, MapLeaf(k1, v1)) - else - // cnt = 1 - Map(cmp, MapLeaf(k0, v0)) - - else - Map(cmp, MapEmpty.Instance) - - static member FromSeqV (elements : seq) = + cnt <- cnt + 1 + + let struct(arr1, cnt1) = Sorting.mergeSortHandleDuplicates true cmp arr cnt + Map.CreateTree(cmp, arr1, cnt1) + + static member FromSeq (elements : seq<'Key * 'Value>) = match elements with - | :? array as e -> Map.FromArrayV e - | :? list as e -> Map.FromListV e + | :? array<'Key * 'Value> as e -> Map.FromArray e + | :? list<'Key * 'Value> as e -> Map.FromList e | _ -> let cmp = defaultComparer use e = elements.GetEnumerator() if e.MoveNext() then // cnt >= 1 - let struct(k0,v0) = e.Current + let t0 = e.Current + let (k0,v0) = t0 if e.MoveNext() then // cnt >= 2 - let struct(k1,v1) = e.Current + let t1 = e.Current + let (k1,v1) = t1 if e.MoveNext() then // cnt >= 3 - let struct(k2,v2) = e.Current + let t2 = e.Current + let (k2,v2) = t2 if e.MoveNext() then // cnt >= 4 - let struct(k3, v3) = e.Current + let t3 = e.Current + let (k3, v3) = t3 if e.MoveNext() then // cnt >= 5 - let struct(k4, v4) = e.Current + let t4 = e.Current + let (k4, v4) = t4 if e.MoveNext() then // cnt >= 6 let mutable arr = Array.zeroCreate 16 let mutable cnt = 6 - arr.[0] <- struct(k0, v0) - arr.[1] <- struct(k1, v1) - arr.[2] <- struct(k2, v2) - arr.[3] <- struct(k3, v3) - arr.[4] <- struct(k4, v4) + arr.[0] <- t0 + arr.[1] <- t1 + arr.[2] <- t2 + arr.[3] <- t3 + arr.[4] <- t4 arr.[5] <- e.Current while e.MoveNext() do @@ -1492,7 +1004,7 @@ type Map< [] 'Key, [] 'Key, [, r : Map<'Key, 'Value>) = - let rec union (cmp : IComparer<'Key>) (l : MapNode<'Key, 'Value>) (r : MapNode<'Key, 'Value>) = - match l with - | :? MapEmpty<'Key, 'Value> -> - r - | :? MapLeaf<'Key, 'Value> as l -> - r.AddIfNotPresent(cmp, l.Key, l.Value) - | :? MapInner<'Key, 'Value> as l -> - match r with - | :? MapEmpty<'Key, 'Value> -> - l :> MapNode<_,_> - | :? MapLeaf<'Key, 'Value> as r -> - l.Add(cmp, r.Key, r.Value) - | :? MapInner<'Key, 'Value> as r -> - if l.Count > r.Count then - let struct(rl, rr, rv) = r.SplitV(cmp, l.Key) - match rv with - | ValueSome rv -> - MapInner.Create( - union cmp l.Left rl, - l.Key, rv, - union cmp l.Right rr - ) - | ValueNone -> - MapInner.Create( - union cmp l.Left rl, - l.Key, l.Value, - union cmp l.Right rr - ) - else - let struct(ll, lr, _lv) = l.SplitV(cmp, r.Key) - MapInner.Create( - union cmp ll r.Left, - r.Key, r.Value, - union cmp lr r.Right - ) - | _ -> - failwith "unexpected node" - | _ -> - failwith "unexpected node" - - let cmp = defaultComparer - Map(cmp, union cmp l.Root r.Root) - - static member UnionWith(l : Map<'Key, 'Value>, r : Map<'Key, 'Value>, resolve : 'Key -> 'Value -> 'Value -> 'Value) = - let resolve = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt resolve - - let rec union (cmp : IComparer<'Key>) (resolve : OptimizedClosures.FSharpFunc<_,_,_,_>) (l : MapNode<'Key, 'Value>) (r : MapNode<'Key, 'Value>) = - match l with - | :? MapEmpty<'Key, 'Value> -> - r - | :? MapLeaf<'Key, 'Value> as l -> - r.ChangeV(cmp, l.Key, function - | ValueSome rv -> resolve.Invoke(l.Key, l.Value, rv) |> ValueSome - | ValueNone -> l.Value |> ValueSome - ) - | :? MapInner<'Key, 'Value> as l -> - match r with - | :? MapEmpty<'Key, 'Value> -> - l :> MapNode<_,_> - | :? MapLeaf<'Key, 'Value> as r -> - l.ChangeV(cmp, r.Key, function - | ValueSome lv -> resolve.Invoke(r.Key, lv, r.Value) |> ValueSome - | ValueNone -> r.Value |> ValueSome - ) - | :? MapInner<'Key, 'Value> as r -> - if l.Count > r.Count then - let struct(rl, rr, rv) = r.SplitV(cmp, l.Key) - match rv with - | ValueSome rv -> - MapInner.Create( - union cmp resolve l.Left rl, - l.Key, resolve.Invoke(l.Key, l.Value, rv), - union cmp resolve l.Right rr - ) - | ValueNone -> - MapInner.Create( - union cmp resolve l.Left rl, - l.Key, l.Value, - union cmp resolve l.Right rr - ) - else - let struct(ll, lr, lv) = l.SplitV(cmp, r.Key) - match lv with - | ValueSome lv -> - MapInner.Create( - union cmp resolve ll r.Left, - r.Key, resolve.Invoke(r.Key, lv, r.Value), - union cmp resolve lr r.Right - ) - | ValueNone -> - MapInner.Create( - union cmp resolve ll r.Left, - r.Key, r.Value, - union cmp resolve lr r.Right - ) - - | _ -> - failwith "unexpected node" - | _ -> - failwith "unexpected node" - - let cmp = defaultComparer - Map(cmp, union cmp resolve l.Root r.Root) - member x.Count = root.Count member x.IsEmpty = root.Count = 0 member x.Root = root member x.Comparer = comparer - static member ComputeDelta<'T>(l : Map<'Key, 'Value>, r : Map<'Key, 'Value>, add : Map<'Key, 'Value> -> Map<'Key, 'T>, remove : Map<'Key, 'Value> -> Map<'Key, 'T>, update : 'Key -> 'Value -> 'Value -> voption<'T>) : Map<'Key, 'T> = - - let inline add (cmp : IComparer<_>) (a : MapNode<'Key, 'Value>) = - if a.Count > 0 then add(Map<'Key, 'Value>(cmp, a)).Root - else MapEmpty.Instance - - let inline remove (cmp : IComparer<_>) (a : MapNode<'Key, 'Value>) = - if a.Count > 0 then remove(Map<'Key, 'Value>(cmp, a)).Root - else MapEmpty.Instance - - let rec computeDelta (cmp : IComparer<_>) (update : OptimizedClosures.FSharpFunc<_,_,_,_>) (l : MapNode<'Key, 'Value>) (r : MapNode<'Key, 'Value>) = - match l with - | :? MapLeaf<'Key, 'Value> as l -> - match r with - | :? MapLeaf<'Key, 'Value> as r -> - let c = cmp.Compare(l.Key, r.Key) - if c < 0 then - MapInner<'Key, 'T>.Join(remove cmp l, add cmp r) - elif c > 0 then - MapInner<'Key, 'T>.Join(add cmp r, remove cmp l) - else - match update.Invoke(l.Key, l.Value, r.Value) with - | ValueSome o -> MapLeaf(l.Key, o) :> MapNode<_,_> - | ValueNone -> MapEmpty.Instance - | :? MapInner<'Key, 'Value> as r -> - let struct(rl, rr, rv) = r.SplitV(cmp, l.Key) - - let a = computeDelta cmp update MapEmpty.Instance rl - let splitter = - match rv with - | ValueSome rv -> update.Invoke(l.Key, l.Value, rv) - | ValueNone -> ValueNone - let b = computeDelta cmp update MapEmpty.Instance rr - - match splitter with - | ValueSome v -> MapInner.Create(a, l.Key, v, b) - | ValueNone -> MapInner.Join(a, b) - | _ -> - remove cmp l - - | :? MapInner<'Key, 'Value> as l -> - match r with - | :? MapLeaf<'Key, 'Value> as r -> - let struct(ll, lr, lv) = l.SplitV(cmp, r.Key) - let a = computeDelta cmp update ll MapEmpty.Instance - let splitter = - match lv with - | ValueSome lv -> update.Invoke(l.Key, lv, r.Value) - | ValueNone -> ValueNone - let b = computeDelta cmp update lr MapEmpty.Instance - - match splitter with - | ValueSome v -> MapInner.Create(a, l.Key, v, b) - | ValueNone -> MapInner.Join(a, b) - | :? MapInner<'Key, 'Value> as r -> - if l.Count > r.Count then - let struct(rl, rr, rv) = r.SplitV(cmp, l.Key) - let a = computeDelta cmp update l.Left rl - let splitter = - match rv with - | ValueSome rv -> update.Invoke(l.Key, l.Value, rv) - | ValueNone -> ValueNone - let b = computeDelta cmp update l.Right rr - match splitter with - | ValueSome v -> MapInner.Create(a, l.Key, v, b) - | ValueNone -> MapInner.Join(a, b) - else - let struct(ll, lr, lv) = l.SplitV(cmp, r.Key) - let a = computeDelta cmp update ll r.Left - let splitter = - match lv with - | ValueSome lv -> update.Invoke(r.Key, lv, r.Value) - | ValueNone -> ValueNone - let b = computeDelta cmp update lr r.Right - match splitter with - | ValueSome v -> MapInner.Create(a, r.Key, v, b) - | ValueNone -> MapInner.Join(a, b) - | _ -> - remove cmp l - | _ -> - add cmp r - - let cmp = defaultComparer - let update = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt update - - Map(cmp, computeDelta cmp update l.Root r.Root) - - member x.Add(key : 'Key, value : 'Value) = Map(comparer, root.Add(comparer, key, value)) - - member x.AddMatch(key : 'Key, value : 'Value) = - let rec add (cmp : IComparer<'Key>) (key : 'Key) (value : 'Value) (n : MapNode<'Key, 'Value>) = - match n with - | :? MapLeaf<'Key, 'Value> as n -> - let c = cmp.Compare(key, n.Key) - if c > 0 then - MapInner(n, key, value, MapEmpty.Instance) :> MapNode<_,_> - elif c < 0 then - MapInner(MapEmpty.Instance, key, value, n) :> MapNode<_,_> - else - MapLeaf(key, value) :> MapNode<_,_> - | :? MapInner<'Key, 'Value> as n -> - let c = cmp.Compare(key, n.Key) - if c > 0 then - MapInner.Create( - n.Left, - n.Key, n.Value, - add cmp key value n.Right - ) - elif c < 0 then - MapInner.Create( - add cmp key value n.Left, - n.Key, n.Value, - n.Right - ) - else - MapInner( - n.Left, - key, value, - n.Right - ) :> MapNode<_,_> - | _ -> - MapLeaf(key, value) :> MapNode<_,_> - - Map(comparer, add comparer key value root) - + member x.Remove(key : 'Key) = Map(comparer, root.Remove(comparer, key)) - - member x.RemoveMatch(key : 'Key) = - - let rec remove (cmp : IComparer<'Key>) (key : 'Key) (n : MapNode<'Key, 'Value>) = - match n with - | :? MapLeaf<'Key, 'Value> as n -> - let c = cmp.Compare(key, n.Key) - if c = 0 then MapEmpty.Instance - else n :> MapNode<_,_> - | :? MapInner<'Key, 'Value> as n -> - let c = cmp.Compare(key, n.Key) - if c > 0 then - MapInner.Create( - n.Left, - n.Key, n.Value, - remove cmp key n.Right - ) - elif c < 0 then - MapInner.Create( - remove cmp key n.Left, - n.Key, n.Value, - n.Right - ) - else - MapInner.Join(n.Left, n.Right) - | _ -> - MapEmpty.Instance - - Map(comparer, remove comparer key root) member x.Iter(action : 'Key -> 'Value -> unit) = let action = OptimizedClosures.FSharpFunc<_,_,_>.Adapt action @@ -1812,10 +1066,6 @@ type Map< [] 'Key, [.Adapt mapping Map(comparer, root.Choose(mapping)) - member x.ChooseV(mapping : 'Key -> 'Value -> voption<'T>) = - let mapping = OptimizedClosures.FSharpFunc<_,_,_>.Adapt mapping - Map(comparer, root.ChooseV(mapping)) - member x.Exists(predicate : 'Key -> 'Value -> bool) = let predicate = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate let rec exists (predicate : OptimizedClosures.FSharpFunc<_,_,_>) (n : MapNode<_,_>) = @@ -1875,6 +1125,22 @@ type Map< [] 'Key, [) key (n : MapNode<_,_>) = + match n with + | :? MapInner<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c > 0 then tryFind cmp key n.Right + elif c < 0 then tryFind cmp key n.Left + else ValueSome n.Value + | :? MapLeaf<'Key, 'Value> as n -> + let c = cmp.Compare(key, n.Key) + if c = 0 then ValueSome n.Value + else ValueNone + | _ -> + ValueNone + tryFind comparer key root member x.TryFind(key : 'Key) = let rec tryFind (cmp : IComparer<_>) key (n : MapNode<_,_>) = @@ -1907,27 +1173,10 @@ type Map< [] 'Key, [ raise <| KeyNotFoundException() run comparer key root - member x.Item with get(key : 'Key) : 'Value = x.Find key - member x.TryFindV(key : 'Key) = - let rec tryFind (cmp : IComparer<_>) key (n : MapNode<_,_>) = - match n with - | :? MapInner<'Key, 'Value> as n -> - let c = cmp.Compare(key, n.Key) - if c > 0 then tryFind cmp key n.Right - elif c < 0 then tryFind cmp key n.Left - else ValueSome n.Value - | :? MapLeaf<'Key, 'Value> as n -> - let c = cmp.Compare(key, n.Key) - if c = 0 then ValueSome n.Value - else ValueNone - | _ -> - ValueNone - tryFind comparer key root - member x.TryFindKey(predicate : 'Key -> 'Value -> bool) = let rec run (predicate : OptimizedClosures.FSharpFunc<'Key, 'Value, bool>) (node : MapNode<'Key, 'Value>) = match node with @@ -1945,7 +1194,7 @@ type Map< [] 'Key, [.Adapt predicate) root - member x.TryFindKeyV(predicate : 'Key -> 'Value -> bool) = + member private x.TryFindKeyV(predicate : 'Key -> 'Value -> bool) = let rec run (predicate : OptimizedClosures.FSharpFunc<'Key, 'Value, bool>) (node : MapNode<'Key, 'Value>) = match node with | :? MapLeaf<'Key, 'Value> as l -> @@ -1961,7 +1210,7 @@ type Map< [] 'Key, [ ValueNone run (OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate) root - + member x.FindKey(predicate : 'Key -> 'Value -> bool) = match x.TryFindKeyV predicate with | ValueSome k -> k @@ -1984,67 +1233,29 @@ type Map< [] 'Key, [ None run (OptimizedClosures.FSharpFunc<_,_,_>.Adapt mapping) root - - //member x.Keys() = - // let rec run (n : MapNode<'Key, 'Value>) = - // match n with - // | :? MapInner<'Key, 'Value> as n -> - // SetNewImplementation.SetInner( - // run n.Left, - // n.Key, - // run n.Right - // ) :> SetNewImplementation.SetNode<_> - // | :? MapLeaf<'Key, 'Value> as n -> - // SetNewImplementation.SetLeaf(n.Key) :> SetNewImplementation.SetNode<_> - // | _ -> - // SetNewImplementation.SetEmpty.Instance - // SetNew(comparer, run root) - - member x.TryPickV(mapping : 'Key -> 'Value -> voption<'T>) = - let rec run (mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, voption<'T>>) (node : MapNode<'Key, 'Value>) = - match node with - | :? MapLeaf<'Key, 'Value> as l -> - mapping.Invoke(l.Key, l.Value) - - | :? MapInner<'Key, 'Value> as n -> - match run mapping n.Left with - | ValueNone -> - match mapping.Invoke(n.Key, n.Value) with - | ValueSome _ as res -> res - | ValueNone -> run mapping n.Right - | res -> - res - | _ -> - ValueNone - run (OptimizedClosures.FSharpFunc<_,_,_>.Adapt mapping) root - + member x.Pick(mapping : 'Key -> 'Value -> option<'T>) = match x.TryPick mapping with | Some k -> k | None -> raise <| KeyNotFoundException() - - member x.PickV(mapping : 'Key -> 'Value -> voption<'T>) = - match x.TryPickV mapping with - | ValueSome k -> k - | ValueNone -> raise <| KeyNotFoundException() - + member x.Partition(predicate : 'Key -> 'Value -> bool) = let predicate = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate let cnt = x.Count let a0 = Array.zeroCreate cnt let a1 = Array.zeroCreate cnt - x.CopyToV(a0, 0) + x.CopyToKeyValue(a0, 0) let mutable i1 = 0 let mutable i0 = 0 for i in 0 .. cnt - 1 do - let struct(k,v) = a0.[i] + let (KeyValue(k,v)) = a0.[i] if predicate.Invoke(k, v) then - a0.[i0] <- struct(k,v) + a0.[i0] <- KeyValuePair(k,v) i0 <- i0 + 1 else - a1.[i1] <- struct(k,v) + a1.[i1] <- KeyValuePair(k,v) i1 <- i1 + 1 Map.CreateTree(comparer, a0, i0), Map.CreateTree(comparer, a1, i1) @@ -2079,17 +1290,6 @@ type Map< [] 'Key, [) = - match n with - | :? MapInner<'Key, 'Value> as n -> - toList (struct(n.Key, n.Value) :: toList acc n.Right) n.Left - | :? MapLeaf<'Key, 'Value> as n -> - struct(n.Key, n.Value) :: acc - | _ -> - acc - toList [] root - member x.ToArray() = let arr = Array.zeroCreate x.Count let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = @@ -2107,23 +1307,6 @@ type Map< [] 'Key, [ ignore arr - member x.ToArrayV() = - let arr = Array.zeroCreate x.Count - let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = - match n with - | :? MapInner<'Key, 'Value> as n -> - let index = copyTo arr index n.Left - arr.[index] <- struct(n.Key, n.Value) - copyTo arr (index + 1) n.Right - | :? MapLeaf<'Key, 'Value> as n -> - arr.[index] <- struct(n.Key, n.Value) - index + 1 - | _ -> - index - - copyTo arr 0 root |> ignore - arr - member x.CopyTo(array : ('Key * 'Value)[], startIndex : int) = if startIndex < 0 || startIndex + x.Count > array.Length then raise <| System.IndexOutOfRangeException("Map.CopyTo") let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = @@ -2138,136 +1321,25 @@ type Map< [] 'Key, [ index copyTo array startIndex root |> ignore - - member x.CopyToV(array : struct('Key * 'Value)[], startIndex : int) = + + member x.CopyToKeyValue(array : KeyValuePair<'Key, 'Value>[], startIndex : int) = if startIndex < 0 || startIndex + x.Count > array.Length then raise <| System.IndexOutOfRangeException("Map.CopyTo") let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = match n with | :? MapInner<'Key, 'Value> as n -> let index = copyTo arr index n.Left - arr.[index] <- struct(n.Key, n.Value) + arr.[index] <- KeyValuePair(n.Key, n.Value) copyTo arr (index + 1) n.Right | :? MapLeaf<'Key, 'Value> as n -> - arr.[index] <- struct(n.Key, n.Value) + arr.[index] <- KeyValuePair(n.Key, n.Value) index + 1 | _ -> index copyTo array startIndex root |> ignore - member x.GetViewBetween(minInclusive : 'Key, maxInclusive : 'Key) = - Map(comparer, root.GetViewBetween(comparer, minInclusive, true, maxInclusive, true)) - - member x.GetSlice(min : option<'Key>, max : option<'Key>) = - match min with - | Some min -> - match max with - | Some max -> - x.GetViewBetween(min, max) - | None -> - x.WithMin min - | None -> - match max with - | Some max -> - x.WithMax max - | None -> - x - - member x.WithMin(minInclusive : 'Key) = - Map(comparer, root.WithMin(comparer, minInclusive, true)) - - member x.WithMax(maxInclusive : 'Key) = - Map(comparer, root.WithMax(comparer, maxInclusive, true)) - - member x.TryMinKeyValue() = - let rec run (node : MapNode<'Key, 'Value>) = - match node with - | :? MapLeaf<'Key, 'Value> as l -> - Some (l.Key, l.Value) - | :? MapInner<'Key, 'Value> as n -> - if n.Left.Count = 0 then Some (n.Key, n.Value) - else run n.Left - | _ -> - None - - run root - - member x.TryMinKeyValueV() = - let rec run (node : MapNode<'Key, 'Value>) = - match node with - | :? MapLeaf<'Key, 'Value> as l -> - ValueSome struct(l.Key, l.Value) - | :? MapInner<'Key, 'Value> as n -> - if n.Left.Count = 0 then ValueSome struct(n.Key, n.Value) - else run n.Left - | _ -> - ValueNone - run root - - member x.TryMaxKeyValue() = - let rec run (node : MapNode<'Key, 'Value>) = - match node with - | :? MapLeaf<'Key, 'Value> as l -> - Some (l.Key, l.Value) - | :? MapInner<'Key, 'Value> as n -> - if n.Right.Count = 0 then Some (n.Key, n.Value) - else run n.Right - | _ -> - None - - run root - - member x.TryMaxKeyValueV() = - let rec run (node : MapNode<'Key, 'Value>) = - match node with - | :? MapLeaf<'Key, 'Value> as l -> - ValueSome struct(l.Key, l.Value) - | :? MapInner<'Key, 'Value> as n -> - if n.Right.Count = 0 then ValueSome struct(n.Key, n.Value) - else run n.Right - | _ -> - ValueNone - run root - member x.Change(key : 'Key, f : option<'Value> -> option<'Value>) = Map(comparer, root.Change(comparer, key, f)) - member x.ChangeV(key : 'Key, update : voption<'Value> -> voption<'Value>) = - Map(comparer, root.ChangeV(comparer, key, update)) - - member x.TryAt(index : int) = - if index < 0 || index >= root.Count then None - else - let rec search (index : int) (node : MapNode<'Key, 'Value>) = - match node with - | :? MapLeaf<'Key, 'Value> as l -> - if index = 0 then Some(l.Key, l.Value) - else None - | :? MapInner<'Key, 'Value> as n -> - let lc = index - n.Left.Count - if lc < 0 then search index n.Left - elif lc > 0 then search (lc - 1) n.Right - else Some (n.Key, n.Value) - | _ -> - None - search index root - - member x.TryAtV(index : int) = - if index < 0 || index >= root.Count then ValueNone - else - let rec search (index : int) (node : MapNode<'Key, 'Value>) = - match node with - | :? MapLeaf<'Key, 'Value> as l -> - if index = 0 then ValueSome(struct(l.Key, l.Value)) - else ValueNone - | :? MapInner<'Key, 'Value> as n -> - let lc = index - n.Left.Count - if lc < 0 then search index n.Left - elif lc > 0 then search (lc - 1) n.Right - else ValueSome (struct(n.Key, n.Value)) - | _ -> - ValueNone - search index root - member x.CompareTo(other : Map<'Key, 'Value>) = let mutable le = x.GetEnumerator() let mutable re = other.GetEnumerator() @@ -2308,24 +1380,23 @@ type Map< [] 'Key, [ "map []" | [KeyValue h1] -> - let txt1 = LanguagePrimitives.anyToStringShowingNull h1 + let txt1 = string h1 StringBuilder().Append("map [").Append(txt1).Append("]").ToString() | [KeyValue h1; KeyValue h2] -> - let txt1 = LanguagePrimitives.anyToStringShowingNull h1 - let txt2 = LanguagePrimitives.anyToStringShowingNull h2 + let txt1 = string h1 + let txt2 = string h2 StringBuilder().Append("map [").Append(txt1).Append("; ").Append(txt2).Append("]").ToString() | [KeyValue h1; KeyValue h2; KeyValue h3] -> - let txt1 = LanguagePrimitives.anyToStringShowingNull h1 - let txt2 = LanguagePrimitives.anyToStringShowingNull h2 - let txt3 = LanguagePrimitives.anyToStringShowingNull h3 + let txt1 = string h1 + let txt2 = string h2 + let txt3 = string h3 StringBuilder().Append("map [").Append(txt1).Append("; ").Append(txt2).Append("; ").Append(txt3).Append("]").ToString() | KeyValue h1 :: KeyValue h2 :: KeyValue h3 :: _ -> - let txt1 = LanguagePrimitives.anyToStringShowingNull h1 - let txt2 = LanguagePrimitives.anyToStringShowingNull h2 - let txt3 = LanguagePrimitives.anyToStringShowingNull h3 + let txt1 = string h1 + let txt2 = string h2 + let txt3 = string h3 StringBuilder().Append("map [").Append(txt1).Append("; ").Append(txt2).Append("; ").Append(txt3).Append("; ... ]").ToString() - member x.TryGetValue(key : 'Key, [] value : byref<'Value>) = match x.TryFindV key with | ValueSome v -> @@ -2340,9 +1411,6 @@ type Map< [] 'Key, [ as o -> x.CompareTo o | _ -> raise <| ArgumentException() - //interface System.IComparable> with - // member x.CompareTo o = x.CompareTo o - interface System.Collections.IEnumerable with member x.GetEnumerator() = new MapEnumerator<_,_>(root) :> _ @@ -2569,15 +1637,9 @@ module Map = [] let change (key : 'Key) (f : option<'Value> -> option<'Value>) (table : Map<'Key, 'Value>) = table.Change(key, f) - [] - let changeV (key : 'Key) (update : voption<'Value> -> voption<'Value>) (map : Map<'Key, 'Value>) = map.ChangeV(key, update) - [] let tryFind (key : 'Key) (table : Map<'Key, 'Value>) = table.TryFind(key) - [] - let tryFindV (key : 'Key) (map : Map<'Key, 'Value>) = map.TryFindV(key) - [] let containsKey (key : 'Key) (table : Map<'Key, 'Value>) = table.ContainsKey(key) @@ -2590,9 +1652,6 @@ module Map = [] let choose (mapping : 'Key -> 'Value -> option<'T>) (map : Map<'Key, 'Value>) = map.Choose(mapping) - [] - let chooseV (mapping : 'Key -> 'Value -> voption<'T>) (map : Map<'Key, 'Value>) = map.ChooseV(mapping) - [] let filter (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = table.Filter(predicate) @@ -2619,81 +1678,15 @@ module Map = [] let ofArray (elements : ('Key * 'Value)[]) = Map.FromArray elements - [] - let ofSeqV (values : seq) = Map.FromSeqV values - - [] - let ofListV (values : list) = Map.FromListV values - - [] - let ofArrayV (values : struct('Key * 'Value)[]) = Map.FromArrayV values - [] let toSeq (table : Map<'Key, 'Value>) = table |> Seq.map (fun (KeyValue(k,v)) -> k, v) - [] - let toSeqV (map : Map<'Key, 'Value>) = map |> Seq.map (fun (KeyValue(k,v)) -> struct (k, v)) - [] let toList (table : Map<'Key, 'Value>) = table.ToList() - [] - let toListV (map : Map<'Key, 'Value>) = map.ToListV() - [] let toArray (table : Map<'Key, 'Value>) = table.ToArray() - [] - let toArrayV (map : Map<'Key, 'Value>) = map.ToArrayV() - - //[] - //let keys (map : Map<'Key, 'Value>) = map.Keys() - - [] - let withMin (minInclusive : 'Key) (map : Map<'Key, 'Value>) = map.WithMin(minInclusive) - - [] - let withMax (maxInclusive : 'Key) (map : Map<'Key, 'Value>) = map.WithMax(maxInclusive) - - [] - let withRange (minInclusive : 'Key) (maxInclusive : 'Key) (map : Map<'Key, 'Value>) = map.GetViewBetween(minInclusive, maxInclusive) - - [] - let union (map1 : Map<'Key, 'Value>) (map2 : Map<'Key, 'Value>) = Map.Union(map1, map2) - - [] - let unionMany (maps : #seq>) = - use e = (maps :> seq<_>).GetEnumerator() - if e.MoveNext() then - let mutable m = e.Current - while e.MoveNext() do - m <- union m e.Current - m - else - empty - - [] - let unionWith (resolve : 'Key -> 'Value -> 'Value -> 'Value) (map1 : Map<'Key, 'Value>) (map2 : Map<'Key, 'Value>) = Map.UnionWith(map1, map2, resolve) - - [] - let tryMax (map : Map<'Key, 'Value>) = map.TryMaxKeyValue() - - [] - let tryMin (map : Map<'Key, 'Value>) = map.TryMinKeyValue() - - [] - let tryMaxV (map : Map<'Key, 'Value>) = map.TryMaxKeyValueV() - - [] - let tryMinV (map : Map<'Key, 'Value>) = map.TryMinKeyValueV() - - [] - let tryAt (index : int) (map : Map<'Key, 'Value>) = map.TryAt index - - [] - let tryAtV (index : int) (map : Map<'Key, 'Value>) = - map.TryAtV index - [] let find (key : 'Key) (table : Map<'Key, 'Value>) = table.Find key @@ -2705,27 +1698,15 @@ module Map = [] let tryFindKey (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = table.TryFindKey(predicate) - - [] - let tryFindKeyV (predicate : 'Key -> 'Value -> bool) (map : Map<'Key, 'Value>) = - map.TryFindKeyV(predicate) - + [] let tryPick (chooser : 'Key -> 'Value -> option<'T>) (table : Map<'Key, 'Value>) = table.TryPick(chooser) - [] - let tryPickV (mapping : 'Key -> 'Value -> voption<'T>) (map : Map<'Key, 'Value>) = - map.TryPickV(mapping) - [] let pick (chooser : 'Key -> 'Value -> option<'T>) (table : Map<'Key, 'Value>) = table.Pick(chooser) - [] - let pickV (mapping : 'Key -> 'Value -> voption<'T>) (map : Map<'Key, 'Value>) = - map.PickV(mapping) - [] let partition (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = table.Partition(predicate) From ed55e689f4d8e10c8183d77d23e0e0c3cd7d5502 Mon Sep 17 00:00:00 2001 From: Georg Haaser Date: Wed, 23 Dec 2020 23:50:22 +0100 Subject: [PATCH 5/5] proper exception messages --- src/fsharp/FSharp.Core/map.fs | 103 ++++++++++++++++------------------ 1 file changed, 48 insertions(+), 55 deletions(-) diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index f4172908947..0a68673bed3 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -321,8 +321,8 @@ module MapImplementation = override x.Filter(_) = x :> MapNode<_,_> override x.Choose(_) = MapEmpty.Instance - override x.UnsafeRemoveHeadV() = failwith "empty" - override x.UnsafeRemoveTailV() = failwith "empty" + override x.UnsafeRemoveHeadV() = raise <| NotSupportedException "cannot remove head from empty node" + override x.UnsafeRemoveTailV() = raise <| NotSupportedException "cannot remove tail from empty node" override x.SplitV(_,_) = (x :> MapNode<_,_>, x :> MapNode<_,_>, ValueNone) @@ -454,22 +454,17 @@ module MapImplementation = r.Right ) else - // right left case - match r.Left with - | :? MapInner<'Key, 'Value> as rl -> - //let rl = r.Left :?> MapInner<'Key, 'Value> - let t1 = l - let t2 = rl.Left - let t3 = rl.Right - let t4 = r.Right - - MapInner.Create( - MapInner.Create(t1, k, v, t2), - rl.Key, rl.Value, - MapInner.Create(t3, r.Key, r.Value, t4) - ) - | _ -> - failwith "impossible" + let rl = r.Left :?> MapInner<'Key, 'Value> // must work + let t1 = l + let t2 = rl.Left + let t3 = rl.Right + let t4 = r.Right + + MapInner.Create( + MapInner.Create(t1, k, v, t2), + rl.Key, rl.Value, + MapInner.Create(t3, r.Key, r.Value, t4) + ) elif b < -2 then @@ -483,19 +478,16 @@ module MapImplementation = ) else - match l.Right with - | :? MapInner<'Key, 'Value> as lr -> - let t1 = l.Left - let t2 = lr.Left - let t3 = lr.Right - let t4 = r - MapInner.Create( - MapInner.Create(t1, l.Key, l.Value, t2), - lr.Key, lr.Value, - MapInner.Create(t3, k, v, t4) - ) - | _ -> - failwith "impossible" + let lr = l.Right :?> MapInner<'Key, 'Value> + let t1 = l.Left + let t2 = lr.Left + let t3 = lr.Right + let t4 = r + MapInner.Create( + MapInner.Create(t1, l.Key, l.Value, t2), + lr.Key, lr.Value, + MapInner.Create(t3, k, v, t4) + ) else MapInner(l, k, v, r) :> MapNode<_,_> @@ -1169,9 +1161,9 @@ type Map< [] 'Key, [ as n -> let c = cmp.Compare(key, n.Key) if c = 0 then n.Value - else raise <| KeyNotFoundException() + else raise <| KeyNotFoundException(SR.GetString(SR.keyNotFound)) | _ -> - raise <| KeyNotFoundException() + raise <| KeyNotFoundException(SR.GetString(SR.keyNotFound)) run comparer key root member x.Item @@ -1214,7 +1206,7 @@ type Map< [] 'Key, [ 'Value -> bool) = match x.TryFindKeyV predicate with | ValueSome k -> k - | ValueNone -> raise <| KeyNotFoundException() + | ValueNone -> raise <| KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt)) member x.TryPick(mapping : 'Key -> 'Value -> option<'T>) = let rec run (mapping : OptimizedClosures.FSharpFunc<'Key, 'Value, option<'T>>) (node : MapNode<'Key, 'Value>) = @@ -1237,7 +1229,7 @@ type Map< [] 'Key, [ 'Value -> option<'T>) = match x.TryPick mapping with | Some k -> k - | None -> raise <| KeyNotFoundException() + | None -> raise <| KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt)) member x.Partition(predicate : 'Key -> 'Value -> bool) = let predicate = OptimizedClosures.FSharpFunc<_,_,_>.Adapt predicate @@ -1406,10 +1398,10 @@ type Map< [] 'Key, [ as o -> x.CompareTo o - | _ -> raise <| ArgumentException() + | _ -> invalidArg "obj" (SR.GetString(SR.notComparable)) interface System.Collections.IEnumerable with member x.GetEnumerator() = new MapEnumerator<_,_>(root) :> _ @@ -1420,15 +1412,15 @@ type Map< [] 'Key, [> with member x.Count = x.Count member x.IsReadOnly = true - member x.Clear() = raise <| NotSupportedException() - member x.Add(_) = raise <| NotSupportedException() - member x.Remove(_) = raise <| NotSupportedException() + member x.Clear() = raise <| NotSupportedException(SR.GetString(SR.mapCannotBeMutated)) + member x.Add(_) = raise <| NotSupportedException(SR.GetString(SR.mapCannotBeMutated)) + member x.Remove(_) = raise <| NotSupportedException(SR.GetString(SR.mapCannotBeMutated)) member x.Contains(kvp : KeyValuePair<'Key, 'Value>) = match x.TryFindV kvp.Key with | ValueSome v -> Unchecked.equals v kvp.Value | ValueNone -> false member x.CopyTo(array : KeyValuePair<'Key, 'Value>[], startIndex : int) = - if startIndex < 0 || startIndex + x.Count > array.Length then raise <| System.IndexOutOfRangeException("Map.CopyTo") + if startIndex < 0 || startIndex + x.Count > array.Length then raise <| System.IndexOutOfRangeException() let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = match n with | :? MapInner<'Key, 'Value> as n -> @@ -1457,8 +1449,8 @@ type Map< [] 'Key, [ with member x.TryGetValue(key : 'Key, [] value : byref<'Value>) = x.TryGetValue(key, &value) - member x.Add(_,_) = raise <| NotSupportedException() - member x.Remove(_) = raise <| NotSupportedException() + member x.Add(_,_) = raise <| NotSupportedException(SR.GetString(SR.mapCannotBeMutated)) + member x.Remove(_) = raise <| NotSupportedException(SR.GetString(SR.mapCannotBeMutated)) member x.Keys = let rec copyTo (arr : array<_>) (index : int) (n : MapNode<_,_>) = @@ -1497,7 +1489,7 @@ type Map< [] 'Key, [) = Map<'Key, 'Value>(comparer, MapEmpty.Instance) @@ -1512,23 +1504,24 @@ and [] val mutable public Root : MapNode<'Key, 'Value> val mutable public Stack : list * bool)> val mutable public Value : KeyValuePair<'Key, 'Value> - val mutable public Valid : bool + val mutable public Valid : int member x.Current : KeyValuePair<'Key, 'Value> = - if x.Valid then x.Value - else raise <| InvalidOperationException() + if x.Valid = 0 then x.Value + elif x.Valid = -1 then raise <| InvalidOperationException(SR.GetString(SR.enumerationNotStarted)) + else raise <| InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished)) member x.Reset() = if x.Root.Height > 0 then x.Stack <- [struct(x.Root, true)] x.Value <- Unchecked.defaultof<_> - x.Valid <- false + x.Valid <- -1 member x.Dispose() = x.Root <- MapEmpty.Instance x.Stack <- [] x.Value <- Unchecked.defaultof<_> - x.Valid <- false + x.Valid <- -1 member inline private x.MoveNext(deep : bool, top : MapNode<'Key, 'Value>) = let mutable top = top @@ -1555,7 +1548,7 @@ and [] run <- false | _ -> - failwith "empty node" + raise <| InvalidOperationException "empty node on stack" member x.MoveNext() : bool = @@ -1563,10 +1556,10 @@ and [] | struct(n, deep) :: rest -> x.Stack <- rest x.MoveNext(deep, n) - x.Valid <- true + x.Valid <- 0 true | [] -> - x.Valid <- false + x.Valid <- -2 false @@ -1584,14 +1577,14 @@ and [] new(r : MapNode<'Key, 'Value>) = if r.Height = 0 then { - Valid = false + Valid = -1 Root = r Stack = [] Value = Unchecked.defaultof<_> } else { - Valid = false + Valid = -1 Root = r Stack = [struct(r, true)] Value = Unchecked.defaultof<_>