From a399d9df8ac05818fd1c9dc703f2baf4d4cddb77 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 18 May 2017 13:49:56 +0100 Subject: [PATCH] Declare dependencies on external library files This way, when an external library is reinstalled, jbuilder knows to rebuild things. Currently, because the library dependencies transitive closures are computed dynamically and jbuilder doesn't yet support dynamic targets, every single rule has to depend on all the external files. When jbuilder support dynamic targets, we can setup one alias per external directory. Tested the build of 97 Jane Street repository at once. No slow down observed for the initial build. Then a null build goes from ~1.5s to 2s. The test case is a bit extreme so it's bot that bad given the benefits. --- src/alias.ml | 3 -- src/alias.mli | 2 -- src/cm_kind.ml | 19 +++++++++++++ src/cm_kind.mli | 14 ++++++++++ src/findlib.ml | 29 ++++---------------- src/findlib.mli | 1 - src/gen_rules.ml | 42 ++++++++++++++++------------ src/lib.ml | 26 ++---------------- src/lib.mli | 2 -- src/module_compilation.ml | 42 +++++++++++++++------------- src/module_compilation.mli | 7 +++-- src/super_context.ml | 56 ++++++++++++++++++++++++++++++++++++++ src/super_context.mli | 13 +++++++++ src/utils.ml | 12 ++++++-- 14 files changed, 172 insertions(+), 96 deletions(-) diff --git a/src/alias.ml b/src/alias.ml index 6caa2055..e2b4685c 100644 --- a/src/alias.ml +++ b/src/alias.ml @@ -45,9 +45,6 @@ let default = make "DEFAULT" let runtest = make "runtest" let install = make "install" -let lib_cm_all ~dir lib_name cm_kind = - make (sprintf "%s%s-all" lib_name (Cm_kind.ext cm_kind)) ~dir - let recursive_aliases = [ default ; runtest diff --git a/src/alias.mli b/src/alias.mli index 515955cf..441a3333 100644 --- a/src/alias.mli +++ b/src/alias.mli @@ -6,8 +6,6 @@ val default : dir:Path.t -> t val runtest : dir:Path.t -> t val install : dir:Path.t -> t -val lib_cm_all : dir:Path.t -> string -> Cm_kind.t -> t - val dep : t -> ('a, 'a) Build.t val file : t -> Path.t diff --git a/src/cm_kind.ml b/src/cm_kind.ml index e754bbf3..fb3efe92 100644 --- a/src/cm_kind.ml +++ b/src/cm_kind.ml @@ -10,3 +10,22 @@ let choose cmi cmo cmx = function let ext = choose ".cmi" ".cmo" ".cmx" let source = choose Ml_kind.Intf Impl Impl + +module Dict = struct + type 'a t = + { cmi : 'a + ; cmo : 'a + ; cmx : 'a + } + + let get t = function + | Cmi -> t.cmi + | Cmo -> t.cmo + | Cmx -> t.cmx + + let of_func f = + { cmi = f ~cm_kind:Cmi + ; cmo = f ~cm_kind:Cmo + ; cmx = f ~cm_kind:Cmx + } +end diff --git a/src/cm_kind.mli b/src/cm_kind.mli index 0de11f47..7d248c1e 100644 --- a/src/cm_kind.mli +++ b/src/cm_kind.mli @@ -4,3 +4,17 @@ val all : t list val ext : t -> string val source : t -> Ml_kind.t + +module Dict : sig + type cm_kind = t + + type 'a t = + { cmi : 'a + ; cmo : 'a + ; cmx : 'a + } + + val get : 'a t -> cm_kind -> 'a + + val of_func : (cm_kind:cm_kind -> 'a) -> 'a t +end with type cm_kind := t diff --git a/src/findlib.ml b/src/findlib.ml index 9829fe01..f527f14a 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -128,7 +128,6 @@ type package = ; jsoo_runtime : string list ; requires : package list ; ppx_runtime_deps : package list - ; has_headers : bool } module Package_not_available = struct @@ -201,10 +200,9 @@ type present_or_not_available = | Not_available of Package_not_available.t type t = - { stdlib_dir : Path.t - ; path : Path.t list - ; packages : (string, present_or_not_available) Hashtbl.t - ; has_headers : (Path.t, bool ) Hashtbl.t + { stdlib_dir : Path.t + ; path : Path.t list + ; packages : (string, present_or_not_available) Hashtbl.t } let path t = t.path @@ -212,23 +210,9 @@ let path t = t.path let create ~stdlib_dir ~path = { stdlib_dir ; path - ; packages = Hashtbl.create 1024 - ; has_headers = Hashtbl.create 1024 + ; packages = Hashtbl.create 1024 } -let has_headers t ~dir = - match Hashtbl.find t.has_headers dir with - | Some x -> x - | None -> - let x = - match Path.readdir dir with - | exception _ -> false - | files -> - List.exists files ~f:(fun fn -> Filename.check_suffix fn ".h") - in - Hashtbl.add t.has_headers ~key:dir ~data:x; - x - module Pkg_step1 = struct type t = { package : package @@ -261,14 +245,13 @@ let parse_package t ~name ~parent_dir ~vars ~required_by = let pkg = { name ; dir - ; has_headers = has_headers t ~dir ; version = Vars.get vars "version" [] ; description = Vars.get vars "description" [] ; archives = archives "archive" preds ; jsoo_runtime ; plugins = Mode.Dict.map2 ~f:(@) - (archives "archive" ("plugin" :: preds)) - (archives "plugin" preds) + (archives "archive" ("plugin" :: preds)) + (archives "plugin" preds) ; requires = [] ; ppx_runtime_deps = [] } diff --git a/src/findlib.mli b/src/findlib.mli index 996015f3..a5433e13 100644 --- a/src/findlib.mli +++ b/src/findlib.mli @@ -55,7 +55,6 @@ type package = ; jsoo_runtime : string list ; requires : package list ; ppx_runtime_deps : package list - ; has_headers : bool } val find : t -> required_by:string list -> string -> package option diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 152fcee6..5a9c53a5 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -92,15 +92,6 @@ module Gen(P : Params) = struct ; Dyn (fun (cm_files, _) -> Deps cm_files) ])) - let mk_lib_cm_all (lib : Library.t) ~dir ~modules cm_kind = - let deps = - String_map.fold modules ~init:[] ~f:(fun ~key:_ ~data:m acc -> - Module.cm_file m ~dir cm_kind :: acc) - in - Alias.add_deps (SC.aliases sctx) - (Alias.lib_cm_all ~dir lib.name cm_kind) - deps - let expand_includes ~dir includes = Arg_spec.As (List.concat_map includes ~f:(fun s -> ["-I"; SC.expand_vars sctx ~dir s])) @@ -113,9 +104,7 @@ module Gen(P : Params) = struct >>> Build.fanout (SC.expand_and_eval_set ~dir lib.c_flags ~standard:(Utils.g ())) - (requires - >>> - Build.dyn_paths (Build.arr Lib.header_files)) + requires >>> Build.run ~context:ctx (* We have to execute the rule in the library directory as the .o is produced in @@ -269,11 +258,14 @@ module Gen(P : Params) = struct ~modules:(String_map.singleton m.name m) ~dep_graph:(Ml_kind.Dict.make_both (Build.return (String_map.singleton m.name []))) ~requires:( - if String_map.is_empty modules then - (* Just so that we setup lib dependencies for empty libraries *) - requires - else - Build.return []) + let requires = + if String_map.is_empty modules then + (* Just so that we setup lib dependencies for empty libraries *) + requires + else + Build.return [] + in + Cm_kind.Dict.of_func (fun ~cm_kind:_ -> requires)) ~alias_module:None); if Library.has_stubs lib then begin @@ -286,6 +278,10 @@ module Gen(P : Params) = struct None) in let o_files = + let requires = + Build.memoize "header files" + (requires >>> SC.Libs.file_deps sctx ~ext:".h") + in List.map lib.c_names ~f:(build_c_file lib ~dir ~requires ~h_files) @ List.map lib.cxx_names ~f:(build_cxx_file lib ~dir ~requires ~h_files) in @@ -324,7 +320,17 @@ module Gen(P : Params) = struct end end; - List.iter Cm_kind.all ~f:(mk_lib_cm_all lib ~dir ~modules); + List.iter Cm_kind.all ~f:(fun cm_kind -> + let files = + String_map.fold modules ~init:[] ~f:(fun ~key:_ ~data:m acc -> + Module.cm_file m ~dir cm_kind :: acc) + in + SC.Libs.setup_file_deps_alias sctx (dir, lib) ~ext:(Cm_kind.ext cm_kind) + files); + SC.Libs.setup_file_deps_group_alias sctx (dir, lib) ~exts:[".cmi"; ".cmx"]; + SC.Libs.setup_file_deps_alias sctx (dir, lib) ~ext:".h" + (List.map lib.install_c_headers ~f:(fun header -> + Path.relative dir (header ^ ".h"))); List.iter Mode.all ~f:(fun mode -> build_lib lib ~flags ~dir ~mode ~modules ~dep_graph); diff --git a/src/lib.ml b/src/lib.ml index f67e53ca..5994a13a 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -21,26 +21,11 @@ end include T module Set = Set.Make(T) -(* -let deps = function - | Internal (_, lib) -> lib.libraries - | External pkg -> pkg.requires -*) + let dir = function | Internal (dir, _) -> dir | External pkg -> pkg.dir -let header_files ts = - List.fold_left ts ~init:[] ~f:(fun acc t -> - match t with - | External _ -> [] - | Internal (dir, lib) -> - match lib.install_c_headers with - | [] -> acc - | l -> - List.fold_left l ~init:acc ~f:(fun acc fn -> - Path.relative dir (fn ^ ".h") :: acc)) - let include_paths ts = List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t -> Path.Set.add (dir t) acc) @@ -50,17 +35,10 @@ let include_flags ts = Arg_spec.S (List.concat_map (Path.Set.elements dirs) ~f:(fun dir -> [Arg_spec.A "-I"; Path dir])) -let has_headers = function - | Internal (_, lib) -> lib.install_c_headers <> [] - | External pkg -> pkg.has_headers - let c_include_flags ts = let dirs = List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t -> - if has_headers t then - Path.Set.add (dir t) acc - else - acc) + Path.Set.add (dir t) acc) in Arg_spec.S (List.concat_map (Path.Set.elements dirs) ~f:(fun dir -> [Arg_spec.A "-I"; Path dir])) diff --git a/src/lib.mli b/src/lib.mli index 486412f3..7bdc919b 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -12,8 +12,6 @@ module Set : Set.S with type elt := t (*val deps : t -> string list*) -val header_files : t list -> Path.t list - val include_paths : t list -> Path.Set.t val include_flags : t list -> _ Arg_spec.t diff --git a/src/module_compilation.ml b/src/module_compilation.ml index 7f4b59ca..44597fad 100644 --- a/src/module_compilation.ml +++ b/src/module_compilation.ml @@ -1,22 +1,8 @@ open Import -open Jbuild_types open Build.O module SC = Super_context -let lib_cm_all ~dir (lib : Library.t) cm_kind = - Alias.file (Alias.lib_cm_all ~dir lib.name cm_kind) - -let lib_dependencies (libs : Lib.t list) ~(cm_kind : Cm_kind.t) = - List.concat_map libs ~f:(function - | External _ -> [] - | Internal (dir, lib) -> - match cm_kind with - | Cmi | Cmo -> - [lib_cm_all ~dir lib Cmi] - | Cmx -> - [lib_cm_all ~dir lib Cmx]) - let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_graph) ~requires ~(modules : Module.t String_map.t) ~dir ~alias_module (m : Module.t) = let ctx = SC.context sctx in @@ -75,7 +61,6 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_gra (Build.paths extra_deps >>> other_cm_files >>> requires >>> - Build.dyn_paths (Build.arr (lib_dependencies ~cm_kind)) >>> Build.run ~context:ctx (Dep compiler) ~extra_targets [ Ocaml_flags.get_for_cm flags ~cm_kind @@ -92,16 +77,35 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_gra ; A "-c"; Ml_kind.flag ml_kind; Dep src ]))) -let build_module sctx ?sandbox ~dynlink ~js_of_ocaml ~flags m ~dir ~dep_graph ~modules ~requires - ~alias_module = +let build_module sctx ?sandbox ~dynlink ~js_of_ocaml ~flags m ~dir ~dep_graph + ~modules ~requires ~alias_module = List.iter Cm_kind.all ~f:(fun cm_kind -> - build_cm sctx ?sandbox ~dynlink ~flags ~dir ~dep_graph ~modules m ~cm_kind ~requires - ~alias_module); + let requires = Cm_kind.Dict.get requires cm_kind in + build_cm sctx ?sandbox ~dynlink ~flags ~dir ~dep_graph ~modules m ~cm_kind + ~requires ~alias_module); (* Build *.cmo.js *) let src = Module.cm_file m ~dir Cm_kind.Cmo in SC.add_rules sctx (Js_of_ocaml_rules.build_cm sctx ~dir ~js_of_ocaml ~src) let build_modules sctx ~dynlink ~js_of_ocaml ~flags ~dir ~dep_graph ~modules ~requires ~alias_module = + let cmi_requires = + Build.memoize "cmi library dependencies" + (requires + >>> + SC.Libs.file_deps sctx ~ext:".cmi") + in + let cmi_and_cmx_requires = + Build.memoize "cmi and cmx library dependencies" + (requires + >>> + SC.Libs.file_deps sctx ~ext:".cmi-and-.cmx") + in + let requires : _ Cm_kind.Dict.t = + { cmi = cmi_requires + ; cmo = cmi_requires + ; cmx = cmi_and_cmx_requires + } + in String_map.iter (match alias_module with | None -> modules diff --git a/src/module_compilation.mli b/src/module_compilation.mli index 7424ac79..823926cf 100644 --- a/src/module_compilation.mli +++ b/src/module_compilation.mli @@ -2,7 +2,10 @@ open Import -(** Setup rules to build a single module *) +(** Setup rules to build a single module. + + [requires] must declare dependencies on files of libraries. +*) val build_module : Super_context.t -> ?sandbox:bool @@ -13,7 +16,7 @@ val build_module -> dir:Path.t -> dep_graph:Ocamldep.dep_graph -> modules:Module.t String_map.t - -> requires:(unit, Lib.t list) Build.t + -> requires:(unit, Lib.t list) Build.t Cm_kind.Dict.t -> alias_module:Module.t option -> unit diff --git a/src/super_context.ml b/src/super_context.ml index 0b068c28..4242b0f3 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -10,6 +10,33 @@ module Dir_with_jbuild = struct } end +module External_dir = struct + (* Files in the directory, grouped by extension *) + type t = Path.t list String_map.t + + let create ~dir : t = + match Path.readdir dir with + | exception _ -> String_map.empty + | files -> + List.map files ~f:(fun fn -> Filename.extension fn, Path.relative dir fn) + |> String_map.of_alist_multi + (* CR-someday jdimino: when we can have dynamic targets: + + {[ + |> String_map.mapi ~f:(fun ext files -> + lazy ( + let alias = + Alias.make ~dir:Path.root (sprintf "external-files-%s%s" hash ext) + in + Alias.add_deps aliases alias files; + alias + )) + ]} + *) + + let files t ~ext = String_map.find_default ext t ~default:[] +end + type t = { context : Context.t ; libs : Lib_db.t @@ -26,6 +53,7 @@ type t = ; vars : string String_map.t ; ppx_dir : Path.t ; ppx_drivers : (string, Path.t) Hashtbl.t + ; external_dirs : (Path.t, External_dir.t) Hashtbl.t } let context t = t.context @@ -40,6 +68,10 @@ let cxx_flags t = t.cxx_flags let expand_var_no_root t var = String_map.find var t.vars +let get_external_dir t ~dir = + Hashtbl.find_or_add t.external_dirs dir ~f:(fun dir -> + External_dir.create ~dir) + let expand_vars t ~dir s = String_with_vars.expand s ~f:(function | "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir) @@ -166,6 +198,7 @@ let create ; vars ; ppx_drivers = Hashtbl.create 32 ; ppx_dir = Path.of_string (sprintf "_build/.ppx/%s" context.name) + ; external_dirs = Hashtbl.create 1024 } let add_rule t ?sandbox build = @@ -324,6 +357,29 @@ module Libs = struct Lib.remove_dups_preserve_order (rt_deps @ rt_deps_of_deps)) >>> Build.store_vfile vruntime_deps) + + let lib_files_alias ((dir, lib) : Lib.Internal.t) ~ext = + Alias.make (sprintf "lib-%s%s-all" lib.name ext) ~dir + + let setup_file_deps_alias t lib ~ext files = + Alias.add_deps t.aliases (lib_files_alias lib ~ext) files + + let setup_file_deps_group_alias t lib ~exts = + setup_file_deps_alias t lib + ~ext:(String.concat exts ~sep:"-and-") + (List.map exts ~f:(fun ext -> Alias.file (lib_files_alias lib ~ext))) + + let file_deps t ~ext = + Build.dyn_paths (Build.arr (fun libs -> + List.fold_left libs ~init:[] ~f:(fun acc (lib : Lib.t) -> + match lib with + | External pkg -> begin + List.rev_append + (External_dir.files (get_external_dir t ~dir:pkg.dir) ~ext) + acc + end + | Internal lib -> + Alias.file (lib_files_alias lib ~ext) :: acc))) end module Deps = struct diff --git a/src/super_context.mli b/src/super_context.mli index 3223c1f3..7b0f6b36 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -95,6 +95,19 @@ module Libs : sig -> libraries:Lib_deps.t -> ppx_runtime_libraries:string list -> unit + + (** [file_deps ~ext] is an arrow that record dependencies on all the files with + extension [ext] of the libraries given as input. *) + val file_deps : t -> ext:string -> (Lib.t list, Lib.t list) Build.t + + (** Setup the alias that depends on all files with a given extension for a library *) + val setup_file_deps_alias : t -> Lib.Internal.t -> ext:string -> Path.t list -> unit + + (** Setup an alias that depend on all files with the given extensions. + + To depend on this alias, use [~ext:"ext1-and-ext2-...-extn"] + *) + val setup_file_deps_group_alias : t -> Lib.Internal.t -> exts:string list -> unit end (** Interpret dependencies written in jbuild files *) diff --git a/src/utils.ml b/src/utils.ml index c38135ee..7f3af677 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -75,8 +75,16 @@ let jbuild_name_in ~dir = let describe_target fn = match Path.extract_build_context fn with - | Some (".aliases", dir) -> - sprintf "alias %s" (Path.to_string dir) + | Some (".aliases", fn) -> + let name = + let fn = Path.to_string fn in + match String.rsplit2 fn ~on:'-' with + | None -> assert false + | Some (name, digest) -> + assert (String.length digest = 32); + name + in + sprintf "alias %s" name | _ -> Path.to_string fn