- let get_trans t a tag r =
- try
- HTagSet.find a.sigma (r,tag)
- with
- Not_found ->
- let fl,mark,_,_,accq =
- Ptset.fold (fun q (accf,accm,acchtrue,acchash,accq) ->
- let naccf,naccm,nacctrue,acchash =
- merge_trans t a tag q (accf,accm,acchtrue,acchash )
- in
- (* if is_false naccf then (naccf,naccm,nacctrue,accq)
- else *) (naccf,naccm,nacctrue,acchash,Ptset.add q accq)
- )
- 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 }
- in
- HTagSet.add a.sigma (accq,tag) (dispatch,mark,fl,llls,rrrs);
- dispatch,mark,fl,llls,rrrs
-