Merge pull request #1826 from rgrinberg/fix-print-rules-loop

Fix infinite rule when printing loop

src/build_system.ml

@@ -1515,24 +1515,28 @@ let rules_for_files rules deps =
 let evaluate_rules ~recursive ~request =
   let t = t () in
   entry_point t ~f:(fun () ->
-    let rules = ref [] in
+    let rules = ref Internal_rule.Id.Map.empty in
     let rec run_rule (rule : Internal_rule.t) =
-      evaluate_rule rule
-      >>= fun (action, deps) ->
-      let rule =
-        { Rule.
-          id = rule.id
-        ; dir = rule.dir
-        ; deps
-        ; targets = rule.targets
-        ; context = rule.context
-        ; action
-        } in
-      rules := rule :: !rules;
-      if recursive then
-        Deps.parallel_iter deps ~f:proc_rule
-      else
+      if Internal_rule.Id.Map.mem !rules rule.id then
         Fiber.return ()
+      else begin
+        evaluate_rule rule
+        >>= fun (action, deps) ->
+        let rule =
+          { Rule.
+            id = rule.id
+          ; dir = rule.dir
+          ; deps
+          ; targets = rule.targets
+          ; context = rule.context
+          ; action
+          } in
+        rules := Internal_rule.Id.Map.add !rules rule.id rule;
+        if recursive then
+          Deps.parallel_iter deps ~f:proc_rule
+        else
+          Fiber.return ()
+      end
     and proc_rule dep =
       get_file_spec_other t dep >>= function
       | None -> Fiber.return () (* external files *)
@@ -1544,9 +1548,10 @@ let evaluate_rules ~recursive ~request =
     Deps.parallel_iter goal ~f:proc_rule
     >>| fun () ->
     let rules =
-      List.fold_left !rules ~init:Path.Map.empty ~f:(fun acc (r : Rule.t) ->
-        Path.Set.fold r.targets ~init:acc ~f:(fun fn acc ->
-          Path.Map.add acc fn r)) in
+      Internal_rule.Id.Map.fold !rules ~init:Path.Map.empty
+        ~f:(fun (r : Rule.t) acc ->
+          Path.Set.fold r.targets ~init:acc ~f:(fun fn acc ->
+            Path.Map.add acc fn r)) in
     match
       Rule.Id.Top_closure.top_closure
         (rules_for_files rules goal)

src/stdune/id.ml

@@ -3,6 +3,8 @@ module type S = sig
 
   module Set : Set.S with type elt = t
 
+  module Map : Map_intf.S with type key = t
+
   val gen : unit -> t
   val peek : unit -> t
   val to_int : t -> int
@@ -14,6 +16,7 @@ end
 
 module Make () : S = struct
   module Set = Int.Set
+  module Map = Int.Map
 
   type t = int
 

src/stdune/id.mli

@@ -3,6 +3,8 @@ module type S = sig
 
   module Set : Set_intf.S with type elt = t
 
+  module Map : Map_intf.S with type key = t
+
   (** Generate a new id. *)
   val gen : unit -> t