Fix recursive aliases
This commit is contained in:
parent
affacb8925
commit
087c9570e4
23
src/alias.ml
23
src/alias.ml
|
@ -31,21 +31,22 @@ let add_deps store t deps =
|
|||
|
||||
type tree = Node of Path.t * tree list
|
||||
|
||||
let rec setup_rec_aliases store (Node (dir, children)) =
|
||||
List.map recursive_aliases ~f:(fun make_alias ->
|
||||
let alias = make_alias ~dir in
|
||||
List.iter children ~f:(fun child ->
|
||||
let sub_aliases = setup_rec_aliases store child in
|
||||
add_deps store alias sub_aliases);
|
||||
alias)
|
||||
let rec setup_rec_alias store ~make_alias ~prefix ~tree:(Node (dir, children)) =
|
||||
let alias = make_alias ~dir:(Path.append prefix dir) in
|
||||
add_deps store alias (List.map children ~f:(fun child ->
|
||||
setup_rec_alias store ~make_alias ~prefix ~tree:child));
|
||||
alias
|
||||
|
||||
let rules store tree =
|
||||
ignore (setup_rec_aliases store tree : t list);
|
||||
let setup_rec_aliases store ~prefix ~tree =
|
||||
List.iter recursive_aliases ~f:(fun make_alias ->
|
||||
ignore (setup_rec_alias store ~make_alias ~prefix ~tree : t))
|
||||
|
||||
let rules store ~prefix ~tree =
|
||||
setup_rec_aliases store ~prefix ~tree;
|
||||
Hashtbl.fold store ~init:[] ~f:(fun ~key:alias ~data:deps acc ->
|
||||
let open Build.O in
|
||||
let rule =
|
||||
Build.path_set !deps >>>
|
||||
Build.create_file ~target:alias (fun _ ->
|
||||
close_out (open_out_bin (Path.to_string alias)))
|
||||
Build.touch alias
|
||||
in
|
||||
rule :: acc)
|
||||
|
|
|
@ -17,4 +17,8 @@ val add_deps : Store.t -> t -> Path.t list -> unit
|
|||
|
||||
type tree = Node of Path.t * tree list
|
||||
|
||||
val rules : Store.t -> tree -> (unit, unit) Build.t list
|
||||
val rules
|
||||
: Store.t
|
||||
-> prefix:Path.t
|
||||
-> tree:tree
|
||||
-> (unit, unit) Build.t list
|
||||
|
|
|
@ -240,8 +240,8 @@ module Gen(P : Params) = struct
|
|||
include Alias
|
||||
|
||||
let store = Store.create ()
|
||||
let _add_deps t deps = add_deps store t deps
|
||||
let rules () = rules store P.tree
|
||||
let add_deps t deps = add_deps store t deps
|
||||
let rules () = rules store ~prefix:ctx.build_dir ~tree:P.tree
|
||||
end
|
||||
|
||||
let all_rules = ref []
|
||||
|
@ -1241,7 +1241,7 @@ module Gen(P : Params) = struct
|
|||
let digest_path =
|
||||
Path.relative dir (Path.basename (Alias.file alias) ^ "-" ^ digest) in
|
||||
let dummy = Build.touch digest_path in
|
||||
Alias._add_deps alias [digest_path];
|
||||
Alias.add_deps alias [digest_path];
|
||||
let deps =
|
||||
let deps = Dep_conf_interpret.dep_of_list ~dir alias_conf.deps in
|
||||
match alias_conf.action with
|
||||
|
|
Loading…
Reference in New Issue