Merge branch 'lucca-tests-bench' into lucca-extentions

[tatoo.git] / src / solve.ml

diff --git a/src/solve.ml b/src/solve.ml
new file mode 100644 (file)
index 0000000..d898bab
--- /dev/null
+++ b/src/solve.ml
@@ -0,0 +1,77 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                               TAToo                                 *)
+(*                                                                     *)
+(*                     Kim Nguyen, LRI UMR8623                         *)
+(*                   Université Paris-Sud & CNRS                       *)
+(*                                                                     *)
+(*  Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
+(*  Recherche Scientifique. All rights reserved.  This file is         *)
+(*  distributed under the terms of the GNU Lesser General Public       *)
+(*  License, with the special exception on linking described in file   *)
+(*  ../LICENSE.                                                        *)
+(*                                                                     *)
+(***********************************************************************)
+
+
+(** use: [./test xml_file -f XPath_queries_file]
+    one query per line [XPath_querie_file]
+*)
+
+open Format
+
+let doc () =
+  let fd = open_in Sys.argv.(1) in
+  let d = Tree.load_xml_file fd in
+  close_in fd;
+  fprintf err_formatter "Parse Tree OK ! ";
+  d
+
+
+let query () = 
+  let arg2 = Sys.argv.(2) in
+  if arg2 = "-f"
+  then  let fq = open_in Sys.argv.(3) in
+        let rec list_qu fq list =
+          try
+            (match XPath.parse_file fq with
+              | q -> list_qu fq (q::list)
+              | _ -> list)
+          with _ -> list in
+        let list = list_qu fq [] in
+        close_in fq;
+        fprintf err_formatter "Parse query OK ! ";
+        list
+  else failwith "Use -f"
+
+let build_asta query =
+  let asta = Compil.trans query in
+  fprintf err_formatter "Compil OK ! ";
+  asta
+
+let compute_run doc query = 
+  let run = Run.compute doc query in
+  fprintf err_formatter "Run OK ! \n";
+  run
+
+let () =
+  Format.pp_set_margin err_formatter 80;
+  let doc = doc () in
+  output_string stderr "##### Doc with positions #####\n";
+  Tree.print_xml_preorder stderr doc (Tree.root doc);
+  let queries = query () in
+  let rec solve_queries = function
+    | [] -> ()
+    | query :: tl ->
+      let asta = build_asta query in
+      let selected_nodes = Run.selected_nodes doc asta in
+      fprintf err_formatter "Query: %a\n"
+        XPath.Ast.print query;
+      let rec print_selec fmt l = match l with
+        | [x] -> fprintf fmt "%s" (string_of_int x)
+        | x :: tl -> fprintf fmt "%s" ((string_of_int x)^"; ");print_selec fmt tl
+        | [] -> fprintf fmt "%s" "ø" in
+      fprintf err_formatter "@.@.  # Selected nodes: {%a}@."
+        print_selec selected_nodes in
+  solve_queries queries;
+  exit 0