commit
0219b0ffdb
|
@ -367,25 +367,25 @@ type hook =
|
|||
|
||||
type t =
|
||||
{ (* File specification by targets *)
|
||||
files : (Path.t, File_spec.packed) Hashtbl.t
|
||||
files : File_spec.packed Path.Table.t
|
||||
; contexts : Context.t String.Map.t
|
||||
; (* Table from target to digest of
|
||||
[(deps (filename + contents), targets (filename only), action)] *)
|
||||
trace : (Path.t, Digest.t) Hashtbl.t
|
||||
trace : Digest.t Path.Table.t
|
||||
; file_tree : File_tree.t
|
||||
; mutable local_mkdirs : Path.Set.t
|
||||
; mutable dirs : (Path.t, Dir_status.t) Hashtbl.t
|
||||
; mutable dirs : Dir_status.t Path.Table.t
|
||||
; mutable gen_rules :
|
||||
(dir:Path.t -> string list -> extra_sub_directories_to_keep) String.Map.t
|
||||
; mutable load_dir_stack : Path.t list
|
||||
; (* Set of directories under _build that have at least one rule and
|
||||
all their ancestors. *)
|
||||
mutable build_dirs_to_keep : Path.Set.t
|
||||
; files_of : (Path.t, Files_of.t) Hashtbl.t
|
||||
; files_of : Files_of.t Path.Table.t
|
||||
; mutable prefix : (unit, unit) Build.t option
|
||||
; hook : hook -> unit
|
||||
; (* Package files are part of *)
|
||||
packages : (Path.t, Package.Name.t) Hashtbl.t
|
||||
packages : Package.Name.t Path.Table.t
|
||||
}
|
||||
|
||||
let string_of_paths set =
|
||||
|
@ -400,7 +400,7 @@ let set_rule_generators t generators =
|
|||
t.gen_rules <- generators
|
||||
|
||||
let get_dir_status t ~dir =
|
||||
Hashtbl.find_or_add t.dirs dir ~f:(fun _ ->
|
||||
Path.Table.find_or_add t.dirs dir ~f:(fun _ ->
|
||||
if Path.is_in_source_tree dir then
|
||||
Dir_status.Loaded (File_tree.files_of t.file_tree dir)
|
||||
else if dir = Path.build_dir then
|
||||
|
@ -441,7 +441,7 @@ module Target = Build_interpret.Target
|
|||
module Pre_rule = Build_interpret.Rule
|
||||
|
||||
let get_file : type a. t -> Path.t -> a File_kind.t -> a File_spec.t = fun t fn kind ->
|
||||
match Hashtbl.find t.files fn with
|
||||
match Path.Table.find t.files fn with
|
||||
| None -> die "no rule found for %s" (Path.to_string fn)
|
||||
| Some (File_spec.T file) ->
|
||||
let Eq = File_kind.eq_exn kind file.kind in
|
||||
|
@ -528,9 +528,9 @@ end
|
|||
|
||||
(* [copy_source] is [true] for rules copying files from the source directory *)
|
||||
let add_spec t fn spec ~copy_source =
|
||||
match Hashtbl.find t.files fn with
|
||||
match Path.Table.find t.files fn with
|
||||
| None ->
|
||||
Hashtbl.add t.files fn spec
|
||||
Path.Table.add t.files fn spec
|
||||
| Some (File_spec.T { rule; _ }) ->
|
||||
match copy_source, rule.mode with
|
||||
| true, (Standard | Not_a_rule_stanza) ->
|
||||
|
@ -551,7 +551,7 @@ let add_spec t fn spec ~copy_source =
|
|||
"To keep the current behavior and get rid of this warning, add a field \
|
||||
(fallback) to the rule."
|
||||
| _ -> assert false);
|
||||
Hashtbl.add t.files fn spec
|
||||
Path.Table.add t.files fn spec
|
||||
| _ ->
|
||||
let (File_spec.T { rule = rule2; _ }) = spec in
|
||||
let string_of_loc = function
|
||||
|
@ -630,7 +630,7 @@ let rec with_locks mutexes ~f =
|
|||
|
||||
let remove_old_artifacts t ~dir ~subdirs_to_keep =
|
||||
if not (Path.is_in_build_dir dir) ||
|
||||
Hashtbl.mem t.files (Path.relative dir Config.jbuilder_keep_fname) then
|
||||
Path.Table.mem t.files (Path.relative dir Config.jbuilder_keep_fname) then
|
||||
()
|
||||
else
|
||||
match Path.readdir_unsorted dir with
|
||||
|
@ -650,9 +650,9 @@ let remove_old_artifacts t ~dir ~subdirs_to_keep =
|
|||
Path.rm_rf path
|
||||
end
|
||||
| exception _ ->
|
||||
if not (Hashtbl.mem t.files path) then Path.unlink path
|
||||
if not (Path.Table.mem t.files path) then Path.unlink path
|
||||
| _ ->
|
||||
if not (Hashtbl.mem t.files path) then Path.unlink path)
|
||||
if not (Path.Table.mem t.files path) then Path.unlink path)
|
||||
|
||||
let no_rule_found =
|
||||
let fail fn =
|
||||
|
@ -730,12 +730,12 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
|
|||
in
|
||||
let deps_or_rule_changed =
|
||||
List.fold_left targets_as_list ~init:false ~f:(fun acc fn ->
|
||||
match Hashtbl.find t.trace fn with
|
||||
match Path.Table.find t.trace fn with
|
||||
| None ->
|
||||
Hashtbl.add t.trace fn hash;
|
||||
Path.Table.add t.trace fn hash;
|
||||
true
|
||||
| Some prev_hash ->
|
||||
Hashtbl.replace t.trace ~key:fn ~data:hash;
|
||||
Path.Table.replace t.trace ~key:fn ~data:hash;
|
||||
acc || prev_hash <> hash)
|
||||
in
|
||||
let targets_missing =
|
||||
|
@ -859,7 +859,7 @@ and load_dir_and_get_targets t ~dir =
|
|||
try
|
||||
load_dir_step2_exn t ~dir ~collector ~lazy_generators
|
||||
with exn ->
|
||||
(match Hashtbl.find t.dirs dir with
|
||||
(match Path.Table.find t.dirs dir with
|
||||
| Some (Loaded _) -> ()
|
||||
| _ ->
|
||||
(match t.load_dir_stack with
|
||||
|
@ -867,7 +867,7 @@ and load_dir_and_get_targets t ~dir =
|
|||
| x :: l ->
|
||||
t.load_dir_stack <- l;
|
||||
assert (x = dir)));
|
||||
Hashtbl.replace t.dirs ~key:dir ~data:Failed_to_load;
|
||||
Path.Table.replace t.dirs ~key:dir ~data:Failed_to_load;
|
||||
reraise exn
|
||||
|
||||
and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
|
||||
|
@ -921,7 +921,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
|
|||
:: rules,
|
||||
Path.Set.add alias_stamp_files path))
|
||||
in
|
||||
Hashtbl.replace t.dirs ~key:alias_dir ~data:(Loaded alias_stamp_files);
|
||||
Path.Table.replace t.dirs ~key:alias_dir ~data:(Loaded alias_stamp_files);
|
||||
|
||||
(* Compute the set of targets and the set of source files that must not be copied *)
|
||||
let user_rule_targets, source_files_to_ignore =
|
||||
|
@ -1035,7 +1035,7 @@ The following targets are not:
|
|||
in
|
||||
|
||||
(* Set the directory status to loaded *)
|
||||
Hashtbl.replace t.dirs ~key:dir ~data:(Loaded targets);
|
||||
Path.Table.replace t.dirs ~key:dir ~data:(Loaded targets);
|
||||
(match t.load_dir_stack with
|
||||
| [] -> assert false
|
||||
| x :: l ->
|
||||
|
@ -1054,13 +1054,13 @@ The following targets are not:
|
|||
targets
|
||||
|
||||
and wait_for_file t fn =
|
||||
match Hashtbl.find t.files fn with
|
||||
match Path.Table.find t.files fn with
|
||||
| Some file -> wait_for_file_found fn file
|
||||
| None ->
|
||||
let dir = Path.parent_exn fn in
|
||||
if Path.is_strict_descendant_of_build_dir dir then begin
|
||||
load_dir t ~dir;
|
||||
match Hashtbl.find t.files fn with
|
||||
match Path.Table.find t.files fn with
|
||||
| Some file -> wait_for_file_found fn file
|
||||
| None -> no_rule_found t fn
|
||||
end else if Path.exists fn then
|
||||
|
@ -1097,7 +1097,7 @@ and wait_for_deps t deps =
|
|||
|
||||
let stamp_file_for_files_of t ~dir ~ext =
|
||||
let files_of_dir =
|
||||
Hashtbl.find_or_add t.files_of dir ~f:(fun dir ->
|
||||
Path.Table.find_or_add t.files_of dir ~f:(fun dir ->
|
||||
let files_by_ext =
|
||||
targets_of t ~dir
|
||||
|> Path.Set.to_list
|
||||
|
@ -1130,7 +1130,7 @@ let stamp_file_for_files_of t ~dir ~ext =
|
|||
stamp_file
|
||||
|
||||
module Trace = struct
|
||||
type t = (Path.t, Digest.t) Hashtbl.t
|
||||
type t = Digest.t Path.Table.t
|
||||
|
||||
let file = Path.relative Path.build_dir ".db"
|
||||
|
||||
|
@ -1146,7 +1146,7 @@ module Trace = struct
|
|||
let load () =
|
||||
match P.load file with
|
||||
| Some t -> t
|
||||
| None -> Hashtbl.create 1024
|
||||
| None -> Path.Table.create 1024
|
||||
end
|
||||
|
||||
let all_targets t =
|
||||
|
@ -1155,7 +1155,7 @@ let all_targets t =
|
|||
~f:(fun dir () ->
|
||||
load_dir t
|
||||
~dir:(Path.append ctx.Context.build_dir (File_tree.Dir.path dir))));
|
||||
Hashtbl.foldi t.files ~init:[] ~f:(fun key _ acc -> key :: acc)
|
||||
Path.Table.foldi t.files ~init:[] ~f:(fun key _ acc -> key :: acc)
|
||||
|
||||
let finalize t =
|
||||
(* Promotion must be handled before dumping the digest cache, as it
|
||||
|
@ -1173,17 +1173,17 @@ let create ~contexts ~file_tree ~hook =
|
|||
in
|
||||
let t =
|
||||
{ contexts
|
||||
; files = Hashtbl.create 1024
|
||||
; packages = Hashtbl.create 1024
|
||||
; files = Path.Table.create 1024
|
||||
; packages = Path.Table.create 1024
|
||||
; trace = Trace.load ()
|
||||
; local_mkdirs = Path.Set.empty
|
||||
; dirs = Hashtbl.create 1024
|
||||
; dirs = Path.Table.create 1024
|
||||
; load_dir_stack = []
|
||||
; file_tree
|
||||
; gen_rules = String.Map.map contexts ~f:(fun _ ~dir:_ ->
|
||||
die "gen_rules called too early")
|
||||
; build_dirs_to_keep = Path.Set.empty
|
||||
; files_of = Hashtbl.create 1024
|
||||
; files_of = Path.Table.create 1024
|
||||
; prefix = None
|
||||
; hook
|
||||
}
|
||||
|
@ -1239,7 +1239,7 @@ let rules_for_files t paths =
|
|||
Path.Set.fold paths ~init:[] ~f:(fun path acc ->
|
||||
if Path.is_in_build_dir path then
|
||||
load_dir t ~dir:(Path.parent_exn path);
|
||||
match Hashtbl.find t.files path with
|
||||
match Path.Table.find t.files path with
|
||||
| None -> acc
|
||||
| Some (File_spec.T { rule; _ }) -> rule :: acc)
|
||||
|> Ir_set.of_list
|
||||
|
@ -1331,7 +1331,7 @@ let build_rules_internal ?(recursive=false) t ~request =
|
|||
let dir = Path.parent_exn fn in
|
||||
if Path.is_in_build_dir dir then
|
||||
load_dir t ~dir;
|
||||
match Hashtbl.find t.files fn with
|
||||
match Path.Table.find t.files fn with
|
||||
| Some file ->
|
||||
file_found fn file
|
||||
| None ->
|
||||
|
@ -1404,12 +1404,12 @@ let build_rules ?recursive t ~request =
|
|||
build_rules_internal ?recursive t ~request)
|
||||
|
||||
let set_package t file package =
|
||||
Hashtbl.add t.packages file package
|
||||
Path.Table.add t.packages file package
|
||||
|
||||
let package_deps t pkg files =
|
||||
let rules_seen = ref Rule.Id.Set.empty in
|
||||
let rec loop fn acc =
|
||||
match Hashtbl.find_all t.packages fn with
|
||||
match Path.Table.find_all t.packages fn with
|
||||
| [] -> loop_deps fn acc
|
||||
| pkgs ->
|
||||
if List.mem pkg ~set:pkgs then
|
||||
|
@ -1422,7 +1422,7 @@ let package_deps t pkg files =
|
|||
else
|
||||
Package.Name.Set.add acc p
|
||||
and loop_deps fn acc =
|
||||
match Hashtbl.find t.files fn with
|
||||
match Path.Table.find t.files fn with
|
||||
| None -> acc
|
||||
| Some (File_spec.T { rule = ir; _ }) ->
|
||||
if Rule.Id.Set.mem !rules_seen ir.id then
|
||||
|
|
|
@ -0,0 +1,5 @@
|
|||
module type S = sig
|
||||
type t
|
||||
val equal : t -> t -> bool
|
||||
val hash : t -> int
|
||||
end
|
|
@ -1,3 +1,5 @@
|
|||
module type S = Hashtbl_intf.S
|
||||
|
||||
include struct
|
||||
[@@@warning "-32"]
|
||||
|
||||
|
@ -7,19 +9,61 @@ include struct
|
|||
| exception Not_found -> None
|
||||
end
|
||||
|
||||
include MoreLabels.Hashtbl
|
||||
module Make(H : Hashable.S) = struct
|
||||
include MoreLabels.Hashtbl.Make(H)
|
||||
|
||||
include struct
|
||||
[@@@warning "-32"]
|
||||
|
||||
let find_opt t key =
|
||||
match find t key with
|
||||
| x -> Some x
|
||||
| exception Not_found -> None
|
||||
end
|
||||
|
||||
include struct
|
||||
let find = find_opt
|
||||
let add t key data = add t ~key ~data
|
||||
|
||||
let find_or_add t key ~f =
|
||||
match find t key with
|
||||
| Some x -> x
|
||||
| None ->
|
||||
let x = f key in
|
||||
add t key x;
|
||||
x
|
||||
|
||||
let foldi t ~init ~f =
|
||||
fold t ~init ~f:(fun ~key ~data acc -> f key data acc)
|
||||
let fold t ~init ~f = foldi t ~init ~f:(fun _ x -> f x)
|
||||
end
|
||||
end
|
||||
|
||||
open MoreLabels.Hashtbl
|
||||
|
||||
type nonrec ('a, 'b) t = ('a, 'b) t
|
||||
|
||||
let hash = hash
|
||||
let create = create
|
||||
let add = add
|
||||
let replace = replace
|
||||
let length = length
|
||||
let remove = remove
|
||||
let mem = mem
|
||||
|
||||
let find = find_opt
|
||||
|
||||
let add t key data = add t ~key ~data
|
||||
|
||||
let find_or_add t key ~f =
|
||||
match find t key with
|
||||
| Some x -> x
|
||||
| None ->
|
||||
let x = f key in
|
||||
add t ~key ~data:x;
|
||||
add t key x;
|
||||
x
|
||||
|
||||
let add t key data = add t ~key ~data
|
||||
|
||||
let foldi t ~init ~f = fold t ~init ~f:(fun ~key ~data acc -> f key data acc)
|
||||
let fold t ~init ~f = foldi t ~init ~f:(fun _ x -> f x)
|
||||
|
||||
let iter t ~f = iter ~f t
|
||||
|
|
|
@ -1,4 +1,20 @@
|
|||
include module type of struct include MoreLabels.Hashtbl end
|
||||
module type S = Hashtbl_intf.S
|
||||
|
||||
module Make(Key : Hashable.S) : S with type key = Key.t
|
||||
|
||||
type ('a, 'b) t = ('a, 'b) MoreLabels.Hashtbl.t
|
||||
|
||||
val hash : 'a -> int
|
||||
|
||||
val create : ?random:bool -> int -> ('a, 'b) t
|
||||
|
||||
val remove : ('a, _) t -> 'a -> unit
|
||||
|
||||
val length : (_, _) t -> int
|
||||
|
||||
val iter : ('a, 'b) t -> f:(key:'a -> data:'b -> unit) -> unit
|
||||
|
||||
val replace : ('a, 'b) t -> key:'a -> data:'b -> unit
|
||||
|
||||
val add : ('a, 'b) t -> 'a -> 'b -> unit
|
||||
|
||||
|
@ -7,3 +23,5 @@ val find_or_add : ('a, 'b) t -> 'a -> f:('a -> 'b) -> 'b
|
|||
|
||||
val fold : ('a, 'b) t -> init:'c -> f:( 'b -> 'c -> 'c) -> 'c
|
||||
val foldi : ('a, 'b) t -> init:'c -> f:('a -> 'b -> 'c -> 'c) -> 'c
|
||||
|
||||
val mem : ('a, _) t -> 'a -> bool
|
||||
|
|
|
@ -0,0 +1,11 @@
|
|||
module type S = sig
|
||||
include MoreLabels.Hashtbl.S
|
||||
|
||||
val add : 'a t -> key -> 'a -> unit
|
||||
|
||||
val find : 'a t -> key -> 'a option
|
||||
val find_or_add : 'a t -> key -> f:(key -> 'a) -> 'a
|
||||
|
||||
val fold : 'a t -> init:'b -> f:('a -> 'b -> 'b) -> 'b
|
||||
val foldi : 'a t -> init:'b -> f:(key -> 'a -> 'b -> 'b) -> 'b
|
||||
end
|
|
@ -489,6 +489,8 @@ module T : sig
|
|||
| In_build_dir of Local.t
|
||||
|
||||
val compare : t -> t -> Ordering.t
|
||||
val equal : t -> t -> bool
|
||||
val hash : t -> int
|
||||
|
||||
val in_build_dir : Local.t -> t
|
||||
val in_source_tree : Local.t -> t
|
||||
|
@ -509,6 +511,9 @@ end = struct
|
|||
| _ , In_source_tree _ -> Gt
|
||||
| In_build_dir x , In_build_dir y -> Local.compare x y
|
||||
|
||||
let equal (x : t) (y : t) = x = y
|
||||
let hash = Hashtbl.hash
|
||||
|
||||
let in_build_dir s = In_build_dir s
|
||||
let in_source_tree s = In_source_tree s
|
||||
let external_ e = External e
|
||||
|
@ -904,3 +909,5 @@ module Set = struct
|
|||
end
|
||||
|
||||
let in_source s = in_source_tree (Local.of_string s)
|
||||
|
||||
module Table = Hashtbl.Make(T)
|
||||
|
|
|
@ -37,6 +37,7 @@ module Set : sig
|
|||
end
|
||||
|
||||
module Map : Map.S with type key = t
|
||||
module Table : Hashtbl.S with type key = t
|
||||
|
||||
val of_string : ?error_loc:Usexp.Loc.t -> string -> t
|
||||
val to_string : t -> string
|
||||
|
|
Loading…
Reference in New Issue