+(** Common and utility functions. *)
(* Memory info command for virtual domains.
(C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
http://libvirt.org/
let bytes_of_wordsize = function
| W32 -> 4 | W64 -> 8
-(* Returns (count, value) in order of highest frequency occurring in the
- * list.
- *)
+(** Returns (count, value) in order of highest frequency occurring in the
+ list. *)
let frequency xs =
let xs = List.sort compare xs in
let rec loop = function
let xs = loop xs in
List.rev (List.sort compare xs)
-(* Pad a string to a fixed width (from virt-top, but don't truncate). *)
+(** Like the Unix uniq(1) command. *)
+let rec uniq ?(cmp = Pervasives.compare) = function
+ | [] -> []
+ | [x] -> [x]
+ | x :: y :: xs when cmp x y = 0 ->
+ uniq (x :: xs)
+ | x :: y :: xs ->
+ x :: uniq (y :: xs)
+
+(** Like the Unix pipeline 'sort|uniq'. *)
+let sort_uniq ?cmp xs =
+ let xs = ExtList.List.sort ?cmp xs in
+ let xs = uniq ?cmp xs in
+ xs
+
+(** Pad a string to a fixed width (from virt-top, but don't truncate). *)
let pad width str =
let n = String.length str in
if n >= width then str
else (* if n < width then *) str ^ String.make (width-n) ' '
+
+(** General binary tree type. Data 'a is stored in the leaves and 'b
+ is stored in the nodes. *)
+type ('a,'b) binary_tree =
+ | Leaf of 'a
+ | Node of ('a,'b) binary_tree * 'b * ('a,'b) binary_tree
+
+(** Print out the binary tree in graphviz dot format. *)
+let print_binary_tree leaf_printer node_printer tree =
+ (* Assign a unique, fixed label to each node. *)
+ let label =
+ let i = ref 0 in
+ let hash = Hashtbl.create 13 in
+ fun node ->
+ try Hashtbl.find hash node
+ with Not_found ->
+ let i = incr i; !i in
+ let label = "n" ^ string_of_int i in
+ Hashtbl.add hash node label;
+ label
+ in
+ (* Recursively generate the graphviz file. *)
+ let rec print = function
+ | (Leaf a as leaf) ->
+ eprintf " %s [shape=box, label=\"%s\"];\n"
+ (label leaf) (leaf_printer a)
+ | (Node (left,b,right) as node) ->
+ eprintf " %s [label=\"%s\"];\n"
+ (label node) (node_printer b);
+ eprintf " %s -> %s [tailport=sw];\n" (label node) (label left);
+ eprintf " %s -> %s [tailport=se];\n" (label node) (label right);
+ print left;
+ print right;
+ in
+ eprintf "/* Use 'dot -Tpng foo.dot > foo.png' to convert to a png file. */\n";
+ eprintf "digraph G {\n";
+ print tree;
+ eprintf "}\n%!"