Get rid of Alias.tree

This commit is contained in:
Jeremie Dimino 2017-09-29 14:27:27 +01:00 committed by Rudi Grinberg
parent 7a5698c7b1
commit 3e13492b7a
7 changed files with 34 additions and 39 deletions

View File

@ -104,21 +104,27 @@ let add_deps store t deps =
} }
| Some e -> e.deps <- Path.Set.union deps e.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 ~dir =
let path = File_tree.Dir.path dir in
let rec setup_rec_alias store ~make_alias ~prefix ~tree:(Node (dir, children)) = let children = File_tree.Dir.sub_dirs dir in
let alias = make_alias ~dir:(Path.append prefix dir) in let alias = make_alias ~dir:(Path.append prefix path) in
add_deps store alias (List.map children ~f:(fun child -> add_deps store alias
setup_rec_alias store ~make_alias ~prefix ~tree:child)); (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 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 -> 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 -> 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 *) (* For each alias @_build/blah/../x, add a dependency: @../x --> @_build/blah/../x *)
Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; _ } acc -> Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; _ } acc ->

View File

@ -48,10 +48,8 @@ end
val add_deps : Store.t -> t -> Path.t list -> unit val add_deps : Store.t -> t -> Path.t list -> unit
type tree = Node of Path.t * tree list
val rules val rules
: Store.t : Store.t
-> prefixes:Path.t list -> prefixes:Path.t list
-> tree:tree -> file_tree:File_tree.t
-> Build_interpret.Rule.t list -> Build_interpret.Rule.t list

View File

@ -34,7 +34,7 @@ let ignore_file fn ~is_directory =
(is_directory && (fn.[0] = '.' || fn.[0] = '_')) || (is_directory && (fn.[0] = '.' || fn.[0] = '_')) ||
(fn.[0] = '.' && fn.[1] = '#') (fn.[0] = '.' && fn.[1] = '#')
let load path = let load ?(extra_ignored_subtrees=Path.Set.empty) path =
let rec walk path ~ignored : Dir.t = let rec walk path ~ignored : Dir.t =
let files, sub_dirs = let files, sub_dirs =
Path.readdir path Path.readdir path
@ -61,7 +61,11 @@ let load path =
in in
let sub_dirs = let sub_dirs =
List.map sub_dirs ~f:(fun (fn, path) -> 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)) (fn, walk path ~ignored))
|> String_map.of_alist_exn |> String_map.of_alist_exn
in in

View File

@ -14,7 +14,7 @@ end
type t type t
val load : Path.t -> t val load : ?extra_ignored_subtrees:Path.Set.t -> Path.t -> t
val fold val fold
: t : t

View File

@ -1104,7 +1104,7 @@ end
let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
?only_packages conf = ?only_packages conf =
let open Future in 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 aliases = Alias.Store.create () in
let dirs_with_dot_opam_files = let dirs_with_dot_opam_files =
String_map.fold packages ~init:Path.Set.empty 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 -> >>| fun l ->
let rules, context_names_and_stanzas = List.split l in let rules, context_names_and_stanzas = List.split l in
(Alias.rules aliases (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, @ List.concat rules,
String_map.of_alist_exn context_names_and_stanzas) String_map.of_alist_exn context_names_and_stanzas)

View File

@ -151,7 +151,6 @@ end
type conf = type conf =
{ file_tree : File_tree.t { file_tree : File_tree.t
; tree : Alias.tree
; jbuilds : Jbuilds.t ; jbuilds : Jbuilds.t
; packages : Package.t String_map.t ; packages : Package.t String_map.t
} }
@ -164,8 +163,8 @@ let load ~dir ~scope =
| Ocaml_script -> | Ocaml_script ->
Script { dir; scope } Script { dir; scope }
let load ?(extra_ignored_subtrees=Path.Set.empty) () = let load ?extra_ignored_subtrees () =
let ftree = File_tree.load Path.root in let ftree = File_tree.load Path.root ?extra_ignored_subtrees in
let packages = let packages =
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs -> File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs ->
let path = File_tree.Dir.path dir in 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 |> Path.Map.map ~f:Scope.make
in in
let rec walk dir jbuilds scope = let rec walk dir jbuilds scope =
if File_tree.Dir.ignored dir || if File_tree.Dir.ignored dir then
Path.Set.mem (File_tree.Dir.path dir) extra_ignored_subtrees then jbuilds
None
else begin else begin
let path = File_tree.Dir.path dir in let path = File_tree.Dir.path dir in
let files = File_tree.Dir.files dir in let files = File_tree.Dir.files dir in
@ -220,23 +218,13 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () =
else else
jbuilds jbuilds
in in
let children, jbuilds = String_map.fold sub_dirs ~init:jbuilds
String_map.fold sub_dirs ~init:([], jbuilds) ~f:(fun ~key:_ ~data:dir jbuilds ->
~f:(fun ~key:_ ~data:dir (children, jbuilds) -> walk dir jbuilds scope)
match walk dir jbuilds scope with
| None -> (children, jbuilds)
| Some (child, jbuilds) -> (child :: children, jbuilds))
in
Some (Alias.Node (path, children), jbuilds)
end end
in in
let root = File_tree.root ftree in let jbuilds = walk (File_tree.root ftree) [] Scope.empty in
let tree, jbuilds =
Option.value (walk root [] Scope.empty)
~default:(Alias.Node (File_tree.Dir.path root, []), [])
in
{ file_tree = ftree { file_tree = ftree
; tree
; jbuilds ; jbuilds
; packages ; packages
} }

View File

@ -9,7 +9,6 @@ end
type conf = type conf =
{ file_tree : File_tree.t { file_tree : File_tree.t
; tree : Alias.tree
; jbuilds : Jbuilds.t ; jbuilds : Jbuilds.t
; packages : Package.t String_map.t ; packages : Package.t String_map.t
} }