X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=html_trace.ml;fp=html_trace.ml;h=0000000000000000000000000000000000000000;hb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;hp=bcd086e5dc1807d27a6e7dcc33bd5657b6d28e3b;hpb=a223af3254fb51c279cfbccdc18c59484fdca74e;p=SXSI%2Fxpathcomp.git diff --git a/html_trace.ml b/html_trace.ml deleted file mode 100644 index bcd086e..0000000 --- a/html_trace.ml +++ /dev/null @@ -1,277 +0,0 @@ -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" ""; - Formlistlist.iter (fun fl -> - pr_str "%s" ""; - max_tt := max !max_tt (Formlist.length fl); - ) trans; - pr_str "%s" "

";Formlist.print strf fl;pr_str "

\n"; - pr_str "In result set : %s\n

" (if selected then "Yes" else "No"); - Format.flush_str_formatter(),selected - with - Not_found -> "",false - in - let div_class = (if (tooltip = "") then "skipped" else (if selected then "selected" else "touched"))^ - (if tag == Tag.pcdata || tag== Tag.attribute_data then "_text" else"") - in - if tag == Tag.pcdata || tag== Tag.attribute_data then - pr_out "

%s%s

" div_class id (Tree.get_text tree t) tooltip - else begin - if (Tree.is_nil (Tree.first_child tree t)) - then - pr_out "

<%s/>%s

" - div_class id id id (tag_to_str tag) tooltip - else begin - pr_out "

<%s>%s

" - div_class id id id (tag_to_str tag) tooltip; - loop (Tree.first_child tree t); - if (tooltip="") then - pr_out "

</%s>

" div_class (tag_to_str tag) - else - pr_out "

</%s>

" id id div_class (tag_to_str tag); - end; - end; - 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 - pr_out html_header height height height height; - pr_out "%s" "

"; - pr_out "%s" "

"; - loop (Tree.root); - pr_out "%s" html_footer; - pr_out "%!"; - close_out outc -