fixed debugging code

git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@394 3cdefd35-fc62-479d-8e8d-bae585ffb9ca

diff --git a/ata.ml b/ata.ml
index fa44fd6..4ef9ccf 100644 (file)
--- a/ata.ml
+++ b/ata.ml
@@ -767,7 +767,7 @@ END
                  in
                  let cont = D_IF_( (fun t ctx ->
                                       let a,b = cont t ctx in
-                                        register_trace t (slist,a,fl_list,first,next,ctx);
+                                        register_trace tree t (slist,a,fl_list,first,next,ctx);
                                         (a,b)
                                    ) ,cont) 
                  in
@@ -783,8 +783,8 @@ END
          let _,res = top_down a tree Tree.root init Tree.root 1 
          in 
            D_IGNORE_(
-             output_trace a tree root "trace.html"
-               (RS.fold (fun t a -> IntSet.add (Tree.id t) a) res.(0) IntSet.empty),
+             output_trace a tree "trace.html"
+               (RS.fold (fun t a -> IntSet.add (Tree.id tree t) a) res.(0) IntSet.empty),
              res.(0))
        ;;
 

diff --git a/html_trace.ml b/html_trace.ml
index c5ed980..333682c 100644 (file)
--- a/html_trace.ml
+++ b/html_trace.ml
@@ -155,11 +155,21 @@ let html_footer = "</div> <!-- document -->
 </body>
 </html>"
 let h_trace = Hashtbl.create 4096
-let register_trace t x = Hashtbl.add h_trace (Tree.id t) x
-let h_fname = Hashtbl.create 401
+let r_trace = Hashtbl.create 4096
+let register_trace tree t x = 
+  Hashtbl.add h_trace (Tree.id tree t) x
 
-let register_funname f s = Hashtbl.add h_fname (Hashtbl.hash  f) s
-let get_funname f = try Hashtbl.find h_fname (Hashtbl.hash  f) with _ -> "[anon_fun]"
+module HFname = Hashtbl.Make (struct
+                               type t = Obj.t
+                               let hash = Hashtbl.hash
+                               let equal = (==)
+                             end)
+
+let h_fname = HFname.create 401
+
+let register_funname f s = 
+  HFname.add h_fname (Obj.repr  f) s
+let get_funname f = try HFname.find h_fname  (Obj.repr f) with _ -> "[anon_fun]"
 let tag_to_str tag = 
   let s = Tag.to_string tag in
   let num =ref 0 in
@@ -185,7 +195,7 @@ let tag_to_str tag =
        ns
            
 
-let output_trace a t file results =
+let output_trace a tree file results =
   let h_auto = 6+ (Hashtbl.fold (fun _ l a -> (List.length l)+a) a.trans 0) in
   let max_tt = ref 0 in
   let outc = open_out file in
@@ -195,29 +205,28 @@ let output_trace a t file results =
   let pr_out x = Format.fprintf outf x in
   let rec loop t = 
     if not (Tree.is_nil t) then
-      let id = Tree.id t in
-      let tag = Tree.tag t in
+    let id = Tree.id tree t in
+      let tag = Tree.tag tree t in
       let tooltip,selected = try 
        let (inconf,outconf,trans,first_fun,next_fun,ctx) = Hashtbl.find h_trace id in
        let selected = IntSet.mem id results in
          pr_str "<span id=\"id%i\"><table><tr><td>Subtree %i, tag='%s', internal node = %s\n" 
-           id id  (tag_to_str tag) (Tree.dump_node t);
-         
+           id id  (tag_to_str tag) (Tree.dump_node t);  
          pr_str "Context node is %i, tag='%s', internal node = '%s'\n"
-           (Tree.id ctx) (tag_to_str (Tree.tag ctx)) (Tree.dump_node ctx);
+           (Tree.id tree ctx) (tag_to_str (Tree.tag tree ctx)) (Tree.dump_node ctx);
          pr_str "%s" "\nEntered with configuration:\n";
          SList.iter (fun s -> StateSet.print strf s) inconf;
          pr_str "%s" "\nLeft with configuration:\n";
          SList.iter (fun s -> StateSet.print strf s) outconf;
          (let ft = first_fun t in
             pr_str "\n<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\" >Left successor</a> is: id=%i, tag='%s', internal node = '%s'\n"
-              (Tree.id ft) (Tree.id ft) (Tree.id ft) (tag_to_str (Tree.tag ft)) (Tree.dump_node ft);
+              (Tree.id tree ft) (Tree.id tree ft) (Tree.id tree ft) (tag_to_str (Tree.tag tree ft)) (Tree.dump_node ft);
             pr_str "Moving with : %s (tree=%i)\n" (get_funname first_fun) id;
          );
          (let nt = next_fun t ctx in
             pr_str "\n<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\">Right successor</a> is: id=%i, tag='%s', internal node = '%s'\n"
-              (Tree.id nt) (Tree.id nt) (Tree.id nt) (tag_to_str (Tree.tag nt)) (Tree.dump_node nt);
-            pr_str "Moving with : %s (tree=%i) (ctx=%i)\n" (get_funname first_fun) id (Tree.id ctx);
+              (Tree.id tree nt) (Tree.id tree nt) (Tree.id tree nt) (tag_to_str (Tree.tag tree nt)) (Tree.dump_node nt);
+            pr_str "Moving with : %s (tree=%i) (ctx=%i)\n" (get_funname next_fun) id (Tree.id tree ctx);
          );
          pr_str "%s" "\nTriggered transitions:\n";
          pr_str "%s" "<table><tr valign=\"top\">";
@@ -225,7 +234,7 @@ let output_trace a t file results =
                       pr_str "%s" "<td>";Formlist.print strf fl;pr_str "</td>";
                       max_tt := max !max_tt (Formlist.length fl);
                    ) trans;
-         pr_str "%s" "</td></table>\n";
+         pr_str "%s" "</td></table>\n";          
          pr_str "In result set : %s\n</td></tr></table></span>" (if selected then  "Yes" else "No");
          Format.flush_str_formatter(),selected
       with
@@ -235,23 +244,23 @@ let output_trace a t file results =
        (if tag == Tag.pcdata || tag== Tag.attribute_data then "_text" else"")
       in
        if tag == Tag.pcdata || tag== Tag.attribute_data then 
-         pr_out "<div class=\"%s\"><a name=\"l%i\"/>%s%s</div>" div_class id (Tree.get_text t) tooltip
+         pr_out "<div class=\"%s\"><a name=\"l%i\"/>%s%s</div>" div_class id (Tree.get_text tree t) tooltip
        else begin
-         if (Tree.is_nil (Tree.first_child t))
+         if (Tree.is_nil (Tree.first_child tree t))
          then
            pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><a name=\"l%i\"/>&lt;%s/&gt;%s</div>" 
              div_class id id id (tag_to_str tag) tooltip
          else begin
             pr_out "<div class=\"%s\" id=\"div%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><a name=\"l%i\"/>&lt;%s&gt;%s</div>" 
              div_class id id id (tag_to_str tag) tooltip;
-           loop (Tree.first_child t);
+           loop (Tree.first_child tree t);
            if (tooltip="") then
              pr_out "<div class=\"%s\">&lt;/%s&gt;</div>" div_class (tag_to_str tag)
            else
              pr_out "<a href=\"#l%i\" onclick=\"ShowPopup(document.getElementById('id%i'));\"><div class=\"%s\">&lt;/%s&gt;</div></a>" id id  div_class (tag_to_str tag);
          end;
        end;
-       loop (Tree.next_sibling t);
+       loop (Tree.next_sibling tree t);
   in
   let max_tt = 25*(!max_tt + 15)+20 in
   let height = max max_tt (25*h_auto) in
@@ -261,7 +270,7 @@ let output_trace a t file results =
     dump outf a;
     pr_out "%s"  "</div><hr  /><div class=\"yellow\" id=\"tooltipzone\"></div>";
     pr_out "%s" "<div class=\"document\">";
-    loop t;
+    loop (Tree.root);
     pr_out "%s" html_footer;
     pr_out "%!";
     close_out outc