28 val keys: 'a table -> key list |
28 val keys: 'a table -> key list |
29 val min_key: 'a table -> key option |
29 val min_key: 'a table -> key option |
30 val exists: (key * 'a -> bool) -> 'a table -> bool |
30 val exists: (key * 'a -> bool) -> 'a table -> bool |
31 val lookup: 'a table * key -> 'a option |
31 val lookup: 'a table * key -> 'a option |
32 val update: (key * 'a) * 'a table -> 'a table |
32 val update: (key * 'a) * 'a table -> 'a table |
33 val update_new: (key * 'a) * 'a table -> 'a table (*exception DUP*) |
33 val update_new: (key * 'a) * 'a table -> 'a table (*exception DUP*) |
34 val make: (key * 'a) list -> 'a table (*exception DUPS*) |
34 val make: (key * 'a) list -> 'a table (*exception DUPS*) |
35 val extend: 'a table * (key * 'a) list -> 'a table (*exception DUPS*) |
35 val extend: 'a table * (key * 'a) list -> 'a table (*exception DUPS*) |
36 val merge: ('a * 'a -> bool) -> 'a table * 'a table -> 'a table (*exception DUPS*) |
36 val join: ('a * 'a -> 'a option) -> 'a table * 'a table -> 'a table (*exception DUPS*) |
|
37 val merge: ('a * 'a -> bool) -> 'a table * 'a table -> 'a table (*exception DUPS*) |
37 val lookup_multi: 'a list table * key -> 'a list |
38 val lookup_multi: 'a list table * key -> 'a list |
38 val update_multi: (key * 'a) * 'a list table -> 'a list table |
39 val update_multi: (key * 'a) * 'a list table -> 'a list table |
39 val make_multi: (key * 'a) list -> 'a list table |
40 val make_multi: (key * 'a) list -> 'a list table |
40 val dest_multi: 'a list table -> (key * 'a) list |
41 val dest_multi: 'a list table -> (key * 'a) list |
|
42 val merge_multi: ('a * 'a -> bool) -> |
|
43 'a list table * 'a list table -> 'a list table (*exception DUPS*) |
|
44 val merge_multi': ('a * 'a -> bool) -> |
|
45 'a list table * 'a list table -> 'a list table (*exception DUPS*) |
41 end; |
46 end; |
42 |
47 |
43 functor TableFun(Key: KEY): TABLE = |
48 functor TableFun(Key: KEY): TABLE = |
44 struct |
49 struct |
45 |
50 |
158 fun update_new (pair as (key, _), tab) = |
163 fun update_new (pair as (key, _), tab) = |
159 if is_none (lookup (tab, key)) then update (pair, tab) |
164 if is_none (lookup (tab, key)) then update (pair, tab) |
160 else raise DUP key; |
165 else raise DUP key; |
161 |
166 |
162 |
167 |
163 (* make, extend, merge tables *) |
168 (* extend and make *) |
164 |
169 |
165 fun add eq ((tab, dups), (key, x)) = |
170 fun extend (table, pairs) = |
166 (case lookup (tab, key) of |
171 let |
167 None => (update ((key, x), tab), dups) |
172 fun add ((tab, dups), (key, x)) = |
168 | Some x' => |
173 (case lookup (tab, key) of |
169 if eq (x, x') then (tab, dups) |
174 None => (update ((key, x), tab), dups) |
170 else (tab, dups @ [key])); |
175 | _ => (tab, key :: dups)); |
171 |
176 in |
172 fun enter eq (tab, pairs) = |
177 (case foldl add ((table, []), pairs) of |
173 (case foldl (add eq) ((tab, []), pairs) of |
178 (table', []) => table' |
174 (tab', []) => tab' |
179 | (_, dups) => raise DUPS (rev dups)) |
175 | (_, dups) => raise DUPS dups); |
180 end; |
176 |
181 |
177 fun extend tab_pairs = enter (K false) tab_pairs; |
|
178 fun make pairs = extend (empty, pairs); |
182 fun make pairs = extend (empty, pairs); |
179 fun merge eq (tab1, tab2) = enter eq (tab1, dest tab2); |
183 |
|
184 |
|
185 (* join and merge *) |
|
186 |
|
187 fun join f (table1, table2) = |
|
188 let |
|
189 fun add ((tab, dups), (key, x)) = |
|
190 (case lookup (tab, key) of |
|
191 None => (update ((key, x), tab), dups) |
|
192 | Some y => |
|
193 (case f (y, x) of |
|
194 Some z => (update ((key, z), tab), dups) |
|
195 | None => (tab, key :: dups))); |
|
196 in |
|
197 (case foldl_table add ((table1, []), table2) of |
|
198 (table', []) => table' |
|
199 | (_, dups) => raise DUPS (rev dups)) |
|
200 end; |
|
201 |
|
202 fun merge eq tabs = join (fn (y, x) => if eq (y, x) then Some y else None) tabs; |
180 |
203 |
181 |
204 |
182 (* tables with multiple entries per key (preserving order) *) |
205 (* tables with multiple entries per key (preserving order) *) |
183 |
206 |
184 fun lookup_multi tab_key = if_none (lookup tab_key) []; |
207 fun lookup_multi tab_key = if_none (lookup tab_key) []; |
185 |
208 fun update_multi ((key, x), tab) = update ((key, x :: lookup_multi (tab, key)), tab); |
186 fun update_multi ((key, x), tab) = |
|
187 update ((key, x :: lookup_multi (tab, key)), tab); |
|
188 |
209 |
189 fun make_multi pairs = foldr update_multi (pairs, empty); |
210 fun make_multi pairs = foldr update_multi (pairs, empty); |
190 |
211 fun dest_multi tab = flat (map (fn (key, xs) => map (Library.pair key) xs) (dest tab)); |
191 fun dest_multi tab = |
212 fun merge_multi eq tabs = join (fn (xs, xs') => Some (gen_merge_lists eq xs xs')) tabs; |
192 flat (map (fn (key, xs) => map (Library.pair key) xs) (dest tab)); |
213 fun merge_multi' eq tabs = join (fn (xs, xs') => Some (gen_merge_lists' eq xs xs')) tabs; |
193 |
214 |
194 |
215 |
195 (*final declarations of this structure!*) |
216 (*final declarations of this structure!*) |
196 val map = map_table; |
217 val map = map_table; |
197 val foldl = foldl_table; |
218 val foldl = foldl_table; |
198 |
219 |
199 |
|
200 end; |
220 end; |
201 |
221 |
202 |
222 |
203 (*tables indexed by strings*) |
223 (*tables indexed by strings*) |
204 structure Symtab = TableFun(type key = string val ord = string_ord); |
224 structure Symtab = TableFun(type key = string val ord = string_ord); |