From 39cc192a010364df4ee0f6307f27bc8a37f026b9 Mon Sep 17 00:00:00 2001
From: Bruno Guillaume <bruno.guillaume@loria.fr>
Date: Tue, 16 May 2017 20:42:10 +0200
Subject: [PATCH] Fix #2: add new syntax for add edge with a label taken from a
matched edge
---
src/grew_ast.ml | 3 +++
src/grew_ast.mli | 1 +
src/grew_command.ml | 16 ++++++++++++++++
src/grew_command.mli | 2 ++
src/grew_parser.mly | 4 ++++
src/grew_rule.ml | 21 +++++++++++++++++++++
6 files changed, 47 insertions(+)
diff --git a/src/grew_ast.ml b/src/grew_ast.ml
index c40c34a..f210403 100644
--- a/src/grew_ast.ml
+++ b/src/grew_ast.ml
@@ -248,6 +248,7 @@ module Ast = struct
| Del_edge_expl of (Id.name * Id.name * edge_label)
| Del_edge_name of string
| Add_edge of (Id.name * Id.name * edge_label)
+ | Add_edge_expl of (Id.name * Id.name * string)
(* 4 args: source, target, labels, flag true iff negative cst *)
| Shift_in of (Id.name * Id.name * edge_label_cst)
@@ -272,6 +273,8 @@ module Ast = struct
| Del_edge_name name -> sprintf "del_edge %s" name
| Add_edge (n1,n2,label) ->
sprintf "add_edge %s -[%s]-> %s" n1 label n2
+ | Add_edge_expl (n1,n2,name) ->
+ sprintf "add_edge %s: %s -> %s" name n1 n2
| Shift_in (n1,n2,Neg_list []) ->
sprintf "shift_in %s ==> %s" n1 n2
diff --git a/src/grew_ast.mli b/src/grew_ast.mli
index 4c6926c..d0c5ae8 100644
--- a/src/grew_ast.mli
+++ b/src/grew_ast.mli
@@ -136,6 +136,7 @@ module Ast : sig
| Del_edge_expl of (Id.name * Id.name * edge_label)
| Del_edge_name of string
| Add_edge of (Id.name * Id.name * edge_label)
+ | Add_edge_expl of (Id.name * Id.name * string)
(* 4 args: source, target, labels, flag true iff negative cst *)
| Shift_in of (Id.name * Id.name * edge_label_cst)
diff --git a/src/grew_command.ml b/src/grew_command.ml
index 286b5a1..4fab75b 100644
--- a/src/grew_command.ml
+++ b/src/grew_command.ml
@@ -52,6 +52,7 @@ module Command = struct
| DEL_EDGE_EXPL of (command_node * command_node * G_edge.t)
| DEL_EDGE_NAME of string
| ADD_EDGE of (command_node * command_node * G_edge.t)
+ | ADD_EDGE_EXPL of (command_node * command_node * string)
| DEL_FEAT of (command_node * string)
| UPDATE_FEAT of (command_node * string * item list)
@@ -86,6 +87,15 @@ module Command = struct
]
)]
+ | ADD_EDGE_EXPL (src,tar,name) ->
+ `Assoc [("add_edge",
+ `Assoc [
+ ("src",command_node_to_json src);
+ ("tar",command_node_to_json tar);
+ ("name", `String name);
+ ]
+ )]
+
| DEL_FEAT (cn, feature_name) ->
`Assoc [("del_feat",
`Assoc [
@@ -157,6 +167,7 @@ module Command = struct
| H_DEL_EDGE_EXPL of (Gid.t * Gid.t * G_edge.t)
| H_DEL_EDGE_NAME of string
| H_ADD_EDGE of (Gid.t * Gid.t * G_edge.t)
+ | H_ADD_EDGE_EXPL of (Gid.t * Gid.t * string)
| H_DEL_FEAT of (Gid.t * string)
| H_UPDATE_FEAT of (Gid.t * string * string)
@@ -206,6 +217,11 @@ module Command = struct
let edge = G_edge.make ~loc ?domain lab in
((ADD_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, edge), loc), (kai, kei))
+ | (Ast.Add_edge_expl (act_i, act_j, name), loc) ->
+ check_node_id loc act_i kai;
+ check_node_id loc act_j kai;
+ ((ADD_EDGE_EXPL (pid_of_act_id loc act_i, pid_of_act_id loc act_j, name), loc), (kai, kei))
+
| (Ast.Shift_edge (act_i, act_j, label_cst), loc) ->
check_node_id loc act_i kai;
check_node_id loc act_j kai;
diff --git a/src/grew_command.mli b/src/grew_command.mli
index c13cb5b..5e84c22 100644
--- a/src/grew_command.mli
+++ b/src/grew_command.mli
@@ -31,6 +31,7 @@ module Command : sig
| DEL_EDGE_EXPL of (command_node * command_node *G_edge.t)
| DEL_EDGE_NAME of string
| ADD_EDGE of (command_node * command_node * G_edge.t)
+ | ADD_EDGE_EXPL of (command_node * command_node * string)
| DEL_FEAT of (command_node * string)
| UPDATE_FEAT of (command_node * string * item list)
@@ -51,6 +52,7 @@ module Command : sig
| H_DEL_EDGE_EXPL of (Gid.t * Gid.t *G_edge.t)
| H_DEL_EDGE_NAME of string
| H_ADD_EDGE of (Gid.t * Gid.t * G_edge.t)
+ | H_ADD_EDGE_EXPL of (Gid.t * Gid.t * string)
| H_DEL_FEAT of (Gid.t *string)
| H_UPDATE_FEAT of (Gid.t * string * string)
diff --git a/src/grew_parser.mly b/src/grew_parser.mly
index 018a832..34679d4 100644
--- a/src/grew_parser.mly
+++ b/src/grew_parser.mly
@@ -598,6 +598,10 @@ command:
| ADD_EDGE src_loc=simple_id_with_loc label=delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) tar=simple_id
{ let (src,loc) = src_loc in (Ast.Add_edge (src, tar, label), loc) }
+ /* add_edge e: m -> n */
+ | ADD_EDGE id_loc=simple_id_with_loc DDOT src=simple_id EDGE tar=simple_id
+ { let (id,loc) = id_loc in (Ast.Add_edge_expl (src, tar, id), loc) }
+
/* shift_in m ==> n */
| SHIFT_IN src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_in (src, tar, Ast.Neg_list []), loc) }
diff --git a/src/grew_rule.ml b/src/grew_rule.ml
index 87d8a66..199d91d 100644
--- a/src/grew_rule.ml
+++ b/src/grew_rule.ml
@@ -908,6 +908,27 @@ module Rule = struct
Error.run "ADD_EDGE: the edge '%s' already exists %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
end
+ | Command.ADD_EDGE_EXPL (src_cn,tar_cn,edge_ident) ->
+ let src_gid = node_find src_cn in
+ let tar_gid = node_find tar_cn in
+ let (_,edge,_) =
+ try List.assoc edge_ident matching.e_match
+ with Not_found -> Error.bug "The edge identifier '%s' is undefined %s" edge_ident (Loc.to_string loc) in
+
+ begin
+ match G_graph.add_edge instance.Instance.graph src_gid edge tar_gid with
+ | Some new_graph ->
+ (
+ {instance with
+ Instance.graph = new_graph;
+ history = List_.sort_insert (Command.H_ADD_EDGE_EXPL (src_gid,tar_gid,edge_ident)) instance.Instance.history
+ },
+ created_nodes
+ )
+ | None ->
+ Error.run "ADD_EDGE_EXPL: the edge '%s' already exists %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
+ end
+
| Command.DEL_EDGE_EXPL (src_cn,tar_cn,edge) ->
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
--
GitLab