Setup copy rules for all source files
This is cleaner and allow dependencies on files that do not appear in static deps or targets. With this patch, one can now build all JS packages at once.
This commit is contained in:
parent
875df08235
commit
614dbc6f6b
|
@ -168,31 +168,13 @@ module Build_interpret = struct
|
|||
| Fanout (a, b) -> loop a (loop b acc)
|
||||
| Paths fns -> Pset.union fns acc
|
||||
| Vpath (Vspec.T (fn, _)) -> Pset.add fn acc
|
||||
| Paths_glob (dir, re) ->
|
||||
let src_dir =
|
||||
match Path.extract_build_context dir with
|
||||
| None -> dir
|
||||
| Some (_, dir) -> dir
|
||||
in
|
||||
let files =
|
||||
Path.readdir src_dir
|
||||
|> List.filter_map ~f:(fun fn ->
|
||||
if Re.execp re fn then begin
|
||||
let path = Path.relative src_dir fn in
|
||||
if Path.is_directory path then
|
||||
None
|
||||
else
|
||||
Some path
|
||||
end else
|
||||
None)
|
||||
|> Pset.of_list
|
||||
in
|
||||
let files =
|
||||
| Paths_glob (dir, re) -> begin
|
||||
match Pmap.find dir (Lazy.force all_targets_by_dir) with
|
||||
| None -> files
|
||||
| Some targets -> Pset.union files targets
|
||||
in
|
||||
Pset.union files acc
|
||||
| None -> Pset.empty
|
||||
| Some targets ->
|
||||
Pset.filter targets ~f:(fun path ->
|
||||
Re.execp re (Path.basename path))
|
||||
end
|
||||
| Dyn_paths t -> loop t acc
|
||||
| Record_lib_deps _ -> acc
|
||||
in
|
||||
|
@ -357,33 +339,47 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
|||
; exec
|
||||
}
|
||||
in
|
||||
create_file_specs t target_specs rule ~allow_override;
|
||||
rule
|
||||
create_file_specs t target_specs rule ~allow_override
|
||||
|
||||
let copy_rules ~all_deps ~all_targets =
|
||||
let contexts = Context.all () in
|
||||
Pset.fold (Pset.union all_deps all_targets) ~init:[] ~f:(fun fn acc ->
|
||||
match Path.extract_build_context fn with
|
||||
| Some (name, src) ->
|
||||
if String_map.mem name contexts &&
|
||||
Path.exists src &&
|
||||
not (Pset.mem src all_targets) then
|
||||
Build.copy ~src ~dst:fn :: acc
|
||||
else
|
||||
acc
|
||||
| None ->
|
||||
acc
|
||||
)
|
||||
let setup_copy_rules t ~all_non_target_source_files ~all_targets_by_dir =
|
||||
String_map.iter (Context.all ()) ~f:(fun ~key:_ ~data:(ctx : Context.t) ->
|
||||
let ctx_dir = ctx.build_dir in
|
||||
Pset.iter all_non_target_source_files ~f:(fun path ->
|
||||
let build = Build.copy ~src:path ~dst:(Path.append ctx_dir path) in
|
||||
(* We temporarily allow overrides while setting up copy rules
|
||||
from the source directory so that artifact that are already
|
||||
present in the source directory are not re-computed.
|
||||
|
||||
let create ~rules =
|
||||
This allows to keep generated files in tarballs. Maybe we
|
||||
should allow it on a case-by-case basis though. *)
|
||||
compile_rule t (Pre_rule.make build)
|
||||
~all_targets_by_dir
|
||||
~allow_override:true))
|
||||
|
||||
let create ~file_tree ~rules =
|
||||
let rules = List.map rules ~f:Pre_rule.make in
|
||||
let all_targets =
|
||||
let all_source_files =
|
||||
File_tree.fold file_tree ~init:Pset.empty ~f:(fun dir acc ->
|
||||
let path = File_tree.Dir.path dir in
|
||||
Pset.union acc
|
||||
(File_tree.Dir.files dir
|
||||
|> String_set.elements
|
||||
|> List.map ~f:(Path.relative path)
|
||||
|> Pset.of_list))
|
||||
in
|
||||
let all_copy_targets =
|
||||
String_map.fold (Context.all ()) ~init:Pset.empty ~f:(fun ~key:_ ~data:(ctx : Context.t) acc ->
|
||||
Pset.union acc (Pset.elements all_source_files
|
||||
|> List.map ~f:(Path.append ctx.build_dir)
|
||||
|> Pset.of_list))
|
||||
in
|
||||
let all_other_targets =
|
||||
List.fold_left rules ~init:Pset.empty ~f:(fun acc { Pre_rule.targets; _ } ->
|
||||
List.fold_left targets ~init:acc ~f:(fun acc target ->
|
||||
Pset.add (Target.path target) acc))
|
||||
in
|
||||
let all_targets_by_dir = lazy (
|
||||
Pset.elements all_targets
|
||||
Pset.elements (Pset.union all_copy_targets all_other_targets)
|
||||
|> List.filter_map ~f:(fun path ->
|
||||
if Path.is_root path then
|
||||
None
|
||||
|
@ -393,25 +389,10 @@ let create ~rules =
|
|||
|> Pmap.map ~f:Pset.of_list
|
||||
) in
|
||||
let t = { files = Hashtbl.create 1024 } in
|
||||
let rules =
|
||||
List.map rules ~f:(compile_rule t ~all_targets_by_dir ~allow_override:false)
|
||||
in
|
||||
let all_deps =
|
||||
List.fold_left rules ~init:Pset.empty ~f:(fun acc { Rule.deps; _ } ->
|
||||
Pset.union acc deps)
|
||||
in
|
||||
(* We temporarily allow overrides while setting up copy rules from the source directory
|
||||
so that artifact that are already present in the source directory are not
|
||||
re-computed.
|
||||
|
||||
This allows to keep generated files in tarballs. Maybe we should allow it on a
|
||||
case-by-case basis though.
|
||||
*)
|
||||
List.iter (copy_rules ~all_deps ~all_targets)
|
||||
~f:(fun build ->
|
||||
ignore (compile_rule t (Pre_rule.make build)
|
||||
~all_targets_by_dir:(lazy (assert false))
|
||||
~allow_override:true : Rule.t));
|
||||
List.iter rules ~f:(compile_rule t ~all_targets_by_dir ~allow_override:false);
|
||||
setup_copy_rules t ~all_targets_by_dir
|
||||
~all_non_target_source_files:
|
||||
(Pset.diff all_source_files all_other_targets);
|
||||
t
|
||||
|
||||
let remove_old_artifacts t =
|
||||
|
|
|
@ -4,7 +4,7 @@ open! Import
|
|||
|
||||
type t
|
||||
|
||||
val create : rules:(unit, unit) Build.t list -> t
|
||||
val create : file_tree:File_tree.t -> rules:(unit, unit) Build.t list -> t
|
||||
|
||||
module Build_error : sig
|
||||
type t
|
||||
|
|
|
@ -0,0 +1,76 @@
|
|||
open! Import
|
||||
|
||||
module Dir = struct
|
||||
type t =
|
||||
{ path : Path.t
|
||||
; files : String_set.t
|
||||
; sub_dirs : t String_map.t
|
||||
}
|
||||
|
||||
let path t = t.path
|
||||
let files t = t.files
|
||||
let sub_dirs t = t.sub_dirs
|
||||
|
||||
let rec fold t ~init ~f =
|
||||
let init = f t init in
|
||||
String_map.fold t.sub_dirs ~init ~f:(fun ~key:_ ~data:t acc ->
|
||||
fold t ~init:acc ~f)
|
||||
end
|
||||
|
||||
type t =
|
||||
{ root : Dir.t
|
||||
; dirs : Dir.t Path.Map.t
|
||||
}
|
||||
|
||||
let root t = t.root
|
||||
|
||||
let always_ignore =
|
||||
String_set.of_list
|
||||
[ ""
|
||||
; "_build"
|
||||
; ".git"
|
||||
; ".hg"
|
||||
; "_darcs"
|
||||
]
|
||||
|
||||
let ignore_file = function
|
||||
| ""
|
||||
| "_build"
|
||||
| ".git"
|
||||
| ".hg"
|
||||
| "_darcs"
|
||||
| "." -> true
|
||||
| fn -> fn.[0] = '.' && fn.[1] = '#'
|
||||
|
||||
let load path =
|
||||
let rec walk path : Dir.t =
|
||||
let files, sub_dirs =
|
||||
Path.readdir path
|
||||
|> List.filter ~f:(fun fn ->
|
||||
not (ignore_file fn))
|
||||
|> List.partition_map ~f:(fun fn ->
|
||||
let path = Path.relative path fn in
|
||||
if Path.exists path && Path.is_directory path then
|
||||
Inr (fn, walk path)
|
||||
else
|
||||
Inl fn)
|
||||
in
|
||||
{ path
|
||||
; files = String_set.of_list files
|
||||
; sub_dirs = String_map.of_alist_exn sub_dirs
|
||||
}
|
||||
in
|
||||
let root = walk path in
|
||||
let dirs =
|
||||
Dir.fold root ~init:Path.Map.empty ~f:(fun dir acc ->
|
||||
Path.Map.add acc ~key:dir.path ~data:dir)
|
||||
in
|
||||
{ root
|
||||
; dirs
|
||||
}
|
||||
|
||||
let fold t ~init ~f =
|
||||
Path.Map.fold t.dirs ~init ~f:(fun ~key:_ ~data:dir acc -> f dir acc)
|
||||
|
||||
let find_dir t path =
|
||||
Path.Map.find path t.dirs
|
|
@ -0,0 +1,20 @@
|
|||
open! Import
|
||||
|
||||
|
||||
module Dir : sig
|
||||
type t
|
||||
|
||||
val path : t -> Path.t
|
||||
val files : t -> String_set.t
|
||||
val sub_dirs : t -> t String_map.t
|
||||
end
|
||||
|
||||
type t
|
||||
|
||||
val load : Path.t -> t
|
||||
|
||||
val fold : t -> init:'a -> f:(Dir.t -> 'a -> 'a) -> 'a
|
||||
|
||||
val root : t -> Dir.t
|
||||
|
||||
val find_dir : t -> Path.t -> Dir.t option
|
|
@ -66,6 +66,7 @@ let obj_name_of_basename fn =
|
|||
|
||||
module type Params = sig
|
||||
val context : Context.t
|
||||
val file_tree : File_tree.t
|
||||
val tree : Alias.tree
|
||||
val stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||
val packages : string list
|
||||
|
@ -1363,7 +1364,11 @@ module Gen(P : Params) = struct
|
|||
|
||||
let rules { src_dir; ctx_dir; stanzas } =
|
||||
let files = lazy (
|
||||
let src_files = Path.readdir src_dir |> String_set.of_list in
|
||||
let src_files =
|
||||
match File_tree.find_dir P.file_tree src_dir with
|
||||
| None -> String_set.empty
|
||||
| Some dir -> File_tree.Dir.files dir
|
||||
in
|
||||
let files_produced_by_rules =
|
||||
List.concat_map stanzas ~f:(fun stanza ->
|
||||
match (stanza : Stanza.t) with
|
||||
|
@ -1528,11 +1533,12 @@ module Gen(P : Params) = struct
|
|||
~dst:(Path.relative Path.root fn)))
|
||||
end
|
||||
|
||||
let gen ~context ~tree ~stanzas ~packages
|
||||
let gen ~context ~file_tree ~tree ~stanzas ~packages
|
||||
?(filter_out_optional_stanzas_with_missing_deps=true) () =
|
||||
let module M =
|
||||
Gen(struct
|
||||
let context = context
|
||||
let file_tree = file_tree
|
||||
let tree = tree
|
||||
let stanzas = stanzas
|
||||
let packages = packages
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
val gen
|
||||
: context:Context.t
|
||||
-> file_tree:File_tree.t
|
||||
-> tree:Alias.tree
|
||||
-> stanzas:(Path.t * Jbuild_types.Stanza.t list) list
|
||||
-> packages:string list
|
||||
|
|
|
@ -2,61 +2,54 @@ open Import
|
|||
open Jbuild_types
|
||||
|
||||
type conf =
|
||||
{ tree : Alias.tree
|
||||
{ file_tree : File_tree.t
|
||||
; tree : Alias.tree
|
||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||
; packages : string list
|
||||
}
|
||||
|
||||
let load fn ~dir = (dir, Sexp_load.many fn Stanza.t)
|
||||
|
||||
let always_ignore =
|
||||
String_set.of_list
|
||||
[ ""
|
||||
; "_build"
|
||||
; ".git"
|
||||
; ".hg"
|
||||
]
|
||||
|
||||
let load () =
|
||||
let load ftree =
|
||||
let rec walk dir stanzas =
|
||||
let files = Path.readdir dir |> String_set.of_list in
|
||||
let ignore_set =
|
||||
let path = File_tree.Dir.path dir in
|
||||
let files = File_tree.Dir.files dir in
|
||||
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
||||
let sub_dirs =
|
||||
if String_set.mem "jbuild-ignore" files then
|
||||
String_set.union
|
||||
(lines_of_file (Path.to_string (Path.relative dir "jbuild-ignore"))
|
||||
|> String_set.of_list)
|
||||
always_ignore
|
||||
let ignore_set =
|
||||
String_set.of_list
|
||||
(lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
|
||||
in
|
||||
String_map.filter sub_dirs ~f:(fun fn _ ->
|
||||
not (String_set.mem fn ignore_set))
|
||||
else
|
||||
always_ignore
|
||||
sub_dirs
|
||||
in
|
||||
let children, stanzas =
|
||||
String_set.fold files ~init:([], stanzas) ~f:(fun fn ((children, stanzas) as acc) ->
|
||||
if String_set.mem fn ignore_set || fn.[0] = '.' then
|
||||
acc
|
||||
else
|
||||
let fn = Path.relative dir fn in
|
||||
if Path.exists fn && Path.is_directory fn then
|
||||
let child, stanzas, _ = walk fn stanzas in
|
||||
(child :: children, stanzas)
|
||||
else
|
||||
acc)
|
||||
String_map.fold sub_dirs ~init:([], stanzas) ~f:(fun ~key:_ ~data:dir (children, stanzas) ->
|
||||
let child, stanzas = walk dir stanzas in
|
||||
(child :: children, stanzas))
|
||||
in
|
||||
let stanzas =
|
||||
if String_set.mem "jbuild" files then
|
||||
load (Path.to_string (Path.relative dir "jbuild")) ~dir :: stanzas
|
||||
load (Path.to_string (Path.relative path "jbuild")) ~dir:path :: stanzas
|
||||
else
|
||||
stanzas
|
||||
in
|
||||
(Alias.Node (dir, children), stanzas, files)
|
||||
(Alias.Node (path, children), stanzas)
|
||||
in
|
||||
let tree, stanzas, files = walk Path.root [] in
|
||||
let ftree = File_tree.load Path.root in
|
||||
let root = File_tree.root ftree in
|
||||
let tree, stanzas = walk root [] in
|
||||
let packages =
|
||||
String_set.fold files ~init:[] ~f:(fun fn acc ->
|
||||
String_set.fold (File_tree.Dir.files root) ~init:[] ~f:(fun fn acc ->
|
||||
match Filename.split_ext fn with
|
||||
| Some (pkg, ".opam") -> pkg :: acc
|
||||
| _ -> acc)
|
||||
in
|
||||
{ tree
|
||||
{ file_tree = ftree
|
||||
; tree
|
||||
; stanzas
|
||||
; packages
|
||||
}
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
|
||||
type conf =
|
||||
{ tree : Alias.tree
|
||||
{ file_tree : File_tree.t
|
||||
; tree : Alias.tree
|
||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||
; packages : string list
|
||||
}
|
||||
|
|
|
@ -47,13 +47,13 @@ let internal argv =
|
|||
()
|
||||
|
||||
let setup ?filter_out_optional_stanzas_with_missing_deps () =
|
||||
let { Jbuild_load. tree; stanzas; packages } = Jbuild_load.load () in
|
||||
let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
|
||||
Lazy.force Context.default >>= fun ctx ->
|
||||
let rules =
|
||||
Gen_rules.gen ~context:ctx ~tree ~stanzas ~packages
|
||||
Gen_rules.gen ~context:ctx ~file_tree ~tree ~stanzas ~packages
|
||||
?filter_out_optional_stanzas_with_missing_deps ()
|
||||
in
|
||||
let bs = Build_system.create ~rules in
|
||||
let bs = Build_system.create ~file_tree ~rules in
|
||||
return (bs, stanzas, ctx)
|
||||
|
||||
let external_lib_deps ~packages =
|
||||
|
|
Loading…
Reference in New Issue