- let id =
- function { doc=d; node=Node(NC n)} -> node_xml_id d n
- | { doc=d; node=Node(SC (i,_) )} -> text_xml_id d i
- | _ -> -1 (*
- Format.fprintf Format.err_formatter "Failure id on %s\n%!" (nts x.node);
- failwith "id" *)
-
- let tag =
- function { node=Node(SC _) } -> Tag.pcdata
- | { doc=d; node=Node(NC n)} -> tag_id d n
- | _ -> failwith "tag"
-
- let string_below t id =
- let strid = parent_doc t.doc id in
- match t.node with
- | Node(NC(i)) ->
- (Tree.equal i strid) || (is_ancestor t.doc i strid)
- | Node(SC(i,_)) -> Text.equal i id
- | _ -> false
-
-
- let tagged_foll t tag =
- if tag = Tag.attribute || tag = Tag.pcdata then failwith "tagged_foll"
- else match t with
- | { doc=d; node=Node(NC n) } -> { t with node = norm (tagged_foll d n tag) }
- | { doc=d; node=Node(SC (_,n)) } when is_nil n -> { t with node= Nil }
- | { doc=d; node=Node(SC (_,n)) } ->
- let nnode =
- if tag_id d n == tag then n
- else
- let n' = tagged_desc d n tag in
- if is_nil n' then tagged_foll d n tag
- else n'
- in {t with node= norm nnode}
- | _ -> { t with node=Nil }
-
-
- let tagged_desc t tag =
- if tag = Tag.attribute || tag = Tag.pcdata then failwith "tagged_desc"
- else match t with
- | { doc=d; node=Node(NC n) } -> { t with node = norm (tagged_desc d n tag) }
- | _ -> { t with node=Nil }
-
-
- let tagged_next t tb tf s =
- match s with
- | { node = Node (NC(below)) } -> begin
- match t with
- | { doc = d; node=Node(NC n) } ->
- { t with node= norm (tagged_next d n (Ptset.to_int_vector tb) (Ptset.to_int_vector tf) below) }
- | { doc = d; node=Node(SC (i,n) ) } when is_nil n ->
- let p = parent_doc d i in
- { t with node= norm (tagged_next d p (Ptset.to_int_vector tb) (Ptset.to_int_vector tf) below) }
- | { doc = d; node=Node(SC (_,n) ) } ->
- if Ptset.mem (tag_id d n) (Ptset.union tb tf)
- then { t with node=Node(NC(n)) }
- else
- let vb = Ptset.to_int_vector tb in
- let vf = Ptset.to_int_vector tf in
- let node =
- let dsc = tagged_below d n vb vf in
- if is_nil dsc
- then tagged_next d n vb vf below
- else dsc
- in
- { t with node = norm node }
- | _ -> {t with node=Nil }
- end
-
- | _ -> {t with node=Nil }
-
- let tagged_foll_only t tf s =
- match s with
- | { node = Node (NC(below)) } -> begin
- match t with
- | { doc = d; node=Node(NC n) } ->
- { t with node= norm (tagged_foll_only d n (Ptset.to_int_vector tf) below) }
- | { doc = d; node=Node(SC (i,n) ) } when is_nil n ->
- let p = parent_doc d i in
- { t with node= norm (tagged_foll_only d p (Ptset.to_int_vector tf) below) }
- | { doc = d; node=Node(SC (_,n) ) } ->
- if Ptset.mem (tag_id d n) tf
- then { t with node=Node(NC(n)) }
- else
- let vf = Ptset.to_int_vector tf in
- let node =
- let dsc = tagged_desc_only d n vf in
- if is_nil dsc
- then tagged_foll_only d n vf below
- else dsc
- in
- { t with node = norm node }
- | _ -> {t with node=Nil }
- end
-
- | _ -> {t with node=Nil }
-
-
- let tagged_below t tc td =
- match t with
- | { doc = d; node=Node(NC n) } ->
- let vc = Ptset.to_int_vector tc
- in
- let vd = Ptset.to_int_vector td
- in
- { t with node= norm(tagged_below d n vc vd) }
- | _ -> { t with node=Nil }
-
- let tagged_desc_only t td =
- match t with
- | { doc = d; node=Node(NC n) } ->
- let vd = Ptset.to_int_vector td
- in
- { t with node= norm(tagged_desc_only d n vd) }
- | _ -> { t with node=Nil }
-
-
- let last_idx = ref 0
- let array_find a i j =
- let l = Array.length a in
- let rec loop idx x y =
- if x > y || idx >= l then Text.nil
- else
- if a.(idx) >= x then if a.(idx) > y then Text.nil else (last_idx := idx;a.(idx))
- else loop (idx+1) x y
- in
- if a.(0) > j || a.(l-1) < i then Text.nil
- else loop !last_idx i j
-
-
- let text_below t =
- let l = Array.length !contains_array in
- if l = 0 then { t with node=Nil }
- else
- match t with
- | { doc = d; node=Node(NC n) } ->
- let i,j = doc_ids t.doc n in
- let id = array_find !contains_array i j
- in
- if id == Text.nil then
- { t with node=Nil }
- else
- {t with node = Node(SC(id, Tree.next_sibling d (Tree.prev_doc d id))) }
- | _ -> { t with node=Nil }
-
- let text_next t root =
- let l = Array.length !contains_array in
- if l = 0 then { t with node=Nil }
- else
- let inf = match t with
- | { doc =d; node = Node(NC n) } -> snd(doc_ids d n)+1
- | { node = Node(SC(i,_)) } -> i+1
- | _ -> assert false
- in
- match root with
- | { doc = d; node= Node (NC n) } ->
- let _,j = doc_ids t.doc n in
-
- let id = array_find !contains_array inf j
- in
- if id == Text.nil then { doc = d; node= Nil }
- else
- {doc = d; node = Node(SC(id,Tree.next_sibling d (Tree.prev_doc d id))) }
- | _ -> { t with node=Nil}
-
-
-
- let subtree_tags t tag =
- match t with
- { doc = d; node = Node(NC n) } ->
- subtree_tags d n tag
- | _ -> 0
-
- let tagged_desc_array = ref [| |]
- let idx = ref 0
-
- let init_tagged_next t tagid =
- let l = subtree_tags (root t) tagid
- in
- tagged_desc_array := Array.create l { t with node= Nil };
- let i = ref 0 in
- let rec collect t =
- if is_node t then begin
- if tag t == tagid then
- begin
- !tagged_desc_array.(!i) <- t;
- incr i;
- end;
- collect (first_child t);
- collect (next_sibling t)
- end;
- in
- collect t;
- idx := 0
-
- let print_id ppf v =
- let pr x= Format.fprintf ppf x in
- match v with
- { node=Nil } -> pr "NULLT: -1"
- | { node=String(i) } | { node=Node(SC(i,_)) } -> pr "DocID: %i" (int_of_node i)
- | { node=Node(NC(i)) } -> pr "Node: %i" (int_of_node i)
-
-
-
-(* let tagged_next t tag =
- if !idx >= Array.length !tagged_desc_array
- then {t with node=Nil}
- else
- let r = !tagged_desc_array.(!idx)
- in
- incr idx; r
-*)