Commit cea5f6b4 authored by bguillaum's avatar bguillaum

add timeout

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6825 7838e531-6607-4d57-9587-6c381814729c
parent cca19da7
......@@ -467,7 +467,7 @@ module Corpus_stat = struct
(fun modul ->
let modul = modul.Modul.name in
let rules = StringMap.find modul t.map in
fprintf out_ch "<tr><td colspan=\"5\" style=\"padding: 0px;\"><h6>Module %s</h6></td>\n" modul;
fprintf out_ch "<tr><td colspan=\"5\" style=\"padding: 0px;\"><h6>Module %s</h6></td></tr>\n" modul;
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
......@@ -539,7 +539,7 @@ module Corpus_stat = struct
if not (IntMap.is_empty t.amb)
then
begin
fprintf out_ch "<tr><td colspan=5><h6>Rewriting ambiguity</h6></td>\n";
fprintf out_ch "<tr><td colspan=5><h6>Rewriting ambiguity</h6></td></tr>\n";
fprintf out_ch "<tr><th class=\"first\" >Number of normal forms</th><th colspan=2 width=20>#files</th><th >Ratio</th><th>Files</th></tr>\n";
IntMap.iter
......@@ -562,14 +562,12 @@ module Corpus_stat = struct
fprintf out_ch "</tr>") t.amb
end;
fprintf out_ch "</table></center>\n";
(* add a subtlabe for sentence that produces an error *)
(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><td colspan=5><h6>ERRORS</h6></td></tr>\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";
fprintf out_ch "<tr>\n";
......
......@@ -64,7 +64,6 @@ module Rule = struct
type gid = int
let max_depth = ref 500
exception Bound_reached
type const =
| No_out of pid * P_edge.t
......@@ -537,6 +536,9 @@ module Rule = struct
*)
let apply_rule instance matching rule =
(* Timeout check *)
(try Timeout.check () with Timeout.Stop -> Error.run "Time out");
(* limit the rewriting depth to avoid looping rewriting *)
begin
if List.length instance.Instance.rules >= !max_depth
......@@ -719,6 +721,7 @@ module Rule = struct
(* type: t list -> (Instance_set.elt -> bool) -> Instance.t -> Instance_set.t * Instance_set.t *)
let normalize ?(confluent=false) rules filters instance =
Timeout.start ();
if confluent
then
let output = conf_normalize instance rules in
......
......@@ -551,4 +551,19 @@ module Lex_par = struct
end
(* copy from leopar *)
module Timeout = struct
exception Stop
let counter = ref 0.
let timeout = ref None
let start () = counter := Unix.time ()
let check () =
match !timeout with
| None -> ()
| Some delay ->
if Unix.time () -. !counter > delay
then raise Stop
end
......@@ -190,3 +190,12 @@ module Lex_par: sig
It returns the [index]^th command_var. *)
val get_command_value: int -> t -> string
end
module Timeout: sig
exception Stop
val timeout: float option ref
val start: unit -> unit
val check: unit -> unit
end
......@@ -28,6 +28,8 @@ let is_empty = Rewrite_history.is_empty
let empty_grs = Grs.empty
let set_timeout t = Timeout.timeout := t
let load_grs ?doc_output_dir file =
if not (Sys.file_exists file)
then raise (File_dont_exists file)
......
......@@ -17,6 +17,7 @@ exception Run of string * (string * int) option
exception Bug of string * (string * int) option
val set_timeout: float option -> unit
val rewrite: gr:Instance.t -> grs:Grs.t -> seq:string -> Rewrite_history.t
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment