X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fnaive_tree.ml;h=89b9e86446f397f03e3ed894d73ab7f65703611b;hp=6625be0cfe22e08e84e054998b5171c31fc0a691;hb=fe2ba1820282783ae8c10fbbbd2b65d3dc4c67f2;hpb=41dd1fed04cabad212f10fce3484545f6e9d9444 diff --git a/src/naive_tree.ml b/src/naive_tree.ml index 6625be0..89b9e86 100644 --- a/src/naive_tree.ml +++ b/src/naive_tree.ml @@ -50,6 +50,7 @@ let rec dummy = { type t = { root : node; size : int; + by_preorder : node array; (* TODO add other intersting stuff *) } @@ -71,7 +72,9 @@ struct "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 @@ -81,7 +84,8 @@ struct 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 @@ -126,12 +130,11 @@ struct 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; - end_element_handler parser_ ctx att_tag + end_element_handler parser_ ctx att 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; - 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; - end_element_handler parser_ ctx pi + end_element_handler parser_ ctx tag 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; + 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; - 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 = - 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 @@ -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 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 "=\""; @@ -298,7 +309,7 @@ let rec print_xml out tree_ node = output_string out "-->" | ProcessingInstruction -> 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 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