@@ -148,24 +148,44 @@ ensureBlackRoot t =
148{-| Insert a key-value pair into a dictionary. Replaces value when there is
148{-| Insert a key-value pair into a dictionary. Replaces value when there is
149a collision. -}
149a collision. -}
150insert : comparable -> v -> Dict comparable v -> Dict comparable v
150insert : comparable -> v -> Dict comparable v -> Dict comparable v
151−insert k v t = let updater _ = v
151+insert k v t = let u _ = Just v in
152− in update k updater t
152+ update k u t
154−{-| Update the value of a dictionary for a specific key with a given function. -}
154+{-| Remove a key-value pair from a dictionary. If the key is not found,
155+no changes are made. -}
155−update : comparable -> (Maybe v -> v) -> Dict comparable v -> Dict comparable v
156+remove : comparable -> Dict comparable v -> Dict comparable v
156−update k u t = -- Invariant: t is a valid left-leaning rb tree
157+remove k t = let u _ = Nothing in
157− let up t =
158+ update k u t
159− -- Insert case
160+data Flag = Insert | Remove | Same
160− RBEmpty LBlack -> RBNode Red k (u Nothing) (RBEmpty LBlack) (RBEmpty LBlack)
161− RBNode c k' v' l r ->
162− let h = case Native.Utils.compare k k' of
163− LT -> RBNode c k' v' (up l) r
164− EQ -> RBNode c k' (u (Just v')) l r -- update case
165− GT -> RBNode c k' v' l (up r)
167− in ensureBlackRoot (up t)
162+{-| Update the value of a dictionary for a specific key with a given function. -}
163+update : comparable -> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v
165+ let up t = case t of
166+ RBEmpty LBlack -> case u Nothing of
167+ Nothing -> (Same, empty)
168+ Just v -> (Insert, RBNode Red k v empty empty)
169+ RBNode c k' v l r -> case Native.Utils.compare k k' of
170+ EQ -> case u (Just v) of
171+ Nothing -> (Remove, rem t)
172+ Just v' -> (Same, RBNode c k' v' l r)
173+ LT -> let (fl, l') = up l in
175+ Same -> (Same, RBNode c k' v l' r)
176+ Insert -> (Insert, fixUp <| RBNode c k' v l' r)
177+ Remove -> (Remove, bubble c k' v l' r)
178+ GT -> let (fl, r') = up r in
180+ Same -> (Same, RBNode c k' v l r')
181+ Insert -> (Insert, fixUp <| RBNode c k' v l r')
182+ Remove -> (Remove, bubble c k' v l r')
186+ Insert -> ensureBlackRoot t'
187+ Remove -> blacken t'
169{-| Create a dictionary with one key-value pair. -}
189{-| Create a dictionary with one key-value pair. -}
170singleton : comparable -> v -> Dict comparable v
190singleton : comparable -> v -> Dict comparable v
171singleton k v = insert k v (RBEmpty LBlack)
191singleton k v = insert k v (RBEmpty LBlack)
@@ -204,15 +224,6 @@ lessBlackTree t = case t of
204 RBNode c k v l r -> RBNode (lessBlack c) k v l r
224 RBNode c k v l r -> RBNode (lessBlack c) k v l r
205 RBEmpty _ -> RBEmpty LBlack
225 RBEmpty _ -> RBEmpty LBlack
207−-- Finds and deletes k in t
208−del : comparable -> Dict comparable v -> Dict comparable v
211− RBNode c k' v l r -> case Native.Utils.compare k k' of
212− LT -> bubble c k' v (del k l) r
214− GT -> bubble c k' v l (del k r)
216-- Remove the top node from the tree, may leave behind BBlacks
227-- Remove the top node from the tree, may leave behind BBlacks
217rem : Dict k v -> Dict k v
228rem : Dict k v -> Dict k v
218rem t = case t of
229rem t = case t of
@@ -292,11 +303,6 @@ redden t = case t of
292 RBEmpty _ -> Native.Error.raise "can't make a Leaf red"
303 RBEmpty _ -> Native.Error.raise "can't make a Leaf red"
293 RBNode _ k v l r -> RBNode Red k v l r
304 RBNode _ k v l r -> RBNode Red k v l r
295−{-| Remove a key-value pair from a dictionary. If the key is not found,
296−no changes are made. -}
297−remove : comparable -> Dict comparable v -> Dict comparable v
298−remove k t = blacken <| del k t
300{-| Apply a function to all values in a dictionary. -}
306{-| Apply a function to all values in a dictionary. -}
301map : (a -> b) -> Dict comparable a -> Dict comparable b
307map : (a -> b) -> Dict comparable a -> Dict comparable b