XPath without predicates are correctly compiled.

[tatoo.git] / src / compil.ml

diff --git a/src/compil.ml b/src/compil.ml
index 30440f3..b722656 100644 (file)
--- a/src/compil.ml
+++ b/src/compil.ml
@@ -13,4 +13,89 @@
 (*                                                                     *)
 (***********************************************************************)
 
-let trad qu = Asta.dummy
+open XPath.Ast
+open Formula.Infix
+
+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 tl; trans_step s
+    | [] -> ()
+      
+  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.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) =
+    let fo_p = trans_pr pred
+    and q = Asta.new_state() in
+    let Simple label = test
+    and form_next = (fo_p) *&                    (* (\/ top_next) /\ predicat *)
+      (List.fold_left (fun acc x -> (`Left *+ x ) +| acc)
+        Formula.false_ (Asta.top_states asta)) in
+    let tr_next = (q, label, form_next)
+    and tr_propa = (q, Asta.any_label, form_propa q ax) in
+    Asta.add_quer asta q;
+    Asta.add_top asta q;
+    Asta.add_bot asta q;
+    Asta.add_tr asta tr_next;
+    Asta.add_tr asta tr_propa;
+    Asta.init_top asta;
+    Asta.add_top asta q
+      
+  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 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