X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Ftatoo.ml;h=e0f29ee8dff4b43df89e93eb4d5a095e59135523;hp=1b8c17d999f1ff09647ff257a0bce80206eb6169;hb=836d6ea0aebf1f947faa74db1d78168afb882930;hpb=974dacbf4f625bfd8ea83db69d6b346050141fea diff --git a/src/tatoo.ml b/src/tatoo.ml index 1b8c17d..e0f29ee 100644 --- a/src/tatoo.ml +++ b/src/tatoo.ml @@ -13,40 +13,157 @@ (* *) (***********************************************************************) -(* - Time-stamp: -*) +open Format -let doc = - let fd = open_in Sys.argv.(1) in - let d = Naive_tree.load_xml_file fd in - close_in fd; d +let time f arg msg = + let t1 = Unix.gettimeofday () in + let r = f arg in + let t2 = Unix.gettimeofday () in + let time = (t2 -. t1) *. 1000. in + Logger.msg `STATS "%s: %fms" msg time; + r -let query = - let arg2 = Sys.argv.(2) in - Xpath.Parser.parse (Ulexing.from_latin1_string arg2) +let compose_parallel run auto_list tree nodes () = + match auto_list with + [ auto ] -> [run auto tree nodes] + | _ -> assert false -let auto = - Xpath.Compile.path query +let compose_sequential run auto_list tree nodes () = + [ List.fold_left (fun acc auto -> + run auto tree acc) nodes auto_list ] + + +let restart_parallel run auto_list tree nodes () = + match auto_list with + [ auto ] -> List.map snd (run auto tree nodes) + | _ -> assert false + +let restart_sequential run auto_list tree nodes () = + List.map (fun auto -> run auto tree nodes) auto_list + +let main () = + let () = Options.parse () in + let doc = + let fd, close_fd = match !Options.input_file with + None | Some "-" | Some "/dev/stdin" -> stdin, ignore + | Some input -> + let fd = open_in input in fd, fun () -> close_in fd + in + let d = time Naive_tree.load_xml_file fd "parsing xml document" in + close_fd (); d + in + let queries = + time + (fun l -> + List.map (fun q -> + Xpath.Parser.parse + (Ulexing.from_utf8_string q)) l) + !Options.queries + "parsing XPath queries" + in + (* parallel, compose -> action + true, true -> Ata.concat of all automata and single run + true, false -> Ata.merge of all automata and single run + false, true -> Eval first, then run on results then ... + false, false -> Eval first on root, then second on root then ... + *) + let auto_list = + time + (fun l -> + List.map (fun query -> Xpath.Compile.path query) l) + queries + "compiling XPath queries" + in + let auto_list = + if !Options.parallel then + match auto_list with + fst :: rest -> + let f = + if !Options.compose then + Ata.concat + else + Ata.merge + in + let big_auto = List.fold_left f fst rest in + [big_auto] + | _ -> assert false + + else + auto_list + in + let output = + match !Options.output_file with + | None | Some "-" | Some "/dev/stdout" -> stdout + | Some f -> open_out f + in + if !Options.stats then begin + List.iter (fun query -> + Logger.msg `STATS "Query: %a " Xpath.Ast.print_path query) queries; + List.iter (fun auto -> + Logger.msg `STATS "@[Automaton: @\n%a@]" Ata.print auto) auto_list; + end; + + let module Naive = Run.Make(Naive_tree)(Naive_node_list) in + let result_list = + let root = Naive_node_list.create () in + let () = Naive_node_list.add (Naive_tree.root doc) root in + let f, msg = + match !Options.parallel, !Options.compose with + true, true -> + compose_parallel Naive.eval auto_list doc root, "parallel/compose" + | true, false -> + restart_parallel Naive.full_eval auto_list doc root, "parallel/restart" + | false, true -> + compose_sequential Naive.eval auto_list doc root , "sequential/compose" + | false, false -> + restart_sequential Naive.eval auto_list doc root, "sequential/restart" + in + time f () ("evaluating query in " ^ msg ^ " mode") + in + let s = Naive.stats () in + Run.( + Logger.msg `STATS + "@[tree size: %d@\ntraversals: %d@\ntransition fetch cache hit ratio: %f@\ntransition eval cache hit ratio: %f@\nNumber of visited nodes per pass: %a@]" + s.tree_size s.pass + (float s.fetch_trans_cache_hit /. float s.fetch_trans_cache_access) + (float s.eval_trans_cache_hit /. float s.eval_trans_cache_access) + (let i = ref 0 in + Pretty.print_list ~sep:"," (fun fmt n -> Format.fprintf fmt "%i: %i" !i n;incr i)) + s.nodes_per_run); + time (fun () -> + let count = ref 1 in + List.iter (fun results -> + output_string output "\n"; + if !Options.count then begin + output_string output (string_of_int (Naive_node_list.length results)); + output_char output '\n'; + end else + Naive_node_list.iter (fun n -> + Naive_tree.print_xml output doc n; + output_char output '\n' + ) results; + output_string output "\n"; + incr count + ) result_list; + flush output; + if output != stdout then close_out output + + ) () "serializing results" -open Format let () = - fprintf err_formatter "Query: %a\n%!" Xpath.Ast.print_path query; - fprintf err_formatter "Automata: %a\n%!" Ata.print auto; - fprintf err_formatter "Evaluating automaton:\n%!"; - let module Naive = Eval.Make(Naive_tree) in - let t1 = Unix.gettimeofday() in - let results = Naive.eval auto doc (Naive_tree.root doc) in - let teval = (Unix.gettimeofday () -. t1) *. 1000. in - let t1 = Unix.gettimeofday () in - output_string stdout "\n"; - List.iter (fun n -> - Naive_tree.print_xml stdout doc n; - output_char stdout '\n' - ) results; - output_string stdout "\n"; - let tprint = (Unix.gettimeofday () -. t1) *. 1000. in - flush stdout; - fprintf err_formatter "evaluation time: %fms\nserialization time: %fms\n%!" teval tprint + try + main () + with + Arg.Bad msg -> eprintf "Error: %s\n%!" msg; Options.usage (); exit 1 + | Sys_error msg -> eprintf "Error: %s\n%!" msg; exit 2 + | Tree.Parse_error msg -> + eprintf "Error: %s, %s\n%!" + (match !Options.input_file with + Some s -> ("file " ^ s) + | None -> "[stdin]") msg; exit 3 + | Xpath.Ulexer.Error (s, e, msg) -> eprintf "Error: character %i-%i: %s\n%!" s e msg; exit 4 + | e -> eprintf "FATAL ERROR: %s\n%!" (Printexc.to_string e); exit 128