X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=html_trace.ml;fp=html_trace.ml;h=c5ed98073c9a625ea192f1cf462676bd6f05eefa;hb=451e60ad59e35344dff62da5ca27fcd5eec1bff9;hp=0000000000000000000000000000000000000000;hpb=b82be3bb29963ce00218ccc59e1622e284145351;p=SXSI%2Fxpathcomp.git diff --git a/html_trace.ml b/html_trace.ml new file mode 100644 index 0000000..c5ed980 --- /dev/null +++ b/html_trace.ml @@ -0,0 +1,268 @@ +let html_header = format_of_string + " + + + + + + + + +" +let html_footer = " + +" +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 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]" +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 t 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 t in + let tag = Tree.tag 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 ctx) (tag_to_str (Tree.tag 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 ft) (Tree.id ft) (Tree.id ft) (tag_to_str (Tree.tag 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 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); + ); + pr_str "%s" "\nTriggered transitions:\n"; + pr_str "%s" ""; + List.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 t) tooltip + else begin + if (Tree.is_nil (Tree.first_child 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 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 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 t; + pr_out "%s" html_footer; + pr_out "%!"; + close_out outc +