forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Simplify DAG construction: recursive memoized get_node
Replace topological sort + linear scan with a recursive function
that builds nodes on demand and memoizes by (pkg, universe).
Deps are resolved by recursion — no sorting needed.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+45
-38
+45
-38
day11/build/dag.ml
+45
-38
day11/build/dag.ml
···
1
1
open Day11_layer.Layer_type
2
2
3
3
let build_dag cache ~base_hash solutions =
4
-
let seen : (string * string, build) Hashtbl.t = Hashtbl.create 256 in
5
-
List.iter (fun (_target, solution) ->
6
-
let trans = Day11_graph.Graph.transitive_deps solution in
7
-
let topo = Day11_graph.Graph.topological_sort solution in
8
-
List.iter (fun pkg ->
9
-
let pkg_deps =
10
-
match OpamPackage.Map.find_opt pkg trans with
4
+
let memo : (string * string, build) Hashtbl.t = Hashtbl.create 256 in
5
+
let trans_cache : (OpamPackage.t, Day11_graph.Graph.solution) Hashtbl.t =
6
+
Hashtbl.create 16 in
7
+
let get_trans solution =
8
+
let target = OpamPackage.Map.min_binding solution |> fst in
9
+
match Hashtbl.find_opt trans_cache target with
10
+
| Some t -> t
11
+
| None ->
12
+
let t = Day11_graph.Graph.transitive_deps solution in
13
+
Hashtbl.replace trans_cache target t;
14
+
t
15
+
in
16
+
let rec get_node solution trans pkg =
17
+
let pkg_deps =
18
+
match OpamPackage.Map.find_opt pkg trans with
19
+
| Some s -> OpamPackage.Set.elements s
20
+
| None -> []
21
+
in
22
+
let universe =
23
+
Day11_graph.Universe.of_deps (OpamPackage.Set.of_list pkg_deps) in
24
+
let key = (OpamPackage.to_string pkg,
25
+
Day11_graph.Universe.to_string universe) in
26
+
match Hashtbl.find_opt memo key with
27
+
| Some node -> node
28
+
| None ->
29
+
let direct_deps =
30
+
match OpamPackage.Map.find_opt pkg solution with
11
31
| Some s -> OpamPackage.Set.elements s
12
32
| None -> []
13
33
in
14
-
let universe =
15
-
Day11_graph.Universe.of_deps
16
-
(OpamPackage.Set.of_list pkg_deps) in
17
-
let key = (OpamPackage.to_string pkg,
18
-
Day11_graph.Universe.to_string universe) in
19
-
if not (Hashtbl.mem seen key) then begin
20
-
let all_pkgs = pkg :: pkg_deps in
21
-
let hash = Hash_cache.layer_hash cache ~base_hash all_pkgs in
22
-
let direct_deps =
23
-
match OpamPackage.Map.find_opt pkg solution with
24
-
| Some s -> OpamPackage.Set.elements s
25
-
| None -> []
26
-
in
27
-
let deps = List.filter_map (fun dep ->
28
-
let dep_deps =
29
-
match OpamPackage.Map.find_opt dep trans with
30
-
| Some s -> OpamPackage.Set.elements s
31
-
| None -> []
32
-
in
33
-
let dep_universe =
34
-
Day11_graph.Universe.of_deps
35
-
(OpamPackage.Set.of_list dep_deps) in
36
-
let dep_key = (OpamPackage.to_string dep,
37
-
Day11_graph.Universe.to_string dep_universe) in
38
-
Hashtbl.find_opt seen dep_key
39
-
) direct_deps in
40
-
let node : build = { hash; pkg; deps; universe } in
41
-
Hashtbl.replace seen key node
42
-
end
43
-
) topo
34
+
let deps = List.filter_map (fun dep ->
35
+
if OpamPackage.Map.mem dep solution then
36
+
Some (get_node solution trans dep)
37
+
else
38
+
None
39
+
) direct_deps in
40
+
let all_pkgs = pkg :: pkg_deps in
41
+
let hash = Hash_cache.layer_hash cache ~base_hash all_pkgs in
42
+
let node : build = { hash; pkg; deps; universe } in
43
+
Hashtbl.replace memo key node;
44
+
node
45
+
in
46
+
List.iter (fun (_target, solution) ->
47
+
let trans = get_trans solution in
48
+
OpamPackage.Map.iter (fun pkg _deps ->
49
+
ignore (get_node solution trans pkg)
50
+
) solution
44
51
) solutions;
45
-
let all_nodes = Hashtbl.fold (fun _ node acc -> node :: acc) seen [] in
52
+
let all_nodes = Hashtbl.fold (fun _ node acc -> node :: acc) memo [] in
46
53
List.sort (fun (a : build) (b : build) ->
47
54
compare (List.length a.deps) (List.length b.deps)) all_nodes