From 5099f2e63c16b9428af0f0f66193595c30d21047 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Tue, 26 Mar 2019 17:25:19 +0100 Subject: [PATCH] [dir_contents] Allow qualified traversal of directories. This is a cherry-pick of the directory traversal parts from the Dune PR (#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 --- src/dir_contents.ml | 31 +++++++++++++++++++------------ src/dir_status.ml | 5 +++-- src/dir_status.mli | 1 + src/dune_file.ml | 16 ++++++++++------ src/dune_file.mli | 3 ++- 5 files changed, 35 insertions(+), 21 deletions(-) diff --git a/src/dir_contents.ml b/src/dir_contents.ml index f13f59256565..1718f91ad061 100644 --- a/src/dir_contents.ml +++ b/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 diff --git a/src/dir_status.ml b/src/dir_status.ml index 009c02b15e7b..1a7c99c7c909 100644 --- a/src/dir_status.ml +++ b/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 -> diff --git a/src/dir_status.mli b/src/dir_status.mli index 2ec45e789232..b9a251b21eaf 100644 --- a/src/dir_status.mli +++ b/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] *) diff --git a/src/dune_file.ml b/src/dune_file.ml index 97f4e5176b4b..14152fc81f38 100644 --- a/src/dune_file.ml +++ b/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", diff --git a/src/dune_file.mli b/src/dune_file.mli index 86df0d8c41e3..7a73b2cf1295 100644 --- a/src/dune_file.mli +++ b/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 +=