From 3e13492b7a175206d9a02baaa670d2d9027dce82 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 29 Sep 2017 14:27:27 +0100 Subject: [PATCH] Get rid of Alias.tree --- src/alias.ml | 26 ++++++++++++++++---------- src/alias.mli | 4 +--- src/file_tree.ml | 8 ++++++-- src/file_tree.mli | 2 +- src/gen_rules.ml | 4 ++-- src/jbuild_load.ml | 28 ++++++++-------------------- src/jbuild_load.mli | 1 - 7 files changed, 34 insertions(+), 39 deletions(-) diff --git a/src/alias.ml b/src/alias.ml index 9456778f..cfbfb996 100644 --- a/src/alias.ml +++ b/src/alias.ml @@ -104,21 +104,27 @@ let add_deps store t deps = } | Some e -> e.deps <- Path.Set.union deps e.deps -type tree = Node of Path.t * tree list - -let rec setup_rec_alias store ~make_alias ~prefix ~tree:(Node (dir, children)) = - let alias = make_alias ~dir:(Path.append prefix dir) in - add_deps store alias (List.map children ~f:(fun child -> - setup_rec_alias store ~make_alias ~prefix ~tree:child)); +let rec setup_rec_alias store ~make_alias ~prefix ~dir = + let path = File_tree.Dir.path dir in + let children = File_tree.Dir.sub_dirs dir in + let alias = make_alias ~dir:(Path.append prefix path) in + add_deps store alias + (String_map.fold children ~init:[] + ~f:(fun ~key:_ ~data:child acc -> + if File_tree.Dir.ignored child then + acc + else + setup_rec_alias store ~make_alias ~prefix ~dir:child :: acc)); alias.file -let setup_rec_aliases store ~prefix ~tree = +let setup_rec_aliases store ~prefix ~file_tree = + let dir = File_tree.root file_tree in List.iter recursive_aliases ~f:(fun make_alias -> - ignore (setup_rec_alias store ~make_alias ~prefix ~tree : Path.t)) + ignore (setup_rec_alias store ~make_alias ~prefix ~dir : Path.t)) -let rules store ~prefixes ~tree = +let rules store ~prefixes ~file_tree = List.iter prefixes ~f:(fun prefix -> - setup_rec_aliases store ~prefix ~tree); + setup_rec_aliases store ~prefix ~file_tree); (* For each alias @_build/blah/../x, add a dependency: @../x --> @_build/blah/../x *) Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; _ } acc -> diff --git a/src/alias.mli b/src/alias.mli index c976e35b..637ec0c3 100644 --- a/src/alias.mli +++ b/src/alias.mli @@ -48,10 +48,8 @@ end val add_deps : Store.t -> t -> Path.t list -> unit -type tree = Node of Path.t * tree list - val rules : Store.t -> prefixes:Path.t list - -> tree:tree + -> file_tree:File_tree.t -> Build_interpret.Rule.t list diff --git a/src/file_tree.ml b/src/file_tree.ml index 50d9377e..5649d2c7 100644 --- a/src/file_tree.ml +++ b/src/file_tree.ml @@ -34,7 +34,7 @@ let ignore_file fn ~is_directory = (is_directory && (fn.[0] = '.' || fn.[0] = '_')) || (fn.[0] = '.' && fn.[1] = '#') -let load path = +let load ?(extra_ignored_subtrees=Path.Set.empty) path = let rec walk path ~ignored : Dir.t = let files, sub_dirs = Path.readdir path @@ -61,7 +61,11 @@ let load path = in let sub_dirs = List.map sub_dirs ~f:(fun (fn, path) -> - let ignored = ignored || String_set.mem fn ignored_sub_dirs in + let ignored = + ignored + || String_set.mem fn ignored_sub_dirs + || Path.Set.mem path extra_ignored_subtrees + in (fn, walk path ~ignored)) |> String_map.of_alist_exn in diff --git a/src/file_tree.mli b/src/file_tree.mli index b9a5cd93..e71ee5be 100644 --- a/src/file_tree.mli +++ b/src/file_tree.mli @@ -14,7 +14,7 @@ end type t -val load : Path.t -> t +val load : ?extra_ignored_subtrees:Path.Set.t -> Path.t -> t val fold : t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index b0dbd779..a381eda6 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -1104,7 +1104,7 @@ end let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) ?only_packages conf = let open Future in - let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in + let { Jbuild_load. file_tree; jbuilds; packages } = conf in let aliases = Alias.Store.create () in let dirs_with_dot_opam_files = String_map.fold packages ~init:Path.Set.empty @@ -1151,6 +1151,6 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) >>| fun l -> let rules, context_names_and_stanzas = List.split l in (Alias.rules aliases - ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree + ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~file_tree @ List.concat rules, String_map.of_alist_exn context_names_and_stanzas) diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 5b7d3f4a..c0622e7a 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -151,7 +151,6 @@ end type conf = { file_tree : File_tree.t - ; tree : Alias.tree ; jbuilds : Jbuilds.t ; packages : Package.t String_map.t } @@ -164,8 +163,8 @@ let load ~dir ~scope = | Ocaml_script -> Script { dir; scope } -let load ?(extra_ignored_subtrees=Path.Set.empty) () = - let ftree = File_tree.load Path.root in +let load ?extra_ignored_subtrees () = + let ftree = File_tree.load Path.root ?extra_ignored_subtrees in let packages = File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs -> let path = File_tree.Dir.path dir in @@ -205,9 +204,8 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () = |> Path.Map.map ~f:Scope.make in let rec walk dir jbuilds scope = - if File_tree.Dir.ignored dir || - Path.Set.mem (File_tree.Dir.path dir) extra_ignored_subtrees then - None + if File_tree.Dir.ignored dir then + jbuilds else begin let path = File_tree.Dir.path dir in let files = File_tree.Dir.files dir in @@ -220,23 +218,13 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () = else jbuilds in - let children, jbuilds = - String_map.fold sub_dirs ~init:([], jbuilds) - ~f:(fun ~key:_ ~data:dir (children, jbuilds) -> - match walk dir jbuilds scope with - | None -> (children, jbuilds) - | Some (child, jbuilds) -> (child :: children, jbuilds)) - in - Some (Alias.Node (path, children), jbuilds) + String_map.fold sub_dirs ~init:jbuilds + ~f:(fun ~key:_ ~data:dir jbuilds -> + walk dir jbuilds scope) end in - let root = File_tree.root ftree in - let tree, jbuilds = - Option.value (walk root [] Scope.empty) - ~default:(Alias.Node (File_tree.Dir.path root, []), []) - in + let jbuilds = walk (File_tree.root ftree) [] Scope.empty in { file_tree = ftree - ; tree ; jbuilds ; packages } diff --git a/src/jbuild_load.mli b/src/jbuild_load.mli index 2f8fb6ff..67998263 100644 --- a/src/jbuild_load.mli +++ b/src/jbuild_load.mli @@ -9,7 +9,6 @@ end type conf = { file_tree : File_tree.t - ; tree : Alias.tree ; jbuilds : Jbuilds.t ; packages : Package.t String_map.t }