Commit 5ca04d8a authored by Bruno Guillaume's avatar Bruno Guillaume

implement edge_del_feat

parent 9dc7d06a
......@@ -53,7 +53,7 @@ module Command = struct
| ADD_EDGE_EXPL of (command_node * command_node * string)
| ADD_EDGE_ITEMS of (command_node * command_node * (string * string) list)
| DEL_FEAT of (command_node * string)
| DEL_EDGE_FEAT of string (* edge identifier *)
| DEL_EDGE_FEAT of (string * string) (* (edge identifier, feature_name) *)
| UPDATE_FEAT of (command_node * string * item list)
| UPDATE_EDGE_FEAT of (string * string * string) (* edge identifier, feat_name, new_value *)
(* *)
......@@ -170,10 +170,11 @@ module Command = struct
("feat_value", `String s);
]
)]
| DEL_EDGE_FEAT edge_id ->
| DEL_EDGE_FEAT (edge_id, feat_name) ->
`Assoc [("del_edge_feat",
`Assoc [
("edge_id", `String edge_id)
("edge_id", `String edge_id);
("feat_name", `String feat_name)
]
)]
......@@ -268,7 +269,7 @@ module Command = struct
Domain.check_feature_name ~loc ?domain feat_name;
((DEL_FEAT (cn_of_node_id node_or_edge_id, feat_name), loc), (kni, kei))
| (false, true) ->
((DEL_EDGE_FEAT node_or_edge_id, loc), (kni, kei))
((DEL_EDGE_FEAT (node_or_edge_id, feat_name), loc), (kni, kei))
| _ -> Error.build ~loc "Unknwon identifier \"%s\"" node_or_edge_id
end
......
......@@ -33,7 +33,7 @@ module Command : sig
| ADD_EDGE_EXPL of (command_node * command_node * string)
| ADD_EDGE_ITEMS of (command_node * command_node * (string * string) list)
| DEL_FEAT of (command_node * string)
| DEL_EDGE_FEAT of string (* edge identifier *)
| DEL_EDGE_FEAT of (string * string) (* (edge identifier, feature_name) *)
| UPDATE_FEAT of (command_node * string * item list)
| UPDATE_EDGE_FEAT of (string * string * string) (* edge identifier, feat_name, new_value *)
......
......@@ -34,6 +34,12 @@ module G_edge = struct
| (fn,fv)::t when feat_name = fn -> (feat_name, new_value) :: t
| x::t -> x :: (update feat_name new_value t)
let rec remove feat_name = function
| [] -> None
| (fn,fv)::t when feat_name < fn -> None
| (fn,fv)::t when feat_name = fn -> Some t
| x::t -> (match remove feat_name t with Some new_t -> Some (x::new_t) | None -> None)
let to_conll ?domain edge =
let prefix = match get_sub "kind" edge with
| None -> ""
......
......@@ -39,6 +39,8 @@ module G_edge: sig
val build: ?domain:Domain.t -> Ast.edge -> t
val update: string -> string -> t -> t
val remove: string -> t -> t option
end (* module G_edge *)
......
......@@ -577,6 +577,14 @@ module G_graph = struct
| Some (new_node, new_edge) -> Some ({graph with map = Gid_map.add src_gid new_node graph.map}, new_edge)
| None -> None
let del_edge_feature ?loc edge_id feat_name (src_gid,edge,tar_gid) graph =
match Gid_map.find_opt src_gid graph.map with
| None -> Error.run ?loc "[Graph.del_edge_feature] cannot find source node of edge \"%s\"" edge_id
| Some src_node ->
match G_node.del_edge_feature tar_gid edge feat_name src_node with
| Some (new_node, new_edge) -> Some ({graph with map = Gid_map.add src_gid new_node graph.map}, new_edge)
| None -> None
(* -------------------------------------------------------------------------------- *)
let del_edge ?edge_ident loc graph id_src label id_tar =
let node_src =
......
......@@ -140,6 +140,8 @@ module G_graph: sig
val update_edge: ?edge_ident:string -> Loc.t -> t -> (Gid.t * G_edge.t * Gid.t ) -> string -> string -> (t * G_edge.t) option
val del_edge_feature: ?loc:Loc.t -> string -> string -> (Gid.t * G_edge.t * Gid.t ) -> t -> (t * G_edge.t) option
(** [del_node graph id] remove node [id] from [graph], with all its incoming and outcoming edges.
None is returned if [id] not defined in [graph]*)
......
......@@ -143,6 +143,14 @@ module G_node = struct
| Some new_next -> Some ({t with next = new_next }, new_edge)
| None -> None
let del_edge_feature gid_tar old_edge feat_name t =
match G_edge.remove feat_name old_edge with
| None -> None
| Some new_edge ->
match Massoc_gid.add_opt gid_tar new_edge (Massoc_gid.remove gid_tar old_edge t.next) with
| Some new_next -> Some ({t with next = new_next }, new_edge)
| None -> None
let remove_key node_id t =
try {t with next = Massoc_gid.remove_key node_id t.next} with Not_found -> t
......
......@@ -57,6 +57,7 @@ module G_node: sig
val remove_edge: Gid.t -> G_edge.t -> t -> t option
val update_edge: Gid.t -> G_edge.t -> string -> string -> t -> (t * G_edge.t) option
val del_edge_feature: Gid.t -> G_edge.t -> string -> t -> (t * G_edge.t) option
val remove_key: Gid.t -> t -> t
......
......@@ -1150,14 +1150,14 @@ module Rule = struct
let direct_items = List.map (fun (name, value) ->
match Str.bounded_split (Str.regexp_string ".") value 2
with
| [edge_id; efeat_name] ->
| [edge_id; feat_name] ->
begin
match String_map.find_opt edge_id state.e_mapping with
| None -> (name, value)
| Some (_,matched_edge,_) ->
match G_edge.get_sub efeat_name matched_edge with
match G_edge.get_sub feat_name matched_edge with
| Some new_value -> (name, new_value)
| None -> Error.run "ADD_EDGE_ITEMS: no items edge feature name '%s' in matched edge '%s'" efeat_name edge_id
| None -> Error.run "ADD_EDGE_ITEMS: no items edge feature name '%s' in matched edge '%s'" feat_name edge_id
end
| _ -> (name, value)
) items in
......@@ -1165,7 +1165,7 @@ module Rule = struct
begin
match G_graph.add_edge state.graph src_gid edge tar_gid with
| None when !Global.safe_commands ->
Error.run "ADD_EDGE_EXPL: the edge '%s' already exists %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
Error.run "ADD_EDGE_ITEMS: the edge '%s' already exists %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
| None -> state
| Some new_graph -> {state with graph = new_graph; effective = true}
end
......@@ -1194,7 +1194,23 @@ module Rule = struct
}
)
| Command.DEL_EDGE_FEAT _ -> failwith "Not implemented DEL_EDGE_FEAT in [onf_apply_command]"
| Command.DEL_EDGE_FEAT (edge_id, feat_name) ->
begin
match String_map.find_opt edge_id state.e_mapping with
| None -> Error.bug ~loc "The edge identifier '%s'" edge_id
| Some (src_gid,old_edge,tar_gid) ->
begin
match G_graph.del_edge_feature ~loc edge_id feat_name (src_gid,old_edge,tar_gid) state.graph with
| None when !Global.safe_commands -> Error.run ~loc "DEL_EDGE_FEAT: the edge feature name '%s' does not exist" feat_name
| None -> state
| Some (new_graph, new_edge) ->
{state with
graph = new_graph;
effective = true;
e_mapping = String_map.add edge_id (src_gid,new_edge,tar_gid) state.e_mapping;
}
end
end
| Command.UPDATE_EDGE_FEAT (edge_ident, feat_name, new_value) ->
let (src_gid,edge,tar_gid) =
......@@ -1413,7 +1429,7 @@ module Rule = struct
let tar_gid = node_find tar_cn in
let (_,edge,_) =
try String_map.find edge_ident gwh.e_mapping
with Not_found -> Error.bug "The edge identifier '%s' is undefined %s" edge_ident (Loc.to_string loc) in
with Not_found -> Error.bug "ADD_EDGE_EXPL: the edge identifier '%s' is undefined %s" edge_ident (Loc.to_string loc) in
begin
match G_graph.add_edge gwh.Graph_with_history.graph src_gid edge tar_gid with
......@@ -1434,14 +1450,14 @@ module Rule = struct
let direct_items = List.map (fun (name, value) ->
match Str.bounded_split (Str.regexp_string ".") value 2
with
| [edge_id; efeat_name] ->
| [edge_id; feat_name] ->
begin
match String_map.find_opt edge_id gwh.e_mapping with
| None -> (name, value)
| Some (_,matched_edge,_) ->
match G_edge.get_sub efeat_name matched_edge with
match G_edge.get_sub feat_name matched_edge with
| Some new_value -> (name, new_value)
| None -> Error.run "ADD_EDGE_ITEMS: no items edge feature name '%s' in matched edge '%s'" efeat_name edge_id
| None -> Error.run "ADD_EDGE_ITEMS: no items edge feature name '%s' in matched edge '%s'" feat_name edge_id
end
| _ -> (name, value)
) items in
......@@ -1449,7 +1465,7 @@ module Rule = struct
begin
match G_graph.add_edge gwh.Graph_with_history.graph src_gid edge tar_gid with
| None when !Global.safe_commands ->
Error.run "ADD_EDGE_EXPL: the edge '%s' already exists %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
Error.run "ADD_EDGE_ITEMS: the edge '%s' already exists %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
| None -> Graph_with_history_set.singleton gwh
| Some new_graph -> Graph_with_history_set.singleton
{gwh with
......@@ -1625,7 +1641,23 @@ module Rule = struct
Graph_with_history.graph = new_graph;
added_gids = (created_name, new_gid) :: gwh.Graph_with_history.added_gids
}
| Command.DEL_EDGE_FEAT _ -> failwith "Not implemented DEL_EDGE_FEAT in [gwh_apply_command]"
| Command.DEL_EDGE_FEAT (edge_id, feat_name) ->
begin
match String_map.find_opt edge_id gwh.e_mapping with
| None -> Error.bug ~loc "The edge identifier '%s'" edge_id
| Some (src_gid,old_edge,tar_gid) ->
begin
match G_graph.del_edge_feature ~loc edge_id feat_name (src_gid,old_edge,tar_gid) gwh.Graph_with_history.graph with
| None when !Global.safe_commands -> Error.run ~loc "DEL_EDGE_FEAT: the edge feature name '%s' does not exist" feat_name
| None -> Graph_with_history_set.singleton gwh
| Some (new_graph, new_edge) -> Graph_with_history_set.singleton
{gwh with
Graph_with_history.graph = new_graph;
e_mapping = String_map.add edge_id (src_gid,new_edge,tar_gid) gwh.e_mapping;
}
end
end
(* ---------------------------------------------------------------------- *)
(** [apply_rule graph_with_history matching rule] returns a new graph_with_history after the application of the rule *)
......
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