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

src/grew_ast.ml

@@ -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 *)

src/grew_ast.mli

@@ -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;
     }

src/grew_grs.ml

@@ -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;

src/grew_grs.mli

@@ -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
 

src/grew_html.ml

@@ -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 **)

src/grew_loader.ml

@@ -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;
     }

src/grew_loader.mli

@@ -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

src/grew_parser.mly

@@ -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 -> [];
              }

src/libgrew.mli

@@ -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
 
 (** [save_full_conll base_name rh] saves one conll_file for each normal form defined in [rh].
     Output files are named according to [base_name] and a secondary index after "__".
     The number of conll file produced is returned. *)
-val save_full_conll: grs -> string -> rewrite_history -> int
+val save_full_conll: domain -> string -> rewrite_history -> int
 
-val save_det_gr: grs -> string -> rewrite_history -> unit
+val save_det_gr: domain -> string -> rewrite_history -> unit
 
-val save_det_conll: grs -> ?header:string -> string -> rewrite_history -> unit
+val save_det_conll: domain -> ?header:string -> string -> rewrite_history -> unit
 
-val det_dep_string: grs -> rewrite_history -> string option
+val det_dep_string: domain -> rewrite_history -> string option
 
-val conll_dep_string: grs -> ?keep_empty_rh:bool -> rewrite_history -> string option
+val conll_dep_string: domain -> ?keep_empty_rh:bool -> rewrite_history -> string option
 
 val save_index: dirname:string -> base_names: string list -> unit
 
-val write_annot: grs -> title:string -> string -> string -> (string * rewrite_history) list -> unit
+val write_annot: domain -> title:string -> string -> string -> (string * rewrite_history) list -> unit
 
 val write_html:
-    grs ->
+    domain ->
     ?no_init: bool ->
     ?out_gr: bool ->
     ?filter: string list ->
@@ -149,7 +155,7 @@ val write_html:
     unit
 
 val error_html:
-    grs ->
+    domain ->
     ?no_init:bool ->
     ?main_feat:string ->
     ?dot: bool ->
@@ -179,11 +185,11 @@ val html_sentences: title:string -> string -> (bool * string * int * string) lis
 type pattern
 type matching
 
-(** [load_pattern filename] returns the pattern describer in the fuile *)
-val load_pattern: grs -> string -> pattern
+(** [load_pattern filename] returns the pattern described in the file *)
+val load_pattern: domain -> string -> pattern
 
-(** [match_in_graph patern graph] returns the list of the possible matching og [pattern] in [graph] *)
-val match_in_graph: grs -> pattern -> graph -> matching list
+(** [match_in_graph pattern graph] returns the list of the possible matching og [pattern] in [graph] *)
+val match_in_graph: domain -> pattern -> graph -> matching list
 
 (** [match_deco pattern matching] returns the deco to be used in the graphical representation.
     WARNING: the function supposes that [matching] was find with the given [pattern]! *)