-(*
- module Algebra =
- struct
- type jump = [ `LONG | `CLOSE | `NIL ]
- type t = jump*Ptset.Int.t
-
- let merge_jump (j1,l1) (j2,l2) =
- match j1,j2 with
- | _ when j1 = j2 -> (j1,Ptset.Int.union l1 l2)
- | _,`NIL -> j1,l1
- | `NIL,_ -> j2,l2
- | _,_ -> (`CLOSE, Ptset.Int.union l1 l2)
-
- let merge_jump_list = function
- | [] -> `NIL,Ptset.Int.empty
- | p::r -> List.fold_left (merge_jump) p r
-
- let labels a s =
- Hashtbl.fold
- (
- fun q l acc ->
- if (q == s)
- then
-
- (List.fold_left
- (fun acc (ts,f) ->
- let _,_,_,bur = Transition.node f in
- if bur then acc else TagSet.cup acc ts)
- acc l)
- else acc ) a.trans TagSet.empty
- exception Found
-
- let is_rec a s access =
- List.exists
- (fun (_,t) -> let _,_,f,_ = Transition.node t in
- StateSet.mem s (access f)) (Hashtbl.find a.trans s)
-
-
- let decide a c_label l_label dir_states access =
-
- let l = StateSet.fold
- (fun s l ->
- let s_rec= is_rec a s access in
- let tlabels,jmp =
- if s_rec then l_label,`LONG
- else c_label,`CLOSE in
- let slabels = TagSet.positive ((TagSet.cap (labels a s) tlabels))
- in
- (if Ptset.Int.is_empty slabels
- then `NIL,Ptset.Int.empty
- else jmp,slabels)::l) dir_states []
- in merge_jump_list l
-
-
-
-
-
- end
-
-
- let choose_jump tagset qtags1 qtagsn a f_nil f_t1 f_s1 f_tn f_sn f_notext f_maytext =
- let tags1,hastext1,fin1 = inter_text tagset (tags a qtags1) in
- let tagsn,hastextn,finn = inter_text tagset (tags a qtagsn) in
- (*if (hastext1||hastextn) then (`ANY,f_text) (* jumping to text nodes doesn't work really well *)
- else*)
- if (Ptset.Int.is_empty tags1) && (Ptset.Int.is_empty tagsn) then (`NIL,f_nil)
- else if (Ptset.Int.is_empty tagsn) then
- if (Ptset.Int.is_singleton tags1)
- then (* TaggedChild/Sibling *)
- let tag = (Ptset.Int.choose tags1) in (`TAG(tag),mk_app_fun f_t1 tag (Tag.to_string tag))
- else (* SelectChild/Sibling *)
- (`ANY,mk_app_fun f_s1 tags1 (string_of_ts tags1))
- else if (Ptset.Int.is_empty tags1) then
- if (Ptset.Int.is_singleton tagsn)
- then (* TaggedDesc/Following *)
- let tag = (Ptset.Int.choose tagsn) in (`TAG(tag),mk_app_fun f_tn tag (Tag.to_string tag))
- else (* SelectDesc/Following *)
- (`ANY,mk_app_fun f_sn tagsn (string_of_ts tagsn))
- else if (hastext1||hastextn) then (`ANY,f_maytext)
- else (`ANY,f_notext)
-
- let choose_jump_down tree a b c d =
- choose_jump a b c d
- (mk_fun (fun _ -> Tree.nil) "Tree.mk_nil")
- (mk_fun (Tree.tagged_child tree) "Tree.tagged_child")
- (mk_fun (Tree.select_child tree) "Tree.select_child")
- (mk_fun (Tree.tagged_desc tree) "Tree.tagged_desc")
- (mk_fun (Tree.select_desc tree) "Tree.select_desc")
- (mk_fun (Tree.first_element tree) "Tree.first_element")
- (mk_fun (Tree.first_child tree) "Tree.first_child")
-
- let choose_jump_next tree a b c d =
- choose_jump a b c d
- (mk_fun (fun _ _ -> Tree.nil) "Tree.mk_nil2")
- (mk_fun (Tree.tagged_sibling_ctx tree) "Tree.tagged_sibling_ctx")
- (mk_fun (Tree.select_sibling_ctx tree) "Tree.select_sibling_ctx")
- (mk_fun (Tree.tagged_foll_ctx tree) "Tree.tagged_foll_ctx")
- (mk_fun (Tree.select_foll_ctx tree) "Tree.select_foll_ctx")
- (mk_fun (Tree.next_element_ctx tree) "Tree.node_element_ctx")
- (mk_fun (Tree.next_sibling_ctx tree) "Tree.node_sibling_ctx")
-*)