- Nil -> "Nil"
- | Text (i,j) -> Printf.sprintf "Text (%i, %i)" i j
- | Node (i) -> Printf.sprintf "Node (%i)" 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(t) -> (int_of_node t) == 0
- | _ -> false
-
-let parent n =
- let node' =
- match n.node with (* inlined parent *)
- | Node(t) when (int_of_node t)== 0 -> Nil
- | Node(t) ->
- let txt = tree_prev_text n.doc t in
- if text_is_empty n.doc txt then
- let ps = tree_prev_sibling n.doc t in
- if tree_is_nil ps
- then
- Node(tree_parent n.doc t)
- else Node(ps)
- else
- Text(txt,t)
- | Text(i,t) ->
- let ps = tree_prev_doc n.doc i in
- if tree_is_nil ps
- then Node (tree_parent_doc n.doc i)
- else Node(ps)
- | _ -> failwith "parent"
- in
- { n with node = node' }
-
-let node_child n =
- match n.node with
- | Node i -> { n with node= norm(tree_first_child n.doc i) }
- | _ -> { n with node = Nil }
-
-let node_sibling n =
- match n.node with
- | Node i -> { n with node= norm(tree_next_sibling n.doc i) }
- | _ -> { n with node = Nil }
-
-let node_sibling_ctx n _ =
- match n.node with
- | Node i -> { n with node= norm(tree_next_sibling n.doc i) }
- | _ -> { n with node = Nil }
-
-
-let first_child n =
- let node' =
- match n.node with
- | Node (t) ->
- let fs = tree_first_child n.doc t in
- if equal_node nil fs
- then
- let txt = tree_my_text n.doc t in
- if equal_node nil txt
- then Nil
- else Text(txt,nil)
- else
- let txt = tree_prev_text n.doc fs in
- if equal_node nil txt
- then Node(fs)
- else Text(txt, fs)
- | Text(_,_) -> Nil
- | Nil -> failwith "first_child"
- in
- { n with node = node'}
-
-let next_sibling n =
- let node' =
- match n.node with
- | Text (_,ns) -> norm ns
- | Node(t) ->
- let ns = tree_next_sibling n.doc t in
- let txt = tree_next_text n.doc t in
- if equal_node nil txt
- then norm ns
- else Text(txt, ns)
- | Nil -> failwith "next_sibling"
- in
- { n with node = node'}
-
-let next_sibling_ctx n _ = next_sibling n
-
-let left = first_child
-let right = next_sibling
-
-let id t =
- match t.node with
- | Node(n) -> tree_node_xml_id t.doc n
- | Text(i,_) -> tree_text_xml_id t.doc i
- | _ -> -1
-
-let tag t =
- match t.node with
- | Text(_) -> Tag.pcdata
- | Node(n) -> tree_tag_id t.doc 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 select_next tb tf t s =
- match s.node with
- | Node (below) -> begin
- match t.node with
- | Node( n) ->
- { t with node = norm (tree_select_next t.doc n (Ptset.to_int_vector tb) (Ptset.to_int_vector tf) below) }
- | Text (i,n) when equal_node nil n ->
- let p = tree_parent_doc t.doc i in
- { t with node = norm (tree_select_next t.doc p (Ptset.to_int_vector tb) (Ptset.to_int_vector tf) below) }
- | Text(_,n) ->
- if Ptset.mem (tree_tag_id t.doc n) (Ptset.union tb tf)
- then { t with node=Node(n) }
- else
- let vb = Ptset.to_int_vector tb in
- let vf = Ptset.to_int_vector tf in
- let node =
- let dsc = tree_select_below t.doc n vb vf in
- if equal_node nil dsc
- then tree_select_next t.doc n vb vf below
- else dsc
- in
- { t with node = norm node }
- | _ -> {t with node = Nil }
- end
-
- | _ -> { t with node = Nil }
-
-
-
-
- let select_foll_only tf t s =
- match s.node with
- | Node (below) ->
- begin
- match t.node with
- | Node(n) ->
- { t with node= norm (tree_select_foll_only t.doc n (Ptset.to_int_vector tf) below) }
- | Text(i,n) when equal_node nil n ->
- let p = tree_parent_doc t.doc i in
- { t with node= norm (tree_select_foll_only t.doc p (Ptset.to_int_vector tf) below) }
- | Text(_,n) ->
- if Ptset.mem (tree_tag_id t.doc n) tf
- then { t with node=Node(n) }
- else
- let vf = Ptset.to_int_vector tf in
- let node =
- let dsc = tree_select_desc_only t.doc n vf in
- if tree_is_nil dsc
- then tree_select_foll_only t.doc n vf below
- else dsc
- in
- { t with node = norm node }
- | _ -> { t with node = Nil }
- end
- | _ -> {t with node=Nil }
-
-let select_below tc td t=
- match t.node with
- | Node( n) ->
- let vc = Ptset.to_int_vector tc
- in
- let vd = Ptset.to_int_vector td
- in
- { t with node= norm(tree_select_below t.doc n vc vd) }
- | _ -> { t with node=Nil }
-
-
-let select_desc_only td t =
- match t.node with
- | Node(n) ->
- let vd = Ptset.to_int_vector td
- in
- { t with node = norm(tree_select_desc_only t.doc n vd) }
- | _ -> { t with node = Nil }
-
-
-let tagged_desc tag t =
- match t.node with
- | Node(n) ->
- { t with node = norm(tree_tagged_desc t.doc n tag) }
- | _ -> { t with node = Nil }
-
-
-let tagged_foll_below tag t s =
- match s.node with
- | Node (below) ->
- begin
- match t.node with
- | Node(n) ->
- { t with node= norm (tree_tagged_foll_below t.doc n tag below) }
- | Text(i,n) when equal_node nil n ->
- let p = tree_prev_doc t.doc i in
- { t with node= norm (tree_tagged_foll_below t.doc p tag below) }
- | Text(_,n) ->
- if (tree_tag_id t.doc n) == tag
- then { t with node=Node(n) }
- else
- let node =
- let dsc = tree_tagged_desc t.doc n tag in
- if tree_is_nil dsc
- then tree_tagged_foll_below t.doc n tag below
- else dsc
- in
- { t with node = norm node }
- | _ -> { t with node = Nil }
- end
- | _ -> {t with node=Nil }
+ -1 -> "Nil"
+ | i -> Printf.sprintf "Node (%i)" i
+
+let dump_node t = nts (inode t)
+
+let is_left t n = tree_is_first_child t.doc n
+
+
+
+let is_below_right t n1 n2 =
+ tree_is_ancestor t.doc (tree_parent t.doc n1) n2
+ && not (tree_is_ancestor t.doc n1 n2)
+
+let is_binary_ancestor t n1 n2 =
+ let p = tree_parent t.doc n1 in
+ let fin = tree_closing t.doc p in
+ n2 > n1 && n2 < fin
+(* (is_below_right t n1 n2) ||
+ (tree_is_ancestor t.doc n1 n2) *)
+
+let parent t n = tree_parent t.doc n
+
+let first_child t = let doc = t.doc in ();fun n -> tree_first_child doc n
+let first_element t = let doc = t.doc in (); fun n -> tree_first_element doc n
+let first_element t n = tree_first_element t.doc n
+(* these function will be called in two times: first partial application
+ on the tag, then application of the tag and the tree, then application of
+ the other arguments. We use the trick to let the compiler optimize application
+*)
+
+let tagged_child t tag = () ; fun n -> tree_tagged_child t.doc n tag
+
+let select_child t = fun ts ->
+ let v = ptset_to_vector ts in ();
+ fun n -> tree_select_child t.doc n v
+
+let next_sibling t = let doc = t.doc in (); fun n -> tree_next_sibling doc n
+let next_element t = let doc = t.doc in (); fun n -> tree_next_element doc n
+let next_element t n = tree_next_element t.doc n
+
+let tagged_following_sibling t tag = (); fun n -> tree_tagged_following_sibling t.doc n tag