Commit 9730de2e authored by bguillaum's avatar bguillaum

add new constraint with regexp

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8895 7838e531-6607-4d57-9587-6c381814729c
parent 833e58f5
......@@ -155,6 +155,7 @@ module Ast = struct
| Feature_diseq of feature_ident * feature_ident
| Feature_ineq of ineq * feature_ident * feature_ident
| Feature_ineq_cst of ineq * feature_ident * float
| Feature_re of feature_ident * string
type const = u_const * Loc.t
type basic = {
......
......@@ -98,6 +98,8 @@ module Ast : sig
| Feature_diseq of feature_ident * feature_ident
| Feature_ineq of ineq * feature_ident * feature_ident
| Feature_ineq_cst of ineq * feature_ident * float
| Feature_re of feature_ident * string
type const = u_const * Loc.t
type basic = {
......
......@@ -138,6 +138,8 @@ module Html_doc = struct
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
| Ast.Feature_re (feat_id, regexp) ->
bprintf buff "%s == \"%s\"" (Ast.dump_feature_ident feat_id) regexp
);
bprintf buff "\n"
......
......@@ -210,6 +210,7 @@ and standard target = parse
| '+' { PLUS }
| '#' { SHARP }
| '=' { EQUAL }
| "==" { REGEXP }
| "!" { BANG }
| "<>" { DISEQUAL }
......
......@@ -40,6 +40,7 @@ let localize t = (t,get_loc ())
%token SHARP /* # */
%token PLUS /* + */
%token EQUAL /* = */
%token REGEXP /* == */
%token DISEQUAL /* <> */
%token BANG /* ! */
%token STAR /* * */
......@@ -62,7 +63,7 @@ let localize t = (t,get_loc ())
%token ARROW_LEFT_NEG /* =[^ */
%token ARROW_RIGHT /* ]=> */
%token INCL /* include */
%token INCL /* include */
%token FEATURES /* features */
%token FEATURE /* feature */
%token FILE /* file */
......@@ -480,6 +481,10 @@ pat_edge_or_const:
| feat_id1_loc=feature_ident_with_loc DISEQUAL feat_id2=feature_ident
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_diseq (feat_id1, feat_id2), loc) }
(* "X.cat == "regexp" " *)
| feat_id_loc=feature_ident_with_loc REGEXP regexp=STRING
{ let (feat_id,loc)=feat_id_loc in Pat_const (Ast.Feature_re (feat_id, regexp), loc) }
(* "X.position < Y.position" *)
| feat_id1_loc=ineq_ident_with_loc LT feat_id2=ineq_ident
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq (Ast.Lt, feat_id1, feat_id2), loc) }
......
......@@ -105,6 +105,8 @@ module Rule = struct
| Feature_eq of Pid.t * string * Pid.t * string
| Feature_diseq of Pid.t * string * Pid.t * string
| Feature_re of Pid.t * string * string
| Feature_ineq of Ast.ineq * Pid.t * string * Pid.t * string
| Feature_ineq_cst of Ast.ineq * Pid.t * string * float
......@@ -137,6 +139,9 @@ module Rule = struct
Domain.check_feature_name domain ~loc feat_name1;
Feature_ineq_cst (ineq, pid_of_name loc node_name1, feat_name1, constant)
| (Ast.Feature_re ((node_name, feat_name), regexp), loc) ->
Domain.check_feature_name domain ~loc feat_name;
Feature_re (pid_of_name loc node_name, feat_name, regexp)
type basic = {
graph: P_graph.t;
......@@ -192,6 +197,11 @@ module Rule = struct
Domain.check_feature_name domain ~loc feat_name1;
Feature_ineq_cst (ineq, pid_of_name loc node_name1, feat_name1, constant)
| (Ast.Feature_re (feat_id, regexp), loc) ->
let (node_name, feat_name) = feat_id in
Domain.check_feature_name domain ~loc feat_name;
Feature_re (pid_of_name loc node_name, feat_name, regexp)
(* It may raise [P_fs.Fail_unif] in case of contradiction on constraints *)
let build_neg_basic domain ?pat_vars ?(locals=[||]) pos_table basic_ast =
let (extension, neg_table) =
......@@ -546,6 +556,19 @@ module Rule = struct
| (Ast.Ge, Some fv1) when fv1 >= constant -> matching
| _ -> raise Fail
end
| Feature_re (pid, feat_name, regexp) ->
begin
match get_string_feat pid feat_name with
| None -> raise Fail
| Some string_feat ->
let re = Str.regexp regexp in
if Str.string_match re string_feat 0
then
if Str.matched_string string_feat = string_feat
then matching
else raise Fail
else raise Fail
end
(* ---------------------------------------------------------------------- *)
(* returns all extension of the partial input matching *)
......
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