git.iko.soy/elk
on master help sign in
Get the core libraries compiling again. Fix type signatures that have super-types, and fix bugs in a couple files.
82b7929evancz
libraries/Dict.elm+116−108
compare with master
unifiedsplit
@@ -11,14 +11,15 @@ module Dict (empty,singleton,insert
11import Maybe as Maybe
11import Maybe as Maybe
12import Native.Error as Error
12import Native.Error as Error
13import List as List
13import List as List
14+import Native.Utils (compare)
14
15
15data NColor = Red | Black
16data NColor = Red | Black
16
17
17−data Dict k v = Node NColor k v (Dict k v) (Dict k v) | Empty
18+data Dict k v = RBNode NColor k v (Dict k v) (Dict k v) | RBEmpty
18
19
19-- Create an empty dictionary.
20-- Create an empty dictionary.
20−empty : Dict k v
21+empty : Dict (Comparable k) v
21−empty = Empty
22+empty = RBEmpty
22
23
23{-- Helpers for checking invariants
24{-- Helpers for checking invariants
24
25
@@ -26,33 +27,32 @@ empty = Empty
26equal_pathLen t =
27equal_pathLen t =
27 let path_numBlacks t =
28 let path_numBlacks t =
28 case t of
29 case t of
29− { Empty -> 1
30+ RBEmpty -> 1
30− ; Node col _ _ l r ->
31+ RBNode col _ _ l r ->
31 let { bl = path_numBlacks l ; br = path_numBlacks r } in
32 let { bl = path_numBlacks l ; br = path_numBlacks r } in
32 if bl /= br || bl == 0-1 || br == 0-1
33 if bl /= br || bl == 0-1 || br == 0-1
33 then 0-1
34 then 0-1
34 else bl + (if col == Red then 0 else 1)
35 else bl + (if col == Red then 0 else 1)
35− }
36 in 0-1 /= path_numBlacks t
36 in 0-1 /= path_numBlacks t
37
37
38rootBlack t =
38rootBlack t =
39 case t of
39 case t of
40− { Empty -> True
40+ RBEmpty -> True
41− ; Node Black _ _ _ _ -> True
41+ RBNode Black _ _ _ _ -> True
42− ; _ -> False }
42+ _ -> False
43
43
44redBlack_children t =
44redBlack_children t =
45 case t of
45 case t of
46− { Node Red _ _ (Node Red _ _ _ _) _ -> False
46+ { RBNode Red _ _ (RBNode Red _ _ _ _) _ -> False
47− ; Node Red _ _ _ (Node Red _ _ _ _) -> False
47+ ; RBNode Red _ _ _ (RBNode Red _ _ _ _) -> False
48− ; Empty -> True
48+ ; RBEmpty -> True
49− ; Node _ _ _ l r -> redBlack_children l && redBlack_children r
49+ ; RBNode _ _ _ l r -> redBlack_children l && redBlack_children r
50 }
50 }
51
51
52findExtreme f t =
52findExtreme f t =
53 case t of
53 case t of
54− { Empty -> Nothing
54+ { RBEmpty -> Nothing
55− ; Node c k _ l r ->
55+ ; RBNode c k _ l r ->
56 case findExtreme f (f (l,r)) of
56 case findExtreme f (f (l,r)) of
57 { Nothing -> Just k
57 { Nothing -> Just k
58 ; Just k' -> Just k' }
58 ; Just k' -> Just k' }
@@ -76,8 +76,8 @@ olte xo yo = optionRelation (<=) True xo yo
76
76
77ordered t =
77ordered t =
78 case t of
78 case t of
79− { Empty -> True
79+ { RBEmpty -> True
80− ; Node c k v l r ->
80+ ; RBNode c k v l r ->
81 let (lmax,rmin) = (findmaxRbt l, findminRbt r) in
81 let (lmax,rmin) = (findmaxRbt l, findminRbt r) in
82 olte lmax (Just k) && olte (Just k) rmin && ordered l && ordered r
82 olte lmax (Just k) && olte (Just k) rmin && ordered l && ordered r
83 }
83 }
@@ -85,10 +85,10 @@ ordered t =
85-- Check that there aren't any right red nodes in the tree *)
85-- Check that there aren't any right red nodes in the tree *)
86leftLeaning t =
86leftLeaning t =
87 case t of
87 case t of
88− { Empty -> True
88+ { RBEmpty -> True
89− ; Node _ _ _ (Node Black _ _ _ _) (Node Red _ _ _ _) -> False
89+ ; RBNode _ _ _ (RBNode Black _ _ _ _) (RBNode Red _ _ _ _) -> False
90− ; Node _ _ _ Empty (Node Red _ _ _ _) -> False
90+ ; RBNode _ _ _ RBEmpty (RBNode Red _ _ _ _) -> False
91− ; Node _ _ _ l r -> (leftLeaning l) && (leftLeaning r)
91+ ; RBNode _ _ _ l r -> (leftLeaning l) && (leftLeaning r)
92 }
92 }
93
93
94invariants_hold t =
94invariants_hold t =
@@ -102,36 +102,37 @@ invariants_hold t =
102min : Dict k v -> (k,v)
102min : Dict k v -> (k,v)
103min t =
103min t =
104 case t of
104 case t of
105− Node _ k v Empty _ -> (k,v)
105+ RBNode _ k v RBEmpty _ -> (k,v)
106− Node _ _ _ l _ -> min l
106+ RBNode _ _ _ l _ -> min l
107− Empty -> Error.raise "(min Empty) is not defined"
107+ RBEmpty -> Error.raise "(min Empty) is not defined"
108
108
109{--
109{--
110max t =
110max t =
111 case t of
111 case t of
112− { Node _ k v _ Empty -> (k,v)
112+ { RBNode _ k v _ RBEmpty -> (k,v)
113− ; Node _ _ _ _ r -> max r
113+ ; RBNode _ _ _ _ r -> max r
114− ; Empty -> Error.raise "(max Empty) is not defined"
114+ ; RBEmpty -> Error.raise "(max Empty) is not defined"
115 }
115 }
116--}
116--}
117
117
118-- Lookup the value associated with a key.
118-- Lookup the value associated with a key.
119−lookup : k -> Dict k v -> Maybe v
119+lookup : Comparable k -> Dict (Comparable k) v -> Maybe v
120lookup k t =
120lookup k t =
121 case t of
121 case t of
122− Empty -> Nothing
122+ RBEmpty -> Nothing
123− Node _ k' v l r ->
123+ RBNode _ k' v l r ->
124 case compare k k' of
124 case compare k k' of
125 LT -> lookup k l
125 LT -> lookup k l
126 EQ -> Just v
126 EQ -> Just v
127 GT -> lookup k r
127 GT -> lookup k r
128
128
129−-- Find the value associated with a key. If the key is not found, return the default value.
129+-- Find the value associated with a key. If the key is not found,
130+-- return the default value.
130−findWithDefault : v -> k -> Dict k v -> v
131+findWithDefault : v -> Comparable k -> Dict (Comparable k) v -> v
131findWithDefault base k t =
132findWithDefault base k t =
132 case t of
133 case t of
133− Empty -> base
134+ RBEmpty -> base
134− Node _ k' v l r ->
135+ RBNode _ k' v l r ->
135 case compare k k' of
136 case compare k k' of
136 LT -> findWithDefault base k l
137 LT -> findWithDefault base k l
137 EQ -> v
138 EQ -> v
@@ -141,8 +142,8 @@ findWithDefault base k t =
141-- Find the value associated with a key. If the key is not found, there will be a runtime error.
142-- Find the value associated with a key. If the key is not found, there will be a runtime error.
142find k t =
143find k t =
143 case t of
144 case t of
144− { Empty -> Error.raise "Key was not found in dictionary!"
145+ { RBEmpty -> Error.raise "Key was not found in dictionary!"
145− ; Node _ k' v l r ->
146+ ; RBNode _ k' v l r ->
146 case compare k k' of
147 case compare k k' of
147 { LT -> find k l
148 { LT -> find k l
148 ; EQ -> v
149 ; EQ -> v
@@ -151,14 +152,14 @@ find k t =
151--}
152--}
152
153
153-- Determine if a key is in a dictionary.
154-- Determine if a key is in a dictionary.
154−member : k -> Dict k v -> Bool
155+member : Comparable k -> Dict (Comparable k) v -> Bool
155-- Does t contain k?
156-- Does t contain k?
156member k t = Maybe.isJust $ lookup k t
157member k t = Maybe.isJust $ lookup k t
157
158
158rotateLeft : Dict k v -> Dict k v
159rotateLeft : Dict k v -> Dict k v
159rotateLeft t =
160rotateLeft t =
160 case t of
161 case t of
161− Node cy ky vy a (Node cz kz vz b c) -> Node cy kz vz (Node Red ky vy a b) c
162+ RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c
162 _ -> Error.raise "rotateLeft of a node without enough children"
163 _ -> Error.raise "rotateLeft of a node without enough children"
163
164
164-- rotateRight -- the reverse, and
165-- rotateRight -- the reverse, and
@@ -166,19 +167,19 @@ rotateLeft t =
166rotateRight : Dict k v -> Dict k v
167rotateRight : Dict k v -> Dict k v
167rotateRight t =
168rotateRight t =
168 case t of
169 case t of
169− Node cz kz vz (Node cy ky vy a b) c -> Node cz ky vy a (Node Red kz vz b c)
170+ RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)
170 _ -> Error.raise "rotateRight of a node without enough children"
171 _ -> Error.raise "rotateRight of a node without enough children"
171
172
172rotateLeftIfNeeded : Dict k v -> Dict k v
173rotateLeftIfNeeded : Dict k v -> Dict k v
173rotateLeftIfNeeded t =
174rotateLeftIfNeeded t =
174 case t of
175 case t of
175− Node _ _ _ _ (Node Red _ _ _ _) -> rotateLeft t
176+ RBNode _ _ _ _ (RBNode Red _ _ _ _) -> rotateLeft t
176 _ -> t
177 _ -> t
177
178
178rotateRightIfNeeded : Dict k v -> Dict k v
179rotateRightIfNeeded : Dict k v -> Dict k v
179rotateRightIfNeeded t =
180rotateRightIfNeeded t =
180 case t of
181 case t of
181− Node _ _ _ (Node Red _ _ (Node Red _ _ _ _) _) _ -> rotateRight t
182+ RBNode _ _ _ (RBNode Red _ _ (RBNode Red _ _ _ _) _) _ -> rotateRight t
182 _ -> t
183 _ -> t
183
184
184otherColor c = case c of { Red -> Black ; Black -> Red }
185otherColor c = case c of { Red -> Black ; Black -> Red }
@@ -186,16 +187,16 @@ otherColor c = case c of { Red -> Black ; Black -> Red }
186color_flip : Dict k v -> Dict k v
187color_flip : Dict k v -> Dict k v
187color_flip t =
188color_flip t =
188 case t of
189 case t of
189− Node c1 bk bv (Node c2 ak av la ra) (Node c3 ck cv lc rc) ->
190+ RBNode c1 bk bv (RBNode c2 ak av la ra) (RBNode c3 ck cv lc rc) ->
190− Node (otherColor c1) bk bv
191+ RBNode (otherColor c1) bk bv
191− (Node (otherColor c2) ak av la ra)
192+ (RBNode (otherColor c2) ak av la ra)
192− (Node (otherColor c3) ck cv lc rc)
193+ (RBNode (otherColor c3) ck cv lc rc)
193 _ -> Error.raise "color_flip called on a Empty or Node with a Empty child"
194 _ -> Error.raise "color_flip called on a Empty or Node with a Empty child"
194
195
195color_flipIfNeeded : Dict k v -> Dict k v
196color_flipIfNeeded : Dict k v -> Dict k v
196color_flipIfNeeded t =
197color_flipIfNeeded t =
197 case t of
198 case t of
198− Node _ _ _ (Node Red _ _ _ _) (Node Red _ _ _ _) -> color_flip t
199+ RBNode _ _ _ (RBNode Red _ _ _ _) (RBNode Red _ _ _ _) -> color_flip t
199 _ -> t
200 _ -> t
200
201
201fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
202fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
@@ -203,21 +204,21 @@ fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
203ensureBlackRoot : Dict k v -> Dict k v
204ensureBlackRoot : Dict k v -> Dict k v
204ensureBlackRoot t =
205ensureBlackRoot t =
205 case t of
206 case t of
206− Node Red k v l r -> Node Black k v l r
207+ RBNode Red k v l r -> RBNode Black k v l r
207 _ -> t
208 _ -> t
208
209
209−-- Insert a key-value pair into a dictionary. Replaces value when there is a collision.
210+-- Insert a key-value pair into a dictionary. Replaces value when there is
211+-- a collision.
212+insert : Comparable k -> v -> Dict (Comparable k) v -> Dict (Comparable k) v
210−-- Invariant: t is a valid left-leaning rb tree *)
213+insert k v t = -- Invariant: t is a valid left-leaning rb tree
211−insert : k -> v -> Dict k v -> Dict k v
212−insert k v t =
213 let ins t =
214 let ins t =
214 case t of
215 case t of
215− Empty -> Node Red k v Empty Empty
216+ RBEmpty -> RBNode Red k v RBEmpty RBEmpty
216− Node c k' v' l r ->
217+ RBNode c k' v' l r ->
217 let h = case compare k k' of
218 let h = case compare k k' of
218− LT -> Node c k' v' (ins l) r
219+ LT -> RBNode c k' v' (ins l) r
219− EQ -> Node c k' v l r -- replace
220+ EQ -> RBNode c k' v l r -- replace
220− GT -> Node c k' v' l (ins r)
221+ GT -> RBNode c k' v' l (ins r)
221 in fixUp h
222 in fixUp h
222 in ensureBlackRoot (ins t)
223 in ensureBlackRoot (ins t)
223{--
224{--
@@ -230,47 +231,47 @@ insert k v t =
230--}
231--}
231
232
232-- Create a dictionary with one key-value pair.
233-- Create a dictionary with one key-value pair.
233−singleton : k -> v -> Dict k v
234+singleton : Comparable k -> v -> Dict (Comparable k) v
234−singleton k v = insert k v Empty
235+singleton k v = insert k v RBEmpty
235
236
236isRed : Dict k v -> Bool
237isRed : Dict k v -> Bool
237isRed t =
238isRed t =
238 case t of
239 case t of
239− Node Red _ _ _ _ -> True
240+ RBNode Red _ _ _ _ -> True
240 _ -> False
241 _ -> False
241
242
242isRedLeft : Dict k v -> Bool
243isRedLeft : Dict k v -> Bool
243isRedLeft t =
244isRedLeft t =
244 case t of
245 case t of
245− Node _ _ _ (Node Red _ _ _ _) _ -> True
246+ RBNode _ _ _ (RBNode Red _ _ _ _) _ -> True
246 _ -> False
247 _ -> False
247
248
248isRedLeftLeft : Dict k v -> Bool
249isRedLeftLeft : Dict k v -> Bool
249isRedLeftLeft t =
250isRedLeftLeft t =
250 case t of
251 case t of
251− Node _ _ _ (Node _ _ _ (Node Red _ _ _ _) _) _ -> True
252+ RBNode _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) _ -> True
252 _ -> False
253 _ -> False
253
254
254isRedRight : Dict k v -> Bool
255isRedRight : Dict k v -> Bool
255isRedRight t =
256isRedRight t =
256 case t of
257 case t of
257− Node _ _ _ _ (Node Red _ _ _ _) -> True
258+ RBNode _ _ _ _ (RBNode Red _ _ _ _) -> True
258 _ -> False
259 _ -> False
259
260
260isRedRightLeft : Dict k v -> Bool
261isRedRightLeft : Dict k v -> Bool
261isRedRightLeft t =
262isRedRightLeft t =
262 case t of
263 case t of
263− Node _ _ _ _ (Node _ _ _ (Node Red _ _ _ _) _) -> True
264+ RBNode _ _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) -> True
264 _ -> False
265 _ -> False
265
266
266moveRedLeft : Dict k v -> Dict k v
267moveRedLeft : Dict k v -> Dict k v
267moveRedLeft t =
268moveRedLeft t =
268 let t' = color_flip t in
269 let t' = color_flip t in
269 case t' of
270 case t' of
270− Node c k v l r ->
271+ RBNode c k v l r ->
271 case r of
272 case r of
272− Node _ _ _ (Node Red _ _ _ _) _ ->
273+ RBNode _ _ _ (RBNode Red _ _ _ _) _ ->
273− color_flip (rotateLeft (Node c k v l (rotateRight r)))
274+ color_flip (rotateLeft (RBNode c k v l (rotateRight r)))
274 _ -> t'
275 _ -> t'
275 _ -> t'
276 _ -> t'
276
277
@@ -291,10 +292,10 @@ deleteMin : Dict k v -> Dict k v
291deleteMin t =
292deleteMin t =
292 let del t =
293 let del t =
293 case t of
294 case t of
294− Node _ _ _ Empty _ -> Empty
295+ RBNode _ _ _ RBEmpty _ -> RBEmpty
295 _ -> case moveRedLeftIfNeeded t of
296 _ -> case moveRedLeftIfNeeded t of
296− Node c k v l r -> fixUp (Node c k v (del l) r)
297+ RBNode c k v l r -> fixUp (RBNode c k v (del l) r)
297− Empty -> Empty
298+ RBEmpty -> RBEmpty
298 in ensureBlackRoot (del t)
299 in ensureBlackRoot (del t)
299
300
300{--
301{--
@@ -302,36 +303,37 @@ deleteMax t =
302 let del t =
303 let del t =
303 let t' = if isRedLeft t then rotateRight t else t in
304 let t' = if isRedLeft t then rotateRight t else t in
304 case t' of
305 case t' of
305− { Node _ _ _ _ Empty -> Empty
306+ { RBNode _ _ _ _ RBEmpty -> RBEmpty
306 ; _ -> let t'' = moveRedRightIfNeeded t' in
307 ; _ -> let t'' = moveRedRightIfNeeded t' in
307 case t'' of
308 case t'' of
308− { Node c k v l r -> fixUp (Node c k v l (del r))
309+ { RBNode c k v l r -> fixUp (RBNode c k v l (del r))
309− ; Empty -> Empty } }
310+ ; RBEmpty -> RBEmpty } }
310 in ensureBlackRoot (del t)
311 in ensureBlackRoot (del t)
311--}
312--}
312
313
313−-- Remove a key-value pair from a dictionary. If the key is not found, no changes are made.
314+-- Remove a key-value pair from a dictionary. If the key is not found,
315+-- no changes are made.
314−remove : k -> Dict k v -> Dict k v
316+remove : Comparable k -> Dict (Comparable k) v -> Dict (Comparable k) v
315remove k t =
317remove k t =
316 let eq_and_noRightNode t =
318 let eq_and_noRightNode t =
317− case t of { Node _ k' _ _ Empty -> k == k' ; _ -> False }
319+ case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }
318− eq t = case t of { Node _ k' _ _ _ -> k == k' ; _ -> False }
320+ eq t = case t of { RBNode _ k' _ _ _ -> k == k' ; _ -> False }
319 delLT t = case moveRedLeftIfNeeded t of
321 delLT t = case moveRedLeftIfNeeded t of
320− Node c k' v l r -> fixUp (Node c k' v (del l) r)
322+ RBNode c k' v l r -> fixUp (RBNode c k' v (del l) r)
321− Empty -> Error.raise "delLT on Empty"
323+ RBEmpty -> Error.raise "delLT on Empty"
322 delEQ t = case t of -- Replace with successor
324 delEQ t = case t of -- Replace with successor
323− Node c _ _ l r -> let (k',v') = min r in
325+ RBNode c _ _ l r -> let (k',v') = min r in
324− fixUp (Node c k' v' l (deleteMin r))
326+ fixUp (RBNode c k' v' l (deleteMin r))
325− Empty -> Error.raise "delEQ called on a Empty"
327+ RBEmpty -> Error.raise "delEQ called on a Empty"
326 delGT t = case t of
328 delGT t = case t of
327− Node c k' v l r -> fixUp (Node c k' v l (del r))
329+ RBNode c k' v l r -> fixUp (RBNode c k' v l (del r))
328− Empty -> Error.raise "delGT called on a Empty"
330+ RBEmpty -> Error.raise "delGT called on a Empty"
329 del t = case t of
331 del t = case t of
330− Empty -> Empty
332+ RBEmpty -> RBEmpty
331− Node _ k' _ _ _ ->
333+ RBNode _ k' _ _ _ ->
332 if k < k' then delLT t else
334 if k < k' then delLT t else
333 let u = if isRedLeft t then rotateRight t else t in
335 let u = if isRedLeft t then rotateRight t else t in
334− if eq_and_noRightNode u then Empty else
336+ if eq_and_noRightNode u then RBEmpty else
335 let t' = moveRedRightIfNeeded t in
337 let t' = moveRedRightIfNeeded t in
336 if eq t' then delEQ t' else delGT t'
338 if eq t' then delEQ t' else delGT t'
337 in if member k t then ensureBlackRoot (del t) else t
339 in if member k t then ensureBlackRoot (del t) else t
@@ -344,52 +346,58 @@ remove k t =
344--}
346--}
345
347
346-- Apply a function to all values in a dictionary.
348-- Apply a function to all values in a dictionary.
347−map : (a -> b) -> Dict k a -> Dict k b
349+map : (a -> b) -> Dict (Comparable k) a -> Dict (Comparable k) b
348map f t =
350map f t =
349 case t of
351 case t of
350− Empty -> Empty
352+ RBEmpty -> RBEmpty
351− Node c k v l r -> Node c k (f v) (map f l) (map f r)
353+ RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)
352
354
353−-- Fold over the key-value pairs in a dictionary, in order from lowest key to highest key.
355+-- Fold over the key-value pairs in a dictionary, in order from lowest
356+-- key to highest key.
354−foldl : (k -> v -> b -> b) -> b -> Dict k v -> b
357+foldl : (Comparable k -> v -> b -> b) -> b -> Dict (Comparable k) v -> b
355foldl f acc t =
358foldl f acc t =
356 case t of
359 case t of
357− Empty -> acc
360+ RBEmpty -> acc
358− Node _ k v l r -> foldl f (f k v (foldl f acc l)) r
361+ RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r
359
362
360−-- Fold over the key-value pairs in a dictionary, in order from highest key to lowest key.
363+-- Fold over the key-value pairs in a dictionary, in order from highest
364+-- key to lowest key.
361−foldr : (k -> v -> b -> b) -> b -> Dict k v -> b
365+foldr : (Comparable k -> v -> b -> b) -> b -> Dict (Comparable k) v -> b
362foldr f acc t =
366foldr f acc t =
363 case t of
367 case t of
364− Empty -> acc
368+ RBEmpty -> acc
365− Node _ k v l r -> foldr f (f k v (foldr f acc r)) l
369+ RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l
366
370
367−-- Combine two dictionaries. If there is a collision, preference is given to the first dictionary.
371+-- Combine two dictionaries. If there is a collision, preference is given
372+-- to the first dictionary.
368−union : Dict k v -> Dict k v -> Dict k v
373+union : Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v
369union t1 t2 = foldl insert t2 t1
374union t1 t2 = foldl insert t2 t1
370
375
371−-- Keep a key-value pair when its key appears in the second dictionary. Preference is given to values in the first dictionary.
376+-- Keep a key-value pair when its key appears in the second dictionary.
377+-- Preference is given to values in the first dictionary.
372−intersect : Dict k v -> Dict k v -> Dict k v
378+intersect : Dict (Comparable k) v
379+ -> Dict (Comparable k) v -> Dict (Comparable k) v
373intersect t1 t2 =
380intersect t1 t2 =
374 let combine k v t = if k `member` t2 then insert k v t else t
381 let combine k v t = if k `member` t2 then insert k v t else t
375 in foldl combine empty t1
382 in foldl combine empty t1
376
383
377−-- Keep a key-value pair when its key does not appear in the second dictionary. Preference is given to the first dictionary.
384+-- Keep a key-value pair when its key does not appear in the second dictionary.
385+-- Preference is given to the first dictionary.
378−diff : Dict k v -> Dict k v -> Dict k v
386+diff : Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v
379diff t1 t2 = foldl (\k v t -> remove k t) t1 t2
387diff t1 t2 = foldl (\k v t -> remove k t) t1 t2
380
388
381-- Get all of the keys in a dictionary.
389-- Get all of the keys in a dictionary.
382−keys : Dict k v -> [k]
390+keys : Dict (Comparable k) v -> [Comparable k]
383keys t = foldr (\k v acc -> k :: acc) [] t
391keys t = foldr (\k v acc -> k :: acc) [] t
384
392
385-- Get all of the values in a dictionary.
393-- Get all of the values in a dictionary.
386−values : Dict k v -> [v]
394+values : Dict (Comparable k) v -> [v]
387values t = foldr (\k v acc -> v :: acc) [] t
395values t = foldr (\k v acc -> v :: acc) [] t
388
396
389-- Convert a dictionary into an association list of key-value pairs.
397-- Convert a dictionary into an association list of key-value pairs.
390−toList : Dict k v -> [(k,v)]
398+toList : Dict (Comparable k) v -> [(Comparable k,v)]
391toList t = foldr (\k v acc -> (k,v) :: acc) [] t
399toList t = foldr (\k v acc -> (k,v) :: acc) [] t
392
400
393-- Convert an association list into a dictionary.
401-- Convert an association list into a dictionary.
394−fromList : [(k,v)] -> Dict k v
402+fromList : [(Comparable k,v)] -> Dict (Comparable k) v
395−fromList assocs = List.foldl (uncurry insert) empty assocs
403+fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs
libraries/Graphics/Color.elm+6−4
@@ -11,7 +11,8 @@ module Graphics.Color (rgba,rgb,hsva,hsv,
11
11
12data Color = Color Int Int Int Float
12data Color = Color Int Int Int Float
13
13
14+-- Create RGB colors with an alpha component for transparency.
14−-- Create RGB colors with an alpha component for transparency. The alpha component is specified with numbers between 0 and 1.
15+-- The alpha component is specified with numbers between 0 and 1.
15rgba : Int -> Int -> Int -> Float -> Color
16rgba : Int -> Int -> Int -> Float -> Color
16rgba = Color
17rgba = Color
17
18
@@ -88,8 +89,9 @@ data Gradient
88 = Linear (Float,Float) (Float,Float) [(Float,Color)]
89 = Linear (Float,Float) (Float,Float) [(Float,Color)]
89 | Radial (Float,Float) Float (Float,Float) Float [(Float,Color)]
90 | Radial (Float,Float) Float (Float,Float) Float [(Float,Color)]
90
91
92+linear : (Number a, Number a) ->
91−linear : (Number,Number) -> (Number,Number) -> [(Float,Color)] -> Gradient
93+ (Number a, Number a) -> [(Float,Color)] -> Gradient
92linear = Linear
94linear = Linear
93−radial : (Number,Number) -> Number ->
95+radial : (Number a,Number a) -> Number a ->
94− (Number,Number) -> Number -> [(Float,Color)] -> Gradient
96+ (Number a,Number a) -> Number a -> [(Float,Color)] -> Gradient
95radial = Radial
97radial = Radial
libraries/Graphics/Element.elm+2−2
@@ -147,9 +147,9 @@ layers es =
147
147
148-- Repetitive things --
148-- Repetitive things --
149
149
150−absolute : Pos
150+absolute : Int -> Pos
151absolute = Absolute
151absolute = Absolute
152−relative : Pos
152+relative : Float -> Pos
153relative = Relative
153relative = Relative
154
154
155middle : Position
155middle : Position
libraries/Json.elm+23−12
@@ -7,8 +7,9 @@ import Dict as Dict
7import JavaScript as JS
7import JavaScript as JS
8import Native.Json as Native
8import Native.Json as Native
9
9
10−-- This datatype can represent all valid values that can be held in a JSON object.
10+-- This datatype can represent all valid values that can be held in a JSON
11−-- In Elm, a proper JSON object is represented as a (Dict String Value) which is a mapping from strings to Json Values.
11+-- object. In Elm, a proper JSON object is represented as a (Dict String Value)
12+-- which is a mapping from strings to Json Values.
12data Value
13data Value
13 = String String
14 = String String
14 | Number Float
15 | Number Float
@@ -25,20 +26,24 @@ toString : Value -> String
25toString v = JS.toString (Native.toPrettyJSString "" v)
26toString v = JS.toString (Native.toPrettyJSString "" v)
26
27
27-- Convert a proper JSON object into a prettified string.
28-- Convert a proper JSON object into a prettified string.
29+-- The first argument is a separator token (e.g. \" \", \"\\n\", etc.) that will
28−-- The first argument is a separator token (e.g. \" \", \"\\n\", etc.) that will be used for indentation in the prettified string version of the JSON object.
30+-- be used for indentation in the prettified string version of the JSON object.
29toPrettyString : String -> Value -> String
31toPrettyString : String -> Value -> String
30toPrettyString sep v = JS.toString (Native.toPrettyJSString sep v)
32toPrettyString sep v = JS.toString (Native.toPrettyJSString sep v)
31
33
32-- Convert a proper JSON object into a JavaScript string.
34-- Convert a proper JSON object into a JavaScript string.
33−-- Note that the type JSString seen here is not the same as the type constructor JsonString used elsewhere in this module.
35+-- Note that the type JSString seen here is not the same as the type constructor
36+-- JsonString used elsewhere in this module.
34toJSString : Value -> JSString
37toJSString : Value -> JSString
35toJSString v = Native.toPrettyJSString "" v
38toJSString v = Native.toPrettyJSString "" v
36
39
37−-- Parse a string representation of a proper JSON object into its Elm's representation.
40+-- Parse a string representation of a proper JSON object into
41+-- its Elm's representation.
38fromString : String -> Maybe Value
42fromString : String -> Maybe Value
39fromString s = Native.fromJSString (JS.fromString s)
43fromString s = Native.fromJSString (JS.fromString s)
40
44
41−-- Parse a JavaScript string representation of a proper JSON object into its Elm's representation.
45+-- Parse a JavaScript string representation of a proper JSON object into
46+-- its Elm's representation.
42fromJSString : JSString -> Maybe Value
47fromJSString : JSString -> Maybe Value
43
48
44
49
@@ -62,7 +67,8 @@ object v = case v of { Object o -> o ; _ -> Dict.empty }
62
67
63-- Extract Elm values from dictionaries of Json values
68-- Extract Elm values from dictionaries of Json values
64
69
65−-- Find a value in a Json Object using the passed get function. If the key is not found, this returns the given default/base value.
70+-- Find a value in a Json Object using the passed get function. If the key is
71+-- not found, this returns the given default/base value.
66find get base =
72find get base =
67 let f key dict =
73 let f key dict =
68 case Dict.lookup key dict of
74 case Dict.lookup key dict of
@@ -70,22 +76,27 @@ find get base =
70 Just v -> get v
76 Just v -> get v
71 in f
77 in f
72
78
73−-- Find a string value in an Elm Json object. If the key is not found or the value found is not a string, this returns the empty string.
79+-- Find a string value in an Elm Json object. If the key is not found or the
80+-- value found is not a string, this returns the empty string.
74findString : String -> Dict String Value -> String
81findString : String -> Dict String Value -> String
75findString = find string ""
82findString = find string ""
76
83
77−-- Find a number value in an Elm Json object. If the key is not found or the value found is not a number, this returns 0
84+-- Find a number value in an Elm Json object. If the key is not found or the
85+-- value found is not a number, this returns 0
78findNumber : String -> Dict String Value -> Float
86findNumber : String -> Dict String Value -> Float
79findNumber = find number 0
87findNumber = find number 0
80
88
81−-- Find a boolean value in an Elm Json object. If the key is not found or the value found is not a boolean, this returns the False.
89+-- Find a boolean value in an Elm Json object. If the key is not found or the
90+-- value found is not a boolean, this returns the False.
82findBoolean : String -> Dict String Value -> Bool
91findBoolean : String -> Dict String Value -> Bool
83findBoolean = find boolean False
92findBoolean = find boolean False
84
93
85−-- Find an array value in an Elm Json object. If the key is not found or the value found is not an array, this returns an empty list.
94+-- Find an array value in an Elm Json object. If the key is not found or the
95+-- value found is not an array, this returns an empty list.
86findArray : String -> Dict String Value -> [Value]
96findArray : String -> Dict String Value -> [Value]
87findArray = find array []
97findArray = find array []
88
98
89−-- Find an object value in an Elm Json object. If the key is not found or the value found is not an object, this returns an empty object.
99+-- Find an object value in an Elm Json object. If the key is not found or the
100+-- value found is not an object, this returns an empty object.
90findObject : String -> Dict String Value -> Dict String Value
101findObject : String -> Dict String Value -> Dict String Value
91findObject = find object Dict.empty
102findObject = find object Dict.empty
libraries/List.elm+3−1
@@ -65,7 +65,9 @@ or : [Bool] -> Bool
65-- Flatten a list of lists.
65-- Flatten a list of lists.
66concat : [Appendable a] -> Appendable a
66concat : [Appendable a] -> Appendable a
67
67
68−-- Map a given function onto a list and flatten the resulting lists. (concatMap f xs == concat (map f xs))
68+-- Map a given function onto a list and flatten the resulting lists.
69+--
70+-- concatMap f xs == concat (map f xs)
69concatMap : (a -> Appendable b) -> [a] -> Appendable b
71concatMap : (a -> Appendable b) -> [a] -> Appendable b
70concatMap f = L.concat . L.map f
72concatMap f = L.concat . L.map f
71
73
libraries/Native/Prelude.js+1−1
@@ -89,7 +89,7 @@ Elm.Native.Prelude = function(elm) {
89 min:F2(min),
89 min:F2(min),
90 max:F2(max),
90 max:F2(max),
91 clamp:F3(clamp),
91 clamp:F3(clamp),
92−
92+ compare:Utils.compare,
93
93
94 xor:F2(xor),
94 xor:F2(xor),
95 not:not,
95 not:not,
libraries/Native/Show.js+1
@@ -11,6 +11,7 @@ Elm.Native.Show = function(elm) {
11 var JS = Elm.JavaScript(elm);
11 var JS = Elm.JavaScript(elm);
12 var Dict = Elm.Dict(elm);
12 var Dict = Elm.Dict(elm);
13 var Json = Elm.Json(elm);
13 var Json = Elm.Json(elm);
14+ var Tuple2 = Elm.Native.Utils(elm).Tuple2;
14
15
15 elm.node.addEventListener('log', function(e) { console.log(e.value); });
16 elm.node.addEventListener('log', function(e) { console.log(e.value); });
16 elm.node.addEventListener('title', function(e) {document.title = e.value;});
17 elm.node.addEventListener('title', function(e) {document.title = e.value;});
libraries/Native/Utils.js+2−1
@@ -112,7 +112,8 @@ Elm.Native.Utils = function(elm) {
112
112
113 return elm.Native.Utils = {
113 return elm.Native.Utils = {
114 eq:eq,
114 eq:eq,
115− compare:compare,
115+ cmp:compare,
116+ compare:F2(compare),
116 Tuple0:Tuple0,
117 Tuple0:Tuple0,
117 Tuple2:Tuple2,
118 Tuple2:Tuple2,
118 copy: copy,
119 copy: copy,
libraries/Prelude.elm+19−15
@@ -12,9 +12,9 @@ degrees d = d * Math.PI / 180
12turns : Float -> Float
12turns : Float -> Float
13turns r = 2 * Math.PI * r
13turns r = 2 * Math.PI * r
14
14
15−(+) : Number -> Number -> Number
15+(+) : Number a -> Number a -> Number a
16−(-) : Number -> Number -> Number
16+(-) : Number a -> Number a -> Number a
17−(*) : Number -> Number -> Number
17+(*) : Number a -> Number a -> Number a
18(/) : Float -> Float -> Float
18(/) : Float -> Float -> Float
19
19
20-- Integer division, remainder is discarded.
20-- Integer division, remainder is discarded.
@@ -40,21 +40,21 @@ atan : Float -> Float
40atan2 : Float -> Float -> Float
40atan2 : Float -> Float -> Float
41
41
42-- Take the square root of a number.
42-- Take the square root of a number.
43−sqrt : Number -> Number
43+sqrt : Number a -> Number a
44
44
45-- Take the absolute value of a number.
45-- Take the absolute value of a number.
46−abs : Number -> Number
46+abs : Number a -> Number a
47
47
48-- Calculate the logarithm of a number with a given base: `logBase 10 100 == 2`
48-- Calculate the logarithm of a number with a given base: `logBase 10 100 == 2`
49−logBase : Number -> Number -> Number
49+logBase : Number a -> Number a -> Number a
50
50
51-- Given two numbers, returns the smaller (or greater respectively).
51-- Given two numbers, returns the smaller (or greater respectively).
52−min : Number -> Number -> Number
52+min : Number a -> Number a -> Number a
53−max : Number -> Number -> Number
53+max : Number a -> Number a -> Number a
54
54
55-- Clamps a number within a given range, so `clamp 100 200 x` is 200 for
55-- Clamps a number within a given range, so `clamp 100 200 x` is 200 for
56-- x >= 200, 100 for x <= 100, and x for any 100 < x < 200
56-- x >= 200, 100 for x <= 100, and x for any 100 < x < 200
57−clamp : Number -> Number -> Number -> Number
57+clamp : Number a -> Number a -> Number a -> Number a
58
58
59-- An approximation of pi.
59-- An approximation of pi.
60pi : Float
60pi : Float
@@ -64,16 +64,20 @@ e : Float
64
64
65-- Compare any two values for structural equality and inequality.
65-- Compare any two values for structural equality and inequality.
66-- Functions cannot be compared.
66-- Functions cannot be compared.
67−(==) : a -> a -> Bool
67+(==) : Comparable a -> Comparable a -> Bool
68−(/=) : a -> a -> Bool
68+(/=) : Comparable a -> Comparable a -> Bool
69
69
70-- Compare any two comparable values. Comparable values include String, Char,
70-- Compare any two comparable values. Comparable values include String, Char,
71-- Int, Float, Time, or a list or tuple containing comparable values.
71-- Int, Float, Time, or a list or tuple containing comparable values.
72-- These are also the only values that work as Dictionary keys or Set members.
72-- These are also the only values that work as Dictionary keys or Set members.
73−(<) : a -> a -> Bool
73+(<) : Comparable a -> Comparable a -> Bool
74−(>) : a -> a -> Bool
74+(>) : Comparable a -> Comparable a -> Bool
75−(<=) : a -> a -> Bool
75+(<=) : Comparable a -> Comparable a -> Bool
76−(>=) : a -> a -> Bool
76+(>=) : Comparable a -> Comparable a -> Bool
77+
78+compare : Comparable a -> Comparable a -> Order
79+
80+data Order = LT | EQ | GT
77
81
78-- The and operator. True if both inputs are True.
82-- The and operator. True if both inputs are True.
79(&&) : Bool -> Bool -> Bool
83(&&) : Bool -> Bool -> Bool
libraries/Set.elm+17−16
@@ -12,53 +12,54 @@ import List as List
12type Set t = Dict t ()
12type Set t = Dict t ()
13
13
14-- Create an empty set.
14-- Create an empty set.
15−empty : Set t
15+empty : Set (Comparable k)
16empty = Dict.empty
16empty = Dict.empty
17
17
18-- Create a set with one value.
18-- Create a set with one value.
19−singleton : t -> Set t
19+singleton : Comparable k -> Set (Comparable k)
20singleton k = Dict.singleton k ()
20singleton k = Dict.singleton k ()
21
21
22-- Insert a value into a set.
22-- Insert a value into a set.
23−insert : t -> Set t -> Set t
23+insert : Comparable k -> Set (Comparable k) -> Set (Comparable k)
24insert k = Dict.insert k ()
24insert k = Dict.insert k ()
25
25
26-- Remove a value from a set. If the value is not found, no changes are made.
26-- Remove a value from a set. If the value is not found, no changes are made.
27−remove : t -> Set t -> Set t
27+remove : Comparable k -> Set (Comparable k) -> Set (Comparable k)
28remove = Dict.remove
28remove = Dict.remove
29
29
30-- Determine if a value is in a set.
30-- Determine if a value is in a set.
31−member : t -> Set t -> Bool
31+member : Comparable k -> Set (Comparable k) -> Bool
32member = Dict.member
32member = Dict.member
33
33
34-- Get the union of two sets. Keep all values.
34-- Get the union of two sets. Keep all values.
35−union : Set t -> Set t -> Set t
35+union : Set (Comparable k) -> Set (Comparable k) -> Set (Comparable k)
36union = Dict.union
36union = Dict.union
37
37
38-- Get the intersection of two sets. Keeps values that appear in both sets.
38-- Get the intersection of two sets. Keeps values that appear in both sets.
39−intersect : Set t -> Set t -> Set t
39+intersect : Set (Comparable k) -> Set (Comparable k) -> Set (Comparable k)
40intersect = Dict.intersect
40intersect = Dict.intersect
41
41
42−-- Get the difference between the first set and the second. Keeps values that do not appear in the second set.
42+-- Get the difference between the first set and the second. Keeps values
43+-- that do not appear in the second set.
43−diff : Set t -> Set t -> Set t
44+diff : Set (Comparable k) -> Set (Comparable k) -> Set (Comparable k)
44−diff = Dict.diff
45+diff s1 s2 = foldl remove s1 s2
45
46
46-- Convert a set into a list.
47-- Convert a set into a list.
47−toList : Set t -> [t]
48+toList : Set (Comparable k) -> [Comparable k]
48toList = Dict.keys
49toList = Dict.keys
49
50
50-- Convert a list into a set, removing any duplicates.
51-- Convert a list into a set, removing any duplicates.
51−fromList : [t] -> Set t
52+fromList : [Comparable k] -> Set (Comparable k)
52−fromList xs = List.foldl (\k t -> Dict.insert k () t) empty xs
53+fromList xs = List.foldl insert empty xs
53
54
54-- Fold over the values in a set, in order from lowest to highest.
55-- Fold over the values in a set, in order from lowest to highest.
55−foldl : (a -> b -> b) -> b -> Set a -> b
56+foldl : (Comparable a -> b -> b) -> b -> Set (Comparable a) -> b
56foldl f b s = Dict.foldl (\k _ b -> f k b) b s
57foldl f b s = Dict.foldl (\k _ b -> f k b) b s
57
58
58-- Fold over the values in a set, in order from highest to lowest.
59-- Fold over the values in a set, in order from highest to lowest.
59−foldr : (a -> b -> b) -> b -> Set a -> b
60+foldr : (Comparable a -> b -> b) -> b -> Set (Comparable a) -> b
60foldr f b s = Dict.foldr (\k _ b -> f k b) b s
61foldr f b s = Dict.foldr (\k _ b -> f k b) b s
61
62
62-- Map a function onto a set, creating a new set with no duplicates.
63-- Map a function onto a set, creating a new set with no duplicates.
63−map : (a -> b) -> Set a -> Set b
64+map : (Comparable a -> Comparable b) -> Set (Comparable a) -> Set (Comparable b)
64map f s = fromList (List.map f (toList s))
65map f s = fromList (List.map f (toList s))