projects
/
tatoo.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Simplify the automaton encoding a bit (remove redundant predicates in formulae).
[tatoo.git]
/
src
/
naive_tree.ml
diff --git
a/src/naive_tree.ml
b/src/naive_tree.ml
index
6625be0
..
89b9e86
100644
(file)
--- a/
src/naive_tree.ml
+++ b/
src/naive_tree.ml
@@
-50,6
+50,7
@@
let rec dummy = {
type t = {
root : node;
size : int;
type t = {
root : node;
size : int;
+ by_preorder : node array;
(* TODO add other intersting stuff *)
}
(* TODO add other intersting stuff *)
}
@@
-71,7
+72,9
@@
struct
"NODE " ^ string_of_int n.preorder)
let debug_node fmt node =
"NODE " ^ string_of_int n.preorder)
let debug_node fmt node =
- Format.fprintf fmt "{ tag=%s; preorder=%i; data=%S; first_child=%a; next_sibling=%a; parent=%a }"
+ Format.fprintf fmt
+ "{ tag=%s; preorder=%i; data=%S;\
+first_child=%a; next_sibling=%a; parent=%a }"
(QName.to_string node.tag)
node.preorder
node.data
(QName.to_string node.tag)
node.preorder
node.data
@@
-81,7
+84,8
@@
struct
let debug_ctx fmt ctx =
let debug_ctx fmt ctx =
- Format.fprintf fmt "Current context: { preorder = %i\n; stack = \n%a\n }\n-------------\n"
+ Format.fprintf fmt "Current context: { preorder = %i\n; stack = \n%a\n }\
+\n-------------\n"
ctx.current_preorder
(Pretty.print_list ~sep:";\n" debug_node) ctx.stack
ctx.current_preorder
(Pretty.print_list ~sep:";\n" debug_node) ctx.stack
@@
-126,12
+130,11
@@
struct
List.iter (do_attribute parser_ ctx) attr_list
and do_attribute parser_ ctx (att, value) =
List.iter (do_attribute parser_ ctx) attr_list
and do_attribute parser_ ctx (att, value) =
- let att_tag = QName.to_string (QName.attribute (QName.of_string att)) in
- start_element_handler parser_ ctx att_tag [];
+ start_element_handler parser_ ctx att [];
let n = top ctx in
n.data <- value;
n.kind <- Tree.NodeKind.Attribute;
let n = top ctx in
n.data <- value;
n.kind <- Tree.NodeKind.Attribute;
- end_element_handler parser_ ctx att
_tag
+ end_element_handler parser_ ctx att
and consume_closing ctx n =
if n.next_sibling != dummy then
and consume_closing ctx n =
if n.next_sibling != dummy then
@@
-166,14
+169,11
@@
struct
and processing_instruction_handler parser_ ctx tag data =
do_text parser_ ctx;
and processing_instruction_handler parser_ ctx tag data =
do_text parser_ ctx;
- let pi = QName.to_string
- (QName.processing_instruction (QName.of_string tag))
- in
- start_element_handler parser_ ctx pi [];
+ start_element_handler parser_ ctx tag [];
let node = top ctx in
node.data <- data;
node.kind <- Tree.NodeKind.ProcessingInstruction;
let node = top ctx in
node.data <- data;
node.kind <- Tree.NodeKind.ProcessingInstruction;
- end_element_handler parser_ ctx
pi
+ end_element_handler parser_ ctx
tag
let character_data_handler _parser ctx text =
let character_data_handler _parser ctx text =
@@
-207,8
+207,19
@@
struct
Expat.final psr;
let root = List.hd ctx.stack in
root.next_sibling <- nil;
Expat.final psr;
let root = List.hd ctx.stack in
root.next_sibling <- nil;
+ let a = Array.make ctx.current_preorder nil in
+ let rec loop n =
+ if n != nil then
+ begin
+ a.(n.preorder) <- n;
+ loop n.first_child;
+ loop n.next_sibling;
+ end
+ in
+ loop root;
{ root = root;
{ root = root;
- size = ctx.current_preorder
+ size = ctx.current_preorder;
+ by_preorder = a
}
)
}
)
@@
-229,7
+240,7
@@
struct
Expat.Expat_error e -> error e parser_
let parse_file fd =
Expat.Expat_error e -> error e parser_
let parse_file fd =
- let buffer = String.
create 4096
in
+ let buffer = String.
make 4096 '\000'
in
let parser_, finalize = create_parser () in
let rec loop () =
let read = input fd buffer 0 4096 in
let parser_, finalize = create_parser () in
let rec loop () =
let read = input fd buffer 0 4096 in
@@
-261,7
+272,7
@@
let output_escape_string out s =
let rec print_attributes ?(sep=true) out tree_ node =
if (node.kind == Tree.NodeKind.Attribute) then
let rec print_attributes ?(sep=true) out tree_ node =
if (node.kind == Tree.NodeKind.Attribute) then
- let tag = QName.to_string
(QName.remove_prefix node.tag)
in
+ let tag = QName.to_string
node.tag
in
if sep then output_char out ' ';
output_string out tag;
output_string out "=\"";
if sep then output_char out ' ';
output_string out tag;
output_string out "=\"";
@@
-298,7
+309,7
@@
let rec print_xml out tree_ node =
output_string out "-->"
| ProcessingInstruction ->
output_string out "<?";
output_string out "-->"
| ProcessingInstruction ->
output_string out "<?";
- output_string out (QName.to_string
(QName.remove_prefix node.tag)
);
+ output_string out (QName.to_string
node.tag
);
output_char out ' ';
output_string out node.data;
output_string out "?>"
output_char out ' ';
output_string out node.data;
output_string out "?>"
@@
-317,5
+328,7
@@
let tag _ n = n.tag
let data _ n = n.data
let kind _ n = n.kind
let preorder _ n = n.preorder
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
+ else let e = Invalid_argument "by_preorder" in raise e
let print_node fmt n = Parser.debug_node fmt n
let print_node fmt n = Parser.debug_node fmt n