46 val add_deps_acyclic: key * key list -> 'a T -> 'a T (*exception CYCLES*) |
46 val add_deps_acyclic: key * key list -> 'a T -> 'a T (*exception CYCLES*) |
47 val merge_acyclic: ('a * 'a -> bool) -> 'a T * 'a T -> 'a T (*exception CYCLES*) |
47 val merge_acyclic: ('a * 'a -> bool) -> 'a T * 'a T -> 'a T (*exception CYCLES*) |
48 val topological_order: 'a T -> key list |
48 val topological_order: 'a T -> key list |
49 val add_edge_trans_acyclic: key * key -> 'a T -> 'a T (*exception CYCLES*) |
49 val add_edge_trans_acyclic: key * key -> 'a T -> 'a T (*exception CYCLES*) |
50 val merge_trans_acyclic: ('a * 'a -> bool) -> 'a T * 'a T -> 'a T (*exception CYCLES*) |
50 val merge_trans_acyclic: ('a * 'a -> bool) -> 'a T * 'a T -> 'a T (*exception CYCLES*) |
51 val extend: (key -> 'a * key list) -> key list -> 'a T -> 'a T |
51 val extend: (key -> 'a * key list) -> key -> 'a T -> 'a T |
52 val make: (key -> 'a * key list) -> key list -> 'a T |
|
53 end; |
52 end; |
54 |
53 |
55 functor GraphFun(Key: KEY): GRAPH = |
54 functor GraphFun(Key: KEY): GRAPH = |
56 struct |
55 struct |
57 |
56 |
275 fun merge_trans_acyclic eq (G1, G2) = |
274 fun merge_trans_acyclic eq (G1, G2) = |
276 merge_acyclic eq (G1, G2) |
275 merge_acyclic eq (G1, G2) |
277 |> fold add_edge_trans_acyclic (diff_edges G1 G2) |
276 |> fold add_edge_trans_acyclic (diff_edges G1 G2) |
278 |> fold add_edge_trans_acyclic (diff_edges G2 G1); |
277 |> fold add_edge_trans_acyclic (diff_edges G2 G1); |
279 |
278 |
280 |
279 |
281 (* constructing graphs *) |
280 (* constructing graphs *) |
282 |
281 |
283 fun extend explore = |
282 fun extend explore = |
284 let |
283 let |
285 fun contains_node gr key = member eq_key (keys gr) key |
284 fun ext x G = |
286 fun extend' key gr = |
285 if can (get_entry G) x then G |
287 let |
286 else |
288 val (node, preds) = explore key |
287 let val (info, ys) = explore x in |
289 in |
288 G |
290 gr |> (not (contains_node gr key)) ? |
289 |> new_node (x, info) |
291 (new_node (key, node) |
290 |> fold ext ys |
292 #> fold extend' preds |
291 |> fold (fn y => add_edge (x, y)) ys |
293 #> fold (add_edge o (pair key)) preds) |
292 end |
294 end |
293 in ext end; |
295 in fold extend' end |
|
296 |
|
297 fun make explore keys = extend explore keys empty |
|
298 |
294 |
299 |
295 |
300 (*final declarations of this structure!*) |
296 (*final declarations of this structure!*) |
301 val fold = fold_graph; |
297 val fold = fold_graph; |
302 |
298 |