Commit 9fca1eb5 authored by Bruno Guillaume's avatar Bruno Guillaume

remove the command “merge”

parent 7e05b76b
......@@ -17,7 +17,6 @@
;; ("$[a-zA-Z0-9_àéèçâôûêäïüö'\-]+" . font-lock-constant-face);;params inside
("del_edge" . font-lock-constant-face)
("add_edge" . font-lock-constant-face)
("merge" . font-lock-constant-face)
("shift" . font-lock-constant-face)
("shift_in" . font-lock-constant-face)
("shift_out" . font-lock-constant-face)
......
......@@ -255,7 +255,6 @@ module Ast = struct
| Shift_out of (Id.name * Id.name * edge_label_cst)
| Shift_edge of (Id.name * Id.name * edge_label_cst)
| Merge_node of (Id.name * Id.name)
| New_neighbour of (Id.name * Id.name * edge_label)
| New_node of Id.name
| New_before of (Id.name * Id.name)
......@@ -304,7 +303,6 @@ module Ast = struct
| Shift_edge (n1,n2,Regexp re) ->
sprintf "shift %s =[re\"%s\"]=> %s" n1 re n2
| Merge_node (n1,n2) -> sprintf "merge %s ==> %s" n1 n2
| New_neighbour (n1,n2,label) -> sprintf "add_node %s: <-[%s]- %s" n1 label n2
| New_node (n) -> sprintf "add_node %s" n
| New_before (n1,n2) -> sprintf "add_node %s :< %s" n1 n2
......
......@@ -143,7 +143,6 @@ module Ast : sig
| Shift_out of (Id.name * Id.name * edge_label_cst)
| Shift_edge of (Id.name * Id.name * edge_label_cst)
| Merge_node of (Id.name * Id.name)
| New_neighbour of (Id.name * Id.name * edge_label)
| New_node of Id.name
......
......@@ -63,7 +63,6 @@ module Command = struct
| SHIFT_EDGE of (command_node * command_node * Label_cst.t)
| SHIFT_IN of (command_node * command_node * Label_cst.t)
| SHIFT_OUT of (command_node * command_node * Label_cst.t)
| MERGE_NODE of (command_node * command_node)
type t = p * Loc.t (* remember command location to be able to localize a command failure *)
......@@ -153,13 +152,6 @@ module Command = struct
("label_cst", Label_cst.to_json ?domain label_cst);
]
)]
| MERGE_NODE (src,tar) ->
`Assoc [("merge",
`Assoc [
("src",command_node_to_json src);
("tar",command_node_to_json tar);
]
)]
(* a item in the command history: command applied to a graph *)
type h =
......@@ -178,7 +170,6 @@ module Command = struct
| H_SHIFT_EDGE of (Gid.t * Gid.t)
| H_SHIFT_IN of (Gid.t * Gid.t)
| H_SHIFT_OUT of (Gid.t * Gid.t)
| H_MERGE_NODE of (Gid.t * Gid.t)
let build ?domain ?param (kai, kei) table locals ast_command =
......@@ -237,11 +228,6 @@ module Command = struct
check_node_id loc act_j kai;
((SHIFT_OUT (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ?domain ~loc label_cst), loc), (kai, kei))
| (Ast.Merge_node (act_i, act_j), loc) ->
check_node_id loc act_i kai;
check_node_id loc act_j kai;
((MERGE_NODE (pid_of_act_id loc act_i, pid_of_act_id loc act_j), loc), (List_.rm act_i kai, kei))
| (Ast.New_node new_id, loc) ->
if List.mem new_id kai
then Error.build ~loc "Node identifier \"%s\" is already used" new_id;
......
......@@ -42,7 +42,6 @@ module Command : sig
| SHIFT_EDGE of (command_node * command_node * Label_cst.t)
| SHIFT_IN of (command_node * command_node * Label_cst.t)
| SHIFT_OUT of (command_node * command_node * Label_cst.t)
| MERGE_NODE of (command_node * command_node)
type t = (p * Loc.t)
val to_json: ?domain:Domain.t -> t -> Yojson.Basic.json
......@@ -63,7 +62,6 @@ module Command : sig
| H_SHIFT_EDGE of (Gid.t * Gid.t)
| H_SHIFT_IN of (Gid.t * Gid.t)
| H_SHIFT_OUT of (Gid.t * Gid.t)
| H_MERGE_NODE of (Gid.t * Gid.t)
val build:
?domain: Domain.t ->
......
......@@ -646,24 +646,6 @@ module G_graph = struct
|> (shift_in loc ?domain src_gid tar_gid is_gid_local label_cst)
|> (shift_out loc ?domain src_gid tar_gid is_gid_local label_cst)
(* -------------------------------------------------------------------------------- *)
let merge_node loc ?domain graph is_gid_local src_gid tar_gid =
let se_graph = shift_edges loc ?domain src_gid tar_gid is_gid_local Label_cst.all graph in
let src_node = Gid_map.find src_gid se_graph.map in
let tar_node = Gid_map.find tar_gid se_graph.map in
match G_fs.unif (G_node.get_fs src_node) (G_node.get_fs tar_node) with
| Some new_fs ->
Some {graph with map =
(Gid_map.add
tar_gid
(G_node.set_fs new_fs tar_node)
(Gid_map.remove src_gid se_graph.map)
)
}
| None -> None
(* -------------------------------------------------------------------------------- *)
let set_feat ?loc ?domain graph node_id feat_name new_value =
let node = Gid_map.find node_id graph.map in
......
......@@ -144,8 +144,6 @@ module G_graph: sig
val add_before: Loc.t -> ?domain:Domain.t -> Gid.t -> t -> (Gid.t * t)
val add_after: Loc.t -> ?domain:Domain.t -> Gid.t -> t -> (Gid.t * t)
val merge_node: Loc.t -> ?domain:Domain.t -> t -> (Gid.t -> bool) -> Gid.t -> Gid.t -> t option
(** move all in arcs to id_src are moved to in arcs on node id_tar from graph, with all its incoming edges *)
val shift_in: Loc.t -> ?domain:Domain.t -> Gid.t -> Gid.t -> (Gid.t -> bool) -> Label_cst.t -> t -> t
......
......@@ -169,7 +169,7 @@ and standard target = parse
| "shift_in" { SHIFT_IN }
| "shift_out" { SHIFT_OUT }
| "shift" { SHIFT }
| "merge" { MERGE }
| "merge" { raise (Error "merge commnand was removed since version 0.43") }
| "del_node" { DEL_NODE }
| "add_node" { ADD_NODE }
| "del_feat" { DEL_FEAT }
......
......@@ -89,7 +89,6 @@ let localize t = (t,get_loc ())
%token DEL_EDGE /* del_edge */
%token ADD_EDGE /* add_edge */
%token MERGE /* merge */
%token SHIFT_IN /* shift_in */
%token SHIFT_OUT /* shift_out */
%token SHIFT /* shift */
......@@ -650,10 +649,6 @@ command:
tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_edge (src, tar, Ast.Neg_list labels), loc) }
/* merge m ==> n */
| MERGE src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Merge_node (src, tar), loc) }
/* del_node n */
| DEL_NODE ci_loc=simple_id_with_loc
{ let (ci,loc) = ci_loc in (Ast.Del_node (ci), loc) }
......
......@@ -881,11 +881,8 @@ module Rule = struct
extend_matching ?domain (positive,neg) graph new_partial
with P_fs.Fail -> []
(* ---------------------------------------------------------------------- *)
(* the exception below is added to handle unification failure in merge!! *)
exception Command_execution_fail
(* [in_img node_gid n_match] checks if [node_gid] belongs to the codomain of [n_match] *)
(* [test_locality matching created_nodes gid] checks if [gid] is a "local" node:
either it belongs to the codomain of [matching] or it is one of the [created_nodes] *)
let test_locality matching created_nodes gid =
(Pid_map.exists (fun _ id -> id=gid) matching.n_match) || (List.exists (fun (_,id) -> id=gid) created_nodes)
......@@ -966,21 +963,6 @@ module Rule = struct
created_nodes
)
| Command.MERGE_NODE (src_cn, tar_cn) ->
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
(match G_graph.merge_node loc ?domain instance.Instance.graph (test_locality matching created_nodes) src_gid tar_gid with
| Some new_graph ->
(
{instance with
Instance.graph = new_graph;
history = List_.sort_insert (Command.H_MERGE_NODE (src_gid,tar_gid)) instance.Instance.history
},
created_nodes
)
| None -> raise Command_execution_fail
)
| Command.UPDATE_FEAT (tar_cn,tar_feat_name, item_list) ->
let tar_gid = node_find tar_cn in
let rule_items = List.map
......@@ -1084,8 +1066,7 @@ module Rule = struct
)
(* ---------------------------------------------------------------------- *)
(** [apply_rule instance matching rule] returns a new instance after the application of the rule
[Command_execution_fail] is raised if some merge unification fails *)
(** [apply_rule instance matching rule] returns a new instance after the application of the rule *)
let apply_rule ?domain modul_name instance matching rule =
(* Timeout check *)
......@@ -1193,8 +1174,7 @@ module Rule = struct
let matching_list = match_in_graph ?domain ?param:rule.param rule.pattern instance.Instance.graph in
List.fold_left
(fun acc1 matching ->
try Instance_set.add (apply_rule ?domain modul_name instance matching rule) acc1
with Command_execution_fail -> acc1
Instance_set.add (apply_rule ?domain modul_name instance matching rule) acc1
) acc matching_list
) Instance_set.empty rules
......
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