X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fauto%2Fata.ml;h=1015513f2563db0d5ebc669c5d47681c3a8f3004;hp=c7bb1720e855130e8884e47db29e8a6d115585ad;hb=ce09a30489dce8ac9e389c8c1525a34d1e02354e;hpb=97cc08246d4a73e9cc9070f645a351799b7340d1 diff --git a/src/auto/ata.ml b/src/auto/ata.ml index c7bb172..1015513 100644 --- a/src/auto/ata.ml +++ b/src/auto/ata.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) 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 "%s" "@?" + | 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_ @@ -142,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
" 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