Skip to content

GitLab

L
libcaml-grew
Commit ff78b7a6 authored by bguillaum's avatar bguillaum
Browse files
Options

generalize the usage of c_ident (X#a.feat) instead of IDENT 

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8099 7838e531-6607-4d57-9587-6c381814729c
parent 82612a36
Hide whitespace changes
Inline Side-by-side
Showing with 99 additions and 86 deletions
src/grew_ast.ml
View file @ ff78b7a6
......@@ -39,6 +39,14 @@ module Ast = struct
}
type edge = u_edge * Loc.t
(* the base node name and the eventual new_node extension *)
type c_ident = Id.name * string option
let c_ident_to_string (string_node, new_opt) =
match new_opt with
| None -> string_node
| Some a -> sprintf "%s#%s" string_node a
type ineq = Lt | Gt | Le | Ge
let string_of_ineq = function
......@@ -49,17 +57,17 @@ module Ast = struct
type feature_name = string
type u_const =
| Start of Id.name * string list (* (source, labels) *)
| Cst_out of Id.name
| End of Id.name * string list (* (target, labels) *)
| Cst_in of Id.name
| Feature_eq of (Id.name * feature_name) * (Id.name * feature_name)
| Feature_diseq of (Id.name * feature_name) * (Id.name * feature_name)
| Feature_ineq of ineq * (Id.name * feature_name) * (Id.name * feature_name)
type u_const =
| Start of c_ident * string list (* (source, labels) *)
| Cst_out of c_ident
| End of c_ident * string list (* (target, labels) *)
| Cst_in of c_ident
| Feature_eq of (c_ident * feature_name) * (c_ident * feature_name)
| Feature_diseq of (c_ident * feature_name) * (c_ident * feature_name)
| Feature_ineq of ineq * (c_ident * feature_name) * (c_ident * feature_name)
type const = u_const * Loc.t
type pattern = {
pat_nodes: node list;
pat_edges: edge list;
......@@ -71,14 +79,6 @@ module Ast = struct
edge: edge list;
}
(* the base node name and the eventual new_node extension *)
type c_ident = Id.name * string option
let c_ident_to_string (string_node, new_opt) =
match new_opt with
| None -> string_node
| Some a -> sprintf "%s#%s" string_node a
type concat_item =
| Qfn_item of (c_ident * feature_name)
| String_item of string
......
src/grew_ast.mli
View file @ ff78b7a6
......@@ -38,6 +38,11 @@ module Ast : sig
type edge = u_edge * Loc.t
(* the base node name and the eventual new_node extension *)
type c_ident = Id.name * string option
val c_ident_to_string: c_ident -> string
type ineq = Lt | Gt | Le | Ge
val string_of_ineq: ineq -> string
......@@ -45,13 +50,13 @@ module Ast : sig
type feature_name = string
type u_const =
| Start of Id.name * string list (* (source, labels) *)
| Cst_out of Id.name
| End of Id.name * string list (* (target, labels) *)
| Cst_in of Id.name
| Feature_eq of (Id.name * feature_name) * (Id.name * feature_name)
| Feature_diseq of (Id.name * feature_name) * (Id.name * feature_name)
| Feature_ineq of ineq * (Id.name * feature_name) * (Id.name * feature_name)
| Start of c_ident * string list (* (source, labels) *)
| Cst_out of c_ident
| End of c_ident * string list (* (target, labels) *)
| Cst_in of c_ident
| Feature_eq of (c_ident * feature_name) * (c_ident * feature_name)
| Feature_diseq of (c_ident * feature_name) * (c_ident * feature_name)
| Feature_ineq of ineq * (c_ident * feature_name) * (c_ident * feature_name)
type const = u_const * Loc.t
......@@ -61,11 +66,6 @@ module Ast : sig
pat_const: const list;
}
(* the base node name and the eventual new_node extension *)
type c_ident = Id.name * string option
val c_ident_to_string: c_ident -> string
type concat_item =
| Qfn_item of (c_ident * feature_name)
| String_item of string
......
src/grew_command.ml
View file @ ff78b7a6
......@@ -67,7 +67,7 @@ module Command = struct
| (Ast.Del_edge_expl (i, j, lab), loc) ->
check_c_ident loc i kci;
check_c_ident loc j kci;
let edge = G_edge.make (* XXX: ~loc *) ~locals lab in
let edge = G_edge.make ~loc ~locals lab in
((DEL_EDGE_EXPL (pid_of_c_ident i, pid_of_c_ident j, edge), loc), (kci, kei))
| (Ast.Del_edge_name id, loc) ->
......@@ -77,7 +77,7 @@ module Command = struct
| (Ast.Add_edge (i, j, lab), loc) ->
check_c_ident loc i kci;
check_c_ident loc j kci;
let edge = G_edge.make (* XXX: ~loc *) ~locals lab in
let edge = G_edge.make ~loc ~locals lab in
((ADD_EDGE (pid_of_c_ident i, pid_of_c_ident j, edge), loc), (kci, kei))
| (Ast.Shift_edge (i, j), loc) ->
......
src/grew_html.ml
View file @ ff78b7a6
......@@ -83,13 +83,19 @@ module Html_doc = struct
let buff_html_const buff (u_const,_) =
bprintf buff " ";
(match u_const with
| Ast.Start (id,labels) -> bprintf buff "%s -[%s]-> *" id (List_.to_string (fun x->x) "|" labels)
| Ast.Cst_out id -> bprintf buff "%s -> *" id
| Ast.End (id,labels) -> bprintf buff "* -[%s]-> %s" (List_.to_string (fun x->x) "|" labels) id
| Ast.Cst_in id -> bprintf buff "* -> %s" id
| Ast.Feature_eq ((n_l,fn_l), (n_r,fn_r)) -> bprintf buff "%s.%s = %s.%s" n_l fn_l n_r fn_r;
| Ast.Feature_diseq ((n_l,fn_l), (n_r,fn_r)) -> bprintf buff "%s.%s <> %s.%s" n_l fn_l n_r fn_r;
| Ast.Feature_ineq (ineq, (n_l,fn_l), (n_r,fn_r)) -> bprintf buff "%s.%s %s %s.%s" n_l fn_l (Ast.string_of_ineq ineq) n_r fn_r
| Ast.Start (c_ident,labels) ->
bprintf buff "%s -[%s]-> *" (Ast.c_ident_to_string c_ident) (List_.to_string (fun x->x) "|" labels)
| Ast.Cst_out c_ident ->
bprintf buff "%s -> *" (Ast.c_ident_to_string c_ident)
| Ast.End (c_ident,labels) ->
bprintf buff "* -[%s]-> %s" (List_.to_string (fun x->x) "|" labels) (Ast.c_ident_to_string c_ident)
| Ast.Cst_in c_ident -> bprintf buff "* -> %s" (Ast.c_ident_to_string c_ident)
| Ast.Feature_eq ((c_ident_l,fn_l), (c_ident_r,fn_r)) ->
bprintf buff "%s.%s = %s.%s" (Ast.c_ident_to_string c_ident_l) fn_l (Ast.c_ident_to_string c_ident_r) fn_r;
| Ast.Feature_diseq ((c_ident_l,fn_l), (c_ident_r,fn_r)) ->
bprintf buff "%s.%s <> %s.%s" (Ast.c_ident_to_string c_ident_l) fn_l (Ast.c_ident_to_string c_ident_r) fn_r;
| Ast.Feature_ineq (ineq, (c_ident_l,fn_l), (c_ident_r,fn_r)) ->
bprintf buff "%s.%s %s %s.%s" (Ast.c_ident_to_string c_ident_l) fn_l (Ast.string_of_ineq ineq) (Ast.c_ident_to_string c_ident_r) fn_r
);
bprintf buff "\n"
......
src/grew_rule.ml
View file @ ff78b7a6
......@@ -84,20 +84,21 @@ module Rule = struct
let build_pos_constraint ?locals pos_table const =
let pid_of_name loc node_name = Pid.Pos (Id.build ~loc node_name pos_table) in
match const with
| (Ast.Start (node_name, labels), loc) ->
| (Ast.Start ((node_name,None), labels), loc) ->
Cst_out (pid_of_name loc node_name, P_edge.make ~loc ?locals labels)
| (Ast.Cst_out node_name, loc) ->
| (Ast.Cst_out (node_name,None), loc) ->
Cst_out (pid_of_name loc node_name, P_edge.all)
| (Ast.End (node_name, labels),loc) ->
| (Ast.End ((node_name,None), labels),loc) ->
Cst_in (pid_of_name loc node_name, P_edge.make ~loc ?locals labels)
| (Ast.Cst_in node_name, loc) ->
| (Ast.Cst_in (node_name,None), loc) ->
Cst_in (pid_of_name loc node_name, P_edge.all)
| (Ast.Feature_eq ((node_name1, feat_name1), (node_name2, feat_name2)), loc) ->
| (Ast.Feature_eq (((node_name1,None), feat_name1), ((node_name2,None), feat_name2)), loc) ->
Feature_eq (pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
| (Ast.Feature_diseq ((node_name1, feat_name1), (node_name2, feat_name2)), loc) ->
| (Ast.Feature_diseq (((node_name1,None), feat_name1), ((node_name2,None), feat_name2)), loc) ->
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) ->
| (Ast.Feature_ineq (ineq, ((node_name1,None), feat_name1), ((node_name2,None), feat_name2)), loc) ->
Feature_ineq (ineq, pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
| _ -> Log.critical "Constraints on activated nodes not implemented"
type pattern = {
graph: P_graph.t;
......@@ -122,20 +123,21 @@ module Rule = struct
| Some i -> Pid.Pos i
| None -> Pid.Neg (Id.build ~loc node_name neg_table) in
match const with
| (Ast.Start (node_name, labels),loc) ->
| (Ast.Start ((node_name,None), labels),loc) ->
Cst_out (pid_of_name loc node_name, P_edge.make ~loc ?locals labels)
| (Ast.Cst_out node_name, loc) ->
| (Ast.Cst_out (node_name,None), loc) ->
Cst_out (pid_of_name loc node_name, P_edge.all)
| (Ast.End (node_name, labels),loc) ->
| (Ast.End ((node_name,None), labels),loc) ->
Cst_in (pid_of_name loc node_name, P_edge.make ~loc ?locals labels)
| (Ast.Cst_in node_name, loc) ->
| (Ast.Cst_in (node_name,None), loc) ->
Cst_in (pid_of_name loc node_name, P_edge.all)
| (Ast.Feature_eq ((node_name1, feat_name1), (node_name2, feat_name2)), loc) ->
| (Ast.Feature_eq (((node_name1,None), feat_name1), ((node_name2,None), feat_name2)), loc) ->
Feature_eq (pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
| (Ast.Feature_diseq ((node_name1, feat_name1), (node_name2, feat_name2)), loc) ->
| (Ast.Feature_diseq (((node_name1,None), feat_name1), ((node_name2,None), feat_name2)), loc) ->
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) ->
| (Ast.Feature_ineq (ineq, ((node_name1,None), feat_name1), ((node_name2,None), feat_name2)), loc) ->
Feature_ineq (ineq, pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
| _ -> Log.critical "Constraints on activated nodes not implemented"
let build_neg_pattern ?(locals=[||]) pos_table pattern_ast =
let (extension, neg_table) =
......
src/parser/gr_grs_parser.mly
View file @ ff78b7a6
......@@ -79,13 +79,11 @@ let localize t = (t,get_loc ())
%token <string> AROBAS_ID /* @id */
%token <string> COLOR /* @#89abCD */
%token <string> IDENT /* indentifier */
%token <Grew_utils.Id.name * Grew_ast.Ast.feature_name>
QFN /* ident.ident */
%token <Grew_utils.Id.name * string option>
EXT_IDENT
%token <(Grew_utils.Id.name * string option) * Grew_ast.Ast.feature_name>
EXT_QFN
%token <string> IDENT /* indentifier */
%token <Grew_utils.Id.name * string option> EXT_IDENT
%token <(Grew_utils.Id.name * string option) * Grew_ast.Ast.feature_name> QFN
%token <string> STRING
%token <int> INT
%token <string list> COMMENT
......@@ -153,7 +151,9 @@ label_ident:
label_item:
| x = IDENT { x }
| p = QFN { (fst p)^"."^(snd p) }
| p = QFN { match p with ((n1, None), n2) -> (n1^"."^n2) | _ -> failwith ("Invalid label identifier") }
(* last line is a hack to see mod.app as a valid label_item: reuse of QFN outside of the right context !!! *)
......@@ -459,19 +459,26 @@ edge_id:
pat_const:
(* "A -[X|Y]-> *" *)
| n1 = IDENT labels = delimited(LTR_EDGE_LEFT,separated_nonempty_list(PIPE,label_ident),LTR_EDGE_RIGHT) STAR
| n1 = c_ident labels = delimited(LTR_EDGE_LEFT,separated_nonempty_list(PIPE,label_ident),LTR_EDGE_RIGHT) STAR
{ localize (Ast.Start (n1,labels)) }
(* "A -> *" *)
| n1 = IDENT GOTO_NODE STAR
{ localize (Ast.Cst_out (n1,None)) }
| n1 = EXT_IDENT GOTO_NODE STAR
{ localize (Ast.Cst_out n1) }
(* TODO: the next line should replace the previous one, but it give a conflit ... *)
(* (\* "A -> *" *\) *)
(* | n1 = c_ident GOTO_NODE STAR *)
(* { Printf.printf "===== A#e -> * ======>%s<====\n%!" (Ast.c_ident_to_string n1); localize (Ast.Cst_out n1) } *)
(* "* -[X|Y]-> A" *)
| STAR labels = delimited(LTR_EDGE_LEFT,separated_nonempty_list(PIPE,label_ident),LTR_EDGE_RIGHT) n2 = IDENT
| STAR labels = delimited(LTR_EDGE_LEFT,separated_nonempty_list(PIPE,label_ident),LTR_EDGE_RIGHT) n2 = c_ident
{ localize (Ast.End (n2,labels)) }
(* "* -> A" *)
| STAR GOTO_NODE n2 = IDENT
| STAR GOTO_NODE n2 = c_ident
{ localize (Ast.Cst_in n2) }
(* X.cat = Y.cat *)
......@@ -523,7 +530,7 @@ pat_const:
commands:
| COMMANDS x = delimited(LACC,separated_nonempty_list_final_opt(SEMIC,command),RACC) { x }
cident:
c_ident:
| i=IDENT { (i, None) }
| ei=EXT_IDENT { ei }
......@@ -536,36 +543,36 @@ command:
{ localize (Ast.Del_edge_name n) }
(* del_edge m -[x]-> n *)
| DEL_EDGE n1 = cident label = delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) n2 = cident
| DEL_EDGE n1 = c_ident label = delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) n2 = c_ident
{ localize (Ast.Del_edge_expl (n1,n2,label)) }
(* add_edge m -[x]-> n *)
| ADD_EDGE n1 = cident label = delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) n2 = cident
| ADD_EDGE n1 = c_ident label = delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) n2 = c_ident
{ localize (Ast.Add_edge (n1,n2,label)) }
(* shift_in m ==> n *)
| SHIFT_IN n1 = cident LONGARROW n2 = cident
| SHIFT_IN n1 = c_ident LONGARROW n2 = c_ident
{ localize (Ast.Shift_in (n1,n2)) }
(* shift_out m ==> n *)
| SHIFT_OUT n1 = cident LONGARROW n2 = cident
| SHIFT_OUT n1 = c_ident LONGARROW n2 = c_ident
{ localize (Ast.Shift_out (n1,n2)) }
(* shift m ==> n *)
| SHIFT n1 = cident LONGARROW n2 = cident
| SHIFT n1 = c_ident LONGARROW n2 = c_ident
{ localize (Ast.Shift_edge (n1,n2)) }
(* merge m ==> n *)
| MERGE n1 = cident LONGARROW n2 = cident
| MERGE n1 = c_ident LONGARROW n2 = c_ident
{ localize (Ast.Merge_node (n1,n2)) }
(* del_node n *)
| DEL_NODE n = cident
| DEL_NODE n = c_ident
{ localize (Ast.Del_node n) }
(* add_node n: <-[x]- m *)
| ADD_NODE n1 = cident DDOT label = delimited(RTL_EDGE_LEFT,label_ident,RTL_EDGE_RIGHT) n2 = cident
| ADD_NODE n1 = c_ident DDOT label = delimited(RTL_EDGE_LEFT,label_ident,RTL_EDGE_RIGHT) n2 = c_ident
{ localize (Ast.New_neighbour (n1,n2,label)) }
(* activate n#a *)
......@@ -573,15 +580,15 @@ command:
{ localize (Ast.Activate n) }
(* del_feat m.cat *)
| DEL_FEAT qfn = EXT_QFN
| DEL_FEAT qfn = QFN
{ localize (Ast.Del_feat qfn) }
(* m.cat = n.x + "_" + nn.y *)
| qfn = EXT_QFN EQUAL items = separated_nonempty_list (PLUS, concat_item)
| qfn = QFN EQUAL items = separated_nonempty_list (PLUS, concat_item)
{ localize (Ast.Update_feat (qfn, items)) }
concat_item:
| qfn = EXT_QFN { Ast.Qfn_item qfn }
| qfn = QFN { Ast.Qfn_item qfn }
| s = IDENT { Ast.String_item s }
| s = STRING { Ast.String_item s }
| p = AROBAS_ID { Ast.Param_item p }
......
src/parser/lexer.mll
View file @ ff78b7a6
......@@ -10,24 +10,21 @@
let tmp_string = ref ""
let escaped = ref false
let parse_couple string =
match Str.split (Str.regexp "\\.") string with
| [s1; s2] -> (s1, s2)
| _ -> Log.fcritical "[BUG] \"%s\" is not a couple" string
let parse_ext_ident string =
match Str.split (Str.regexp "#") string with
| [base; ext] -> (base, Some ext)
| _ -> Log.fcritical "[BUG] \"%s\" is not an extented ident" string
let parse_ext_qfn string =
let parse_short_qfn string =
match Str.split (Str.regexp "\\.") string with
| [s1; s2] -> ((s1,None), s2)
| _ -> Log.fcritical "[BUG] \"%s\" is not a couple" string
let parse_long_qfn string =
match Str.split (Str.regexp "\\.") string with
| [ext_ident; feat_name] -> (parse_ext_ident ext_ident, feat_name)
| _ -> Log.fcritical "[BUG] \"%s\" is not an extented qfn" string
let split_comment com =
let raw = Str.split (Str.regexp "\n") com in
List.filter (fun l -> not (Str.string_match (Str.regexp "[ \t]*$") l 0)) raw
......@@ -117,14 +114,15 @@ and global = parse
| "graph" { GRAPH }
| digit+ as number { INT (int_of_string number) }
| ident ['.'] ident as c { QFN (parse_couple c) }
| ident as id { IDENT id }
| '$' ident as pat_var { DOLLAR_ID pat_var}
| '@' ident as cmd_var { AROBAS_ID cmd_var }
| "@#" color as col { COLOR col }
| ident '#' ident as ext_ident { EXT_IDENT (parse_ext_ident ext_ident) }
| ident '#' ident ['.'] ident as ext_qfn { EXT_QFN (parse_ext_qfn ext_qfn) }
| ident ['.'] ident as qfn { QFN (parse_short_qfn qfn) }
| ident '#' ident ['.'] ident as qfn { QFN (parse_long_qfn qfn) }
| '{' { LACC }
......
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