type table = int array
type t = {
table : table;
- kind : Bytes.t;
+ summary : Bytes.t;
tags : QName.t array;
data : string array;
}
let tag t n =
Array.unsafe_get t.tags (idx n)
+let summary t n =
+ Obj.magic (String.unsafe_get t.summary (idx n))
let kind t n : Tree.NodeKind.t =
- Obj.magic (String.unsafe_get t.kind (idx n))
+ Tree.NodeSummary.kind (summary t n)
let preorder t n =
(idx n) - 2
print_xml (next_sibling tree node) out tree node
-let mk_node table_a data_a kind_a tags_a i kind tag data pre_fc pre_ns pre_p =
+let mk_node table_a data_a kind_a tags_a i summary tag data pre_fc pre_ns pre_p =
try
data_a.(i+2) <- data;
tags_a.(i+2) <- tag;
- Bytes.unsafe_set kind_a (i+2) (Obj.magic kind);
+ Bytes.unsafe_set kind_a (i+2) (Char.chr (summary land 0xff));
let n = (i+2) * 3 in
let fc = (pre_fc + 2) * 3 in
let ns = (pre_ns + 2) * 3 in
let table = Array.make len ~-1 (* int16_unsigned c_layout len *) in
let data = Array.make (s + 2) "" in
let tags = Array.make (s+2) dummy_tag in
- let kind = Bytes.make (s+2) '\000' in
- mk_node table data kind tags ~-2 Tree.NodeKind.Element dummy_tag "" dummy dummy dummy;
- mk_node table data kind tags ~-1 Tree.NodeKind.Element QName.nil "" nil nil nil;
+ let summaries = Bytes.make (s+2) '\000' in
+ mk_node table data summaries tags ~-2 Tree.NodeSummary.dummy dummy_tag "" dummy dummy dummy;
+ mk_node table data summaries tags ~-1 Tree.NodeSummary.dummy QName.nil "" nil nil nil;
for i = 0 to s - 1 do
let node = Naive_tree.by_preorder t i in
- mk_node table data kind tags i (Naive_tree.kind t node)
+ mk_node table data summaries tags i
+ (Naive_tree.summary t node)
(Naive_tree.tag t node)
(Naive_tree.data t node)
(Naive_tree.preorder t (Naive_tree.first_child t node))
(Naive_tree.preorder t (Naive_tree.next_sibling t node))
(Naive_tree.preorder t (Naive_tree.parent t node))
done;
- { data; table; tags ; kind }
+ { data; table; tags ; summary = summaries }
let load_xml_string s = of_naive (Naive_tree.load_xml_string s)
let load_xml_file f = of_naive (Naive_tree.load_xml_file f)
type node = {
tag : QName.t;
preorder : int;
- mutable kind : Tree.NodeKind.t;
+ mutable summary : Tree.NodeSummary.t;
mutable data : string;
mutable first_child : node;
mutable next_sibling : node;
let rec nil = {
tag = QName.nil;
- kind = Tree.NodeKind.Element;
+ summary = Tree.NodeSummary.dummy;
preorder = -1;
data = "";
first_child = nil;
let dummy_tag = QName.of_string "#dummy"
let rec dummy = {
tag = dummy_tag;
- kind = Tree.NodeKind.Element;
+ summary = Tree.NodeSummary.dummy;
preorder = -1;
data = "";
first_child = dummy;
do_text parser_ ctx;
let parent = top ctx in
let n = { tag = QName.of_string tag;
- kind = Tree.NodeKind.Element;
+ summary = Tree.NodeSummary.make false false false false Tree.NodeKind.Element;
preorder = next ctx;
data = "";
first_child = dummy;
start_element_handler parser_ ctx att [];
let n = top ctx in
n.data <- value;
- n.kind <- Tree.NodeKind.Attribute;
+ n.summary <- Tree.NodeSummary.make false false false false Tree.NodeKind.Attribute;
end_element_handler parser_ ctx att
and consume_closing ctx n =
start_element_handler parser_ ctx text_string [];
let node = top ctx in
node.data <- s;
- node.kind <- Tree.NodeKind.Text;
+ node.summary <- Tree.NodeSummary.make false false false false Tree.NodeKind.Text;
end_element_handler parser_ ctx text_string
and comment_handler parser_ ctx s =
start_element_handler parser_ ctx comment_string [];
let node = top ctx in
node.data <- s;
- node.kind <- Tree.NodeKind.Comment;
+ node.summary <- Tree.NodeSummary.make false false false false Tree.NodeKind.Comment;
end_element_handler parser_ ctx comment_string
and processing_instruction_handler parser_ ctx tag data =
start_element_handler parser_ ctx tag [];
let node = top ctx in
node.data <- data;
- node.kind <- Tree.NodeKind.ProcessingInstruction;
+ node.summary <- Tree.NodeSummary.make false false false false Tree.NodeKind.ProcessingInstruction;
end_element_handler parser_ ctx tag
(processing_instruction_handler psr ctx);
push { tag = QName.document;
preorder = next ctx;
- kind = Tree.NodeKind.Document;
+ summary = Tree.NodeSummary.make false false false false Tree.NodeKind.Document;
data = "";
first_child = dummy;
next_sibling = dummy;
let rec loop n =
if n != nil then
begin
+ n.summary <-
+ Tree.NodeSummary.make
+ (n == n.parent.first_child)
+ (n == n.parent.next_sibling)
+ (n.first_child != nil)
+ (n.next_sibling != nil)
+ (Tree.NodeSummary.kind n.summary);
a.(n.preorder) <- n;
loop n.first_child;
loop n.next_sibling;
| c -> output_char out c
done
+let kind _ n = Tree.NodeSummary.kind n.summary
+let summary _ n = n.summary
let rec print_attributes ?(sep=true) out tree_ node =
- if (node.kind == Tree.NodeKind.Attribute) then
+ if (kind tree_ node == Tree.NodeKind.Attribute) then
let tag = QName.to_string node.tag in
if sep then output_char out ' ';
output_string out tag;
if node != nil then
let () =
let open Tree.NodeKind in
- match node.kind with
+ match kind tree_ node with
| Node -> ()
| Text -> output_escape_string out node.data
| Element | Document ->
let parent _ n = n.parent
let tag _ n = n.tag
let data _ n = n.data
-let kind _ n = n.kind
let preorder _ n = n.preorder
let by_preorder t i =
if i >= 0 && i < t.size then Array.unsafe_get t.by_preorder i
(* ../LICENSE. *)
(* *)
(***********************************************************************)
+open Misc
(** The different kind of XML nodes and utility functions *)
k1 == Node || k2 == Node || k1 == k2
end
+
+module NodeSummary =
+struct
+ (* Pack into an integer the result of the is_* and has_ predicates
+ for a given node *)
+ type t = int
+ let dummy = -1
+ (*
+ ...44443210
+ ...4444 -> kind
+ 3 -> has_right
+ 2 -> has_left
+ 1 -> is_right
+ 0 -> is_left
+ *)
+ let is_left (s : t) : bool =
+ s land 1 != 0
+
+ let is_right (s : t) : bool =
+ s land 0b10 != 0
+
+ let has_left (s : t) : bool =
+ s land 0b100 != 0
+
+ let has_right (s : t) : bool =
+ s land 0b1000 != 0
+
+ let kind (s : t) : NodeKind.t =
+ Obj.magic (s lsr 4)
+
+ let make is_left is_right has_left has_right kind =
+ (int_of_bool is_left) lor
+ ((int_of_bool is_right) lsl 1) lor
+ ((int_of_bool has_left) lsl 2) lor
+ ((int_of_bool has_right) lsl 3) lor
+ ((Obj.magic kind) lsl 4)
+end
+
+
(** Signatures for trees *)
exception Parse_error of string
val kind : t -> node -> NodeKind.t
(** Returns the kind of the given node *)
+ val summary : t -> node -> NodeSummary.t
+ (** Returns the summary of the given node *)
+
val preorder : t -> node -> int
(** [preorder t n] returns the pre-order position of [n] in [t].
[preodrder t (root t) == 0] and [preorder t nil < 0].
(** [by_preorder t i] returns the node with preorder [i]
*)
val print_node : Format.formatter -> node -> unit
+
+ val dispatch ('a -> 'b -> QName.t -> NodeSummary.t -> node -> node
end