Commit 7588c3fc authored by bguillaum's avatar bguillaum

be more tolerant when checking command update_feat

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8453 7838e531-6607-4d57-9587-6c381814729c
parent 3d9d86f4
......@@ -190,6 +190,7 @@ module Command = struct
(* check for consistency *)
(match items with
| [String s] -> Domain.check_feature ~loc feat_name s
| [Feat (_,fn)] when Domain.sub fn feat_name -> ()
| _ when Domain.is_open feat_name -> ()
| _ -> Error.build ~loc "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))
......
......@@ -235,6 +235,14 @@ module Domain = struct
| _ -> false
) domain
let get feature_name domain =
List.find (function
| Closed (fn,_) when fn = feature_name -> true
| Open fn when fn = feature_name -> true
| Num fn when fn = feature_name -> true
| _ -> false
) domain
let check_feature_name ?loc name =
match !current with
| None -> ()
......@@ -295,6 +303,18 @@ module Domain = struct
match !current with
| None -> None
| Some dom -> Some (List.map (function Closed (fn, _) | Open fn | Num fn -> fn) dom)
let sub name1 name2 =
match !current with
| None -> true
| Some dom ->
match (get name1 dom, get name2 dom) with
| (_, Open _) -> true
| (Closed (_,l1), Closed (_,l2)) -> List_.sort_include l1 l2
| (Num _, Num _) -> true
| _ -> false
end (* Domain *)
(* ================================================================================ *)
......
......@@ -116,6 +116,8 @@ module Domain: sig
(** [is_open feature_name] returns [true] iff no domain is set or if [feature_name] is defined to be open in the current domain. *)
val is_open: feature_name -> bool
(** [sub fn1 fn2] returns [true] iff the domain of [fn1] is a subset if the domain of [fn2]. *)
val sub: feature_name -> feature_name -> bool
end (* module Domain *)
(* ================================================================================ *)
......
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