Implement a new automaton run (non optimized) with cleaner semantics w.r.t. ranked...

[tatoo.git] / src / ata.ml

diff --git a/src/ata.ml b/src/ata.ml
index 9ad2b12..939586f 100644 (file)
--- a/src/ata.ml
+++ b/src/ata.ml
@@ -212,6 +212,9 @@ struct
         Formula.print f sep) l
 end
 
+type rank = { td : StateSet.t;
+              bu : StateSet.t;
+              exit : StateSet.t }
 
 
 type t = {
@@ -220,7 +223,7 @@ type t = {
   mutable starting_states : StateSet.t;
   mutable selecting_states: StateSet.t;
   transitions: (State.t, (QNameSet.t*Formula.t) list) Hashtbl.t;
-  mutable ranked_states : (StateSet.t*StateSet.t) array
+  mutable ranked_states : rank array
 }
 
 let uid t = t.id
@@ -252,8 +255,10 @@ let print fmt a =
     (StateSet.cardinal a.states)
     StateSet.print a.starting_states
     StateSet.print a.selecting_states
-    (let r = ref 0 in Pretty.print_array ~sep:", " (fun ppf (s1,s2) ->
-      fprintf ppf "(%i:%a,%a)" !r StateSet.print s1 StateSet.print s2; incr r)) a.ranked_states;
+    (let r = ref 0 in Pretty.print_array ~sep:", " (fun ppf s ->
+      fprintf ppf "(%i:{td=%a,bu=%a,exit=%a)" !r
+        StateSet.print s.td StateSet.print s.bu StateSet.print s.exit;
+      incr r)) a.ranked_states;
   let trs =
     Hashtbl.fold
       (fun q t acc -> List.fold_left (fun acc (s , f) -> (q,s,f)::acc) acc t)
@@ -453,6 +458,7 @@ let state_prerequisites dir auto q =
     StateSet.union prereq acc)
     StateSet.empty trans
 
+
 let compute_rank auto =
   let dependencies = compute_dependencies auto in
   let upward = [ `Stay ; `Parent ; `Previous_sibling ] in
@@ -503,24 +509,37 @@ let compute_rank auto =
     let set = try Hashtbl.find by_rank r with Not_found -> StateSet.empty in
     Hashtbl.replace by_rank r (StateSet.union s set)) !rank_list;
   let rank = Hashtbl.length by_rank in
-  auto.ranked_states <-
-    Array.init rank
-    (fun i ->
-      let set = try Hashtbl.find by_rank i with Not_found -> StateSet.empty in
-      let source =
-        if i + 1 == rank then auto.selecting_states else
-          let post_set = Hashtbl.find by_rank (i+1) in
-          let source = if i + 1 == rank then post_set else
-              StateSet.fold (fun q acc ->
-                List.fold_left (fun acc m ->
-                  StateSet.union acc (state_prerequisites m auto q ))
-                  acc [`First_child; `Next_sibling; `Parent; `Previous_sibling; `Stay]
-              ) post_set StateSet.empty
-          in
-          StateSet.inter set source
-      in
-      (source, set)
-    )
+  if rank mod 2 == 1 then Hashtbl.replace by_rank rank StateSet.empty;
+  let rank = Hashtbl.length by_rank in
+  assert (rank mod 2 == 0);
+  let rank_array =
+    Array.init (rank / 2)
+      (fun i ->
+        let td_set = Hashtbl.find by_rank (2 * i) in
+        let bu_set = Hashtbl.find by_rank (2 * i + 1) in
+        { td = td_set; bu = bu_set ; exit = StateSet.empty }
+      )
+  in
+  let max_rank = Array.length rank_array - 1 in
+  for i = 0 to max_rank do
+    let this_rank = rank_array.(i) in
+    let exit = if i == max_rank then auto.selecting_states else
+        let next = rank_array.(i+1) in
+        let res =
+          StateSet.fold (fun q acc ->
+            List.fold_left (fun acc m ->
+              StateSet.union acc (state_prerequisites m auto q ))
+              acc [`First_child; `Next_sibling; `Parent; `Previous_sibling; `Stay]
+          ) (StateSet.union next.td next.bu) StateSet.empty
+        in
+
+        StateSet.(
+          union  auto.selecting_states ( inter res (union this_rank.td this_rank.bu)))
+
+    in
+    rank_array.(i) <- {this_rank with exit = exit };
+  done;
+  auto.ranked_states <- rank_array
 
 
 module Builder =
@@ -608,7 +627,11 @@ let rename_states mapper a =
         (fun l ->
           (List.map (fun (labels, form) -> (labels, map_form rename form)) l))
         a.transitions;
-    ranked_states = Array.map (fun (a,b) -> map_set rename a, map_set rename b) a.ranked_states
+    ranked_states = Array.map (fun s ->
+      { td = map_set rename s.td;
+        bu = map_set rename s.bu;
+        exit = map_set rename s.exit;
+      }) a.ranked_states
   }
 
 let copy a =