(* Distributed under the terms of the LGPL (see LICENCE) *)
(******************************************************************************)
-let collect_tags v =
- let rec aux acc v =
- if Tree.Binary.is_node v
- then
- let tag = Tree.Binary.tag v
- in
- let acc = aux (Ptset.add tag acc) (Tree.Binary.first_child v)
- in
- aux (Ptset.add tag acc) (Tree.Binary.next_sibling v)
- else acc
- in
- aux Ptset.empty v
-;;
if Array.length (Sys.argv) <> 2
let doc =
try
- Tree.Binary.load Sys.argv.(1)
+ Tree.load Sys.argv.(1)
with
| _ ->
( try
- Tree.Binary.parse_xml_uri Sys.argv.(1)
+ Tree.parse_xml_uri Sys.argv.(1)
with
| _ ->(
Printf.printf "Error parsing document\n";
exit 2))
;;
-let _ = Tag.init (Tree.Binary.tag_pool doc)
-;;
-(*
- let tags = (collect_tags doc)
- ;;
-(*
-let _ = Tree.Binary.test_xml_tree Format.std_formatter tags doc
-;;
-let _ = Printf.printf "Testing //a with jumping\n"
-;;
-*)
-let rec test_a dir t acc ctx =
- if Tree.Binary.is_node t
- then
- let acc =
- if (Tree.Binary.tag t) == (Tag.tag "a")
- then Ata.TS.cons t acc
- else acc
- in
- let first = Tree.Binary.tagged_below t Ptset.empty (Ptset.singleton (Tag.tag "a"))
- and next = Tree.Binary.tagged_next t Ptset.empty (Ptset.singleton (Tag.tag "a")) ctx
- in
- let _ =
- Printf.printf "t is :";
- Tree.Binary.print_xml_fast stdout t;
- Printf.printf " called from %s of " (if dir then "below" else "next");
- Tree.Binary.print_xml_fast stdout ctx;
- if (Tree.Binary.is_node next)
- then begin
- Printf.printf ", Next a is %!";
- Tree.Binary.print_xml_fast stdout next;
- end
- else
- Printf.printf ", Next a is empty!";
- print_newline();
- in
- test_a false next (test_a true first acc t) t
- else acc
-;;
-let rec test_text dir t acc ctx =
- if Tree.Binary.is_node t
- then
- let acc =
- if (Tree.Binary.tag t) == (Tag.pcdata)
- then Ata.TS.cons t acc
- else acc
- in
- let first = Tree.Binary.text_below t
- and next = Tree.Binary.text_next t ctx
- in
- (*
- let _ =
- Printf.printf "t is :";
- Tree.Binary.print_xml_fast stdout t;
- Printf.printf " called from %s of " (if dir then "below" else "next");
- Tree.Binary.print_xml_fast stdout ctx;
- if (Tree.Binary.is_node first)
- then begin
- Printf.printf "First (text) is %!";
- Tree.Binary.print_xml_fast stdout first;
- end
- else
- Printf.printf "First (text) is empty!";
- if (Tree.Binary.is_node next)
- then begin
- Printf.printf ", Next (text) is %!";
- Tree.Binary.print_xml_fast stdout next;
- end
- else
- Printf.printf ", Next (text) is empty!";
- print_newline();
- in *)
- test_text false next (test_text true first acc t) ctx
- else acc
+let full_traversal tree =
+ let rec loop t =
+ if Tree.is_node t
+ then
+ begin
+ (*ignore (Tree.tag t); *)
+ loop (Tree.node_child t);
+ loop (Tree.node_sibling t);
+ end
+ in loop tree
;;
-(*
-let r = test_a true doc Ata.TS.empty doc;;
-(*
-let _ = Printf.printf "==> %i nodes\n" (Ata.TS.length r)
-let _ = Ata.TS.iter (fun t -> Tree.Binary.print_xml_fast stdout t; print_newline();) r
+
-*)
-let _ = Tree.Binary.init_contains doc "car"
+let _ = Tag.init (Tree.tag_pool doc)
-let r = test_text true doc Ata.TS.empty doc
-let _ = Printf.printf "==> %i nodes\n" (Ata.TS.length r)
-(* let _ = Ata.TS.iter (fun t -> Tree.Binary.print_xml_fast stdout t; print_newline();) r *)
-;;
-
-*) *)
let time f x =
let t1 = Unix.gettimeofday () in
let r = f x in
Printf.eprintf " %fms\n%!" t ;
r
;;
-let _ = Printf.eprintf "Timing full //keyword ... "
-let x = List.length (time (Tree.Binary.time_xml_tree doc) (Tag.tag "keyword"))
-let _ = Printf.eprintf "Timing jump //keyword ... "
-let y = List.length (time (Tree.Binary.time_xml_tree2 doc) (Tag.tag "keyword"))
-let _ = Printf.eprintf "coherant : %b\n" (x=y)
+let _ = Printf.eprintf "Timing traversal ... ";;
+let _ = time (full_traversal) doc
+;;