deps: Try to print the dependency cycle in error message

[goals.git] / src / deps.ml

diff --git a/src/deps.ml b/src/deps.ml
index c1c1474..088c64d 100644 (file)
--- a/src/deps.ml
+++ b/src/deps.ml
@@ -88,21 +88,33 @@ and add_node { nodes; edges } ?parent data =
           * 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)
+         (match exists_path node parent edges with
+          | None -> ()
+          | Some nodes ->
+             let loc = loc_of_node data in
+             failwithf "%a: dependency cycle: %s -> %s"
+               Ast.string_loc loc
+               (String.concat " -> " (List.map string_of_node nodes))
+               (string_of_node data)
          );
          G.add parent (node :: children) edges
        ) in
   node, { nodes; edges }
 
-(* Is there a path from n1 to n2 in edges? *)
+(* Is there a path from n1 to n2 in edges?
+ * Returns [None] if no path, or [Some nodes] if there is a path.
+ *)
 and exists_path n1 n2 edges =
-  if compare_nodes n1 n2 = 0 then true
+  if compare_nodes n1 n2 = 0 then Some [n2]
   else (
     let children = try G.find n1 edges with Not_found -> [] in
-    List.exists (fun n -> exists_path n n2 edges) children
+    let path =
+      List.find_map (
+        fun n -> exists_path n n2 edges
+      ) children in
+    match path with
+    | None -> None
+    | Some nodes -> Some (n1 :: nodes)
   )
 
 (* This is Khan's algorithm. *)