- let string t = match t.node with
- | String i -> Text.get_text t.doc i
- | _ -> assert false
-
- let norm (n : [`Tree ] node ) = if is_nil n then Nil else Node (NC n)
-
- let descr t = t.node
-
- let nts = function
- Nil -> "Nil"
- | String i -> Printf.sprintf "String %i" i
- | Node (NC t) -> Printf.sprintf "Node (NC %i)" (int_of_node t)
- | Node (SC (t,i)) -> Printf.sprintf "Node (SC (%i,%i))" (int_of_node t) (int_of_node i)
-
- let mk_nil t = { t with node = Nil }
- let root n = { n with node = norm (Tree.root n.doc) }
- let is_root n = match n.node with
- | Node(NC t) -> (int_of_node t) == 0
- | _ -> false
-
- let parent n =
- if is_root n then { n with node=Nil}
- else
- let node' =
- match n.node with
- | Node(NC t) ->
- let txt = prev_text n.doc t in
- if Text.is_empty n.doc txt then
- let ps = Tree.prev_sibling n.doc t in
- if is_nil ps
- then
- Node(NC (Tree.parent n.doc t))
- else Node(NC ps)
- else
- Node(SC (txt,t))
- | Node(SC(i,t)) ->
- let ps = Tree.prev_sibling n.doc t in
- if is_nil ps
- then Node (NC(parent_doc n.doc i))
- else Node(NC ps)
- | _ -> failwith "parent"
- in
- { n with node = node' }
-
- let first_child n =
- let node' =
- match n.node with
- | Node (NC t) when is_leaf n.doc t ->
- let txt = my_text n.doc t in
- if Text.is_empty n.doc txt
- then Nil
- else Node(SC (txt,Tree.nil))
- | Node (NC t) ->
- let fs = first_child n.doc t in
- let txt = prev_text n.doc fs in
- if Text.is_empty n.doc txt
- then norm fs
- else Node (SC (txt, fs))
- | Node(SC (i,_)) -> String i
- | Nil | String _ -> failwith "first_child"
- in
- { n with node = node'}
-
- let next_sibling n =
- let node' =
- match n.node with
- | Node (SC (_,ns)) -> norm ns
- | Node(NC t) ->
- let ns = next_sibling n.doc t in
- let txt = next_text n.doc t in
- if Text.is_empty n.doc txt
- then norm ns
- else Node (SC (txt, ns))
- | Nil | String _ -> failwith "next_sibling"
- in
- { n with node = node'}
-
-
- let left = first_child
- let right = next_sibling
-
- 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 }
-