diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index c0f28b9715a..0a68673bed3 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -2,896 +2,1705 @@ 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 - -[] -[] -type internal MapTree<'Key, 'Value>(k: 'Key, v: 'Value) = - member _.Key = k - member _.Value = v - -[] -[] -[] -type internal MapTreeNode<'Key, 'Value>(k:'Key, v:'Value, left:MapTree<'Key, 'Value>, right: MapTree<'Key, 'Value>, h: int) = - inherit MapTree<'Key,'Value>(k, v) - - member _.Left = left - member _.Right = right - member _.Height = h - -[] -module MapTree = - - let empty = null - - let inline isEmpty (m:MapTree<'Key, 'Value>) = isNull m +open Microsoft.FSharp.Core.Operators +open Microsoft.FSharp.Collections +open System.Runtime.InteropServices + +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 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 - 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> + // 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 : 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 + + 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 : 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 (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 (KeyValue(k,v)) = src.[li] + append k v + li <- li + 1 + + while ri < re do + let (KeyValue(k,v)) = src.[ri] + append k v + ri <- ri + 1 + + oi - 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) + // 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 - mk t1'.Left t1'.Key t1'.Value (mk t1'.Right k v t2) - else mk t1 k v t2 + src.[i0] <- KeyValuePair(kb, vb) + src.[i1] <- KeyValuePair(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) + + + [] + 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 Remove : comparer : IComparer<'Key> * key : 'Key -> MapNode<'Key, 'Value> + abstract member AddInPlace : comparer : IComparer<'Key> * key : 'Key * value : 'Value -> MapNode<'Key, '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 UnsafeRemoveHeadV : unit -> struct('Key * 'Value * MapNode<'Key, 'Value>) + abstract member UnsafeRemoveTailV : unit -> struct(MapNode<'Key, 'Value> * 'Key * 'Value) + abstract member SplitV : comparer : IComparer<'Key> * key : 'Key -> struct(MapNode<'Key, 'Value> * MapNode<'Key, 'Value> * voption<'Value>) + + + 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.AddInPlace(_, 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.Remove(_,_) = + x :> 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 - None + override x.Map(_) = MapEmpty.Instance + override x.Filter(_) = x :> MapNode<_,_> + override x.Choose(_) = MapEmpty.Instance - 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.UnsafeRemoveHeadV() = raise <| NotSupportedException "cannot remove head from empty node" + override x.UnsafeRemoveTailV() = raise <| NotSupportedException "cannot remove tail from empty node" - 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.SplitV(_,_) = + (x :> MapNode<_,_>, x :> MapNode<_,_>, ValueNone) - let partition (comparer: IComparer<'Key>) f m = - partitionAux comparer (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m (empty, empty) + override x.Change(_comparer, key, update) = + match update None with + | None -> x :> MapNode<_,_> + | Some v -> MapLeaf(key, v) :> MapNode<_,_> - let filter1 (comparer: IComparer<'Key>) (f: OptimizedClosures.FSharpFunc<_, _, _>) k v acc = - if f.Invoke (k, v) then add comparer k v acc else acc + and [] + MapLeaf<'Key, 'Value> = + class + inherit MapNode<'Key, 'Value> + val mutable public Key : 'Key + val mutable public Value : 'Value - 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.Height = + 1 - 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> - 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) + 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 - match u None with - | None -> m - | Some v -> MapTreeNode (k, v, m, empty, 2) :> MapTree<'Key,'Value> + MapLeaf(key, value) :> MapNode<'Key,'Value> - let rec mem (comparer: IComparer<'Key>) k (m: MapTree<'Key, 'Value>) = - if isEmpty m then false - else - let c = comparer.Compare(k, m.Key) - match m with - | :? MapTreeNode<'Key, 'Value> as mn -> - 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.AddInPlace(comparer, key, value) = + let c = comparer.Compare(key, x.Key) - let iter f m = - iterOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m + 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.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.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 + + 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 + + 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.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 + + 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 + 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 + 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 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) + else + 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) + ) - let exists f m = - existsOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m + 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) - 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.Count = + x._Count - let forall f m = - forallOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt f) m + 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.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.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.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 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 + 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.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) + + 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) + + 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 - if comparer.Compare(lo, hi) = 1 then x else foldFromTo f m x + + 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 - let foldSection (comparer: IComparer<'Key>) lo hi f m x = - foldSectionOpt comparer lo hi (OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt f) m x + hash 0 n - 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) + let rec equals (cmp : IComparer<'K>) (l : MapNode<'K,'V>) (r : MapNode<'K,'V>) = + if l.Count <> r.Count then + false 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" + // 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 | _ -> - i.stack <- collapseLHS rest - not i.stack.IsEmpty - else - i.started <- true (* The first call to MoveNext "starts" the enumeration. *) - not i.stack.IsEmpty - - let mkIEnumerator m = - let mutable i = mkIterator m - { new IEnumerator<_> with - member _.Current = current i - - interface System.Collections.IEnumerator with - member _.Current = box (current i) - member _.MoveNext() = moveNext i - member _.Reset() = i <- mkIterator m + false + | _ -> + true - interface System.IDisposable with - member _.Dispose() = ()} +open MapImplementation -[>)>] -[] -[] -[] +[] +[] [] -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) + // helper for serialization + 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 + + // helper for deserialization + static let fromArray (elements : KeyValuePair<'Key, 'Value>[]) = + let cmp = defaultComparer + match elements.Length with + | 0 -> + MapEmpty.Instance + | 1 -> + let (KeyValue(k,v)) = elements.[0] + MapLeaf(k, v) :> MapNode<_,_> + | 2 -> + 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 (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 (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 (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 + Map.CreateRoot(arr, cnt) [] - member _.OnSerializing(context: System.Runtime.Serialization.StreamingContext) = + 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) = + 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 |> 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) - - 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))) - - // REVIEW: this implementation could avoid copying the Values to an array - member m.Keys = ([| for kvp in m -> kvp.Key |] :> ICollection<'Key>) + static member Empty = empty - // REVIEW: this implementation could avoid copying the Values to an array - member m.Values = ([| for kvp in m -> kvp.Value |] :> ICollection<'Value>) - - member m.Add(k, v) = ignore(k, v); raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) - - member m.ContainsKey k = m.ContainsKey k - - member m.TryGetValue(k, r) = m.TryGetValue(k, &r) - - member m.Remove(k : 'Key) = ignore k; (raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) : bool) - - interface ICollection> with - member _.Add x = ignore x; raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) - - member _.Clear() = raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) - - member _.Remove x = ignore x; raise (NotSupportedException(SR.GetString(SR.mapCannotBeMutated))) - - member m.Contains x = m.ContainsKey x.Key && Unchecked.equals m.[x.Key] x.Value - - member _.CopyTo(arr, i) = MapTree.copyToArray tree arr i - - member _.IsReadOnly = true - - member m.Count = m.Count + 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 kvp = arr.[l] + MapLeaf(kvp.Key, kvp.Value) :> MapNode<_,_> + elif l > r then + MapEmpty.Instance + else + let m = (l+r)/2 + let kvp = arr.[m] + MapInner( + create arr l (m-1), + kvp.Key, kvp.Value, + create arr (m+1) r + ) :> MapNode<_,_> + + 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 (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 + | 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 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 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)) - 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)) + else + Map(cmp, MapEmpty.Instance) + + member x.Count = root.Count + member x.IsEmpty = root.Count = 0 + member x.Root = root + member x.Comparer = comparer + + member x.Add(key : 'Key, value : 'Value) = + Map(comparer, root.Add(comparer, key, value)) + + member x.Remove(key : 'Key) = + Map(comparer, root.Remove(comparer, key)) + + 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 IReadOnlyCollection> with - member m.Count = m.Count + 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.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 - interface IReadOnlyDictionary<'Key, 'Value> with + 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 + + foldBack folder seed root + + member private 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.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(SR.GetString(SR.keyNotFound)) + | _ -> + raise <| KeyNotFoundException(SR.GetString(SR.keyNotFound)) + run comparer key root + + member x.Item + with get(key : 'Key) : 'Value = x.Find key + + 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 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 -> + 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 m.Item with get key = m.[key] + member x.FindKey(predicate : 'Key -> 'Value -> bool) = + match x.TryFindKeyV predicate with + | ValueSome k -> k + | 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>) = + 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.Pick(mapping : 'Key -> 'Value -> option<'T>) = + match x.TryPick mapping with + | Some k -> k + | None -> raise <| KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt)) + + 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.CopyToKeyValue(a0, 0) + + let mutable i1 = 0 + let mutable i0 = 0 + for i in 0 .. cnt - 1 do + let (KeyValue(k,v)) = a0.[i] + if predicate.Invoke(k, v) then + a0.[i0] <- KeyValuePair(k,v) + i0 <- i0 + 1 + else + a1.[i1] <- KeyValuePair(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 m.Keys = seq { for kvp in m -> kvp.Key } + | _ -> + 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.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.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.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] <- 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 - member m.TryGetValue(key, value: byref<'Value>) = m.TryGetValue(key, &value) + member x.Change(key : 'Key, f : option<'Value> -> option<'Value>) = + Map(comparer, root.Change(comparer, key, f)) + + 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.Values = seq { for kvp in m -> kvp.Value } + override x.GetHashCode() = + hash root - member m.ContainsKey key = m.ContainsKey key + override x.Equals o = + match o with + | :? Map<'Key, 'Value> as o -> equals comparer root o.Root + | _ -> false - override x.ToString() = + override x.ToString() = match List.ofSeq (Seq.truncate 4 x) with | [] -> "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() -and - [] - MapDebugView<'Key, 'Value when 'Key : comparison>(v: Map<'Key, 'Value>) = + member x.TryGetValue(key : 'Key, [] value : byref<'Value>) = + match x.TryFindV key with + | ValueSome v -> + value <- v + true + | ValueNone -> + false - [] - member x.Items = - v |> Seq.truncate 10000 |> Seq.map KeyValuePairDebugFriendly |> Seq.toArray + interface System.IComparable with + member x.CompareTo obj = + match obj with + | :? Map<'Key, 'Value> as o -> x.CompareTo o + | _ -> invalidArg "obj" (SR.GetString(SR.notComparable)) + + interface System.Collections.IEnumerable with + member x.GetEnumerator() = new MapEnumerator<_,_>(root) :> _ + + 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() = 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() + 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 + + interface System.Collections.Generic.IReadOnlyDictionary<'Key, 'Value> with + member x.Item + with get(k : 'Key) = x.[k] + + 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) + + interface System.Collections.Generic.IDictionary<'Key, 'Value> with + member x.TryGetValue(key : 'Key, [] value : byref<'Value>) = x.TryGetValue(key, &value) + + 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<_,_>) = + 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 = + 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 + + member x.Item + with get (key : 'Key) = x.Find key + and set _ _ = raise <| NotSupportedException(SR.GetString(SR.mapCannotBeMutated)) + + 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> + val mutable public Valid : int + + member x.Current : KeyValuePair<'Key, 'Value> = + 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 <- -1 + + member x.Dispose() = + x.Root <- MapEmpty.Instance + x.Stack <- [] + x.Value <- Unchecked.defaultof<_> + x.Valid <- -1 + + 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 + | _ -> + raise <| InvalidOperationException "empty node on stack" + + + member x.MoveNext() : bool = + match x.Stack with + | struct(n, deep) :: rest -> + x.Stack <- rest + x.MoveNext(deep, n) + x.Valid <- 0 + true + | [] -> + x.Valid <- -2 + 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 + { + Valid = -1 + Root = r + Stack = [] + Value = Unchecked.defaultof<_> + } + else + { + Valid = -1 + 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 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 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 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 toSeq (table: Map<_, _>) = - table |> Seq.map (fun kvp -> kvp.Key, kvp.Value) - - [] - 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 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 ofList (elements: ('Key * 'Value) list) = - Map<_, _>.ofList elements + let foldBack (folder : 'Key -> 'Value -> 'State -> 'State) (table : Map<'Key, 'Value>) (state : 'State) = + table.FoldBack(folder, state) [] - let ofSeq elements = - Map<_, _>.Create elements - + let ofSeq (elements : seq<'Key * 'Value>) = Map.FromSeq elements + + [] + let ofList (elements : list<'Key * 'Value>) = Map.FromList elements + [] - let ofArray (elements: ('Key * 'Value) array) = - let comparer = LanguagePrimitives.FastGenericComparer<'Key> - new Map<_, _>(comparer, MapTree.ofArray comparer elements) + let ofArray (elements : ('Key * 'Value)[]) = Map.FromArray elements + + [] + let toSeq (table : Map<'Key, 'Value>) = table |> Seq.map (fun (KeyValue(k,v)) -> k, v) [] - let toList (table: Map<_, _>) = - table.ToList() - + let toList (table : Map<'Key, 'Value>) = table.ToList() + [] - let toArray (table: Map<_, _>) = - table.ToArray() + let toArray (table : Map<'Key, 'Value>) = table.ToArray() + + [] + 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 tryPick (chooser : 'Key -> 'Value -> option<'T>) (table : Map<'Key, 'Value>) = + table.TryPick(chooser) + + [] + let pick (chooser : 'Key -> 'Value -> option<'T>) (table : Map<'Key, 'Value>) = + table.Pick(chooser) - [] - let empty<'Key, 'Value when 'Key : comparison> = - Map<'Key, 'Value>.Empty + [] + let partition (predicate : 'Key -> 'Value -> bool) (table : Map<'Key, 'Value>) = + table.Partition(predicate) - [] - let count (table: Map<_, _>) = - table.Count