src/utils.ml

   1 (* virt-dmesg
   2  * (C) Copyright 2008-2011 Red Hat Inc.
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17  *)
  18
  19 open Printf
  20
  21 module StringMap = Map.Make (String)
  22
  23 type symbol_table = int64 StringMap.t
  24
  25 let ( +^ ) = Int64.add
  26 let ( -^ ) = Int64.sub
  27 let ( *^ ) = Int64.mul
  28 let ( /^ ) = Int64.div
  29 let ( &^ ) = Int64.logand
  30
  31 let frequency xs =
  32   let xs = List.sort compare xs in
  33   let rec loop = function
  34     | [] -> []
  35     | [x] -> [1, x]
  36     | x :: y :: xs when x = y ->
  37         let rest = loop (y :: xs) in
  38         let (count, _), rest = List.hd rest, List.tl rest in
  39         (count+1, y) :: rest
  40     | x :: xs ->
  41         (1, x) :: loop xs
  42   in
  43   let xs = loop xs in
  44   List.rev (List.sort compare xs)
  45
  46 let rec filter_map f = function
  47   | [] -> []
  48   | x :: xs ->
  49       match f x with
  50       | None -> filter_map f xs
  51       | Some y -> y :: filter_map f xs
  52
  53 let replace_chars f s =
  54   let len = String.length s in
  55   let rec loop i acc =
  56     if i < len then (
  57       let c = String.unsafe_get s i in
  58       let acc = f c :: acc in
  59       loop (i+1) acc
  60     ) else
  61       String.concat "" (List.rev acc)
  62   in
  63   loop 0 []
  64
  65 let program_name = ref "virt-dmesg"
  66 let set_program_name str = program_name := str
  67 let get_program_name () = !program_name
  68
  69 let debug_mode = ref false
  70 let set_debug () = debug_mode := true
  71 let debug fs = ksprintf (fun str -> if !debug_mode then print_endline str) fs
  72
  73 let error fs =
  74   ksprintf (
  75     fun str ->
  76       prerr_string !program_name;
  77       prerr_string ": ";
  78       prerr_endline str
  79   ) fs