The domain is encoded in GRS and is not anymore a global variable

WARNING: breaks libgrew.mli

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8832 7838e531-6607-4d57-9587-6c381814729c

src/grew_ast.ml

@@ -267,14 +267,14 @@ module Ast = struct
     | Includ of (string * Loc.t)
 
   type grs_with_include = {
-    domain_wi: Domain.t;
+    domain_wi: Domain.feature_spec list;
     labels_wi: (string * string list) list;    (* the list of global edge labels *)
     modules_wi: module_or_include list;
     sequences_wi: sequence list;
   }
 
   type grs = {
-    domain: Domain.t;
+    domain: Domain.feature_spec list;
     labels: (string * string list) list;
     modules: modul list;
     sequences: sequence list;

src/grew_ast.mli

@@ -182,7 +182,7 @@ module Ast : sig
     | Includ of (string * Loc.t)
 
   type grs_with_include = {
-      domain_wi: Domain.t;
+      domain_wi: Domain.feature_spec list;
       labels_wi: (string * string list) list;    (* the list of global edge labels *)
       modules_wi: module_or_include list;
       sequences_wi: sequence list;
@@ -190,7 +190,7 @@ module Ast : sig
 
   (* a GRS: graph rewriting system *)
   type grs = {
-      domain: Domain.t;
+      domain: Domain.feature_spec list;
       labels: (string * string list) list;
       modules: modul list;
       sequences: sequence list;

src/grew_command.ml

@@ -65,7 +65,7 @@ module Command  = struct
     | H_MERGE_NODE of (Gid.t * Gid.t)
     | H_ACT_NODE of (Gid.t * string)
 
-  let build ?param (kai, kei) table locals suffixes ast_command =
+  let build domain ?param (kai, kei) table locals suffixes ast_command =
     (* kai stands for "known act ident", kei for "known edge ident" *)
 
     let pid_of_act_id loc = function
@@ -169,7 +169,7 @@ module Command  = struct
           if feat_name = "position"
           then Error.build ~loc "Illegal del_feat command: the 'position' feature cannot be deleted";
           check_act_id loc act_id kai;
-          Domain.check_feature_name ~loc feat_name;
+          Domain.check_feature_name ~loc domain feat_name;
           ((DEL_FEAT (pid_of_act_id loc act_id, feat_name), loc), (kai, kei))
 
       | (Ast.Update_feat ((act_id, feat_name), ast_items), loc) ->
@@ -178,7 +178,7 @@ module Command  = struct
             (function
               | Ast.Qfn_item (node_id,feature_name) ->
                 check_node_id loc node_id kai;
-                Domain.check_feature_name ~loc feature_name;
+                Domain.check_feature_name ~loc domain feature_name;
                 Feat (pid_of_node_id loc node_id, feature_name)
               | Ast.String_item s -> String s
               | Ast.Param_item var ->
@@ -192,9 +192,9 @@ module Command  = struct
             ) ast_items in
             (* check for consistency *)
             (match items with
-              | _ when Domain.is_open feat_name -> ()
+              | _ when Domain.is_open domain feat_name -> ()
               | [Param_out _] -> () (* TODO: check that lexical parameters are compatible with the feature domain *)
-              | [String s] -> Domain.check_feature ~loc feat_name s
+              | [String s] -> Domain.check_feature ~loc domain feat_name s
               | [Feat (_,fn)] -> ()
               | _ -> Error.build ~loc "[Update_feat] Only open features can be modified with the concat operator '+' but \"%s\" is not declared as an open feature" feat_name);
           ((UPDATE_FEAT (pid_of_act_id loc act_id, feat_name, items), loc), (kai, kei))

src/grew_command.mli

@@ -58,6 +58,7 @@ module Command : sig
     | H_ACT_NODE of (Gid.t * string)
 
   val build:
+      Domain.t ->
       ?param: (string list * string list) ->
       (Ast.command_node_ident list * string list) ->
       Id.table ->

src/grew_fs.ml

@@ -33,9 +33,9 @@ module G_feature = struct
     | (None, Some j) -> 1
     | (None, None) -> Pervasives.compare name1 name2    
 
-  let build (x : Ast.feature) = match x with
+  let build domain = function
     | ({Ast.kind=Ast.Equality [atom]; name=name},loc) ->
-      (name, Domain.build_one ~loc name atom)
+      (name, Domain.build_value ~loc domain name atom)
     | _ -> Error.build "Illegal feature declaration in Graph (must be '=' and atomic)"
 
   let to_string (feat_name, feat_val) = sprintf "%s=%s" feat_name (string_of_value feat_val)
@@ -130,14 +130,14 @@ module P_feature = struct
 
     | _ -> Error.bug "[P_feature.to_string] multiple parameters are not handled"
 
-  let build ?pat_vars = function
+  let build domain ?pat_vars = function
     | ({Ast.kind=Ast.Absent; name=name}, loc) -> 
-      Domain.check_feature_name ~loc name;
+      Domain.check_feature_name ~loc domain name;
       (name, {cst=Absent;in_param=[];})
     | ({Ast.kind=Ast.Equality unsorted_values; name=name}, loc) ->
-      let values = Domain.build ~loc name unsorted_values in (name, {cst=Equal values;in_param=[];})
+      let values = Domain.build_disj ~loc domain name unsorted_values in (name, {cst=Equal values;in_param=[];})
     | ({Ast.kind=Ast.Disequality unsorted_values; name=name}, loc) ->
-      let values = Domain.build ~loc name unsorted_values in (name, {cst=Different values;in_param=[];})
+      let values = Domain.build_disj ~loc domain name unsorted_values in (name, {cst=Different values;in_param=[];})
     | ({Ast.kind=Ast.Equal_param var; name=name}, loc) ->
         begin
           match pat_vars with
@@ -161,8 +161,8 @@ module G_fs = struct
   let empty = []
 
   (* ---------------------------------------------------------------------- *)
-  let set_feat ?loc feature_name atom t =
-    let new_value = Domain.build_one ?loc feature_name atom in
+  let set_feat ?loc domain feature_name atom t =
+    let new_value = Domain.build_value ?loc domain feature_name atom in
     let rec loop = function
     | [] -> [(feature_name, new_value)]
     | ((fn,_)::_) as t when feature_name < fn -> (feature_name, new_value)::t
@@ -203,22 +203,22 @@ module G_fs = struct
   let to_gr t = List_.to_string G_feature.to_gr ", " t
 
   (* ---------------------------------------------------------------------- *)
-  let build ast_fs =
-    let unsorted = List.map (fun feat -> G_feature.build feat) ast_fs in
+  let build domain ast_fs =
+    let unsorted = List.map (fun feat -> G_feature.build domain feat) ast_fs in
     List.sort G_feature.compare unsorted
 
   (* ---------------------------------------------------------------------- *)
-  let of_conll ?loc line =
+  let of_conll ?loc domain line =
     let raw_list0 =
-      ("phon", Domain.build_one ?loc "phon" line.Conll.phon)
-      :: ("cat", Domain.build_one ?loc "cat" line.Conll.pos1)
-      :: (List.map (fun (f,v) -> (f, Domain.build_one ?loc f v)) line.Conll.morph) in
+      ("phon", Domain.build_value ?loc domain "phon" line.Conll.phon)
+      :: ("cat", Domain.build_value ?loc domain "cat" line.Conll.pos1)
+      :: (List.map (fun (f,v) -> (f, Domain.build_value ?loc domain f v)) line.Conll.morph) in
     let raw_list1 = match line.Conll.pos2 with
       | "" | "_" -> raw_list0
-      | s -> ("pos", Domain.build_one ?loc "pos" s) :: raw_list0 in
+      | s -> ("pos", Domain.build_value ?loc domain "pos" s) :: raw_list0 in
     let raw_list2 = match line.Conll.lemma with
       | "" | "_" -> raw_list1
-      | s -> ("lemma", Domain.build_one ?loc "lemma" s) :: raw_list1 in
+      | s -> ("lemma", Domain.build_value ?loc domain "lemma" s) :: raw_list1 in
     List.sort G_feature.compare raw_list2
 
   (* ---------------------------------------------------------------------- *)
@@ -347,8 +347,8 @@ module P_fs = struct
         | _ -> Error.bug "Position can't be parametrized"
     with Not_found -> true
 
-  let build ?pat_vars ast_fs =
-    let unsorted = List.map (P_feature.build ?pat_vars) ast_fs in
+  let build domain ?pat_vars ast_fs =
+    let unsorted = List.map (P_feature.build domain ?pat_vars) ast_fs in
     List.sort P_feature.compare unsorted
 
   let feat_list t = List.map P_feature.get_name t

src/grew_fs.mli

@@ -19,9 +19,9 @@ module G_fs: sig
 
   val empty: t
 
-  (** [set_feat feature_name atom t] adds the feature ([feature_name],[atom]) in [t].
+  (** [set_feat domain feature_name atom t] adds the feature ([feature_name],[atom]) in [t].
       If [t] already contains a feature named [feature_name], the old value is erased by the new one. *)
-  val set_feat: ?loc:Loc.t -> string -> string -> t ->  t
+  val set_feat: ?loc:Loc.t -> Domain.t -> feature_name -> string -> t ->  t
 
   (** [del_feat feature_name t] remove the feature with name [feature_name] in [t].
       If [t] does not contain such a feature, [t] is returned unchanged. *)
@@ -46,9 +46,9 @@ module G_fs: sig
 
   val to_string: t -> string
 
-  val build: Ast.feature list -> t
+  val build: Domain.t -> Ast.feature list -> t
 
-  val of_conll: ?loc:Loc.t -> Conll.line -> t
+  val of_conll: ?loc:Loc.t -> Domain.t -> Conll.line -> t
 
   (** [unif t1 t2] returns [Some t] if [t] is the unification of two graph feature structures
       [None] is returned if the two feature structures cannot be unified. *)
@@ -62,7 +62,7 @@ module P_fs: sig
 
   val empty: t
 
-  val build: ?pat_vars: string list -> Ast.feature list -> t
+  val build: Domain.t -> ?pat_vars: string list -> Ast.feature list -> t
 
   val to_string: t -> string
 

src/grew_graph.ml

@@ -47,21 +47,21 @@ module P_graph = struct
       | Some new_node -> Some (Pid_map.add id_src new_node map)
 
   (* -------------------------------------------------------------------------------- *)
-  let build_filter table (ast_node, loc) =
+  let build_filter domain table (ast_node, loc) =
     let pid = Id.build ~loc ast_node.Ast.node_id table in
-    let fs = P_fs.build ast_node.Ast.fs in
+    let fs = P_fs.build domain ast_node.Ast.fs in
     (pid, fs)
 
   (* -------------------------------------------------------------------------------- *)
-  let build ?pat_vars ?(locals=[||]) (full_node_list : Ast.node list) full_edge_list =
+  let build domain ?pat_vars ?(locals=[||]) (full_node_list : Ast.node list) full_edge_list =
 
     (* NB: insert searches for a previous node with the Same name and uses unification rather than constraint *)
     (* NB: insertion of new node at the end of the list: not efficient but graph building is not the hard part. *)
     let rec insert (ast_node, loc) = function
-      | [] -> [P_node.build ?pat_vars (ast_node, loc)]
+      | [] -> [P_node.build domain ?pat_vars (ast_node, loc)]
       | (node_id,fs)::tail when ast_node.Ast.node_id = node_id ->
         begin
-          try (node_id, P_node.unif_fs (P_fs.build ?pat_vars ast_node.Ast.fs) fs) :: tail
+          try (node_id, P_node.unif_fs (P_fs.build domain ?pat_vars ast_node.Ast.fs) fs) :: tail
           with Error.Build (msg,_) -> raise (Error.Build (msg,Some loc))
         end
       | head :: tail -> head :: (insert (ast_node, loc) tail) in
@@ -108,9 +108,9 @@ module P_graph = struct
 
   (* -------------------------------------------------------------------------------- *)
   (* It may raise [P_fs.Fail_unif] in case of contradiction on constraints *)
-  let build_extension ?pat_vars ?(locals=[||]) pos_table full_node_list full_edge_list =
+  let build_extension domain ?pat_vars ?(locals=[||]) pos_table full_node_list full_edge_list =
 
-    let built_nodes = List.map (P_node.build ?pat_vars) full_node_list in
+    let built_nodes = List.map (P_node.build domain ?pat_vars) full_node_list in
 
     let (old_nodes, new_nodes) =
       List.partition
@@ -295,7 +295,7 @@ module G_graph = struct
       | None -> None
 
   (* -------------------------------------------------------------------------------- *)
-  let build ?(locals=[||]) gr_ast =
+  let build domain ?(locals=[||]) gr_ast =
     let full_node_list = gr_ast.Ast.nodes
     and full_edge_list = gr_ast.Ast.edges in
 
@@ -309,7 +309,7 @@ module G_graph = struct
           if List.mem node_id already_bound
           then Error.build "[GRS] [Graph.build] try to build a graph with twice the same node id '%s'" node_id
           else
-            let (new_id,new_node) = G_node.build ~def_position:!next_free_position (ast_node, loc) in
+            let (new_id,new_node) = G_node.build domain ~def_position:!next_free_position (ast_node, loc) in
             next_free_position := 1. +. (max !next_free_position (G_node.get_position new_node));
             let new_tail = loop (node_id :: already_bound) tail in
             (new_id,new_node) :: new_tail in
@@ -343,7 +343,7 @@ module G_graph = struct
 
 
   (* -------------------------------------------------------------------------------- *)
-  let of_conll ?loc (meta, lines, range_lines) =
+  let of_conll ?loc domain (meta, lines, range_lines) =
     let sorted_lines = Conll.root :: (List.sort Conll.compare lines) in
 
     let gtable = (Array.of_list (List.map (fun line -> line.Conll.num) sorted_lines), string_of_int) in
@@ -352,7 +352,7 @@ module G_graph = struct
       List_.foldi_left
         (fun i acc line ->
           let loc = Loc.opt_set_line i loc in
-          Gid_map.add (Gid.Old i) (G_node.of_conll ?loc line) acc)
+          Gid_map.add (Gid.Old i) (G_node.of_conll domain ?loc line) acc)
         Gid_map.empty sorted_lines in
     let map_with_edges =
       List.fold_left
@@ -386,7 +386,7 @@ module G_graph = struct
 
   (* -------------------------------------------------------------------------------- *)
   (** input : "Le/DET/le petit/ADJ/petit chat/NC/chat dort/V/dormir ./PONCT/." *)
-  let of_brown ?sentid brown =
+  let of_brown domain ?sentid brown =
     let units = Str.split (Str.regexp " ") brown in
       let conll_lines = List.mapi
       (fun i item -> match Str.full_split (Str.regexp "/[A-Z'+'']+/") item with
@@ -407,7 +407,7 @@ module G_graph = struct
           }
         | _ -> Error.build "[Graph.of_brown] Cannot parse Brown item >>>%s<<< (expected \"phon/POS/lemma\")" item
       ) units in 
-    of_conll ([], conll_lines, [])
+    of_conll domain ([], conll_lines, [])
 
   (* -------------------------------------------------------------------------------- *)
   let opt_att atts name =
@@ -416,7 +416,7 @@ module G_graph = struct
 
  (* -------------------------------------------------------------------------------- *)
  (** [of_xml d_xml] loads a graph in the xml format: [d_xml] must be a <D> xml element *)
-  let of_xml d_xml =
+  let of_xml domain d_xml =
     match d_xml with
       | Xml.Element ("D", _, t_or_r_list) ->
         let (t_list, r_list) = List.partition (function Xml.Element ("T",_,_) -> true | _ -> false) t_or_r_list in
@@ -429,7 +429,7 @@ module G_graph = struct
                   let other_feats = List.filter (fun (n,_) -> not (List.mem n ["id"; "start"; "end"; "label"])) t_atts in
                   let new_fs =
                     List.fold_left
-                      (fun acc2 (fn,fv) -> G_fs.set_feat fn fv acc2)
+                      (fun acc2 (fn,fv) -> G_fs.set_feat domain fn fv acc2)
                       G_fs.empty
                       (("phon", phon) :: ("cat", (List.assoc "label" t_atts)) :: other_feats) in
                   let new_node = G_node.set_fs new_fs (G_node.set_position (float i) G_node.empty) in
@@ -614,18 +614,18 @@ module G_graph = struct
       | None -> None
 
   (* -------------------------------------------------------------------------------- *)
-  let set_feat ?loc graph node_id feat_name new_value =
+  let set_feat ?loc domain graph node_id feat_name new_value =
     let node = Gid_map.find node_id graph.map in
     let new_node =
       match feat_name with
         | "position" -> G_node.set_position (float_of_string new_value) node
         | _ ->
-          let new_fs = G_fs.set_feat ?loc feat_name new_value (G_node.get_fs node) in
+          let new_fs = G_fs.set_feat ?loc domain feat_name new_value (G_node.get_fs node) in
           (G_node.set_fs new_fs node) in
     { graph with map = Gid_map.add node_id new_node graph.map }
 
   (* -------------------------------------------------------------------------------- *)
-  let update_feat ?loc graph tar_id tar_feat_name item_list =
+  let update_feat ?loc domain graph tar_id tar_feat_name item_list =
     let strings_to_concat =
       List.map
         (function
@@ -638,7 +638,7 @@ module G_graph = struct
           | Concat_item.String s -> s
         ) item_list in
     let new_feature_value = List_.to_string (fun s->s) "" strings_to_concat in
-    (set_feat ?loc graph tar_id tar_feat_name new_feature_value, new_feature_value)
+    (set_feat ?loc domain graph tar_id tar_feat_name new_feature_value, new_feature_value)
 
   (* -------------------------------------------------------------------------------- *)
   let del_feat graph node_id feat_name =

src/grew_graph.mli

@@ -53,6 +53,7 @@ module P_graph: sig
     }
 
   val build:
+      Domain.t ->
       ?pat_vars: string list ->
       ?locals: Label.decl array ->
       Ast.node list ->
@@ -60,6 +61,7 @@ module P_graph: sig
       (t * Id.table)
 
   val build_extension:
+      Domain.t ->
       ?pat_vars: string list ->
       ?locals: Label.decl array ->
       Id.table ->
@@ -101,15 +103,15 @@ module G_graph: sig
   (* Build functions *)
   (* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
 
-  val build: ?locals: Label.decl array -> Ast.gr -> t
+  val build: Domain.t -> ?locals: Label.decl array -> Ast.gr -> t
 
-  val of_conll: ?loc:Loc.t -> Conll.t -> t
+  val of_conll: ?loc:Loc.t -> Domain.t -> Conll.t -> t
 
   (** input : "Le/DET/le petit/ADJ/petit chat/NC/chat dort/V/dormir ./PONCT/." 
       It supposes that "SUC" is defined in current relations *)
-  val of_brown: ?sentid: string -> string -> t
+  val of_brown: Domain.t -> ?sentid: string -> string -> t
 
-  val of_xml: Xml.xml -> t
+  val of_xml: Domain.t -> Xml.xml -> t
   (* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
   (* Update functions *)
   (* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
@@ -145,12 +147,12 @@ module G_graph: sig
   (** move all incident arcs from/to id_src are moved to incident arcs on node id_tar from graph, with all its incoming and outcoming edges *)
   val shift_edges: Loc.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
 
-  (** [update_feat tar_id tar_feat_name concat_items] sets the feature of the node [tar_id]
+  (** [update_feat domain tar_id tar_feat_name concat_items] sets the feature of the node [tar_id]
       with feature name [tar_feat_name] to be the contatenation of values described by the [concat_items].
       It returns both the new graph and the new feature value produced as the second element *)
-  val update_feat: ?loc:Loc.t -> t -> Gid.t -> string -> Concat_item.t list -> (t * string)
+  val update_feat: ?loc:Loc.t -> Domain.t -> t -> Gid.t -> string -> Concat_item.t list -> (t * string)
 
-  val set_feat: ?loc:Loc.t -> t -> Gid.t -> string -> string -> t
+  val set_feat: ?loc:Loc.t -> Domain.t -> t -> Gid.t -> string -> string -> t
 
   (** [del_feat graph node_id feat_name] returns [graph] where the feat [feat_name] of [node_id] is deleted
       If the feature is not present, [graph] is returned. *)

src/grew_grs.ml

@@ -163,11 +163,11 @@ module Modul = struct
       | r::tail -> loop ((Rule.get_name r) :: already_defined) tail in
     loop [] t.rules
 
-  let build ast_module =
+  let build domain ast_module =
     let locals = Array.of_list ast_module.Ast.local_labels in
     Array.sort compare locals;
     let suffixes = ast_module.Ast.suffixes in
-    let rules_or_filters = List.map (Rule.build ~locals suffixes ast_module.Ast.mod_dir) ast_module.Ast.rules in
+    let rules_or_filters = List.map (Rule.build domain ~locals suffixes ast_module.Ast.mod_dir) ast_module.Ast.rules in
     let (filters, rules) = List.partition Rule.is_filter rules_or_filters in
     let modul =
       {
@@ -218,6 +218,7 @@ end (* module Sequence *)
 module Grs = struct
 
   type t = {
+    domain: Domain.t;
     labels: Label.t list;        (* the list of global edge labels *)
     modules: Modul.t list;       (* the ordered list of modules used from rewriting *)
     sequences: Sequence.t list;
@@ -228,10 +229,11 @@ module Grs = struct
   let get_modules t = t.modules
   let get_ast t = t.ast
   let get_filename t = t.filename
+  let get_domain t = t.domain
 
   let sequence_names t = List.map (fun s -> s.Sequence.name) t.sequences
 
-  let empty = {labels=[]; modules=[]; sequences=[]; ast=Ast.empty_grs; filename=""; }
+  let empty = {domain=Domain.empty; labels=[]; modules=[]; sequences=[]; ast=Ast.empty_grs; filename=""; }
 
   let check t =
     (* check for duplicate modules *)
@@ -252,10 +254,12 @@ module Grs = struct
 
   let build filename =
     let ast = Loader.grs filename in
+    let domain = Domain.build ast.Ast.domain in
+
     Label.init ast.Ast.labels;
-    Domain.init ast.Ast.domain;
-    let modules = List.map Modul.build ast.Ast.modules in
+    let modules = List.map (Modul.build domain) ast.Ast.modules in
     let grs = {
+      domain;
       labels = List.map (fun (l,_) -> Label.from_string l) ast.Ast.labels;
       sequences = List.map (Sequence.build modules) ast.Ast.sequences;
       modules; ast; filename;
@@ -290,6 +294,7 @@ module Grs = struct
         (* printf "Enter module ==> %s\n%!" next.Modul.name; *)
         let (good_set, bad_set) =
           Rule.normalize
+            grs.domain
             next.Modul.name
             ~confluent: next.Modul.confluent
             next.Modul.rules
@@ -316,6 +321,7 @@ module Grs = struct
       | next :: tail ->
         let (good_set, bad_set) =
           Rule.normalize
+            grs.domain
             next.Modul.name
             ~confluent: next.Modul.confluent
             next.Modul.rules

src/grew_grs.mli

@@ -9,6 +9,7 @@
 (**********************************************************************************)
 
 open Grew_base
+open Grew_types
 open Grew_graph
 open Grew_rule
 open Grew_ast
@@ -84,6 +85,8 @@ module Grs: sig
 
   val get_ast: t -> Ast.grs
 
+  val get_domain: t -> Domain.t
+
   val get_filename: t -> string
 
   val sequence_names: t -> string list

src/grew_node.ml

@@ -55,18 +55,18 @@ module G_node = struct
 
   let get_annot_info t = G_fs.get_annot_info t.fs
 
-  let build ?def_position (ast_node, loc) =
-    let fs = G_fs.build ast_node.Ast.fs in
+  let build domain ?def_position (ast_node, loc) =
+    let fs = G_fs.build domain ast_node.Ast.fs in
     let position = match (ast_node.Ast.position, def_position) with
       | (Some position, _) -> position
       | (None, Some position) -> position
       | (None, None) -> Error.bug "Cannot build a node without position" in
     (ast_node.Ast.node_id, { empty with fs; position })
 
-  let of_conll ?loc line =
+  let of_conll ?loc domain line =
     if line = Conll.root
     then { empty with conll_root=true }
-    else { empty with fs = G_fs.of_conll ?loc line; position = float line.Conll.num }
+    else { empty with fs = G_fs.of_conll ?loc domain line; position = float line.Conll.num }
 
   let remove (id_tar : Gid.t) label t = {t with next = Massoc_gid.remove id_tar label t.next}
 
@@ -109,11 +109,11 @@ module P_node = struct
 
   let empty = { fs = P_fs.empty; next = Massoc_pid.empty; name = ""; loc=None   }
 
-  let build ?pat_vars (ast_node, loc) =
+  let build domain ?pat_vars (ast_node, loc) =
     (ast_node.Ast.node_id,
      {
        name = ast_node.Ast.node_id;
-       fs = P_fs.build ?pat_vars ast_node.Ast.fs;
+       fs = P_fs.build domain ?pat_vars ast_node.Ast.fs;
        next = Massoc_pid.empty;
        loc = Some loc;
      } )

src/grew_node.mli

@@ -42,8 +42,8 @@ module G_node: sig
   val rm_out_edges: t -> t
 
   val add_edge: G_edge.t -> Gid.t -> t -> t option
-  val build: ?def_position: float -> Ast.node -> (Id.name * t)
-  val of_conll: ?loc:Loc.t -> Conll.line -> t
+  val build: Domain.t -> ?def_position: float -> Ast.node -> (Id.name * t)
+  val of_conll: ?loc:Loc.t -> Domain.t -> Conll.line -> t
 
   val get_position: t -> float
 
@@ -77,7 +77,7 @@ module P_node: sig
   *)
   val unif_fs: P_fs.t -> t -> t
 
-  val build: ?pat_vars: string list -> Ast.node -> (Id.name * t)
+  val build: Domain.t -> ?pat_vars: string list -> Ast.node -> (Id.name * t)
 
   val add_edge: P_edge.t -> Pid.t -> t -> t option
 

src/grew_rule.mli

@@ -73,13 +73,14 @@ module Rule : sig
   (** [to_dep t] returns a string in the [dep] language describing the match basic of the rule *)
   val to_dep: t -> string
 
-  (** [build ?local dir ast_rule] returns the Rule.t value corresponding to [ast_rule].
+  (** [build domain ?local dir ast_rule] returns the Rule.t value corresponding to [ast_rule].
       [dir] is used for localisation of lp files *)
-  val build: ?locals:Label.decl array -> string list -> string -> Ast.rule -> t
+  val build: Domain.t -> ?locals:Label.decl array -> string list -> string -> Ast.rule -> t
 
-  (** [normalize module_name ?confluent rule_list filter_list instance] returns two sets of good normal forms and bad normal forms *)
+  (** [normalize domain module_name ?confluent rule_list filter_list instance] returns two sets of good normal forms and bad normal forms *)
   (* raise Stop if some command fails to apply *)
   val normalize:
+    Domain.t ->
     string -> (* module name *)
     ?confluent:bool ->
     t list -> (* rule list *)
@@ -92,7 +93,7 @@ module Rule : sig
   type matching
   type pattern
 
-  val build_pattern: Ast.pattern -> pattern
+  val build_pattern: Domain.t -> Ast.pattern -> pattern
 
   (** [match_in_graph rule graph] returns the list of matching of the pattern of the rule into the graph *)
   val match_in_graph: ?param:Lex_par.t -> pattern -> G_graph.t -> matching list

src/grew_types.ml

@@ -29,6 +29,8 @@ let conll_string_of_value = function
   | String s -> s
   | Float i -> String_.of_float i
 
+type disjunction = value list
+
 let dot_color string =
   match (string.[0], String.length string) with
   | ('#', 4) -> sprintf "\"#%c%c%c%c%c%c\"" string.[1] string.[1] string.[2] string.[2] string.[3] string.[3]
@@ -259,9 +261,7 @@ module Domain = struct
 
   type t = feature_spec list
 
-  let (current: t option ref) = ref None
-
-  let reset () = current := None
+  let empty = []
 
   let is_defined feature_name domain =
     List.exists (function
@@ -271,6 +271,16 @@ module Domain = struct
       | _ -> false
     ) domain
 
+  let rec build = function
+    | [] -> [Num "position"]
+    | (Num "position") :: tail -> Log.warning "[Domain] declaration of the feature name \"position\" in useless"; build tail
+    | (Open "position") :: _
+    | (Closed ("position",_)) :: _ ->
+      Error.build "[Domain] The feature named \"position\" is reserved and must be types 'integer', you cannot not redefine it"
+    | (Num fn) :: tail | (Open fn) :: tail | Closed (fn,_) :: tail when is_defined fn tail ->
+      Error.build "[Domain] The feature named \"%s\" is defined several times" fn
+    | x :: tail -> x :: (build tail)
+
   let get feature_name domain =
     List.find (function
       | Closed (fn,_) when fn = feature_name -> true
@@ -279,36 +289,18 @@ module Domain = struct
       | _ -> false
     ) domain
 
-  let check_feature_name ?loc name =
-    match !current with
-      | None -> ()
-      | Some dom when is_defined name dom -> ()
-      | _ -> Error.build ?loc "The feature name \"%s\" in not defined in the domain" name
+  let check_feature_name ?loc domain name =
+    if not (is_defined name domain)
+    then Error.build ?loc "The feature name \"%s\" in not defined in the domain" name
 
-  let is_open name =
-      match !current with
-      | None -> true
-      | Some dom -> List.exists (function Open n when n=name -> true | _ -> false) dom
+  let is_open domain name =
+    List.exists (function Open n when n=name -> true | _ -> false) domain
 
-  let rec normalize_domain = function
-    | [] -> [Num "position"]
-    | (Num "position") :: tail -> Log.warning "[Domain] declaration of the feature name \"position\" in useless"; normalize_domain tail
-    | (Open "position") :: _
-    | (Closed ("position",_)) :: _ ->
-      Error.build "[Domain] The feature named \"position\" is reserved and must be types 'integer', you cannot not redefine it"
-    | (Num fn) :: tail |  (Open fn) :: tail |  Closed (fn,_) :: tail when is_defined fn tail ->
-      Error.build "[Domain] The feature named \"%s\" is defined several times" fn
-    | x :: tail -> x :: (normalize_domain tail)
-
-  let init domain =
-    current := Some (normalize_domain domain)