My aggregated monorepo of OCaml code, automaintained
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

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
··· 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