sxsi_test.ml

   1 let time f a msg =
   2   let t0 = Unix.gettimeofday () in
   3   let r = f a in
   4   let t1 = Unix.gettimeofday () in
   5     Printf.printf "Timing %s: %f ms\n" msg ((t1 -. t0) *. 1000.);
   6     r
   7
   8
   9
  10 type pointers
  11 type allocation_order = PREORDER | INORDER | POSTORDER
  12 external build_pointers : Tree.t -> allocation_order -> pointers = "caml_build_pointers"
  13 external iter_pointers : pointers -> int = "caml_iter_pointers"
  14 external free_pointers : pointers -> unit = "caml_free_pointers"
  15
  16 let string_of_alloc =
  17   function
  18       PREORDER -> "preorder"
  19     | INORDER -> "inorder"
  20     | POSTORDER -> "postorder"
  21
  22
  23 let test_pointers alloc v =
  24   let size = Tree.subtree_size v Tree.root in
  25     if ((size * (Sys.word_size/8)*2) / (1024*1024)) >= 2800
  26     then Printf.printf "Not enough memory to allocate pointer with %i nodes\n%!" size
  27     else begin
  28       let msg1 = Printf.sprintf "pointer structure %s allocation" (string_of_alloc alloc) in
  29       let pointers = time (build_pointers v) alloc msg1 in
  30       let i = time (iter_pointers) pointers "pointer structure full traversal" in
  31         Printf.printf "Traversed %i nodes\n" i;
  32         time (free_pointers) pointers "pointer structure deallocation"
  33     end
  34 ;;
  35
  36 let test_iterative v =
  37   let i = time (Tree.benchmark_iter) v "iterative traversal (on sxsi)" in
  38     Printf.printf "Traversed %i nodes\n%!" i
  39
  40 let test_full_traversal v =
  41   let i = time (Tree.benchmark_fcns) v "recursive traversal (on sxsi)" in
  42     Printf.printf "Traversed %i nodes\n%!" i
  43
  44 let test_full_elements v =
  45   let i = time (Tree.benchmark_fene) v "recursive traversal of element nodes (on sxsi)" in
  46     Printf.printf "Traversed %i nodes\n%!" i
  47
  48 let test_tag_jump v t =
  49   let msg = Printf.sprintf "jumping to tag <%s> (on sxsi)" (Tag.to_string t) in
  50   let i = time (Tree.benchmark_jump v) t msg in
  51     Printf.printf "Traversed %i nodes\n%!" i
  52
  53
  54 module Options =
  55   struct
  56     open Arg
  57     let input_file = ref ""
  58     let save_file = ref ""
  59     let run_iterative = ref false
  60     let run_full_sxsi = ref false
  61     let run_elements = ref false
  62     let run_pointers = ref []
  63     let run_jump_tag = ref ""
  64
  65     let add_pointer t =
  66       let tag = match t with
  67         | "preorder" -> PREORDER
  68         | "inorder" -> INORDER
  69         | "postorder" -> POSTORDER
  70         | _ -> raise (Bad (t))
  71       in
  72         if not (List.mem tag !run_pointers) then run_pointers := tag :: !run_pointers
  73
  74
  75     let spec = align
  76       [ "-s", Set_string save_file, "<output.srx> saves the index in file output.srx";
  77         "-i", Set run_iterative, " runs the iterative full traversal (on sxsi)";
  78         "-f", Set run_full_sxsi, " runs the recursive full traversal (on sxsi)";
  79         "-e", Set run_elements, " simulates //* on sxsi";
  80         "-p", Symbol ([ "preorder"; "inorder"; "postorder" ],
  81                       add_pointer), "runs a full traveral over pointers with given allocation scheme";
  82         "-t", Set_string run_jump_tag, "<tag> simulates //tag on sxsi" ]
  83
  84     let usage_msg = Printf.sprintf "%s [options] <input.{xml|srx}>" Sys.argv.(0)
  85     let parse () = parse spec (fun s -> input_file := s) usage_msg
  86     let usage () = usage spec usage_msg
  87   end
  88
  89 let fail msg = Printf.eprintf "error: %s%!" msg; Options.usage (); exit 1
  90
  91 let line () = Printf.printf "\n%!"
  92
  93 let main () =
  94   Options.parse ();
  95   if !Options.input_file = "" then fail "missing input file";
  96   let ifile = !Options.input_file in
  97   let doc =
  98     if Filename.check_suffix ifile ".srx" then
  99       Tree.load ifile
 100     else Tree.parse_xml_uri ifile in
 101     if !Options.save_file <> "" then begin
 102       Printf.printf "Saving index to %s ... %!" !Options.save_file;
 103       Tree.save doc !Options.save_file;
 104       Printf.printf "done\n%!"
 105     end;
 106     Tag.init (Tree.tag_pool doc);
 107     line ();
 108     if !Options.run_iterative then (test_iterative doc; line ());
 109
 110     if !Options.run_full_sxsi then (test_full_traversal doc; line ());
 111
 112     if !Options.run_elements then (test_full_elements doc; line ());
 113
 114     if !Options.run_jump_tag <> "" then (test_tag_jump doc (Tag.tag  !Options.run_jump_tag);
 115                                         line ());
 116
 117     if !Options.run_pointers <> [] then
 118       List.iter (fun s -> test_pointers s doc; line ())
 119       !Options.run_pointers;
 120
 121     exit 0
 122 ;;
 123
 124 let _ =
 125   let () = Printexc.record_backtrace true in
 126     try
 127       main ()
 128     with
 129         _ ->
 130           let msg = Printexc.get_backtrace () in
 131           Printf.eprintf "%s\n%!" msg;
 132           exit 3
 133
 134