Commit 6c501f75 authored by bguillaum's avatar bguillaum

catch unification failure in Rule.build and Rule.build_pattern

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@9029 7838e531-6607-4d57-9587-6c381814729c
parent 4769a6b2
......@@ -90,6 +90,7 @@ module P_feature = struct
exception Fail_unif
(** raise [P_feature.Fail_unif] *)
let unif_value v1 v2 = match (v1, v2) with
| ({cst=Absent;in_param=[]},{cst=Absent;in_param=[]}) -> v1
| ({cst=Absent;in_param=[]},_)
......
......@@ -87,8 +87,9 @@ module P_fs: sig
val check_position: ?param:Lex_par.t -> float -> t -> bool
exception Fail_unif
(** [unif fs1 fs2] returns the unification of the two feature structures.
It raises [Fail_unif] exception in case of Failure.
*)
It raises [Fail_unif] exception in case of Failure. *)
val unif: t -> t -> t
end (* module P_fs *)
......@@ -54,6 +54,7 @@ module P_graph: sig
old_map: P_node.t Pid_map.t; (* a partial map for new constraints on old nodes "Old [...]" *)
}
(** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *)
val build:
Domain.t ->
?pat_vars: string list ->
......@@ -62,6 +63,7 @@ module P_graph: sig
Ast.edge list ->
(t * Id.table)
(** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *)
val build_extension:
Domain.t ->
?pat_vars: string list ->
......
......@@ -84,9 +84,8 @@ module P_node: sig
val get_next: t -> P_edge.t Massoc_pid.t
(** [unif_fs fs t] replaces the feature structure of the node
by the unification of [node.fs] ] and [fs].
It raises (Error.Build msg) exception in case of Failure.
*)
by the unification of [t.fs] and [fs].
It raises [P_fs.Fail_unif] exception in case of Failure. *)
val unif_fs: P_fs.t -> t -> t
val build: Domain.t -> ?pat_vars: string list -> Ast.node -> (Id.name * t)
......
......@@ -363,11 +363,16 @@ module Rule = struct
(full_param, pat_vars, cmd_vars) in
(match (param, pat_vars) with
| (None, _::_) -> Error.build ~loc:rule_ast.Ast.rule_loc "Missing lexical parameters in rule \"%s\"" rule_ast.Ast.rule_id
| (None, _::_) -> Error.build ~loc:rule_ast.Ast.rule_loc "[Rule.build] Missing lexical parameters in rule \"%s\"" rule_ast.Ast.rule_id
| _ -> ()
);
let (pos, pos_table) = build_pos_basic domain ~pat_vars rule_ast.Ast.pattern.Ast.pat_pos in
let (pos, pos_table) =
try build_pos_basic domain ~pat_vars rule_ast.Ast.pattern.Ast.pat_pos
with P_fs.Fail_unif ->
Error.build ~loc:rule_ast.Ast.rule_loc
"[Rule.build] in rule \"%s\": feature structures declared in the \"match\" clause are inconsistent"
rule_ast.Ast.rule_id in
let (negs,_) =
List.fold_left
(fun (acc,pos) basic_ast ->
......@@ -387,8 +392,14 @@ module Rule = struct
}
let build_pattern domain pattern_ast =
let (pos, pos_table) = build_pos_basic domain pattern_ast.Ast.pat_pos in
let negs = List_.try_map P_fs.Fail_unif (fun basic_ast -> build_neg_basic domain pos_table basic_ast) pattern_ast.Ast.pat_negs in
let (pos, pos_table) =
try build_pos_basic domain pattern_ast.Ast.pat_pos
with P_fs.Fail_unif -> Error.build "feature structures declared in the \"match\" clause are inconsistent " in
let negs =
List_.try_map
P_fs.Fail_unif (* Skip the without parts that are incompatible with the match part *)
(fun basic_ast -> build_neg_basic domain pos_table basic_ast)
pattern_ast.Ast.pat_negs in
(pos, negs)
(* ====================================================================== *)
......
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