From: Richard W.M. Jones <rjones@redhat.com>
Date: Mon, 1 Mar 2021 19:49:07 +0000 (+0000)
Subject: Try a simpler algorithm for detecting cycles.
X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=832682193c42b520d293c6175746b6cfe5272c0b;p=goals.git

Try a simpler algorithm for detecting cycles.

Fixes: commit 5f25b73757c74fde044315e9b82aa70da8fcfbc0
---

diff --git a/src/deps.ml b/src/deps.ml
index 1911499..c1c1474 100644
--- a/src/deps.ml
+++ b/src/deps.ml
@@ -83,19 +83,27 @@ and add_node { nodes; edges } ?parent data =
     | Some parent ->
        let children = try G.find parent edges with Not_found -> [] in
        if List.mem node children then edges
-       else G.add parent (node :: children) edges in
-  (* Doing this checks if we have added a cycle.  There may be
-   * cheaper ways to do this, see:
-   * https://stackoverflow.com/questions/20246417/how-to-detect-if-adding-an-edge-to-a-directed-graph-results-in-a-cycle
-   *)
-  let dag = { nodes; edges } in
-  (try ignore (topological_sort dag)
-   with Cycle_found ->
-     let loc = loc_of_node data in
-     failwithf "%a: adding %s creates a dependency cycle"
-       Ast.string_loc loc (string_of_node data)
-  );
-  node, dag
+       else (
+         (* We are going to add an edge from parent -> node.  To
+          * ensure we don't make a cycle, check there is no path
+          * already from node -> parent.
+          *)
+         if exists_path node parent edges then (
+           let loc = loc_of_node data in
+           failwithf "%a: adding %s creates a dependency cycle"
+             Ast.string_loc loc (string_of_node data)
+         );
+         G.add parent (node :: children) edges
+       ) in
+  node, { nodes; edges }
+
+(* Is there a path from n1 to n2 in edges? *)
+and exists_path n1 n2 edges =
+  if compare_nodes n1 n2 = 0 then true
+  else (
+    let children = try G.find n1 edges with Not_found -> [] in
+    List.exists (fun n -> exists_path n n2 edges) children
+  )
 
 (* This is Khan's algorithm. *)
 and topological_sort dag =