xPath.ml

   1 (******************************************************************************)
   2 (*  SXSI : XPath evaluator                                                    *)
   3 (*  Kim Nguyen (Kim.Nguyen@nicta.com.au)                                      *)
   4 (*  Copyright NICTA 2008                                                      *)
   5 (*  Distributed under the terms of the LGPL (see LICENCE)                     *)
   6 (******************************************************************************)
   7 INCLUDE "debug.ml";;
   8 #load "pa_extend.cmo";;
   9 let contains = ref None
  10 module Ast =
  11 struct
  12   (* The steps are in reverse order !!!! *)
  13   type path = Absolute of step list | AbsoluteDoS of step list| Relative of step list
  14   and step = axis*test*predicate
  15   and axis = Self | Attribute | Child | Descendant | DescendantOrSelf | FollowingSibling
  16              | Parent | Ancestor | AncestorOrSelf | PrecedingSibling | Preceding | Following
  17
  18   and test = TagSet.t
  19
  20   and predicate = Or of predicate*predicate
  21                   | And of predicate*predicate
  22                   | Not of predicate
  23                   | Expr of expression
  24   and expression =  Path of path
  25                     | Function of string*expression list
  26                     | Int of int
  27                     | String of string
  28                     | True | False
  29   type t = path
  30
  31
  32
  33
  34   let pp fmt = Format.fprintf fmt
  35   let print_list printer fmt sep l =
  36     match l with
  37         [] -> ()
  38       | [e] -> printer fmt e
  39       | e::es -> printer fmt e; List.iter (fun x -> pp fmt sep;printer fmt x) es
  40
  41
  42   let rec print fmt p =
  43     let l = match p with
  44       | Absolute l -> pp fmt "/"; l
  45       | AbsoluteDoS l -> pp fmt "/";
  46           print_step fmt (DescendantOrSelf,TagSet.node,Expr True);
  47           pp fmt "/"; l
  48       | Relative l -> l
  49     in
  50       print_list print_step fmt "/" (List.rev l)
  51   and print_step fmt (axis,test,predicate) =
  52     print_axis fmt axis;pp fmt "::";print_test fmt test;
  53     pp fmt "["; print_predicate fmt predicate; pp fmt "]"
  54   and print_axis fmt a = pp fmt "%s" (match a with
  55                                           Self -> "self"
  56                                         | Child -> "child"
  57                                         | Descendant -> "descendant"
  58                                         | DescendantOrSelf -> "descendant-or-self"
  59                                         | FollowingSibling -> "following-sibling"
  60                                         | Attribute -> "attribute"
  61                                         | Ancestor -> "ancestor"
  62                                         | AncestorOrSelf -> "ancestor-or-self"
  63                                         | PrecedingSibling -> "preceding-sibling"
  64                                         | Parent -> "parent"
  65                                         | _ -> assert false
  66                                      )
  67   and print_test fmt ts =
  68     try
  69       pp fmt "%s" (List.assoc ts
  70                      [ (TagSet.pcdata,"text()"); (TagSet.node,"node()");
  71                        (TagSet.star),"*"])
  72     with
  73         Not_found -> pp fmt "%s"
  74           (if TagSet.is_finite ts
  75            then Tag.to_string (TagSet.choose ts)
  76            else "<INFINITE>")
  77
  78   and print_predicate fmt = function
  79     | Or(p,q) -> print_predicate fmt p; pp fmt " or "; print_predicate fmt q
  80     | And(p,q) -> print_predicate fmt p; pp fmt " and "; print_predicate fmt q
  81     | Not p -> pp fmt "not "; print_predicate fmt p
  82     | Expr e -> print_expression fmt e
  83
  84   and print_expression fmt = function
  85     | Path p -> print fmt p
  86     | Function (f,l) -> pp fmt "%s(" f;print_list print_expression fmt "," l;pp fmt ")"
  87     | Int i -> pp fmt "%i" i
  88     | String s -> pp fmt "\"%s\"" s
  89     | t -> pp fmt "%b" (t== True)
  90
  91 end
  92 module Parser =
  93 struct
  94   open Ast
  95   open Ulexer
  96   let predopt = function None -> Expr True | Some p -> p
  97
  98   module Gram =  Camlp4.Struct.Grammar.Static.Make(Ulexer)
  99   let query = Gram.Entry.mk "query"
 100
 101   exception Error of Gram.Loc.t*string
 102   let test_of_keyword t loc =
 103     match t with
 104       | "text()" -> TagSet.pcdata
 105       | "node()" -> TagSet.node
 106       | "*" -> TagSet.star
 107       | "and" | "not" | "or" -> TagSet.singleton (Tag.tag t)
 108       | _ -> raise (Error(loc,"Invalid test name "^t ))
 109
 110   let axis_to_string a = let r = Format.str_formatter in
 111     print_axis r a; Format.flush_str_formatter()
 112 EXTEND Gram
 113
 114 GLOBAL: query;
 115
 116  query : [ [ p = path; `EOI -> p ]]
 117 ;
 118
 119  path : [
 120    [ "//" ; l = slist -> AbsoluteDoS l ]
 121  | [ "/" ; l = slist -> Absolute l ]
 122  | [ l = slist  -> Relative l ]
 123  ]
 124 ;
 125
 126 slist: [
 127   [ l = slist ;"/"; s = step -> s@l ]
 128 | [ l = slist ; "//"; s = step -> s@[(DescendantOrSelf, TagSet.node,Expr True)]@l]
 129 | [ s = step ->  s ]
 130 ];
 131
 132 step : [
 133   (* yurk, this is done to parse stuff like
 134      a/b/descendant/a where descendant is actually a tag name :(
 135      if OPT is None then this is a child::descendant if not, this is a real axis name
 136   *)
 137 [ axis = axis ; o = OPT ["::" ; t = test -> t ] ; p = top_pred  ->
 138     let a,t,p =
 139       match o with
 140         | Some(t) ->  (axis,t,p)
 141         | None -> (Child,TagSet.singleton (Tag.tag (axis_to_string axis)),p)
 142     in match a with
 143       | Following -> [ (DescendantOrSelf,t,p);
 144                        (FollowingSibling,TagSet.star,Expr(True));
 145                        (Ancestor,TagSet.star,Expr(True)) ]
 146
 147       | Preceding -> [ (DescendantOrSelf,t,p);
 148                        (PrecedingSibling,TagSet.star,Expr(True));
 149                        (Ancestor,TagSet.star,Expr(True)) ]
 150       | _ -> [ a,t,p ]
 151
 152 ]
 153
 154 | [ "." ; p = top_pred ->  [(Self,TagSet.node,p)]  ]
 155 | [ ".." ; p = top_pred ->  [(Parent,TagSet.star,p)]  ]
 156 | [ "contains"; "(" ; s = STRING ; ")";p=top_pred -> [
 157       let _ = contains := Some(s) in  (Child,TagSet.singleton Tag.pcdata, p)]
 158   ]
 159 | [ "contains_full"; "(" ; s = STRING ; ")";p=top_pred -> [
 160       let _ = contains := Some(s) in  (Descendant,TagSet.singleton Tag.pcdata, p)]
 161   ]
 162 | [ test = test; p = top_pred  -> [(Child,test, p)] ]
 163 | [ att = ATT ; p = top_pred ->
 164       match att with
 165         | "*" -> [(Attribute,TagSet.star,p)]
 166         | _ ->  [(Attribute, TagSet.singleton (Tag.tag att) ,p )]]
 167 ]
 168 ;
 169 top_pred  : [
 170   [ p = OPT [ "["; p=predicate ;"]" -> p ] -> predopt p ]
 171 ]
 172 ;
 173 axis : [
 174   [ "self" -> Self | "child" -> Child | "descendant" -> Descendant
 175       | "descendant-or-self" -> DescendantOrSelf
 176       | "ancestor-or-self" -> AncestorOrSelf
 177       | "following-sibling" -> FollowingSibling
 178       | "attribute" -> Attribute
 179       | "parent" -> Parent
 180       | "ancestor" -> Ancestor
 181       | "preceding-sibling" -> PrecedingSibling
 182       | "preceding" -> Preceding
 183       | "following" -> Following
 184   ]
 185
 186
 187 ];
 188 test : [
 189   [ s = KWD -> test_of_keyword s _loc  ]
 190 | [ t = TAG -> TagSet.singleton (Tag.tag t) ]
 191 ];
 192
 193
 194 predicate: [
 195   [ p = predicate; "or"; q = predicate -> Or(p,q) ]
 196 | [ p = predicate; "and"; q = predicate -> And(p,q) ]
 197 | [ "not" ; p = predicate -> Not p ]
 198 | [ "("; p = predicate ;")" -> p ]
 199 | [ e = expression -> Expr e ]
 200 ];
 201
 202 expression: [
 203   [ f = TAG; "("; args = LIST0 expression SEP "," ; ")" -> Function(f,args)]
 204 | [ `INT(i) -> Int (i) ]
 205 | [ s = STRING -> String s ]
 206 | [ p = path -> Path p ]
 207 | [ "("; e = expression ; ")" -> e ]
 208 ]
 209 ;
 210 END
 211 ;;
 212   let parse_string = Gram.parse_string query (Ulexer.Loc.mk "<string>")
 213   let parse = Gram.parse_string query (Ulexer.Loc.mk "<string>")
 214 end
 215
 216
 217 module Compile = struct
 218 open Ast
 219
 220 type config = { st_root : Ata.state; (* state matching the root element (initial state) *)
 221                 st_univ : Ata.state; (* universal state accepting anything *)
 222                 st_from_root : Ata.state; (* state chaining the root and the current position *)
 223                 mutable final_state : Ptset.t;
 224                 mutable has_backward: bool;
 225                 (* To store transitions *)
 226                 (* Key is the from state, (i,l) -> i the number of the step and l the list of trs *)
 227                 tr_parent_loop : (Ata.state,int*(Ata.transition list)) Hashtbl.t;
 228                 tr : (Ata.state,int*(Ata.transition list)) Hashtbl.t;
 229                 tr_aux : (Ata.state,int*(Ata.transition list)) Hashtbl.t;
 230                 mutable entry_points : (Tag.t*Ptset.t) list;
 231                 mutable  contains : string option;
 232                 mutable univ_states : Ata.state list;
 233                 mutable starstate : Ptset.t option;
 234               }
 235 let dummy_conf = { st_root = -1;
 236                    st_univ = -1;
 237                    st_from_root = -1;
 238                    final_state = Ptset.empty;
 239                    has_backward = false;
 240                    tr_parent_loop = Hashtbl.create 0;
 241                    tr = Hashtbl.create 0;
 242                    tr_aux = Hashtbl.create 0;
 243                    entry_points = [];
 244                    contains = None;
 245                    univ_states = [];
 246                    starstate = None;
 247                  }
 248
 249
 250 let _r =
 251   function (`Left|`Last) -> `Right
 252     | `Right -> `Left
 253     | `RRight -> `LLeft
 254     | `LLeft -> `RRight
 255
 256
 257 let _l =
 258   function (`Left|`Last) -> `Left
 259     | `Right -> `Right
 260     | `RRight -> `RRight
 261     | `LLeft -> `LLeft
 262
 263
 264 open Ata.Transitions
 265
 266
 267 let add_trans num htr ((q,_,_,_,_) as tr) =
 268   try
 269     let (i,ltr) = Hashtbl.find htr q in
 270       if List.exists (Ata.equal_trans tr) ltr
 271       then ()
 272       else Hashtbl.replace htr q (i,(tr::ltr))
 273   with
 274     | Not_found -> Hashtbl.add htr q (num,[tr])
 275
 276 exception Exit of Ata.state * Ata.transition list
 277 let rec replace s f =
 278   match f.Ata.pos with
 279     | Ata.Atom(_,b,q) when q = s -> if b then Ata.true_ else Ata.false_
 280     | Ata.Or(f1,f2) -> (replace s f1) +| (replace s f2)
 281     | Ata.And(f1,f2) -> (replace s f1) *& (replace s f2)
 282     | _ -> f
 283
 284
 285 let or_self conf old_dst q_src q_dst dir test pred mark =
 286   try
 287     let (num,l) = Hashtbl.find conf.tr q_src in
 288     let l2 = List.fold_left (fun acc (q,t,m,f,_) ->
 289                                (q,
 290                                 TagSet.cap t test,
 291                                 mark,
 292                                 (if mark then replace old_dst f else f)
 293                                 *& pred *&
 294                                   (if mark then Ata.true_ else (_l dir) ** q_dst),
 295                                 false)::acc)
 296       l l
 297     in Hashtbl.replace conf.tr q_src (num,l2)
 298   with  Not_found -> ()
 299
 300
 301 let nst = Ata.mk_state
 302 let att_or_str = TagSet.add Tag.pcdata TagSet.attribute
 303 let vpush x y = (x,[]) :: y
 304 let hpush x y =
 305   match y with
 306     | (z,r)::l -> (z,x::r) ::l
 307     | _ -> assert false
 308
 309 let vpop = function
 310     (x,_)::r -> x,r
 311   | _ -> assert false
 312
 313 let hpop = function
 314   | (x,z::y) ::r -> z,(x,y)::r
 315   | _-> assert false
 316
 317 let rec compile_step  ?(existential=false) conf q_src dir ctx_path nrec step num  =
 318   let ex = existential in
 319   let axis,test,pred = step  in
 320   let is_last = dir = `Last in
 321   let { st_root = q_root;
 322         st_univ = q_univ;
 323         st_from_root = q_frm_root } = conf
 324   in
 325   let q_dst = Ata.mk_state() in
 326   let p_st, p_anc, p_par, p_pre, p_num, p_f =
 327     compile_pred conf q_src num ctx_path dir pred q_dst
 328   in
 329   let new_st,new_dst, new_ctx =
 330   match axis with
 331     | Child | Descendant ->
 332         if (TagSet.is_finite test)
 333         then conf.entry_points <- (TagSet.choose test,Ptset.singleton q_src)::conf.entry_points;
 334         let left,right =
 335           if nrec then `LLeft,`RRight
 336           else `Left,`Right
 337         in
 338         let _ = if is_last && axis=Descendant && TagSet.equal test TagSet.star
 339         then conf.starstate <- Some(Ptset.singleton q_src)
 340         in
 341         let t1 = ?< q_src><(test, is_last && not(ex))>=>
 342           p_f *& ( if is_last then Ata.true_ else  (_l left) ** q_dst) in
 343
 344         let _ = add_trans num conf.tr t1 in
 345
 346
 347         let _ = if axis=Descendant then
 348           add_trans num conf.tr_aux (
 349             ?< q_src><@ ((if ex||nrec then TagSet.diff TagSet.star test
 350                           else TagSet.star),false)>=> `LLeft ** q_src )
 351         in
 352         let t3 =
 353           ?< q_src><@ ((if ex then TagSet.diff TagSet.any test
 354                         else TagSet.any), false)>=>
 355             if ex then  right ** q_src
 356             else (if axis=Descendant then `RRight else `Right) ** q_src
 357         in
 358         let _ = add_trans num conf.tr_aux t3
 359         in
 360           [q_dst], q_dst,
 361         (if axis = FollowingSibling then hpush q_src ctx_path else vpush q_src ctx_path)
 362
 363
 364     | Attribute ->
 365         let q_dstreal = Ata.mk_state() in
 366           (* attributes are always the first child *)
 367         let t1 = ?< q_src><(TagSet.attribute,false)>=>
 368           `Left ** q_dst  in
 369         let t2 = ?< q_dst><(test, is_last && not(existential))>=>
 370           if is_last then Ata.true_ else `Left ** q_dstreal in
 371         let tsa = ?< q_dst><(TagSet.star, false)>=> `Right ** q_dst
 372         in
 373           add_trans num conf.tr t1;
 374           add_trans num conf.tr_aux t2;
 375           add_trans num conf.tr_aux tsa;
 376           [q_dst;q_dstreal], q_dstreal,
 377         ctx_path
 378
 379     | Ancestor | AncestorOrSelf ->
 380         conf.has_backward <- true;
 381         let up_states, new_ctx =
 382           List.fold_left (fun acc (q,_) -> if q == q_root then acc else q::acc) [] ctx_path, (vpush q_root [])
 383         in
 384         let _ = if axis = AncestorOrSelf then
 385           or_self conf q_src (fst(vpop ctx_path)) q_dst dir test p_f (is_last && not(existential));
 386         in
 387         let fc = List.fold_left (fun f s -> ((_l dir)**s +|f)) Ata.false_ up_states
 388         in
 389         let t1 = ?< q_frm_root><(test,is_last && (not existential) )>=>
 390           ( (*if is_last then Ata.true_ else *) (`LLeft ) ** q_dst) *& fc in
 391           add_trans num conf.tr t1;
 392           [q_dst ], q_dst, vpush q_frm_root new_ctx
 393
 394     | Parent ->
 395         conf.has_backward <- true;
 396         let q_self,new_ctx =
 397           match ctx_path with
 398             | (a,_)::[] -> a, vpush q_root []
 399             | (a,_)::r -> a, r
 400             | _ -> assert false
 401         in
 402         let t1 = ?< q_frm_root>< (test,is_last && (not existential)) >=>
 403           (if is_last then Ata.true_ else (_l dir) ** q_dst) *& (_l dir) ** q_self in
 404           add_trans num conf.tr t1;
 405           [ q_dst ], q_dst,  vpush q_frm_root new_ctx
 406
 407     | _ -> assert false
 408   in
 409     (* todo change everything to Ptset *)
 410     (Ptset.elements (Ptset.union p_st (Ptset.from_list new_st)),
 411      new_dst,
 412      new_ctx)
 413 and is_rec  = function
 414     [] -> false
 415   | ((axis,_,_),_)::_ ->
 416       match axis with
 417           Descendant | Ancestor -> true
 418         | _ -> false
 419
 420 and compile_path ?(existential=false) annot_path config q_src states idx ctx_path =
 421   List.fold_left
 422     (fun (a_st,a_dst,anc_st,par_st,pre_st,ctx_path,num,has_backward,a_isrec) (step,dir) ->
 423        let add_states,new_dst,new_ctx =
 424          compile_step ~existential:existential config a_dst dir ctx_path (is_rec a_isrec) step num
 425        in
 426        let new_states = Ptset.union (Ptset.from_list add_states) a_st in
 427        let nanc_st,npar_st,npre_st,new_bw =
 428          match step with
 429            |PrecedingSibling,_,_ -> anc_st,par_st,Ptset.add a_dst pre_st,true
 430            |(Parent|Ancestor|AncestorOrSelf),_,_ -> Ptset.add a_dst anc_st,par_st,pre_st,true
 431            | _ -> anc_st,par_st,pre_st,has_backward
 432        in
 433          new_states,new_dst,nanc_st,npar_st,npre_st,new_ctx, num+1,new_bw,(match a_isrec with [] -> [] | _::r -> r)
 434     )
 435     (states, q_src, Ptset.empty,Ptset.empty,Ptset.empty, ctx_path,idx, false,(List.tl annot_path) )
 436     annot_path
 437
 438 and binop_ conf q_src idx ctx_path dir pred p1 p2 f ddst =
 439   let a_st1,anc_st1,par_st1,pre_st1,idx1,f1 =
 440     compile_pred conf q_src idx ctx_path dir p1 ddst in
 441   let a_st2,anc_st2,par_st2,pre_st2,idx2,f2 =
 442     compile_pred conf q_src idx1 ctx_path dir p2 ddst
 443   in
 444         Ptset.union a_st1 a_st2,
 445         Ptset.union anc_st1 anc_st2,
 446         Ptset.union par_st1 par_st2,
 447         Ptset.union pre_st1 pre_st2,
 448         idx2, (f f1 f2)
 449
 450 and compile_pred conf q_src idx ctx_path dir pred qdst =
 451   match pred with
 452     | Or(p1,p2) ->
 453         binop_ conf q_src idx ctx_path dir pred p1 p2 (( +| )) qdst
 454     | And(p1,p2) ->
 455         binop_ conf q_src idx ctx_path dir pred p1 p2 (( *& )) qdst
 456     | Expr e -> compile_expr conf Ptset.empty q_src idx ctx_path dir e qdst
 457     | Not(p) ->
 458         let a_st,anc_st,par_st,pre_st,idx,f =
 459           compile_pred conf q_src idx ctx_path dir p qdst
 460         in a_st,anc_st,par_st,pre_st,idx, Ata.not_ f
 461
 462 and compile_expr conf states q_src idx ctx_path dir e qdst =
 463   match e with
 464     | Path (p) ->
 465         let q = Ata.mk_state () in
 466         let annot_path = match p with Relative(r) -> dirannot (List.rev r) | _ -> assert false in
 467         let a_st,a_dst,anc_st,par_st,pre_st,_,idx,has_backward,_ =
 468             compile_path ~existential:true annot_path conf q states idx ctx_path
 469         in
 470         let ret_dir = match annot_path with
 471           | ((FollowingSibling,_,_),_)::_ -> `Right
 472           | _ -> `Left
 473         in
 474         let _ = match annot_path with
 475           | (((Parent|Ancestor|AncestorOrSelf),_,_),_)::_ -> conf.final_state <- Ptset.add qdst conf.final_state
 476           | _ -> ()
 477         in let _ = conf.univ_states <- a_dst::conf.univ_states in
 478           (a_st,anc_st,par_st,pre_st,idx, ((ret_dir) ** q))
 479     | True -> states,Ptset.empty,Ptset.empty,Ptset.empty,idx,Ata.true_
 480     | False -> states,Ptset.empty,Ptset.empty,Ptset.empty,idx,Ata.false_
 481     | _ -> assert false
 482
 483
 484 and dirannot = function
 485     [] -> []
 486   | [p]  -> [p,`Last]
 487   | p::(((FollowingSibling),_,_)::_ as l) -> (p,`Right)::(dirannot l)
 488   | p::l -> (p,`Left) :: (dirannot l)
 489
 490 let compile path =
 491   let steps =
 492   match path with
 493     | Absolute(steps)
 494     | Relative(steps) -> steps
 495     | AbsoluteDoS(steps) -> steps@[(DescendantOrSelf,TagSet.node,Expr(True))]
 496   in
 497         let steps = List.rev steps in
 498         let dirsteps = dirannot steps in
 499         let _ = Ata.mk_state() in
 500         let config = { st_root = Ata.mk_state();
 501                        st_univ = Ata.mk_state();
 502                        final_state = Ptset.empty;
 503                        st_from_root =  Ata.mk_state();
 504                        has_backward = false;
 505                        tr_parent_loop = Hashtbl.create 5;
 506                        tr = Hashtbl.create 5;
 507                        tr_aux =  Hashtbl.create 5;
 508                        entry_points = [];
 509                        contains = None;
 510                        univ_states = [];
 511                        starstate = None;
 512                      }
 513         in
 514         let q0 = Ata.mk_state() in
 515         let states = Ptset.from_list [config.st_univ;config.st_root]
 516         in
 517         let num = 0 in
 518         (* add_trans num config.tr_aux (mk_star config.st_from_root `Left config.st_univ config.st_from_root);
 519              add_trans num config.tr_aux (mk_star config.st_from_root `Left config.st_from_root config.st_univ);
 520              add_trans num config.tr_aux (mk_step config.st_no_nil (TagSet.add Tag.pcdata TagSet.star) `Left config.st_univ config.st_univ);
 521           *)
 522           let a_st,a_dst,anc_st,par_st,pre_st,_,_,has_backward,_ =
 523             compile_path dirsteps config q0 states 0 [(config.st_root,[]) ]
 524           in
 525           let fst_tr =
 526             ?< (config.st_root) >< (TagSet.singleton (Tag.tag ""),false) >=>
 527               ((if is_rec dirsteps then `LLeft else `Left)** q0) *& (if config.has_backward then `LLeft ** config.st_from_root else Ata.true_)
 528           in
 529             add_trans num config.tr fst_tr;
 530             if config.has_backward then begin
 531               add_trans num config.tr_aux
 532                 (?< (config.st_from_root) >< (TagSet.star,false) >=> `LLeft ** config.st_from_root);
 533               add_trans num config.tr_aux
 534                 (?< (config.st_from_root) >< (TagSet.any,false) >=>
 535                      `RRight ** config.st_from_root);
 536
 537             end;
 538           let phi = Hashtbl.create 37 in
 539           let fadd = fun _ (_,l) -> List.iter (fun (s,t,m,f,p) ->
 540                                                  let lt = try
 541                                                    Hashtbl.find phi s
 542                                                      with Not_found -> []
 543                                                  in
 544                                                    Hashtbl.replace phi s ((t,(m,f,p))::lt)
 545                                               ) l in
 546             Hashtbl.iter (fadd) config.tr;
 547             Hashtbl.iter (fadd) config.tr_aux;
 548             Hashtbl.iter (fadd) config.tr_parent_loop;
 549             let final =
 550               let s = Ptset.union anc_st (Ptset.from_list [])
 551               in if has_backward then Ptset.add config.st_from_root s else s
 552             in { Ata.id = Oo.id (object end);
 553                  Ata.states = Hashtbl.fold (fun q _ acc -> Ptset.add q acc) phi Ptset.empty;
 554                  Ata.init = Ptset.singleton config.st_root;
 555                  Ata.final = Ptset.union anc_st config.final_state;
 556                  Ata.universal = Ptset.add a_dst (Ptset.from_list config.univ_states);
 557                  Ata.phi = phi;
 558                  Ata.sigma = Hashtbl.create 17;
 559                  Ata.starstate = config.starstate;
 560                },config.entry_points,!contains
 561
 562
 563 end