@@ -14,6 +14,7 @@ data NColor = Red | Black
1414
1515data RBTree k v = RBNode NColor k v (RBTree k v) (RBTree k v) | RBEmpty
1616
17+empty : RBTree k v
1718empty = RBEmpty
1819
1920raise err = throw (JavaScript.castStringToJSString err)
@@ -97,6 +98,7 @@ invariants_hold t =
9798--}
9899
99100
101+min : RBTree k v -> (k,v)
100102min t =
101103 case t of
102104 RBNode _ k v RBEmpty _ -> (k,v)
@@ -112,6 +114,7 @@ max t =
112114 }
113115--}
114116
117+lookup : k -> RBTree k v -> Maybe v
115118lookup k t =
116119 case t of
117120 RBEmpty -> Nothing
@@ -121,6 +124,7 @@ lookup k t =
121124 EQ -> Just v
122125 GT -> lookup k r
123126
127+findWithDefault : v -> k -> RBTree k v -> v
124128findWithDefault base k t =
125129 case t of
126130 RBEmpty -> base
@@ -143,8 +147,10 @@ find k t =
143147--}
144148
145149-- Does t contain k?
150+member : k -> RBTree k v -> Bool
146151member k t = isJust $ lookup k t
147152
153+rotateLeft : RBTree k v -> RBTree k v
148154rotateLeft t =
149155 case t of
150156 RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c
@@ -152,16 +158,19 @@ rotateLeft t =
152158
153159-- rotateRight -- the reverse, and
154160-- makes Y have Z's color, and makes Z Red.
161+rotateRight : RBTree k v -> RBTree k v
155162rotateRight t =
156163 case t of
157164 RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)
158165 _ -> raise "rotateRight of a node without enough children"
159166
167+rotateLeftIfNeeded : RBTree k v -> RBTree k v
160168rotateLeftIfNeeded t =
161169 case t of
162170 RBNode _ _ _ _ (RBNode Red _ _ _ _) -> rotateLeft t
163171 _ -> t
164172
173+rotateRightIfNeeded : RBTree k v -> RBTree k v
165174rotateRightIfNeeded t =
166175 case t of
167176 RBNode _ _ _ (RBNode Red _ _ (RBNode Red _ _ _ _) _) _ -> rotateRight t
@@ -169,6 +178,7 @@ rotateRightIfNeeded t =
169178
170179otherColor c = case c of { Red -> Black ; Black -> Red }
171180
181+color_flip : RBTree k v -> RBTree k v
172182color_flip t =
173183 case t of
174184 RBNode c1 bk bv (RBNode c2 ak av la ra) (RBNode c3 ck cv lc rc) ->
@@ -177,6 +187,7 @@ color_flip t =
177187 (RBNode (otherColor c3) ck cv lc rc)
178188 _ -> raise "color_flip called on a RBEmpty or RBNode with a RBEmpty child"
179189
190+color_flipIfNeeded : RBTree k v -> RBTree k v
180191color_flipIfNeeded t =
181192 case t of
182193 RBNode _ _ _ (RBNode Red _ _ _ _) (RBNode Red _ _ _ _) -> color_flip t
@@ -184,13 +195,14 @@ color_flipIfNeeded t =
184195
185196fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
186197
187−
198+ensureBlackRoot : RBTree k v -> RBTree k v
188199ensureBlackRoot t =
189200 case t of
190201 RBNode Red k v l r -> RBNode Black k v l r
191202 _ -> t
192203
193204-- Invariant: t is a valid left-leaning rb tree *)
205+insert : k -> v -> RBTree k v -> RBTree k v
194206insert k v t =
195207 let ins t =
196208 case t of
@@ -211,35 +223,40 @@ insert k v t =
211223 else new_t)
212224--}
213225
226+singleton : k -> v -> RBTree k v
214227singleton k v = insert k v RBEmpty
215228
216−
229+isRed : RBTree k v -> Bool
217230isRed t =
218231 case t of
219232 RBNode Red _ _ _ _ -> True
220233 _ -> False
221234
235+isRedLeft : RBTree k v -> Bool
222236isRedLeft t =
223237 case t of
224238 RBNode _ _ _ (RBNode Red _ _ _ _) _ -> True
225239 _ -> False
226240
241+isRedLeftLeft : RBTree k v -> Bool
227242isRedLeftLeft t =
228243 case t of
229244 RBNode _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) _ -> True
230245 _ -> False
231246
247+isRedRight : RBTree k v -> Bool
232248isRedRight t =
233249 case t of
234250 RBNode _ _ _ _ (RBNode Red _ _ _ _) -> True
235251 _ -> False
236252
253+isRedRightLeft : RBTree k v -> Bool
237254isRedRightLeft t =
238255 case t of
239256 RBNode _ _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) -> True
240257 _ -> False
241258
242−
259+moveRedLeft : RBTree k v -> RBTree k v
243260moveRedLeft t =
244261 let t' = color_flip t in
245262 case t' of
@@ -250,16 +267,20 @@ moveRedLeft t =
250267 _ -> t'
251268 _ -> t'
252269
270+moveRedRight : RBTree k v -> RBTree k v
253271moveRedRight t =
254272 let t' = color_flip t in
255273 if isRedLeftLeft t' then color_flip (rotateRight t') else t'
256274
275+moveRedLeft : RBTree k v -> RBTree k v
257276moveRedLeftIfNeeded t =
258277 if not (isRedLeft t) && not (isRedLeftLeft t) then moveRedLeft t else t
259278
279+moveRedRightIfNeeded : RBTree k v -> RBTree k v
260280moveRedRightIfNeeded t =
261281 if not (isRedRight t) && not (isRedRightLeft t) then moveRedRight t else t
262282
283+deleteMin : RBTree k v -> RBTree k v
263284deleteMin t =
264285 let del t =
265286 case t of
@@ -282,6 +303,7 @@ deleteMax t =
282303 in ensureBlackRoot (del t)
283304--}
284305
306+remove : k -> RBTree k v -> RBTree k v
285307remove k t =
286308 let eq_and_noRightNode t =
287309 case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }
@@ -313,27 +335,41 @@ remove k t =
313335 raise "invariants broken after remove")
314336--}
315337
338+map : (a -> b) -> RBTree k a -> RBTree k b
316339map f t =
317340 case t of
318341 RBEmpty -> RBEmpty
319342 RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)
320343
344+foldl : (k -> v -> b -> b) -> b -> RBTree k v -> b
321345foldl f acc t =
322346 case t of
323347 RBEmpty -> acc
324348 RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r
325349
350+foldr : (k -> v -> b -> b) -> b -> RBTree k v -> b
326351foldr f acc t =
327352 case t of
328353 RBEmpty -> acc
329354 RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l
330355
356+union : RBTree k v -> RBTree k v -> RBTree k v
331357union t1 t2 = foldl insert t2 t1
358+
359+intersect : RBTree k v -> RBTree k v -> RBTree k v
332360intersect t1 t2 = foldl (\k v t -> if k `member` t2 then insert k v t else t) empty t1
361+
362+diff : RBTree k v -> RBTree k v -> RBTree k v
333363diff t1 t2 = foldl (\k v t -> remove k t) t1 t2
334364
335−keys t = foldr (\k v acc -> k : acc) [] t
336−values t = foldr (\k v acc -> v : acc) [] t
365+keys : RBTree k v -> [k]
366+keys t = foldr (\k v acc -> k :: acc) [] t
367+
368+values : RBTree k v -> [v]
369+values t = foldr (\k v acc -> v :: acc) [] t
370+
371+toList : RBTree k v -> [(k,v)]
372+toList t = foldr (\k v acc -> (k,v) :: acc) [] t
337373
338−toList t = foldr (\k v acc -> (k,v) : acc) [] t
374+fromList : [(k,v)] -> RBTree k v
339375fromList assocs = Elm.List.foldl (uncurry insert) empty assocs