1 (***********************************************************************)
5 (* Kim Nguyen, LRI UMR8623 *)
6 (* Université Paris-Sud & CNRS *)
8 (* Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
9 (* Recherche Scientifique. All rights reserved. This file is *)
10 (* distributed under the terms of the GNU Lesser General Public *)
11 (* License, with the special exception on linking described in file *)
14 (***********************************************************************)
17 let default_gc = Gc.get()
18 let tuned_gc = { default_gc with
19 Gc.minor_heap_size = 32*1024*1024;
20 Gc.major_heap_increment = 8*1024*1024;
21 Gc.max_overhead = 1000000;
22 Gc.space_overhead = 100;
26 let t1 = Unix.gettimeofday () in
28 let t2 = Unix.gettimeofday () in
29 let time = (t2 -. t1) *. 1000. in
30 Logger.msg `STATS "%s: %fms" msg time;
34 let compose_parallel run auto_list tree nodes () =
36 [ auto ] -> [run auto tree nodes]
39 let compose_sequential run auto_list tree nodes () =
40 [ List.fold_left (fun acc auto ->
41 run auto tree acc) nodes auto_list ]
44 let restart_parallel run auto_list tree nodes () =
46 [ auto ] -> List.map snd (run auto tree nodes)
49 let restart_sequential run auto_list tree nodes () =
50 List.map (fun auto -> run auto tree nodes) auto_list
53 let () = Options.parse () in
54 let tree_model = List.assoc !Options.tree_model
55 Options.supported_models
57 let module T = (val tree_model) in
58 let module Runtime = Run.Make(T)
62 let fd, close_fd = match !Options.input_file with
63 None | Some "-" | Some "/dev/stdin" -> stdin, ignore
65 let fd = open_in input in fd, fun () -> close_in fd
67 let d = time Runtime.Tree.load_xml_file fd "parsing xml document" in
80 (Ulexing.from_utf8_string q)) l)
82 "parsing XPath queries"
84 (* parallel, compose -> action
85 true, true -> Ata.concat of all automata and single run
86 true, false -> Ata.merge of all automata and single run
87 false, true -> Eval first, then run on results then ...
88 false, false -> Eval first on root, then second on root then ...
93 List.map (fun query -> Xpath.Compile.path query) l)
95 "compiling XPath queries"
98 if !Options.parallel then
102 if !Options.compose then
107 let big_auto = List.fold_left f fst rest in
115 match !Options.output_file with
116 | None | Some "-" | Some "/dev/stdout" -> stdout
117 | Some f -> open_out f
119 if !Options.stats then begin
120 List.iter (fun query ->
121 Logger.msg `STATS "Query: %a " Xpath.Ast.print_path query) queries;
122 List.iter (fun auto ->
123 Logger.msg `STATS "@[Automaton: @\n%a@]" Ata.print auto) auto_list;
127 let root = Runtime.ResultSet.create () in
128 let () = Runtime.ResultSet.add (Runtime.Tree.root doc) root in
130 match !Options.parallel, !Options.compose with
132 compose_parallel Runtime.eval auto_list doc root, "parallel/compose"
134 restart_parallel Runtime.full_eval auto_list doc root, "parallel/restart"
136 compose_sequential Runtime.eval auto_list doc root , "sequential/compose"
138 restart_sequential Runtime.eval auto_list doc root, "sequential/restart"
140 time f () ("evaluating query in " ^ msg ^ " mode")
142 let s = Runtime.stats () in
145 "@[tree size: %d@\ntraversals: %d@\ntransition fetch cache miss ratio: %f@\ntransition eval cache miss ratio: %f@\nNumber of visited nodes per pass: %a@]"
147 (float s.fetch_trans_cache_miss /. float s.fetch_trans_cache_access)
148 (float s.eval_trans_cache_miss /. float s.eval_trans_cache_access)
150 Pretty.print_list ~sep:"," (fun fmt n -> Format.fprintf fmt "%i: %i" !i n;incr i))
154 List.iter (fun results ->
155 output_string output "<xml_result num=\"";
156 output_string output (string_of_int !count);
157 output_string output "\" >\n";
158 if !Options.count then begin
159 output_string output (string_of_int (Runtime.ResultSet.length results));
160 output_char output '\n';
162 Runtime.ResultSet.iter (fun n ->
163 Runtime.Tree.print_xml output doc n;
164 output_char output '\n'
166 output_string output "</xml_result>\n";
170 if output != stdout then close_out output
172 ) () "serializing results"
179 Arg.Bad msg -> eprintf "Error: %s\n%!" msg; Options.usage (); exit 1
180 | Sys_error msg -> eprintf "Error: %s\n%!" msg; exit 2
181 | Tree.Parse_error msg ->
182 eprintf "Error: %s, %s\n%!"
183 (match !Options.input_file with
184 Some s -> ("file " ^ s)
185 | None -> "[stdin]") msg; exit 3
186 | Xpath.Ulexer.Error (s, e, msg) -> eprintf "Error: character %i-%i: %s\n%!" s e msg; exit 4
187 (* | e -> Printexc.print_backtrace stderr;
189 eprintf "FATAL ERROR: %s\n%!" (Printexc.to_string e); exit 128 *)