diff --git a/ocaml/xenopsd/lib/topology.ml b/ocaml/xenopsd/lib/topology.ml index b0453f681d..13440be3e9 100644 --- a/ocaml/xenopsd/lib/topology.ml +++ b/ocaml/xenopsd/lib/topology.ml @@ -121,13 +121,6 @@ let seq_sort ~cmp s = let a = Array.of_seq s in Array.fast_sort cmp a ; Array.to_seq a -(** [seq_append a b] is the sequence [a] followed by [b] *) -let seq_append (a : 'a Seq.t) (b : 'a Seq.t) = - let rec next v () = - match v () with Seq.Nil -> b () | Seq.Cons (x, xs) -> Seq.Cons (x, next xs) - in - next a - module NUMA = struct type node = Node of int @@ -182,7 +175,6 @@ module NUMA = struct [n*multiply ... n*multiply + multiply-1], except we always the add the single NUMA node combinations. *) let distance_to_candidate d = (d, float_of_int d) in - (* make sure that single NUMA nodes are always present in the combinations *) let valid_nodes = seq_range 0 (Array.length d) |> Seq.filter_map (fun i -> @@ -193,25 +185,19 @@ module NUMA = struct None ) in - let single_nodes = - valid_nodes - |> Seq.map (fun i -> - let self_distance = d.(i).(i) in - (distance_to_candidate self_distance, Seq.return i) - ) - in let numa_nodes = Array.length d in let nodes = if numa_nodes > 16 then - (* try just the single nodes, and give up (use all nodes otherwise) to - avoid exponential running time. We could do better here, e.g. by + (* Avoid generating too many candidates because of the exponential + running time. We could do better here, e.g. by reducing the matrix *) - single_nodes - else valid_nodes - |> seq_all_subsets - |> Seq.filter_map (node_distances d) - |> seq_append single_nodes + |> Seq.map (fun i -> + let self_distance = d.(i).(i) in + (distance_to_candidate self_distance, Seq.return i) + ) + else + valid_nodes |> seq_all_subsets |> Seq.filter_map (node_distances d) in nodes |> seq_sort ~cmp:dist_cmp diff --git a/ocaml/xenopsd/test/test_topology.ml b/ocaml/xenopsd/test/test_topology.ml index d24d77d197..fbfb69dd07 100644 --- a/ocaml/xenopsd/test/test_topology.ml +++ b/ocaml/xenopsd/test/test_topology.ml @@ -281,17 +281,14 @@ let allocate_tests = let distances_tests = let specs = [ - ( "Last node is unreachable" - , Distances.unreachable_last - , Some [(10., [0]); (10., [0])] - ) + ("Last node is unreachable", Distances.unreachable_last, Some [(10., [0])]) ; ( "Node in the middle is unreachable" , Distances.unreachable_middle - , Some [(10., [0]); (10., [2]); (10., [0]); (10., [2]); (15., [0; 2])] + , Some [(10., [0]); (10., [2]); (15., [0; 2])] ) ; ( "The first two nodes are unreachable" , Distances.unreachable_two - , Some [(10., [2]); (10., [2])] + , Some [(10., [2])] ) ; ("All nodes are unreachable", Distances.none_reachable, None) ]