Recursive package deps
This commit is contained in:
parent
1b8fbfc149
commit
73873b31bc
|
@ -27,6 +27,7 @@ module Repr = struct
|
||||||
| Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
|
| Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
|
||||||
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
|
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
|
||||||
| Paths : Pset.t -> ('a, 'a) t
|
| Paths : Pset.t -> ('a, 'a) t
|
||||||
|
| Paths_for_rule : Path.Set.t -> ('a, 'a) t
|
||||||
| Paths_glob : glob_state ref -> ('a, Path.t list) t
|
| Paths_glob : glob_state ref -> ('a, Path.t list) t
|
||||||
(* The reference gets decided in Build_interpret.deps *)
|
(* The reference gets decided in Build_interpret.deps *)
|
||||||
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
||||||
|
@ -135,6 +136,7 @@ let path_set ps = Paths ps
|
||||||
let paths_glob ~loc ~dir re = Paths_glob (ref (G_unevaluated (loc, dir, re)))
|
let paths_glob ~loc ~dir re = Paths_glob (ref (G_unevaluated (loc, dir, re)))
|
||||||
let vpath vp = Vpath vp
|
let vpath vp = Vpath vp
|
||||||
let dyn_paths t = Dyn_paths t
|
let dyn_paths t = Dyn_paths t
|
||||||
|
let paths_for_rule ps = Paths_for_rule ps
|
||||||
|
|
||||||
let catch t ~on_error = Catch (t, on_error)
|
let catch t ~on_error = Catch (t, on_error)
|
||||||
|
|
||||||
|
|
|
@ -183,6 +183,7 @@ module Repr : sig
|
||||||
| Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
|
| Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
|
||||||
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
|
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
|
||||||
| Paths : Path.Set.t -> ('a, 'a) t
|
| Paths : Path.Set.t -> ('a, 'a) t
|
||||||
|
| Paths_for_rule : Path.Set.t -> ('a, 'a) t
|
||||||
| Paths_glob : glob_state ref -> ('a, Path.t list) t
|
| Paths_glob : glob_state ref -> ('a, Path.t list) t
|
||||||
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
||||||
| Contents : Path.t -> ('a, string) t
|
| Contents : Path.t -> ('a, string) t
|
||||||
|
@ -220,3 +221,6 @@ end
|
||||||
val repr : ('a, 'b) t -> ('a, 'b) Repr.t
|
val repr : ('a, 'b) t -> ('a, 'b) Repr.t
|
||||||
|
|
||||||
val merge_lib_deps : lib_deps -> lib_deps -> lib_deps
|
val merge_lib_deps : lib_deps -> lib_deps -> lib_deps
|
||||||
|
|
||||||
|
(**/**)
|
||||||
|
val paths_for_rule : Path.Set.t -> ('a, 'a) t
|
||||||
|
|
|
@ -63,6 +63,8 @@ let static_deps t ~all_targets ~file_tree =
|
||||||
| Split (a, b) -> loop a (loop b acc)
|
| Split (a, b) -> loop a (loop b acc)
|
||||||
| Fanout (a, b) -> loop a (loop b acc)
|
| Fanout (a, b) -> loop a (loop b acc)
|
||||||
| Paths fns -> { acc with action_deps = Pset.union fns acc.action_deps }
|
| Paths fns -> { acc with action_deps = Pset.union fns acc.action_deps }
|
||||||
|
| Paths_for_rule fns ->
|
||||||
|
{ acc with rule_deps = Pset.union fns acc.rule_deps }
|
||||||
| Paths_glob state -> begin
|
| Paths_glob state -> begin
|
||||||
match !state with
|
match !state with
|
||||||
| G_evaluated l ->
|
| G_evaluated l ->
|
||||||
|
@ -129,6 +131,7 @@ let lib_deps =
|
||||||
| Split (a, b) -> loop a (loop b acc)
|
| Split (a, b) -> loop a (loop b acc)
|
||||||
| Fanout (a, b) -> loop a (loop b acc)
|
| Fanout (a, b) -> loop a (loop b acc)
|
||||||
| Paths _ -> acc
|
| Paths _ -> acc
|
||||||
|
| Paths_for_rule _ -> acc
|
||||||
| Vpath _ -> acc
|
| Vpath _ -> acc
|
||||||
| Paths_glob _ -> acc
|
| Paths_glob _ -> acc
|
||||||
| Dyn_paths t -> loop t acc
|
| Dyn_paths t -> loop t acc
|
||||||
|
@ -156,6 +159,7 @@ let targets =
|
||||||
| Split (a, b) -> loop a (loop b acc)
|
| Split (a, b) -> loop a (loop b acc)
|
||||||
| Fanout (a, b) -> loop a (loop b acc)
|
| Fanout (a, b) -> loop a (loop b acc)
|
||||||
| Paths _ -> acc
|
| Paths _ -> acc
|
||||||
|
| Paths_for_rule _ -> acc
|
||||||
| Vpath _ -> acc
|
| Vpath _ -> acc
|
||||||
| Paths_glob _ -> acc
|
| Paths_glob _ -> acc
|
||||||
| Dyn_paths t -> loop t acc
|
| Dyn_paths t -> loop t acc
|
||||||
|
@ -188,10 +192,11 @@ module Rule = struct
|
||||||
; locks : Path.t list
|
; locks : Path.t list
|
||||||
; loc : Loc.t option
|
; loc : Loc.t option
|
||||||
; dir : Path.t
|
; dir : Path.t
|
||||||
|
; package : Package.Name.t option
|
||||||
}
|
}
|
||||||
|
|
||||||
let make ?(sandbox=false) ?(mode=Jbuild.Rule.Mode.Not_a_rule_stanza)
|
let make ?(sandbox=false) ?(mode=Jbuild.Rule.Mode.Not_a_rule_stanza)
|
||||||
~context ?(locks=[]) ?loc build =
|
~context ?(locks=[]) ?loc ?package build =
|
||||||
let targets = targets build in
|
let targets = targets build in
|
||||||
let dir =
|
let dir =
|
||||||
match targets with
|
match targets with
|
||||||
|
@ -225,5 +230,6 @@ module Rule = struct
|
||||||
; locks
|
; locks
|
||||||
; loc
|
; loc
|
||||||
; dir
|
; dir
|
||||||
|
; package
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
|
@ -20,6 +20,7 @@ module Rule : sig
|
||||||
; loc : Loc.t option
|
; loc : Loc.t option
|
||||||
; (** Directory where all the targets are produced *)
|
; (** Directory where all the targets are produced *)
|
||||||
dir : Path.t
|
dir : Path.t
|
||||||
|
; package : Package.Name.t option
|
||||||
}
|
}
|
||||||
|
|
||||||
val make
|
val make
|
||||||
|
@ -28,6 +29,7 @@ module Rule : sig
|
||||||
-> context:Context.t option
|
-> context:Context.t option
|
||||||
-> ?locks:Path.t list
|
-> ?locks:Path.t list
|
||||||
-> ?loc:Loc.t
|
-> ?loc:Loc.t
|
||||||
|
-> ?package:Package.Name.t
|
||||||
-> (unit, Action.t) Build.t
|
-> (unit, Action.t) Build.t
|
||||||
-> t
|
-> t
|
||||||
end
|
end
|
||||||
|
|
|
@ -161,6 +161,7 @@ module Internal_rule = struct
|
||||||
; loc : Loc.t option
|
; loc : Loc.t option
|
||||||
; dir : Path.t
|
; dir : Path.t
|
||||||
; mutable exec : Exec_status.t
|
; mutable exec : Exec_status.t
|
||||||
|
; package : Package.Name.t option
|
||||||
}
|
}
|
||||||
|
|
||||||
let compare a b = Id.compare a.id b.id
|
let compare a b = Id.compare a.id b.id
|
||||||
|
@ -446,6 +447,7 @@ module Build_exec = struct
|
||||||
let b = exec dyn_deps b x in
|
let b = exec dyn_deps b x in
|
||||||
(a, b)
|
(a, b)
|
||||||
| Paths _ -> x
|
| Paths _ -> x
|
||||||
|
| Paths_for_rule _ -> x
|
||||||
| Paths_glob state -> get_glob_result_exn state
|
| Paths_glob state -> get_glob_result_exn state
|
||||||
| Contents p -> Io.read_file (Path.to_string p)
|
| Contents p -> Io.read_file (Path.to_string p)
|
||||||
| Lines_of p -> Io.lines_of_file (Path.to_string p)
|
| Lines_of p -> Io.lines_of_file (Path.to_string p)
|
||||||
|
@ -650,6 +652,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
|
||||||
; locks
|
; locks
|
||||||
; loc
|
; loc
|
||||||
; dir
|
; dir
|
||||||
|
; package
|
||||||
} =
|
} =
|
||||||
pre_rule
|
pre_rule
|
||||||
in
|
in
|
||||||
|
@ -774,6 +777,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
|
||||||
; mode
|
; mode
|
||||||
; loc
|
; loc
|
||||||
; dir
|
; dir
|
||||||
|
; package
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
create_file_specs t target_specs rule ~copy_source
|
create_file_specs t target_specs rule ~copy_source
|
||||||
|
@ -1328,7 +1332,8 @@ let build_rules_internal ?(recursive=false) t ~request =
|
||||||
else begin
|
else begin
|
||||||
rules_seen := Id_set.add !rules_seen ir.id;
|
rules_seen := Id_set.add !rules_seen ir.id;
|
||||||
(match ir.exec with
|
(match ir.exec with
|
||||||
| Running { rule_evaluation; _ } | Evaluating_rule { rule_evaluation; _ } ->
|
| Running { rule_evaluation; _ }
|
||||||
|
| Evaluating_rule { rule_evaluation; _ } ->
|
||||||
Fiber.return rule_evaluation
|
Fiber.return rule_evaluation
|
||||||
| Not_started { eval_rule; exec_rule } ->
|
| Not_started { eval_rule; exec_rule } ->
|
||||||
Fiber.fork (fun () ->
|
Fiber.fork (fun () ->
|
||||||
|
@ -1385,6 +1390,38 @@ let build_rules ?recursive t ~request =
|
||||||
entry_point t ~f:(fun () ->
|
entry_point t ~f:(fun () ->
|
||||||
build_rules_internal ?recursive t ~request)
|
build_rules_internal ?recursive t ~request)
|
||||||
|
|
||||||
|
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 ->
|
||||||
|
Pset.iter (Pset.union ir.static_deps dyn_deps) ~f:loop
|
||||||
|
| Some p ->
|
||||||
|
packages := Package.Name.Set.add !packages p
|
||||||
|
end
|
||||||
|
in
|
||||||
|
let open Build.O in
|
||||||
|
Build.paths_for_rule files >>^ fun () ->
|
||||||
|
(* This is a bit ugly, we know that at this point of execution, all
|
||||||
|
the relevant ivars have been filled *)
|
||||||
|
Pset.iter files ~f:loop;
|
||||||
|
!packages
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
| Adding rules to the system |
|
| Adding rules to the system |
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
|
|
@ -77,6 +77,14 @@ val on_load_dir : t -> dir:Path.t -> f:(unit -> unit) -> unit
|
||||||
(** Stamp file that depends on all files of [dir] with extension [ext]. *)
|
(** 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
|
val stamp_file_for_files_of : t -> dir:Path.t -> ext:string -> Path.t
|
||||||
|
|
||||||
|
(** Scan the transitive dependencies of the following files and return
|
||||||
|
set of packages these files are part of. Do not scan packages
|
||||||
|
recursively. *)
|
||||||
|
val package_deps
|
||||||
|
: t
|
||||||
|
-> Path.Set.t
|
||||||
|
-> (unit, Package.Name.Set.t) Build.t
|
||||||
|
|
||||||
(** {2 Aliases} *)
|
(** {2 Aliases} *)
|
||||||
|
|
||||||
module Alias : sig
|
module Alias : sig
|
||||||
|
|
|
@ -386,12 +386,18 @@ module Ivar = struct
|
||||||
| Full x -> k x
|
| Full x -> k x
|
||||||
| Empty q ->
|
| Empty q ->
|
||||||
Queue.push { Handler. run = k; ctx } q
|
Queue.push { Handler. run = k; ctx } q
|
||||||
|
|
||||||
|
let peek t =
|
||||||
|
match t.state with
|
||||||
|
| Full x -> Some x
|
||||||
|
| Empty _ -> None
|
||||||
end
|
end
|
||||||
|
|
||||||
module Future = struct
|
module Future = struct
|
||||||
type 'a t = 'a Ivar.t
|
type 'a t = 'a Ivar.t
|
||||||
|
|
||||||
let wait = Ivar.read
|
let wait = Ivar.read
|
||||||
|
let peek = Ivar.peek
|
||||||
end
|
end
|
||||||
|
|
||||||
let fork f ctx k =
|
let fork f ctx k =
|
||||||
|
|
|
@ -40,6 +40,9 @@ module Future : sig
|
||||||
|
|
||||||
(** Wait for the given future to yield a value. *)
|
(** Wait for the given future to yield a value. *)
|
||||||
val wait : 'a t -> 'a fiber
|
val wait : 'a t -> 'a fiber
|
||||||
|
|
||||||
|
(** Return [Some x] if [t] has already returned. *)
|
||||||
|
val peek : 'a t -> 'a option
|
||||||
end with type 'a fiber := 'a t
|
end with type 'a fiber := 'a t
|
||||||
|
|
||||||
(** [fork f] creates a sub-fiber and return a [Future.t] to wait its result. *)
|
(** [fork f] creates a sub-fiber and return a [Future.t] to wait its result. *)
|
||||||
|
@ -226,6 +229,9 @@ module Ivar : sig
|
||||||
(** Fill the ivar with the following value. This can only be called
|
(** Fill the ivar with the following value. This can only be called
|
||||||
once for a given ivar. *)
|
once for a given ivar. *)
|
||||||
val fill : 'a t -> 'a -> unit fiber
|
val fill : 'a t -> 'a -> unit fiber
|
||||||
|
|
||||||
|
(** Return [Some x] is [fill t x] has been called previously. *)
|
||||||
|
val peek : 'a t -> 'a option
|
||||||
end with type 'a fiber := 'a t
|
end with type 'a fiber := 'a t
|
||||||
|
|
||||||
module Mutex : sig
|
module Mutex : sig
|
||||||
|
|
|
@ -205,7 +205,7 @@ module Gen(P : Install_params) = struct
|
||||||
let dst =
|
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
|
in
|
||||||
SC.add_rule sctx (Build.symlink ~src:entry.src ~dst);
|
SC.add_rule sctx (Build.symlink ~src:entry.src ~dst) ~package;
|
||||||
Install.Entry.set_src entry dst)
|
Install.Entry.set_src entry dst)
|
||||||
|
|
||||||
let promote_install_file =
|
let promote_install_file =
|
||||||
|
@ -237,9 +237,24 @@ module Gen(P : Install_params) = struct
|
||||||
(Utils.install_file ~package ~findlib_toolchain:ctx.findlib_toolchain)
|
(Utils.install_file ~package ~findlib_toolchain:ctx.findlib_toolchain)
|
||||||
in
|
in
|
||||||
let entries = local_install_rules entries ~package in
|
let entries = local_install_rules entries ~package in
|
||||||
SC.add_alias_deps sctx
|
SC.add_alias_action sctx ~stamp:(List [])
|
||||||
(Alias.package_install ~context:ctx ~pkg:package)
|
(Alias.package_install ~context:ctx ~pkg:package)
|
||||||
(List.map entries ~f:(fun (e : Install.Entry.t) -> e.src));
|
(let files =
|
||||||
|
List.map entries ~f:(fun (e : Install.Entry.t) -> e.src)
|
||||||
|
|> Path.Set.of_list
|
||||||
|
in
|
||||||
|
Build.path_set files
|
||||||
|
>>>
|
||||||
|
Build_system.package_deps (SC.build_system sctx) files
|
||||||
|
>>>
|
||||||
|
Build.dyn_paths (Build.arr (fun packages ->
|
||||||
|
Package.Name.Set.remove packages package
|
||||||
|
|> Package.Name.Set.to_list
|
||||||
|
|> List.map ~f:(fun pkg ->
|
||||||
|
Build_system.Alias.package_install
|
||||||
|
~context:(SC.context sctx) ~pkg
|
||||||
|
|> Build_system.Alias.stamp_file)))
|
||||||
|
>>^ fun _ -> Action.Progn []);
|
||||||
SC.add_rule sctx
|
SC.add_rule sctx
|
||||||
~mode:(if promote_install_file then
|
~mode:(if promote_install_file then
|
||||||
Promote_but_delete_on_clean
|
Promote_but_delete_on_clean
|
||||||
|
|
|
@ -41,6 +41,7 @@ let file_tree t = t.file_tree
|
||||||
let stanzas_to_consider_for_install t = t.stanzas_to_consider_for_install
|
let stanzas_to_consider_for_install t = t.stanzas_to_consider_for_install
|
||||||
let cxx_flags t = t.cxx_flags
|
let cxx_flags t = t.cxx_flags
|
||||||
let build_dir t = t.context.build_dir
|
let build_dir t = t.context.build_dir
|
||||||
|
let build_system t = t.build_system
|
||||||
|
|
||||||
let host t = Option.value t.host ~default:t
|
let host t = Option.value t.host ~default:t
|
||||||
|
|
||||||
|
@ -218,10 +219,10 @@ let create
|
||||||
let prefix_rules t prefix ~f =
|
let prefix_rules t prefix ~f =
|
||||||
Build_system.prefix_rules t.build_system prefix ~f
|
Build_system.prefix_rules t.build_system prefix ~f
|
||||||
|
|
||||||
let add_rule t ?sandbox ?mode ?locks ?loc build =
|
let add_rule t ?sandbox ?mode ?locks ?loc ?package build =
|
||||||
let build = Build.O.(>>>) build t.chdir in
|
let build = Build.O.(>>>) build t.chdir in
|
||||||
Build_system.add_rule t.build_system
|
Build_system.add_rule t.build_system
|
||||||
(Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc
|
(Build_interpret.Rule.make ?sandbox ?mode ?locks ?loc ?package
|
||||||
~context:(Some t.context) build)
|
~context:(Some t.context) build)
|
||||||
|
|
||||||
let add_rule_get_targets t ?sandbox ?mode ?locks ?loc build =
|
let add_rule_get_targets t ?sandbox ?mode ?locks ?loc build =
|
||||||
|
|
|
@ -41,6 +41,7 @@ val stanzas_to_consider_for_install : t -> (Path.t * Scope.t * Stanza.t) list
|
||||||
val cxx_flags : t -> string list
|
val cxx_flags : t -> string list
|
||||||
val build_dir : t -> Path.t
|
val build_dir : t -> Path.t
|
||||||
val host : t -> t
|
val host : t -> t
|
||||||
|
val build_system : t -> Build_system.t
|
||||||
|
|
||||||
(** All public libraries of the workspace *)
|
(** All public libraries of the workspace *)
|
||||||
val public_libs : t -> Lib.DB.t
|
val public_libs : t -> Lib.DB.t
|
||||||
|
@ -79,6 +80,7 @@ val add_rule
|
||||||
-> ?mode:Jbuild.Rule.Mode.t
|
-> ?mode:Jbuild.Rule.Mode.t
|
||||||
-> ?locks:Path.t list
|
-> ?locks:Path.t list
|
||||||
-> ?loc:Loc.t
|
-> ?loc:Loc.t
|
||||||
|
-> ?package:Package.Name.t
|
||||||
-> (unit, Action.t) Build.t
|
-> (unit, Action.t) Build.t
|
||||||
-> unit
|
-> unit
|
||||||
val add_rule_get_targets
|
val add_rule_get_targets
|
||||||
|
|
Loading…
Reference in New Issue