Commit 1a0f4cae authored by bguillaum's avatar bguillaum

handle < and << between nodes

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8959 7838e531-6607-4d57-9587-6c381814729c
parent 94d2f1b0
...@@ -63,12 +63,17 @@ module Ast = struct ...@@ -63,12 +63,17 @@ module Ast = struct
| [Str.Text base; Str.Delim "."; Str.Text fn] -> (base, fn) | [Str.Text base; Str.Delim "."; Str.Text fn] -> (base, fn)
| _ -> Error.build "The identifier '%s' must be a feature identifier (with exactly one '.' symbol, like \"V.cat\" for instance)" s | _ -> Error.build "The identifier '%s' must be a feature identifier (with exactly one '.' symbol, like \"V.cat\" for instance)" s
let parse_ineq_ident s = (* ---------------------------------------------------------------------- *)
(* simple_or_feature_ident: union of simple_ident and feature_ident *)
(* Note: used for parsing of "X < Y" and "X.feat < Y.feat" without conflicts *)
type simple_or_feature_ident = Id.name * feature_name option
let parse_simple_or_feature_ident s =
check_special "feature ident" ["."] s; check_special "feature ident" ["."] s;
match Str.full_split (Str.regexp "\\.") s with match Str.full_split (Str.regexp "\\.") s with
| [Str.Text base; ] -> (base, "position") | [Str.Text base; ] -> (base, None)
| [Str.Text base; Str.Delim "."; Str.Text fn] -> (base, fn) | [Str.Text base; Str.Delim "."; Str.Text fn] -> (base, Some fn)
| _ -> Error.build "The identifier '%s' must be a feature identifier (with exactly one '.' symbol, like \"V.cat\" for instance)" s | _ -> Error.build "The identifier '%s' must be a feature identifier (with at most one '.' symbol, like \"V\" or \"V.cat\" for instance)" s
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* command_node_id: V, V#alpha *) (* command_node_id: V, V#alpha *)
...@@ -156,6 +161,8 @@ module Ast = struct ...@@ -156,6 +161,8 @@ module Ast = struct
| Feature_ineq of ineq * feature_ident * feature_ident | Feature_ineq of ineq * feature_ident * feature_ident
| Feature_ineq_cst of ineq * feature_ident * float | Feature_ineq_cst of ineq * feature_ident * float
| Feature_re of feature_ident * string | Feature_re of feature_ident * string
| Prec of Id.name * Id.name
| Lprec of Id.name * Id.name
type const = u_const * Loc.t type const = u_const * Loc.t
type basic = { type basic = {
...@@ -187,7 +194,8 @@ module Ast = struct ...@@ -187,7 +194,8 @@ module Ast = struct
(fun acc (u_const, loc) -> match u_const with (fun acc (u_const, loc) -> match u_const with
| Feature_eq ((name1,_), (name2,_)) | Feature_eq ((name1,_), (name2,_))
| Feature_diseq ((name1,_), (name2,_)) | Feature_diseq ((name1,_), (name2,_))
| Feature_ineq (_, (name1,_), (name2,_)) -> | Feature_ineq (_, (name1,_), (name2,_))
| Prec (name1, name2) ->
acc acc
|> (add_implicit_node loc aux name1) |> (add_implicit_node loc aux name1)
|> (add_implicit_node loc aux name2) |> (add_implicit_node loc aux name2)
......
...@@ -14,7 +14,7 @@ open Grew_types ...@@ -14,7 +14,7 @@ open Grew_types
module Ast : sig module Ast : sig
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* simple_ident: V.cat *) (* simple_ident: cat or V *)
type simple_ident = Id.name type simple_ident = Id.name
val parse_simple_ident: string -> simple_ident val parse_simple_ident: string -> simple_ident
val is_simple_ident: string -> bool val is_simple_ident: string -> bool
...@@ -36,10 +36,15 @@ module Ast : sig ...@@ -36,10 +36,15 @@ module Ast : sig
(* feature_ident: V.cat *) (* feature_ident: V.cat *)
type feature_ident = Id.name * feature_name type feature_ident = Id.name * feature_name
val parse_feature_ident: string -> feature_ident val parse_feature_ident: string -> feature_ident
val parse_ineq_ident: string -> feature_ident
val dump_feature_ident: feature_ident -> string val dump_feature_ident: feature_ident -> string
(* -------------------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* simple_or_feature_ident: union of simple_ident and feature_ident *)
(* Note: used for parsing of "X < Y" and "X.feat < Y.feat" without conflicts *)
type simple_or_feature_ident = Id.name * feature_name option
val parse_simple_or_feature_ident: string -> simple_or_feature_ident
(* ---------------------------------------------------------------------- *)
(* command_node_ident: V, V#alpha, V.cat, V#alpha.cat, p_obj.loc *) (* command_node_ident: V, V#alpha, V.cat, V#alpha.cat, p_obj.loc *)
type command_node_ident = type command_node_ident =
| No_sharp of string | No_sharp of string
...@@ -99,6 +104,8 @@ module Ast : sig ...@@ -99,6 +104,8 @@ module Ast : sig
| Feature_ineq of ineq * feature_ident * feature_ident | Feature_ineq of ineq * feature_ident * feature_ident
| Feature_ineq_cst of ineq * feature_ident * float | Feature_ineq_cst of ineq * feature_ident * float
| Feature_re of feature_ident * string | Feature_re of feature_ident * string
| Prec of Id.name * Id.name
| Lprec of Id.name * Id.name
type const = u_const * Loc.t type const = u_const * Loc.t
......
...@@ -140,6 +140,10 @@ module Html_doc = struct ...@@ -140,6 +140,10 @@ module Html_doc = struct
bprintf buff "%s %s %f" (Ast.dump_feature_ident feat_id_l) (Ast.string_of_ineq ineq) 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) -> | Ast.Feature_re (feat_id, regexp) ->
bprintf buff "%s == \"%s\"" (Ast.dump_feature_ident feat_id) regexp bprintf buff "%s == \"%s\"" (Ast.dump_feature_ident feat_id) regexp
| Ast.Prec (id1, id2) ->
bprintf buff "%s < %s" id1 id2
| Ast.Lprec (id1, id2) ->
bprintf buff "%s << %s" id1 id2
); );
bprintf buff "\n" bprintf buff "\n"
......
...@@ -215,6 +215,8 @@ and standard target = parse ...@@ -215,6 +215,8 @@ and standard target = parse
| "!" { BANG } | "!" { BANG }
| "<>" { DISEQUAL } | "<>" { DISEQUAL }
| "<<" { LPREC }
| ">>" { LSUCC }
| "<" { LT } | "<" { LT }
| ">" { GT } | ">" { GT }
| "<=" | "≤" { LE } | "<=" | "≤" { LE }
......
...@@ -24,6 +24,10 @@ type graph_item = ...@@ -24,6 +24,10 @@ type graph_item =
| Graph_node of Ast.node | Graph_node of Ast.node
| Graph_edge of Ast.edge | Graph_edge of Ast.edge
type ineq_item =
| Ineq_sofi of Ast.simple_or_feature_ident
| Ineq_float of float
let get_loc () = Loc.file_line !Global.current_file !Global.current_line let get_loc () = Loc.file_line !Global.current_file !Global.current_line
let localize t = (t,get_loc ()) let localize t = (t,get_loc ())
%} %}
...@@ -48,6 +52,8 @@ let localize t = (t,get_loc ()) ...@@ -48,6 +52,8 @@ let localize t = (t,get_loc ())
%token GT /* > */ %token GT /* > */
%token LE /* <= or */ %token LE /* <= or */
%token GE /* >= or */ %token GE /* >= or */
%token LPREC /* << */
%token LSUCC /* >> */
%token PIPE /* | */ %token PIPE /* | */
...@@ -157,12 +163,6 @@ feature_ident : ...@@ -157,12 +163,6 @@ feature_ident :
feature_ident_with_loc : feature_ident_with_loc :
| id=ID { localize (Ast.parse_feature_ident id) } | id=ID { localize (Ast.parse_feature_ident id) }
ineq_ident :
| id=ID { Ast.parse_ineq_ident id }
ineq_ident_with_loc :
| id=ID { localize (Ast.parse_ineq_ident id) }
command_feature_ident_with_loc : command_feature_ident_with_loc :
| id=ID { localize (Ast.parse_command_feature_ident id) } | id=ID { localize (Ast.parse_command_feature_ident id) }
...@@ -171,6 +171,14 @@ feature_value: ...@@ -171,6 +171,14 @@ feature_value:
| v=STRING { v } | v=STRING { v }
| v=FLOAT { Printf.sprintf "%g" v } | v=FLOAT { Printf.sprintf "%g" v }
ineq_value:
| v=ID { Ineq_sofi (Ast.parse_simple_or_feature_ident v) }
| v=FLOAT { Ineq_float v }
ineq_value_with_loc:
| v=ID { localize (Ineq_sofi (Ast.parse_simple_or_feature_ident v)) }
| v=FLOAT { localize (Ineq_float v) }
/*=============================================================================================*/ /*=============================================================================================*/
/* GREW GRAPH */ /* GREW GRAPH */
/*=============================================================================================*/ /*=============================================================================================*/
...@@ -479,42 +487,61 @@ pat_edge_or_const: ...@@ -479,42 +487,61 @@ pat_edge_or_const:
| feat_id_loc=feature_ident_with_loc REGEXP regexp=STRING | 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) } { let (feat_id,loc)=feat_id_loc in Pat_const (Ast.Feature_re (feat_id, regexp), loc) }
(* "X.position < Y.position" *) | id1_loc=ineq_value_with_loc LT id2=ineq_value
| feat_id1_loc=ineq_ident_with_loc LT feat_id2=ineq_ident { let (id1,loc)=id1_loc in
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq (Ast.Lt, feat_id1, feat_id2), loc) } match (id1, id2) with
(* "X.feat < Y.feat" *)
| (Ineq_sofi (n1, Some f1), Ineq_sofi (n2, Some f2)) -> Pat_const (Ast.Feature_ineq (Ast.Lt, (n1,f1), (n2,f2)), loc)
(* "X.feat < 12.34" *)
| (Ineq_sofi (n1, Some f1), Ineq_float num) -> Pat_const (Ast.Feature_ineq_cst (Ast.Lt, (n1,f1), num), loc)
(* "12.34 < Y.feat" *)
| (Ineq_float num, Ineq_sofi (n1, Some f1)) -> Pat_const (Ast.Feature_ineq_cst (Ast.Gt, (n1,f1), num), loc)
(* "X < Y" *)
| (Ineq_sofi (n1, None), Ineq_sofi (n2, None)) -> Pat_const (Ast.Prec (n1,n2), loc)
| (Ineq_float _, Ineq_float _) -> Error.build "the '<' symbol can be used with 2 constants"
| _ -> Error.build "the '<' symbol can be used with 2 nodes or with 2 features but not in a mix inequality"
}
(* "X.position > Y.position" *) | id1_loc=ineq_value_with_loc GT id2=ineq_value
| feat_id1_loc=ineq_ident_with_loc GT feat_id2=ineq_ident { let (id1,loc)=id1_loc in
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq (Ast.Gt, feat_id1, feat_id2), loc) } match (id1, id2) with
(* "X.feat > Y.feat" *)
| (Ineq_sofi (n1, Some f1), Ineq_sofi (n2, Some f2)) -> Pat_const (Ast.Feature_ineq (Ast.Gt, (n1,f1), (n2,f2)), loc)
(* "X.feat > 12.34" *)
| (Ineq_sofi (n1, Some f1), Ineq_float num) -> Pat_const (Ast.Feature_ineq_cst (Ast.Gt, (n1,f1), num), loc)
(* "12.34 > Y.feat" *)
| (Ineq_float num, Ineq_sofi (n1, Some f1)) -> Pat_const (Ast.Feature_ineq_cst (Ast.Lt, (n1,f1), num), loc)
(* "X > Y" *)
| (Ineq_sofi (n1, None), Ineq_sofi (n2, None)) -> Pat_const (Ast.Prec (n2,n1), loc)
| (Ineq_float _, Ineq_float _) -> Error.build "the '>' symbol can be used with 2 constants"
| _ -> Error.build "the '>' symbol can be used with 2 nodes or with 2 features but not in a mix inequality"
}
(* "X.position <= Y.position" *) (* "X.position <= Y.position" *)
| feat_id1_loc=ineq_ident_with_loc LE feat_id2=ineq_ident | feat_id1_loc=feature_ident_with_loc LE feat_id2=feature_ident
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq (Ast.Le, feat_id1, feat_id2), loc) } { let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq (Ast.Le, feat_id1, feat_id2), loc) }
(* "X.position >= Y.position" *) (* "X.position >= Y.position" *)
| feat_id1_loc=ineq_ident_with_loc GE feat_id2=ineq_ident | 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) } { let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq (Ast.Ge, feat_id1, feat_id2), loc) }
(* "X.feat >= 12.34" *) (* "X.feat >= 12.34" *)
| feat_id1_loc=ineq_ident_with_loc GE num=FLOAT | feat_id1_loc=feature_ident_with_loc GE num=FLOAT
| num=FLOAT LE feat_id1_loc=ineq_ident_with_loc | 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) } { 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=ineq_ident_with_loc GT num=FLOAT
| num=FLOAT LT feat_id1_loc=ineq_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" *) (* "X.feat <= 12.34" *)
| feat_id1_loc=ineq_ident_with_loc LE num=FLOAT | feat_id1_loc=feature_ident_with_loc LE num=FLOAT
| num=FLOAT GE feat_id1_loc=ineq_ident_with_loc | 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) } { let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq_cst (Ast.Le, feat_id1, num), loc) }
(* "X.feat < 12.34" *) (* "A << B" *)
| feat_id1_loc=ineq_ident_with_loc LT num=FLOAT | n1_loc=simple_id_with_loc LPREC n2=simple_id
| num=FLOAT GT feat_id1_loc=ineq_ident_with_loc { let (n1,loc) = n1_loc in Pat_const (Ast.Lprec (n1,n2), loc) }
{ let (feat_id1,loc)=feat_id1_loc in Pat_const (Ast.Feature_ineq_cst (Ast.Lt, feat_id1, num), loc) }
(* "A >> B" *)
| n1_loc=simple_id_with_loc LSUCC n2=simple_id
{ let (n1,loc) = n1_loc in Pat_const (Ast.Lprec (n2,n1), loc) }
/*=============================================================================================*/ /*=============================================================================================*/
/* COMMANDS DEFINITION */ /* COMMANDS DEFINITION */
......
...@@ -112,6 +112,9 @@ module Rule = struct ...@@ -112,6 +112,9 @@ module Rule = struct
| Filter of Pid.t * P_fs.t (* used when a without impose a fs on a node defined by the match basic *) | Filter of Pid.t * P_fs.t (* used when a without impose a fs on a node defined by the match basic *)
| Prec of Pid.t * Pid.t
| Lprec of Pid.t * Pid.t
let build_pos_constraint domain ?locals pos_table const = let build_pos_constraint domain ?locals pos_table const =
let pid_of_name loc node_name = Pid.Pos (Id.build ~loc node_name pos_table) in let pid_of_name loc node_name = Pid.Pos (Id.build ~loc node_name pos_table) in
match const with match const with
...@@ -143,6 +146,12 @@ module Rule = struct ...@@ -143,6 +146,12 @@ module Rule = struct
Domain.check_feature_name domain ~loc feat_name; Domain.check_feature_name domain ~loc feat_name;
Feature_re (pid_of_name loc node_name, feat_name, regexp) Feature_re (pid_of_name loc node_name, feat_name, regexp)
| (Ast.Prec (id1, id2), loc) ->
Prec (pid_of_name loc id1, pid_of_name loc id2)
| (Ast.Lprec (id1, id2), loc) ->
Lprec (pid_of_name loc id1, pid_of_name loc id2)
type basic = { type basic = {
graph: P_graph.t; graph: P_graph.t;
constraints: const list; constraints: const list;
...@@ -202,6 +211,12 @@ module Rule = struct ...@@ -202,6 +211,12 @@ module Rule = struct
Domain.check_feature_name domain ~loc feat_name; Domain.check_feature_name domain ~loc feat_name;
Feature_re (pid_of_name loc node_name, feat_name, regexp) Feature_re (pid_of_name loc node_name, feat_name, regexp)
| (Ast.Prec (id1, id2), loc) ->
Prec (pid_of_name loc id1, pid_of_name loc id2)
| (Ast.Lprec (id1, id2), loc) ->
Lprec (pid_of_name loc id1, pid_of_name loc id2)
(* It may raise [P_fs.Fail_unif] in case of contradiction on constraints *) (* 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 build_neg_basic domain ?pat_vars ?(locals=[||]) pos_table basic_ast =
let (extension, neg_table) = let (extension, neg_table) =
...@@ -569,6 +584,14 @@ module Rule = struct ...@@ -569,6 +584,14 @@ module Rule = struct
else raise Fail else raise Fail
else raise Fail else raise Fail
end end
| Prec (pid1, pid2) ->
let gid1 = Pid_map.find pid1 matching.n_match in
let gid2 = Pid_map.find pid2 matching.n_match in
failwith "TODO"
| Lprec (pid1, pid2) ->
let gid1 = Pid_map.find pid1 matching.n_match in
let gid2 = Pid_map.find pid2 matching.n_match in
failwith "TODO"
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
(* returns all extension of the partial input matching *) (* 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