Skip to content

Commit 14b6286

Browse files
committed
Factor out targets into a separate module
Signed-off-by: Andrey Mokhov <[email protected]>
1 parent a0e9a3a commit 14b6286

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

43 files changed

+281
-156
lines changed

bin/import.ml

+1
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ module Colors = Dune_rules.Colors
2525
module Dune_project = Dune_engine.Dune_project
2626
module Workspace = Dune_rules.Workspace
2727
module Cached_digest = Dune_engine.Cached_digest
28+
module Targets = Dune_engine.Targets
2829
module Profile = Dune_rules.Profile
2930
module Log = Dune_util.Log
3031
module Dune_rpc = Dune_rpc_private

bin/print_rules.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ let print_rule_makefile ppf (rule : Dune_engine.Reflection.Rule.t) =
3838
"@[<hov 2>@{<makefile-stuff>%a:%t@}@]@,@<0>\t@{<makefile-action>%a@}@,@,"
3939
(Format.pp_print_list ~pp_sep:Format.pp_print_space (fun ppf p ->
4040
Format.pp_print_string ppf (Path.to_string p)))
41-
(List.map ~f:Path.build (Path.Build.Set.to_list rule.targets))
41+
(Targets.to_list_map rule.targets ~file:Path.build)
4242
(fun ppf ->
4343
Path.Set.iter rule.expanded_deps ~f:(fun dep ->
4444
Format.fprintf ppf "@ %s" (Path.to_string dep)))
@@ -55,7 +55,7 @@ let print_rule_sexp ppf (rule : Dune_engine.Reflection.Rule.t) =
5555
[ [ ("deps", Dep.Set.encode rule.deps)
5656
; ( "targets"
5757
, paths
58-
(Path.Build.Set.to_list rule.targets
58+
(Targets.to_list_map rule.targets ~file:Fun.id
5959
|> Path.set_of_build_paths_list) )
6060
]
6161
; (match rule.context with

src/dune_engine/action_builder.ml

+32-29
Original file line numberDiff line numberDiff line change
@@ -131,44 +131,42 @@ let source_tree ~dir =
131131
}
132132

133133
(* CR-someday amokhov: The set of targets is accumulated using information from
134-
multiple sources by calling [Path.Build.Set.union] and hence occasionally
135-
duplicate declarations of the very same target go unnoticed. I think such
136-
redeclarations are not erroneous but are merely redundant; it seems that it
137-
would be better to rule them out completely.
138-
139-
Another improvement is to cache [Path.Build.Set.to_list targets] which is
140-
currently performed multiple times on the very same
141-
[Action_builder.With_targets.t]. *)
134+
multiple sources by calling [Targets.combine], which performs set union and
135+
hence duplicate declarations of the very same target can go unnoticed. I
136+
think such redeclarations are not erroneous but are merely redundant; perhaps
137+
we should detect and disallow them. *)
142138
module With_targets = struct
143139
type nonrec 'a t =
144140
{ build : 'a t
145-
; targets : Path.Build.Set.t
141+
; targets : Targets.t
146142
}
147143

148144
let map_build t ~f = { t with build = f t.build }
149145

150-
let return x = { build = return x; targets = Path.Build.Set.empty }
146+
let return x = { build = return x; targets = Targets.empty }
151147

152-
let add t ~targets =
148+
let add t ~file_targets =
153149
{ build = t.build
154-
; targets = Path.Build.Set.union t.targets (Path.Build.Set.of_list targets)
150+
; targets =
151+
Targets.combine t.targets
152+
(Targets.Files.create (Path.Build.Set.of_list file_targets))
155153
}
156154

157155
let map { build; targets } ~f = { build = map build ~f; targets }
158156

159157
let map2 x y ~f =
160158
{ build = map2 x.build y.build ~f
161-
; targets = Path.Build.Set.union x.targets y.targets
159+
; targets = Targets.combine x.targets y.targets
162160
}
163161

164162
let both x y =
165163
{ build = both x.build y.build
166-
; targets = Path.Build.Set.union x.targets y.targets
164+
; targets = Targets.combine x.targets y.targets
167165
}
168166

169167
let seq x y =
170168
{ build = x.build >>> y.build
171-
; targets = Path.Build.Set.union x.targets y.targets
169+
; targets = Targets.combine x.targets y.targets
172170
}
173171

174172
module O = struct
@@ -186,48 +184,53 @@ module With_targets = struct
186184
| [] -> return []
187185
| xs ->
188186
let build, targets =
189-
List.fold_left xs ~init:([], Path.Build.Set.empty)
190-
~f:(fun (xs, set) x ->
191-
(x.build :: xs, Path.Build.Set.union set x.targets))
187+
List.fold_left xs ~init:([], Targets.empty)
188+
~f:(fun (builds, targets) x ->
189+
(x.build :: builds, Targets.combine x.targets targets))
192190
in
193191
{ build = all (List.rev build); targets }
194192

195193
let write_file_dyn ?(perm = Action.File_perm.Normal) fn s =
196-
add ~targets:[ fn ]
194+
add ~file_targets:[ fn ]
197195
(let+ s = s in
198196
Action.Write_file (fn, perm, s))
199197

200198
let memoize name t = { build = memoize name t.build; targets = t.targets }
201199
end
202200

203-
let with_targets build ~targets : _ With_targets.t =
204-
{ build; targets = Path.Build.Set.of_list targets }
201+
let with_targets build ~targets : _ With_targets.t = { build; targets }
205202

206-
let with_targets_set build ~targets : _ With_targets.t = { build; targets }
203+
let with_file_targets build ~file_targets : _ With_targets.t =
204+
{ build
205+
; targets = Targets.Files.create (Path.Build.Set.of_list file_targets)
206+
}
207207

208208
let with_no_targets build : _ With_targets.t =
209-
{ build; targets = Path.Build.Set.empty }
209+
{ build; targets = Targets.empty }
210210

211211
let write_file ?(perm = Action.File_perm.Normal) fn s =
212-
with_targets ~targets:[ fn ] (return (Action.Write_file (fn, perm, s)))
212+
with_file_targets ~file_targets:[ fn ]
213+
(return (Action.Write_file (fn, perm, s)))
213214

214215
let write_file_dyn ?(perm = Action.File_perm.Normal) fn s =
215-
with_targets ~targets:[ fn ]
216+
with_file_targets ~file_targets:[ fn ]
216217
(let+ s = s in
217218
Action.Write_file (fn, perm, s))
218219

219220
let copy ~src ~dst =
220-
with_targets ~targets:[ dst ] (path src >>> return (Action.Copy (src, dst)))
221+
with_file_targets ~file_targets:[ dst ]
222+
(path src >>> return (Action.Copy (src, dst)))
221223

222224
let copy_and_add_line_directive ~src ~dst =
223-
with_targets ~targets:[ dst ]
225+
with_file_targets ~file_targets:[ dst ]
224226
(path src >>> return (Action.Copy_and_add_line_directive (src, dst)))
225227

226228
let symlink ~src ~dst =
227-
with_targets ~targets:[ dst ] (path src >>> return (Action.Symlink (src, dst)))
229+
with_file_targets ~file_targets:[ dst ]
230+
(path src >>> return (Action.Symlink (src, dst)))
228231

229232
let create_file ?(perm = Action.File_perm.Normal) fn =
230-
with_targets ~targets:[ fn ]
233+
with_file_targets ~file_targets:[ fn ]
231234
(return (Action.Redirect_out (Stdout, fn, perm, Action.empty)))
232235

233236
let progn ts =

src/dune_engine/action_builder.mli

+8-7
Original file line numberDiff line numberDiff line change
@@ -10,14 +10,14 @@ module With_targets : sig
1010

1111
type nonrec 'a t =
1212
{ build : 'a t
13-
; targets : Path.Build.Set.t
13+
; targets : Targets.t
1414
}
1515

1616
val map_build : 'a t -> f:('a build -> 'b build) -> 'b t
1717

1818
val return : 'a -> 'a t
1919

20-
val add : 'a t -> targets:Path.Build.t list -> 'a t
20+
val add : 'a t -> file_targets:Path.Build.t list -> 'a t
2121

2222
val map : 'a t -> f:('a -> 'b) -> 'b t
2323

@@ -42,12 +42,13 @@ module With_targets : sig
4242
end
4343
with type 'a build := 'a t
4444

45-
(** Add a set of targets to an action builder, turning a target-less
46-
[Action_builder.t] into [Action_builder.With_targets.t]. *)
47-
val with_targets : 'a t -> targets:Path.Build.t list -> 'a With_targets.t
45+
(** Add targets to an action builder, turning a target-less [Action_builder.t]
46+
into [Action_builder.With_targets.t]. *)
47+
val with_targets : 'a t -> targets:Targets.t -> 'a With_targets.t
4848

49-
(** [with_targets_set] is like [with_targets] but [targets] is a set *)
50-
val with_targets_set : 'a t -> targets:Path.Build.Set.t -> 'a With_targets.t
49+
(** Like [with_targets] but specifies a list of file targets. *)
50+
val with_file_targets :
51+
'a t -> file_targets:Path.Build.t list -> 'a With_targets.t
5152

5253
(** Create a value of [With_targets.t] with the empty set of targets. *)
5354
val with_no_targets : 'a t -> 'a With_targets.t

src/dune_engine/action_exec.ml

+2-3
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,7 @@ type done_or_more_deps =
7171
| Need_more_deps of (DAP.Dependency.Set.t * Dynamic_dep.Set.t)
7272

7373
type exec_context =
74-
{ targets : Path.Build.Set.t
74+
{ targets : Targets.t
7575
; context : Build_context.t option
7676
; purpose : Process.purpose
7777
; rule_loc : Loc.t
@@ -127,8 +127,7 @@ let exec_run_dynamic_client ~ectx ~eenv prog args =
127127
let to_relative path =
128128
path |> Stdune.Path.build |> Stdune.Path.reach ~from:eenv.working_dir
129129
in
130-
Stdune.Path.Build.Set.to_list ectx.targets
131-
|> String.Set.of_list_map ~f:to_relative
130+
Targets.to_list_map ectx.targets ~file:to_relative |> String.Set.of_list
132131
in
133132
DAP.Run_arguments.
134133
{ prepared_dependencies = eenv.prepared_dependencies; targets }

src/dune_engine/action_exec.mli

+1-1
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ end
3030
(** [root] should be the root of the current build context, or the root of the
3131
sandbox if the action is sandboxed. *)
3232
val exec :
33-
targets:Path.Build.Set.t
33+
targets:Targets.t
3434
-> root:Path.t
3535
-> context:Build_context.t option
3636
-> env:Env.t

src/dune_engine/build_system.ml

+28-23
Original file line numberDiff line numberDiff line change
@@ -520,7 +520,8 @@ let () =
520520
Path.Build.Set.iter fns ~f:(fun p -> Path.unlink_no_err (Path.build p)))
521521

522522
let compute_target_digests targets =
523-
Option.List.traverse (Path.Build.Set.to_list targets) ~f:(fun target ->
523+
Option.List.traverse (Targets.to_list_map targets ~file:Fun.id)
524+
~f:(fun target ->
524525
Cached_digest.build_file target
525526
|> Cached_digest.Digest_result.to_option
526527
|> Option.map ~f:(fun digest -> (target, digest)))
@@ -535,15 +536,15 @@ let compute_target_digests_or_raise_error exec_params ~loc targets =
535536
(* FIXME: searching the dune version for each single target seems way
536537
suboptimal. This information could probably be stored in rules
537538
directly. *)
538-
if Path.Build.Set.is_empty targets then
539+
if Targets.is_empty targets then
539540
false
540541
else
541542
Execution_parameters.should_remove_write_permissions_on_generated_files
542543
exec_params
543544
in
544545
let good, missing, errors =
545-
Path.Build.Set.fold targets ~init:([], [], [])
546-
~f:(fun target (good, missing, errors) ->
546+
Targets.fold targets ~init:([], [], [])
547+
~file:(fun target (good, missing, errors) ->
547548
let expected_syscall_path = Path.to_string (Path.build target) in
548549
match Cached_digest.refresh ~remove_write_permissions target with
549550
| Ok digest -> ((target, digest) :: good, missing, errors)
@@ -773,13 +774,13 @@ end = struct
773774
we try to sandbox this. *)
774775
~sandbox:Sandbox_config.no_sandboxing ~context:None
775776
~info:(Source_file_copy path)
776-
~targets:(Path.Build.Set.singleton ctx_path)
777+
~targets:(Targets.File.create ctx_path)
777778
build)
778779

779780
let compile_rules ~dir ~source_dirs rules =
780781
List.concat_map rules ~f:(fun rule ->
781782
assert (Path.Build.( = ) dir rule.Rule.dir);
782-
Path.Build.Set.to_list_map rule.targets ~f:(fun target ->
783+
Targets.to_list_map rule.targets ~file:(fun target ->
783784
if String.Set.mem source_dirs (Path.Build.basename target) then
784785
report_rule_src_dir_conflict dir target rule
785786
else
@@ -851,8 +852,9 @@ end = struct
851852
(* All targets are in [dir] and we know it correspond to a directory
852853
of a build context since there are source files to copy, so this
853854
call can't fail. *)
854-
Path.Build.Set.to_list rule.targets
855-
|> Path.Source.Set.of_list_map ~f:Path.Build.drop_build_context_exn
855+
Targets.to_list_map rule.targets
856+
~file:Path.Build.drop_build_context_exn
857+
|> Path.Source.Set.of_list
856858
in
857859
if Path.Source.Set.is_subset source_files_for_targets ~of_:to_copy
858860
then
@@ -1020,10 +1022,10 @@ end = struct
10201022
match mode with
10211023
| Promote { only = None; _ }
10221024
| Ignore_source_files ->
1023-
Path.Build.Set.union targets acc_ignored
1025+
Path.Build.Set.union (Targets.files targets) acc_ignored
10241026
| Promote { only = Some pred; _ } ->
10251027
let to_ignore =
1026-
Path.Build.Set.filter targets ~f:(fun target ->
1028+
Path.Build.Set.filter (Targets.files targets) ~f:(fun target ->
10271029
Predicate_lang.Glob.exec pred
10281030
(Path.reach (Path.build target) ~from:(Path.build dir))
10291031
~standard:Predicate_lang.any)
@@ -1361,7 +1363,7 @@ end = struct
13611363
let trace =
13621364
( rule_digest_version (* Update when changing the rule digest scheme. *)
13631365
, Dep.Facts.digest deps ~sandbox_mode ~env
1364-
, Path.Build.Set.to_list_map rule.targets ~f:Path.Build.to_string
1366+
, Targets.to_list_map rule.targets ~file:Path.Build.to_string
13651367
, Option.map rule.context ~f:(fun c -> Context_name.to_string c.name)
13661368
, Action.for_shell action
13671369
, can_go_in_shared_cache
@@ -1430,7 +1432,8 @@ end = struct
14301432
let { Action.Full.action; env; locks; can_go_in_shared_cache = _ } =
14311433
action
14321434
in
1433-
pending_targets := Path.Build.Set.union targets !pending_targets;
1435+
let file_targets = Targets.files targets in
1436+
pending_targets := Path.Build.Set.union file_targets !pending_targets;
14341437
let chdirs = Action.chdirs action in
14351438
let sandbox =
14361439
Option.map sandbox_mode ~f:(fun mode ->
@@ -1473,7 +1476,7 @@ end = struct
14731476
in
14741477
Option.iter sandbox ~f:Sandbox.destroy;
14751478
(* All went well, these targets are no longer pending *)
1476-
pending_targets := Path.Build.Set.diff !pending_targets targets;
1479+
pending_targets := Path.Build.Set.diff !pending_targets file_targets;
14771480
exec_result
14781481

14791482
let try_to_store_to_shared_cache ~mode ~rule_digest ~action ~targets =
@@ -1494,7 +1497,7 @@ end = struct
14941497
Cached_digest.set target digest)
14951498
in
14961499
match
1497-
Path.Build.Set.to_list_map targets ~f:Dune_cache.Local.Target.create
1500+
Targets.to_list_map targets ~file:Dune_cache.Local.Target.create
14981501
|> Option.List.all
14991502
with
15001503
| None -> Fiber.return None
@@ -1590,7 +1593,7 @@ end = struct
15901593
rule
15911594
in
15921595
start_rule t rule;
1593-
let head_target = Path.Build.Set.choose_exn targets in
1596+
let head_target = Targets.head_exn targets in
15941597
let* execution_parameters =
15951598
match Dpath.Target_dir.of_target dir with
15961599
| Regular (With_context (_, dir))
@@ -1745,7 +1748,7 @@ end = struct
17451748
~cache_debug_flags:t.cache_debug_flags ~head_target miss_reason;
17461749
(* Step I. Remove stale targets both from the digest table and from
17471750
the build directory. *)
1748-
Path.Build.Set.iter targets ~f:(fun target ->
1751+
Targets.iter targets ~file:(fun target ->
17491752
Cached_digest.remove target;
17501753
Path.Build.unlink_no_err target);
17511754
(* Step II. Try to restore artifacts from the shared cache if the
@@ -1855,20 +1858,22 @@ end = struct
18551858
| Promote { lifetime; into; only }, (Some Automatically | None) ->
18561859
Fiber.parallel_iter_set
18571860
(module Path.Build.Set)
1858-
targets
1859-
~f:(fun path ->
1861+
(Targets.files targets)
1862+
~f:(fun target ->
18601863
let consider_for_promotion =
18611864
match only with
18621865
| None -> true
18631866
| Some pred ->
18641867
Predicate_lang.Glob.exec pred
1865-
(Path.reach (Path.build path) ~from:(Path.build dir))
1868+
(Path.reach (Path.build target) ~from:(Path.build dir))
18661869
~standard:Predicate_lang.any
18671870
in
18681871
match consider_for_promotion with
18691872
| false -> Fiber.return ()
18701873
| true ->
1871-
let in_source_tree = Path.Build.drop_build_context_exn path in
1874+
let in_source_tree =
1875+
Path.Build.drop_build_context_exn target
1876+
in
18721877
let in_source_tree =
18731878
match into with
18741879
| None -> in_source_tree
@@ -1910,7 +1915,7 @@ end = struct
19101915
| None -> false
19111916
| Some in_source_tree_digest -> (
19121917
match
1913-
Cached_digest.build_file path
1918+
Cached_digest.build_file target
19141919
|> Cached_digest.Digest_result.to_option
19151920
with
19161921
| None ->
@@ -1935,7 +1940,7 @@ end = struct
19351940
explicitly set the user writable bit. *)
19361941
let chmod n = n lor 0o200 in
19371942
Path.unlink_no_err (Path.source dst);
1938-
t.promote_source ~src:path ~dst ~chmod context
1943+
t.promote_source ~src:target ~dst ~chmod context
19391944
))
19401945
in
19411946
t.rule_done <- t.rule_done + 1;
@@ -2005,7 +2010,7 @@ end = struct
20052010
(match loc with
20062011
| Some loc -> From_dune_file loc
20072012
| None -> Internal)
2008-
~targets:(Path.Build.Set.singleton target)
2013+
~targets:(Targets.File.create target)
20092014
(Action_builder.of_thunk
20102015
{ f =
20112016
(fun mode ->

0 commit comments

Comments
 (0)