Preliminary work for multiple starters evaluation. refactor/sanitize-ata
authorKim Nguyễn <kn@lri.fr>
Fri, 19 Jul 2013 15:02:10 +0000 (17:02 +0200)
committerKim Nguyễn <kn@lri.fr>
Fri, 19 Jul 2013 15:02:10 +0000 (17:02 +0200)
src/ata.ml
src/ata.mli
src/run.ml
src/run.mli
src/tatoo.ml
src/xpath/compile.ml

index 7310839..79d47a9 100644 (file)
@@ -142,6 +142,7 @@ end =
 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;
 }
@@ -149,6 +150,7 @@ type t = {
 
 
 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 =
@@ -174,10 +176,12 @@ let print fmt a =
   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
+    StateSet.print a.starting_states
     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 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
 
+(* [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 =
@@ -308,7 +317,7 @@ let normalize_negations auto =
           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;
@@ -326,6 +335,7 @@ module Builder =
         {
           id = next ();
           states = StateSet.empty;
+          starting_states = StateSet.empty;
           selecting_states = StateSet.empty;
           transitions = Hashtbl.create MED_H_SIZE;
         }
@@ -350,8 +360,9 @@ module Builder =
       ); *)
       auto
 
-    let add_state a ?(selecting=false) q =
+    let add_state a ?(starting=false) ?(selecting=false) q =
       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 =
index 8b7851b..2676923 100644 (file)
@@ -85,6 +85,9 @@ type t
 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 *)
 
@@ -109,10 +112,11 @@ sig
   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 *)
index 38b7e45..d7d5177 100644 (file)
@@ -159,6 +159,16 @@ END
        (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 =
@@ -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
@@ -285,7 +295,8 @@ END
           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 *)
@@ -346,7 +357,7 @@ END
         unstable_self
       end
     in
-    run.redo <- loop node;
+    run.redo <- loop (T.root tree);
     run.pass <- run.pass + 1
 
 (*
@@ -405,9 +416,40 @@ END
     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
-    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
index 8476326..d57f6c9 100644 (file)
@@ -15,5 +15,5 @@
 
 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
index c3cddfe..362c4fb 100644 (file)
@@ -52,7 +52,7 @@ let main () =
 
   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";
index c53057e..6987b4c 100644 (file)
@@ -39,7 +39,7 @@ let root_set = QNameSet.singleton QName.document
    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
@@ -210,27 +210,35 @@ let compile_top_level_step_list l trans states =
             in
             loop ll trans2 states2  phi2
   in
+  let starting = State.make () in
   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
-  loop l trans0 states0 phi0
+  let mstates, trans, states = loop l trans0 states0 phi0 in
+  starting, mstates, trans, states
 ;;
 
 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
   StateSet.iter
+    (Ata.Builder.add_state builder ~starting:true) sstates;
+  StateSet.iter
     (Ata.Builder.add_state builder ~selecting:true) mstates;
   StateSet.iter
     (Ata.Builder.add_state builder) states;