1 (* ========================================================================= *) |
|
2 (* FINITE MAPS IMPLEMENTED WITH RANDOMLY BALANCED TREES *) |
|
3 (* Copyright (c) 2004-2006 Joe Hurd, distributed under the BSD License *) |
|
4 (* ========================================================================= *) |
|
5 |
|
6 structure RandomMap :> Map = |
|
7 struct |
|
8 |
|
9 exception Bug = Useful.Bug; |
|
10 |
|
11 exception Error = Useful.Error; |
|
12 |
|
13 val pointerEqual = Portable.pointerEqual; |
|
14 |
|
15 val K = Useful.K; |
|
16 |
|
17 val snd = Useful.snd; |
|
18 |
|
19 val randomInt = Portable.randomInt; |
|
20 |
|
21 val randomWord = Portable.randomWord; |
|
22 |
|
23 (* ------------------------------------------------------------------------- *) |
|
24 (* Random search trees. *) |
|
25 (* ------------------------------------------------------------------------- *) |
|
26 |
|
27 type priority = Word.word; |
|
28 |
|
29 datatype ('a,'b) tree = |
|
30 E |
|
31 | T of |
|
32 {size : int, |
|
33 priority : priority, |
|
34 left : ('a,'b) tree, |
|
35 key : 'a, |
|
36 value : 'b, |
|
37 right : ('a,'b) tree}; |
|
38 |
|
39 type ('a,'b) node = |
|
40 {size : int, |
|
41 priority : priority, |
|
42 left : ('a,'b) tree, |
|
43 key : 'a, |
|
44 value : 'b, |
|
45 right : ('a,'b) tree}; |
|
46 |
|
47 datatype ('a,'b) map = Map of ('a * 'a -> order) * ('a,'b) tree; |
|
48 |
|
49 (* ------------------------------------------------------------------------- *) |
|
50 (* Random priorities. *) |
|
51 (* ------------------------------------------------------------------------- *) |
|
52 |
|
53 local |
|
54 val randomPriority = randomWord; |
|
55 |
|
56 val priorityOrder = Word.compare; |
|
57 in |
|
58 fun treeSingleton (key,value) = |
|
59 T {size = 1, priority = randomPriority (), |
|
60 left = E, key = key, value = value, right = E}; |
|
61 |
|
62 fun nodePriorityOrder cmp (x1 : ('a,'b) node, x2 : ('a,'b) node) = |
|
63 let |
|
64 val {priority = p1, key = k1, ...} = x1 |
|
65 and {priority = p2, key = k2, ...} = x2 |
|
66 in |
|
67 case priorityOrder (p1,p2) of |
|
68 LESS => LESS |
|
69 | EQUAL => cmp (k1,k2) |
|
70 | GREATER => GREATER |
|
71 end; |
|
72 end; |
|
73 |
|
74 (* ------------------------------------------------------------------------- *) |
|
75 (* Debugging functions. *) |
|
76 (* ------------------------------------------------------------------------- *) |
|
77 |
|
78 local |
|
79 fun checkSizes E = 0 |
|
80 | checkSizes (T {size,left,right,...}) = |
|
81 let |
|
82 val l = checkSizes left |
|
83 and r = checkSizes right |
|
84 val () = if l + 1 + r = size then () else raise Error "wrong size" |
|
85 in |
|
86 size |
|
87 end; |
|
88 |
|
89 fun checkSorted _ x E = x |
|
90 | checkSorted cmp x (T {left,key,right,...}) = |
|
91 let |
|
92 val x = checkSorted cmp x left |
|
93 val () = |
|
94 case x of |
|
95 NONE => () |
|
96 | SOME k => |
|
97 case cmp (k,key) of |
|
98 LESS => () |
|
99 | EQUAL => raise Error "duplicate keys" |
|
100 | GREATER => raise Error "unsorted" |
|
101 in |
|
102 checkSorted cmp (SOME key) right |
|
103 end; |
|
104 |
|
105 fun checkPriorities _ E = NONE |
|
106 | checkPriorities cmp (T (x as {left,right,...})) = |
|
107 let |
|
108 val () = |
|
109 case checkPriorities cmp left of |
|
110 NONE => () |
|
111 | SOME l => |
|
112 case nodePriorityOrder cmp (l,x) of |
|
113 LESS => () |
|
114 | EQUAL => raise Error "left child has equal key" |
|
115 | GREATER => raise Error "left child has greater priority" |
|
116 val () = |
|
117 case checkPriorities cmp right of |
|
118 NONE => () |
|
119 | SOME r => |
|
120 case nodePriorityOrder cmp (r,x) of |
|
121 LESS => () |
|
122 | EQUAL => raise Error "right child has equal key" |
|
123 | GREATER => raise Error "right child has greater priority" |
|
124 in |
|
125 SOME x |
|
126 end; |
|
127 in |
|
128 fun checkWellformed s (m as Map (cmp,tree)) = |
|
129 (let |
|
130 val _ = checkSizes tree |
|
131 val _ = checkSorted cmp NONE tree |
|
132 val _ = checkPriorities cmp tree |
|
133 in |
|
134 m |
|
135 end |
|
136 handle Error err => raise Bug err) |
|
137 handle Bug bug => raise Bug (s ^ "\nRandomMap.checkWellformed: " ^ bug); |
|
138 end; |
|
139 |
|
140 (* ------------------------------------------------------------------------- *) |
|
141 (* Basic operations. *) |
|
142 (* ------------------------------------------------------------------------- *) |
|
143 |
|
144 fun comparison (Map (cmp,_)) = cmp; |
|
145 |
|
146 fun new cmp = Map (cmp,E); |
|
147 |
|
148 fun treeSize E = 0 |
|
149 | treeSize (T {size = s, ...}) = s; |
|
150 |
|
151 fun size (Map (_,tree)) = treeSize tree; |
|
152 |
|
153 fun mkT p l k v r = |
|
154 T {size = treeSize l + 1 + treeSize r, priority = p, |
|
155 left = l, key = k, value = v, right = r}; |
|
156 |
|
157 fun singleton cmp key_value = Map (cmp, treeSingleton key_value); |
|
158 |
|
159 local |
|
160 fun treePeek cmp E pkey = NONE |
|
161 | treePeek cmp (T {left,key,value,right,...}) pkey = |
|
162 case cmp (pkey,key) of |
|
163 LESS => treePeek cmp left pkey |
|
164 | EQUAL => SOME value |
|
165 | GREATER => treePeek cmp right pkey |
|
166 in |
|
167 fun peek (Map (cmp,tree)) key = treePeek cmp tree key; |
|
168 end; |
|
169 |
|
170 (* treeAppend assumes that every element of the first tree is less than *) |
|
171 (* every element of the second tree. *) |
|
172 |
|
173 fun treeAppend _ t1 E = t1 |
|
174 | treeAppend _ E t2 = t2 |
|
175 | treeAppend cmp (t1 as T x1) (t2 as T x2) = |
|
176 case nodePriorityOrder cmp (x1,x2) of |
|
177 LESS => |
|
178 let |
|
179 val {priority = p2, |
|
180 left = l2, key = k2, value = v2, right = r2, ...} = x2 |
|
181 in |
|
182 mkT p2 (treeAppend cmp t1 l2) k2 v2 r2 |
|
183 end |
|
184 | EQUAL => raise Bug "RandomSet.treeAppend: equal keys" |
|
185 | GREATER => |
|
186 let |
|
187 val {priority = p1, |
|
188 left = l1, key = k1, value = v1, right = r1, ...} = x1 |
|
189 in |
|
190 mkT p1 l1 k1 v1 (treeAppend cmp r1 t2) |
|
191 end; |
|
192 |
|
193 (* nodePartition splits the node into three parts: the keys comparing less *) |
|
194 (* than the supplied key, an optional equal key, and the keys comparing *) |
|
195 (* greater. *) |
|
196 |
|
197 local |
|
198 fun mkLeft [] t = t |
|
199 | mkLeft (({priority,left,key,value,...} : ('a,'b) node) :: xs) t = |
|
200 mkLeft xs (mkT priority left key value t); |
|
201 |
|
202 fun mkRight [] t = t |
|
203 | mkRight (({priority,key,value,right,...} : ('a,'b) node) :: xs) t = |
|
204 mkRight xs (mkT priority t key value right); |
|
205 |
|
206 fun treePart _ _ lefts rights E = (mkLeft lefts E, NONE, mkRight rights E) |
|
207 | treePart cmp pkey lefts rights (T x) = nodePart cmp pkey lefts rights x |
|
208 and nodePart cmp pkey lefts rights (x as {left,key,value,right,...}) = |
|
209 case cmp (pkey,key) of |
|
210 LESS => treePart cmp pkey lefts (x :: rights) left |
|
211 | EQUAL => (mkLeft lefts left, SOME (key,value), mkRight rights right) |
|
212 | GREATER => treePart cmp pkey (x :: lefts) rights right; |
|
213 in |
|
214 fun nodePartition cmp x pkey = nodePart cmp pkey [] [] x; |
|
215 end; |
|
216 |
|
217 (* union first calls treeCombineRemove, to combine the values *) |
|
218 (* for equal keys into the first map and remove them from the second map. *) |
|
219 (* Note that the combined key is always the one from the second map. *) |
|
220 |
|
221 local |
|
222 fun treeCombineRemove _ _ t1 E = (t1,E) |
|
223 | treeCombineRemove _ _ E t2 = (E,t2) |
|
224 | treeCombineRemove cmp f (t1 as T x1) (t2 as T x2) = |
|
225 let |
|
226 val {priority = p1, |
|
227 left = l1, key = k1, value = v1, right = r1, ...} = x1 |
|
228 val (l2,k2_v2,r2) = nodePartition cmp x2 k1 |
|
229 val (l1,l2) = treeCombineRemove cmp f l1 l2 |
|
230 and (r1,r2) = treeCombineRemove cmp f r1 r2 |
|
231 in |
|
232 case k2_v2 of |
|
233 NONE => |
|
234 if treeSize l2 + treeSize r2 = #size x2 then (t1,t2) |
|
235 else (mkT p1 l1 k1 v1 r1, treeAppend cmp l2 r2) |
|
236 | SOME (k2,v2) => |
|
237 case f (v1,v2) of |
|
238 NONE => (treeAppend cmp l1 r1, treeAppend cmp l2 r2) |
|
239 | SOME v => (mkT p1 l1 k2 v r1, treeAppend cmp l2 r2) |
|
240 end; |
|
241 |
|
242 fun treeUnionDisjoint _ t1 E = t1 |
|
243 | treeUnionDisjoint _ E t2 = t2 |
|
244 | treeUnionDisjoint cmp (T x1) (T x2) = |
|
245 case nodePriorityOrder cmp (x1,x2) of |
|
246 LESS => nodeUnionDisjoint cmp x2 x1 |
|
247 | EQUAL => raise Bug "RandomSet.unionDisjoint: equal keys" |
|
248 | GREATER => nodeUnionDisjoint cmp x1 x2 |
|
249 and nodeUnionDisjoint cmp x1 x2 = |
|
250 let |
|
251 val {priority = p1, |
|
252 left = l1, key = k1, value = v1, right = r1, ...} = x1 |
|
253 val (l2,_,r2) = nodePartition cmp x2 k1 |
|
254 val l = treeUnionDisjoint cmp l1 l2 |
|
255 and r = treeUnionDisjoint cmp r1 r2 |
|
256 in |
|
257 mkT p1 l k1 v1 r |
|
258 end; |
|
259 in |
|
260 fun union f (m1 as Map (cmp,t1)) (Map (_,t2)) = |
|
261 if pointerEqual (t1,t2) then m1 |
|
262 else |
|
263 let |
|
264 val (t1,t2) = treeCombineRemove cmp f t1 t2 |
|
265 in |
|
266 Map (cmp, treeUnionDisjoint cmp t1 t2) |
|
267 end; |
|
268 end; |
|
269 |
|
270 (*DEBUG |
|
271 val union = fn f => fn t1 => fn t2 => |
|
272 checkWellformed "RandomMap.union: result" |
|
273 (union f (checkWellformed "RandomMap.union: input 1" t1) |
|
274 (checkWellformed "RandomMap.union: input 2" t2)); |
|
275 *) |
|
276 |
|
277 (* intersect is a simple case of the union algorithm. *) |
|
278 |
|
279 local |
|
280 fun treeIntersect _ _ _ E = E |
|
281 | treeIntersect _ _ E _ = E |
|
282 | treeIntersect cmp f (t1 as T x1) (t2 as T x2) = |
|
283 let |
|
284 val {priority = p1, |
|
285 left = l1, key = k1, value = v1, right = r1, ...} = x1 |
|
286 val (l2,k2_v2,r2) = nodePartition cmp x2 k1 |
|
287 val l = treeIntersect cmp f l1 l2 |
|
288 and r = treeIntersect cmp f r1 r2 |
|
289 in |
|
290 case k2_v2 of |
|
291 NONE => treeAppend cmp l r |
|
292 | SOME (k2,v2) => |
|
293 case f (v1,v2) of |
|
294 NONE => treeAppend cmp l r |
|
295 | SOME v => mkT p1 l k2 v r |
|
296 end; |
|
297 in |
|
298 fun intersect f (m1 as Map (cmp,t1)) (Map (_,t2)) = |
|
299 if pointerEqual (t1,t2) then m1 |
|
300 else Map (cmp, treeIntersect cmp f t1 t2); |
|
301 end; |
|
302 |
|
303 (*DEBUG |
|
304 val intersect = fn f => fn t1 => fn t2 => |
|
305 checkWellformed "RandomMap.intersect: result" |
|
306 (intersect f (checkWellformed "RandomMap.intersect: input 1" t1) |
|
307 (checkWellformed "RandomMap.intersect: input 2" t2)); |
|
308 *) |
|
309 |
|
310 (* delete raises an exception if the supplied key is not found, which *) |
|
311 (* makes it simpler to maximize sharing. *) |
|
312 |
|
313 local |
|
314 fun treeDelete _ E _ = raise Error "RandomMap.delete: element not found" |
|
315 | treeDelete cmp (T {priority,left,key,value,right,...}) dkey = |
|
316 case cmp (dkey,key) of |
|
317 LESS => mkT priority (treeDelete cmp left dkey) key value right |
|
318 | EQUAL => treeAppend cmp left right |
|
319 | GREATER => mkT priority left key value (treeDelete cmp right dkey); |
|
320 in |
|
321 fun delete (Map (cmp,tree)) key = Map (cmp, treeDelete cmp tree key); |
|
322 end; |
|
323 |
|
324 (*DEBUG |
|
325 val delete = fn t => fn x => |
|
326 checkWellformed "RandomMap.delete: result" |
|
327 (delete (checkWellformed "RandomMap.delete: input" t) x); |
|
328 *) |
|
329 |
|
330 (* Set difference on domains *) |
|
331 |
|
332 local |
|
333 fun treeDifference _ t1 E = t1 |
|
334 | treeDifference _ E _ = E |
|
335 | treeDifference cmp (t1 as T x1) (T x2) = |
|
336 let |
|
337 val {size = s1, priority = p1, |
|
338 left = l1, key = k1, value = v1, right = r1} = x1 |
|
339 val (l2,k2_v2,r2) = nodePartition cmp x2 k1 |
|
340 val l = treeDifference cmp l1 l2 |
|
341 and r = treeDifference cmp r1 r2 |
|
342 in |
|
343 if Option.isSome k2_v2 then treeAppend cmp l r |
|
344 else if treeSize l + treeSize r + 1 = s1 then t1 |
|
345 else mkT p1 l k1 v1 r |
|
346 end; |
|
347 in |
|
348 fun difference (Map (cmp,tree1)) (Map (_,tree2)) = |
|
349 Map (cmp, treeDifference cmp tree1 tree2); |
|
350 end; |
|
351 |
|
352 (*DEBUG |
|
353 val difference = fn t1 => fn t2 => |
|
354 checkWellformed "RandomMap.difference: result" |
|
355 (difference (checkWellformed "RandomMap.difference: input 1" t1) |
|
356 (checkWellformed "RandomMap.difference: input 2" t2)); |
|
357 *) |
|
358 |
|
359 (* subsetDomain is mainly used when using maps as sets. *) |
|
360 |
|
361 local |
|
362 fun treeSubsetDomain _ E _ = true |
|
363 | treeSubsetDomain _ _ E = false |
|
364 | treeSubsetDomain cmp (t1 as T x1) (T x2) = |
|
365 let |
|
366 val {size = s1, left = l1, key = k1, right = r1, ...} = x1 |
|
367 and {size = s2, ...} = x2 |
|
368 in |
|
369 s1 <= s2 andalso |
|
370 let |
|
371 val (l2,k2_v2,r2) = nodePartition cmp x2 k1 |
|
372 in |
|
373 Option.isSome k2_v2 andalso |
|
374 treeSubsetDomain cmp l1 l2 andalso |
|
375 treeSubsetDomain cmp r1 r2 |
|
376 end |
|
377 end; |
|
378 in |
|
379 fun subsetDomain (Map (cmp,tree1)) (Map (_,tree2)) = |
|
380 pointerEqual (tree1,tree2) orelse |
|
381 treeSubsetDomain cmp tree1 tree2; |
|
382 end; |
|
383 |
|
384 (* Map equality *) |
|
385 |
|
386 local |
|
387 fun treeEqual _ _ E E = true |
|
388 | treeEqual _ _ E _ = false |
|
389 | treeEqual _ _ _ E = false |
|
390 | treeEqual cmp veq (t1 as T x1) (T x2) = |
|
391 let |
|
392 val {size = s1, left = l1, key = k1, value = v1, right = r1, ...} = x1 |
|
393 and {size = s2, ...} = x2 |
|
394 in |
|
395 s1 = s2 andalso |
|
396 let |
|
397 val (l2,k2_v2,r2) = nodePartition cmp x2 k1 |
|
398 in |
|
399 (case k2_v2 of NONE => false | SOME (_,v2) => veq v1 v2) andalso |
|
400 treeEqual cmp veq l1 l2 andalso |
|
401 treeEqual cmp veq r1 r2 |
|
402 end |
|
403 end; |
|
404 in |
|
405 fun equal veq (Map (cmp,tree1)) (Map (_,tree2)) = |
|
406 pointerEqual (tree1,tree2) orelse |
|
407 treeEqual cmp veq tree1 tree2; |
|
408 end; |
|
409 |
|
410 (* mapPartial is the basic function for preserving the tree structure. *) |
|
411 (* It applies the argument function to the elements *in order*. *) |
|
412 |
|
413 local |
|
414 fun treeMapPartial cmp _ E = E |
|
415 | treeMapPartial cmp f (T {priority,left,key,value,right,...}) = |
|
416 let |
|
417 val left = treeMapPartial cmp f left |
|
418 and value' = f (key,value) |
|
419 and right = treeMapPartial cmp f right |
|
420 in |
|
421 case value' of |
|
422 NONE => treeAppend cmp left right |
|
423 | SOME value => mkT priority left key value right |
|
424 end; |
|
425 in |
|
426 fun mapPartial f (Map (cmp,tree)) = Map (cmp, treeMapPartial cmp f tree); |
|
427 end; |
|
428 |
|
429 (* map is a primitive function for efficiency reasons. *) |
|
430 (* It also applies the argument function to the elements *in order*. *) |
|
431 |
|
432 local |
|
433 fun treeMap _ E = E |
|
434 | treeMap f (T {size,priority,left,key,value,right}) = |
|
435 let |
|
436 val left = treeMap f left |
|
437 and value = f (key,value) |
|
438 and right = treeMap f right |
|
439 in |
|
440 T {size = size, priority = priority, left = left, |
|
441 key = key, value = value, right = right} |
|
442 end; |
|
443 in |
|
444 fun map f (Map (cmp,tree)) = Map (cmp, treeMap f tree); |
|
445 end; |
|
446 |
|
447 (* nth picks the nth smallest key/value (counting from 0). *) |
|
448 |
|
449 local |
|
450 fun treeNth E _ = raise Subscript |
|
451 | treeNth (T {left,key,value,right,...}) n = |
|
452 let |
|
453 val k = treeSize left |
|
454 in |
|
455 if n = k then (key,value) |
|
456 else if n < k then treeNth left n |
|
457 else treeNth right (n - (k + 1)) |
|
458 end; |
|
459 in |
|
460 fun nth (Map (_,tree)) n = treeNth tree n; |
|
461 end; |
|
462 |
|
463 (* ------------------------------------------------------------------------- *) |
|
464 (* Iterators. *) |
|
465 (* ------------------------------------------------------------------------- *) |
|
466 |
|
467 fun leftSpine E acc = acc |
|
468 | leftSpine (t as T {left,...}) acc = leftSpine left (t :: acc); |
|
469 |
|
470 fun rightSpine E acc = acc |
|
471 | rightSpine (t as T {right,...}) acc = rightSpine right (t :: acc); |
|
472 |
|
473 datatype ('key,'a) iterator = |
|
474 LR of ('key * 'a) * ('key,'a) tree * ('key,'a) tree list |
|
475 | RL of ('key * 'a) * ('key,'a) tree * ('key,'a) tree list; |
|
476 |
|
477 fun mkLR [] = NONE |
|
478 | mkLR (T {key,value,right,...} :: l) = SOME (LR ((key,value),right,l)) |
|
479 | mkLR (E :: _) = raise Bug "RandomMap.mkLR"; |
|
480 |
|
481 fun mkRL [] = NONE |
|
482 | mkRL (T {key,value,left,...} :: l) = SOME (RL ((key,value),left,l)) |
|
483 | mkRL (E :: _) = raise Bug "RandomMap.mkRL"; |
|
484 |
|
485 fun mkIterator (Map (_,tree)) = mkLR (leftSpine tree []); |
|
486 |
|
487 fun mkRevIterator (Map (_,tree)) = mkRL (rightSpine tree []); |
|
488 |
|
489 fun readIterator (LR (key_value,_,_)) = key_value |
|
490 | readIterator (RL (key_value,_,_)) = key_value; |
|
491 |
|
492 fun advanceIterator (LR (_,next,l)) = mkLR (leftSpine next l) |
|
493 | advanceIterator (RL (_,next,l)) = mkRL (rightSpine next l); |
|
494 |
|
495 (* ------------------------------------------------------------------------- *) |
|
496 (* Derived operations. *) |
|
497 (* ------------------------------------------------------------------------- *) |
|
498 |
|
499 fun null m = size m = 0; |
|
500 |
|
501 fun get m key = |
|
502 case peek m key of |
|
503 NONE => raise Error "RandomMap.get: element not found" |
|
504 | SOME value => value; |
|
505 |
|
506 fun inDomain key m = Option.isSome (peek m key); |
|
507 |
|
508 fun insert m key_value = |
|
509 union (SOME o snd) m (singleton (comparison m) key_value); |
|
510 |
|
511 (*DEBUG |
|
512 val insert = fn m => fn x => |
|
513 checkWellformed "RandomMap.insert: result" |
|
514 (insert (checkWellformed "RandomMap.insert: input" m) x); |
|
515 *) |
|
516 |
|
517 local |
|
518 fun fold _ NONE acc = acc |
|
519 | fold f (SOME iter) acc = |
|
520 let |
|
521 val (key,value) = readIterator iter |
|
522 in |
|
523 fold f (advanceIterator iter) (f (key,value,acc)) |
|
524 end; |
|
525 in |
|
526 fun foldl f b m = fold f (mkIterator m) b; |
|
527 |
|
528 fun foldr f b m = fold f (mkRevIterator m) b; |
|
529 end; |
|
530 |
|
531 local |
|
532 fun find _ NONE = NONE |
|
533 | find pred (SOME iter) = |
|
534 let |
|
535 val key_value = readIterator iter |
|
536 in |
|
537 if pred key_value then SOME key_value |
|
538 else find pred (advanceIterator iter) |
|
539 end; |
|
540 in |
|
541 fun findl p m = find p (mkIterator m); |
|
542 |
|
543 fun findr p m = find p (mkRevIterator m); |
|
544 end; |
|
545 |
|
546 local |
|
547 fun first _ NONE = NONE |
|
548 | first f (SOME iter) = |
|
549 let |
|
550 val key_value = readIterator iter |
|
551 in |
|
552 case f key_value of |
|
553 NONE => first f (advanceIterator iter) |
|
554 | s => s |
|
555 end; |
|
556 in |
|
557 fun firstl f m = first f (mkIterator m); |
|
558 |
|
559 fun firstr f m = first f (mkRevIterator m); |
|
560 end; |
|
561 |
|
562 fun fromList cmp l = List.foldl (fn (k_v,m) => insert m k_v) (new cmp) l; |
|
563 |
|
564 fun insertList m l = union (SOME o snd) m (fromList (comparison m) l); |
|
565 |
|
566 fun filter p = |
|
567 let |
|
568 fun f (key_value as (_,value)) = |
|
569 if p key_value then SOME value else NONE |
|
570 in |
|
571 mapPartial f |
|
572 end; |
|
573 |
|
574 fun app f m = foldl (fn (key,value,()) => f (key,value)) () m; |
|
575 |
|
576 fun transform f = map (fn (_,value) => f value); |
|
577 |
|
578 fun toList m = foldr (fn (key,value,l) => (key,value) :: l) [] m; |
|
579 |
|
580 fun domain m = foldr (fn (key,_,l) => key :: l) [] m; |
|
581 |
|
582 fun exists p m = Option.isSome (findl p m); |
|
583 |
|
584 fun all p m = not (exists (not o p) m); |
|
585 |
|
586 fun random m = |
|
587 case size m of |
|
588 0 => raise Error "RandomMap.random: empty" |
|
589 | n => nth m (randomInt n); |
|
590 |
|
591 local |
|
592 fun iterCompare _ _ NONE NONE = EQUAL |
|
593 | iterCompare _ _ NONE (SOME _) = LESS |
|
594 | iterCompare _ _ (SOME _) NONE = GREATER |
|
595 | iterCompare kcmp vcmp (SOME i1) (SOME i2) = |
|
596 keyIterCompare kcmp vcmp (readIterator i1) (readIterator i2) i1 i2 |
|
597 |
|
598 and keyIterCompare kcmp vcmp (k1,v1) (k2,v2) i1 i2 = |
|
599 case kcmp (k1,k2) of |
|
600 LESS => LESS |
|
601 | EQUAL => |
|
602 (case vcmp (v1,v2) of |
|
603 LESS => LESS |
|
604 | EQUAL => |
|
605 iterCompare kcmp vcmp (advanceIterator i1) (advanceIterator i2) |
|
606 | GREATER => GREATER) |
|
607 | GREATER => GREATER; |
|
608 in |
|
609 fun compare vcmp (m1,m2) = |
|
610 if pointerEqual (m1,m2) then EQUAL |
|
611 else |
|
612 case Int.compare (size m1, size m2) of |
|
613 LESS => LESS |
|
614 | EQUAL => |
|
615 iterCompare (comparison m1) vcmp (mkIterator m1) (mkIterator m2) |
|
616 | GREATER => GREATER; |
|
617 end; |
|
618 |
|
619 fun equalDomain m1 m2 = equal (K (K true)) m1 m2; |
|
620 |
|
621 fun toString m = "<" ^ (if null m then "" else Int.toString (size m)) ^ ">"; |
|
622 |
|
623 end |
|