let doc =
- try
- Tree.Binary.parse_xml_uri Sys.argv.(1)
- with
- | _ ->
- Printf.printf "Error parsing document\n";
- exit 2
+ try
+ Tree.Binary.load Sys.argv.(1)
+ with
+ | _ ->
+ ( try
+ Tree.Binary.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 = (Ptset.add (Tag.tag "foo") (collect_tags doc))
+(*
+ let tags = (collect_tags doc)
+ ;;
+(*
+let _ = Tree.Binary.test_xml_tree Format.std_formatter 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 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 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
+ let t2 = Unix.gettimeofday () in
+ let t = (1000. *.(t2 -. t1)) 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)