Get rid of Alias.tree
This commit is contained in:
parent
7a5698c7b1
commit
3e13492b7a
26
src/alias.ml
26
src/alias.ml
|
@ -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 ->
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue