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

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


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
22 23 24
  let rec is_empty t = 
    (t.instance.Instance.rules = []) && List.for_all is_empty t.good_nf
      
pj2m's avatar
pj2m committed
25
IFDEF DEP2PICT THEN
26

27 28 29 30 31 32
  (** [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
33
      match t.good_nf with
34 35 36 37 38 39 40 41 42 43 44 45 46 47
      | [] -> 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

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 75
  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
76
  let save_html ?main_feat ?(init_graph=true) ?header prefix t =
pj2m's avatar
pj2m committed
77 78 79 80 81
    (* 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
    
82 83
    (if init_graph then Instance.save_dep_png ?main_feat prefix t.instance);

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

pj2m's avatar
pj2m committed
88 89 90 91 92
    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
93
    let title = sprintf "Sentence: %s --- %d Normal form%s" local l (if l>1 then "s" else "") in
94
    let () = Html.enter html_ch ~title ?header prefix in
pj2m's avatar
pj2m committed
95

bguillaum's avatar
bguillaum committed
96
    if init_graph
pj2m's avatar
pj2m committed
97 98
    then
      begin
99 100
        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
101 102
      end;
    
bguillaum's avatar
bguillaum committed
103
    List_.iteri 
104
      (fun i (rules_list,file_name) -> 
bguillaum's avatar
bguillaum committed
105
        fprintf html_ch "<h6>Solution %d</h6>\n" (i+1);
pj2m's avatar
pj2m committed
106

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

        (* the modules list *)
113
        fprintf html_ch "<b>Modules applied</b>: %d<br/>\n" (List.length rules_list);
bguillaum's avatar
bguillaum committed
114
        
bguillaum's avatar
bguillaum committed
115
        let id = sprintf "id_%d" (i+1) in
bguillaum's avatar
bguillaum committed
116
        
bguillaum's avatar
bguillaum committed
117
        (* 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; *)
118 119 120

        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
121 122 123
        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;
124
        fprintf html_ch "</a>\n";
bguillaum's avatar
bguillaum committed
125 126 127

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

128 129 130 131 132 133 134
        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
135 136 137
        fprintf html_ch " </div>\n"

        
pj2m's avatar
pj2m committed
138 139
      ) nf_files;
    Html.leave html_ch;
bguillaum's avatar
bguillaum committed
140
    close_out html_ch
pj2m's avatar
pj2m committed
141
ENDIF
pj2m's avatar
pj2m committed
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;
153
      filters: Rule.t list;
pj2m's avatar
pj2m committed
154
      confluent: bool;
155
      loc: Loc.t;
pj2m's avatar
pj2m committed
156 157
    }

158 159 160 161 162 163 164 165
  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
166

167
  let build ast_module =
168 169
    let locals = Array.of_list ast_module.Ast.local_labels in
    Array.sort compare locals;
170 171
    let rules_or_filters = List.map (Rule.build ~locals ast_module.Ast.mod_dir) ast_module.Ast.rules in
    let (filters, rules) = List.partition Rule.is_filter rules_or_filters in 
172 173 174 175 176
    let modul = 
      {
       name = ast_module.Ast.module_id;
       local_labels = locals; 
       bad_labels = List.map Label.from_string ast_module.Ast.bad_labels;
177 178
       rules = rules; 
       filters = filters;
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
       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
208 209 210 211
end

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

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

223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
  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
240
  let build ast_grs =
241
    Label.init ast_grs.Ast.labels;
242 243
    Domain.init ast_grs.Ast.domain;
    let modules = List.map Modul.build ast_grs.Ast.modules in
244 245 246 247 248 249
    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
250

bguillaum's avatar
bguillaum committed
251
  let modules_of_sequence grs sequence =
252 253 254 255
    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
256 257 258 259 260 261 262 263 264 265 266
      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
267 268 269
    
    let rec loop instance = function
      | [] -> (* no more modules to apply *) 
270
          {Rewrite_history.instance = instance; module_name = ""; good_nf = []; bad_nf = []; }
pj2m's avatar
pj2m committed
271
      | next::tail -> 
272 273 274 275
          let (good_set, bad_set) = 
            Rule.normalize
              ~confluent: next.Modul.confluent
              next.Modul.rules 
276
              next.Modul.filters
277 278 279 280 281 282 283 284
              (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
285 286 287 288 289
         } 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
290 291 292

    let rec loop instance = function
      | [] -> Grew_types.Leaf instance.Instance.graph
293 294
      | next :: tail ->
          let (good_set, bad_set) =
295 296
            Rule.normalize
              ~confluent: next.Modul.confluent
297
              next.Modul.rules
298
              next.Modul.filters
299
              (Instance.clear instance) in
300
          let inst_list = Instance_set.elements good_set
301
              (* and bad_list = Instance_set.elements bad_set *) in
pj2m's avatar
pj2m committed
302

303
          match inst_list with
304
          | [{Instance.big_step = None}] ->
305
              Grew_types.Local_normal_form (instance.Instance.graph, next.Modul.name, loop instance tail)
306
          | _ -> Grew_types.Node
307 308 309
                (
                 instance.Instance.graph,
                 next.Modul.name,
310 311
                 List.map
                   (fun inst ->
312 313 314 315
                     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
316
                )
pj2m's avatar
pj2m committed
317
    in loop instance modules_to_apply
bguillaum's avatar
bguillaum committed
318

pj2m's avatar
pj2m committed
319 320
end  

bguillaum's avatar
bguillaum committed
321 322 323
module Gr_stat = struct

  (** the type [gr] stores the stats for the rewriting of one gr file *)
324 325 326
  type t = 
    | Stat of int StringMap.t 
    | Error of string
bguillaum's avatar
bguillaum committed
327 328 329 330 331 332 333 334 335 336 337 338

  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"
339
          
bguillaum's avatar
bguillaum committed
340 341 342 343 344 345 346 347 348 349 350 351 352 353
  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
354
    in Stat (loop None rew_history)
bguillaum's avatar
bguillaum committed
355

356
  let save stat_file t =
bguillaum's avatar
bguillaum committed
357
    let out_ch = open_out stat_file in
358 359
    (match t with
    | Error msg -> fprintf out_ch "ERROR\n%s" msg 
bguillaum's avatar
bguillaum committed
360 361
    | Stat map -> 
        StringMap.iter (fun rule_name occ -> fprintf out_ch "%s:%d\n%!" rule_name occ) map);
bguillaum's avatar
bguillaum committed
362 363
    close_out out_ch

364
  let load stat_file = 
bguillaum's avatar
bguillaum committed
365 366 367 368 369 370 371 372 373 374 375 376 377 378
    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
379 380 381 382 383 384 385 386 387
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
388
      modules: Modul.t list; (* ordered list of modules in the sequence *)
bguillaum's avatar
bguillaum committed
389
      map: (int * StringSet.t) StringMap.t StringMap.t;
390
      error: (string * string) list;   (* (file, msg) *)
bguillaum's avatar
bguillaum committed
391 392 393
      num: int;
    }

bguillaum's avatar
bguillaum committed
394
  let empty ~grs ~seq =
395 396
    (* 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
397 398
    let map = List.fold_left 
        (fun acc modul ->
399
          if List.exists (fun m -> modul.Modul.name = m.Modul.name) modules 
bguillaum's avatar
bguillaum committed
400 401 402 403 404 405 406 407
          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
408
        ) StringMap.empty grs.Grs.modules in
bguillaum's avatar
bguillaum committed
409
    { modules=modules; map = map; error = []; num = 0 }
bguillaum's avatar
bguillaum committed
410
      
bguillaum's avatar
bguillaum committed
411 412 413 414 415 416 417 418 419 420
  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
421
        
bguillaum's avatar
bguillaum committed
422
  let add_gr_stat base_name gr_stat t = 
423 424 425 426 427 428 429 430 431 432 433
    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
434 435 436 437 438 439 440 441 442 443 444 445 446 447

  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
448
    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
449 450
    fprintf out_ch "<b>%d Sentences</b><br/>\n<br/>\n" t.num;

451
    fprintf out_ch "<center><table cellpadding=3 cellspacing=0 width=95%%>\n";
bguillaum's avatar
bguillaum committed
452 453 454 455
    List.iter
      (fun modul ->
        let modul = modul.Modul.name in
        let rules = StringMap.find modul t.map in
bguillaum's avatar
bguillaum committed
456
        fprintf out_ch "<tr><td colspan=\"5\" style=\"padding: 0px;\"><h6>Module %s</h6></td>\n" modul;
457 458 459 460 461 462 463 464 465 466 467 468 469 470
        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
471 472 473 474 475 476 477 478 479 480 481 482 483 484
        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 
485 486
                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
487 488 489 490 491 492 493
            | 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
494 495
                  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
496 497
                 );
                compute t
bguillaum's avatar
bguillaum committed
498
            in compute file_list;
bguillaum's avatar
bguillaum committed
499 500 501 502 503 504

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

            let file_num = List.length file_list in

            fprintf out_ch "<tr>\n";
505 506 507 508
            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
509 510 511 512
            
            fprintf out_ch "<td class=\"stats\">%s" !tmp;
            if (!counter > 10)
            then (
bguillaum's avatar
bguillaum committed
513
              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
514
                modul rule
bguillaum's avatar
bguillaum committed
515 516
                (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
517 518 519 520
                modul rule;
             );
            fprintf out_ch "</td></tr>\n";
          ) rules;
bguillaum's avatar
bguillaum committed
521
      ) t.modules;
bguillaum's avatar
bguillaum committed
522 523


524
    (* add a subtlabe for sentence that produces an error *)
bguillaum's avatar
bguillaum committed
525 526 527 528 529
    (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";
530
        
bguillaum's avatar
bguillaum committed
531 532 533 534 535
        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\">";
536
        
bguillaum's avatar
bguillaum committed
537 538 539 540 541 542 543 544 545 546 547 548
        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
549

bguillaum's avatar
bguillaum committed
550 551 552
    fprintf out_ch "</table></center>\n";
    close_out out_ch;
    ()
bguillaum's avatar
bguillaum committed
553
end (* module Stat *)