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

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

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
 

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

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

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
+  { stdlib_dir    : Path.t
-  ; path        : Path.t list
+  ; path          : Path.t list
-  ; packages    : (string, present_or_not_available) Hashtbl.t
+  ; packages      : (string, present_or_not_available) Hashtbl.t
-  ; has_headers : (Path.t, bool                    ) 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
+  ; packages      = Hashtbl.create 1024
-  ; has_headers = 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 "archive" ("plugin" :: preds))
-                      (archives "plugin" preds)
+                       (archives "plugin" preds)
     ; requires    = []
     ; ppx_runtime_deps = []
     }

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

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
+         requires
-          >>>
-          Build.dyn_paths (Build.arr Lib.header_files))
        >>>
        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
+          let requires =
-            (* Just so that we setup lib dependencies for empty libraries *)
+            if String_map.is_empty modules then
-            requires
+              (* Just so that we setup lib dependencies for empty libraries *)
-          else
+              requires
-            Build.return [])
+            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);

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)
-        Path.Set.add (dir t) acc
-      else
-        acc)
   in
   Arg_spec.S (List.concat_map (Path.Set.elements dirs) ~f:(fun dir ->
     [Arg_spec.A "-I"; Path dir]))

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

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
+let build_module sctx ?sandbox ~dynlink ~js_of_ocaml ~flags m ~dir ~dep_graph
-      ~alias_module =
+      ~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
+    let requires = Cm_kind.Dict.get requires cm_kind in
-      ~alias_module);
+    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

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
 

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

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

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) ->
+  | Some (".aliases", fn) ->
-    sprintf "alias %s" (Path.to_string dir)
+    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