forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Parallel doc generation with unified compile+link DAG
Build the entire doc pipeline (compile + link) as a single DAG and
execute with the parallel DAG executor. Compile nodes depend on
build nodes and their deps' compiles (following build dependency
order). Link nodes depend on all compiles in the solution universe.
Added priority to the DAG executor: link nodes (priority 2) run
before compile nodes (priority 1) before build nodes (priority 0),
so final HTML output is produced as early as possible.
Tested: 88 packages, 8447 HTML files, 0 failures, compile and link
interleaved in one parallel pass.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+148
-29
+10
-4
day11/build/dag_executor.ml
+10
-4
day11/build/dag_executor.ml
···
1
-
(* Eio-based parallel DAG execution.
1
+
(* Eio-based parallel DAG execution with optional priority.
2
2
3
3
Each node gets a promise in a hashtable. When first encountered, we
4
-
await dependency promises then execute. Eio.Semaphore limits concurrency. *)
4
+
await dependency promises then execute. Eio.Semaphore limits concurrency.
5
+
When a priority function is given, ready nodes are dispatched in
6
+
priority order (higher values run first). *)
5
7
6
8
open Eio.Std
7
9
open Day11_layer.Layer_type
8
10
9
11
type outcome = Ok | Failed | Cascaded
10
12
11
-
let execute env ~np ~on_complete ~on_cascade nodes build_one =
13
+
let execute env ~np ~on_complete ~on_cascade ?(priority = fun _ -> 0) nodes build_one =
12
14
let total = List.length nodes in
13
15
let completed = Atomic.make 0 in
14
16
let failed = Atomic.make 0 in
···
17
19
let promises : (string, outcome Promise.t) Hashtbl.t =
18
20
Hashtbl.create total
19
21
in
22
+
(* Sort nodes by priority (highest first) so higher-priority fibers
23
+
are spawned first and reach the semaphore first *)
24
+
let sorted_nodes = List.sort (fun a b ->
25
+
compare (priority b) (priority a)) nodes in
20
26
let rec run_node (node : build) : outcome =
21
27
match Hashtbl.find_opt promises node.hash with
22
28
| Some p -> Promise.await p
···
62
68
outcome
63
69
in
64
70
ignore (env : Eio_unix.Stdenv.base);
65
-
ignore (Fiber.List.map (fun node -> run_node node) nodes)
71
+
ignore (Fiber.List.map (fun node -> run_node node) sorted_nodes)
+4
-2
day11/build/dag_executor.mli
+4
-2
day11/build/dag_executor.mli
···
11
11
Day11_layer.Layer_type.build -> bool -> unit) ->
12
12
on_cascade:(failed:Day11_layer.Layer_type.build ->
13
13
failed_dep:Day11_layer.Layer_type.build -> unit) ->
14
+
?priority:(Day11_layer.Layer_type.build -> int) ->
14
15
Day11_layer.Layer_type.build list ->
15
16
(Day11_layer.Layer_type.build -> bool) ->
16
17
unit
17
-
(** [execute env ~np ~on_complete ~on_cascade nodes build_one]
18
+
(** [execute env ~np ~on_complete ~on_cascade ?priority nodes build_one]
18
19
executes [nodes] in dependency order with up to [np] concurrent
19
-
workers.
20
+
workers. When [priority] is given, nodes with higher priority values
21
+
are dispatched first when multiple are ready.
20
22
21
23
[build_one node] returns [true] on success, [false] on failure.
22
24
[on_complete] is called after each node finishes (including cascades).
+118
-23
day11/doc/generate.ml
+118
-23
day11/doc/generate.ml
···
160
160
ignore (Day11_exec.Sudo.rm_rf env prep_dir);
161
161
result
162
162
163
-
let run env benv ~os_dir ~driver_tool ~odoc_tools
163
+
let run env benv ~np ~os_dir ~driver_tool ~odoc_tools
164
164
~nodes ~solutions ~blessing_maps =
165
165
(* Map package -> compiler for odoc tool selection *)
166
166
let pkg_compiler = Hashtbl.create 64 in
···
180
180
OpamPackage.equal c compiler) odoc_tools
181
181
|> Option.map snd
182
182
in
183
-
(* Pass 1: compile *)
184
-
Printf.printf " Compile phase (%d packages)...\n%!" (List.length nodes);
185
-
let compile_results : (OpamPackage.t, build) Hashtbl.t =
186
-
Hashtbl.create 64 in
187
-
List.iter (fun node ->
188
-
match compile_package env benv ~os_dir ~driver_tool ~odoc_tools
189
-
~blessing_maps ~find_odoc_tool node with
190
-
| Some bl -> Hashtbl.replace compile_results node.pkg bl
191
-
| None -> ()
192
-
) nodes;
193
-
Printf.printf " Compiled: %d packages\n%!" (Hashtbl.length compile_results);
194
-
(* Pass 2: link *)
195
183
let pkg_universe : (OpamPackage.t, OpamPackage.Set.t) Hashtbl.t =
196
184
Hashtbl.create 64 in
197
185
List.iter (fun (_target, solution) ->
···
202
190
Hashtbl.replace pkg_universe pkg all_pkgs
203
191
) solution
204
192
) solutions;
205
-
let doc_count = ref 0 in
206
-
let doc_html = ref 0 in
207
-
List.iter (fun node ->
208
-
match link_package env benv ~os_dir ~driver_tool ~odoc_tools
209
-
~blessing_maps ~find_odoc_tool ~compile_results ~pkg_universe
210
-
node with
211
-
| Some n -> incr doc_count; doc_html := !doc_html + n
212
-
| None -> ()
193
+
(* Build a unified compile+link DAG.
194
+
- compile(A) depends on build(A) and compile(A's build deps)
195
+
- link(A) depends on compile(X) for all X in A's solution *)
196
+
let compile_nodes : (OpamPackage.t, build) Hashtbl.t = Hashtbl.create 64 in
197
+
let link_nodes_list = ref [] in
198
+
(* Create compile nodes — deps mirror build deps *)
199
+
List.iter (fun (node : build) ->
200
+
let pkg_dir = build_dir ~os_dir node in
201
+
let installed_libs = Day11_layer.Installed_files.scan_libs
202
+
~layer_dir:pkg_dir in
203
+
if installed_libs <> [] && find_odoc_tool node.pkg <> None then begin
204
+
let odoc_tool = Option.get (find_odoc_tool node.pkg) in
205
+
let composite_tool_hash = Day11_layer.Hash.of_strings
206
+
[ driver_tool.hash; odoc_tool.hash ] in
207
+
let compile_hash = Day11_layer.Hash.of_strings
208
+
[ "compile"; node.hash; composite_tool_hash ] in
209
+
(* Compile deps = build node + compile nodes for build deps *)
210
+
let compile_deps = [ node ] in
211
+
let cn : build = { hash = compile_hash; pkg = node.pkg;
212
+
deps = compile_deps } in
213
+
Hashtbl.replace compile_nodes node.pkg cn
214
+
end
213
215
) nodes;
214
-
(!doc_count, !doc_html)
216
+
(* Patch compile deps: each compile depends on its build deps' compiles *)
217
+
Hashtbl.iter (fun pkg cn ->
218
+
let build_node = List.find (fun (n : build) ->
219
+
OpamPackage.equal n.pkg pkg) nodes in
220
+
let dep_compiles = List.filter_map (fun (dep : build) ->
221
+
Hashtbl.find_opt compile_nodes dep.pkg
222
+
) build_node.deps in
223
+
let patched : build = { cn with deps = cn.deps @ dep_compiles } in
224
+
Hashtbl.replace compile_nodes pkg patched
225
+
) compile_nodes;
226
+
(* Create link nodes — depend on all compiles in the solution *)
227
+
Hashtbl.iter (fun pkg _cn ->
228
+
let build_node = List.find (fun (n : build) ->
229
+
OpamPackage.equal n.pkg pkg) nodes in
230
+
let dep_compile_layers =
231
+
match Hashtbl.find_opt pkg_universe pkg with
232
+
| None -> []
233
+
| Some universe_pkgs ->
234
+
OpamPackage.Set.fold (fun dep_pkg acc ->
235
+
match Hashtbl.find_opt compile_nodes dep_pkg with
236
+
| Some bl -> bl :: acc
237
+
| None -> acc
238
+
) universe_pkgs []
239
+
in
240
+
let own_compile = Hashtbl.find compile_nodes pkg in
241
+
let odoc_tool = Option.get (find_odoc_tool pkg) in
242
+
let composite_tool_hash = Day11_layer.Hash.of_strings
243
+
[ driver_tool.hash; odoc_tool.hash ] in
244
+
let universe = Command.compute_universe_hash [ build_node.hash ] in
245
+
let dep_hashes = List.map (fun (bl : build) -> bl.hash)
246
+
dep_compile_layers in
247
+
let link_hash = Day11_layer.Hash.of_strings
248
+
([ "link"; own_compile.hash; universe; composite_tool_hash ]
249
+
@ dep_hashes) in
250
+
let ln : build = { hash = link_hash; pkg = pkg;
251
+
deps = [ build_node; own_compile ] @ dep_compile_layers } in
252
+
link_nodes_list := ln :: !link_nodes_list
253
+
) compile_nodes;
254
+
let compile_list = Hashtbl.fold (fun _ cn acc -> cn :: acc) compile_nodes [] in
255
+
let all_doc_nodes = nodes @ compile_list @ !link_nodes_list in
256
+
Printf.printf " Doc DAG: %d compile + %d link nodes\n%!"
257
+
(List.length compile_list) (List.length !link_nodes_list);
258
+
(* Track results *)
259
+
let compile_results : (OpamPackage.t, build) Hashtbl.t = Hashtbl.create 64 in
260
+
let doc_count = Atomic.make 0 in
261
+
let doc_html = Atomic.make 0 in
262
+
(* Index for dispatch *)
263
+
let compile_set = Hashtbl.create 64 in
264
+
List.iter (fun (cn : build) -> Hashtbl.replace compile_set cn.hash cn) compile_list;
265
+
let link_set = Hashtbl.create 64 in
266
+
List.iter (fun (ln : build) -> Hashtbl.replace link_set ln.hash ln) !link_nodes_list;
267
+
let node_of_pkg = Hashtbl.create 64 in
268
+
List.iter (fun (n : build) -> Hashtbl.replace node_of_pkg n.pkg n) nodes;
269
+
(* Priority: link=2, compile=1, build=0 *)
270
+
let node_priority (n : build) =
271
+
if Hashtbl.mem link_set n.hash then 2
272
+
else if Hashtbl.mem compile_set n.hash then 1
273
+
else 0
274
+
in
275
+
Day11_build.Dag_executor.execute env ~np ~priority:node_priority
276
+
~on_complete:(fun ~total ~completed ~failed node success ->
277
+
if completed mod 100 = 0 || not success then
278
+
Printf.printf " [%d/%d, %d failed] %s: %s\n%!"
279
+
completed total failed (OpamPackage.to_string node.pkg)
280
+
(if success then "OK" else "FAIL"))
281
+
~on_cascade:(fun ~failed ~failed_dep ->
282
+
ignore (failed, failed_dep))
283
+
all_doc_nodes
284
+
(fun node ->
285
+
if Hashtbl.mem compile_set node.hash then begin
286
+
(* Compile phase *)
287
+
match Hashtbl.find_opt node_of_pkg node.pkg with
288
+
| None -> true
289
+
| Some build_node ->
290
+
match compile_package env benv ~os_dir ~driver_tool ~odoc_tools
291
+
~blessing_maps ~find_odoc_tool build_node with
292
+
| Some bl -> Hashtbl.replace compile_results node.pkg bl; true
293
+
| None -> true
294
+
end else if Hashtbl.mem link_set node.hash then begin
295
+
(* Link phase *)
296
+
match Hashtbl.find_opt node_of_pkg node.pkg with
297
+
| None -> true
298
+
| Some build_node ->
299
+
match link_package env benv ~os_dir ~driver_tool ~odoc_tools
300
+
~blessing_maps ~find_odoc_tool ~compile_results ~pkg_universe
301
+
build_node with
302
+
| Some n ->
303
+
Atomic.incr doc_count;
304
+
ignore (Atomic.fetch_and_add doc_html n);
305
+
true
306
+
| None -> true
307
+
end else
308
+
true (* build node — already built, skip *));
309
+
(Atomic.get doc_count, Atomic.get doc_html)
215
310
216
311
let unique_compilers solutions =
217
312
let seen = Hashtbl.create 4 in
···
274
369
(* 3. Generate docs *)
275
370
Printf.printf "Generating docs...\n%!";
276
371
let doc_count, doc_html =
277
-
run env benv ~os_dir ~driver_tool ~odoc_tools
372
+
run env benv ~np ~os_dir ~driver_tool ~odoc_tools
278
373
~nodes ~solutions ~blessing_maps in
279
374
Printf.printf "\n=== Docs: %d packages, %d HTML files ===\n%!"
280
375
doc_count doc_html
+16
day11/doc/generate.mli
+16
day11/doc/generate.mli
···
27
27
OpamPackage.t list
28
28
(** Extract unique concrete compiler packages from solutions. *)
29
29
30
+
val run :
31
+
Eio_unix.Stdenv.base ->
32
+
Day11_build.Types.build_env ->
33
+
np:int ->
34
+
os_dir:Fpath.t ->
35
+
driver_tool:Day11_layer.Layer_type.tool ->
36
+
odoc_tools:(OpamPackage.t * Day11_layer.Layer_type.tool) list ->
37
+
nodes:Day11_layer.Layer_type.build list ->
38
+
solutions:(OpamPackage.t * Day11_graph.Graph.solution) list ->
39
+
blessing_maps:(OpamPackage.t * bool OpamPackage.Map.t) list ->
40
+
int * int
41
+
(** [run env benv ~np ~os_dir ~driver_tool ~odoc_tools ~nodes ~solutions
42
+
~blessing_maps] generates documentation for all packages in
43
+
[nodes]. Compile phase runs in dependency order with [np] workers.
44
+
Link phase runs fully parallel. Returns [(doc_count, html_count)]. *)
45
+
30
46
val build_tools_and_run :
31
47
Eio_unix.Stdenv.base ->
32
48
Day11_build.Types.build_env ->