Preliminary work for multiple starters evaluation.

diff --git a/src/ata.ml b/src/ata.ml
index 7310839..79d47a9 100644 (file)
--- a/src/ata.ml
+++ b/src/ata.ml
@@ -142,6 +142,7 @@ end =
 type t = {
   id : Uid.t;
   mutable states : StateSet.t;
 type t = {
   id : Uid.t;
   mutable states : StateSet.t;

+  mutable starting_states : StateSet.t;

   mutable selecting_states: StateSet.t;
   transitions: (State.t, (QNameSet.t*Formula.t) list) Hashtbl.t;
 }
   mutable selecting_states: StateSet.t;
   transitions: (State.t, (QNameSet.t*Formula.t) list) Hashtbl.t;
 }


@@ -149,6 +150,7 @@ type t = {
 
 
 let get_states a = a.states
 
 
 let get_states a = a.states

+let get_starting_states a = a.starting_states

 let get_selecting_states a = a.selecting_states
 
 let get_trans a tag states =
 let get_selecting_states a = a.selecting_states
 
 let get_trans a tag states =


@@ -174,10 +176,12 @@ let print fmt a =
   fprintf fmt
     "Internal UID: %i@\n\
      States: %a@\n\
   fprintf fmt
     "Internal UID: %i@\n\
      States: %a@\n\

+     Starting states: %a@\n\

      Selection states: %a@\n\
      Alternating transitions:@\n"
     (a.id :> int)
     StateSet.print a.states
      Selection states: %a@\n\
      Alternating transitions:@\n"
     (a.id :> int)
     StateSet.print a.states

+    StateSet.print a.starting_states

     StateSet.print a.selecting_states;
   let trs =
     Hashtbl.fold
     StateSet.print a.selecting_states;
   let trs =
     Hashtbl.fold


@@ -219,19 +223,24 @@ let print fmt a =
 
 let complete_transitions a =
   StateSet.iter (fun q ->
 
 let complete_transitions a =
   StateSet.iter (fun q ->

-    let qtrans = Hashtbl.find a.transitions q in
-    let rem =
-      List.fold_left (fun rem (labels, _) ->
-        QNameSet.diff rem labels) QNameSet.any qtrans
-    in
-    let nqtrans =
-      if QNameSet.is_empty rem then qtrans
-      else
-        (rem, Formula.false_) :: qtrans
-    in
-    Hashtbl.replace a.transitions q nqtrans
+    if StateSet.mem q a.starting_states then ()
+    else
+      let qtrans = try Hashtbl.find a.transitions q with Not_found -> eprintf "Not found here 226\n%!"; raise Not_found in
+      let rem =
+        List.fold_left (fun rem (labels, _) ->
+          QNameSet.diff rem labels) QNameSet.any qtrans
+      in
+      let nqtrans =
+        if QNameSet.is_empty rem then qtrans
+        else
+          (rem, Formula.false_) :: qtrans
+      in
+      Hashtbl.replace a.transitions q nqtrans

   ) a.states
 
   ) a.states
 

+(* [cleanup_states] remove states that do not lead to a
+   selecting states *)
+

 let cleanup_states a =
   let memo = ref StateSet.empty in
   let rec loop q =
 let cleanup_states a =
   let memo = ref StateSet.empty in
   let rec loop q =


@@ -308,7 +317,7 @@ let normalize_negations auto =
           in
           Hashtbl.add memo_state key nq; nq
     in
           in
           Hashtbl.add memo_state key nq; nq
     in

-    let trans = Hashtbl.find auto.transitions q in
+    let trans = try Hashtbl.find auto.transitions q with Not_found -> eprintf "Not_found here 318\n%!"; [] in

     let trans' = List.map (fun (lab, f) -> lab, flip b f) trans in
     Hashtbl.replace auto.transitions q' trans';
   done;
     let trans' = List.map (fun (lab, f) -> lab, flip b f) trans in
     Hashtbl.replace auto.transitions q' trans';
   done;


@@ -326,6 +335,7 @@ module Builder =
         {
           id = next ();
           states = StateSet.empty;
         {
           id = next ();
           states = StateSet.empty;

+          starting_states = StateSet.empty;

           selecting_states = StateSet.empty;
           transitions = Hashtbl.create MED_H_SIZE;
         }
           selecting_states = StateSet.empty;
           transitions = Hashtbl.create MED_H_SIZE;
         }


@@ -350,8 +360,9 @@ module Builder =
       ); *)
       auto
 
       ); *)
       auto
 

-    let add_state a ?(selecting=false) q =
+    let add_state a ?(starting=false) ?(selecting=false) q =

       a.states <- StateSet.add q a.states;
       a.states <- StateSet.add q a.states;

+      if starting then a.starting_states <- StateSet.add q a.starting_states;

       if selecting then a.selecting_states <- StateSet.add q a.selecting_states
 
     let add_trans a q s f =
       if selecting then a.selecting_states <- StateSet.add q a.selecting_states
 
     let add_trans a q s f =

diff --git a/src/ata.mli b/src/ata.mli
index 8b7851b..2676923 100644 (file)
--- a/src/ata.mli
+++ b/src/ata.mli
@@ -85,6 +85,9 @@ type t
 val get_states : t -> StateSet.t
 (** return the set of states of the automaton *)
 
 val get_states : t -> StateSet.t
 (** return the set of states of the automaton *)
 

+val get_starting_states : t -> StateSet.t
+(** return the set of starting states of the automaton *)
+

 val get_selecting_states : t -> StateSet.t
 (** return the set of selecting states of the automaton *)
 
 val get_selecting_states : t -> StateSet.t
 (** return the set of selecting states of the automaton *)
 


@@ -109,10 +112,11 @@ sig
   val make : unit -> t
     (** Create a fresh builder *)
 
   val make : unit -> t
     (** Create a fresh builder *)
 

-  val add_state : t -> ?selecting:bool -> State.t -> unit
-    (** Add a state to the set of states of the automaton. The optional argument
-        [?selecting] (defaulting to [false]) allows to specify whether the state is
-        selecting. *)
+  val add_state : t -> ?starting:bool -> ?selecting:bool -> State.t -> unit
+  (** Add a state to the set of states of the automaton. The
+      optional arguments [?starting] and [?selecting] (defaulting
+      to [false]) allow one to specify whether the state is
+      starting/selecting. *)

 
   val add_trans : t -> State.t -> QNameSet.t -> Formula.t -> unit
     (** Add a transition to the automaton *)
 
   val add_trans : t -> State.t -> QNameSet.t -> Formula.t -> unit
     (** Add a transition to the automaton *)

diff --git a/src/run.ml b/src/run.ml
index 38b7e45..d7d5177 100644 (file)
--- a/src/run.ml
+++ b/src/run.ml
@@ -159,6 +159,16 @@ END
        (Ata.TransList.print ~sep:"<br/>") config.todo i
 
 
        (Ata.TransList.print ~sep:"<br/>") config.todo i
 
 

+   let debug msg tree node i config =
+     let config = config.NodeStatus.node in
+     eprintf
+       "DEBUG:%s node: %i\nsat: %a\nunsat: %a\ntodo: %around: %i\n"
+       msg
+       (T.preorder tree node)
+       StateSet.print config.sat
+       StateSet.print config.unsat
+       (Ata.TransList.print ~sep:"\n") config.todo i
+

 
    let get_trans cache2 auto tag states =
      let trs =
 
    let get_trans cache2 auto tag states =
      let trs =


@@ -262,7 +272,7 @@ END
 
 
 
 
 
 

-  let top_down node run =
+  let top_down run =

     let tree = run.tree in
     let auto = run.auto in
     let status = run.status in
     let tree = run.tree in
     let auto = run.auto in
     let status = run.status in


@@ -285,7 +295,8 @@ END
           if c == dummy_status then
             (* first time we visit the node *)
             NodeStatus.make
           if c == dummy_status then
             (* first time we visit the node *)
             NodeStatus.make

-              { c.NodeStatus.node with
+              { sat = StateSet.empty;
+                unsat = Ata.get_starting_states auto;

                 todo = get_trans cache2 auto tag (Ata.get_states auto);
                 summary = NodeSummary.make
                   (node == T.first_child tree parent) (* is_left *)
                 todo = get_trans cache2 auto tag (Ata.get_states auto);
                 summary = NodeSummary.make
                   (node == T.first_child tree parent) (* is_left *)


@@ -346,7 +357,7 @@ END
         unstable_self
       end
     in
         unstable_self
       end
     in

-    run.redo <- loop node;
+    run.redo <- loop (T.root tree);

     run.pass <- run.pass + 1
 
 (*
     run.pass <- run.pass + 1
 
 (*


@@ -405,9 +416,40 @@ END
     in
     loop (T.root tree) []
 
     in
     loop (T.root tree) []
 

+  let prepare_run run list =
+    let tree = run.tree in
+    let auto = run.auto in
+    let status = run.status in
+    let cache2 = run.cache2 in
+    List.iter (fun node ->
+      let parent = T.parent tree node in
+      let fc = T.first_child tree node in
+      let ns = T.next_sibling tree node in
+      let tag = T.tag tree node in
+
+      let status0 =
+        NodeStatus.make
+          { sat = Ata.get_starting_states auto;
+            unsat = StateSet.empty;
+            todo = get_trans cache2 auto tag (Ata.get_states auto);
+            summary = NodeSummary.make
+              (node == T.first_child tree parent) (* is_left *)
+              (node == T.next_sibling tree parent) (* is_right *)
+              (fc != T.nil) (* has_left *)
+              (ns != T.nil) (* has_right *)
+              (T.kind tree node) (* kind *)
+          }
+      in
+      let node_id = T.preorder tree node in
+      status.(node_id) <- status0) list
+

 
 

-  let eval auto tree node =
+
+  let eval auto tree nodes =

     let run = make auto tree in
     let run = make auto tree in

-    while run.redo do top_down node run done;
+    prepare_run run nodes;
+    while run.redo do
+      top_down run;
+    done;

     get_results run
 end
     get_results run
 end

diff --git a/src/run.mli b/src/run.mli
index 8476326..d57f6c9 100644 (file)
--- a/src/run.mli
+++ b/src/run.mli
@@ -15,5 +15,5 @@
 
 module Make (T : Tree.S) :
   sig
 
 module Make (T : Tree.S) :
   sig

-    val eval : Ata.t -> T.t -> T.node -> T.node list
+    val eval : Ata.t -> T.t -> T.node list -> T.node list

   end
   end

diff --git a/src/tatoo.ml b/src/tatoo.ml
index c3cddfe..362c4fb 100644 (file)
--- a/src/tatoo.ml
+++ b/src/tatoo.ml
@@ -52,7 +52,7 @@ let main () =
 
   let module Naive = Run.Make(Naive_tree) in
   let results =
 
   let module Naive = Run.Make(Naive_tree) in
   let results =

-    time (Naive.eval auto doc) (Naive_tree.root doc) "evaluating query"
+    time (Naive.eval auto doc) ([Naive_tree.root doc]) "evaluating query"

   in
   time (fun () ->
   output_string output "<xml_result>\n";
   in
   time (fun () ->
   output_string output "<xml_result>\n";

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
index c53057e..6987b4c 100644 (file)
--- a/src/xpath/compile.ml
+++ b/src/xpath/compile.ml
@@ -39,7 +39,7 @@ let root_set = QNameSet.singleton QName.document
    holds.
 *)
 
    holds.
 *)
 

-let compile_axis_test axis (test,kind) phi trans states =
+let compile_axis_test axis (test,kind) phi trans states=

   let q = State.make () in
   let phi = match kind with
     Tree.NodeKind.Node -> phi
   let q = State.make () in
   let phi = match kind with
     Tree.NodeKind.Node -> phi


@@ -210,26 +210,34 @@ let compile_top_level_step_list l trans states =
             in
             loop ll trans2 states2  phi2
   in
             in
             loop ll trans2 states2  phi2
   in

+  let starting = State.make () in

   let phi0, trans0, states0 =
     compile_axis_test
       Self
   let phi0, trans0, states0 =
     compile_axis_test
       Self

-      (QNameSet.singleton QName.document, Tree.NodeKind.Node)
-      F.true_
+      (QNameSet.any, Tree.NodeKind.Node)
+      (F.stay starting)

       trans
       states
   in
       trans
       states
   in

-  loop l trans0 states0 phi0
+  let mstates, trans, states = loop l trans0 states0 phi0 in
+  starting, mstates, trans, states

 ;;
 
 let path p =
 ;;
 
 let path p =

-  let mstates, trans, states = List.fold_left (fun (ams, atrs, asts) p ->
-    let ms, natrs, nasts =
-      match p with
-      | Absolute l | Relative l -> compile_top_level_step_list l atrs asts
-    in
-    (StateSet.add ms ams), natrs, nasts) (StateSet.empty, [], StateSet.empty) p
+  let sstates, mstates, trans, states =
+    List.fold_left (fun (ass, ams, atrs, asts) p ->
+      let ss, ms, natrs, nasts =
+        match p with
+        | Absolute l | Relative l -> compile_top_level_step_list l atrs asts
+      in
+      (StateSet.add ss ass),
+      (StateSet.add ms ams),
+      natrs,
+      nasts) (StateSet.empty, StateSet.empty, [], StateSet.empty) p

   in
   let builder = Ata.Builder.make () in
   in
   let builder = Ata.Builder.make () in

+  StateSet.iter
+    (Ata.Builder.add_state builder ~starting:true) sstates;

   StateSet.iter
     (Ata.Builder.add_state builder ~selecting:true) mstates;
   StateSet.iter
   StateSet.iter
     (Ata.Builder.add_state builder ~selecting:true) mstates;
   StateSet.iter