Commit 39cc192a authored by Bruno Guillaume's avatar Bruno Guillaume

Fix #2: add new syntax for add edge with a label taken from a matched edge

parent 2c7eb7d5
......@@ -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
......
......@@ -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)
......
......@@ -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;
......
......@@ -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)
......
......@@ -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) }
......
......@@ -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
......
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