Commit aab948be authored by bguillaum's avatar bguillaum

Add inequality constraints between numerical features and constants

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8731 7838e531-6607-4d57-9587-6c381814729c
parent 5438614a
VERSION = 0.27
VERSION = 0.28
INSTALL_DIR_LIB = @OCAMLLIB@
INSTALL_DIR = @prefix@/bin/
......
......@@ -147,6 +147,7 @@ module Ast = struct
| Feature_eq of feature_ident * feature_ident
| Feature_diseq of feature_ident * feature_ident
| Feature_ineq of ineq * feature_ident * feature_ident
| Feature_ineq_cst of ineq * feature_ident * float
type const = u_const * Loc.t
type basic = {
......
......@@ -96,6 +96,7 @@ module Ast : sig
| Feature_eq of feature_ident * feature_ident
| Feature_diseq of feature_ident * feature_ident
| Feature_ineq of ineq * feature_ident * feature_ident
| Feature_ineq_cst of ineq * feature_ident * float
type const = u_const * Loc.t
type basic = {
......
......@@ -136,6 +136,8 @@ module Html_doc = struct
bprintf buff "%s <> %s" (Ast.dump_feature_ident feat_id_l) (Ast.dump_feature_ident feat_id_r);
| Ast.Feature_ineq (ineq, feat_id_l, feat_id_r) ->
bprintf buff "%s %s %s" (Ast.dump_feature_ident feat_id_l) (Ast.string_of_ineq ineq) (Ast.dump_feature_ident feat_id_r)
| Ast.Feature_ineq_cst (ineq, feat_id_l, constant) ->
bprintf buff "%s %s %f" (Ast.dump_feature_ident feat_id_l) (Ast.string_of_ineq ineq) constant
);
bprintf buff "\n"
......
......@@ -102,6 +102,8 @@ module Rule = struct
| Feature_diseq of Pid.t * string * Pid.t * string
| Feature_ineq of Ast.ineq * Pid.t * string * Pid.t * string
| Feature_ineq_cst of Ast.ineq * Pid.t * string * float
| Filter of Pid.t * P_fs.t (* used when a without impose a fs on a node defined by the match basic *)
let build_pos_constraint ?locals pos_table const =
......@@ -118,6 +120,9 @@ module Rule = struct
Feature_diseq (pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
| (Ast.Feature_ineq (ineq, (node_name1, feat_name1), (node_name2, feat_name2)), loc) ->
Feature_ineq (ineq, pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
| (Ast.Feature_ineq_cst (ineq, (node_name1, feat_name1), constant), loc) ->
Feature_ineq_cst (ineq, pid_of_name loc node_name1, feat_name1, constant)
type basic = {
graph: P_graph.t;
......@@ -160,6 +165,9 @@ module Rule = struct
let (node_name1, feat_name1) = feat_id1
and (node_name2, feat_name2) = feat_id2 in
Feature_ineq (ineq, pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
| (Ast.Feature_ineq_cst (ineq, feat_id1, constant), loc) ->
let (node_name1, feat_name1) = feat_id1 in
Feature_ineq_cst (ineq, pid_of_name loc node_name1, feat_name1, constant)
(* It may raise [P_fs.Fail_unif] in case of contradiction on constraints *)
let build_neg_basic ?pat_vars ?(locals=[||]) pos_table basic_ast =
......@@ -481,12 +489,23 @@ module Rule = struct
| _ -> raise Fail
end
| Feature_ineq (ineq, pid1, feat_name1, pid2, feat_name2) ->
match (ineq, get_float_feat pid1 feat_name1, get_float_feat pid2 feat_name2) with
begin
match (ineq, get_float_feat pid1 feat_name1, get_float_feat pid2 feat_name2) with
| (Ast.Lt, Some fv1, Some fv2) when fv1 < fv2 -> matching
| (Ast.Gt, Some fv1, Some fv2) when fv1 > fv2 -> matching
| (Ast.Le, Some fv1, Some fv2) when fv1 <= fv2 -> matching
| (Ast.Ge, Some fv1, Some fv2) when fv1 >= fv2 -> matching
| _ -> raise Fail
end
| Feature_ineq_cst (ineq, pid1, feat_name1, constant) ->
begin
match (ineq, get_float_feat pid1 feat_name1) with
| (Ast.Lt, Some fv1) when fv1 < constant -> matching
| (Ast.Gt, Some fv1) when fv1 > constant -> matching
| (Ast.Le, Some fv1) when fv1 <= constant -> matching
| (Ast.Ge, Some fv1) when fv1 >= constant -> matching
| _ -> raise Fail
end
(* ---------------------------------------------------------------------- *)
(* returns all extension of the partial input matching *)
......
......@@ -483,6 +483,26 @@ pat_edge_or_const:
| feat_id1_loc=feature_ident_with_loc GE feat_id2=feature_ident
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq (Ast.Ge, feat_id1, feat_id2), loc) }
(* "X.feat >= 12.34" *)
| feat_id1_loc=feature_ident_with_loc GE num=FLOAT
| num=FLOAT LE feat_id1_loc=feature_ident_with_loc
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq_cst (Ast.Ge, feat_id1, num), loc) }
(* "X.feat > 12.34" *)
| feat_id1_loc=feature_ident_with_loc GT num=FLOAT
| num=FLOAT LT feat_id1_loc=feature_ident_with_loc
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq_cst (Ast.Gt, feat_id1, num), loc) }
(* "X.feat <= 12.34" *)
| feat_id1_loc=feature_ident_with_loc LE num=FLOAT
| num=FLOAT GE feat_id1_loc=feature_ident_with_loc
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq_cst (Ast.Le, feat_id1, num), loc) }
(* "X.feat < 12.34" *)
| feat_id1_loc=feature_ident_with_loc LT num=FLOAT
| num=FLOAT GT feat_id1_loc=feature_ident_with_loc
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq_cst (Ast.Lt, feat_id1, num), loc) }
/*=============================================================================================*/
/* COMMANDS DEFINITION */
......
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