then ()
else NodeHash.add run node (map_leaf asta)
else
- let tfnode = Tree.first_child tree tnode
+ let tfnode = Tree.first_child_x tree tnode
and tnnode = Tree.next_sibling tree tnode in
let fnode,nnode = (* their preorders *)
(Tree.preorder tree tfnode, Tree.preorder tree tnnode) in
then
()
else
- let tfnode = Tree.first_child tree tnode
+ let tfnode = Tree.first_child_x tree tnode
and tnnode = Tree.next_sibling tree tnode in
begin
bu_over_max asta run tree tfnode;
()
else
let node = Tree.preorder tree tnode
- and tfnode = Tree.first_child tree tnode
+ and tfnode = Tree.first_child_x tree tnode
and tnnode = Tree.next_sibling tree tnode in
let (fnode,nnode) =
(Tree.preorder tree tfnode, Tree.preorder tree tnnode) in
and qnq,qnr = try NodeHash.find run nnode
with | _ -> map_leaf asta in
begin
- if tfnode == Tree.nil
+ if tfnode == Tree.nil || Tree.is_attribute tree tnode
then ()
else NodeHash.replace run fnode (StateSet.inter qfq ql,qfr);
- if tnnode == Tree.nil
+ if tnnode == Tree.nil || Tree.is_attribute tree tnode
then ()
else NodeHash.replace run nnode (StateSet.inter qnq qr,qnr);
(* indeed we delete all states from self transitions! *)
NodeHash.fold
(fun key set acc ->
if not(StateSet.is_empty
- (StateSet.inter (fst set) (Asta.selec_states asta)))
+ (StateSet.inter (fst set) (Asta.selec_states asta)))
then key :: acc
else acc)
run []
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)
+ let rec list_qu fq list =
+ try let q = XPath.parse_file fq in
+ list_qu fq (q::list)
with _ -> list in
let list = list_qu fq [] in
close_in fq;
- fprintf err_formatter "Parse query OK ! ";
+ fprintf err_formatter "Parse query OK !\n %!";
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 () =
+ let flag = Array.length Sys.argv = 5 in
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);
output_string stderr "\n";
let queries = query () in
+ 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
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 "\n ### 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
+ let run = compute_run doc asta in
+ fprintf err_formatter "\n ### Query: %a"
+ XPath.Ast.print query;
fprintf err_formatter "@. ### Selected nodes: {%a}@."
- print_selec selected_nodes in
+ print_selec selected_nodes;
+ if flag
+ then begin
+ Asta.print err_formatter asta;
+ Run.print err_formatter run;
+ end
+ else ();
+ solve_queries tl in
solve_queries queries;
exit 0
let root t = t.root
let first_child _ n = n.first_child
+let first_child_x _ n =
+ if n.first_child.tag == QName.attribute_map
+ then n.first_child.next_sibling
+ else n.first_child
let next_sibling _ n = n.next_sibling
let parent _ n = n.parent
(* Begin Lucca Hirschi *)
-let is_leaf t n = (first_child t n == nil) && (next_sibling t n == nil)
+let is_leaf t n = (not (n.tag == QName.attribute_map)) &&
+ (first_child t n == nil) && (next_sibling t n == nil)
+let is_attribute t n = n.tag == QName.attribute_map
(* End *)
let tag _ n = n.tag
let data _ n = n.data
let fchild =
if node.first_child.tag == QName.attribute_map then
let () =
- print_attributes out tree_ node.first_child.first_child
+ let ffn = node.first_child.first_child in
+ print_attributes out tree_ ffn;
in
node.first_child.next_sibling
else
end
in
print_xml_preorder out tree_ node.next_sibling
+
+let debug_node fmt t n =
+ Parser.debug_node fmt n
Returns [nil] if [n] is a leaf. Returns [nil] if [n == nil].
*)
+val first_child_x : t -> node -> node
+(** [first_child t n] returns the first child which is not an attribute
+ of node [n] in tree [t].
+ Returns [nil] if [n] is a leaf. Returns [nil] if [n == nil].
+*)
+
val next_sibling : t -> node -> node
(** [next_sibling t n] returns the next_sibling of node [n] in tree [t].
Returns [nil] if [n] is the last child of a node.
*)
val is_leaf : t -> node -> bool
-(** Return true if the node is a *)
+(** Return true if the node is a leaf or an attribute *)
+
+val is_attribute : t -> node -> bool
+(** Return true if the node is an attribute *)
val tag : t -> node -> QName.t
(** Returns the label of a given node *)
val print_xml_preorder : out_channel -> t -> node -> unit
(** Outputs the tree with IDs for nodes as an XML document on the
given output_channel *)
+
+val debug_node : Format.formatter -> t -> node -> unit
+(** DEBUG *)
-<?xml version="1.0" encoding="UTF-8"?><!DOCTYPE A SYSTEM "alphabet.dtd"><A id="n1" pre="1" post="26" xml:lang="en"><B id="n2" pre="2" post="3"><C id="n3" pre="3" post="1">clergywoman</C><D id="n4" pre="4" post="2">decadent</D></B><E id="n5" pre="5" post="22"><F id="n6" pre="6" post="6"><G id="n7" pre="7" post="4">gentility</G><H id="n8" pre="8" post="5" idrefs="n17 n26">happy-go-lucky man</H></F><I id="n9" pre="9" post="9"><J id="n10" pre="10" post="7">jigsaw</J><K id="n11" pre="11" post="8">kerchief</K></I><L id="n12" pre="12" post="15"><!--L is the twelve-th letter of the English alphabet-->The letter L is followed by the letter:<M id="n13" pre="13" post="10"/>which is followed by the letter:<N id="n14" pre="14" post="13"><O id="n15" pre="15" post="11">ovenware</O><P id="n16" pre="16" post="12">plentiful</P></N><?myPI value="XPath is nice"?><Q id="n17" pre="17" post="14" idrefs="n8 n26">quarrelsome</Q></L><R id="n18" pre="18" post="18"><S id="n19" pre="19" post="16">sage</S><T id="n20" pre="20" post="17">tattered</T></R><U id="n21" pre="21" post="21"><V id="n22" pre="22" post="19">voluptuary</V><W id="n23" pre="23" post="20">wriggle</W></U></E><X id="n24" pre="24" post="25"><Y id="n25" pre="25" post="23">yawn</Y><Z id="n26" pre="26" post="24" idrefs="n8 n17" xml:lang="it">zuzzurellone</Z></X></A>
+<A id="n1" pre="1" post="26" xml:lang="en">
+<B id="n2" pre="2" post="3">
+<C id="n3" pre="3" post="1">clergywoman</C>
+<D id="n4" pre="4" post="2">decadent</D>
+</B>
+<E id="n5" pre="5" post="22">
+<F id="n6" pre="6" post="6">
+<G id="n7" pre="7" post="4">gentility</G>
+<H id="n8" pre="8" post="5" idrefs="n17 n26">happy-go-lucky man</H>
+</F>
+<I id="n9" pre="9" post="9">
+<J id="n10" pre="10" post="7">jigsaw</J>
+<K id="n11" pre="11" post="8">kerchief</K>
+</I>
+<L id="n12" pre="12" post="15">
+<!-- L is the twelve-th letter of the English alphabet -->
+The letter L is followed by the letter:
+<M id="n13" pre="13" post="10"/>
+which is followed by the letter:
+<N id="n14" pre="14" post="13">
+<O id="n15" pre="15" post="11">ovenware</O>
+<P id="n16" pre="16" post="12">plentiful</P>
+</N>
+<?myPI value="XPath is nice"?>
+<Q id="n17" pre="17" post="14" idrefs="n8 n26">quarrelsome</Q>
+</L>
+<R id="n18" pre="18" post="18">
+<S id="n19" pre="19" post="16">sage</S>
+<T id="n20" pre="20" post="17">tattered</T>
+</R>
+<U id="n21" pre="21" post="21">
+<V id="n22" pre="22" post="19">voluptuary</V>
+<W id="n23" pre="23" post="20">wriggle</W>
+</U>
+</E>
+<X id="n24" pre="24" post="25">
+<Y id="n25" pre="25" post="23">yawn</Y>
+<Z id="n26" pre="26" post="24" idrefs="n8 n17" xml:lang="it">zuzzurellone</Z>
+</X>
+</A>
-/descendant::L
+/descendant::L/child::*
/descendant::L/descendant::*
/descendant::L/following-sibling::*
/descendant::L/self::*
projects / tatoo.git / commitdiff