Commit d747112c authored by bguillaum's avatar bguillaum

add a new type domain in ast/libgrew

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8838 7838e531-6607-4d57-9587-6c381814729c
parent d1bdd7f2
......@@ -266,16 +266,21 @@ module Ast = struct
| Modul of modul
| Includ of (string * Loc.t)
type domain = {
feature_domain: Feature_domain.feature_spec list;
label_domain: (string * string list) list;
}
let empty_domain = { feature_domain=[]; label_domain=[] }
type grs_with_include = {
domain_wi: Feature_domain.feature_spec list;
labels_wi: (string * string list) list; (* the list of global edge labels *)
domain_wi: domain;
modules_wi: module_or_include list;
sequences_wi: sequence list;
}
type grs = {
domain: Feature_domain.feature_spec list;
labels: (string * string list) list;
domain: domain;
modules: modul list;
sequences: sequence list;
}
......@@ -286,6 +291,6 @@ module Ast = struct
edges: edge list;
}
let empty_grs = { domain = []; labels = []; modules = []; sequences= [] }
let empty_grs = { domain = empty_domain; modules = []; sequences= [] }
end (* module Ast *)
......@@ -181,17 +181,20 @@ module Ast : sig
| Modul of modul
| Includ of (string * Loc.t)
type domain = {
feature_domain: Feature_domain.feature_spec list;
label_domain: (string * string list) list;
}
type grs_with_include = {
domain_wi: Feature_domain.feature_spec list;
labels_wi: (string * string list) list; (* the list of global edge labels *)
domain_wi: domain;
modules_wi: module_or_include list;
sequences_wi: sequence list;
}
(* a GRS: graph rewriting system *)
type grs = {
domain: Feature_domain.feature_spec list;
labels: (string * string list) list;
domain: domain;
modules: modul list;
sequences: sequence list;
}
......
......@@ -250,11 +250,14 @@ module Grs = struct
| s::tail -> loop (s.Sequence.name :: already_defined) tail in
loop [] t.sequences
let domain_build ast_domain =
Domain.build
(Label_domain.build ast_domain.Ast.label_domain)
(Feature_domain.build ast_domain.Ast.feature_domain)
let build filename =
let ast = Loader.grs filename in
let domain = Domain.build
(Label_domain.build ast.Ast.labels)
(Feature_domain.build ast.Ast.domain) in
let domain = domain_build ast.Ast.domain in
let modules = List.map (Modul.build domain) ast.Ast.modules in
let grs = {domain; sequences = List.map (Sequence.build modules) ast.Ast.sequences; modules; ast; filename} in
check grs;
......
......@@ -92,6 +92,8 @@ module Grs: sig
val sequence_names: t -> string list
val domain_build: Ast.domain -> Domain.t
(** [build filename] returns the GRS defined in the file [filename] *)
val build: string -> t
......
......@@ -405,12 +405,12 @@ module Html_doc = struct
| Feature_domain.Closed (feat_name,values) -> wnl "<b>%s</b> : %s<br/>" feat_name (String.concat " | " values)
| Feature_domain.Open feat_name -> wnl " <b>%s</b> : *<br/>" feat_name
| Feature_domain.Num feat_name -> wnl " <b>%s</b> : #<br/>" feat_name
) ast.Ast.domain;
) ast.Ast.feature_domain;
wnl " </code>";
wnl " <h6>Labels</h6>";
wnl " <code class=\"code\">";
(match ast.Ast.labels with
(match ast.Ast.label_domain with
| [] -> wnl "No labels defined!"
| (l,c)::t -> w "<font color=\"%s\">%s</font>" (of_opt_color c) l;
List.iter
......@@ -489,7 +489,7 @@ module Html_doc = struct
let domain = Filename.concat output_dir "domain.html" in
let domain_out_ch = open_out domain in
output_string domain_out_ch (domain_text ~corpus ast);
output_string domain_out_ch (domain_text ~corpus ast.Ast.domain);
close_out domain_out_ch;
(** Modules + rules **)
......
......@@ -58,6 +58,17 @@ module Loader = struct
module_list
with Sys_error msg-> raise (Error (msg, None))
(* ------------------------------------------------------------------------------------------*)
let domain file =
try
Global.init file;
let in_ch = open_in file in
let lexbuf = Lexing.from_channel in_ch in
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))
(* ------------------------------------------------------------------------------------------*)
(**
[parse_string file] where [file] is a file following the grew syntax
......@@ -80,7 +91,6 @@ module Loader = struct
@ (flatten_modules current_file tail) in
{
Ast.domain = grs_with_includes.Ast.domain_wi;
Ast.labels = grs_with_includes.Ast.labels_wi;
Ast.modules = flatten_modules main_file grs_with_includes.Ast.modules_wi;
Ast.sequences = grs_with_includes.Ast.sequences_wi;
}
......
......@@ -17,6 +17,8 @@ module Loader: sig
(* message and location *)
exception Error of (string * Loc.t option)
val domain: string -> Ast.domain
val grs: string -> Ast.grs
val gr: string -> Ast.gr
......
......@@ -110,6 +110,7 @@ let localize t = (t,get_loc ())
%start <Grew_ast.Ast.gr> gr
%start <Grew_ast.Ast.module_or_include list> included
%start <Grew_ast.Ast.pattern> pattern
%start <Grew_ast.Ast.domain> domain
%left SEMIC
%left PLUS
......@@ -192,24 +193,33 @@ gr_item:
| n1_loc=simple_id_with_loc label=delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) n2=simple_id
{ Graph_edge ({Ast.edge_id = None; src=fst n1_loc; edge_label_cst=([label],false); tar=n2}, snd n1_loc) }
/*=============================================================================================*/
/* DOMAIN DEFINITION */
/*=============================================================================================*/
domain:
| f=features_group g=labels
{
{ Ast.feature_domain = f;
label_domain = g;
}
}
/*=============================================================================================*/
/* GREW GRAPH REWRITING SYSTEM */
/*=============================================================================================*/
grs_with_include:
| f=features_group g=labels m=module_or_include_list s=option(sequences) EOF
| d=domain m=module_or_include_list s=option(sequences) EOF
{
{ Ast.domain_wi=f;
labels_wi=g;
{ Ast.domain_wi=d;
modules_wi=m;
sequences_wi=match s with Some seq -> seq | None -> [];
}
}
grs:
| f=features_group g=labels m=modules s=option(sequences) EOF
| d=domain m=modules s=option(sequences) EOF
{
{ Ast.domain=f;
labels=g;
{ Ast.domain=d;
modules=m;
sequences=match s with Some seq -> seq | None -> [];
}
......
......@@ -20,6 +20,7 @@ ENDIF
open Grew_fs
open Grew_base
open Grew_types
open Grew_ast
open Grew_graph
open Grew_rule
open Grew_grs
......@@ -57,114 +58,76 @@ let handle ?(name="") ?(file="No file defined") fct () =
| exc -> raise (Bug (sprintf "[Libgrew.%s] UNCATCHED EXCEPTION: %s" name (Printexc.to_string exc), None))
(* -------------------------------------------------------------------------------- *)
(** {2 Graph Rewriting System} *)
type grs = Grs.t
let empty_grs = Grs.empty
let load_grs file =
handle ~name:"load_grs" ~file
(fun () ->
if not (Sys.file_exists file)
then raise (File_dont_exists file)
else Grs.build file
) ()
let get_sequence_names grs =
handle ~name:"get_sequence_names"
(fun () ->
Grs.sequence_names grs
) ()
IFDEF DEP2PICT THEN
let build_html_doc ?(corpus=false) dir grs =
handle ~name:"build_doc [with Dep2pict]"
(fun () ->
Html_doc.build ~corpus ~dep:true dir grs;
(* draw pattern graphs for all rules and all filters *)
let fct module_ rule_ =
let dep_code = Rule.to_dep (Grs.get_domain grs) rule_ in
let dep_png_file = sprintf "%s/%s_%s-patt.png" dir module_ (Rule.get_name rule_) in
let d2p = Dep2pict.from_dep ~dep:dep_code in
Dep2pict.save_png ~filename:dep_png_file d2p in
Grs.rule_iter fct grs;
Grs.filter_iter fct grs
) ()
ELSE
let build_html_doc ?(corpus=false) dir grs =
handle ~name:"build_doc [without Dep2pict]" (fun () -> Html_doc.build ~corpus ~dep:false dir grs) ()
END
(** {2 Domain} *)
type domain = Domain.t
let feature_names grs = handle ~name:"feature_names" (fun () -> Domain.feature_names (Grs.get_domain grs)) ()
let load_domain filename =
let ast = Loader.domain filename in
Grs.domain_build ast
(* -------------------------------------------------------------------------------- *)
(** {2 Graph} *)
type graph = G_graph.t
let load_gr grs file =
let load_gr domain file =
if not (Sys.file_exists file)
then raise (File_dont_exists file)
else
handle ~name:"load_gr" ~file
(fun () ->
let gr_ast = Loader.gr file in
G_graph.build (Grs.get_domain grs) gr_ast
G_graph.build domain gr_ast
) ()
let load_conll grs file =
let load_conll domain file =
handle ~name:"load_conll" ~file
(fun () ->
G_graph.of_conll ~loc:(Loc.file file) (Grs.get_domain grs) (Conll.load file)
G_graph.of_conll ~loc:(Loc.file file) domain (Conll.load file)
) ()
let load_brown grs file =
let load_brown domain file =
handle ~name:"load_brown"
(fun () ->
let brown = File.load file in
G_graph.of_brown (Grs.get_domain grs) brown
G_graph.of_brown domain brown
) ()
let load_graph grs file =
let load_graph domain file =
handle ~name:"load_graph" ~file
(fun () ->
match File.get_suffix file with
| Some ".gr" -> load_gr grs file
| Some ".conll" -> load_conll grs file
| Some ".br" | Some ".melt" -> load_brown grs file
| Some ".gr" -> load_gr domain file
| Some ".conll" -> load_conll domain file
| Some ".br" | Some ".melt" -> load_brown domain file
| _ ->
Log.fwarning "Unknown file format for input graph '%s', try to guess..." file;
let rec loop = function
| [] -> Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file
| load_fct :: tail -> try load_fct grs file with _ -> loop tail in
| load_fct :: tail -> try load_fct domain file with _ -> loop tail in
loop [load_gr; load_conll; load_brown]
) ()
let of_conll grs file_name line_list =
let of_conll domain file_name line_list =
handle ~name:"of_conll"
(fun () ->
G_graph.of_conll ~loc:(Loc.file file_name) (Grs.get_domain grs) (Conll.parse file_name line_list)
G_graph.of_conll ~loc:(Loc.file file_name) domain (Conll.parse file_name line_list)
) ()
let of_brown grs ?sentid brown =
handle ~name:"of_brown"
(fun () ->
G_graph.of_brown (Grs.get_domain grs) ?sentid brown
) ()
let of_brown domain ?sentid brown =
handle ~name:"of_brown" (fun () -> G_graph.of_brown domain ?sentid brown) ()
let to_dot_graph grs ?main_feat ?(deco=G_deco.empty) graph =
handle ~name:"to_dot_graph" (fun () -> G_graph.to_dot (Grs.get_domain grs) ?main_feat graph ~deco) ()
let to_dot_graph domain ?main_feat ?(deco=G_deco.empty) graph =
handle ~name:"to_dot_graph" (fun () -> G_graph.to_dot domain ?main_feat graph ~deco) ()
let to_dep_graph grs ?filter ?main_feat ?(deco=G_deco.empty) graph =
handle ~name:"to_dep_graph" (fun () -> G_graph.to_dep (Grs.get_domain grs) ?filter ?main_feat ~deco graph) ()
let to_dep_graph domain ?filter ?main_feat ?(deco=G_deco.empty) graph =
handle ~name:"to_dep_graph" (fun () -> G_graph.to_dep domain ?filter ?main_feat ~deco graph) ()
let to_gr_graph grs graph =
handle ~name:"to_gr_graph" (fun () -> G_graph.to_gr (Grs.get_domain grs) graph) ()
let to_gr_graph domain graph =
handle ~name:"to_gr_graph" (fun () -> G_graph.to_gr domain graph) ()
let to_conll_graph grs graph =
handle ~name:"to_conll_graph" (fun () -> G_graph.to_conll (Grs.get_domain grs) graph) ()
let to_conll_graph domain graph =
handle ~name:"to_conll_graph" (fun () -> G_graph.to_conll domain graph) ()
let to_sentence ?main_feat gr =
handle ~name:"to_sentence"
......@@ -172,15 +135,57 @@ let to_sentence ?main_feat gr =
G_graph.to_sentence ?main_feat gr
) ()
let save_graph_conll grs filename graph =
let save_graph_conll domain filename graph =
handle ~name:"save_graph_conll" (fun () ->
let out_ch = open_out filename in
fprintf out_ch "%s" (G_graph.to_conll (Grs.get_domain grs) graph);
fprintf out_ch "%s" (G_graph.to_conll domain graph);
close_out out_ch
) ()
let raw_graph grs gr =
handle ~name:"raw_graph" (fun () -> G_graph.to_raw (Grs.get_domain grs) gr) ()
let raw_graph domain gr =
handle ~name:"raw_graph" (fun () -> G_graph.to_raw domain gr) ()
(* -------------------------------------------------------------------------------- *)
(** {2 Graph Rewriting System} *)
type grs = Grs.t
let empty_grs = Grs.empty
let load_grs file =
handle ~name:"load_grs" ~file
(fun () ->
if not (Sys.file_exists file)
then raise (File_dont_exists file)
else Grs.build file
) ()
let get_sequence_names grs =
handle ~name:"get_sequence_names"
(fun () ->
Grs.sequence_names grs
) ()
IFDEF DEP2PICT THEN
let build_html_doc ?(corpus=false) dir grs =
handle ~name:"build_doc [with Dep2pict]"
(fun () ->
Html_doc.build ~corpus ~dep:true dir grs;
(* draw pattern graphs for all rules and all filters *)
let fct module_ rule_ =
let dep_code = Rule.to_dep (Grs.get_domain grs) rule_ in
let dep_png_file = sprintf "%s/%s_%s-patt.png" dir module_ (Rule.get_name rule_) in
let d2p = Dep2pict.from_dep ~dep:dep_code in
Dep2pict.save_png ~filename:dep_png_file d2p in
Grs.rule_iter fct grs;
Grs.filter_iter fct grs
) ()
ELSE
let build_html_doc ?(corpus=false) dir grs =
handle ~name:"build_doc [without Dep2pict]" (fun () -> Html_doc.build ~corpus ~dep:false dir grs) ()
END
let feature_names domain = handle ~name:"feature_names" (fun () -> Domain.feature_names domain) ()
(* -------------------------------------------------------------------------------- *)
(** {2 rew_display: data for the GUI } *)
......@@ -204,16 +209,11 @@ let num_sol rh =
let write_stat filename rew_hist =
handle ~name:"write_stat" (fun () -> Gr_stat.save filename (Gr_stat.from_rew_history rew_hist)) ()
let write_annot grs ~title static_dir annot_dir base_name_rew_hist_list =
handle ~name:"write_annot" (fun () -> Html_annot.build (Grs.get_domain grs) ~title static_dir annot_dir base_name_rew_hist_list) ()
let write_annot domain ~title static_dir annot_dir base_name_rew_hist_list =
handle ~name:"write_annot" (fun () -> Html_annot.build domain ~title static_dir annot_dir base_name_rew_hist_list) ()
let save_index ~dirname ~base_names =
handle ~name:"save_index" (fun () ->
......@@ -223,28 +223,28 @@ let save_index ~dirname ~base_names =
) ()
let save_gr grs base rew_hist =
handle ~name:"save_gr" (fun () -> Rewrite_history.save_gr (Grs.get_domain grs) base rew_hist) ()
let save_gr domain base rew_hist =
handle ~name:"save_gr" (fun () -> Rewrite_history.save_gr domain base rew_hist) ()
let save_conll grs base rew_hist =
handle ~name:"save_conll" (fun () -> Rewrite_history.save_conll (Grs.get_domain grs) base rew_hist) ()
let save_conll domain base rew_hist =
handle ~name:"save_conll" (fun () -> Rewrite_history.save_conll domain base rew_hist) ()
let save_full_conll grs base rew_hist =
handle ~name:"save_full_conll" (fun () -> Rewrite_history.save_full_conll (Grs.get_domain grs) base rew_hist) ()
let save_full_conll domain base rew_hist =
handle ~name:"save_full_conll" (fun () -> Rewrite_history.save_full_conll domain base rew_hist) ()
let save_det_gr grs base rew_hist =
handle ~name:"save_det_gr" (fun () -> Rewrite_history.save_det_gr (Grs.get_domain grs) base rew_hist) ()
let save_det_gr domain base rew_hist =
handle ~name:"save_det_gr" (fun () -> Rewrite_history.save_det_gr domain base rew_hist) ()
let save_det_conll grs ?header base rew_hist =
handle ~name:"save_deeeet_conll" (fun () -> Rewrite_history.save_det_conll (Grs.get_domain grs) ?header base rew_hist) ()
let save_det_conll domain ?header base rew_hist =
handle ~name:"save_deeeet_conll" (fun () -> Rewrite_history.save_det_conll domain ?header base rew_hist) ()
let det_dep_string grs rew_hist =
handle ~name:"det_dep_string" (fun () -> Rewrite_history.det_dep_string (Grs.get_domain grs) rew_hist) ()
let det_dep_string domain rew_hist =
handle ~name:"det_dep_string" (fun () -> Rewrite_history.det_dep_string domain rew_hist) ()
let conll_dep_string grs ?keep_empty_rh rew_hist =
handle ~name:"conll_dep_string" (fun () -> Rewrite_history.conll_dep_string (Grs.get_domain grs) ?keep_empty_rh rew_hist) ()
let conll_dep_string domain ?keep_empty_rh rew_hist =
handle ~name:"conll_dep_string" (fun () -> Rewrite_history.conll_dep_string domain ?keep_empty_rh rew_hist) ()
let write_html grs
let write_html domain
?(no_init=false)
?(out_gr=false)
?filter
......@@ -257,7 +257,7 @@ let write_html grs
handle ~name:"write_html" (fun () ->
ignore (
Html_rh.build
(Grs.get_domain grs)
domain
?filter
?main_feat
?dot
......@@ -269,7 +269,7 @@ let write_html grs
)
) ()
let error_html grs
let error_html domain
?(no_init=false)
?main_feat
?dot
......@@ -280,7 +280,7 @@ let error_html grs
handle ~name:"error_html" (fun () ->
ignore (
Html_rh.error
(Grs.get_domain grs)
domain
?main_feat
?dot
~init_graph: (not no_init)
......@@ -310,9 +310,9 @@ let html_sentences ~title = handle ~name:"html_sentences" (fun () -> Html_senten
type pattern = Rule.pattern
type matching = Rule.matching
let load_pattern grs file =
handle ~name:"load_pattern" (fun () -> Rule.build_pattern (Grs.get_domain grs) (Loader.pattern file)) ()
let load_pattern domain file =
handle ~name:"load_pattern" (fun () -> Rule.build_pattern domain (Loader.pattern file)) ()
let match_in_graph grs pattern graph = Rule.match_in_graph (Grs.get_domain grs) pattern graph
let match_in_graph domain pattern graph = Rule.match_in_graph domain pattern graph
let match_deco pattern matching = Rule.match_deco pattern matching
......@@ -37,25 +37,11 @@ exception Run of string * loc option
exception Bug of string * loc option
(* -------------------------------------------------------------------------------- *)
(** {2 Graph Rewriting System} *)
type grs
val empty_grs: grs
(** [load_grs filename] loads a graph rewriting system from [filename]
@raise Parsing_err if libgrew can't parse the file
@raise File_dont_exists if the file doesn't exists *)
val load_grs: string -> grs
(** {2 Domain} *)
type domain
(** [get_sequence_names grs] returns the list of sequence names defined in a GRS *)
val get_sequence_names: grs -> string list
(** [build_html_doc ?corpus directory grs]
@[corpus] is a flag (default is [false]) for complete html doc with corpus sentence. *)
val build_html_doc: ?corpus:bool -> string -> grs -> unit
val feature_names: grs -> string list option
val load_domain: string -> domain
(* -------------------------------------------------------------------------------- *)
(** {2 Graph} *)
......@@ -64,12 +50,12 @@ val feature_names: grs -> string list option
File extension should be '.gr' or '.conll'.
@raise Parsing_err if libgrew can't parse the file
@raise File_dont_exists if the file doesn't exists. *)
val load_graph: grs -> string -> graph
val load_graph: domain -> string -> graph
(** [of_conll filename line_list] *)
val of_conll: grs -> string -> (int * string) list -> graph
val of_conll: domain -> string -> (int * string) list -> graph
val of_brown: grs -> ?sentid:string -> string -> graph
val of_brown: domain -> ?sentid:string -> string -> graph
val to_sentence: ?main_feat:string -> graph -> string
......@@ -78,18 +64,38 @@ val to_sentence: ?main_feat:string -> graph -> string
- the list of node (node is a list of feature (feature is string * string))
- the list of edge (src, label, tar) where src and tar refers to the position in the node list
*)
val raw_graph: grs -> graph ->
val raw_graph: domain -> graph ->
(string * string) list *
(string * string) list list *
(int * string * int) list
val to_dot_graph : grs -> ?main_feat:string -> ?deco:deco -> graph -> string
val to_dot_graph : domain -> ?main_feat:string -> ?deco:deco -> graph -> string
val to_dep_graph : domain -> ?filter: string list -> ?main_feat:string -> ?deco:deco -> graph -> string
val to_gr_graph: domain -> graph -> string
val to_dep_graph : grs -> ?filter: string list -> ?main_feat:string -> ?deco:deco -> graph -> string
val to_conll_graph: domain -> graph -> string
val to_gr_graph: grs -> graph -> string
val to_conll_graph: grs -> graph -> string
(* -------------------------------------------------------------------------------- *)
(** {2 Graph Rewriting System} *)
type grs
val empty_grs: grs
(** [load_grs filename] loads a graph rewriting system from [filename]
@raise Parsing_err if libgrew can't parse the file
@raise File_dont_exists if the file doesn't exists *)
val load_grs: string -> grs
(** [get_sequence_names grs] returns the list of sequence names defined in a GRS *)
val get_sequence_names: grs -> string list
(** [build_html_doc ?corpus directory grs]
@[corpus] is a flag (default is [false]) for complete html doc with corpus sentence. *)
val build_html_doc: ?corpus:bool -> string -> grs -> unit
val feature_names: domain -> string list option
(* -------------------------------------------------------------------------------- *)
(** {2 rew_display: data for the GUI } *)
......@@ -114,29 +120,29 @@ val num_sol: rewrite_history -> int
val write_stat: string -> rewrite_history -> unit
val save_gr: grs -> string -> rewrite_history -> unit
val save_gr: domain -> string -> rewrite_history -> unit
val save_conll: grs -> string -> rewrite_history -> unit
val save_conll: domain -> string -> rewrite_history -> unit