grew_grs.ml 20.4 KB
Newer Older
pj2m's avatar
pj2m committed
1 2 3
open Printf
open Log

bguillaum's avatar
bguillaum committed
4 5
open Grew_utils
open Grew_ast
pj2m's avatar
pj2m committed
6
open Grew_edge 
bguillaum's avatar
bguillaum committed
7 8 9
open Grew_command
open Grew_graph
open Grew_rule
pj2m's avatar
pj2m committed
10 11 12 13 14 15 16 17 18 19 20


module Rewrite_history = struct

  type t = {
      instance: Instance.t;
      module_name: string; 
      good_nf: t list; 
      bad_nf: Instance.t list;
    }

bguillaum's avatar
bguillaum committed
21 22 23
  let rec is_empty t = 
    (t.instance.Instance.rules = []) && List.for_all is_empty t.good_nf
      
pj2m's avatar
pj2m committed
24
IFDEF DEP2PICT THEN
25

26 27 28 29 30 31
  (** [save_nfs ?main_feat base_name t] does two things:
      - write PNG files of normal forms
      - returns a list of couples (rules, file)
   *)
  let save_nfs ?main_feat base_name t = 
    let rec loop file_name rules t =
pj2m's avatar
pj2m committed
32
      match t.good_nf with
33 34 35 36 37 38 39 40 41 42 43 44 45 46
      | [] -> Instance.save_dep_png ?main_feat file_name t.instance; [rules, file_name] 
      | l -> 
          List_.foldi_left
            (fun i acc son -> 
              (* Instance.save_dep_png ?main_feat (sprintf "%s_%d" file_name i) son.instance; *)
              let nfs = loop 
                  (sprintf "%s_%d" file_name i) 
                  (rules @ [t.module_name, son.instance.Instance.rules]) 
                  son in
              nfs @ acc
            )
            [] l
    in loop base_name [] t

47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
  let error_html ?main_feat ?(init_graph=true) ?header prefix msg inst_opt =
    (* remove files from previous runs *)
    let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
    let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
    let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in

    (match inst_opt, init_graph with
    | (Some inst, true) -> Instance.save_dep_png ?main_feat prefix inst
    | _ -> ());

    let local = Filename.basename prefix in
    
    (* All normal forms view *)
    let html_ch = open_out (sprintf "%s.html" prefix) in

    let title = sprintf "Sentence: %s --- ERROR" local in
    let () = Html.enter html_ch ~title ?header prefix in

    if init_graph
    then
      begin
        fprintf html_ch "<h6>Initial graph</h6>\n";
        fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" local
      end;
    fprintf html_ch "<h2>ERROR: %s</h2>\n" msg;
    Html.leave html_ch;
    close_out html_ch

bguillaum's avatar
bguillaum committed
75
  let save_html ?main_feat ?(init_graph=true) ?header prefix t =
pj2m's avatar
pj2m committed
76 77 78 79 80
    (* remove files from previous runs *)
    let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
    let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
    let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in
    
81 82
    (if init_graph then Instance.save_dep_png ?main_feat prefix t.instance);

83
    let nf_files = save_nfs ?main_feat prefix t in
84
    
85 86
    let l = List.length nf_files in

pj2m's avatar
pj2m committed
87 88 89 90 91
    let local = Filename.basename prefix in
    
    (* All normal forms view *)
    let html_ch = open_out (sprintf "%s.html" prefix) in

bguillaum's avatar
bguillaum committed
92
    let title = sprintf "Sentence: %s --- %d Normal form%s" local l (if l>1 then "s" else "") in
93
    let () = Html.enter html_ch ~title ?header prefix in
pj2m's avatar
pj2m committed
94

bguillaum's avatar
bguillaum committed
95
    if init_graph
pj2m's avatar
pj2m committed
96 97
    then
      begin
98 99
        fprintf html_ch "<h6>Initial graph</h6>\n";
        fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" local
pj2m's avatar
pj2m committed
100 101
      end;
    
bguillaum's avatar
bguillaum committed
102
    List_.iteri 
103
      (fun i (rules_list,file_name) -> 
bguillaum's avatar
bguillaum committed
104
        fprintf html_ch "<h6>Solution %d</h6>\n" (i+1);
pj2m's avatar
pj2m committed
105

106
        let local_name = Filename.basename file_name in
bguillaum's avatar
bguillaum committed
107 108 109 110 111
        
        (* the png file *)
        fprintf html_ch "<div width=100%% style=\"overflow-x:auto\"><IMG SRC=\"%s.png\"></div>\n" local_name;

        (* the modules list *)
112
        fprintf html_ch "<b>Modules applied</b>: %d<br/>\n" (List.length rules_list);
bguillaum's avatar
bguillaum committed
113
        
bguillaum's avatar
bguillaum committed
114
        let id = sprintf "id_%d" (i+1) in
bguillaum's avatar
bguillaum committed
115
        
bguillaum's avatar
bguillaum committed
116
        (* fprintf html_ch "<a style=\"cursor:pointer;\" onClick=\"if (document.getElementById('%s').style.display == 'none') { document.getElementById('%s').style.display = 'block'; document.getElementById('p_%s').innerHTML = 'Hide applied rules'; } else { document.getElementById('%s').style.display = 'none';; document.getElementById('p_%s').innerHTML = 'Show applied rules'; }\"><b><p id=\"p_%s\">Show applied rules</p></b></a>\n" id id id id id id; *)
117 118 119

        fprintf html_ch "<a style=\"cursor:pointer;\"\n";
        fprintf html_ch "  onClick=\"if (document.getElementById('%s').style.display == 'none')\n" id;
bguillaum's avatar
bguillaum committed
120 121 122
        fprintf html_ch "      { document.getElementById('%s').style.display = 'block'; document.getElementById('p_%s').innerHTML = 'Hide applied rules'; }\n" id id;
        fprintf html_ch " else { document.getElementById('%s').style.display = 'none';; document.getElementById('p_%s').innerHTML = 'Show applied rules'; }\">" id id;
        fprintf html_ch "         <b><p id=\"p_%s\">Show applied rules</p></b>\n" id;
123
        fprintf html_ch "</a>\n";
bguillaum's avatar
bguillaum committed
124 125 126

        fprintf html_ch " <div id=\"%s\" style=\"display:none;\">\n" id;

127 128 129 130 131 132 133
        List.iter 
          (fun (mod_name,rules) -> 
            fprintf html_ch "<p><b><font color=\"red\">%s: </font></b><font color=\"green\">%s</font></p>\n" 
              mod_name
              (List_.to_string (fun x -> x) ", " rules);
          )
          rules_list;
bguillaum's avatar
bguillaum committed
134 135 136
        fprintf html_ch " </div>\n"

        
pj2m's avatar
pj2m committed
137 138
      ) nf_files;
    Html.leave html_ch;
bguillaum's avatar
bguillaum committed
139
    close_out html_ch
pj2m's avatar
pj2m committed
140
ENDIF
pj2m's avatar
pj2m committed
141 142 143 144 145 146 147 148 149 150 151 152
end




module Modul = struct
  type t = {
      name: string;
      local_labels: (string * string option) array;
      bad_labels: Label.t list;
      rules: Rule.t list;
      confluent: bool;
153
      loc: Loc.t;
pj2m's avatar
pj2m committed
154 155
    }

156 157 158 159 160 161 162 163
  let check t =
    (* check for duplicate rules *)
    let rec loop already_defined = function
      | [] -> ()
      | r::_ when List.mem (Rule.get_name r) already_defined -> 
          Error.build ~loc:(Rule.get_loc r) "Rule '%s' is defined twice in the same module" (Rule.get_name r)
      | r::tail -> loop ((Rule.get_name r) :: already_defined) tail in
    loop [] t.rules
pj2m's avatar
pj2m committed
164

165 166 167
  let build ?domain ast_module =
    let locals = Array.of_list ast_module.Ast.local_labels in
    Array.sort compare locals;
168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202
    let modul = 
      {
       name = ast_module.Ast.module_id;
       local_labels = locals; 
       bad_labels = List.map Label.from_string ast_module.Ast.bad_labels;
       rules = List.map (Rule.build ?domain ~locals) ast_module.Ast.rules;
       confluent = ast_module.Ast.confluent;
       loc = ast_module.Ast.mod_loc;
     } in
    check modul; modul
end

module Sequence = struct
  type t = {
      name: string;
      def: string list;
      loc: Loc.t;
    }

  let check module_list t =
    List.iter
      (fun module_name -> 
        if not (List.exists (fun modul -> modul.Modul.name = module_name) module_list)
        then Error.build ~loc:t.loc "sequence \"%s\", refers to the unknown module \"%s\"."
            t.name module_name
      ) t.def

  let build module_list ast_sequence = 
    let sequence = 
      {
       name = ast_sequence.Ast.seq_name;
       def = ast_sequence.Ast.seq_mod;
       loc = ast_sequence.Ast.seq_loc;
     } in
    check module_list sequence; sequence
pj2m's avatar
pj2m committed
203 204 205 206
end

module Grs = struct
  type sequence = string * string list (* (name of the seq, list of modules) *)
207
        
pj2m's avatar
pj2m committed
208 209 210
  type t = {
      labels: Label.t list;    (* the list of global edge labels *)
      modules: Modul.t list;          (* the ordered list of modules used from rewriting *)
211
      sequences: Sequence.t list;
pj2m's avatar
pj2m committed
212
    }
213
        
214 215
  let sequence_names t = List.map (fun s -> s.Sequence.name) t.sequences

pj2m's avatar
pj2m committed
216 217
  let empty = {labels=[]; modules=[]; sequences=[];}

218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
  let check t =
    (* check for duplicate modules *)
    let rec loop already_defined = function
      | [] -> ()
      | m::_ when List.mem m.Modul.name already_defined -> 
          Error.build ~loc:m.Modul.loc "Module '%s' is defined twice" m.Modul.name
      | m::tail -> loop (m.Modul.name :: already_defined) tail in
    loop [] t.modules;

    (* check for duplicate sequences *)
    let rec loop already_defined = function
      | [] -> ()
      | s::_ when List.mem s.Sequence.name already_defined -> 
          Error.build ~loc:s.Sequence.loc "Sequence '%s' is defined twice" s.Sequence.name
      | s::tail -> loop (s.Sequence.name :: already_defined) tail in
    loop [] t.sequences

pj2m's avatar
pj2m committed
235
  let build ast_grs =
236 237 238 239 240 241 242 243
    Label.init ast_grs.Ast.labels;
    let modules = List.map (Modul.build ~domain:ast_grs.Ast.domain) ast_grs.Ast.modules in
    let grs = {
      labels = List.map (fun (l,_) -> Label.from_string l) ast_grs.Ast.labels;
      modules = modules;
      sequences = List.map (Sequence.build modules) ast_grs.Ast.sequences;
    } in
    check grs; grs
pj2m's avatar
pj2m committed
244

bguillaum's avatar
bguillaum committed
245
  let modules_of_sequence grs sequence =
246 247 248 249
    let module_names =
      try 
        let seq = List.find (fun s -> s.Sequence.name = sequence) grs.sequences in
        seq.Sequence.def
bguillaum's avatar
bguillaum committed
250 251 252 253 254 255 256 257 258 259 260
      with Not_found -> [sequence] in (* a module name can be used as a singleton sequence *)

    List.map 
      (fun name -> 
        try List.find (fun m -> m.Modul.name=name) grs.modules 
        with Not_found -> Log.fcritical "No sequence or module named '%s'" name
      )
      module_names

  let rewrite grs sequence instance = 
    let modules_to_apply = modules_of_sequence grs sequence in
pj2m's avatar
pj2m committed
261 262 263
    
    let rec loop instance = function
      | [] -> (* no more modules to apply *) 
264
          {Rewrite_history.instance = instance; module_name = ""; good_nf = []; bad_nf = []; }
pj2m's avatar
pj2m committed
265
      | next::tail -> 
266 267 268 269 270 271 272 273 274 275 276 277 278
          let (good_set, bad_set) = 
            Rule.normalize
              ~confluent: next.Modul.confluent
              next.Modul.rules 
              (fun x -> true)  (* FIXME *)
              (Instance.clear instance) in
          let good_list = Instance_set.elements good_set 
          and bad_list = Instance_set.elements bad_set in
          {
           Rewrite_history.instance = instance; 
           module_name = next.Modul.name;
           good_nf = List.map (fun i -> loop i tail) good_list;
           bad_nf = bad_list;
bguillaum's avatar
bguillaum committed
279 280 281 282 283
         } in
    loop instance modules_to_apply
      
  let build_rew_display grs sequence instance =
    let modules_to_apply = modules_of_sequence grs sequence in
pj2m's avatar
pj2m committed
284 285 286

    let rec loop instance = function
      | [] -> Grew_types.Leaf instance.Instance.graph
287 288
      | next :: tail ->
          let (good_set, bad_set) =
289 290
            Rule.normalize
              ~confluent: next.Modul.confluent
291
              next.Modul.rules
292 293
              (fun x -> true)  (* FIXME: filtering in module outputs *)
              (Instance.clear instance) in
294
          let inst_list = Instance_set.elements good_set
295
              (* and bad_list = Instance_set.elements bad_set *) in
pj2m's avatar
pj2m committed
296

297
          match inst_list with
298
          | [{Instance.big_step = None}] ->
299
              Grew_types.Local_normal_form (instance.Instance.graph, next.Modul.name, loop instance tail)
300
          | _ -> Grew_types.Node
301 302 303
                (
                 instance.Instance.graph,
                 next.Modul.name,
304 305
                 List.map
                   (fun inst ->
306 307 308 309
                     match inst.Instance.big_step with
                     | None -> Error.bug "Cannot have no big_steps and more than one reducts at the same time"
                     | Some bs -> (bs, loop inst tail)
                   ) inst_list
310
                )
pj2m's avatar
pj2m committed
311
    in loop instance modules_to_apply
bguillaum's avatar
bguillaum committed
312

pj2m's avatar
pj2m committed
313 314
end  

bguillaum's avatar
bguillaum committed
315 316 317
module Gr_stat = struct

  (** the type [gr] stores the stats for the rewriting of one gr file *)
318 319 320
  type t = 
    | Stat of int StringMap.t 
    | Error of string
bguillaum's avatar
bguillaum committed
321 322 323 324 325 326 327 328 329 330 331 332

  let add_one_module modul_opt rules stat =
    match modul_opt with
    | Some modul ->
        List.fold_left
          (fun acc rule ->
            let key = sprintf "%s.%s" modul rule in
            let old = try StringMap.find key acc with Not_found -> 0 in
            StringMap.add key (old+1) acc
          ) stat rules
    | None when rules = [] -> stat
    | None -> Log.fcritical "Unconsistent rewrite history"
333
          
bguillaum's avatar
bguillaum committed
334 335 336 337 338 339 340 341 342 343 344 345 346 347
  let max_stat stat1 stat2 =
    StringMap.fold
      (fun key value acc ->
        let old = try StringMap.find key acc with Not_found -> 0 in
        StringMap.add key (max old value) acc
      ) stat1 stat2
      
  let from_rew_history rew_history =
    let rec loop prev_module rh =
      let sub_stat = 
        match List.map (loop (Some rh.Rewrite_history.module_name)) rh.Rewrite_history.good_nf with 
        | [] -> StringMap.empty
        | h::t -> List.fold_left max_stat h t in
      add_one_module prev_module rh.Rewrite_history.instance.Instance.rules sub_stat
348
    in Stat (loop None rew_history)
bguillaum's avatar
bguillaum committed
349

350
  let save stat_file t =
bguillaum's avatar
bguillaum committed
351
    let out_ch = open_out stat_file in
352 353
    (match t with
    | Error msg -> fprintf out_ch "ERROR\n%s" msg 
bguillaum's avatar
bguillaum committed
354 355
    | Stat map -> 
        StringMap.iter (fun rule_name occ -> fprintf out_ch "%s:%d\n%!" rule_name occ) map);
bguillaum's avatar
bguillaum committed
356 357
    close_out out_ch

358
  let load stat_file = 
bguillaum's avatar
bguillaum committed
359 360 361 362 363 364 365 366 367 368 369 370 371 372
    try
      let lines = File.read stat_file in
      match lines with
      | "ERROR" :: msg_lines -> Error (List_.to_string (fun x->x) "\n" msg_lines)
      | _ -> 
          Stat 
            (List.fold_left 
               (fun acc line ->
                 match Str.split (Str.regexp ":") line with
                 | [modu_rule; num] -> StringMap.add modu_rule (int_of_string num) acc
                 | _ -> Log.fcritical "invalid stat line: %s" line
               ) StringMap.empty lines
            )
    with Sys_error msg -> Error (sprintf "Sys_error: %s" msg)
bguillaum's avatar
bguillaum committed
373 374 375 376 377 378 379 380 381
end (* module Gr_stat *)

module Corpus_stat = struct
  (** the [t] type stores stats for a corpus of gr_files *)
  (* 
     first key: [m] module name
     second key: [r] rule name
     value: [occ_nul, file_list] the totat number of rule applications and the set of gr files concerned *)
  type t = {
bguillaum's avatar
bguillaum committed
382
      modules: Modul.t list; (* ordered list of modules in the sequence *)
bguillaum's avatar
bguillaum committed
383
      map: (int * StringSet.t) StringMap.t StringMap.t;
384
      error: (string * string) list;   (* (file, msg) *)
bguillaum's avatar
bguillaum committed
385 386 387
      num: int;
    }

bguillaum's avatar
bguillaum committed
388
  let empty ~grs ~seq =
389 390
    (* let modules = try List.assoc seq grs.Grs.sequences with Not_found -> [seq] in *)
    let modules = Grs.modules_of_sequence grs seq in 
bguillaum's avatar
bguillaum committed
391 392
    let map = List.fold_left 
        (fun acc modul ->
393
          if List.exists (fun m -> modul.Modul.name = m.Modul.name) modules 
bguillaum's avatar
bguillaum committed
394 395 396 397 398 399 400 401
          then
            let rule_map = 
              List.fold_left
                (fun acc2 rule ->
                  StringMap.add (Rule.get_name rule) (0,StringSet.empty) acc2
                ) StringMap.empty modul.Modul.rules in
            StringMap.add modul.Modul.name rule_map acc
          else acc
bguillaum's avatar
bguillaum committed
402
        ) StringMap.empty grs.Grs.modules in
bguillaum's avatar
bguillaum committed
403
    { modules=modules; map = map; error = []; num = 0 }
bguillaum's avatar
bguillaum committed
404
      
bguillaum's avatar
bguillaum committed
405 406 407 408 409 410 411 412 413 414
  let add modul rule file num map = 
    let old_rule_map = StringMap.find modul map in
    let (old_num, old_file_set) = StringMap.find rule old_rule_map in
    StringMap.add 
      modul 
      (StringMap.add
         rule
         (old_num + num, StringSet.add file old_file_set)
         old_rule_map
      ) map
415
        
bguillaum's avatar
bguillaum committed
416
  let add_gr_stat base_name gr_stat t = 
417 418 419 420 421 422 423 424 425 426 427
    match gr_stat with
    | Gr_stat.Error msg -> { t with error = (base_name, msg) :: t.error; num = t.num+1 }
    | Gr_stat.Stat map -> 
        let new_map = 
          StringMap.fold
            (fun modul_rule num_occ acc ->
              match Str.split (Str.regexp "\\.") modul_rule with
              | [modul; rule] -> add modul rule base_name num_occ acc
              | _ -> Log.fcritical "illegal modul_rule spec \"%s\"" modul_rule 
            ) map t.map in
        { t with map = new_map; num = t.num+1 }
bguillaum's avatar
bguillaum committed
428 429 430 431 432 433 434 435 436 437 438 439 440 441

  let save_html ~title ~grs_file ~html ~output_dir t =

    let ratio nb = (float nb) /. (float t.num) *. 100. in


    let out_ch = open_out (Filename.concat output_dir "index.html") in
    
    let css = "<link rel=\"stylesheet\" href=\"style.css\" type=\"text/css\">" in
    
    ignore(Sys.command("cp "^(Filename.concat DATA_DIR "style.css")^" "^(Filename.concat output_dir "style.css")));
    
    fprintf out_ch "<head>\n%s\n<title>%s</title>\n<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" /></head>\n" css title;
    fprintf out_ch "<h1>%s</h1>\n" title;
bguillaum's avatar
bguillaum committed
442
    fprintf out_ch "<b>Grs file</b>:<a href =\"%s\">%s</a>\n<br/>\n" (Filename.basename grs_file) (Filename.basename grs_file);
bguillaum's avatar
bguillaum committed
443 444
    fprintf out_ch "<b>%d Sentences</b><br/>\n<br/>\n" t.num;

445
    fprintf out_ch "<center><table cellpadding=3 cellspacing=0 width=95%%>\n";
bguillaum's avatar
bguillaum committed
446 447 448 449
    List.iter
      (fun modul ->
        let modul = modul.Modul.name in
        let rules = StringMap.find modul t.map in
bguillaum's avatar
bguillaum committed
450
        fprintf out_ch "<tr><td colspan=\"5\" style=\"padding: 0px;\"><h6>Module %s</h6></td>\n" modul;
451 452 453 454 455 456 457 458 459 460 461 462 463 464
        fprintf out_ch "<tr><th class=\"first\">Rule</th><th>#occ</th><th>#files</th><th>Ratio</th><th>Files</th></tr>\n";
        let (tot_occ, full_sent) = 
          StringMap.fold
            (fun _ (occ_num, file_set) (acc_occ, acc_sent) -> (acc_occ + occ_num, StringSet.union acc_sent file_set))
            rules (0,StringSet.empty) in
        let tot_sent = StringSet.cardinal full_sent in
        fprintf out_ch "<tr>\n";
        fprintf out_ch "<td class=\"first_total\">Total for module</td>\n";
        fprintf out_ch "<td class=\"total\">%d</td>" tot_occ;
        fprintf out_ch "<td class=\"total\">%d</td>" tot_sent;
        fprintf out_ch "<td class=\"total\">%.2f%%</td>" (ratio tot_sent);
        fprintf out_ch "<td class=\"total\">&nbsp;</td>\n";
        fprintf out_ch "</tr>\n";

bguillaum's avatar
bguillaum committed
465 466 467 468 469 470 471 472 473 474 475 476 477 478
        StringMap.iter
          (fun rule (occ_num, file_set) ->
            let file_list = StringSet.elements file_set in

            let tmp = ref "" in
            let counter = ref 0 in
            let rec compute list = match list with
            | [] -> ()
            | h::[] ->
                if (!counter = 10) then (
                  tmp := sprintf "%s<div id=\"%s_%s\" style=\"display:none;\">\n" !tmp modul rule
                 );
                incr counter;
                if html 
479 480
                then tmp := sprintf "%s\n    <a href=\"%s.html\">%s</a> &nbsp; &nbsp;" !tmp h h
                else tmp := sprintf "%s\n    %s &nbsp; &nbsp;" !tmp h
bguillaum's avatar
bguillaum committed
481 482 483 484 485 486 487
            | h::t ->
                if (not (List.mem h t)) then ( (*avoid doublons*)
                  if (!counter = 10) then (
                    tmp := sprintf "%s<div id=\"%s_%s\" style=\"display:none;\">\n" !tmp modul rule
                   );
                  incr counter;
                  if html 
bguillaum's avatar
bguillaum committed
488 489
                  then tmp := sprintf "%s\n    <a href=\"%s.html\">%s</a>&nbsp;&nbsp;" !tmp h h 
                  else tmp := sprintf "%s\n    %s&nbsp;&nbsp;" !tmp h
bguillaum's avatar
bguillaum committed
490 491
                 );
                compute t
bguillaum's avatar
bguillaum committed
492
            in compute file_list;
bguillaum's avatar
bguillaum committed
493 494 495 496 497 498

            if file_list = [] then tmp := "&nbsp;";

            let file_num = List.length file_list in

            fprintf out_ch "<tr>\n";
499 500 501 502
            fprintf out_ch "<td class=\"first_stats\"  valign=top>%s</td>\n" rule;
            fprintf out_ch "<td class=\"stats\"  valign=top>%d</td>\n" occ_num;
            fprintf out_ch "<td class=\"stats\"  valign=top>%d</td>\n" file_num;
            fprintf out_ch "<td class=\"stats\"  valign=top>%.2f%%</td>\n" (ratio file_num);
bguillaum's avatar
bguillaum committed
503 504 505 506
            
            fprintf out_ch "<td class=\"stats\">%s" !tmp;
            if (!counter > 10)
            then (
bguillaum's avatar
bguillaum committed
507
              fprintf out_ch "</div><a style=\"cursor:pointer;\" onClick=\"if (document.getElementById('%s_%s').style.display == 'none') { %s } else { %s }\"><b><p id=\"p_%s_%s\">+ Show all +</p></b></a>\n"
bguillaum's avatar
bguillaum committed
508
                modul rule
bguillaum's avatar
bguillaum committed
509 510
                (sprintf "document.getElementById('%s_%s').style.display = 'block'; document.getElementById('p_%s_%s').innerHTML = '- Show first ten -';" modul rule modul rule)
                (sprintf "document.getElementById('%s_%s').style.display = 'none';; document.getElementById('p_%s_%s').innerHTML = '+ Show all +';" modul rule modul rule)
bguillaum's avatar
bguillaum committed
511 512 513 514
                modul rule;
             );
            fprintf out_ch "</td></tr>\n";
          ) rules;
bguillaum's avatar
bguillaum committed
515
      ) t.modules;
bguillaum's avatar
bguillaum committed
516 517


518
    (* add a subtlabe for sentence that produces an error *)
bguillaum's avatar
bguillaum committed
519 520 521 522 523
    (match List.length t.error with
    | 0 -> ()
    | nb_errors ->
        fprintf out_ch "<tr><td colspan=5><h6>ERRORS</h6></td>\n";
        fprintf out_ch "<tr><th class=\"first\" >Rule</th><th colspan=2 width=20>#files</th><th >Ratio</th><th>Files</th></tr>\n";
524
        
bguillaum's avatar
bguillaum committed
525 526 527 528 529
        fprintf out_ch "<tr>\n";
        fprintf out_ch "<td class=\"first_stats\">Errors</td>\n";
        fprintf out_ch "<td class=\"stats\" colspan=2>%d</td>\n" nb_errors;
        fprintf out_ch "<td class=\"stats\">%.2f%%</td>\n" (ratio nb_errors);
        fprintf out_ch "<td class=\"stats\">";
530
        
bguillaum's avatar
bguillaum committed
531 532 533 534 535 536 537 538 539 540 541 542
        match t.error with 
        | [] -> fprintf out_ch "&nbsp;"
        | l ->
            List.iter
              (fun (file,err) ->
                if html 
                then fprintf out_ch "<a href=\"%s.html\">%s</a>: %s<br/>" file file err
                else fprintf out_ch "%s: %s<br/>" file err
              ) (List.rev l);
            
            fprintf out_ch "</td>\n";
            fprintf out_ch "</tr>");
bguillaum's avatar
bguillaum committed
543

bguillaum's avatar
bguillaum committed
544 545 546
    fprintf out_ch "</table></center>\n";
    close_out out_ch;
    ()
bguillaum's avatar
bguillaum committed
547
end (* module Stat *)