Final test in run_test try my.query on my.xml (from thesis) + fixs in run.ml ==>...

diff --git a/run_tests b/run_tests
index 13f44fe..4a26469 100755 (executable)
--- a/run_tests
+++ b/run_tests
@@ -1,8 +1,9 @@
-#./test.native ./tests/docs/my.xml '/child::site/child::regions'
-#echo "________________________________________________________________________________"
-#./test.native ./tests/docs/my.xml -f ./tests/queries/Treebank.xml.queries
-#echo "________________________________________________________________________________"
-#./test.native ./tests/docs/my.xml '/descendant::listitem[not(descendant::keyword/child::emph)]/descendant::parlist'
-#echo "________________________________________________________________________________"
+./test.native ./tests/docs/my.xml '/child::site/child::regions'
+echo "________________________________________________________________________________"
+./test.native ./tests/docs/my.xml -f ./tests/queries/Treebank.xml.queries
+echo "________________________________________________________________________________"
+./test.native ./tests/docs/my.xml '/descendant::listitem[not(descendant::keyword/child::emph)]/descendant::parlist'
+echo "________________________________________________________________________________"
 ./test.native ./tests/docs/my.xml -f ./tests/queries/my.queries.old
-#./test.native ./tests/docs/my.xml -f ./tests/queries/my.queries 2> tests/results/my.result
\ No newline at end of file
+echo "Expected answer: 43 (the b from the second big sub-tree)."
+./test.native ./tests/docs/my.xml -f ./tests/queries/my.queries.old 2> tests/results/my.result
\ No newline at end of file

diff --git a/src/asta.ml b/src/asta.ml
index 3189b27..d866005 100644 (file)
--- a/src/asta.ml
+++ b/src/asta.ml
@@ -121,7 +121,9 @@ let init_top ast  = ast.top <- (StateSet.empty)
 
 let top_states ast = StateSet.elements ast.top
 
-let bot_states ast = ast.bottom
+let top_states_s ast = ast.top
+
+let bot_states_s ast = ast.bottom
 
 let selec_states ast = ast.selec
 
@@ -149,6 +151,6 @@ let print fmt asta =
       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 1>##### ASTA #####@, %a@ @]@." print_box 0
+  Format.fprintf fmt "@[<v 1>##### ASTA #####@. %a@ @]@." print_box 0
 
 let to_file out asta = ()

diff --git a/src/asta.mli b/src/asta.mli
index e3d3c0d..7bbf13d 100644 (file)
--- a/src/asta.mli
+++ b/src/asta.mli
@@ -75,8 +75,11 @@ val init_top : t -> unit
 val top_states : t -> state list
 (** Give the list of top states of an ASTA *)
 
-val bot_states : t -> StateSet.t
-(** Give the list of bottom states of an ASTA *)
+val top_states_s : t -> StateSet.t
+(** Give the set of top states of an ASTA *)
+
+val bot_states_s : t -> StateSet.t
+(** Give the set of bottom states of an ASTA *)
 
 val selec_states : t -> StateSet.t
 (** Give the list of selecting states of an ASTA *)

diff --git a/src/formula.ml b/src/formula.ml
index c75748f..8369571 100644 (file)
--- a/src/formula.ml
+++ b/src/formula.ml
@@ -91,7 +91,7 @@ let rec infer_form ssq ssr f = match expr f with
   | Atom(dir, b, s) -> 
     let setq, setr = match dir with
       |`Left -> fst ssq, fst ssr
-      | `Right -> snd ssq, fst ssr in
+      | `Right -> snd ssq, snd ssr in
     (* WG: WE SUPPOSE THAT Q^r and Q^q are disjoint ! *)
     let mem =  StateSet.mem s setq || StateSet.mem s setr in
     if b then mem else not mem

diff --git a/src/run.ml b/src/run.ml
index 8a7e066..9ece6ee 100644 (file)
--- a/src/run.ml
+++ b/src/run.ml
@@ -32,7 +32,7 @@ exception Over_max_fail
 exception Max_fail
 
 (* Mapped sets for leaves *)
-let map_leaf asta = (Asta.bot_states asta, StateSet.empty)
+let map_leaf asta = (Asta.bot_states_s asta, StateSet.empty)
 let empty = (StateSet.empty,StateSet.empty)
 
 (* Build the Oracle *)
@@ -112,43 +112,52 @@ let rec tp_max asta run tree tnode =
     and tnnode = Tree.next_sibling tree tnode in
     let (fnode,nnode) =
       (Tree.preorder tree tfnode, Tree.preorder tree tnnode) in
-    let q_rec n =
-      try NodeHash.find run n
-      with Not_found -> (Asta.bot_states asta,StateSet.empty) in
-    let (qf),(qn) = q_rec fnode,q_rec nnode in
-    let lab = Tree.tag tree tnode in
-    let list_tr,_ = Asta.transitions_lab asta lab in (* only take query. *)
-    let set_node,_ = try NodeHash.find run node
-      with _ -> raise Max_fail in
-    let rec result = function
-      | [] -> []
-      | (q,form) :: tl ->
-        if (Formula.infer_form qf qn form) && (StateSet.mem q set_node)
-        then form :: (result tl)
-        else result tl in
-    let list_form = result list_tr in
-    let rec add_st (ql,qr) = function
-      | [] -> ql,qr
-      | f :: tl -> let sql,sqr = Formula.st f in
-                   let ql' = StateSet.union sql ql
-                   and qr' = StateSet.union sqr qr in
-                   add_st (ql',qr') tl in
-    let ql,qr = add_st (StateSet.empty, StateSet.empty) list_form in
-    let qfq,qfr = try NodeHash.find run fnode
-      with | _ -> map_leaf asta
-    and qnq,qnr = try NodeHash.find run nnode
-      with | _ -> map_leaf asta in
     begin
-      if Tree.is_leaf tree tfnode
-      then ()
-      else NodeHash.replace run fnode (StateSet.inter qfq ql,qfr);
-      if Tree.is_leaf tree tnnode
-      then ()
-      else NodeHash.replace run nnode (StateSet.inter qnq qr,qnr);
-      tp_max asta run tree tfnode;
-      tp_max asta run tree tnnode;
+      if tnode == Tree.root tree        (* we must intersectt with top states *)
+      then let setq,_  = try NodeHash.find run node
+        with _ -> raise Max_fail in
+           NodeHash.replace run node
+             ((StateSet.inter (Asta.top_states_s asta) setq),StateSet.empty)
+      else ();
+      let q_rec n =
+        try NodeHash.find run n
+        with Not_found -> map_leaf asta in
+      let (qfq,qfr),(qnq,qnr) = q_rec fnode,q_rec nnode in
+      let lab = Tree.tag tree tnode in
+      let list_tr,_ = Asta.transitions_lab asta lab in (* only take query. *)
+      let set_node,_ = try NodeHash.find run node
+        with _ -> raise Max_fail in
+      let rec result = function
+        | [] -> []
+        | (q,form) :: tl ->
+          if (Formula.infer_form (qfq,qnq) (qfr,qnr) form) &&
+            (StateSet.mem q set_node)
+          then form :: (result tl)
+          else result tl in
+      let list_form = result list_tr in
+      let rec add_st (ql,qr) = function
+        | [] -> ql,qr
+        | f :: tl -> let sql,sqr = Formula.st f in
+                     let ql' = StateSet.union sql ql
+                     and qr' = StateSet.union sqr qr in
+                     add_st (ql',qr') tl in
+      let ql,qr = add_st (StateSet.empty, StateSet.empty) list_form in
+      let qfq,qfr = try NodeHash.find run fnode
+        with | _ -> map_leaf asta
+      and qnq,qnr = try NodeHash.find run nnode
+        with | _ -> map_leaf asta in
+      begin
+        if tfnode == Tree.nil
+        then ()
+        else NodeHash.replace run fnode (StateSet.inter qfq ql,qfr);
+        if tnnode == Tree.nil
+        then ()
+        else NodeHash.replace run nnode (StateSet.inter qnq qr,qnr);
+        tp_max asta run tree tfnode;
+        tp_max asta run tree tnnode;
+      end;
     end
-
+        
 let compute tree asta =
   let flag = 2 in                       (* debug  *)
   let size_tree = 10000 in              (* todo *)