Sketch-out a dummy escape-finding module
[tiger.ml.git] / compiler / src / lib / tiger / tiger_dag.ml
... / ...
CommitLineData
1module List = ListLabels
2
3module Map = Tiger_map
4module Opt = Tiger_opt
5
6type t =
7 unit
8
9type count =
10 { parents : int
11 ; children : int
12 }
13
14let 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
This page took 0.024484 seconds and 4 git commands to generate.