- let next_sibling n =
- let node' =
- match n.node with
- | Node (SC (_,ns)) -> norm ns
- | Node(NC t) ->
- let ns = next_sibling_ n.doc t in
- let txt =
- if XML.Tree.is_nil ns then
- next_text_ n.doc t
- else prev_text_ n.doc ns
- in
- if is_empty_ n.doc txt
- then norm ns
- else Node (SC (txt, ns))
- | Nil | String _ -> failwith "next_sibling"
- in
- { n with node = node'}
-
- let id =
- function { doc=d; node=Node(NC n)} -> node_xml_id_ d n
- | { doc=d; node=Node(SC (i,_) )} -> text_xml_id_ d i
- | _ -> failwith "id"
-
- (* Wrapper around critical function *)
- let string t = time ("TextCollection.GetText()") (string) t
- let left = first_child
- let right = next_sibling
- let tag t = time ("XMLTree.GetTag()") (tag) t
-
- let print_stats ppf =
- let total_time,total_calls =
- Hashtbl.fold (fun _ (t,c) (tacc,cacc) ->
- tacc+. t, cacc + c) _timings (0.,0)
-
- in
- Format.fprintf ppf
- "Timing : Function Name, number of calls,%% of total calls, mean time, total time, %% of total time\n%!";
- Hashtbl.iter (fun name (time,count) ->
- Format.fprintf ppf "%-27s% 8d\t% 4.2f%%\t% 4.6f ms\t% 4.6f ms\t%04.2f%%\n%!"
- name
- count
- (100. *. (float_of_int count)/.(float_of_int total_calls))
- (time /. (float_of_int count))
- time
- (100. *. time /. total_time)) _timings;
- Format.fprintf ppf "-------------------------------------------------------------------\n";
- Format.fprintf ppf "%-27s% 8d\t% 4.0f%%\t########## ms\t% 4.6f ms\t% 4.0f%%\n%!"
- "Total" total_calls 100. total_time 100.
-
-
- let print_xml_fast outc t =
- let rec loop ?(print_right=true) t = match t.node with
- | Nil -> ()
- | String (s) -> output_string outc (string t)
- | Node _ when Tag.equal (tag t) Tag.pcdata -> loop (left t); loop (right t)
-
- | Node (_) ->
- let tg = Tag.to_string (tag t) in
- let l = left t
- and r = right t
- in
- output_char outc '<';
- output_string outc tg;
- ( match l.node with
- Nil -> output_string outc "/>"
- | String _ -> assert false
- | Node(_) when Tag.equal (tag l) Tag.attribute ->
- (loop_attributes (left l);
- match (right l).node with
- | Nil -> output_string outc "/>"
- | _ ->
- output_char outc '>';
- loop (right l);
- output_string outc "</";
- output_string outc tg;
- output_char outc '>' )
- | _ ->
- output_char outc '>';
- loop l;
- output_string outc "</";
- output_string outc tg;
- output_char outc '>'
- );if print_right then loop r
- and loop_attributes a =
-
- match a.node with
- | Node(_) ->
- let value =
- match (left a).node with
- | Nil -> ""
- | _ -> string (left(left a))
- in
- output_char outc ' ';
- output_string outc (Tag.to_string (tag a));
- output_string outc "=\"";
- output_string outc value;
- output_char outc '"';
- loop_attributes (right a)
- | _ -> ()
- in
- loop ~print_right:false t
-
-