From 9a1792faff5e38231a74f9e761a7ff94aae5e6d9 Mon Sep 17 00:00:00 2001 From: kim Date: Tue, 26 May 2009 15:47:04 +0000 Subject: [PATCH] Fixed bug in collect_tags (Tree.ml) Tag Table was wrong (following copied in descendant tags too) git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@409 3cdefd35-fc62-479d-8e8d-bae585ffb9ca --- ata.ml | 2 +- html_trace.ml | 2 +- tests/test.xml | 8 ++------ tree.ml | 48 +++++++++++++++++++++++++++++++++--------------- 4 files changed, 37 insertions(+), 23 deletions(-) diff --git a/ata.ml b/ata.ml index eb4f394..90458a3 100644 --- a/ata.ml +++ b/ata.ml @@ -382,7 +382,7 @@ let tags_of_state a q = module type ResultSet = sig type t - type elt = [` Tree] Tree.node + type elt = [` Tree ] Tree.node val empty : t val cons : elt -> t -> t val concat : t -> t -> t diff --git a/html_trace.ml b/html_trace.ml index 333682c..bcd086e 100644 --- a/html_trace.ml +++ b/html_trace.ml @@ -230,7 +230,7 @@ let output_trace a tree file results = ); pr_str "%s" "\nTriggered transitions:\n"; pr_str "%s" ""; - List.iter (fun fl -> + Formlistlist.iter (fun fl -> pr_str "%s" ""; max_tt := max !max_tt (Formlist.length fl); ) trans; diff --git a/tests/test.xml b/tests/test.xml index a9c7a55..8f0e255 100644 --- a/tests/test.xml +++ b/tests/test.xml @@ -1,10 +1,6 @@ - foo - foo - foo - foo - foo - foo + + diff --git a/tree.ml b/tree.ml index a1ddcac..0a31e83 100644 --- a/tree.ml +++ b/tree.ml @@ -178,24 +178,28 @@ let collect_tags tree = Hashtbl.replace h t (pt_cup sc schild,pt_cup sbelow sb, pt_cup ssibling ss, pt_cup safter sa) in - let rec loop_right id acc_sibling acc_after= + let rec loop_right id acc_after = if id == nil - then (acc_sibling,acc_after) + then Ptset.Int.empty,Ptset.Int.empty,acc_after else - let sibling2,after2 = loop_right (tree_next_sibling tree id) acc_sibling acc_after in - let child1,below1 = loop_left (tree_first_child tree id) after2 in - let tag = tree_tag_id tree id in - update tag child1 below1 sibling2 after2; - (pt_add tag sibling2, (pt_add tag (pt_cup after2 below1))) + let sibling2,desc2,after2 = loop_right (tree_next_sibling tree id) acc_after in + let child1,desc1,after1 = loop_left (tree_first_child tree id) after2 in + let tag = tree_tag_id tree id in + update tag child1 desc1 sibling2 after2; + ( pt_add tag sibling2, + pt_add tag (pt_cup desc1 desc2), + pt_cup after1 (pt_cup desc1 desc2) ) and loop_left id acc_after = - if id == nil - then (Ptset.Int.empty,Ptset.Int.empty) + if id == nil + then Ptset.Int.empty,Ptset.Int.empty,acc_after else - let sibling2,after2 = loop_right (tree_next_sibling tree id) Ptset.Int.empty acc_after in - let child1,below1 = loop_left (tree_first_child tree id) after2 in - let tag = tree_tag_id tree id in - update tag child1 below1 sibling2 after2; - (pt_add tag sibling2,(pt_add tag (pt_cup after2 below1))) + let sibling2,desc2,after2 = loop_right (tree_next_sibling tree id) acc_after in + let child1,desc1,after1 = loop_left (tree_first_child tree id) after2 in + let tag = tree_tag_id tree id in + update tag child1 desc1 sibling2 after2; + (pt_add tag sibling2, + pt_add tag (pt_cup desc1 desc2), + acc_after ) in let _ = loop_left (tree_root tree) Ptset.Int.empty in h @@ -288,7 +292,21 @@ let is_root t = t == root let node_of_t t = let _ = Tag.init (Obj.magic t) in let table = collect_tags t + in (* + let _ = Hashtbl.iter (fun t (c,d,ns,f) -> + Printf.eprintf "Tag %s has:\n" (Tag.to_string t); + Printf.eprintf "Child tags: "; + Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) c; + Printf.eprintf "\nDescendant tags: "; + Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) d; + Printf.eprintf "\nNextSibling tags: "; + Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) ns; + Printf.eprintf "\nFollowing tags: "; + Ptset.Int.iter (fun t -> Printf.eprintf "%s "(Tag.to_string t)) f; + Printf.eprintf "\n\n%!";) table in + + *) { doc= t; ttable = table; } @@ -310,7 +328,7 @@ let parse_xml_string str = parse parse_xml_string str external pool : tree -> Tag.pool = "%identity" let magic_string = "SXSI_INDEX" -let version_string = "1" +let version_string = "2" let pos fd = Unix.lseek fd 0 Unix.SEEK_CUR -- 2.17.1
";Formlist.print strf fl;pr_str "