./test.native ./tests/docs/tiny.xml -f ./tests/queries/Treebank.xml.queries
echo "\n"
./test.native ./tests/docs/tiny.xml '/descendant::listitem[not(descendant::keyword/child::emph)]/descendant::parlist'
+echo "/n"
+./test.native ./tests/docs/tiny.xml -f ./tests/queries/my.queries
\ No newline at end of file
mutable selec : StateSet.t;
mutable bottom : StateSet.t;
mutable top : StateSet.t;
- mutable trans : SetT.t;
+ mutable trans_q : SetT.t;
+ mutable trans_r : SetT.t;
}
exception Not_found_transition
exception Transition_not_injective
-
+
let transition asta st lab =
let filter (s,l,f) =
(State.compare s st = 0) && (QNameSet.compare l lab = 0) in
- let tr_set = SetT.elements (SetT.filter filter asta.trans) in
+ let tr_set = (SetT.elements (SetT.filter filter asta.trans_q)) @
+ (SetT.elements (SetT.filter filter asta.trans_r))
+ in
match tr_set with
| [] -> raise Not_found_transition
| x::y::z -> raise Transition_not_injective
let rec remove_states l = match l with
| [] -> []
| (a,s,l) :: tl -> (s,l) :: (remove_states tl) in
- remove_states (SetT.elements (SetT.filter filter asta.trans))
+ (remove_states (SetT.elements (SetT.filter filter asta.trans_q)),
+ (remove_states (SetT.elements (SetT.filter filter asta.trans_r))))
let empty = {
quer = StateSet.empty;
selec = StateSet.empty;
bottom = StateSet.empty;
top = StateSet.empty;
- trans = SetT.empty;
+ trans_q = SetT.empty;
+ trans_r = SetT.empty
}
let any_label = QNameSet.complement (QNameSet.empty)
let new_state () = State.make()
-let add_tr ast tr = ast.trans <- (SetT.add tr (ast.trans))
+let add_tr ast tr flag =
+ if flag
+ then ast.trans_q <- (SetT.add tr (ast.trans_q))
+ else ast.trans_r <- (SetT.add tr (ast.trans_r))
let add_quer ast st = ast.quer <- (StateSet.add st (ast.quer))
let top_states ast = StateSet.elements ast.top
let print fmt asta =
- let pp = Format.fprintf fmt in
- 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 "\nBottom states: ";
- StateSet.print fmt asta.bottom;
- pp "\nTop states: ";
- StateSet.print fmt asta.top;
- pp "\nTransitions: \n";
- 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 print_box fmt flag =
+ let pp = Format.fprintf fmt in
+ Format.fprintf fmt "@[<v 0># Query states: %a@ @]"
+ StateSet.print asta.quer;
+ Format.fprintf fmt "@[<v 0># Recognizing states: %a@ @]"
+ StateSet.print asta.reco;
+ Format.fprintf fmt "@[<v 0># Selecting states: %a@ @]"
+ StateSet.print asta.selec;
+ Format.fprintf fmt "@[<v 0># Bottom states: %a@ @]"
+ StateSet.print asta.bottom;
+ Format.fprintf fmt "@[<v 0># Tom states: %a@ @]"
+ StateSet.print asta.top;
+ let print_list_tr fmt z=
+ SetT.iter (fun x -> Format.fprintf fmt "| %a@ " Transition.print x) z in
+ let print_box_list fmt trans =
+ Format.fprintf fmt " @[<hov 0>%a @]" print_list_tr trans in
+ Format.fprintf fmt "@[<v 0># Queries transitions:@ %a@ @]"
+ print_box_list asta.trans_q;
+ Format.fprintf fmt "@[<v 0># Recognizing transitions:@ %a@ @]"
+ print_box_list asta.trans_r in
+ Format.fprintf fmt "@[<v 0> ##### ASTA #####@. %a@ @]@ " print_box 0
let to_file out asta = ()
val transition : t -> state -> label -> formula
(** Give the formula which must hold for a current state and label *)
-val transitions : t -> state -> (label*formula) list
-(** Give the list of labels and formulae from transitions for a given state *)
+val transitions : t -> state -> ((label*formula) list)*((label*formula) list)
+(** Give the list of labels and formulae from queries and recognizing
+ transitions for a given state *)
val empty : t
(** The empty automaton *)
val new_state : unit -> state
(** Give a new state (different from all others states) *)
-val add_tr : t -> transition -> unit
-(** Add a transition to an asta *)
+val add_tr : t -> transition -> bool -> unit
+(** Add a query transition (recognizing transition if flag=false) to an asta *)
val add_reco : t -> state -> unit
(** Add a state to the recognizing states of an asta *)
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
+ let rec trans = function (* builds asta from the bottom of the query *)
| [s] -> trans_last s
| s :: tl -> trans tl; trans_step s
| [] -> ()
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)
+ Asta.add_tr asta (top_st, Asta.any_label, or_top) true
and trans_last (ax,test,pred) = (* a selecting state is needed *)
let fo_p = trans_pr pred in
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
+ Asta.add_tr asta tr_selec true;
+ Asta.add_tr asta tr_q true
- and trans_step (ax,test,pred) =
+ and trans_step (ax,test,pred) = (* add a new state for the step *)
let fo_p = trans_pr pred
and q = Asta.new_state() in
let Simple label = test
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.add_tr asta tr_next true;
+ Asta.add_tr asta tr_propa true;
Asta.init_top asta;
Asta.add_top asta q
| 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 *)
+ | Not (Expr Path q) -> (trans_pr_path false q)
+ | Expr Path q -> (trans_pr_path true q)
| x -> print_predicate pr_er x; raise Not_core_XPath
- and form_propa q = function
+ and trans_pr_path posi = function (* builds asta for predicate and gives
+ the formula which must be satsified *)
+ | Relative [] -> if posi then Formula.true_ else Formula.false_
+ | Relative steps -> List.fold_left
+ (fun acc x -> if posi then (`Left *+ x) +| acc else (`Left *- x) +| acc)
+ Formula.false_ (trans_pr_step_l steps)
+ | AbsoluteDoS steps as x -> print pr_er x; raise Not_core_XPath
+ | Absolute steps as x -> print pr_er x; raise Not_core_XPath
+
+ and trans_pr_step_l = function (* builds asta for a predicate query *)
+ | [step] -> trans_pr_step [] step
+ | step :: tl -> let list_top = trans_pr_step_l tl in
+ trans_pr_step list_top step
+ | [] -> failwith "Can not happened! 1"
+
+ and trans_pr_step list (ax,test,pred) = (* add a step on the top of
+ list in a predicate *)
+ let form_next =
+ if list = []
+ then trans_pr pred
+ else (trans_pr pred) *&
+ (List.fold_left (fun acc x -> (`Left *+ x) +| acc)
+ Formula.false_ list)
+ and q = Asta.new_state()
+ and Simple label = test in
+ let tr_next = (q,label, form_next)
+ and tr_propa = (q, Asta.any_label, form_propa q ax) in
+ Asta.add_reco asta q;
+ Asta.add_tr asta tr_next false;
+ Asta.add_tr asta tr_propa false;
+ [q] (* always one element here, but not with self
+ axis*)
+
+ and form_propa q = function (* gives the propagation formula *)
| 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
+ and form_propa_selec q q' = function (* the same with a selecting state *)
| 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
+ match query with (* match the top-level query *)
| 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
only the first line of XPath_querie_file is read
*)
+open Format
-let doc =
+let doc () =
let fd = open_in Sys.argv.(1) in
let d = Tree.load_xml_file fd in
- close_in fd; d
-
+ close_in fd;
+ fprintf err_formatter "Parse Tree OK ! ";
+ d
-let query =
+let query () =
let arg2 = Sys.argv.(2) in
if arg2 = "-f"
then let fq = open_in Sys.argv.(3) in
let q = XPath.parse_file fq in
- close_in fq; q
- else XPath.parse_string arg2
-
-open Format
-
-let build_asta () =
+ close_in fq;
+ fprintf err_formatter "Parse query OK ! ";
+ q
+ else let q = XPath.parse_string arg2 in
+ fprintf err_formatter "Parse query OK ! ";
+ q
+
+let build_asta query =
let asta = Compil.trans query in
- fprintf err_formatter "COMPIL OK\n";
+ 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 (build_asta());
- fprintf err_formatter "Document:\n%!";
- Tree.print_xml stderr doc (Tree.root doc);
+ let query = query () in
+ let doc = doc () in
+ let asta = build_asta query in
+ fprintf err_formatter "@[<v 0> ##### Query #####@. %a@]@ "
+ XPath.Ast.print query;
+ Asta.print err_formatter asta;
+ fprintf err_formatter "@[<v 0> ##### Doc #####@.%a@]@ "
+ Tree.print_xml doc (Tree.root doc);
exit 0
--- /dev/null
+/descendant::a[descendant::c[child::e and not(descendant::f[not(descendant::e)]/descendant::g)]]/descendant::b[child::g]
\ No newline at end of file
projects / tatoo.git / commitdiff