Commit df4cba18 authored by bguillaum's avatar bguillaum

add new function in libgrew for grewpy

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@9032 7838e531-6607-4d57-9587-6c381814729c
parent 7c56884f
......@@ -40,17 +40,22 @@ end (* module Loc *)
module Error = struct
exception Build of (string * Loc.t option)
exception Run of (string * Loc.t option)
exception Bug of (string * Loc.t option)
let build_ ?loc message = raise (Build (message, loc))
let build ?loc = Printf.ksprintf (build_ ?loc)
exception Run of (string * Loc.t option)
let run_ ?loc message = raise (Run (message, loc))
let run ?loc = Printf.ksprintf (run_ ?loc)
exception Bug of (string * Loc.t option)
let bug_ ?loc message = raise (Bug (message, loc))
let bug ?loc = Printf.ksprintf (bug_ ?loc)
exception Parse of (string * Loc.t option)
let parse_ ?loc message = raise (Parse (message, loc))
let parse ?loc = Printf.ksprintf (parse_ ?loc)
end (* module Error *)
(* ================================================================================ *)
......
......@@ -236,12 +236,16 @@ module Massoc_make (Ord : OrderedType) : S with type key = Ord.t
(* ================================================================================ *)
module Error: sig
exception Build of (string * Loc.t option)
exception Run of (string * Loc.t option)
exception Bug of (string * Loc.t option)
val build: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
exception Run of (string * Loc.t option)
val run: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
exception Bug of (string * Loc.t option)
val bug: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
exception Parse of (string * Loc.t option)
val parse: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
end
(* ================================================================================ *)
......
......@@ -311,8 +311,6 @@ module G_graph = struct
{meta=gr_ast.Ast.meta; map=map; fusion = []; highest_index = (List.length full_node_list) -1}
(* -------------------------------------------------------------------------------- *)
let of_conll domain conll =
......
......@@ -30,6 +30,11 @@ module Rewrite_history = struct
bad_nf: Instance.t list;
}
let rec get_graphs = function
| { good_nf = []; bad_nf = []; instance } -> [instance.Instance.graph]
| { good_nf = [] } -> []
| { good_nf = l} -> List_.flat_map get_graphs l
let rec is_empty t =
(t.instance.Instance.rules = []) && List.for_all is_empty t.good_nf
......
......@@ -23,6 +23,8 @@ module Rewrite_history: sig
bad_nf: Instance.t list;
}
val get_graphs: t -> G_graph.t list
val is_empty: t -> bool
val num_sol: t -> int
......
......@@ -11,30 +11,18 @@
open Grew_base
open Grew_ast
module Loader = struct
(* ------------------------------------------------------------------------------------------*)
(** general function to handle parse errors *)
let parse_handle file fct lexbuf =
let get_loc () = Loc.file_line file !Global.current_line in
try fct lexbuf with
| Grew_lexer.Error msg -> Error.parse ~loc:(get_loc ()) "Lexing error: %s" msg
| Grew_parser.Error -> Error.parse ~loc:(get_loc ()) "Syntax error: %s" (Lexing.lexeme lexbuf)
| Failure msg -> Error.parse ~loc:(get_loc ()) "Failure: %s" msg
| err -> Error.bug ~loc:(get_loc ()) "Unexpected error: %s" (Printexc.to_string err)
(* message and location *)
exception Error of (string * Loc.t option)
module Loader = struct
(* ------------------------------------------------------------------------------------------*)
(** general function to handle parse errors *)
let parse_handle file fct lexbuf =
try fct lexbuf with
| Grew_lexer.Error msg ->
let cp = !Global.current_line in
raise (Error ("Lexing error:"^msg, Some (Loc.file_line file cp)))
| Grew_parser.Error ->
let cp = !Global.current_line in
raise (Error ("Syntax error:"^(Lexing.lexeme lexbuf), Some (Loc.file_line file cp)))
| Failure msg ->
let cp = !Global.current_line in
raise (Error ("Failure:"^msg, Some (Loc.file_line file cp)))
| Error.Build (msg,_) ->
let cp = !Global.current_line in
raise (Error ("Syntax error:"^msg, Some (Loc.file_line file cp)))
| err ->
let cp = !Global.current_line in
raise (Error ("Unexpected error:"^(Printexc.to_string err), Some (Loc.file_line file cp)))
(* ------------------------------------------------------------------------------------------*)
let parse_file_to_grs_wi file =
......@@ -45,10 +33,10 @@ module Loader = struct
let grs = parse_handle file (Grew_parser.grs_wi Grew_lexer.global) lexbuf in
close_in in_ch;
grs
with Sys_error msg -> raise (Error (msg, None))
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.parse_file_to_grs_wi] %s" msg
(* ------------------------------------------------------------------------------------------*)
let parse_file_to_module_list loc file =
let parse_file_to_module_list file =
try
Global.init file;
let in_ch = open_in file in
......@@ -56,7 +44,7 @@ module Loader = struct
let module_list = parse_handle file (Grew_parser.included Grew_lexer.global) lexbuf in
close_in in_ch;
module_list
with Sys_error msg-> raise (Error (msg, None))
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.parse_file_to_module_list] %s" msg
(* ------------------------------------------------------------------------------------------*)
let domain file =
......@@ -67,7 +55,7 @@ module Loader = struct
let gr = parse_handle file (Grew_parser.domain Grew_lexer.global) lexbuf in
close_in in_ch;
gr
with Sys_error msg-> raise (Error (msg, None))
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.domain] %s" msg
(* ------------------------------------------------------------------------------------------*)
(**
......@@ -90,7 +78,7 @@ module Loader = struct
if Filename.is_relative inc_file
then Filename.concat (Filename.dirname current_file) inc_file
else inc_file in
(flatten_modules sub_file (parse_file_to_module_list loc sub_file))
(flatten_modules sub_file (parse_file_to_module_list sub_file))
@ (flatten_modules current_file tail) in
{
Ast.domain = domain;
......@@ -107,7 +95,8 @@ module Loader = struct
let gr = parse_handle file (Grew_parser.gr Grew_lexer.global) lexbuf in
close_in in_ch;
gr
with Sys_error msg-> raise (Error (msg, None))
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.gr] %s" msg
(* ------------------------------------------------------------------------------------------*)
let pattern file =
......@@ -118,6 +107,18 @@ module Loader = struct
let gr = parse_handle file (Grew_parser.pattern Grew_lexer.global) lexbuf in
close_in in_ch;
gr
with Sys_error msg-> raise (Error (msg, None))
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.pattern] %s" msg
end (* module Loader *)
module Parser = struct
(* ------------------------------------------------------------------------------------------*)
let gr gr_string =
try
Global.init "from_string";
let lexbuf = Lexing.from_string gr_string in
let gr = parse_handle "from_string" (Grew_parser.gr Grew_lexer.global) lexbuf in
gr
with Sys_error msg -> Error.parse "[Grew_parser.gr] %s" msg
end
......@@ -13,10 +13,6 @@ open Grew_base
open Grew_ast
module Loader: sig
(* message and location *)
exception Error of (string * Loc.t option)
val domain: string -> Ast.domain
val grs: string -> Ast.grs
......@@ -25,3 +21,7 @@ module Loader: sig
val pattern: string -> Ast.pattern
end
module Parser : sig
val gr: string -> Ast.gr
end
\ No newline at end of file
......@@ -56,9 +56,7 @@ module G_node = struct
(G_fs.to_string t.fs)
(Massoc_gid.to_string (G_edge.to_string label_domain) t.next)
let to_gr t = if t.position < 0.
then sprintf "[%s] " (G_fs.to_gr t.fs)
else sprintf "(%g) [%s] " t.position (G_fs.to_gr t.fs)
let to_gr t = sprintf "[%s] " (G_fs.to_gr t.fs)
let add_edge g_edge gid_tar t =
match Massoc_gid.add gid_tar g_edge t.next with
......
......@@ -42,7 +42,7 @@ let handle ?(name="") ?(file="No file defined") fct () =
| File_not_found file -> raise (File_not_found file)
(* Catch new exceptions *)
| Grew_loader.Loader.Error (msg, loc_opt) -> raise (Parsing_err (msg, loc_opt))
| Grew_base.Error.Parse (msg, loc_opt) -> raise (Parsing_err (msg, loc_opt))
| Grew_base.Error.Build (msg, loc_opt) -> raise (Build (msg, loc_opt))
| Grew_base.Error.Bug (msg, loc_opt) -> raise (Bug (msg,loc_opt))
| Grew_base.Error.Run (msg, loc_opt) -> raise (Run (msg,loc_opt))
......@@ -136,8 +136,11 @@ type t = Grew_graph.G_graph.t
loop [load_gr; load_conll; load_brown]
) ()
let of_gr domain gr_string =
handle ~name:"Graph.of_gr" (fun () -> Grew_graph.G_graph.build domain (Grew_loader.Parser.gr gr_string)) ()
let of_conll domain conll =
handle ~name:"Graph.xxx_of_conll" (fun () -> Grew_graph.G_graph.of_conll domain conll) ()
handle ~name:"Graph.of_conll" (fun () -> Grew_graph.G_graph.of_conll domain conll) ()
let of_brown domain ?sentid brown =
handle ~name:"Graph.of_brown" (fun () -> Grew_graph.G_graph.of_brown domain ?sentid brown) ()
......@@ -241,6 +244,9 @@ module Rewrite = struct
let rewrite ~gr ~grs ~seq =
handle ~name:"Rewrite.rewrite" (fun () -> Grew_grs.Grs.rewrite grs seq gr) ()
let get_graphs rh =
handle ~name:"Rewrite.get_graphs" (fun () -> Grew_grs.Rewrite_history.get_graphs rh) ()
let is_empty rh =
handle ~name:"Rewrite.is_empty" (fun () -> Grew_grs.Rewrite_history.is_empty rh) ()
......
......@@ -87,6 +87,8 @@ module Graph : sig
@raise File_not_found if the file doesn't exists. *)
val load: Domain.t -> string -> t
val of_gr: Domain.t -> string -> t
val of_conll: Domain.t -> Conll.t -> t
val of_brown: Domain.t -> ?sentid:string -> string -> t
......@@ -163,6 +165,8 @@ module Rewrite: sig
val rewrite: gr:Graph.t -> grs:Grs.t -> seq:string -> history
val get_graphs: history -> Graph.t list
val is_empty: history -> bool
val num_sol: history -> int
......
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