From: Lucca Hirschi <lucca.hirschi@gmail.com>
Date: Mon, 2 Jul 2012 15:35:40 +0000 (+0200)
Subject:   Add queries states
X-Git-Tag: Core~18
X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=commitdiff_plain;h=91c3b3585a018dd5f98949e4838ef3d6c5c120fc

  Add queries states
+ last_step from compilation works (one step paths)
+ print QNameSet works
+ try boxes from Format
---

diff --git a/src/asta.ml b/src/asta.ml
index 8b9682c..9682bd1 100644
--- a/src/asta.ml
+++ b/src/asta.ml
@@ -33,7 +33,7 @@ struct
   let la (st,la,f) = la
   let fo (st,la,f) = f
   let print fmt (st,la,f) =
-    Format.fprintf fmt "(%a,%s,%a)"
+    Format.fprintf fmt "%a ----%s---> %a"
       State.print st
       (QNameSet.to_string la)
       Formula.print f
@@ -47,6 +47,7 @@ end
 type transition = Transition.t
 
 type t = {
+  mutable quer : StateSet.t;
   mutable reco : StateSet.t;
   mutable selec : StateSet.t;
   mutable bottom : StateSet.t;
@@ -74,6 +75,7 @@ let transitions asta st =
   remove_states (SetT.elements (SetT.filter filter asta.trans))
 
 let empty = {
+  quer = StateSet.empty;
   reco = StateSet.empty;
   selec = StateSet.empty;
   bottom = StateSet.empty;
@@ -87,6 +89,8 @@ let new_state () = State.make()
 
 let add_tr ast tr = ast.trans <- (SetT.add tr (ast.trans))
 
+let add_quer ast st = ast.quer <- (StateSet.add st (ast.quer))
+
 let add_reco ast st = ast.reco <- (StateSet.add st (ast.reco))
 
 let add_selec ast st = ast.selec <- (StateSet.add st (ast.selec))
@@ -95,11 +99,15 @@ let add_bot ast st = ast.bottom <- (StateSet.add st (ast.bottom))
 
 let add_top ast st = ast.top <- (StateSet.add st (ast.top))
 
+let init_top ast  = ast.top <- (StateSet.empty)
+
 let top_states ast = StateSet.elements ast.top
 
 let print fmt asta =
   let pp = Format.fprintf fmt in
-  pp "Recognizing states: ";
+  pp "Query states: ";
+  StateSet.print fmt asta.quer;
+  pp "\nRecognizing states: ";
   StateSet.print fmt asta.reco;
   pp "\nSelecting states: ";
   StateSet.print fmt asta.selec;
@@ -108,9 +116,12 @@ let print fmt asta =
   pp "\nTop states: ";
   StateSet.print fmt asta.top;
   pp "\nTransitions: \n";
-  Format.fprintf fmt "{@[<hov 2> %a @]}" (* todo: check boxes *)
-    (Pretty.print_list ~sep:"@, " (Transition.print))
-    (SetT.elements (asta.trans))
-
+  Format.fprintf fmt "{";
+  Format.open_vbox 20;
+  SetT.iter (fun x -> Format.fprintf fmt "%a @." Transition.print x)
+    (asta.trans);
+  Format.print_flush ();
+  Format.fprintf fmt "}"
+    
 
 let to_file out asta = ()
diff --git a/src/asta.mli b/src/asta.mli
index a0d589f..6f592fb 100644
--- a/src/asta.mli
+++ b/src/asta.mli
@@ -52,8 +52,11 @@ val add_tr : t -> transition -> unit
 val add_reco : t -> state -> unit
 (** Add a state to the recognizing states of an asta *)
 
+val add_quer : t -> state -> unit
+(** Add a state to the query states of an asta *)
+
 val add_selec : t -> state -> unit
-(** Add a state to the recognizing states of an asta *)
+(** Add a state to the selecting states of an asta *)
 
 val add_bot : t -> state -> unit
 (** Add a state to the bottom states of an asta *)
@@ -61,6 +64,9 @@ val add_bot : t -> state -> unit
 val add_top : t -> state -> unit
 (** Add a state to the top states of an asta *)
 
+val init_top : t -> unit
+(** Remove all top states *)
+
 val top_states : t -> state list
 (** Give the list of top states of an ASTA *)
 
diff --git a/src/compil.ml b/src/compil.ml
index 610360b..8044968 100644
--- a/src/compil.ml
+++ b/src/compil.ml
@@ -16,34 +16,72 @@
 open XPath.Ast
 open Formula.Infix
 
-exception Not_core_XPath of path
+exception Not_core_XPath
 (** Raised whenever the XPath query contains not implemented structures *)
 
+let pr_er = Format.err_formatter
+
 let trans query =
   let asta = Asta.empty in
+  (* Buidling of the ASTA step by step with a special case for the last
+     step. Then add a top most state. Each function modifies asta. *)
   let rec trans = function
     | [s] -> trans_last s
     | s :: tl -> trans_step s; trans tl
     | [] -> ()
       
-  and trans_init () = 			(* add THE top state  *)
+  and trans_init () = 			(* add THE top most state  *)
     let top_st = Asta.new_state () in
     let or_top = 
-      List.fold_left (fun acc x -> (`Left *+ x +| acc))
-	Formula.true_ (Asta.top_states asta)
+      List.fold_left (fun acc x -> ((`Left *+ x) +| acc))
+	(Formula.false_) (Asta.top_states asta)
     in
+    Asta.add_quer asta top_st;
+    Asta.init_top asta;
+    Asta.add_top asta top_st;
     Asta.add_tr asta (top_st, Asta.any_label, or_top)
       
   and trans_last (ax,test,pred) =	(* a selecting state is needed *)
-    ()
-      
+    let fo_p = trans_pr pred in
+    let q,q' = Asta.new_state(), Asta.new_state() in
+    Asta.add_selec asta q';
+    Asta.add_quer asta q;
+    Asta.add_quer asta q';
+    Asta.add_top asta q;
+    Asta.add_top asta q';
+    Asta.add_bot asta q;
+    Asta.add_bot asta q';
+    let Simple lab = test in
+    let tr_selec = (q', lab, fo_p)
+    and tr_q = (q, Asta.any_label, form_propa_selec q q' ax) in
+    Asta.add_tr asta tr_selec;
+    Asta.add_tr asta tr_q
+    
   and trans_step (ax,test,pred) =
     ()
       
-  and trans_pr p = ()
+  and trans_pr  = function		(* either we apply De Morgan rules
+					   in xPath:parse or here *)
+    | Expr True -> Formula.true_
+    | Expr False -> Formula.false_
+    | Or (p_1,p_2) -> trans_pr(p_1) +| trans_pr(p_2)
+    | And (p_1,p_2) -> trans_pr(p_1) *& trans_pr(p_2)
+    | Not (Expr Path q) -> Formula.true_ (* todo *)
+    | Expr Path q -> Formula.true_	   (* todo *)
+    | x -> print_predicate pr_er x; raise Not_core_XPath
+      
+  and form_propa q = function
+    | Child -> `Right *+ q
+    | Descendant -> (`Left *+ q +| `Right *+ q)
+    | x -> print_axis pr_er x; raise Not_core_XPath 
 
+  and form_propa_selec q q' = function
+    | Child -> `Right *+ q +| `Right *+ q'
+    | Descendant -> (`Left *+ q +| `Right *+ q) +| (`Left *+ q' +| `Right *+ q')
+    | x -> print_axis pr_er x; raise Not_core_XPath 
+      
   in
   match query with
-    | Absolute steps -> trans_init(); trans steps; asta
-    | AbsoluteDoS steps as x -> raise (Not_core_XPath x)
-    | Relative steps as x -> raise (Not_core_XPath x)
+    | Absolute steps -> trans steps; trans_init(); asta
+    | AbsoluteDoS steps as x -> print pr_er x; raise Not_core_XPath
+    | Relative steps as x -> print pr_er x; raise Not_core_XPath
diff --git a/src/qNameSet.ml b/src/qNameSet.ml
index 8746b09..e81118e 100644
--- a/src/qNameSet.ml
+++ b/src/qNameSet.ml
@@ -19,18 +19,14 @@ module Weak = FiniteCofinite.Weak(Ptset.Weak(QName))
 
 (* BEGIN : Lucca Hirschi *)
 let to_string set =
-  String.concat " "
-    [
-      (match (kind set) with
-	| `Finite -> "F("
-	| `Cofinite  -> "Cof(")
-      ;
-      if is_empty (complement set) then
-	"ø"
-      else
-	( String.concat " "
-	    (List.map (fun name -> QName.to_string name) (elements (complement set))))
-      ;
-      ")"
-    ]
+  let print_set s=
+    if is_empty (s) then
+      "ø"
+    else
+      String.concat " "
+	(List.map (fun name -> QName.to_string name) (elements s))
+  in
+  match (kind set) with
+    | `Finite -> "F("^(print_set set)^")"
+    | `Cofinite  -> "Cof("^(print_set (complement set))^")"
 (* END : Lucca Hirschi *)
diff --git a/src/test.ml b/src/test.ml
index 334e572..cba40e0 100644
--- a/src/test.ml
+++ b/src/test.ml
@@ -37,11 +37,14 @@ let query =
 
 open Format
 
-let asta = Compil.trans query
+let build_asta () =
+  let asta = Compil.trans query in
+  fprintf err_formatter "COMPIL OK\n";
+  asta
 
 let () =
   fprintf err_formatter "Query: %a\n%!" XPath.Ast.print query;
-  fprintf err_formatter "Asta: %a\n%!" Asta.print asta;
+  fprintf err_formatter "Asta: %a\n%!" Asta.print (build_asta());
   fprintf err_formatter "Document:\n%!";
   Tree.print_xml stderr doc (Tree.root doc);
   exit 0