diff --git a/src/build_system.ml b/src/build_system.ml index f595b419..c36c0927 100644 --- a/src/build_system.ml +++ b/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 = - if File_tree.file_exists file_tree dir "dune" then - "dune" - else if File_tree.file_exists file_tree dir "jbuild" then - "jbuild" - else - "_unknown_" + let file = + match + Option.bind (File_tree.find_dir file_tree dir) + ~f:File_tree.Dir.dune_file + with + | Some file -> file + | None -> Path.relative dir "_unknown_" in - Loc.in_file - (Path.to_string - (Path.drop_optional_build_context (Path.relative dir fname))) + Loc.in_file (Path.to_string file) module Internal_rule = struct module Id : sig diff --git a/src/file_tree.ml b/src/file_tree.ml index 59b89b70..535038bd 100644 --- a/src/file_tree.ml +++ b/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 = diff --git a/src/file_tree.mli b/src/file_tree.mli index 5c10207b..be098fa9 100644 --- a/src/file_tree.mli +++ b/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 diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 6f75cb4e..a387816e 100644 --- a/src/jbuild_load.ml +++ b/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 file = Path.relative dir fname in +let load ~dir ~scope ~ignore_promoted_rules ~file = 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)