| 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 =