git.iko.soy/elk
on master help sign in
Name constructors so that they are less likely to collide with something.
7822f02evancz
core-elm/Map.elm+72−75
compare with master
unifiedsplit
@@ -5,11 +5,11 @@ import Data.Maybe (isJust)
5
5
6data NColor = Red | Black
6data NColor = Red | Black
7
7
8−data RBTree k v = Node NColor k v (RBTree k v) (RBTree k v) | Empty
8+data RBTree k v = RBNode NColor k v (RBTree k v) (RBTree k v) | RBEmpty
9
9
10raise = console.log
10raise = console.log
11
11
12−empty = Empty
12+empty = RBEmpty
13
13
14-- Helpers for checking invariants
14-- Helpers for checking invariants
15
15
@@ -17,8 +17,8 @@ empty = Empty
17equal_pathLen t =
17equal_pathLen t =
18 let path_numBlacks t =
18 let path_numBlacks t =
19 case t of
19 case t of
20− { Empty -> 1
20+ { RBEmpty -> 1
21− ; Node col _ _ l r ->
21+ ; RBNode col _ _ l r ->
22 let { bl = path_numBlacks l ; br = path_numBlacks r } in
22 let { bl = path_numBlacks l ; br = path_numBlacks r } in
23 if bl /= br || bl == 0-1 || br == 0-1
23 if bl /= br || bl == 0-1 || br == 0-1
24 then 0-1
24 then 0-1
@@ -28,22 +28,22 @@ equal_pathLen t =
28
28
29rootBlack t =
29rootBlack t =
30 case t of
30 case t of
31− { Empty -> True
31+ { RBEmpty -> True
32− ; Node Black _ _ _ _ -> True
32+ ; RBNode Black _ _ _ _ -> True
33 ; _ -> False }
33 ; _ -> False }
34
34
35redBlack_children t =
35redBlack_children t =
36 case t of
36 case t of
37− { Node Red _ _ (Node Red _ _ _ _) _ -> False
37+ { RBNode Red _ _ (RBNode Red _ _ _ _) _ -> False
38− ; Node Red _ _ _ (Node Red _ _ _ _) -> False
38+ ; RBNode Red _ _ _ (RBNode Red _ _ _ _) -> False
39− ; Empty -> True
39+ ; RBEmpty -> True
40− ; Node _ _ _ l r -> redBlack_children l && redBlack_children r
40+ ; RBNode _ _ _ l r -> redBlack_children l && redBlack_children r
41 }
41 }
42
42
43findExtreme f t =
43findExtreme f t =
44 case t of
44 case t of
45− { Empty -> Nothing
45+ { RBEmpty -> Nothing
46− ; Node c k _ l r ->
46+ ; RBNode c k _ l r ->
47 case findExtreme f (f (l,r)) of
47 case findExtreme f (f (l,r)) of
48 { Nothing -> Just k
48 { Nothing -> Just k
49 ; Just k' -> Just k' }
49 ; Just k' -> Just k' }
@@ -67,8 +67,8 @@ olte xo yo = optionRelation (<=) True xo yo
67
67
68ordered t =
68ordered t =
69 case t of
69 case t of
70− { Empty -> True
70+ { RBEmpty -> True
71− ; Node c k v l r ->
71+ ; RBNode c k v l r ->
72 let (lmax,rmin) = (findmaxRbt l, findminRbt r) in
72 let (lmax,rmin) = (findmaxRbt l, findminRbt r) in
73 olte lmax (Just k) && olte (Just k) rmin && ordered l && ordered r
73 olte lmax (Just k) && olte (Just k) rmin && ordered l && ordered r
74 }
74 }
@@ -76,10 +76,10 @@ ordered t =
76-- Check that there aren't any right red nodes in the tree *)
76-- Check that there aren't any right red nodes in the tree *)
77leftLeaning t =
77leftLeaning t =
78 case t of
78 case t of
79− { Empty -> True
79+ { RBEmpty -> True
80− ; Node _ _ _ (Node Black _ _ _ _) (Node Red _ _ _ _) -> False
80+ ; RBNode _ _ _ (RBNode Black _ _ _ _) (RBNode Red _ _ _ _) -> False
81− ; Node _ _ _ Empty (Node Red _ _ _ _) -> False
81+ ; RBNode _ _ _ RBEmpty (RBNode Red _ _ _ _) -> False
82− ; Node _ _ _ l r -> (leftLeaning l) && (leftLeaning r)
82+ ; RBNode _ _ _ l r -> (leftLeaning l) && (leftLeaning r)
83 }
83 }
84
84
85invariants_hold t =
85invariants_hold t =
@@ -91,22 +91,22 @@ invariants_hold t =
91
91
92min t =
92min t =
93 case t of
93 case t of
94− { Node _ k v Empty _ -> (k,v)
94+ { RBNode _ k v RBEmpty _ -> (k,v)
95− ; Node _ _ _ l _ -> min l
95+ ; RBNode _ _ _ l _ -> min l
96− ; Empty -> console.log "(min Empty) is not defined"
96+ ; RBEmpty -> console.log "(min RBEmpty) is not defined"
97 }
97 }
98
98
99max t =
99max t =
100 case t of
100 case t of
101− { Node _ k v _ Empty -> (k,v)
101+ { RBNode _ k v _ RBEmpty -> (k,v)
102− ; Node _ _ _ _ r -> max r
102+ ; RBNode _ _ _ _ r -> max r
103− ; Empty -> console.log "(max Empty) is not defined"
103+ ; RBEmpty -> console.log "(max RBEmpty) is not defined"
104 }
104 }
105
105
106lookup k t =
106lookup k t =
107 case t of
107 case t of
108− { Empty -> Nothing
108+ { RBEmpty -> Nothing
109− ; Node _ k' v l r ->
109+ ; RBNode _ k' v l r ->
110 case compare k k' of
110 case compare k k' of
111 { LT -> lookup k l
111 { LT -> lookup k l
112 ; EQ -> Just v
112 ; EQ -> Just v
@@ -118,39 +118,39 @@ member k t = isJust $ lookup k t
118
118
119rotateLeft t =
119rotateLeft t =
120 case t of
120 case t of
121− { Node cy ky vy a (Node cz kz vz b c) -> Node cy kz vz (Node Red ky vy a b) c
121+ { RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c
122 ; _ -> raise "rotateLeft of a node without enough children" }
122 ; _ -> raise "rotateLeft of a node without enough children" }
123
123
124-- rotateRight -- the reverse, and
124-- rotateRight -- the reverse, and
125-- makes Y have Z's color, and makes Z Red.
125-- makes Y have Z's color, and makes Z Red.
126rotateRight t =
126rotateRight t =
127 case t of
127 case t of
128− { Node cz kz vz (Node cy ky vy a b) c -> Node cz ky vy a (Node Red kz vz b c)
128+ { RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)
129 ; _ -> raise "rotateRight of a node without enough children" }
129 ; _ -> raise "rotateRight of a node without enough children" }
130
130
131rotateLeftIfNeeded t =
131rotateLeftIfNeeded t =
132 case t of
132 case t of
133− { Node _ _ _ _ (Node Red _ _ _ _) -> rotateLeft t
133+ { RBNode _ _ _ _ (RBNode Red _ _ _ _) -> rotateLeft t
134 ; _ -> t }
134 ; _ -> t }
135
135
136rotateRightIfNeeded t =
136rotateRightIfNeeded t =
137 case t of
137 case t of
138− { Node _ _ _ (Node Red _ _ (Node Red _ _ _ _) _) _ -> rotateRight t
138+ { RBNode _ _ _ (RBNode Red _ _ (RBNode Red _ _ _ _) _) _ -> rotateRight t
139 ; _ -> t }
139 ; _ -> t }
140
140
141otherColor c = case c of { Red -> Black ; Black -> Red }
141otherColor c = case c of { Red -> Black ; Black -> Red }
142
142
143color_flip t =
143color_flip t =
144 case t of
144 case t of
145− { Node c1 bk bv (Node c2 ak av la ra) (Node c3 ck cv lc rc) ->
145+ { RBNode c1 bk bv (RBNode c2 ak av la ra) (RBNode c3 ck cv lc rc) ->
146− Node (otherColor c1) bk bv
146+ RBNode (otherColor c1) bk bv
147− (Node (otherColor c2) ak av la ra)
147+ (RBNode (otherColor c2) ak av la ra)
148− (Node (otherColor c3) ck cv lc rc)
148+ (RBNode (otherColor c3) ck cv lc rc)
149− ; _ -> raise "color_flip called on a Empty or Node with a Empty child" }
149+ ; _ -> raise "color_flip called on a RBEmpty or RBNode with a RBEmpty child" }
150
150
151color_flipIfNeeded t =
151color_flipIfNeeded t =
152 case t of
152 case t of
153− { Node _ _ _ (Node Red _ _ _ _) (Node Red _ _ _ _) -> color_flip t
153+ { RBNode _ _ _ (RBNode Red _ _ _ _) (RBNode Red _ _ _ _) -> color_flip t
154 ; _ -> t }
154 ; _ -> t }
155
155
156fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
156fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
@@ -158,19 +158,19 @@ fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
158
158
159ensureBlackRoot t =
159ensureBlackRoot t =
160 case t of
160 case t of
161− { Node Red k v l r -> Node Black k v l r
161+ { RBNode Red k v l r -> RBNode Black k v l r
162 ; _ -> t }
162 ; _ -> t }
163
163
164-- Invariant: t is a valid left-leaning rb tree *)
164-- Invariant: t is a valid left-leaning rb tree *)
165insert k v t =
165insert k v t =
166 let ins t =
166 let ins t =
167 case t of
167 case t of
168− { Empty -> Node Red k v Empty Empty
168+ { RBEmpty -> RBNode Red k v RBEmpty RBEmpty
169− ; Node c k' v' l r ->
169+ ; RBNode c k' v' l r ->
170 let h = case compare k k' of
170 let h = case compare k k' of
171− { LT -> Node c k' v' (ins l) r
171+ { LT -> RBNode c k' v' (ins l) r
172− ; EQ -> Node c k' v l r -- replace
172+ ; EQ -> RBNode c k' v l r -- replace
173− ; GT -> Node c k' v' l (ins r) }
173+ ; GT -> RBNode c k' v' l (ins r) }
174 in fixUp h }
174 in fixUp h }
175 in if not (invariants_hold t) then
175 in if not (invariants_hold t) then
176 raise "invariants broken before insert"
176 raise "invariants broken before insert"
@@ -179,42 +179,42 @@ insert k v t =
179 raise "invariants broken after insert"
179 raise "invariants broken after insert"
180 else new_t)
180 else new_t)
181
181
182−singleton k v = insert k v Empty
182+singleton k v = insert k v RBEmpty
183
183
184
184
185isRed t =
185isRed t =
186 case t of
186 case t of
187− { Node Red _ _ _ _ -> True
187+ { RBNode Red _ _ _ _ -> True
188 ; _ -> False }
188 ; _ -> False }
189
189
190isRedLeft t =
190isRedLeft t =
191 case t of
191 case t of
192− { Node _ _ _ (Node Red _ _ _ _) _ -> True
192+ { RBNode _ _ _ (RBNode Red _ _ _ _) _ -> True
193 ; _ -> False }
193 ; _ -> False }
194
194
195isRedLeftLeft t =
195isRedLeftLeft t =
196 case t of
196 case t of
197− { Node _ _ _ (Node _ _ _ (Node Red _ _ _ _) _) _ -> True
197+ { RBNode _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) _ -> True
198 ; _ -> False }
198 ; _ -> False }
199
199
200isRedRight t =
200isRedRight t =
201 case t of
201 case t of
202− { Node _ _ _ _ (Node Red _ _ _ _) -> True
202+ { RBNode _ _ _ _ (RBNode Red _ _ _ _) -> True
203 ; _ -> False }
203 ; _ -> False }
204
204
205isRedRightLeft t =
205isRedRightLeft t =
206 case t of
206 case t of
207− { Node _ _ _ _ (Node _ _ _ (Node Red _ _ _ _) _) -> True
207+ { RBNode _ _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) -> True
208 ; _ -> False }
208 ; _ -> False }
209
209
210
210
211moveRedLeft t =
211moveRedLeft t =
212 let t' = color_flip t in
212 let t' = color_flip t in
213 case t' of
213 case t' of
214− { Node c k v l r ->
214+ { RBNode c k v l r ->
215 case r of
215 case r of
216− { Node _ _ _ (Node Red _ _ _ _) _ ->
216+ { RBNode _ _ _ (RBNode Red _ _ _ _) _ ->
217− color_flip (rotateLeft (Node c k v l (rotateRight r)))
217+ color_flip (rotateLeft (RBNode c k v l (rotateRight r)))
218 ; _ -> t' }
218 ; _ -> t' }
219 ; _ -> t' }
219 ; _ -> t' }
220
220
@@ -235,11 +235,11 @@ moveRedRightIfNeeded t =
235deleteMin t =
235deleteMin t =
236 let del t =
236 let del t =
237 case t of
237 case t of
238− { Node _ _ _ Empty _ -> Empty
238+ { RBNode _ _ _ RBEmpty _ -> RBEmpty
239 ; _ -> let t' = moveRedLeftIfNeeded t in
239 ; _ -> let t' = moveRedLeftIfNeeded t in
240 case t' of
240 case t' of
241− { Node c k v l r -> fixUp (Node c k v (del l) r)
241+ { RBNode c k v l r -> fixUp (RBNode c k v (del l) r)
242− ; Empty -> Empty }
242+ ; RBEmpty -> RBEmpty }
243 }
243 }
244 in ensureBlackRoot (del t)
244 in ensureBlackRoot (del t)
245
245
@@ -247,39 +247,39 @@ deleteMax t =
247 let del t =
247 let del t =
248 let t' = if isRedLeft t then rotateRight t else t in
248 let t' = if isRedLeft t then rotateRight t else t in
249 case t' of
249 case t' of
250− { Node _ _ _ _ Empty -> Empty
250+ { RBNode _ _ _ _ RBEmpty -> RBEmpty
251 ; _ -> let t'' = moveRedRightIfNeeded t' in
251 ; _ -> let t'' = moveRedRightIfNeeded t' in
252 case t'' of
252 case t'' of
253− { Node c k v l r -> fixUp (Node c k v l (del r))
253+ { RBNode c k v l r -> fixUp (RBNode c k v l (del r))
254− ; Empty -> Empty } }
254+ ; RBEmpty -> RBEmpty } }
255 in ensureBlackRoot (del t)
255 in ensureBlackRoot (del t)
256
256
257remove k t =
257remove k t =
258 let {
258 let {
259− eq_and_noRightNode t = case t of { Node _ k' _ _ Empty -> k == k' ; _ -> False }
259+ eq_and_noRightNode t = case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }
260− ; eq t = case t of { Node _ k' _ _ _ -> k == k' ; _ -> False }
260+ ; eq t = case t of { RBNode _ k' _ _ _ -> k == k' ; _ -> False }
261 ; delLT t =
261 ; delLT t =
262 let t' = moveRedLeftIfNeeded t in
262 let t' = moveRedLeftIfNeeded t in
263 case t' of
263 case t' of
264− { Node c k' v l r -> fixUp (Node c k' v (del l) r)
264+ { RBNode c k' v l r -> fixUp (RBNode c k' v (del l) r)
265− ; Empty -> raise "delLT on Empty" }
265+ ; RBEmpty -> raise "delLT on RBEmpty" }
266 ; delEQ t =
266 ; delEQ t =
267 case t of -- Replace with successor
267 case t of -- Replace with successor
268− { Node c _ _ l r ->
268+ { RBNode c _ _ l r ->
269 let (k',v') = min r in
269 let (k',v') = min r in
270− fixUp (Node c k' v' l (deleteMin r))
270+ fixUp (RBNode c k' v' l (deleteMin r))
271− ; Empty -> raise "delEQ called on a Empty" }
271+ ; RBEmpty -> raise "delEQ called on a RBEmpty" }
272 ; delGT t =
272 ; delGT t =
273 case t of
273 case t of
274− { Node c k' v l r -> fixUp (Node c k' v l (del r))
274+ { RBNode c k' v l r -> fixUp (RBNode c k' v l (del r))
275− ; Empty -> raise "delGT called on a Empty" }
275+ ; RBEmpty -> raise "delGT called on a RBEmpty" }
276 ; del t =
276 ; del t =
277 case t of
277 case t of
278− { Empty -> Empty
278+ { RBEmpty -> RBEmpty
279− ; Node _ k' _ _ _ ->
279+ ; RBNode _ k' _ _ _ ->
280 if k < k' then delLT t
280 if k < k' then delLT t
281 else (let t' = if isRedLeft t then rotateRight t else t in
281 else (let t' = if isRedLeft t then rotateRight t else t in
282− if eq_and_noRightNode t' then Empty
282+ if eq_and_noRightNode t' then RBEmpty
283 else (let t = moveRedRightIfNeeded t in
283 else (let t = moveRedRightIfNeeded t in
284 if eq t then delEQ t else delGT t)) }
284 if eq t then delEQ t else delGT t)) }
285 }
285 }
@@ -291,9 +291,6 @@ remove k t =
291
291
292fold f acc t =
292fold f acc t =
293 case t of
293 case t of
294− { Empty -> acc
294+ { RBEmpty -> acc
295− ; Node _ k v l r -> fold f (f k v (fold f acc l)) r
295+ ; RBNode _ k v l r -> fold f (f k v (fold f acc l)) r
296− }
296+ }
297−
298−{--
299−--}