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
type transition = Transition.t
type t = {
+ mutable quer : StateSet.t;
mutable reco : StateSet.t;
mutable selec : StateSet.t;
mutable bottom : StateSet.t;
remove_states (SetT.elements (SetT.filter filter asta.trans))
let empty = {
+ quer = StateSet.empty;
reco = StateSet.empty;
selec = StateSet.empty;
bottom = StateSet.empty;
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))
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;
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 = ()
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 *)
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 *)
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
(* 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 *)
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
projects / tatoo.git / commitdiff