From 9fe0e9c87dbf01813e5c3f279490eebaa42cbde7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Sat, 25 Feb 2017 01:33:37 +0000 Subject: [PATCH] Improve alias management --- bin/main.ml | 14 +-------- doc/manual.org | 10 +++---- src/alias.ml | 75 +++++++++++++++++++++++++++++++++++------------ src/alias.mli | 3 +- src/gen_rules.ml | 63 ++++++++++++++++++++------------------- src/gen_rules.mli | 2 +- src/main.ml | 5 ++-- 7 files changed, 97 insertions(+), 75 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 23b95c0b..4b5d0a27 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -129,11 +129,6 @@ type target = | File of Path.t | Alias of Path.t * Alias.t -let aliases_in_source_tree = - String_set.of_list - [ "install" - ] - let resolve_targets (setup : Main.setup) user_targets = match user_targets with | [] -> [] @@ -146,15 +141,8 @@ let resolve_targets (setup : Main.setup) user_targets = if Path.is_root path then die "@ on the command line must be followed by a valid alias name" else - let name = Path.basename path in - let path = - if Path.is_in_build_dir path || - String_set.mem name aliases_in_source_tree then - path - else - Path.append setup.context.build_dir path - in let dir = Path.parent path in + let name = Path.basename path in Alias (path, Alias.make ~dir name) else File ( diff --git a/doc/manual.org b/doc/manual.org index b48e7ce0..f727da1b 100644 --- a/doc/manual.org +++ b/doc/manual.org @@ -130,12 +130,10 @@ Jbuilder doesn't read =.opam= files, however when a =.opam= is present, Jbuilder will knows that the package named == exists. It will know how to construct a =.install= file in the same directory, to handle installation -via [[https://opam.ocaml.org/][opam]]. In addition, Jbuilder will also know how to build -=.install= at the root of the workspace, for -convenience. Jbuilder also defines the =install= alias, which depends -on all the buildable =.install= at the root of the -workspace. So for instance to build everything that is installable in -a workspace, run: +via [[https://opam.ocaml.org/][opam]]. Jbuilder also defines the recursive =install= alias, which depends +on all the buildable =.install= files in the workspace. So +for instance to build everything that is installable in a workspace, +run at the root: #+begin_src $ jbuilder build @install diff --git a/src/alias.ml b/src/alias.ml index d90c133a..e6a10435 100644 --- a/src/alias.ml +++ b/src/alias.ml @@ -1,39 +1,66 @@ open! Import -type t = Path.t +module Name : sig + type t + val make : Path.t -> t + val path : t -> Path.t +end = struct + type t = Path.t + let make t = t + let path t = t +end + +type t = + { name : Name.t + ; file : Path.t + } let aliases_path = Path.(relative root) "_build/.aliases" -let make name ~dir = - if not (Path.is_local dir) then +let of_path path = + if not (Path.is_local path) then die "Aliases are only supported for local paths!\n\ - Tried to reference alias %S in %s" - name (Path.to_string dir); - Path.append aliases_path (Path.relative dir name) + Tried to reference alias %S" + (Path.to_string path); + { name = Name.make path + ; file = Path.append aliases_path path + } -let dep = Build.path +let make name ~dir = of_path (Path.relative dir name) -let file t = t +let dep t = Build.path t.file + +let file t = t.file let default = make "DEFAULT" let runtest = make "runtest" +let install = make "install" let recursive_aliases = [ default ; runtest + ; install ] module Store = struct - type nonrec t = (t, Path.Set.t ref) Hashtbl.t + type entry = + { alias : t + ; mutable deps : Path.Set.t + } + type t = (Name.t, entry) Hashtbl.t let create () = Hashtbl.create 1024 end let add_deps store t deps = let deps = Path.Set.of_list deps in - match Hashtbl.find store t with - | None -> Hashtbl.add store ~key:t ~data:(ref deps) - | Some r -> r := Path.Set.union deps !r + match Hashtbl.find store t.name with + | None -> + Hashtbl.add store ~key:t.name + ~data:{ Store.alias = t + ; deps = deps + } + | Some e -> e.deps <- Path.Set.union deps e.deps type tree = Node of Path.t * tree list @@ -41,19 +68,29 @@ 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 + alias.file 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)) + ignore (setup_rec_alias store ~make_alias ~prefix ~tree : Path.t)) -let rules store ~prefix ~tree = - setup_rec_aliases store ~prefix ~tree; - Hashtbl.fold store ~init:[] ~f:(fun ~key:alias ~data:deps acc -> +let rules store ~prefixes ~tree = + List.iter prefixes ~f:(fun prefix -> + setup_rec_aliases store ~prefix ~tree); + + (* For each alias @_build/blah/../x, add a dependency: @../x --> @_build/blah/../x *) + Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; _ } acc -> + match Path.extract_build_context (Name.path alias.name) with + | None -> acc + | Some (_, in_src) -> (of_path in_src, alias) :: acc) + |> List.iter ~f:(fun (in_src, in_build_dir) -> + add_deps store in_src [in_build_dir.file]); + + Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; deps } acc -> let open Build.O in let rule = Build_interpret.Rule.make - (Build.path_set !deps >>> - Build.touch alias) + (Build.path_set deps >>> + Build.touch alias.file) in rule :: acc) diff --git a/src/alias.mli b/src/alias.mli index d9a8c8d2..aac32d0c 100644 --- a/src/alias.mli +++ b/src/alias.mli @@ -4,6 +4,7 @@ val make : string -> dir:Path.t -> t val default : dir:Path.t -> t val runtest : dir:Path.t -> t +val install : dir:Path.t -> t val dep : t -> ('a, 'a) Build.t val file : t -> Path.t @@ -19,6 +20,6 @@ type tree = Node of Path.t * tree list val rules : Store.t - -> prefix:Path.t + -> prefixes:Path.t list -> tree:tree -> Build_interpret.Rule.t list diff --git a/src/gen_rules.ml b/src/gen_rules.ml index ea913166..4a5561d2 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -96,10 +96,10 @@ 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 : Package.t String_map.t val filter_out_optional_stanzas_with_missing_deps : bool + val alias_store : Alias.Store.t end module Gen(P : Params) = struct @@ -264,12 +264,9 @@ module Gen(P : Params) = struct module Alias = struct include Alias - let store = Store.create () - let add_deps t deps = add_deps store t deps - let rules () = rules store ~prefix:ctx.build_dir ~tree:P.tree + let add_deps t deps = add_deps P.alias_store t deps end - let all_rules = ref [] let known_targets_by_dir_so_far = ref Path.Map.empty @@ -1679,38 +1676,40 @@ module Gen(P : Params) = struct install_file pkg.Package.path pkg.name) let () = - let install_alias = Alias.make ~dir:ctx.build_dir "install" in - let global_install_alias = Alias.make ~dir:Path.root "install" in let is_default = Path.basename ctx.build_dir = "default" in - String_map.iter P.packages ~f:(fun ~key:pkg ~data:{ Package.path; _ } -> + String_map.iter P.packages ~f:(fun ~key:pkg ~data:{ Package.path = src_path; _ } -> let install_fn = pkg ^ ".install" in - let in_source_dir = Path.relative path install_fn in - let orig = Path.append ctx.build_dir in_source_dir in - let at_root_of_build_context = Path.relative ctx.build_dir install_fn in - if not (Path.is_root path) then - add_rule (Build.copy ~src:orig ~dst:at_root_of_build_context); - Alias.add_deps install_alias [at_root_of_build_context]; + + let ctx_path = Path.append ctx.build_dir src_path in + let ctx_install_alias = Alias.install ~dir:ctx_path in + let ctx_install_file = Path.relative ctx_path install_fn in + Alias.add_deps ctx_install_alias [ctx_install_file]; if is_default then begin - add_rule (Build.copy ~src:orig ~dst:in_source_dir); - let at_root = Path.relative Path.root install_fn in - if not (Path.is_root path) then - add_rule (Build.copy ~src:orig ~dst:at_root); - Alias.add_deps global_install_alias [at_root] + let src_install_alias = Alias.install ~dir:src_path in + let src_install_file = Path.relative src_path install_fn in + add_rule (Build.copy ~src:ctx_install_file ~dst:src_install_file); + Alias.add_deps src_install_alias [src_install_file] end) end -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 - let filter_out_optional_stanzas_with_missing_deps = - filter_out_optional_stanzas_with_missing_deps - end) +let gen ~contexts ~file_tree ~tree ~stanzas ~packages + ?(filter_out_optional_stanzas_with_missing_deps=true) () = + let alias_store = Alias.Store.create () in + let rules = + List.concat_map contexts ~f:(fun context -> + let module M = + Gen(struct + let context = context + let file_tree = file_tree + let stanzas = stanzas + let packages = packages + let filter_out_optional_stanzas_with_missing_deps = + filter_out_optional_stanzas_with_missing_deps + let alias_store = alias_store + end) + in + !M.all_rules) in - M.Alias.rules () @ !M.all_rules + Alias.rules alias_store ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree + @ rules diff --git a/src/gen_rules.mli b/src/gen_rules.mli index 9457e2e8..815583dc 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -1,7 +1,7 @@ open Import val gen - : context:Context.t + : contexts:Context.t list -> file_tree:File_tree.t -> tree:Alias.tree -> stanzas:(Path.t * Jbuild_types.Stanza.t list) list diff --git a/src/main.ml b/src/main.ml index e1f5a8d8..767f777d 100644 --- a/src/main.ml +++ b/src/main.ml @@ -28,9 +28,8 @@ let setup ?filter_out_optional_stanzas_with_missing_deps () = | Some c -> return c) >>= fun default_context -> let rules = - List.concat_map contexts ~f:(fun context -> - Gen_rules.gen ~context ~file_tree ~tree ~stanzas ~packages - ?filter_out_optional_stanzas_with_missing_deps ()) + Gen_rules.gen ~contexts ~file_tree ~tree ~stanzas ~packages + ?filter_out_optional_stanzas_with_missing_deps () in let build_system = Build_system.create ~file_tree ~rules in return { build_system