X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=sxsi_test.ml;fp=sxsi_test.ml;h=0000000000000000000000000000000000000000;hb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;hp=6e852786b6f9b163aac3569e315c45cfe1f63ba6;hpb=a223af3254fb51c279cfbccdc18c59484fdca74e;p=SXSI%2Fxpathcomp.git diff --git a/sxsi_test.ml b/sxsi_test.ml deleted file mode 100644 index 6e85278..0000000 --- a/sxsi_test.ml +++ /dev/null @@ -1,134 +0,0 @@ -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, " 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, " simulates //tag on sxsi" ] - - let usage_msg = Printf.sprintf "%s [options] " 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 - -