benchmark/benchmark.ml

   1 module Utils =
   2 struct
   3   type queryset = { documents : (string*int) array;
   4                     queries : string array;}
   5
   6   let make_queryset docs queries =
   7     { documents = Array.of_list (List.map (function f -> (f,(Unix.stat f).Unix.st_size)) docs);
   8       queries = Array.of_list queries
   9     }
  10
  11
  12   type stats = {
  13     mutable query : int; (* index in the query set *)
  14     mutable input_document : int; (* index in the query set *)
  15     mutable input_size : int;
  16     mutable print_output : bool;
  17
  18     mutable input_parsing_time : float;
  19     mutable query_compile_time : float;
  20     mutable query_execution_time : float;
  21     mutable serialization_time : float;
  22
  23     mutable memory_usage : int;
  24   }
  25
  26   type stats_token =
  27     |  Query of int
  28     |  Input_document of int
  29     |  Print_output of int
  30     |  Input_size of int
  31     |  Input_parsing_time of int
  32     |  Query_compile_time of int
  33     |  Query_execution_time of int
  34     |  Serialization_time of int
  35     |  Memory_usage of int
  36
  37
  38   let print_stats fmt s =
  39     Format.fprintf fmt "\
  40 Query number : %i
  41 Document number : %i
  42 Document size : %i bytes
  43 Output was serialized : %s
  44 Parsing time : %f ms
  45 Compile time : %f ms
  46 Execution time : %f ms
  47 Serialization time : %f ms
  48 Memory usage : %i kB\n" s.query
  49       s.input_document s.input_size (if s.print_output then "yes" else "no")
  50       s.input_parsing_time s.query_compile_time s.query_execution_time
  51       s.serialization_time (s.memory_usage/1024)
  52
  53   let empty_stats () = {
  54     query = -1;
  55     input_document = -1;
  56     input_size = -1;
  57     print_output = false;
  58     input_parsing_time = infinity;
  59     query_compile_time = infinity;
  60     query_execution_time = infinity;
  61     serialization_time = infinity;
  62     memory_usage = 0
  63   }
  64
  65   type result = (string*string)*(stats array list)
  66
  67
  68   let re_vmrss = Str.regexp ".*VmRSS:[^0-9]*\\([0-9]+\\) kB.*"
  69   let re_status  = Str.regexp ".*Status:[^A-Z]*\\([A-Z]\\).*"
  70
  71   let monitor_mem pid =
  72     let zombie = ref false in
  73     let rss = ref 0 in
  74     let in_c = open_in (Printf.sprintf "/proc/%i/status" pid) in
  75     let _ =  try
  76       while true do
  77         let s = input_line in_c in
  78           if Str.string_match re_vmrss s 0
  79           then rss:= int_of_string (Str.matched_group 1 s);
  80           if Str.string_match re_status s 0
  81           then zombie:= (Str.matched_group 1 s) = "Z"
  82       done;
  83
  84     with
  85         End_of_file -> close_in in_c
  86     in
  87       (!zombie,!rss*1024)
  88
  89
  90   let input_str = ref ""
  91
  92   let get_res i = Str.matched_group i !input_str
  93
  94   let rec match_out stats = function [] -> []
  95     | (s,l)::r ->
  96         if Str.string_match s !input_str 0
  97         then let () =
  98           List.iter
  99             (function  Query i -> stats.query <- int_of_string (get_res i)
 100                | Input_document i -> stats.input_document <- int_of_string (get_res i)
 101                | Input_size i -> stats.input_size <- int_of_string (get_res i)
 102                | Print_output _ -> stats.print_output <- false;
 103                | Input_parsing_time i -> stats.input_parsing_time <- float_of_string (get_res i)
 104                | Query_compile_time i -> stats.query_compile_time <- float_of_string (get_res i)
 105                | Query_execution_time i -> stats.query_execution_time <- float_of_string (get_res i)
 106                | Serialization_time i -> stats.serialization_time <- float_of_string (get_res i)
 107                | Memory_usage i -> stats.memory_usage <- int_of_string (get_res i)) l
 108         in r
 109         else (s,l)::(match_out stats r)
 110
 111   let parse_result pid in_c stats l =
 112     let descr = Unix.descr_of_in_channel in_c in
 113     let l = ref (List.map (fun (s,f) -> (Str.regexp s,f)) l) in
 114       try
 115         while !l <> [] && (0 == (fst (Unix.waitpid [ Unix.WNOHANG ] pid))) do
 116           let _ =
 117             match Unix.select [descr] [] [] 0.75 with
 118               | [d ],_,_ ->
 119                   input_str := input_line in_c;
 120                   l := match_out stats !l;
 121               | _ -> ()
 122           in
 123             if pid != 0 then
 124               let z,rss = monitor_mem pid in
 125                 if rss > stats.memory_usage
 126                 then stats.memory_usage <- rss;
 127                 if z then raise End_of_file
 128         done
 129       with
 130         | End_of_file | Unix.Unix_error(Unix.ECHILD,_,_) -> ()
 131         | e -> raise e
 132
 133   let build_xquery document query file print_output =
 134     let oc = open_out file in
 135     output_string oc "let $doc := doc(\"";
 136     output_string oc document;
 137     output_string oc "\") for $i in  $doc";
 138     output_string oc query;
 139     output_string oc "\n let $a := ";
 140     if print_output
 141     then output_string oc "$i"
 142     else output_string oc "()";
 143     output_string oc "\n let $b := 1+1";
 144     output_string oc "\n return $a\n";
 145     close_out oc
 146
 147       (* usually xslt processor take the filename
 148          as argument on the command line *)
 149   let build_xslt _ query file print_output =
 150     let oc = open_out file in
 151       output_string oc "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
 152 <xsl:stylesheet xmlns:xsl=\"http://www.w3.org/1999/XSL/Transform\"
 153                 xmlns=\"http://www.w3.org/1999/xhtml\" version=\"1.0\">
 154
 155 <xsl:template match=\"/\">
 156 <xsl:for-each select=\"";
 157       output_string oc query;
 158       output_string oc "\">
 159 <xsl:call-template name=\"out\"/>
 160   </xsl:for-each>
 161 </xsl:template>
 162
 163 <xsl:template name=\"out\">\n";
 164       if print_output
 165       then output_string oc "<xsl:copy-of select=\".\"/>\n";
 166       output_string oc "</xsl:template>
 167 </xsl:stylesheet>\n";
 168       close_out oc
 169 ;;
 170
 171
 172 end
 173
 174 (* Signatures to build the test suite *)
 175 module type CONFIGURATION = sig
 176   val path : string
 177   val result_basename : string
 178   val num_runs : int
 179   val run_without_output : bool
 180   val run_with_output : bool
 181 end
 182
 183
 184 module type ENGINE = sig
 185   val name : string
 186   val description : string
 187   val command : string
 188   val mk_queryfile : bool -> (string -> string -> string -> unit)
 189   val mk_cmdline : bool -> string -> string -> string -> string -> string list
 190   val time_factor : float
 191   val reference : bool
 192   val parse_rules : (string * Utils.stats_token list) list
 193 end
 194
 195 module type ENGINE_TESTER =
 196 sig
 197   module Conf : CONFIGURATION
 198   val test_engine : Utils.result list -> Utils.queryset -> Utils.result list
 199 end
 200 module INIT_TESTER (C : CONFIGURATION) : ENGINE_TESTER =
 201 struct
 202   module Conf = C
 203   let test_engine l _ = l
 204 end
 205
 206 module MK (E: ENGINE) (C : ENGINE_TESTER) : ENGINE_TESTER =
 207 struct
 208   module Conf = C.Conf
 209   open Utils
 210
 211   let run_query mem print_output qnum docnum qset =
 212     let docname = fst qset.documents.(docnum)
 213     in
 214     let query = qset.queries.(qnum) in
 215     let stats = empty_stats () in
 216     let qfile =
 217       Printf.sprintf "%s_%s_Q%.2d_D%.2d.query"
 218         Conf.result_basename E.name qnum docnum
 219     in
 220     let _ = (E.mk_queryfile print_output)
 221       docname  query qfile
 222     in
 223     let qoutput = Printf.sprintf "%s_%s_Q%.2d_D%.2d.output"
 224       Conf.result_basename E.name qnum docnum
 225     in
 226     let cmdline = Array.of_list
 227       (E.command :: (E.mk_cmdline print_output qoutput qfile docname query))
 228     in
 229     let in_fd,out_fd = Unix.pipe () in
 230     let in_c = Unix.in_channel_of_descr in_fd in
 231     let pid = Unix.create_process E.command cmdline
 232       Unix.stdin out_fd out_fd
 233     in
 234       parse_result (if mem then pid else 0) in_c stats E.parse_rules;
 235       (try
 236         ignore(Unix.waitpid [] pid)
 237       with
 238           _ -> ());
 239       Unix.close in_fd;
 240       Unix.close out_fd;
 241       Some stats
 242
 243   let extract = function Some a -> a | _ -> failwith "extract"
 244   let vb = function false -> 0 | _ -> 1
 245   let test_engine res qset =
 246     let header = (E.name, E.description) in
 247     let _ = Printf.printf "Testing engine %s\n%!" E.name in
 248     let lres = ref [] in
 249     let _ = Array.iteri
 250         (fun qnum _ ->
 251            Array.iteri ( fun docnum (_,docsize) ->
 252                            let sres = [| (empty_stats()); (empty_stats()) |] in
 253                              Printf.printf "Running query %.2d on document %.2d :\n%!" qnum docnum;
 254
 255                              for k = 0 to 1 do
 256                                for j = (vb (not Conf.run_without_output)) to (vb Conf.run_with_output) do
 257                                  if j = 0 then Printf.printf "No output : \t%!"
 258                                  else Printf.printf "With output : \t%!";
 259                                  for i = 1 to Conf.num_runs do
 260                                    let s = extract(run_query (k==1) (j==1) qnum docnum qset) in
 261                                      sres.(j).query_execution_time <- s.query_execution_time;
 262                                      sres.(j).query_compile_time <- s.query_compile_time;
 263                                      if j == 1 then sres.(j).serialization_time <- s.serialization_time;
 264                                      if k == 1 then sres.(j).memory_usage <- s.memory_usage;
 265                                      Printf.printf "pass %i ... %!" i;
 266                                  done;
 267                                  Printf.printf "Ok\n%!";
 268                                done;
 269                                if (k == 0)
 270                                then  Printf.printf "Monitoring memory use: ... \n%!";
 271                              done;
 272                              let _ = Array.iteri (fun i s -> s.print_output <- (i==1);
 273                                                     s.query <- qnum;
 274                                                     s.input_document <- docnum;
 275                                                     s.input_size <- docsize) sres
 276                              in lres := sres::!lres
 277                        ) qset.documents
 278         )qset.queries
 279     in
 280       C.test_engine ((header,!lres)::res) qset
 281
 282
 283
 284 end