(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-04-22 15:27:36 CEST by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-04-22 17:22:38 CEST by Kim Nguyen>
*)
INCLUDE "utils.ml"
let n2 = ref 0 in
Cache.N2.iteri (fun _ _ _ b -> if b then incr n2) auto.cache2;
Cache.N4.iteri (fun _ _ _ _ _ b -> if b then incr n4) auto.cache4;
- Format.eprintf "INFO: automaton %i, cache2: %i entries, cache6: %i entries\n%!"
+ Format.eprintf "STATS: automaton %i, cache2: %i entries, cache6: %i entries\n%!"
(auto.id :> int) !n2 !n4;
let c2l, c2u = Cache.N2.stats auto.cache2 in
let c4l, c4u = Cache.N4.stats auto.cache4 in
- Format.eprintf "INFO: cache2: length: %i, used: %i, occupation: %f\n%!" c2l c2u (float c2u /. float c2l);
- Format.eprintf "INFO: cache4: length: %i, used: %i, occupation: %f\n%!" c4l c4u (float c4u /. float c4l)
+ Format.eprintf "STATS: cache2: length: %i, used: %i, occupation: %f\n%!" c2l c2u (float c2u /. float c2l);
+ Format.eprintf "STATS: cache4: length: %i, used: %i, occupation: %f\n%!" c4l c4u (float c4u /. float c4l)
);
auto
let print fmt a =
fprintf fmt
- "\nInternal UID: %i@\n\
+ "Internal UID: %i@\n\
States: %a@\n\
Selection states: %a@\n\
Alternating transitions:@\n"
in
let line = Pretty.line (max_all + max_pre + 6) in
let prev_q = ref State.dummy in
+ fprintf fmt "%s@\n" line;
List.iter (fun (q, s1, s2, s3) ->
- if !prev_q != q && !prev_q != State.dummy then fprintf fmt " %s\n%!" line;
+ if !prev_q != q && !prev_q != State.dummy then fprintf fmt "%s@\n" line;
prev_q := q;
- fprintf fmt " %s, %s" s1 s2;
+ fprintf fmt "%s, %s" s1 s2;
fprintf fmt "%s" (Pretty.padding (max_pre - Pretty.length s1 - Pretty.length s2));
- fprintf fmt " %s %s@\n%!" Pretty.right_arrow s3;
+ fprintf fmt " %s %s@\n" Pretty.right_arrow s3;
) strs_strings;
- fprintf fmt " %s\n%!" line
+ fprintf fmt "%s@\n" line
(*
[complete transitions a] ensures that for each state q
in
StateSet.iter loop a.selection_states;
let unused = StateSet.diff a.states !memo in
- eprintf "Unused states %a\n%!" StateSet.print unused;
StateSet.iter (fun q -> Hashtbl.remove a.transitions q) unused;
a.states <- !memo
*)
let normalize_negations auto =
- eprintf "Automaton before normalize_trans:\n";
- print err_formatter auto;
- eprintf "--------------------\n%!";
-
let memo_state = Hashtbl.create 17 in
let todo = Queue.create () in
let rec flip b f =
(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-04-22 15:31:24 CEST by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-04-22 17:12:11 CEST by Kim Nguyen>
*)
INCLUDE "utils.ml"
redo := top_down_run auto tree node cache !iter;
incr iter;
done;
- at_exit (fun () -> eprintf "INFO: %i iterations\n" !iter);
+ at_exit (fun () -> eprintf "@[STATS: %i iterations@]@." !iter);
let r = get_results auto tree node cache in
TRACE(Html.gen_trace (module T : Tree.S with type t = T.t) (tree));
r
(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-04-04 18:47:30 CEST by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-04-22 16:42:50 CEST by Kim Nguyen>
*)
type node = {
let node = top ctx in
node.next_sibling <- nil;
consume_closing ctx node;
- match ctx.stack with
- [ root ] ->
- root.next_sibling <- nil;
- { root = root;
- size = ctx.current_preorder
- }
- | _ -> raise (Expat.Expat_error Expat.UNCLOSED_TOKEN)
+ Expat.final psr;
+ let root = List.hd ctx.stack in
+ root.next_sibling <- nil;
+ { root = root;
+ size = ctx.current_preorder
+ }
)
+ let error e parser_ =
+ let msg = Printf.sprintf "%i.%i %s"
+ (Expat.get_current_line_number parser_)
+ (Expat.get_current_column_number parser_)
+ (Expat.xml_error_to_string e)
+ in
+ raise (Tree.Parse_error msg)
let parse_string s =
let parser_, finalize = create_parser () in
- Expat.parse parser_ s;
- finalize ()
+ try
+ Expat.parse parser_ s;
+ finalize ()
+ with
+ Expat.Expat_error e -> error e parser_
let parse_file fd =
let buffer = String.create 4096 in
if read != 0 then
let () = Expat.parse_sub parser_ buffer 0 read in
loop ()
- in loop (); finalize ()
+ in try
+ loop (); finalize ()
+ with
+ Expat.Expat_error e -> error e parser_
end
--- /dev/null
+open Arg
+
+let count = ref false
+let input_file = ref ""
+let output_file : string option ref = ref None
+let query = ref ""
+let stats = ref false
+
+let specs = align [
+ "-c", Set count, "";
+ "--count", Set count, " write the number of results only";
+ "-s", Set stats, "";
+ "--stats", Set stats, " display timing and various statistics";
+]
+
+let usage_msg = Printf.sprintf "usage: %s [options] input.xml query [output.xml]" Sys.argv.(0)
+
+let get_anon, anon_arg =
+ let args = ref [] in
+ (fun () -> !args),
+ (fun s -> args := s::!args)
+
+let usage () = usage specs usage_msg
+
+let parse () =
+ parse specs anon_arg usage_msg;
+ match List.rev (get_anon ()) with
+ input :: q :: maybe_output ->
+ input_file := input;
+ query := q;
+ begin
+ match maybe_output with
+ [] -> ()
+ | [ output ] -> output_file := Some output
+ | _ -> raise (Arg.Bad "too many arguments")
+ end
+ | [] | [ _ ] -> raise (Arg.Bad "not enough arguments")
+
+
(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-04-04 18:45:43 CEST by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-04-22 17:26:34 CEST by Kim Nguyen>
*)
-let doc =
- let fd = open_in Sys.argv.(1) in
- let d = Naive_tree.load_xml_file fd in
- close_in fd; d
-
-
-let query =
- let arg2 = Sys.argv.(2) in
- Xpath.Parser.parse (Ulexing.from_latin1_string arg2)
-
-let auto =
- Xpath.Compile.path query
-
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 main () =
+ let () = Options.parse () in
+ let doc =
+ let fd = open_in !Options.input_file in
+ let d = Naive_tree.load_xml_file fd in
+ close_in fd; d
+ in
+ let query =
+ Xpath.Parser.parse (Ulexing.from_latin1_string !Options.query)
+ in
+ let auto =
+ Xpath.Compile.path query
+ 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
+ fprintf err_formatter "@[STATS: Query: %a @]@." Xpath.Ast.print_path query;
+ fprintf err_formatter "@[STATS: @[Automaton: @\n";
+ Ata.print err_formatter auto;
+ fprintf err_formatter "@]@]@.";
+ end;
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 "<xml_result>\n";
- List.iter (fun n ->
- Naive_tree.print_xml stdout doc n;
- output_char stdout '\n'
- ) results;
- output_string stdout "</xml_result>\n";
+ output_string output "<xml_result>\n";
+ if !Options.count then begin
+ output_string output (string_of_int (List.length results));
+ output_char output '\n';
+ end else
+ List.iter (fun n ->
+ Naive_tree.print_xml output doc n;
+ output_char output '\n'
+ ) results;
+ output_string output "</xml_result>\n";
let tprint = (Unix.gettimeofday () -. t1) *. 1000. in
- flush stdout;
- fprintf err_formatter "evaluation time: %fms\nserialization time: %fms\n%!" teval tprint
+ flush output;
+ if output != stdout then close_out output;
+ if !Options.stats then begin
+ fprintf err_formatter "@[STATS: evaluation time: %fms@]@." teval;
+ fprintf err_formatter "@[STATS: serialization time: %fms@]@." tprint
+ end
+
+
+let () =
+ 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: file %s, %s\n%!" !Options.input_file 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
(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-04-04 18:40:39 CEST by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-04-22 16:29:52 CEST by Kim Nguyen>
*)
(** The different kind of XML nodes and utility functions *)
k1 == Node || k2 == Node || k1 == k2
end
-
(** Signatures for trees *)
+exception Parse_error of string
+
module type S =
sig
type node
(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-02-07 10:31:20 CET by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-04-22 16:23:46 CEST by Kim Nguyen>
*)
include Xpath_internal_parser
let parse (l : Ulexing.lexbuf) =
- xpath_query (fun _ -> Ulexer.token l) (Lexing.from_string "!!dummy!!")
+ try
+ xpath_query (fun _ -> Ulexer.token l) (Lexing.from_string "!!dummy!!")
+ with
+ Parsing.Parse_error ->
+ Ulexer.error (Ulexing.lexeme_start l) (Ulexing.lexeme_end l) "syntax error"
projects / tatoo.git / commitdiff