Commit 8eda0edc authored by Steffen Michels's avatar Steffen Michels

Data.Map: move comments from icl to dcl, remove unused code, export keysSet &...

Data.Map: move comments from icl to dcl, remove unused code, export keysSet & fromSet, more efficient gEq
parent c113789c
Pipeline #19442 passed with stage
in 3 minutes and 30 seconds
......@@ -75,6 +75,7 @@ from Data.GenLexOrd import generic gLexOrd, :: LexOrd
from Data.Monoid import class Monoid, class Semigroup
import qualified StdList
from Data.Functor import class Functor (..)
from Data.Set import :: Set
from StdOverloaded import class < (..)
import StdClass
......@@ -124,6 +125,7 @@ instance < (Map k v) | Ord k & Ord v
* mapSize m == 0 <==> null m
* @property equivalence with newMap: A.m :: Map k v:
* m == newMap <==> null m
* @complexity O(1)
*/
null mp :== case mp of
Tip -> True
......@@ -134,11 +136,13 @@ null mp :== case mp of
* @result An empty map
* @property is null:
* null newMap
* @complexity O(1)
*/
newMap :: w:(Map k u:v), [ w <= u]
/**
* Create a Map with one element.
* @complexity O(1)
*/
singleton :: !k !v -> Map k v
......@@ -162,6 +166,7 @@ mapSize :: !(Map k v) -> Int
* integrity m`
* where
* m` = put k v m
* @complexity O(log n)
*/
put :: !k !a !(Map k a) -> Map k a | < k
......@@ -173,6 +178,7 @@ put :: !k !a !(Map k a) -> Map k a | < k
* @param The key to look for
* @param The orginal mapping
* @result When found, the value at the key position, if not: Nothing
* @complexity O(log n)
*/
get k m :== get` k m
where
......@@ -268,9 +274,22 @@ toAscList m :== foldrWithKey (\k x xs -> [(k,x):xs]) [] m
* integrity m
* where
* m = fromList elems
* @complexity O(n*log n)
*/
fromList :: !u:[v:(!a, !b)] -> Map a b | == a & < a, [u <= v]
/**
* The keys of all keys of a map.
* @complexity log(n)
*/
keysSet :: !(Map k a) -> Set k
/**
* Build a map from a set of keys and a function which for each key computes its value.
* @complexity log(n)
*/
fromSet :: !(k -> a) !(Set k) -> Map k a
derive JSONEncode Map
derive JSONDecode Map
derive gEq Map
......@@ -280,6 +299,7 @@ derive gLexOrd Map
* Check if a key exists in a Map.
* @property correctness: A.k :: k; m :: Map k v:
* member k m <==> isMember k (keys m)
* @complexity O(log n)
*/
member :: !k !(Map k a) -> Bool | < k
......@@ -296,6 +316,7 @@ notMember k m :== not (member k m)
* Aborts when the element is not found.
* @property correctness: A.k :: k; v :: v; m :: Map k v:
* find k (put k v m) =.= v
* @complexity O(log n)
*/
find :: !k !(Map k a) -> a | < k
......@@ -309,6 +330,7 @@ find :: !k !(Map k a) -> a | < k
* findWithDefault default k (put k v m) =.= v /\
* findWithDefault default k (del k m) =.= default
* where default = gDefault{|*|}
* @complexity O(log n)
*/
findWithDefault :: !a !k !(Map k a) -> a | < k
......@@ -322,6 +344,7 @@ findWithDefault :: !a !k !(Map k a) -> a | < k
* case [k \\ (k,v`) <- toList m | v == v`] of
* [] -> findKey v m =.= Nothing
* [k:_] -> findKey v m =.= Just k
* @complexity O(n)
*/
findKey :: !a !(Map k a) -> Maybe k | == a
......@@ -334,6 +357,7 @@ findKey :: !a !(Map k a) -> Maybe k | == a
* case [k \\ (k,v) <- toList m | pred p v] of
* [] -> findKeyWith (pred p) m =.= Nothing
* [k:_] -> findKeyWith (pred p) m =.= Just k
* @complexity O(n)
*/
findKeyWith :: !(a -> Bool) !(Map k a) -> Maybe k
......@@ -348,6 +372,7 @@ findKeyWith :: !(a -> Bool) !(Map k a) -> Maybe k
* Nothing -> findKeyWithDefault default v m =.= default
* Just k -> findKeyWithDefault default v m =.= k
* where default = gDefault{|*|}
* @complexity O(n)
*/
findKeyWithDefault :: !k !a !(Map k a) -> k | == a
......@@ -362,6 +387,7 @@ findKeyWithDefault :: !k !a !(Map k a) -> k | == a
* Nothing -> findKeyWithDefaultWith (pred p) default m =.= default
* Just k -> findKeyWithDefaultWith (pred p) default m =.= k
* where default = gDefault{|*|}
* @complexity O(n)
*/
findKeyWithDefaultWith :: !(a -> Bool) !k !(Map k a) -> k
......
implementation module Data.Map
import StdClass
import StdBool
import StdFunctions
import StdOverloaded
import StdMisc
import StdInt
import StdString
import StdTuple
import StdEnv
import Data.Either
import Data.GenLexOrd
import Data.Maybe
......@@ -24,48 +16,18 @@ from Data.Set import :: Set
// Ported from Haskell`s Data.Map by Jurriën Stutterheim, 10-09-2014
////////////////////////////////////////////////////////////////////
// Size balanced trees.
////////////////////////////////////////////////////////////////////
// | A Map from keys @k@ to values @a@.
// TODO
instance Semigroup (Map k v) | < k where
mappend x y = union x y
instance Monoid (Map k v) | < k where
mempty = newMap
//////////////////////////////////////////////////////////////////////
// Query
//////////////////////////////////////////////////////////////////////
// | /O(1)/. Is the map newMap?
//
// > Data.Map.null (newMap) == True
// > Data.Map.null (singleton 1 'a`) == False
//null :: !(Map k a) -> Bool
//null Tip = True
//null _ = False
// | /O(1)/. The number of elements in the map.
//
// > mapSize newMap == 0
// > mapSize (singleton 1 'a`) == 1
// > mapSize (fromList([(1,'a`), (2,'c'), (3,'b`)])) == 3
mapSize :: !(Map k a) -> Int
mapSize Tip = 0
mapSize (Bin sz _ _ _ _) = sz
//lexOrd :: !a !a -> LexOrd | < a
lexOrd x y :== if (x < y) LT (if (x > y) GT EQ)
// | /O(log n)/. Is the key a member of the map? See also 'notMember`.
//
// > member 5 (fromList [(5,'a`), (3,'b`)]) == True
// > member 1 (fromList [(5,'a`), (3,'b`)]) == False
member :: !k !(Map k a) -> Bool | < k
member _ Tip = False
member k (Bin _ kx _ l r) = if (k < kx)
......@@ -74,15 +36,6 @@ member k (Bin _ kx _ l r) = if (k < kx)
(member k r)
True)
// | /O(log n)/. Is the key not a member of the map? See also 'member`.
//
// > notMember 5 (fromList [(5,'a`), (3,'b`)]) == False
// > notMember 1 (fromList [(5,'a`), (3,'b`)]) == True
//notMember :: !k !(Map k a) -> Bool | < k
// | /O(log n)/. Find the value at a key.
// Calls 'abort` when the element can not be found.
find :: !k !(Map k a) -> a | < k
find _ Tip = abort "Map.!: given key is not an element in the map"
find k (Bin _ kx x l r) = if (k < kx)
......@@ -91,12 +44,6 @@ find k (Bin _ kx x l r) = if (k < kx)
(find k r)
x)
// | /O(log n)/. The expression @('findWithDefault` def k map)@ returns
// the value at key @k@ or returns default value @def@
// when the key is not in the map.
//
// > findWithDefault 'x` 1 (fromList [(5,'a`), (3,'b`)]) == 'x`
// > findWithDefault 'x` 5 (fromList [(5,'a`), (3,'b`)]) == 'a`
findWithDefault :: !a !k !(Map k a) -> a | < k
findWithDefault def _ Tip = def
findWithDefault def k (Bin _ kx x l r) = if (k < kx)
......@@ -105,25 +52,15 @@ findWithDefault def k (Bin _ kx x l r) = if (k < kx)
(findWithDefault def k r)
x)
// | /O(n)/. The expression @('findKey' a map)@ returns (Just k) if (k,a) is a member of (toList map).
// It returns Nothing in any other case.
findKey :: !a !(Map k a) -> Maybe k | == a
findKey a m = findKeyWith ((==) a) m
// | /O(n)/. The expression @('findKeyWith' select map)@ returns (Just k) if (k,a`) is a member of
// (toList map) such that (select a`) is True.
// It returns Nothing in any other case.
findKeyWith :: !(a -> Bool) !(Map k a) -> Maybe k
findKeyWith select m = listToMaybe [k` \\ (k`,v) <- toList m | select v]
// | /O(n)/. The expression @('findKeyWithDefault' k a map)@ returns k` if (k`,@a@) is a member of (toList @map@).
// It returns @k@ in any other case.
findKeyWithDefault :: !k !a !(Map k a) -> k | == a
findKeyWithDefault k a m = findKeyWithDefaultWith ((==) a) k m
// | /O(n)/. The expression @('findKeyWithDefaultWith' select k map)@ returns k` if (k`,a`) is a member of
// (toList @map@) such that (@select@ a`@) is True.
// It returns @k@ in any other case.
findKeyWithDefaultWith :: !(a -> Bool) !k !(Map k a) -> k
findKeyWithDefaultWith compare k m = fromMaybe k (findKeyWith compare m)
......@@ -215,37 +152,12 @@ getGE k m = goNothing k m
EQ -> Just (kx, x)
GT -> goJust k kx` x` r
//////////////////////////////////////////////////////////////////////
// Construction
//////////////////////////////////////////////////////////////////////
// | /O(1)/. The newMap map.
//
// > newMap == fromList []
// > mapSize newMap == 0
newMap :: w:(Map k u:v), [ w <= u]
newMap = Tip
// | /O(1)/. A map with a single element.
//
// > singleton 1 'a` == fromList [(1, 'a`)]
// > mapSize (singleton 1 'a`) == 1
singleton :: !k !a -> Map k a
singleton k x = Bin 1 k x Tip Tip
//////////////////////////////////////////////////////////////////////
// Insertion
//////////////////////////////////////////////////////////////////////
// | /O(log n)/. Insert a new key and value in the map.
// If the key is already present in the map, the associated value is
// replaced with the supplied value. 'put` is equivalent to
// @'putWith' 'const`=:.
//
// > put 5 'x` (fromList [(5,'a`), (3,'b`)]) == fromList [(3, 'b`), (5, 'x`)]
// > put 7 'x` (fromList [(5,'a`), (3,'b`)]) == fromList [(3, 'b`), (5, 'a`), (7, 'x`)]
// > put 5 'x` newMap == singleton 5 'x`
// See Note: Type of local 'go' function
put :: !k !a !(Map k a) -> Map k a | < k
put kx x Tip = singleton kx x
......@@ -304,18 +216,6 @@ putWithKey f kx x (Bin sy ky y l r) =
(balanceR ky y l (putWithKey f kx x r))
(Bin sy kx (f kx x y) l r))
//////////////////////////////////////////////////////////////////////
// Deletion
//////////////////////////////////////////////////////////////////////
// | /O(log n)/. Delete a key and its value from the map. When the key is not
// a member of the map, the original map is returned.
//
// > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
// > delete 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
// > delete 5 newMap == newMap
// See Note: Type of local 'go' function
del :: !k !(Map k a) -> Map k a | < k
del _ Tip = Tip
del k (Bin _ kx x l r) =
......@@ -1281,43 +1181,14 @@ foldMapWithKey f (Bin _ k v l r) = mappend (foldMapWithKey f l) (mappend (f k v)
assocs :: !(Map k a) -> [(!k, !a)]
assocs m = toAscList m
// | /O(n)/. The set of all keys of the map.
//
// > keysSet (fromList [(5,"a"), (3,"b")]) == Data.Set.fromList [3,5]
// > keysSet newMap == Data.Set.newMap
keysSet :: !(Map k a) -> Set k
keysSet Tip = 'Data.Set'.Tip
keysSet (Bin sz kx _ l r) = 'Data.Set'.Bin sz kx (keysSet l) (keysSet r)
// | /O(n)/. Build a map from a set of keys and a function which for each key
// computes its value.
//
// > fromSet (\k -> replicate k 'a`) (Data.Set.fromList [3, 5]) == fromList [(5,"aaaaa"), (3,"aaa")]
// > fromSet undefined Data.Set.newMap == newMap
fromSet :: !(k -> a) !(Set k) -> Map k a
fromSet _ 'Data.Set'.Tip = Tip
fromSet f ('Data.Set'.Bin sz x l r) = Bin sz x (f x) (fromSet f l) (fromSet f r)
//////////////////////////////////////////////////////////////////////
// Lists
// use [foldlStrict] to reduce demand on the control-stack
//////////////////////////////////////////////////////////////////////
// | /O(n*log n)/. Build a map from a list of key\/value pairs. See also 'fromAscList`.
// If the list contains more than one value for the same key, the last value
// for the key is retained.
//
// If the keys of the list are ordered, linear-time implementation is used,
// with the performance equal to 'fromDistinctAscList`.
//
// > fromList [] == newMap
// > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
// > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
// For some reason, when 'singleton' is used in fromList or in
// create, it is not inlined, so we inline it manually.
//fromList :: !w:[x:(!k,u:v)] -> y:(Map k u:v) | == k & < k, [x y <= u, w <= x, w <= y]
fromList :: !u:[v:(!a, !b)] -> Map a b | == a & < a, [u <= v]
fromList [] = Tip
fromList [(kx, x)] = Bin 1 kx x Tip Tip
......@@ -1925,9 +1796,6 @@ instance == (Map k a) | Eq k & Eq a where
instance < (Map k v) | Ord k & Ord v where
(<) t1 t2 = toAscList t1 < toAscList t2
////////////////////////////////////////////////////////////////////
// Functor
////////////////////////////////////////////////////////////////////
instance Functor (Map k)
where
fmap :: !(a -> b) !(Map k a) -> Map k b
......@@ -1949,9 +1817,6 @@ where
//go (Bin 1 _ v _ _) = f v
//go (Bin _ _ v l r) = mappend (go l) (mappend (f v) (go r))
////////////////////////////////////////////////////////////////////
// Show
////////////////////////////////////////////////////////////////////
instance toString (Map k a) | toString k & toString a where
toString m = "" // TODO showParen False (showString "fromList " o shows (toList m))
......@@ -2099,16 +1964,12 @@ validmapSize t
(Just n,Just m) | n+m+1 == sz -> Just sz
_ -> Nothing
////////////////////////////////////////////////////////////////////
// Utilities
////////////////////////////////////////////////////////////////////
foldlStrict :: !(a b -> a) !a ![b] -> a
foldlStrict f acc [] = acc
foldlStrict f acc [x:xs]
#! z` = f acc x
= foldlStrict f z` xs
// | /O(1)/. Decompose a map into pieces based on the structure of the underlying
// tree. This function is useful for consuming a map in parallel.
//
......@@ -2131,16 +1992,6 @@ splitRoot :: !(Map k b) -> [Map k b]
splitRoot Tip = []
splitRoot (Bin _ k v l r) = [l, singleton k v, r]
// BC funs
//putList :: !u:[v:(!a, !b)] !u:(Map a b) -> Map a b | == a & < a, [u <= v]
//delList :: ![a] !.(Map a b) -> Map a b | == a & < a
//foldlNoKey :: !(a -> b -> a) !a !(Map c b) -> a
//foldrNoKey :: !(v u:a -> u:a) !u:a !(Map k v) -> u:a
getU :: !k !w:(Map k v) -> x:(!Maybe v, !y:(Map k v)) | == k & < k, [ x <= y, w <= y]
getU k Tip = (Nothing, Tip)
getU k (Bin h nk nv left right)
......@@ -2152,10 +2003,7 @@ getU k (Bin h nk nv left right)
#! (mbv, right) = getU k right
= (mbv, Bin h nk nv left right)
//:: Map k a
//= Bin !Size !k a !(Map k a) !(Map k a)
//| Tip
delU :: !a !.(Map a b) -> u:(!v:(Maybe b), !Map a b) | == a & < a, [u <= v] // !k !w:(Map k u:v) -> x:(Maybe u:v, !y:(Map k u:v)) | == k & < k, [ w y <= u, x <= y, w <= y]
delU :: !a !.(Map a b) -> u:(!v:(Maybe b), !Map a b) | == a & < a, [u <= v]
delU k Tip = (Nothing, Tip) //Do nothing
delU k (Bin h nk nv Tip Tip) //A node with just leaves as children can be safely removed
| k == nk = (Just nv, Tip)
......@@ -2212,349 +2060,9 @@ height :: !u:(Map k w:v) -> x:(!Int, !y:(Map k w:v)), [u y <= w, x <= y, u <= y]
height Tip = (0, Tip)
height (Bin h k v left right) = (h, Bin h k v left right)
/*
gLessThan x y = (gLexOrd{|*|} x y) == LT
singleton :: k v -> Map k v | Eq k & gLexOrd{|*|} k
singleton k v = put k v newMap
newMap :: (Map k v) -> Bool
newMap MLeaf = True
newMap _ = False
mapSize :: (Map k v) -> Int
mapSize MLeaf = 0
mapSize (MNode left _ _ _ right) = 1 + mapSize left + mapSize right
//Insert function
put :: !k u:v !w:(Map k u:v) -> x:(Map k u:v) | Eq k & gLexOrd{|*|} k, [w x <= u, w <= x]
put k v MLeaf = MNode MLeaf k 1 v MLeaf
put k v (MNode left nk h nv right)
| k == nk = (MNode left k h v right)
| k < nk
# left = put k v left
= update left nk nv right
| otherwise
# right = put k v right
= update left nk nv right
where
update left nk nv right
# (hleft,left) = height left
# (hright,right) = height right
# h = (max hleft hright) + 1
= balance (MNode left nk h nv right)
gPut :: !k u:v !w:(Map k u:v) -> x:(Map k u:v) | == k & gLexOrd{|*|} k, [w x <= u, w <= x]
gPut k v MLeaf = MNode MLeaf k 1 v MLeaf
gPut k v (MNode left nk h nv right)
| k === nk = (MNode left k h v right)
| gLessThan k nk
# left = gPut k v left
= update left nk nv right
| otherwise
# right = gPut k v right
= update left nk nv right
where
update left nk nv right
# (hleft,left) = height left
# (hright,right) = height right
# h = (max hleft hright) + 1
= balance (MNode left nk h nv right)
//Lookup function, non-unique version
get :: !k !(Map k v) -> Maybe v | Eq k & gLexOrd{|*|} k
get k MLeaf = Nothing
get k (MNode left nk _ nv right)
| k == nk = Just nv
| k < nk = get k left
= get k right
gGet :: !k !(Map k v) -> Maybe v | == k & gLexOrd{|*|} k
gGet k MLeaf = Nothing
gGet k (MNode left nk _ nv right)
| k === nk = Just nv
| gLessThan k nk = gGet k left
| otherwise = gGet k right
//Lookup function, possibly spine unique version
getU :: !k !w:(Map k v) -> x:(Maybe v,!y:(Map k v)) | Eq k & gLexOrd{|*|} k, [ x <= y, w <= y]
getU k MLeaf = (Nothing, MLeaf)
getU k (MNode left nk h nv right)
| k == nk = (Just nv, MNode left nk h nv right)
| k < nk
# (mbv, left) = getU k left
= (mbv, MNode left nk h nv right)
| otherwise
# (mbv, right) = getU k right
= (mbv, MNode left nk h nv right)
ggetu :: !k !w:(map k v) -> x:(maybe v,!y:(map k v)) | geq{|*|} k & glexord{|*|} k, [ x <= y, w <= y]
gGetU k MLeaf = (Nothing, MLeaf)
gGetU k (MNode left nk h nv right)
| k === nk = (Just nv, MNode left nk h nv right)
| gLessThan k nk
# (mbv, left) = gGetU k left
= (mbv, MNode left nk h nv right)
| otherwise
# (mbv, right) = gGetU k right
= (mbv, MNode left nk h nv right)
//Delete function, only spine unique version
del :: !k !w:(Map k v) -> x:(Map k v) | Eq k & gLexOrd{|*|} k, [ w <= x]
del k mapping = snd (delU k mapping)
gDel :: !k !w:(Map k v) -> x:(Map k v) | == k & gLexOrd{|*|} k, [ w <= x]
gDel k mapping = snd (gDelU k mapping)
//Delete function
delU :: !k !w:(Map k u:v) -> x:(Maybe u:v, !y:(Map k u:v)) | Eq k & gLexOrd{|*|} k, [ w y <= u, x <= y, w <= y]
delU k MLeaf = (Nothing, MLeaf) //Do nothing
delU k (MNode MLeaf nk h nv MLeaf) //A node with just leaves as children can be safely removed
| k == nk = (Just nv, MLeaf)
= (Nothing, MNode MLeaf nk h nv MLeaf)
delU k (MNode MLeaf nk h nv right) //A node without smaller items
| k == nk = (Just nv, right) //When found, just remove
| k < nk = (Nothing, MNode MLeaf nk h nv right) //Do nothing, k is not in the mapping
| otherwise
# (mbv,right) = delU k right
# (hright,right) = height right
# h = hright + 1
= (mbv, balance (MNode MLeaf nk h nv right))
delU k (MNode left nk h nv MLeaf) //A node without larger items
| k == nk = (Just nv, left) //When found just remove
| k < nk
# (mbv,left) = delU k left
# (hleft,left) = height left
# h = hleft + 1
= (mbv, balance (MNode left nk h nv MLeaf))
| otherwise
= (Nothing, MNode left nk h nv MLeaf) //Do nothing, k is not in hte mapping
delU k (MNode left nk h nv right) //A node with both larger and smaller items
| k == nk
# (left,k,v) = takeMax left
# (h,left,right) = parentHeight left right
= (Just nv, balance (MNode left k h v right)) //Replace with the largest of the smaller items and rebalance
| k < nk
# (mbv, left) = delU k left
# (h,left,right) = parentHeight left right
= (mbv, balance (MNode left nk h nv right))
| otherwise
# (mbv, right) = delU k right
# (h,left,right) = parentHeight left right
= (mbv, balance (MNode left nk h nv right))
where
//Takes the k and v values from the maximum node in the tree and removes that node
takeMax MLeaf = abort "takeMax of leaf evaluated"
takeMax (MNode left nk _ nv MLeaf) = (left, nk, nv)
takeMax (MNode left nk _ nv right)
# (right,k,v) = takeMax right
# (hleft,left) = height left
# (hright,right) = height right
# h = (max hleft hright) + 1
= (balance (MNode left nk h nv right), k, v)
//Determines the height of the parent node of two sub trees
parentHeight left right
# (hleft,left) = height left
# (hright,right) = height right
# h = (max hleft hright) + 1
= (h, left, right)
gDelU :: !k !w:(Map k u:v) -> x:(Maybe u:v, !y:(Map k u:v)) | == k & gLexOrd{|*|} k, [ w y <= u, x <= y, w <= y]
gDelU k MLeaf = (Nothing, MLeaf) //Do nothing
gDelU k (MNode MLeaf nk h nv MLeaf) //A node with just leaves as children can be safely removed
| k === nk = (Just nv, MLeaf)
| otherwise = (Nothing, MNode MLeaf nk h nv MLeaf)
gDelU k (MNode MLeaf nk h nv right) //A node without smaller items
| k === nk = (Just nv, right) //When found, just remove
| gLessThan k nk = (Nothing, MNode MLeaf nk h nv right) //Do nothing, k is not in the mapping
| otherwise
# (mbv,right) = gDelU k right
# (hright,right) = height right
# h = hright + 1
= (mbv, balance (MNode MLeaf nk h nv right))
gDelU k (MNode left nk h nv MLeaf) //A node without larger items
| k === nk = (Just nv, left) //When found just remove
| gLessThan k nk
# (mbv,left) = gDelU k left
# (hleft,left) = height left
# h = hleft + 1
= (mbv, balance (MNode left nk h nv MLeaf))
| otherwise = (Nothing, MNode left nk h nv MLeaf) //Do nothing, k is not in hte mapping
gDelU k (MNode left nk h nv right) //A node with both larger and smaller items
| k === nk
# (left,k,v) = takeMax left
# (h,left,right) = parentHeight left right
= (Just nv, balance (MNode left k h v right)) //Replace with the largest of the smaller items and rebalance
| gLessThan k nk
# (mbv, left) = gDelU k left
# (h,left,right) = parentHeight left right
= (mbv, balance (MNode left nk h nv right))
| otherwise
# (mbv, right) = gDelU k right
# (h,left,right) = parentHeight left right
= (mbv, balance (MNode left nk h nv right))
where
//Takes the k and v values from the maximum node in the tree and removes that node
takeMax MLeaf = abort "takeMax of leaf evaluated"
takeMax (MNode left nk _ nv MLeaf) = (left, nk, nv)
takeMax (MNode left nk _ nv right)
# (right,k,v) = takeMax right
# (hleft,left) = height left
# (hright,right) = height right
# h = (max hleft hright) + 1
= (balance (MNode left nk h nv right), k, v)
//Determines the height of the parent node of two sub trees
parentHeight left right
# (hleft,left) = height left
# (hright,right) = height right
# h = (max hleft hright) + 1
= (h, left, right)
foldrWithKey :: (k v u:a -> u:a) u:a (Map k v) -> u:a
foldrWithKey f z m = go z m
where
go z` MLeaf = z`
go z` (MNode l k _ v r) = go (f k v (go z` r)) l
foldrNoKey :: (v u:a -> u:a) u:a (Map k v) -> u:a
foldrNoKey f z m = go z m
where
go z` MLeaf = z`
go z` (MNode l _ _ v r) = go (f v (go z` r)) l
foldlWithKey :: (u:a k v -> u:a) u:a (Map k v) -> u:a
foldlWithKey f z m = go z m
where
go z` MLeaf = z`
go z` (MNode l k _ v r) = go (f (go z` l) k v) r
foldlNoKey :: (u:a v -> u:a) u:a (Map k v) -> u:a
foldlNoKey f z m = go z m
where
go z` MLeaf = z`
go z` (MNode l _ _ v r) = go (f (go z` l) v) r
// TODO Replace this with an efficient implementation that does not require Eq and Ord