diff --git a/src/build_system.ml b/src/build_system.ml index 4021d2f6796..e07e2eafab5 100644 --- a/src/build_system.ml +++ b/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) diff --git a/src/stdune/id.ml b/src/stdune/id.ml index d606d1ea711..50b9bfea94b 100644 --- a/src/stdune/id.ml +++ b/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 diff --git a/src/stdune/id.mli b/src/stdune/id.mli index 01b0cba58d9..db11bc04645 100644 --- a/src/stdune/id.mli +++ b/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