X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=sxsi_test.ml;fp=sxsi_test.ml;h=6e852786b6f9b163aac3569e315c45cfe1f63ba6;hb=c02900bb9b9ecd87ab08465f7dad36dd7cd34d50;hp=0000000000000000000000000000000000000000;hpb=0c2338bfcdae0df1c68112a10247dc4e68a483ff;p=SXSI%2Fxpathcomp.git

diff --git a/sxsi_test.ml b/sxsi_test.ml
new file mode 100644
index 0000000..6e85278
--- /dev/null
+++ b/sxsi_test.ml
@@ -0,0 +1,134 @@
+let time f a msg =
+  let t0 = Unix.gettimeofday () in
+  let r = f a in
+  let t1 = Unix.gettimeofday () in
+    Printf.printf "Timing %s: %f ms\n" msg ((t1 -. t0) *. 1000.);
+    r
+
+
+
+type pointers
+type allocation_order = PREORDER | INORDER | POSTORDER
+external build_pointers : Tree.t -> allocation_order -> pointers = "caml_build_pointers"
+external iter_pointers : pointers -> int = "caml_iter_pointers"
+external free_pointers : pointers -> unit = "caml_free_pointers"
+
+let string_of_alloc =
+  function
+      PREORDER -> "preorder"
+    | INORDER -> "inorder"
+    | POSTORDER -> "postorder"
+
+
+let test_pointers alloc v =
+  let size = Tree.subtree_size v Tree.root in
+    if ((size * (Sys.word_size/8)*2) / (1024*1024)) >= 2800
+    then Printf.printf "Not enough memory to allocate pointer with %i nodes\n%!" size
+    else begin
+      let msg1 = Printf.sprintf "pointer structure %s allocation" (string_of_alloc alloc) in
+      let pointers = time (build_pointers v) alloc msg1 in
+      let i = time (iter_pointers) pointers "pointer structure full traversal" in
+	Printf.printf "Traversed %i nodes\n" i;
+	time (free_pointers) pointers "pointer structure deallocation"
+    end
+;;
+
+let test_iterative v =
+  let i = time (Tree.benchmark_iter) v "iterative traversal (on sxsi)" in
+    Printf.printf "Traversed %i nodes\n%!" i
+
+let test_full_traversal v =
+  let i = time (Tree.benchmark_fcns) v "recursive traversal (on sxsi)" in
+    Printf.printf "Traversed %i nodes\n%!" i
+
+let test_full_elements v =
+  let i = time (Tree.benchmark_fene) v "recursive traversal of element nodes (on sxsi)" in
+    Printf.printf "Traversed %i nodes\n%!" i
+
+let test_tag_jump v t =
+  let msg = Printf.sprintf "jumping to tag <%s> (on sxsi)" (Tag.to_string t) in
+  let i = time (Tree.benchmark_jump v) t msg in
+    Printf.printf "Traversed %i nodes\n%!" i
+
+
+module Options =
+  struct
+    open Arg
+    let input_file = ref ""
+    let save_file = ref ""
+    let run_iterative = ref false
+    let run_full_sxsi = ref false
+    let run_elements = ref false
+    let run_pointers = ref []
+    let run_jump_tag = ref ""
+
+    let add_pointer t =
+      let tag = match t with
+	| "preorder" -> PREORDER
+	| "inorder" -> INORDER
+	| "postorder" -> POSTORDER
+	| _ -> raise (Bad (t))
+      in
+	if not (List.mem tag !run_pointers) then run_pointers := tag :: !run_pointers
+
+
+    let spec = align
+      [ "-s", Set_string save_file, "<output.srx> saves the index in file output.srx";
+	"-i", Set run_iterative, " runs the iterative full traversal (on sxsi)";
+	"-f", Set run_full_sxsi, " runs the recursive full traversal (on sxsi)";
+	"-e", Set run_elements, " simulates //* on sxsi";
+	"-p", Symbol ([ "preorder"; "inorder"; "postorder" ],
+		      add_pointer), "runs a full traveral over pointers with given allocation scheme";
+	"-t", Set_string run_jump_tag, "<tag> simulates //tag on sxsi" ]
+
+    let usage_msg = Printf.sprintf "%s [options] <input.{xml|srx}>" Sys.argv.(0)
+    let parse () = parse spec (fun s -> input_file := s) usage_msg
+    let usage () = usage spec usage_msg
+  end
+
+let fail msg = Printf.eprintf "error: %s%!" msg; Options.usage (); exit 1
+
+let line () = Printf.printf "\n%!"
+
+let main () =
+  Options.parse ();
+  if !Options.input_file = "" then fail "missing input file";
+  let ifile = !Options.input_file in
+  let doc =
+    if Filename.check_suffix ifile ".srx" then
+      Tree.load ifile
+    else Tree.parse_xml_uri ifile in
+    if !Options.save_file <> "" then begin
+      Printf.printf "Saving index to %s ... %!" !Options.save_file;
+      Tree.save doc !Options.save_file;
+      Printf.printf "done\n%!"
+    end;
+    Tag.init (Tree.tag_pool doc);
+    line ();
+    if !Options.run_iterative then (test_iterative doc; line ());
+
+    if !Options.run_full_sxsi then (test_full_traversal doc; line ());
+
+    if !Options.run_elements then (test_full_elements doc; line ());
+
+    if !Options.run_jump_tag <> "" then (test_tag_jump doc (Tag.tag  !Options.run_jump_tag);
+					line ());
+
+    if !Options.run_pointers <> [] then
+      List.iter (fun s -> test_pointers s doc; line ())
+      !Options.run_pointers;
+
+    exit 0
+;;
+
+let _ =
+  let () = Printexc.record_backtrace true in
+    try
+      main ()
+    with
+	_ ->
+	  let msg = Printexc.get_backtrace () in
+	  Printf.eprintf "%s\n%!" msg;
+	  exit 3
+
+