X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fnaive_tree.ml;h=a7194be52bcfe13b1c690c4461290e6d3830f9cc;hb=30f4414e41e3000319023c1eaf587df80ff321b2;hp=33c953df3e85cf3197a4a503eeb1768e4138e2cf;hpb=75375a8bc02893080745ab38768b7ee48f5c4153;p=tatoo.git diff --git a/src/naive_tree.ml b/src/naive_tree.ml index 33c953d..a7194be 100644 --- a/src/naive_tree.ml +++ b/src/naive_tree.ml @@ -16,7 +16,7 @@ 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; @@ -27,7 +27,7 @@ type node = { let rec nil = { tag = QName.nil; - kind = Tree.NodeKind.Element; + summary = Tree.NodeSummary.dummy; preorder = -1; data = ""; first_child = nil; @@ -38,7 +38,7 @@ let rec 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; @@ -72,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 @@ -82,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 @@ -113,7 +116,7 @@ struct 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; @@ -127,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 + n.summary <- Tree.NodeSummary.make false false false false Tree.NodeKind.Attribute; + end_element_handler parser_ ctx att and consume_closing ctx n = if n.next_sibling != dummy then @@ -154,7 +156,7 @@ struct 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 = @@ -162,19 +164,16 @@ struct 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 = 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 + node.summary <- Tree.NodeSummary.make false false false false Tree.NodeKind.ProcessingInstruction; + end_element_handler parser_ ctx tag let character_data_handler _parser ctx text = @@ -194,7 +193,7 @@ struct (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; @@ -208,10 +207,17 @@ struct Expat.final psr; let root = List.hd ctx.stack in root.next_sibling <- nil; - let a = Array.create ctx.current_preorder nil in + let a = Array.make ctx.current_preorder nil in 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; @@ -241,7 +247,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 @@ -270,10 +276,12 @@ let output_escape_string out s = | 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 - let tag = QName.to_string (QName.remove_prefix node.tag) in + 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; output_string out "=\""; @@ -287,7 +295,7 @@ let rec print_xml out tree_ node = 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 -> @@ -310,7 +318,7 @@ let rec print_xml out tree_ node = output_string out "-->" | ProcessingInstruction -> output_string out "" @@ -327,7 +335,6 @@ let next_sibling _ n = n.next_sibling 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