Add a function to remove unreachable states in the automaton

diff --git a/src/auto/ata.ml b/src/auto/ata.ml
index 90168b2..9e370fd 100644 (file)
--- a/src/auto/ata.ml
+++ b/src/auto/ata.ml
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
 (***********************************************************************)
 
 (*

-  Time-stamp: <Last modified on 2013-03-09 11:13:58 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-09 11:35:17 CET by Kim Nguyen>

 *)
 
 INCLUDE "utils.ml"
 *)
 
 INCLUDE "utils.ml"


@@ -114,6 +114,15 @@ struct
     is_next_sibling
   let stay q =
     (mk_atom Stay true q)
     is_next_sibling
   let stay q =
     (mk_atom Stay true q)

+
+  let get_states phi =
+    fold (fun phi acc ->
+      match expr phi with
+      | Formula.Atom a -> let _, _, q = Atom.node a in
+                          if q != State.dummy then StateSet.add q acc else acc
+      | _ -> acc
+    ) phi StateSet.empty
+

 end
 
 type t = {
 end
 
 type t = {


@@ -236,6 +245,21 @@ let complete_transitions a =
     Hashtbl.replace a.transitions q nqtrans
   ) a.states
 
     Hashtbl.replace a.transitions q nqtrans
   ) a.states
 

+let cleanup_states a =
+  let memo = ref StateSet.empty in
+  let rec loop q =
+    if not (StateSet.mem q !memo) then begin
+      memo := StateSet.add q !memo;
+      let trs = try Hashtbl.find a.transitions q with Not_found -> [] in
+      List.iter (fun (_, phi) ->
+        StateSet.iter loop (SFormula.get_states phi)) trs
+    end
+  in
+  StateSet.iter loop a.selection_states;
+  let unused = StateSet.diff a.states !memo in
+  eprintf "Unused states %a\n%!" StateSet.print unused;
+  StateSet.iter (fun q -> Hashtbl.remove a.transitions q) unused;
+  a.states <- !memo

 
 (* [normalize_negations a] removes negative atoms in the formula
    complementing the sub-automaton in the negative states.
 
 (* [normalize_negations a] removes negative atoms in the formula
    complementing the sub-automaton in the negative states.


@@ -305,6 +329,7 @@ let normalize_negations auto =
     let trans = Hashtbl.find auto.transitions q in
     let trans' = List.map (fun (lab, f) -> lab, flip b f) trans in
     Hashtbl.replace auto.transitions q' trans';
     let trans = Hashtbl.find auto.transitions q in
     let trans' = List.map (fun (lab, f) -> lab, flip b f) trans in
     Hashtbl.replace auto.transitions q' trans';

-  done
+  done;
+  cleanup_states auto