let html_header = format_of_string "
" let html_footer = " " let h_trace = Hashtbl.create 4096 let r_trace = Hashtbl.create 4096 let register_trace tree t x = Hashtbl.add h_trace (Tree.id tree t) x 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 for i=0 to (String.length s)-1 do match s.[i] with | '<' | '>' -> incr num | _ -> () done; if !num == 0 then s else let j = ref 0 in let ns = String.create ((String.length s)+3 * !num) in for i=0 to (String.length s)-1 do match s.[i] with | '<' | '>' as x -> ns.[!j] <- '&'; ns.[!j+1] <- (if x == '>' then 'g' else 'l') ; ns.[!j+2] <- 't'; ns.[!j+3] <- ';'; j:= !j+4 | _ -> ns.[!j] <- s.[i]; incr j done; ns 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 let outf = Format.formatter_of_out_channel outc in let strf = Format.str_formatter in let pr_str x = Format.fprintf strf x in let pr_out x = Format.fprintf outf x in let rec loop t = if not (Tree.is_nil t) then 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 "Subtree %i, tag='%s', internal node = %s\n"
id id (tag_to_str tag) (Tree.dump_node t);
pr_str "Context node is %i, tag='%s', internal node = '%s'\n"
(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 "\nLeft successor is: id=%i, tag='%s', internal node = '%s'\n"
(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 "\nRight successor is: id=%i, tag='%s', internal node = '%s'\n"
(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" "
|