[dir_contents] Allow qualified traversal of directories.

This is a cherry-pick of the directory traversal parts from the Dune
PR (ocaml#1968).

I was uncomfortable with the misnaming done there, so this PR enables
the `(include_subdirs qualified)` syntax and provides a `local` part
to the traversal so clients [such as the Coq mode] can use it.

Note that this does introduce a bit of overhead in the tree traversal,
especially in deep trees, it should be possible to optimize if we deem
it necessary.

Signed-off-by: Emilio Jesus Gallego Arias <e+git@x80.org>

src/dir_contents.ml

@@ -364,6 +364,10 @@ module Key = struct
   let hash = Tuple.T2.hash Super_context.hash Path.hash
 end
 
+let check_no_qualified loc qualif_mode =
+  if qualif_mode = Include_subdirs.Qualified then
+    Errors.fail loc "(include_subdirs qualified) is not supported yet"
+
 let get0_impl (sctx, dir) : result0 =
   let dir_status_db = Super_context.dir_status_db sctx in
   match Dir_status.DB.get dir_status_db ~dir with
@@ -407,8 +411,8 @@ let get0_impl (sctx, dir) : result0 =
        })
   | Is_component_of_a_group_but_not_the_root { group_root; _ } ->
     See_above group_root
-  | Group_root (ft_dir, d) ->
-    let rec walk ft_dir ~dir acc =
+  | Group_root (ft_dir, qualif_mode, d) ->
+    let rec walk ft_dir ~dir ~local acc =
       match
         Dir_status.DB.get dir_status_db ~dir
       with
@@ -418,25 +422,27 @@ let get0_impl (sctx, dir) : result0 =
           | None -> File_tree.Dir.files ft_dir
           | Some d -> load_text_files sctx ft_dir d
         in
-        walk_children ft_dir ~dir ((dir, files) :: acc)
+        walk_children ft_dir ~dir ~local ((dir, List.rev local, files) :: acc)
       | _ -> acc
-    and walk_children ft_dir ~dir acc =
+    and walk_children ft_dir ~dir ~local acc =
       String.Map.foldi (File_tree.Dir.sub_dirs ft_dir) ~init:acc
         ~f:(fun name ft_dir acc ->
           let dir = Path.relative dir name in
-          walk ft_dir ~dir acc)
+          let local = if qualif_mode = Qualified then name :: local else local in
+          walk ft_dir ~dir ~local acc)
     in
     let (files, subdirs), rules =
       Memo.Implicit_output.collect_sync
         Build_system.rule_collection_implicit_output (fun () ->
           let files = load_text_files sctx ft_dir d in
-          let subdirs = walk_children ft_dir ~dir [] in
+          let subdirs = walk_children ft_dir ~dir ~local:[] [] in
           files, subdirs)
     in
     let modules = Memo.lazy_ (fun () ->
+      check_no_qualified Loc.none qualif_mode;
       let modules =
-        List.fold_left ((dir, files) :: subdirs) ~init:Module.Name.Map.empty
-          ~f:(fun acc (dir, files) ->
+        List.fold_left ((dir, [], files) :: subdirs) ~init:Module.Name.Map.empty
+          ~f:(fun acc (dir, _local, files) ->
             let modules = modules_of_files ~dir ~files in
             Module.Name.Map.union acc modules ~f:(fun name x y ->
               Errors.fail (Loc.in_file
@@ -455,11 +461,12 @@ let get0_impl (sctx, dir) : result0 =
       Modules.make d ~modules)
     in
     let c_sources = Memo.lazy_ (fun () ->
+      check_no_qualified Loc.none qualif_mode;
       let dune_version = d.dune_version in
       let init = C.Kind.Dict.make String.Map.empty in
       let c_sources =
-        List.fold_left ((dir, files) :: subdirs) ~init
-          ~f:(fun acc (dir, files) ->
+        List.fold_left ((dir, [], files) :: subdirs) ~init
+          ~f:(fun acc (dir, _local, files) ->
             let sources = C_sources.load_sources ~dir ~dune_version ~files in
             let f acc sources =
               String.Map.union acc sources ~f:(fun name x y ->
@@ -485,7 +492,7 @@ let get0_impl (sctx, dir) : result0 =
     let t =
       { kind = Group_root
                  (Memo.lazy_ (fun () ->
-                    List.map subdirs ~f:(fun (dir, _) ->
+                    List.map subdirs ~f:(fun (dir, _, _) ->
                       Fdecl.get get_without_rules_fdecl (sctx, dir)
                     )))
       ; dir
@@ -497,7 +504,7 @@ let get0_impl (sctx, dir) : result0 =
     in
     let
       subdirs =
-      List.map subdirs ~f:(fun (dir, files) ->
+      List.map subdirs ~f:(fun (dir, _local, files) ->
         dir,
         { kind = Group_part t
         ; dir

src/dir_status.ml

@@ -15,6 +15,7 @@ module T = struct
        generated ones. *)
 
     | Group_root of File_tree.Dir.t
+                    * Include_subdirs.qualification
                     * Stanza.t list Dir_with_dune.t
     (* Directory with [(include_subdirs x)] where [x] is not [no] *)
 
@@ -105,8 +106,8 @@ module DB = struct
                { stanzas = None; group_root })
       | Some d ->
         match get_include_subdirs d.data with
-        | Some Unqualified ->
-          Group_root (ft_dir, d)
+        | Some (Include mode) ->
+          Group_root (ft_dir, mode, d)
         | Some No ->
           Standalone (Some (ft_dir, Some d))
         | None ->

src/dir_status.mli

@@ -13,6 +13,7 @@ type t =
      generated ones. *)
 
   | Group_root of File_tree.Dir.t
+                  * Dune_file.Include_subdirs.qualification
                   * Stanza.t list Dir_with_dune.t
   (* Directory with [(include_subdirs x)] where [x] is not [no] *)
 

src/dune_file.ml

@@ -1960,13 +1960,17 @@ module Documentation = struct
 end
 
 module Include_subdirs = struct
-  type t = No | Unqualified
 
-  let decode =
-    enum
+  type qualification = Unqualified | Qualified
+  type t = No | Include of qualification
+
+  let decode ~enable_qualified =
+    let opts_list =
       [ "no", No
-      ; "unqualified", Unqualified
-      ]
+      ; "unqualified", Include Unqualified
+      ] @ if enable_qualified then ["qualified", Include Qualified] else []
+    in
+    enum opts_list
 end
 
 type Stanza.t +=
@@ -2053,7 +2057,7 @@ module Stanzas = struct
        [Dune_env.T x])
     ; "include_subdirs",
       (let+ () = Syntax.since Stanza.syntax (1, 1)
-       and+ t = Include_subdirs.decode
+       and+ t = Include_subdirs.decode ~enable_qualified:false
        and+ loc = loc in
        [Include_subdirs (loc, t)])
     ; "toplevel",

src/dune_file.mli

@@ -405,7 +405,8 @@ module Toplevel : sig
 end
 
 module Include_subdirs : sig
-  type t = No | Unqualified
+  type qualification = Unqualified | Qualified
+  type t = No | Include of qualification
 end
 
 type Stanza.t +=