matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Jeremie Dimino 2017-05-18 13:49:56 +01:00
parent 08af136c97
commit a399d9df8a
14 changed files with 172 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/alias.ml
View File

@ -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

2
src/alias.mli
View File

@ -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

19
src/cm_kind.ml
View File

@ -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

14
src/cm_kind.mli
View File

@ -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

29
src/findlib.ml
View File

@ -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 = []
}

1
src/findlib.mli
View File

@ -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

42
src/gen_rules.ml
View File

@ -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);

26
src/lib.ml
View File

@ -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]))

2
src/lib.mli
View File

@ -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

42
src/module_compilation.ml
View File

@ -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

7
src/module_compilation.mli
View File

@ -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

56
src/super_context.ml
View File

@ -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

13
src/super_context.mli
View File

@ -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 *)

12
src/utils.ml
View File

@ -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