git.iko.soy/elk
on master help sign in
Update the Dict library to test new parser and type checker.
d15e080evancz
core-elm/Dict.elm+92−107
compare with master
unifiedsplit
@@ -99,10 +99,9 @@ invariants_hold t =
99
99
100min t =
100min t =
101 case t of
101 case t of
102− { RBNode _ k v RBEmpty _ -> (k,v)
102+ RBNode _ k v RBEmpty _ -> (k,v)
103− ; RBNode _ _ _ l _ -> min l
103+ RBNode _ _ _ l _ -> min l
104− ; RBEmpty -> raise "(min RBEmpty) is not defined"
104+ RBEmpty -> raise "(min RBEmpty) is not defined"
105− }
106
105
107{--
106{--
108max t =
107max t =
@@ -115,23 +114,21 @@ max t =
115
114
116lookup k t =
115lookup k t =
117 case t of
116 case t of
118− { RBEmpty -> Nothing
117+ RBEmpty -> Nothing
119− ; RBNode _ k' v l r ->
118+ RBNode _ k' v l r ->
120 case compare k k' of
119 case compare k k' of
121− { LT -> lookup k l
120+ LT -> lookup k l
122− ; EQ -> Just v
121+ EQ -> Just v
123− ; GT -> lookup k r }
122+ GT -> lookup k r
124− }
125
123
126findWithDefault base k t =
124findWithDefault base k t =
127 case t of
125 case t of
128− { RBEmpty -> base
126+ RBEmpty -> base
129− ; RBNode _ k' v l r ->
127+ RBNode _ k' v l r ->
130 case compare k k' of
128 case compare k k' of
131− { LT -> findWithDefault base k l
129+ LT -> findWithDefault base k l
132− ; EQ -> v
130+ EQ -> v
133− ; GT -> findWithDefault base k r }
131+ GT -> findWithDefault base k r
134− }
135
132
136{--
133{--
137find k t =
134find k t =
@@ -150,60 +147,60 @@ member k t = isJust $ lookup k t
150
147
151rotateLeft t =
148rotateLeft t =
152 case t of
149 case t of
153− { RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c
150+ RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c
154− ; _ -> raise "rotateLeft of a node without enough children" }
151+ _ -> raise "rotateLeft of a node without enough children"
155
152
156-- rotateRight -- the reverse, and
153-- rotateRight -- the reverse, and
157-- makes Y have Z's color, and makes Z Red.
154-- makes Y have Z's color, and makes Z Red.
158rotateRight t =
155rotateRight t =
159 case t of
156 case t of
160− { RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)
157+ RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)
161− ; _ -> raise "rotateRight of a node without enough children" }
158+ _ -> raise "rotateRight of a node without enough children"
162
159
163rotateLeftIfNeeded t =
160rotateLeftIfNeeded t =
164 case t of
161 case t of
165− { RBNode _ _ _ _ (RBNode Red _ _ _ _) -> rotateLeft t
162+ RBNode _ _ _ _ (RBNode Red _ _ _ _) -> rotateLeft t
166− ; _ -> t }
163+ _ -> t
167
164
168rotateRightIfNeeded t =
165rotateRightIfNeeded t =
169 case t of
166 case t of
170− { RBNode _ _ _ (RBNode Red _ _ (RBNode Red _ _ _ _) _) _ -> rotateRight t
167+ RBNode _ _ _ (RBNode Red _ _ (RBNode Red _ _ _ _) _) _ -> rotateRight t
171− ; _ -> t }
168+ _ -> t
172
169
173otherColor c = case c of { Red -> Black ; Black -> Red }
170otherColor c = case c of { Red -> Black ; Black -> Red }
174
171
175color_flip t =
172color_flip t =
176 case t of
173 case t of
177− { RBNode c1 bk bv (RBNode c2 ak av la ra) (RBNode c3 ck cv lc rc) ->
174+ RBNode c1 bk bv (RBNode c2 ak av la ra) (RBNode c3 ck cv lc rc) ->
178− RBNode (otherColor c1) bk bv
175+ RBNode (otherColor c1) bk bv
179− (RBNode (otherColor c2) ak av la ra)
176+ (RBNode (otherColor c2) ak av la ra)
180− (RBNode (otherColor c3) ck cv lc rc)
177+ (RBNode (otherColor c3) ck cv lc rc)
181− ; _ -> raise "color_flip called on a RBEmpty or RBNode with a RBEmpty child" }
178+ _ -> raise "color_flip called on a RBEmpty or RBNode with a RBEmpty child"
182
179
183color_flipIfNeeded t =
180color_flipIfNeeded t =
184 case t of
181 case t of
185− { RBNode _ _ _ (RBNode Red _ _ _ _) (RBNode Red _ _ _ _) -> color_flip t
182+ RBNode _ _ _ (RBNode Red _ _ _ _) (RBNode Red _ _ _ _) -> color_flip t
186− ; _ -> t }
183+ _ -> t
187
184
188fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
185fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
189
186
190
187
191ensureBlackRoot t =
188ensureBlackRoot t =
192 case t of
189 case t of
193− { RBNode Red k v l r -> RBNode Black k v l r
190+ RBNode Red k v l r -> RBNode Black k v l r
194− ; _ -> t }
191+ _ -> t
195
192
196-- Invariant: t is a valid left-leaning rb tree *)
193-- Invariant: t is a valid left-leaning rb tree *)
197insert k v t =
194insert k v t =
198 let ins t =
195 let ins t =
199 case t of
196 case t of
200− { RBEmpty -> RBNode Red k v RBEmpty RBEmpty
197+ RBEmpty -> RBNode Red k v RBEmpty RBEmpty
201− ; RBNode c k' v' l r ->
198+ RBNode c k' v' l r ->
202 let h = case compare k k' of
199 let h = case compare k k' of
203− { LT -> RBNode c k' v' (ins l) r
200+ LT -> RBNode c k' v' (ins l) r
204− ; EQ -> RBNode c k' v l r -- replace
201+ EQ -> RBNode c k' v l r -- replace
205− ; GT -> RBNode c k' v' l (ins r) }
202+ GT -> RBNode c k' v' l (ins r)
206− in fixUp h }
203+ in fixUp h
207 in ensureBlackRoot (ins t)
204 in ensureBlackRoot (ins t)
208{--
205{--
209 if not (invariants_hold t) then
206 if not (invariants_hold t) then
@@ -219,63 +216,59 @@ singleton k v = insert k v RBEmpty
219
216
220isRed t =
217isRed t =
221 case t of
218 case t of
222− { RBNode Red _ _ _ _ -> True
219+ RBNode Red _ _ _ _ -> True
223− ; _ -> False }
220+ _ -> False
224
221
225isRedLeft t =
222isRedLeft t =
226 case t of
223 case t of
227− { RBNode _ _ _ (RBNode Red _ _ _ _) _ -> True
224+ RBNode _ _ _ (RBNode Red _ _ _ _) _ -> True
228− ; _ -> False }
225+ _ -> False
229
226
230isRedLeftLeft t =
227isRedLeftLeft t =
231 case t of
228 case t of
232− { RBNode _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) _ -> True
229+ RBNode _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) _ -> True
233− ; _ -> False }
230+ _ -> False
234
231
235isRedRight t =
232isRedRight t =
236 case t of
233 case t of
237− { RBNode _ _ _ _ (RBNode Red _ _ _ _) -> True
234+ RBNode _ _ _ _ (RBNode Red _ _ _ _) -> True
238− ; _ -> False }
235+ _ -> False
239
236
240isRedRightLeft t =
237isRedRightLeft t =
241 case t of
238 case t of
242− { RBNode _ _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) -> True
239+ RBNode _ _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) -> True
243− ; _ -> False }
240+ _ -> False
244
241
245
242
246moveRedLeft t =
243moveRedLeft t =
247 let t' = color_flip t in
244 let t' = color_flip t in
248 case t' of
245 case t' of
249− { RBNode c k v l r ->
246+ RBNode c k v l r ->
250 case r of
247 case r of
251− { RBNode _ _ _ (RBNode Red _ _ _ _) _ ->
248+ RBNode _ _ _ (RBNode Red _ _ _ _) _ ->
252 color_flip (rotateLeft (RBNode c k v l (rotateRight r)))
249 color_flip (rotateLeft (RBNode c k v l (rotateRight r)))
253− ; _ -> t' }
250+ _ -> t'
254− ; _ -> t' }
251+ _ -> t'
255
252
256moveRedRight t =
253moveRedRight t =
257 let t' = color_flip t in
254 let t' = color_flip t in
258 if isRedLeftLeft t' then color_flip (rotateRight t') else t'
255 if isRedLeftLeft t' then color_flip (rotateRight t') else t'
259
256
260−moveRedLeftIfNeeded t =
257+moveRedLeftIfNeeded t
261− if not (isRedLeft t) && not (isRedLeftLeft t)
258+ | not (isRedLeft t) && not (isRedLeftLeft t) = moveRedLeft t
262− then moveRedLeft t
259+ | otherwise = t
263− else t
264
260
265−moveRedRightIfNeeded t =
261+moveRedRightIfNeeded t
266− if not (isRedRight t) && not (isRedRightLeft t)
262+ | not (isRedRight t) && not (isRedRightLeft t) = moveRedRight t
267− then moveRedRight t
263+ | otherwise = t
268− else t
269
264
270deleteMin t =
265deleteMin t =
271 let del t =
266 let del t =
272 case t of
267 case t of
273− { RBNode _ _ _ RBEmpty _ -> RBEmpty
268+ RBNode _ _ _ RBEmpty _ -> RBEmpty
274− ; _ -> let t' = moveRedLeftIfNeeded t in
269+ _ -> case moveRedLeftIfNeeded t of
275− case t' of
276− { RBNode c k v l r -> fixUp (RBNode c k v (del l) r)
270+ RBNode c k v l r -> fixUp (RBNode c k v (del l) r)
277− ; RBEmpty -> RBEmpty }
271+ RBEmpty -> RBEmpty
278− }
279 in ensureBlackRoot (del t)
272 in ensureBlackRoot (del t)
280
273
281{--
274{--
@@ -292,31 +285,26 @@ deleteMax t =
292--}
285--}
293
286
294remove k t =
287remove k t =
295− let eq_and_noRightNode t = case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False } in
288+ let eq_and_noRightNode t = case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }
296− let eq t = case t of { RBNode _ k' _ _ _ -> k == k' ; _ -> False } in
289+ eq t = case t of { RBNode _ k' _ _ _ -> k == k' ; _ -> False }
297− let delLT t = let t' = moveRedLeftIfNeeded t in
290+ delLT t = case moveRedLeftIfNeeded t of
298− case t' of
299− { RBNode c k' v l r -> fixUp (RBNode c k' v (del l) r)
291+ RBNode c k' v l r -> fixUp (RBNode c k' v (del l) r)
300− ; RBEmpty -> raise "delLT on RBEmpty" }
292+ RBEmpty -> raise "delLT on RBEmpty"
301− in
302− let delEQ t = case t of -- Replace with successor
293+ delEQ t = case t of -- Replace with successor
303− { RBNode c _ _ l r ->
294+ RBNode c _ _ l r -> let (k',v') = min r in
304− let (k',v') = min r in
305− fixUp (RBNode c k' v' l (deleteMin r))
295+ fixUp (RBNode c k' v' l (deleteMin r))
306− ; RBEmpty -> raise "delEQ called on a RBEmpty" }
296+ RBEmpty -> raise "delEQ called on a RBEmpty"
307− in
308− let delGT t = case t of
297+ delGT t = case t of
309− { RBNode c k' v l r -> fixUp (RBNode c k' v l (del r))
298+ RBNode c k' v l r -> fixUp (RBNode c k' v l (del r))
310− ; RBEmpty -> raise "delGT called on a RBEmpty" }
299+ RBEmpty -> raise "delGT called on a RBEmpty"
311− in
312− let del t = case t of
300+ del t = case t of
313− { RBEmpty -> RBEmpty
301+ RBEmpty -> RBEmpty
314− ; RBNode _ k' _ _ _ ->
302+ RBNode _ k' _ _ _ ->
315− if k < k' then delLT t
303+ let v | k < k' = delLT t
316− else (let t' = if isRedLeft t then rotateRight t else t in
304+ | eq_and_noRightNode (if isRedLeft t then rotateRight t else t) = RBEmpty
317− if eq_and_noRightNode t' then RBEmpty
318− else (let t = moveRedRightIfNeeded t in
305+ | otherwise = let t' = moveRedRightIfNeeded t in
319− if eq t then delEQ t else delGT t)) }
306+ if eq t' then delEQ t' else delGT t'
307+ in v
320 in ensureBlackRoot (del t)
308 in ensureBlackRoot (del t)
321{--
309{--
322 if not (invariants_hold t) then
310 if not (invariants_hold t) then
@@ -328,28 +316,25 @@ remove k t =
328
316
329map f t =
317map f t =
330 case t of
318 case t of
331− { RBEmpty -> RBEmpty
319+ RBEmpty -> RBEmpty
332− ; RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)
320+ RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)
333− }
334
321
335foldl f acc t =
322foldl f acc t =
336 case t of
323 case t of
337− { RBEmpty -> acc
324+ RBEmpty -> acc
338− ; RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r
325+ RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r
339− }
340
326
341foldr f acc t =
327foldr f acc t =
342 case t of
328 case t of
343− { RBEmpty -> acc
329+ RBEmpty -> acc
344− ; RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l
330+ RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l
345− }
346
331
347−union t1 t2 = foldl insert t2 t1
332+union t1 t2 = Dict.foldl insert t2 t1
348−intersect t1 t2 = foldl (\k v t -> if k `member` t2 then insert k v t else t) empty t1
333+intersect t1 t2 = Dict.foldl (\k v t -> if k `member` t2 then insert k v t else t) empty t1
349−diff t1 t2 = foldl (\k _ t -> remove k t) t1 t2
334+diff t1 t2 = Dict.foldl (\k v t -> remove k t) t1 t2
350
335
351−keys t = foldl (\k _ acc -> k : acc) [] t
336+keys t = Dict.foldl (\k v acc -> k : acc) [] t
352−values t = foldl (\_ -> (:)) [] t
337+values t = Dict.foldl (\k v acc -> v : acc) [] t
353
338
354−toList t = foldl (\k v acc -> (k,v) : acc) [] t
339+toList t = Dict.foldl (\k v acc -> (k,v) : acc) [] t
355fromList assocs = List.foldl (uncurry insert) empty assocs
340fromList assocs = List.foldl (uncurry insert) empty assocs