Merge pull request #458 from rgrinberg/remove-dir-from-record-lib-deps

Remove the path argument from Record_lib_deps

src/build.ml

@@ -34,7 +34,7 @@ module Repr = struct
     | Lines_of : Path.t -> ('a, string list) t
     | Vpath : 'a Vspec.t -> (unit, 'a) t
     | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
-    | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
+    | Record_lib_deps : lib_deps -> ('a, 'a) t
     | Fail : fail -> (_, _) t
     | Memo : 'a memo -> (unit, 'a) t
 
@@ -80,13 +80,12 @@ let merge_lib_deps a b =
 let arr f = Arr f
 let return x = Arr (fun () -> x)
 
-let record_lib_deps_simple ~dir lib_deps =
+let record_lib_deps_simple lib_deps =
-  Record_lib_deps (dir, lib_deps)
+  Record_lib_deps lib_deps
 
-let record_lib_deps ~dir ~kind lib_deps =
+let record_lib_deps ~kind lib_deps =
   Record_lib_deps
-    (dir,
+    (List.concat_map lib_deps ~f:(function
-     List.concat_map lib_deps ~f:(function
        | Jbuild.Lib_dep.Direct s -> [(s, kind)]
        | Select { choices; _ } ->
          List.concat_map choices ~f:(fun c ->

src/build.mli

@@ -124,14 +124,13 @@ type lib_dep_kind =
   | Required
 
 val record_lib_deps
-  :  dir:Path.t
+  :  kind:lib_dep_kind
-  -> kind:lib_dep_kind
   -> Jbuild.Lib_dep.t list
   -> ('a, 'a) t
 
 type lib_deps = lib_dep_kind String_map.t
 
-val record_lib_deps_simple : dir:Path.t -> lib_deps -> ('a, 'a) t
+val record_lib_deps_simple : lib_deps -> ('a, 'a) t
 
 (**/**)
 
@@ -153,7 +152,7 @@ module Repr : sig
     | Lines_of : Path.t -> ('a, string list) t
     | Vpath : 'a Vspec.t -> (unit, 'a) t
     | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
-    | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
+    | Record_lib_deps : lib_deps -> ('a, 'a) t
     | Fail : fail -> (_, _) t
     | Memo : 'a memo -> (unit, 'a) t
 

src/build_interpret.ml

@@ -88,7 +88,7 @@ let static_deps t ~all_targets =
   loop (Build.repr t) { rule_deps = Pset.empty; action_deps = Pset.empty }
 
 let lib_deps =
-  let rec loop : type a b. (a, b) t -> Build.lib_deps Pmap.t -> Build.lib_deps Pmap.t
+  let rec loop : type a b. (a, b) t -> Build.lib_deps option -> Build.lib_deps option
     = fun t acc ->
       match t with
       | Arr _ -> acc
@@ -105,19 +105,17 @@ let lib_deps =
       | Dyn_paths t -> loop t acc
       | Contents _ -> acc
       | Lines_of _ -> acc
-      | Record_lib_deps (dir, deps) ->
+      | Record_lib_deps deps ->
-        let data =
+        begin match acc with
-          match Pmap.find dir acc with
+        | None -> Some deps
-          | None -> deps
+        | Some acc -> Some (Build.merge_lib_deps deps acc)
-          | Some others -> Build.merge_lib_deps deps others
+        end
-        in
-        Pmap.add acc ~key:dir ~data
       | Fail _ -> acc
       | If_file_exists (_, state) ->
         loop (get_if_file_exists_exn state) acc
       | Memo m -> loop m.t acc
   in
-  fun t -> loop (Build.repr t) Pmap.empty
+  fun t -> loop (Build.repr t) None
 
 let targets =
   let rec loop : type a b. (a, b) t -> Target.t list -> Target.t list = fun t acc ->

src/build_interpret.mli

@@ -47,7 +47,7 @@ val static_deps
 
 val lib_deps
   :  (_, _) Build.t
-  -> Build.lib_deps Path.Map.t
+  -> Build.lib_deps option
 
 val targets
   :  (_, _) Build.t

src/build_system.ml

@@ -107,6 +107,7 @@ module Internal_rule = struct
     ; build            : (unit, Action.t) Build.t
     ; mode             : Jbuild.Rule.Mode.t
     ; loc              : Loc.t option
+    ; dir              : Path.t
     ; mutable exec     : Exec_status.t
     }
 
@@ -606,7 +607,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
       ; mode
       ; locks
       ; loc
-      ; dir = _
+      ; dir
       } =
     pre_rule
   in
@@ -728,6 +729,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
     ; exec = Not_started { eval_rule; exec_rule }
     ; mode
     ; loc
+    ; dir
     }
   in
   create_file_specs t target_specs rule ~copy_source
@@ -1188,8 +1190,11 @@ let static_deps_of_request t request =
 let all_lib_deps t ~request =
   let targets = static_deps_of_request t request in
   List.fold_left (rules_for_targets t targets) ~init:Pmap.empty
-    ~f:(fun acc rule ->
+    ~f:(fun acc (rule : Internal_rule.t) ->
-      let lib_deps = Build_interpret.lib_deps rule.Internal_rule.build in
+      let lib_deps =
+        match Build_interpret.lib_deps rule.build with
+        | None -> Pmap.empty
+        | Some deps -> Pmap.singleton rule.dir deps in
       Pmap.merge acc lib_deps ~f:(fun _ a b ->
         match a, b with
         | None, None -> None
@@ -1199,8 +1204,12 @@ let all_lib_deps t ~request =
 
 let all_lib_deps_by_context t ~request =
   let targets = static_deps_of_request t request in
-  List.fold_left (rules_for_targets t targets) ~init:[] ~f:(fun acc rule ->
+  rules_for_targets t targets
-    let lib_deps = Build_interpret.lib_deps rule.Internal_rule.build in
+  |> List.fold_left  ~init:[] ~f:(fun acc (rule : Internal_rule.t) ->
+    let lib_deps =
+        match Build_interpret.lib_deps rule.build with
+        | None -> Pmap.empty
+        | Some deps -> Pmap.singleton rule.dir deps in
     Path.Map.fold lib_deps ~init:acc ~f:(fun ~key:path ~data:lib_deps acc ->
       match Path.extract_build_context path with
       | None -> acc

src/super_context.ml

@@ -254,7 +254,7 @@ module Libs = struct
   let closure t ~dir ~dep_kind lib_deps =
     let internals, externals, fail = Lib_db.interpret_lib_deps t.libs ~dir lib_deps in
     with_fail ~fail
-      (Build.record_lib_deps ~dir ~kind:dep_kind lib_deps
+      (Build.record_lib_deps ~kind:dep_kind lib_deps
        >>>
        Build.all
          (List.map internals ~f:(fun ((dir, lib) : Lib.Internal.t) ->
@@ -273,7 +273,7 @@ module Libs = struct
   let closed_ppx_runtime_deps_of t ~dir ~dep_kind lib_deps =
     let internals, externals, fail = Lib_db.interpret_lib_deps t.libs ~dir lib_deps in
     with_fail ~fail
-      (Build.record_lib_deps ~dir ~kind:dep_kind lib_deps
+      (Build.record_lib_deps ~kind:dep_kind lib_deps
        >>>
        Build.all
          (List.map internals ~f:(fun ((dir, lib) : Lib.Internal.t) ->
@@ -305,7 +305,7 @@ module Libs = struct
     in
     let vrequires = vrequires t ~dir ~item in
     add_rule t
-      (Build.record_lib_deps ~dir ~kind:dep_kind (List.map virtual_deps ~f:Lib_dep.direct)
+      (Build.record_lib_deps ~kind:dep_kind (List.map virtual_deps ~f:Lib_dep.direct)
        >>>
        Build.fanout
          (closure t ~dir ~dep_kind libraries)
@@ -709,7 +709,7 @@ module Action = struct
              sprintf "- %s" (Utils.describe_target target))
            |> String.concat ~sep:"\n"));
     let build =
-      Build.record_lib_deps_simple ~dir forms.lib_deps
+      Build.record_lib_deps_simple forms.lib_deps
       >>>
       Build.path_set deps
       >>>