Commit bc1dd696 authored by bguillaum's avatar bguillaum

add a root node at pos 0 in CONLL

fix CONLL output (empty fields, quote)
sem=void ==> void=y

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7936 7838e531-6607-4d57-9587-6c381814729c
parent a51d1f0f
...@@ -28,7 +28,7 @@ module Label = struct ...@@ -28,7 +28,7 @@ module Label = struct
let to_string ?(locals=[||]) t = let to_string ?(locals=[||]) t =
match (!full, t) with match (!full, t) with
| (None, No_domain s) -> s | (_, No_domain s) -> s
| (Some table, Global i) -> table.(i) | (Some table, Global i) -> table.(i)
| (Some _, Local i) -> fst locals.(i) | (Some _, Local i) -> fst locals.(i)
| _ -> Error.bug "[Label.to_string] inconsistent data" | _ -> Error.bug "[Label.to_string] inconsistent data"
...@@ -58,6 +58,8 @@ module G_edge = struct ...@@ -58,6 +58,8 @@ module G_edge = struct
let to_string ?(locals=[||]) t = Label.to_string ~locals t let to_string ?(locals=[||]) t = Label.to_string ~locals t
let root = Label.No_domain "root"
let make ?loc ?(locals=[||]) string = Label.from_string ?loc ~locals string let make ?loc ?(locals=[||]) string = Label.from_string ?loc ~locals string
let build ?locals (ast_edge, loc) = let build ?locals (ast_edge, loc) =
......
...@@ -28,6 +28,8 @@ module G_edge: sig ...@@ -28,6 +28,8 @@ module G_edge: sig
val to_string: ?locals:Label.decl array -> t -> string val to_string: ?locals:Label.decl array -> t -> string
val root: t
val make: ?loc:Loc.t -> ?locals:Label.decl array -> string -> t val make: ?loc:Loc.t -> ?locals:Label.decl array -> string -> t
val build: ?locals:Label.decl array -> Ast.edge -> t val build: ?locals:Label.decl array -> Ast.edge -> t
......
...@@ -8,6 +8,10 @@ open Grew_ast ...@@ -8,6 +8,10 @@ open Grew_ast
type value = String of string | Float of float type value = String of string | Float of float
let string_of_value = function let string_of_value = function
| String s -> Str.global_replace (Str.regexp "\"") "\\\"" s
| Float i -> String_.of_float i
let conll_string_of_value = function
| String s -> s | String s -> s
| Float i -> String_.of_float i | Float i -> String_.of_float i
...@@ -35,6 +39,7 @@ module Domain = struct ...@@ -35,6 +39,7 @@ module Domain = struct
| ((Ast.Closed (n,vs))::_) when n = name -> | ((Ast.Closed (n,vs))::_) when n = name ->
(match List_.sort_diff values vs with (match List_.sort_diff values vs with
| [] -> List.map (fun s -> String s) values | [] -> List.map (fun s -> String s) values
| l when List.for_all (fun x -> x.[0] = '_') l -> List.map (fun s -> String s) values
| l -> Error.build ?loc "Unknown feature values '%s' for feature name '%s'" | l -> Error.build ?loc "Unknown feature values '%s' for feature name '%s'"
(List_.to_string (fun x->x) ", " l) (List_.to_string (fun x->x) ", " l)
name name
...@@ -150,7 +155,7 @@ module G_fs = struct ...@@ -150,7 +155,7 @@ module G_fs = struct
let get_string_atom feat_name t = let get_string_atom feat_name t =
match List_.sort_assoc feat_name t with match List_.sort_assoc feat_name t with
| None -> None | None -> None
| Some v -> Some (string_of_value v) | Some v -> Some (conll_string_of_value v)
let get_float_feat feat_name t = let get_float_feat feat_name t =
match List_.sort_assoc feat_name t with match List_.sort_assoc feat_name t with
...@@ -219,14 +224,20 @@ module G_fs = struct ...@@ -219,14 +224,20 @@ module G_fs = struct
| None -> sub | None -> sub
| Some l -> List.filter (fun (fn,_) -> List.mem fn l) sub in | Some l -> List.filter (fun (fn,_) -> List.mem fn l) sub in
sprintf " word=\"%s\"; subword=\"%s\"" sprintf " word=\"%s\"; subword=\"%s\""
(match main_opt with Some atom -> string_of_value atom | None -> "") (match main_opt with Some atom -> string_of_value atom | None -> "_")
(List_.to_string G_feature.to_string "#" reduced_sub) (List_.to_string G_feature.to_string "#" reduced_sub)
let to_conll ?exclude t = let to_conll ?exclude t =
let reduced_t = match exclude with let reduced_t = match exclude with
| None -> t | None -> t
| Some list -> List.filter (fun (fn,_) -> not (List.mem fn list || fn.[0]='_')) t in | Some list -> List.filter (fun (fn,_) -> not (List.mem fn list || fn.[0]='_')) t in
String.concat "|" (List.map (function (fn, String "true") -> fn | (fn, fv) -> fn^"="^(string_of_value fv)) reduced_t) match reduced_t with
| [] -> "_"
| _ -> String.concat "|"
(List.map
(function (fn, String "true") -> fn | (fn, fv) -> fn^"="^(string_of_value fv))
reduced_t
)
end (* module G_fs *) end (* module G_fs *)
(* ==================================================================================================== *) (* ==================================================================================================== *)
......
...@@ -295,8 +295,9 @@ module G_graph = struct ...@@ -295,8 +295,9 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let of_conll ?loc lines = let of_conll ?loc lines =
let sorted_lines =
let sorted_lines = List.sort (fun line1 line2 -> Pervasives.compare line1.Conll.num line2.Conll.num) lines in Conll.root ::
(List.sort (fun line1 line2 -> Pervasives.compare line1.Conll.num line2.Conll.num) lines) in
let table = Array.of_list (List.map (fun line -> line.Conll.num) sorted_lines) in let table = Array.of_list (List.map (fun line -> line.Conll.num) sorted_lines) in
...@@ -308,20 +309,17 @@ module G_graph = struct ...@@ -308,20 +309,17 @@ module G_graph = struct
(fun acc line -> (fun acc line ->
(* add line number information in loc *) (* add line number information in loc *)
let loc = Loc.opt_set_line line.Conll.line_num loc in let loc = Loc.opt_set_line line.Conll.line_num loc in
let dep_id = Id.build ?loc line.Conll.num table in
List.fold_left List.fold_left
(fun acc2 (gov, dep_lab) -> (fun acc2 (gov, dep_lab) ->
if gov = "0" let gov_id = Id.build ?loc gov table in
then acc2 let edge = if gov = "0" then G_edge.root else G_edge.make ?loc dep_lab in
else (match map_add_edge acc2 (Gid.Old gov_id) edge (Gid.Old dep_id) with
let gov_id = Id.build ?loc gov table in | Some g -> g
let dep_id = Id.build ?loc line.Conll.num table in | None -> Error.build "[GRS] [Graph.of_conll] try to build a graph with twice the same edge %s %s"
let edge = G_edge.make ?loc dep_lab in (G_edge.to_string edge)
(match map_add_edge acc2 (Gid.Old gov_id) edge (Gid.Old dep_id) with (match loc with Some l -> Loc.to_string l | None -> "")
| Some g -> g )
| None -> Error.build "[GRS] [Graph.of_conll] try to build a graph with twice the same edge %s %s"
(G_edge.to_string edge)
(match loc with Some l -> Loc.to_string l | None -> "")
)
) acc line.Conll.deps ) acc line.Conll.deps
) map_without_edges lines in ) map_without_edges lines in
{meta=[]; map=map_with_edges} {meta=[]; map=map_with_edges}
...@@ -624,9 +622,9 @@ module G_graph = struct ...@@ -624,9 +622,9 @@ module G_graph = struct
(fun (id, node) -> (fun (id, node) ->
let fs = G_node.get_fs node in let fs = G_node.get_fs node in
let dep_fs = G_fs.to_dep ?filter ?main_feat fs in let dep_fs = G_fs.to_dep ?filter ?main_feat fs in
let style = match (List.mem id deco.G_deco.nodes, G_fs.get_string_atom "sem" fs) with let style = match (List.mem id deco.G_deco.nodes, G_fs.get_string_atom "void" fs) with
| (true, _) -> "; forecolor=red; subcolor=red; " | (true, _) -> "; forecolor=red; subcolor=red; "
| (false, Some "void") -> "; forecolor=red; subcolor=red; " | (false, Some "y") -> "; forecolor=red; subcolor=red; "
| _ -> "" in | _ -> "" in
bprintf buff "N_%s { %s%s }\n" (Gid.to_string id) dep_fs style bprintf buff "N_%s { %s%s }\n" (Gid.to_string id) dep_fs style
) snodes; ) snodes;
...@@ -698,10 +696,9 @@ module G_graph = struct ...@@ -698,10 +696,9 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------------- *)
let to_conll graph = let to_conll graph =
let nodes = Gid_map.fold (fun gid node acc -> (gid,node)::acc) graph.map [] in let nodes = Gid_map.fold (fun gid node acc -> (gid,node)::acc) graph.map [] in
let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.pos_comp n1 n2) nodes in let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.pos_comp n1 n2) nodes in
let get_num gid = (list_num (fun (x,_) -> x=gid) snodes) + 1 in let get_num gid = (list_num (fun (x,_) -> x=gid) snodes) in
(* Warning: [govs_labs] maps [gid]s to [num]s *) (* Warning: [govs_labs] maps [gid]s to [num]s *)
let govs_labs = let govs_labs =
...@@ -718,19 +715,31 @@ module G_graph = struct ...@@ -718,19 +715,31 @@ module G_graph = struct
let buff = Buffer.create 32 in let buff = Buffer.create 32 in
List.iter List.iter
(fun (gid, node) -> (fun (gid, node) ->
let (govs,labs) = List.split (try Gid_map.find gid govs_labs with Not_found -> ["0","root"]) in let gov_labs = try Gid_map.find gid govs_labs with Not_found -> [] in
let sorted_gov_labs =
List.sort
(fun (g1,l1) (g2,l2) ->
if l1 <> "" && l1.[0] <> 'I' && l1.[0] <> 'D'
then -1
else if l2 <> "" && l2.[0] <> 'I' && l2.[0] <> 'D'
then 1
else compare (String_.to_float g1) (String_.to_float g2)
) gov_labs in
let (govs,labs) = List.split sorted_gov_labs in
let fs = G_node.get_fs node in let fs = G_node.get_fs node in
bprintf buff "%d\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t_\t_\n" bprintf buff "%d\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t_\t_\n"
(get_num gid) (get_num gid)
(match G_fs.get_string_atom "phon" fs with Some p -> p | None -> "NO_PHON") (match G_fs.get_string_atom "phon" fs with Some p -> p | None -> "NO_PHON")
(match G_fs.get_string_atom "lemma" fs with Some p -> p | None -> "NO_LEMMA") (match G_fs.get_string_atom "lemma" fs with Some p -> p | None -> "NO_LEMMA")
(match G_fs.get_string_atom "cat" fs with Some p -> p | None -> "NO_CAT") (match G_fs.get_string_atom "cat" fs with Some p -> p | None -> "NO_CAT")
(match G_fs.get_string_atom "pos" fs with Some p -> p | None -> "_") (match G_fs.get_string_atom "pos" fs with Some p -> p | None -> "_")
(G_fs.to_conll ~exclude: ["phon"; "lemma"; "cat"; "pos"; "position"] fs) (G_fs.to_conll ~exclude: ["phon"; "lemma"; "cat"; "pos"; "position"] fs)
(String.concat "|" govs) (String.concat "|" govs)
(String.concat "|" labs) (String.concat "|" labs)
) )
snodes; (List.tl snodes) (* do not consider the root node in CONLL output *);
Buffer.contents buff Buffer.contents buff
end (* module G_graph *) end (* module G_graph *)
......
...@@ -48,11 +48,14 @@ module G_node = struct ...@@ -48,11 +48,14 @@ module G_node = struct
} ) } )
let of_conll line = let of_conll line =
{ if line = Conll.root
fs = G_fs.of_conll line; then { fs = G_fs.empty; pos = Some 0.; next = Massoc_gid.empty }
pos = Some (String_.to_float line.Conll.num); else
next = Massoc_gid.empty; {
} fs = G_fs.of_conll line;
pos = Some (String_.to_float line.Conll.num);
next = Massoc_gid.empty;
}
let remove (id_tar : Gid.t) label t = {t with next = Massoc_gid.remove id_tar label t.next} let remove (id_tar : Gid.t) label t = {t with next = Massoc_gid.remove id_tar label t.next}
......
...@@ -23,8 +23,3 @@ and big_step = { ...@@ -23,8 +23,3 @@ and big_step = {
first: rule_app; first: rule_app;
small_step: (G_graph.t * rule_app) list; small_step: (G_graph.t * rule_app) list;
} }
let to_dot_graph ?main_feat ?(deco=G_deco.empty) graph = G_graph.to_dot ?main_feat graph ~deco
let to_dep_graph ?filter ?main_feat ?(deco=G_deco.empty) graph = G_graph.to_dep ?filter ?main_feat ~deco graph
let to_gr_graph graph = G_graph.to_gr graph
let to_conll_graph graph = G_graph.to_conll graph
...@@ -28,10 +28,3 @@ and big_step = { ...@@ -28,10 +28,3 @@ and big_step = {
first: rule_app; first: rule_app;
small_step: (graph * rule_app) list; small_step: (graph * rule_app) list;
} }
(** {2 Types displaying} *)
val to_dot_graph : ?main_feat:string -> ?deco:deco -> graph -> string
val to_dep_graph : ?filter: string list -> ?main_feat:string -> ?deco:deco -> graph -> string
val to_gr_graph: graph -> string
val to_conll_graph: graph -> string
...@@ -608,8 +608,9 @@ module Conll = struct ...@@ -608,8 +608,9 @@ module Conll = struct
deps: (string * string ) list; deps: (string * string ) list;
} }
let load file = let root = { line_num = -1; num="0"; phon="ROOT"; lemma="__"; pos1="_X"; pos2=""; morph=[]; deps=[] }
let load file =
let parse_morph line_num = function let parse_morph line_num = function
| "_" -> [] | "_" -> []
| morph -> | morph ->
...@@ -631,8 +632,8 @@ module Conll = struct ...@@ -631,8 +632,8 @@ module Conll = struct
let deps = List.combine gov_list lab_list in let deps = List.combine gov_list lab_list in
{line_num = line_num; {line_num = line_num;
num = num; num = num;
phon = escape_quote phon; phon = phon;
lemma = escape_quote lemma; lemma = lemma;
pos1 = pos1; pos1 = pos1;
pos2 = pos2; pos2 = pos2;
morph = parse_morph line_num morph; morph = parse_morph line_num morph;
......
...@@ -266,6 +266,8 @@ module Conll: sig ...@@ -266,6 +266,8 @@ module Conll: sig
deps: (string * string ) list; deps: (string * string ) list;
} }
val root:line
val load: string -> line list val load: string -> line list
end end
......
...@@ -13,6 +13,12 @@ open Grew_parser ...@@ -13,6 +13,12 @@ open Grew_parser
open Grew_html open Grew_html
let css_file = Filename.concat DATA_DIR "style.css"
let empty_grs = Grs.empty
let set_timeout t = Timeout.timeout := t
exception File_dont_exists of string exception File_dont_exists of string
...@@ -21,151 +27,149 @@ exception Build of string * (string * int) option ...@@ -21,151 +27,149 @@ exception Build of string * (string * int) option
exception Run of string * (string * int) option exception Run of string * (string * int) option
exception Bug of string * (string * int) option exception Bug of string * (string * int) option
type grs = Grs.t let handle ?(name="") ?(file="No file defined") fct () =
type gr = Instance.t (* Printf.printf " ==========> %s ...%!" name; *)
type rew_history = Rewrite_history.t try fct () with
| Grew_parser.Parse_error (msg,Some (sub_file,l)) ->
raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
| Grew_parser.Parse_error (msg,None) ->
raise (Parsing_err (sprintf "[file:%s] %s" file msg))
| Error.Build (msg,loc) -> raise (Build (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| Error.Run (msg, loc) -> raise (Run (msg,loc))
| exc -> raise (Bug (sprintf "[Libgrew.%s] UNCATCHED EXCEPTION: %s" name (Printexc.to_string exc), None))
let is_empty = Rewrite_history.is_empty
let num_sol = Rewrite_history.num_sol let is_empty rh =
handle ~name:"num_sol" (fun () -> Rewrite_history.is_empty rh) ()
let empty_grs = Grs.empty let num_sol rh =
handle ~name:"num_sol" (fun () -> Rewrite_history.num_sol rh) ()
let set_timeout t = Timeout.timeout := t
IFDEF DEP2PICT THEN IFDEF DEP2PICT THEN
let build_doc file dir grs_ast grs = let build_doc file dir grs_ast grs =
Html_doc.build ~dep:true file dir grs_ast; handle ~name:"build_doc [with Dep2pict]" ~file
(fun () ->
(* draw pattern graphs for all rules and all filters *) Html_doc.build ~dep:true file dir grs_ast;
let fct module_ rule_ =
let dep_code = Rule.to_dep rule_ in (* draw pattern graphs for all rules and all filters *)
let dep_svg_file = sprintf "%s/%s_%s-patt.png" dir module_ (Rule.get_name rule_) in let fct module_ rule_ =
ignore (Dep2pict.Dep2pict.fromDepStringToPng dep_code dep_svg_file) in let dep_code = Rule.to_dep rule_ in
Grs.rule_iter fct grs; let dep_svg_file = sprintf "%s/%s_%s-patt.png" dir module_ (Rule.get_name rule_) in
Grs.filter_iter fct grs ignore (Dep2pict.Dep2pict.fromDepStringToPng dep_code dep_svg_file) in
Grs.rule_iter fct grs;
Grs.filter_iter fct grs
) ()
ELSE ELSE
let build_doc file dir grs_ast grs = let build_doc file dir grs_ast grs =
Html_doc.build ~dep:false file dir grs_ast handle ~name:"build_doc [without Dep2pict]" (fun () -> Html_doc.build ~dep:false file dir grs_ast) ()
END END
let load_grs ?doc_output_dir file = let load_grs ?doc_output_dir file =
if not (Sys.file_exists file) handle ~name:"load_grs" ~file
then raise (File_dont_exists file) (fun () ->
else if not (Sys.file_exists file)
try then raise (File_dont_exists file)
let grs_ast = Grew_parser.grs_of_file file in else
let grs = Grs.build grs_ast in let grs_ast = Grew_parser.grs_of_file file in
(match doc_output_dir with let grs = Grs.build grs_ast in
| None -> () (match doc_output_dir with
| Some dir -> build_doc file dir grs_ast grs); | None -> ()
grs | Some dir -> build_doc file dir grs_ast grs);
with grs
| Grew_parser.Parse_error (msg,Some (sub_file,l)) -> ) ()
raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
| Grew_parser.Parse_error (msg,None) ->
raise (Parsing_err (sprintf "[file:%s] %s" file msg))
| Error.Build (msg,loc) -> raise (Build (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "[Libgrew.load_grs] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
let to_sentence ?main_feat gr = let to_sentence ?main_feat gr =
let graph = gr.Instance.graph in handle ~name:"to_sentence"
G_graph.to_sentence ?main_feat graph (fun () ->
let graph = gr.Instance.graph in
let get_sequence_names grs = Grs.sequence_names grs G_graph.to_sentence ?main_feat graph
) ()
let get_sequence_names grs =
handle ~name:"get_sequence_names"
(fun () ->
Grs.sequence_names grs
) ()
let load_gr file = let load_gr file =
if Sys.file_exists file if not (Sys.file_exists file)
then then raise (File_dont_exists file)
begin else
try handle ~name:"load_gr" ~file
(fun () ->
let gr_ast = Grew_parser.gr_of_file file in let gr_ast = Grew_parser.gr_of_file file in
Instance.from_graph (G_graph.build gr_ast) Instance.from_graph (G_graph.build gr_ast)
with ) ()
| Grew_parser.Parse_error (msg,Some (sub_file,l)) ->
raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
| Grew_parser.Parse_error (msg,None) ->
raise (Parsing_err (sprintf "[file:%s] %s" file msg))
| Error.Build (msg,loc) -> raise (Build (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "[Libgrew.load_gr] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
end
else raise (File_dont_exists file)
let load_conll file = let load_conll file =
try handle ~name:"load_conll" ~file
let graph = G_graph.of_conll ~loc:(file,-1) (Conll.load file) in (fun () ->
Instance.from_graph graph let graph = G_graph.of_conll ~loc:(file,-1) (Conll.load file) in
with Instance.from_graph graph
| Grew_parser.Parse_error (msg,Some (sub_file,l)) -> ) ()
raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
| Grew_parser.Parse_error (msg,None) -> let load_graph file =
raise (Parsing_err (sprintf "[file:%s] %s" file msg)) handle ~name:"load_graph" ~file
| Error.Build (msg,loc) -> raise (Build (msg,loc)) (fun () ->
| Error.Bug (msg, loc) -> raise (Bug (msg,loc)) if Filename.check_suffix file ".gr"
| exc -> raise (Bug (sprintf "[Libgrew.load_conll] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None)) then load_gr file
else if Filename.check_suffix file ".conll"
let load_graph file = then load_conll file
if Filename.check_suffix file ".gr" else
then load_gr file begin
else if Filename.check_suffix file ".conll" Log.fwarning "Unknown file format for input graph '%s', try to guess..." file;
then load_conll file try load_gr file with
else Parsing_err _ ->
begin try load_conll file with
Log.fwarning "Unknown file format for input graph '%s', try to guess..." file; Parsing_err _ ->
try load_gr file with Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file
Parsing_err _ -> end
try load_conll file with ) ()
Parsing_err _ ->
Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file
end
let xml_graph xml = let xml_graph xml =
try Instance.from_graph (G_graph.of_xml xml) with handle ~name:"xml_graph" (fun () -> Instance.from_graph (G_graph.of_xml xml)) ()
| Error.Build (msg,loc) -> raise (Build (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "[Libgrew.load_conll] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
let raw_graph instance = let raw_graph instance =
G_graph.to_raw instance.Instance.graph handle ~name:"raw_graph" (fun () -> G_graph.to_raw instance.Instance.graph) ()
let rewrite ~gr ~grs ~seq = let rewrite ~gr ~grs ~seq =
try Grs.rewrite grs seq gr handle ~name:"rewrite" (fun () -> Grs.rewrite grs seq gr) ()
with
| Error.Run (msg,loc) -> raise (Run (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "[Libgrew.rewrite] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
let display ~gr ~grs ~seq = let display ~gr ~grs ~seq =
try Grs.build_rew_display grs seq gr handle ~name:"display" (fun () -> Grs.build_rew_display grs seq gr) ()
with
| Error.Run (msg,loc) -> raise (Run (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| Error.Build (msg, loc) -> raise (Build (msg,loc))
| exc -> raise (Bug (sprintf "[Libgrew.display] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
let write_stat filename rew_hist = Gr_stat.save filename (Gr_stat.from_rew_history rew_hist) let write_stat filename rew_hist =
handle ~name:"write_stat" (fun () -> Gr_stat.save filename (Gr_stat.from_rew_history rew_hist)) ()
let save_index ~dirname ~base_names = let save_index ~dirname ~base_names =
let out_ch = open_out (Filename.concat dirname "index") in handle ~name:"save_index" (fun () ->
List.iter (fun f -> fprintf out_ch "%s\n" f) base_names; let out_ch = open_out (Filename.concat dirname "index") in
close_out out_ch List.iter (fun f -> fprintf out_ch "%s\n" f) base_names;
close_out out_ch
) ()
let save_graph_conll filename graph = let save_graph_conll filename graph =
let out_ch = open_out filename in handle ~name:"save_graph_conll" (fun () ->
fprintf out_ch "%s" (Instance.to_conll graph); let out_ch = open_out filename in
close_out out_ch fprintf out_ch "%s" (Instance.to_conll graph);
close_out out_ch
) ()