@@ -8,8 +8,9 @@ module Dict (empty,singleton,insert
88 ,toList,fromList
99 ) where
1010
11−import Maybe as Maybe
12−import Native.Error as Error
11+import open Basics
12+import open Maybe
13+import Native.Error
1314import List as List
1415import Native.Utils (compare)
1516
@@ -18,7 +19,7 @@ data NColor = Red | Black
1819data Dict k v = RBNode NColor k v (Dict k v) (Dict k v) | RBEmpty
1920
2021-- Create an empty dictionary.
21−empty : Dict (Comparable k) v
22+empty : Dict comparable v
2223empty = RBEmpty
2324
2425{-- Helpers for checking invariants
@@ -104,31 +105,31 @@ min t =
104105 case t of
105106 RBNode _ k v RBEmpty _ -> (k,v)
106107 RBNode _ _ _ l _ -> min l
107− RBEmpty -> Error.raise "(min Empty) is not defined"
108+ RBEmpty -> Native.Error.raise "(min Empty) is not defined"
108109
109110{--
110111max t =
111112 case t of
112113 { RBNode _ k v _ RBEmpty -> (k,v)
113114 ; RBNode _ _ _ _ r -> max r
114− ; RBEmpty -> Error.raise "(max Empty) is not defined"
115+ ; RBEmpty -> Native.Error.raise "(max Empty) is not defined"
115116 }
116117--}
117118
118119-- Lookup the value associated with a key.
119−lookup : Comparable k -> Dict (Comparable k) v -> Maybe v
120+lookup : comparable -> Dict comparable v -> Maybe v
120121lookup k t =
121122 case t of
122− RBEmpty -> Maybe.Nothing
123+ RBEmpty -> Nothing
123124 RBNode _ k' v l r ->
124125 case compare k k' of
125126 LT -> lookup k l
126− EQ -> Maybe.Just v
127+ EQ -> Just v
127128 GT -> lookup k r
128129
129130-- Find the value associated with a key. If the key is not found,
130131-- return the default value.
131−findWithDefault : v -> Comparable k -> Dict (Comparable k) v -> v
132+findWithDefault : v -> comparable -> Dict comparable v -> v
132133findWithDefault base k t =
133134 case t of
134135 RBEmpty -> base
@@ -142,7 +143,7 @@ findWithDefault base k t =
142143-- Find the value associated with a key. If the key is not found, there will be a runtime error.
143144find k t =
144145 case t of
145− { RBEmpty -> Error.raise "Key was not found in dictionary!"
146+ { RBEmpty -> Native.Error.raise "Key was not found in dictionary!"
146147 ; RBNode _ k' v l r ->
147148 case compare k k' of
148149 { LT -> find k l
@@ -152,15 +153,15 @@ find k t =
152153--}
153154
154155-- Determine if a key is in a dictionary.
155−member : Comparable k -> Dict (Comparable k) v -> Bool
156+member : comparable -> Dict comparable v -> Bool
156157-- Does t contain k?
157−member k t = Maybe.isJust $ lookup k t
158+member k t = isJust <| lookup k t
158159
159160rotateLeft : Dict k v -> Dict k v
160161rotateLeft t =
161162 case t of
162163 RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c
163− _ -> Error.raise "rotateLeft of a node without enough children"
164+ _ -> Native.Error.raise "rotateLeft of a node without enough children"
164165
165166-- rotateRight -- the reverse, and
166167-- makes Y have Z's color, and makes Z Red.
@@ -168,7 +169,7 @@ rotateRight : Dict k v -> Dict k v
168169rotateRight t =
169170 case t of
170171 RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)
171− _ -> Error.raise "rotateRight of a node without enough children"
172+ _ -> Native.Error.raise "rotateRight of a node without enough children"
172173
173174rotateLeftIfNeeded : Dict k v -> Dict k v
174175rotateLeftIfNeeded t =
@@ -191,7 +192,7 @@ color_flip t =
191192 RBNode (otherColor c1) bk bv
192193 (RBNode (otherColor c2) ak av la ra)
193194 (RBNode (otherColor c3) ck cv lc rc)
194− _ -> Error.raise "color_flip called on a Empty or Node with a Empty child"
195+ _ -> Native.Error.raise "color_flip called on a Empty or Node with a Empty child"
195196
196197color_flipIfNeeded : Dict k v -> Dict k v
197198color_flipIfNeeded t =
@@ -209,7 +210,7 @@ ensureBlackRoot t =
209210
210211-- Insert a key-value pair into a dictionary. Replaces value when there is
211212-- a collision.
212−insert : Comparable k -> v -> Dict (Comparable k) v -> Dict (Comparable k) v
213+insert : comparable -> v -> Dict comparable v -> Dict comparable v
213214insert k v t = -- Invariant: t is a valid left-leaning rb tree
214215 let ins t =
215216 case t of
@@ -223,15 +224,15 @@ insert k v t = -- Invariant: t is a valid left-leaning rb tree
223224 in ensureBlackRoot (ins t)
224225{--
225226 if not (invariants_hold t) then
226− Error.raise "invariants broken before insert"
227+ Native.Error.raise "invariants broken before insert"
227228 else (let new_t = ensureBlackRoot (ins t) in
228229 if not (invariants_hold new_t) then
229− Error.raise "invariants broken after insert"
230+ Native.Error.raise "invariants broken after insert"
230231 else new_t)
231232--}
232233
233234-- Create a dictionary with one key-value pair.
234−singleton : Comparable k -> v -> Dict (Comparable k) v
235+singleton : comparable -> v -> Dict comparable v
235236singleton k v = insert k v RBEmpty
236237
237238isRed : Dict k v -> Bool
@@ -313,21 +314,21 @@ deleteMax t =
313314
314315-- Remove a key-value pair from a dictionary. If the key is not found,
315316-- no changes are made.
316−remove : Comparable k -> Dict (Comparable k) v -> Dict (Comparable k) v
317+remove : comparable -> Dict comparable v -> Dict comparable v
317318remove k t =
318319 let eq_and_noRightNode t =
319320 case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }
320321 eq t = case t of { RBNode _ k' _ _ _ -> k == k' ; _ -> False }
321322 delLT t = case moveRedLeftIfNeeded t of
322323 RBNode c k' v l r -> fixUp (RBNode c k' v (del l) r)
323− RBEmpty -> Error.raise "delLT on Empty"
324+ RBEmpty -> Native.Error.raise "delLT on Empty"
324325 delEQ t = case t of -- Replace with successor
325326 RBNode c _ _ l r -> let (k',v') = min r in
326327 fixUp (RBNode c k' v' l (deleteMin r))
327− RBEmpty -> Error.raise "delEQ called on a Empty"
328+ RBEmpty -> Native.Error.raise "delEQ called on a Empty"
328329 delGT t = case t of
329330 RBNode c k' v l r -> fixUp (RBNode c k' v l (del r))
330− RBEmpty -> Error.raise "delGT called on a Empty"
331+ RBEmpty -> Native.Error.raise "delGT called on a Empty"
331332 del t = case t of
332333 RBEmpty -> RBEmpty
333334 RBNode _ k' _ _ _ ->
@@ -339,14 +340,14 @@ remove k t =
339340 in if member k t then ensureBlackRoot (del t) else t
340341{--
341342 if not (invariants_hold t) then
342− Error.raise "invariants broken before remove"
343+ Native.Error.raise "invariants broken before remove"
343344 else (let t' = ensureBlackRoot (del t) in
344345 if invariants_hold t' then t' else
345− Error.raise "invariants broken after remove")
346+ Native.Error.raise "invariants broken after remove")
346347--}
347348
348349-- Apply a function to all values in a dictionary.
349−map : (a -> b) -> Dict (Comparable k) a -> Dict (Comparable k) b
350+map : (a -> b) -> Dict comparable a -> Dict comparable b
350351map f t =
351352 case t of
352353 RBEmpty -> RBEmpty
@@ -354,7 +355,7 @@ map f t =
354355
355356-- Fold over the key-value pairs in a dictionary, in order from lowest
356357-- key to highest key.
357−foldl : (Comparable k -> v -> b -> b) -> b -> Dict (Comparable k) v -> b
358+foldl : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b
358359foldl f acc t =
359360 case t of
360361 RBEmpty -> acc
@@ -362,7 +363,7 @@ foldl f acc t =
362363
363364-- Fold over the key-value pairs in a dictionary, in order from highest
364365-- key to lowest key.
365−foldr : (Comparable k -> v -> b -> b) -> b -> Dict (Comparable k) v -> b
366+foldr : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b
366367foldr f acc t =
367368 case t of
368369 RBEmpty -> acc
@@ -370,33 +371,33 @@ foldr f acc t =
370371
371372-- Combine two dictionaries. If there is a collision, preference is given
372373-- to the first dictionary.
373−union : Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v
374+union : Dict comparable v -> Dict comparable v -> Dict comparable v
374375union t1 t2 = foldl insert t2 t1
375376
376377-- Keep a key-value pair when its key appears in the second dictionary.
377378-- Preference is given to values in the first dictionary.
378−intersect : Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v
379+intersect : Dict comparable v -> Dict comparable v -> Dict comparable v
379380intersect t1 t2 =
380381 let combine k v t = if k `member` t2 then insert k v t else t
381382 in foldl combine empty t1
382383
383384-- Keep a key-value pair when its key does not appear in the second dictionary.
384385-- Preference is given to the first dictionary.
385−diff : Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v
386+diff : Dict comparable v -> Dict comparable v -> Dict comparable v
386387diff t1 t2 = foldl (\k v t -> remove k t) t1 t2
387388
388389-- Get all of the keys in a dictionary.
389−keys : Dict (Comparable k) v -> [Comparable k]
390+keys : Dict comparable v -> [comparable]
390391keys t = foldr (\k v acc -> k :: acc) [] t
391392
392393-- Get all of the values in a dictionary.
393−values : Dict (Comparable k) v -> [v]
394+values : Dict comparable v -> [v]
394395values t = foldr (\k v acc -> v :: acc) [] t
395396
396397-- Convert a dictionary into an association list of key-value pairs.
397−toList : Dict (Comparable k) v -> [(Comparable k,v)]
398+toList : Dict comparable v -> [(comparable,v)]
398399toList t = foldr (\k v acc -> (k,v) :: acc) [] t
399400
400401-- Convert an association list into a dictionary.
401−fromList : [(Comparable k,v)] -> Dict (Comparable k) v
402+fromList : [(comparable,v)] -> Dict comparable v
402403fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs