From 0ad5138b52e81a599b562eb198b078c5608fcacf Mon Sep 17 00:00:00 2001
From: sneeker <s@cpl0.zip>
Date: Thu, 9 Jun 2022 14:01:08 +0000
Subject: [PATCH] feat(graph): derive edges from which node produces which file

Indexes producers by output path, so a generator and the compile consuming its
output are connected without being declared. Detects duplicate producers and
reports dependency cycles by path.
---
 lib/graph.ml | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 72 insertions(+)
 create mode 100644 lib/graph.ml

diff --git a/lib/graph.ml b/lib/graph.ml
new file mode 100644
index 0000000..badc0e4
--- /dev/null
+++ b/lib/graph.ml
@@ -0,0 +1,72 @@
+type node = {
+  id : int;
+  tag : string;
+  label : string;
+  cmd : string array;
+  outs : string list;
+  ins : string list;
+  depfile : string option;
+  ords : string list;
+  pool : string;
+  mutable deps : int list;
+}
+
+type t = { nodes : node array; by_output : (string, int) Hashtbl.t }
+
+let make ~id ~tag ~label ~cmd ~outs ~ins ?depfile ?(ords = []) ?(pool = "default") () =
+  { id; tag; label; cmd; outs; ins; depfile; ords; pool; deps = [] }
+
+let build specs =
+  let nodes = Array.of_list specs in
+  Array.iteri (fun i n -> if n.id <> i then invalid_arg "graph: node ids must be dense") nodes;
+  let by_output = Hashtbl.create (Array.length nodes * 2) in
+  Array.iter
+    (fun n ->
+      List.iter
+        (fun o ->
+          match Hashtbl.find_opt by_output o with
+          | Some prev when prev <> n.id ->
+              Diag.error "two rules both produce %s (%s and %s)" o nodes.(prev).label n.label
+          | _ -> Hashtbl.replace by_output o n.id)
+        n.outs)
+    nodes;
+  Array.iter
+    (fun n ->
+      n.deps <-
+        List.filter_map (fun i -> Hashtbl.find_opt by_output i) (n.ins @ n.ords)
+        |> List.sort_uniq compare
+        |> List.filter (fun d -> d <> n.id))
+    nodes;
+  { nodes; by_output }
+
+let topo g =
+  let n = Array.length g.nodes in
+  let state = Array.make n 0 in
+  let order = ref [] in
+  let rec visit path i =
+    match state.(i) with
+    | 2 -> ()
+    | 1 ->
+        let cycle = List.rev_map (fun j -> g.nodes.(j).label) (i :: path) in
+        Diag.error "dependency cycle: %s" (String.concat " -> " cycle)
+    | _ ->
+        state.(i) <- 1;
+        List.iter (visit (i :: path)) g.nodes.(i).deps;
+        state.(i) <- 2;
+        order := i :: !order
+  in
+  for i = 0 to n - 1 do visit [] i done;
+  List.rev !order
+
+let reachable g roots =
+  let seen = Hashtbl.create 64 in
+  let rec go i =
+    if not (Hashtbl.mem seen i) then begin
+      Hashtbl.add seen i ();
+      List.iter go g.nodes.(i).deps
+    end
+  in
+  List.iter go roots;
+  seen
+
+let producing g path = Hashtbl.find_opt g.by_output path