Add File_tree.Dir.dune_file (#749)

src/build_system.ml

@@ -129,17 +129,15 @@ let rule_loc ~file_tree ~loc ~dir =
   | Some loc -> loc
   | None ->
     let dir = Path.drop_optional_build_context dir in
-    let fname =
+    let file =
-      if File_tree.file_exists file_tree dir "dune" then
+      match
-        "dune"
+        Option.bind (File_tree.find_dir file_tree dir)
-      else if File_tree.file_exists file_tree dir "jbuild" then
+          ~f:File_tree.Dir.dune_file
-        "jbuild"
+      with
-      else
+      | Some file -> file
-        "_unknown_"
+      | None      -> Path.relative dir "_unknown_"
     in
-    Loc.in_file
+    Loc.in_file (Path.to_string file)
-      (Path.to_string
-         (Path.drop_optional_build_context (Path.relative dir fname)))
 
 module Internal_rule = struct
   module Id : sig

src/file_tree.ml

@@ -38,6 +38,15 @@ module Dir = struct
       let acc = f t acc in
       String.Map.fold (sub_dirs t) ~init:acc ~f:(fun t acc ->
         fold t ~traverse_ignored_dirs ~init:acc ~f)
+
+  let dune_file t =
+    let (lazy { files; _ }) = t.contents in
+    if String.Set.mem files "dune" then
+      Some (Path.relative t.path "dune")
+    else if String.Set.mem files "jbuild" then
+      Some (Path.relative t.path "jbuild")
+    else
+      None
 end
 
 type t =

src/file_tree.mli

@@ -22,6 +22,9 @@ module Dir : sig
     -> init:'a
     -> f:(t -> 'a -> 'a)
     -> 'a
+
+  (** Return the dune (or jbuild) file in this directory *)
+  val dune_file : t -> Path.t option
 end
 
 (** A [t] value represent a view of the source tree. It is lazily

src/jbuild_load.ml

@@ -207,8 +207,7 @@ module Sexp_io = struct
       loop0 Parser.Stack.empty 0)
 end
 
-let load ~dir ~scope ~ignore_promoted_rules ~fname =
+let load ~dir ~scope ~ignore_promoted_rules ~file =
-  let file = Path.relative dir fname in
   match Sexp_io.load_many_or_ocaml_script file with
   | Sexps sexps ->
     Jbuilds.Literal (dir, scope,
@@ -299,22 +298,16 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () =
       jbuilds
     else begin
       let path = File_tree.Dir.path dir in
-      let files = File_tree.Dir.files dir in
       let sub_dirs = File_tree.Dir.sub_dirs dir in
       let scope = Option.value (Path.Map.find scopes path) ~default:scope in
       let jbuilds =
-        if String.Set.mem files "dune" then
+        match File_tree.Dir.dune_file dir with
+        | None -> jbuilds
+        | Some file ->
           let jbuild =
-            load ~dir:path ~scope ~ignore_promoted_rules ~fname:"dune"
+            load ~dir:path ~scope ~ignore_promoted_rules ~file
           in
           jbuild :: jbuilds
-        else if String.Set.mem files "jbuild" then
-          let jbuild =
-            load ~dir:path ~scope ~ignore_promoted_rules ~fname:"jbuild"
-          in
-          jbuild :: jbuilds
-        else
-          jbuilds
       in
       String.Map.fold sub_dirs ~init:jbuilds
         ~f:(fun dir jbuilds -> walk dir jbuilds scope)