Commit | Line | Data |
---|---|---|
e6e82c08 SK |
1 | module List = ListLabels |
2 | ||
3 | module Map = Tiger_map | |
4 | module Opt = Tiger_opt | |
5 | ||
6 | type t = | |
7 | unit | |
8 | ||
9 | type count = | |
10 | { parents : int | |
11 | ; children : int | |
12 | } | |
13 | ||
14 | let of_list pairs = | |
15 | let incr counts k incr = | |
16 | let prev = Opt.get (Map.get counts ~k) ~default:{parents=0; children=0} in | |
17 | Map.set counts ~k ~v:(incr prev) | |
18 | in | |
19 | let incr_parents count = {count with parents = succ count.parents} in | |
20 | let incr_children count = {count with children = succ count.children} in | |
21 | let zero_children counts = | |
22 | List.filter (Map.to_list counts) ~f:(fun (_, {children=c; _}) -> c = 0 ) | |
23 | in | |
24 | let zero_parents counts = | |
25 | List.filter (Map.to_list counts) ~f:(fun (_, {parents=p; _}) -> p = 0 ) | |
26 | in | |
27 | let counts = | |
28 | List.fold_left pairs ~init:Map.empty ~f:( | |
29 | fun counts (p, c) -> | |
30 | let counts = incr counts p incr_children in | |
31 | let counts = incr counts c incr_parents in | |
32 | counts | |
33 | ) | |
34 | in | |
35 | (* At least one node with no in-coming links and | |
36 | * at least one node with no out-going links. *) | |
37 | match (zero_parents counts, zero_children counts) with | |
38 | | _ :: _, _ :: _ -> Ok () | |
39 | | _, _ -> Error `Cycle |