diff --git a/src/build_interpret.ml b/src/build_interpret.ml index f559174d..59037a43 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -192,11 +192,10 @@ module Rule = struct ; locks : Path.t list ; loc : Loc.t option ; dir : Path.t - ; package : Package.Name.t option } let make ?(sandbox=false) ?(mode=Jbuild.Rule.Mode.Not_a_rule_stanza) - ~context ?(locks=[]) ?loc ?package build = + ~context ?(locks=[]) ?loc build = let targets = targets build in let dir = match targets with @@ -230,6 +229,5 @@ module Rule = struct ; locks ; loc ; dir - ; package } end diff --git a/src/build_interpret.mli b/src/build_interpret.mli index 01bf3687..5d2f08c7 100644 --- a/src/build_interpret.mli +++ b/src/build_interpret.mli @@ -20,7 +20,6 @@ module Rule : sig ; loc : Loc.t option ; (** Directory where all the targets are produced *) dir : Path.t - ; package : Package.Name.t option } val make @@ -29,7 +28,6 @@ module Rule : sig -> context:Context.t option -> ?locks:Path.t list -> ?loc:Loc.t - -> ?package:Package.Name.t -> (unit, Action.t) Build.t -> t end diff --git a/src/build_system.ml b/src/build_system.ml index 99fbaad1..30013f78 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -161,7 +161,6 @@ module Internal_rule = struct ; loc : Loc.t option ; dir : Path.t ; mutable exec : Exec_status.t - ; package : Package.Name.t option } let compare a b = Id.compare a.id b.id @@ -354,6 +353,8 @@ type t = ; files_of : (Path.t, Files_of.t) Hashtbl.t ; mutable prefix : (unit, unit) Build.t option ; hook : hook -> unit + ; (* Package files are part of *) + packages : (Path.t, Package.Name.t) Hashtbl.t } let string_of_paths set = @@ -652,7 +653,6 @@ let rec compile_rule t ?(copy_source=false) pre_rule = ; locks ; loc ; dir - ; package } = pre_rule in @@ -777,7 +777,6 @@ let rec compile_rule t ?(copy_source=false) pre_rule = ; mode ; loc ; dir - ; package } in create_file_specs t target_specs rule ~copy_source @@ -1150,6 +1149,7 @@ let create ~contexts ~file_tree ~hook = let t = { contexts ; files = Hashtbl.create 1024 + ; packages = Hashtbl.create 1024 ; trace = Trace.load () ; local_mkdirs = Path.Local.Set.empty ; dirs = Hashtbl.create 1024 @@ -1390,30 +1390,33 @@ let build_rules ?recursive t ~request = entry_point t ~f:(fun () -> build_rules_internal ?recursive t ~request) +let set_package t file package = + Hashtbl.add t.packages file package + let package_deps t files = let rules_seen = ref Id_set.empty in let packages = ref Package.Name.Set.empty in let rec loop fn = - let dir = Path.parent fn in - if Path.is_in_build_dir dir then load_dir t ~dir; - match Hashtbl.find t.files fn with - | None -> () - | Some (File_spec.T { rule = ir; _ }) -> - if not (Id_set.mem !rules_seen ir.id) then begin - rules_seen := Id_set.add !rules_seen ir.id; - let _, dyn_deps = - match ir.exec with - | Running { rule_evaluation; _ } - | Evaluating_rule { rule_evaluation; _ } -> - Option.value_exn (Fiber.Future.peek rule_evaluation) - | Not_started _ -> assert false - in - match ir.package with - | None -> + match Hashtbl.find t.packages fn with + | Some p -> + packages := Package.Name.Set.add !packages p + | None -> + let dir = Path.parent fn in + if Path.is_in_build_dir dir then load_dir t ~dir; + match Hashtbl.find t.files fn with + | None -> () + | Some (File_spec.T { rule = ir; _ }) -> + if not (Id_set.mem !rules_seen ir.id) then begin + rules_seen := Id_set.add !rules_seen ir.id; + let _, dyn_deps = + match ir.exec with + | Running { rule_evaluation; _ } + | Evaluating_rule { rule_evaluation; _ } -> + Option.value_exn (Fiber.Future.peek rule_evaluation) + | Not_started _ -> assert false + in Pset.iter (Pset.union ir.static_deps dyn_deps) ~f:loop - | Some p -> - packages := Package.Name.Set.add !packages p - end + end in let open Build.O in Build.paths_for_rule files >>^ fun () -> diff --git a/src/build_system.mli b/src/build_system.mli index 0a3aaea8..109e763d 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -77,6 +77,9 @@ val on_load_dir : t -> dir:Path.t -> f:(unit -> unit) -> unit (** Stamp file that depends on all files of [dir] with extension [ext]. *) val stamp_file_for_files_of : t -> dir:Path.t -> ext:string -> Path.t +(** Sets the package this file is part of *) +val set_package : t -> Path.t -> Package.Name.t -> unit + (** Scan the transitive dependencies of the following files and return set of packages these files are part of. Do not scan packages recursively. *) diff --git a/src/install_rules.ml b/src/install_rules.ml index 7c948d76..d4715a67 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -203,9 +203,11 @@ module Gen(P : Install_params) = struct let install_dir = Config.local_install_dir ~context:ctx.name in List.map entries ~f:(fun entry -> let dst = - Path.append install_dir (Install.Entry.relative_installed_path entry ~package) + Path.append install_dir + (Install.Entry.relative_installed_path entry ~package) in - SC.add_rule sctx (Build.symlink ~src:entry.src ~dst) ~package; + Build_system.set_package (SC.build_system sctx) entry.src package; + SC.add_rule sctx (Build.symlink ~src:entry.src ~dst); Install.Entry.set_src entry dst) let promote_install_file = diff --git a/src/super_context.ml b/src/super_context.ml index 8eb6724b..c157ae55 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -219,10 +219,10 @@ let create let prefix_rules t prefix ~f = Build_system.prefix_rules t.build_system prefix ~f -let add_rule t ?sandbox ?mode ?locks ?loc ?package build = +let add_rule t ?sandbox ?mode ?locks ?loc build = let build = Build.O.(>>>) build t.chdir in Build_system.add_rule t.build_system - (Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc ?package + (Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc ~context:(Some t.context) build) let add_rule_get_targets t ?sandbox ?mode ?locks ?loc build = diff --git a/src/super_context.mli b/src/super_context.mli index ffd2900d..a696840d 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -80,7 +80,6 @@ val add_rule -> ?mode:Jbuild.Rule.Mode.t -> ?locks:Path.t list -> ?loc:Loc.t - -> ?package:Package.Name.t -> (unit, Action.t) Build.t -> unit val add_rule_get_targets