+ r (Nil,false,false,17,Ptset.empty)
+ in
+ let (ls,lls,llls),(rs,rrs,rrrs) =
+ form_list_fold_left (fun ((a1,b1,c1),(a2,b2,c2)) _ f _ ->
+ let (x1,y1,z1),(x2,y2,z2) = f.st in
+ ((Ptset.union x1 a1),(Ptset.union y1 b1),(Ptset.union c1 z1)),
+ ((Ptset.union x2 a2),(Ptset.union y2 b2),(Ptset.union c2 z2)))
+ ((Ptset.empty,Ptset.empty,Ptset.empty),
+ (Ptset.empty,Ptset.empty,Ptset.empty))
+ fl
+ in
+ let tb,ta =
+ Tree.tags t tag
+ in
+ let tl,htlt,lfin = inter_text tb (tags a ls)
+ and tll,htllt,llfin = inter_text tb (tags a lls)
+ and tr,htrt,rfin = inter_text ta (tags a rs)
+ and trr,htrrt,rrfin = inter_text ta (tags a rrs)
+ in(*
+ let _ =
+ Format.fprintf Format.err_formatter "Tag %s, right_states " (Tag.to_string tag);
+ pr_st Format.err_formatter (Ptset.elements rs);
+ Format.fprintf Format.err_formatter " tags = ";
+ Ptset.iter (fun t -> Format.fprintf Format.err_formatter "%s "
+ (Tag.to_string t)) tr;
+ Format.fprintf Format.err_formatter ", next_states ";
+ pr_st Format.err_formatter (Ptset.elements rrs);
+ Format.fprintf Format.err_formatter " tags = ";
+ Ptset.iter (fun t -> Format.fprintf Format.err_formatter "%s "
+ (Tag.to_string t)) trr;
+ Format.fprintf Format.err_formatter "\n%!";
+
+ in*)
+ let first,flabel =
+ if (llfin && lfin) then (* no stars *)
+ (if htlt || htllt then (Tree.text_below, "#text_below")
+ else
+ let etl = Ptset.is_empty tl
+ and etll = Ptset.is_empty tll
+ in
+ if (etl && etll)
+ then (Tree.mk_nil, "#mk_nil")
+ else
+ if etl then
+ if Ptset.is_singleton tll
+ then (Tree.tagged_desc (Ptset.choose tll), "#tagged_desc")
+ else (Tree.select_desc_only tll, "#select_desc_only")
+ else if etll then (Tree.node_child,"#node_child")
+ else (Tree.select_below tl tll,"#select_below"))
+ else (* stars or node() *)
+ if htlt||htllt then (Tree.first_child,"#first_child")
+ else (Tree.node_child,"#node_child")
+ and next,nlabel =
+ if (rrfin && rfin) then (* no stars *)
+ ( if htrt || htrrt
+ then (Tree.text_next, "#text_next")
+ else
+ let etr = Ptset.is_empty tr
+ and etrr = Ptset.is_empty trr
+ in
+ if etr && etrr
+ then (mk_nil_ctx, "#mk_nil_ctx")
+ else
+ if etr then
+ if Ptset.is_singleton trr
+ then (Tree.tagged_foll_below (Ptset.choose trr),"#tagged_foll_below")
+ else (Tree.select_foll_only trr,"#select_foll_only")
+ else if etrr then (Tree.node_sibling_ctx,"#node_sibling_ctx")
+ else
+ (Tree.select_next tr trr,"#select_next") )
+
+ else if htrt || htrrt then (Tree.next_sibling_ctx,"#next_sibling_ctx")
+ else (Tree.node_sibling_ctx,"#node_sibling_ctx")
+ in
+ let dispatch = { first = first; flabel = flabel; next = next; nlabel = nlabel;
+ consres = if mark then cons_res else cat_res }