X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fauto%2Fata.ml;h=1015513f2563db0d5ebc669c5d47681c3a8f3004;hp=90168b20fca8a01b1345fcc2b29c944c5c38356e;hb=ce09a30489dce8ac9e389c8c1525a34d1e02354e;hpb=35c32fbd2543a399cc6939f21317bebf37172646

diff --git a/src/auto/ata.ml b/src/auto/ata.ml
index 90168b2..1015513 100644
--- 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-14 19:14:03 CET by Kim Nguyen>
 *)
 
 INCLUDE "utils.ml"
@@ -28,7 +28,7 @@ type predicate = | First_child
                  | Stay
                  | Is_first_child
                  | Is_next_sibling
-                 | Is_attribute
+                 | Is of (Tree.Common.NodeKind.t)
                  | Has_first_child
                  | Has_next_sibling
 
@@ -63,7 +63,7 @@ struct
     | Stay -> fprintf ppf "%s(%a)" Pretty.epsilon State.print q
     | Is_first_child -> fprintf ppf "FC%s?" Pretty.inverse
     | Is_next_sibling -> fprintf ppf "NS%s?" Pretty.inverse
-    | Is_attribute -> fprintf ppf "@?"
+    | Is k -> fprintf ppf "is-%a?" Tree.Common.NodeKind.print k
     | Has_first_child -> fprintf ppf "FC?"
     | Has_next_sibling -> fprintf ppf "NS?"
 
@@ -77,7 +77,9 @@ end
 module SFormula =
 struct
   include Formula.Make(Atom)
+  open Tree.Common.NodeKind
   let mk_atom a b c = atom_ (Atom.make (a,b,c))
+  let mk_kind k = mk_atom (Is k) true State.dummy
   let has_first_child =
     (mk_atom Has_first_child true State.dummy)
 
@@ -91,7 +93,16 @@ struct
     (mk_atom Is_next_sibling true State.dummy)
 
   let is_attribute =
-    (mk_atom Is_attribute true State.dummy)
+    (mk_atom (Is Attribute) true State.dummy)
+
+  let is_element =
+    (mk_atom (Is Element) true State.dummy)
+
+  let is_processing_instruction =
+    (mk_atom (Is ProcessingInstruction) true State.dummy)
+
+  let is_comment =
+    (mk_atom (Is Comment) true State.dummy)
 
   let first_child q =
   and_
@@ -112,8 +123,18 @@ struct
   and_
     (mk_atom Previous_sibling 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 = {
@@ -132,14 +153,34 @@ let create () = { id = next ();
  }
 
 
+module Transition = Hcons.Make (struct
+  type t = State.t * QNameSet.t * SFormula.t
+  let equal (a, b, c) (d, e, f) =
+    a == d && b == e && c == f
+  let hash (a, b, c) =
+    HASHINT4 (PRIME1, a, ((QNameSet.uid b) :> int), ((SFormula.uid c) :> int))
+end)
+
+module TransList : sig
+  include Hlist.S with type elt = Transition.t
+  val print : Format.formatter -> t -> unit
+end =
+  struct
+    include Hlist.Make(Transition)
+    let print ppf l =
+      iter (fun t ->
+        let q, lab, f = Transition.node t in
+        fprintf ppf "%a, %a -> %a<br/>" State.print q QNameSet.print lab SFormula.print f) l
+  end
+
 let get_trans a states tag =
   StateSet.fold (fun q acc0 ->
     try
       let trs = Hashtbl.find a.transitions q in
       List.fold_left (fun acc1 (labs, phi) ->
-        if QNameSet.mem tag labs then (q,phi)::acc1 else acc1) acc0 trs
+        if QNameSet.mem tag labs then TransList.cons (Transition.make (q, labs, phi)) acc1 else acc1) acc0 trs
     with Not_found -> acc0
-  ) states []
+  ) states TransList.nil
 
 (*
   [add_trans a q labels f] adds a transition [(q,labels) -> f] to the
@@ -236,6 +277,21 @@ let complete_transitions a =
     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.
@@ -305,6 +361,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';
-  done
+  done;
+  cleanup_states auto