X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=xPath.ml;h=3fbfacf8718f6acfaed79dbba855a9b16add0f98;hb=f98a8d98d86941a885f492d5cc134e34989c198a;hp=de9c0567fd5b7a5c3262205f3f70543985fc15fd;hpb=dc91851aaeac91a71eba2c266d0227adea0c5815;p=SXSI%2Fxpathcomp.git diff --git a/xPath.ml b/xPath.ml index de9c056..3fbfacf 100644 --- a/xPath.ml +++ b/xPath.ml @@ -229,6 +229,8 @@ type config = { st_root : Ata.state; (* state matching the root element (initial tr_aux : (Ata.state,int*(Ata.transition list)) Hashtbl.t; mutable entry_points : (Tag.t*Ptset.t) list; mutable contains : string option; + mutable univ_states : Ata.state list; + mutable starstate : Ptset.t option; } let dummy_conf = { st_root = -1; st_univ = -1; @@ -240,6 +242,8 @@ let dummy_conf = { st_root = -1; tr_aux = Hashtbl.create 0; entry_points = []; contains = None; + univ_states = []; + starstate = None; } @@ -288,7 +292,7 @@ let or_self conf old_dst q_src q_dst dir test pred mark = (if mark then replace old_dst f else f) *& pred *& (if mark then Ata.true_ else (_l dir) ** q_dst), - `True)::acc) + false)::acc) l l in Hashtbl.replace conf.tr q_src (num,l2) with Not_found -> () @@ -324,15 +328,18 @@ let rec compile_step ?(existential=false) conf q_src dir ctx_path nrec step num in let new_st,new_dst, new_ctx = match axis with - | Child | Descendant -> + if (TagSet.is_finite test) + then conf.entry_points <- (TagSet.choose test,Ptset.singleton q_src)::conf.entry_points; let left,right = if nrec then `LLeft,`RRight else `Left,`Right in - + let _ = if is_last && axis=Descendant && TagSet.equal test TagSet.star + then conf.starstate <- Some(Ptset.singleton q_src) + in let t1 = ?< q_src><(test, is_last && not(ex))>=> - p_f *& ( if false (*is_last*) then Ata.true_ else (_l left) ** q_dst) in + p_f *& ( if is_last then Ata.true_ else (_l left) ** q_dst) in let _ = add_trans num conf.tr t1 in @@ -340,13 +347,12 @@ let rec compile_step ?(existential=false) conf q_src dir ctx_path nrec step num let _ = if axis=Descendant then add_trans num conf.tr_aux ( ?< q_src><@ ((if ex||nrec then TagSet.diff TagSet.star test - else TagSet.star),false, - `True )>=> `LLeft ** q_src ) + else TagSet.star),false)>=> `LLeft ** q_src ) in let t3 = ?< q_src><@ ((if ex then TagSet.diff TagSet.any test - else TagSet.any), false, `True )>=> - if ex then ( Ata.atom_ `Left false q_src) *& right ** q_src + else TagSet.any), false)>=> + if ex then right ** q_src else (if axis=Descendant then `RRight else `Right) ** q_src in let _ = add_trans num conf.tr_aux t3 @@ -468,7 +474,7 @@ and compile_expr conf states q_src idx ctx_path dir e qdst = let _ = match annot_path with | (((Parent|Ancestor|AncestorOrSelf),_,_),_)::_ -> conf.final_state <- Ptset.add qdst conf.final_state | _ -> () - in + in let _ = conf.univ_states <- a_dst::conf.univ_states in (a_st,anc_st,par_st,pre_st,idx, ((ret_dir) ** q)) | True -> states,Ptset.empty,Ptset.empty,Ptset.empty,idx,Ata.true_ | False -> states,Ptset.empty,Ptset.empty,Ptset.empty,idx,Ata.false_ @@ -500,7 +506,9 @@ let compile path = tr = Hashtbl.create 5; tr_aux = Hashtbl.create 5; entry_points = []; - contains = None + contains = None; + univ_states = []; + starstate = None; } in let q0 = Ata.mk_state() in @@ -542,13 +550,13 @@ let compile path = let s = Ptset.union anc_st (Ptset.from_list []) in if has_backward then Ptset.add config.st_from_root s else s in { Ata.id = Oo.id (object end); - Ata.states = if has_backward then Ptset.add config.st_from_root a_st else a_st; + Ata.states = Hashtbl.fold (fun q _ acc -> Ptset.add q acc) phi Ptset.empty; Ata.init = Ptset.singleton config.st_root; Ata.final = Ptset.union anc_st config.final_state; - Ata.universal = Ptset.singleton a_dst; + Ata.universal = Ptset.add a_dst (Ptset.from_list config.univ_states); Ata.phi = phi; - Ata.delta = Hashtbl.create 17; - Ata.sigma = Ata.HTagSet.create 17; + Ata.sigma = Hashtbl.create 17; + Ata.starstate = config.starstate; },config.entry_points,!contains