Commit 695c1c74 authored by Bruno Guillaume's avatar Bruno Guillaume

more opt_* functions

parent e86ca5d2
......@@ -410,7 +410,7 @@ module type S = sig
val iter: (key -> 'a -> unit) -> 'a t -> unit
val add: key -> 'a -> 'a t -> 'a t option
val add_opt: key -> 'a -> 'a t -> 'a t option
val replace: key -> 'a list -> 'a t -> 'a t
......@@ -418,6 +418,7 @@ module type S = sig
(* raise Not_found if no (key,elt) *)
val remove: key -> 'a -> 'a t -> 'a t
val remove_opt: key -> 'a -> 'a t -> 'a t option
(* raise Not_found if no (key,elt) *)
val remove_key: key -> 'a t -> 'a t
......@@ -464,7 +465,7 @@ module Massoc_make (Ord: OrderedType) = struct
let replace = M.add
let add key elt t =
let add_opt key elt t =
try
let list = M.find key t in
match List_.usort_insert elt list with
......@@ -487,6 +488,10 @@ module Massoc_make (Ord: OrderedType) = struct
| [one] when one=value -> M.remove key t
| old -> M.add key (List_.usort_remove value old) t
let remove_opt key value t =
try Some (remove key value t)
with Not_found -> None
let remove_key key t = M.remove key t
let rec mem key value t =
......
......@@ -201,7 +201,7 @@ module type S =
val iter: (key -> 'a -> unit) -> 'a t -> unit
val add: key -> 'a -> 'a t -> 'a t option
val add_opt: key -> 'a -> 'a t -> 'a t option
val replace: key -> 'a list -> 'a t -> 'a t
......@@ -209,6 +209,7 @@ module type S =
(* raise Not_found if no (key,elt) *)
val remove: key -> 'a -> 'a t -> 'a t
val remove_opt: key -> 'a -> 'a t -> 'a t option
(* raise Not_found if no (key,elt) *)
val remove_key: key -> 'a t -> 'a t
......
......@@ -38,6 +38,8 @@ module G_fs: sig
If [t] does not contain such a feature, [t] is returned unchanged. *)
val del_feat: string -> t -> t
val get_atom: string -> t -> value option
(** [get_string_atom f t] returns [Some v] if the fs [t] contains the feature (f,v).
It returns [None] if there is no feature named [f] in [t] *)
val get_string_atom: string -> t -> string option
......
......@@ -488,9 +488,11 @@ module G_graph = struct
match edge_ident with
| None -> Log.fcritical "[RUN] Some edge refers to a dead node, please report"
| Some id -> Error.run ~loc "[Graph.del_edge] cannot find source node of edge \"%s\"" id in
try {graph with map = Gid_map.add id_src (G_node.remove id_tar label node_src) graph.map}
with Not_found -> Error.run ~loc "[Graph.del_edge] cannot find edge '%s'" (G_edge.to_string ?domain label)
match G_node.remove_opt id_tar label node_src with
| None -> None
| Some new_node -> Some {graph with map = Gid_map.add id_src new_node graph.map}
exception EEE
(* -------------------------------------------------------------------------------- *)
let del_node graph node_id =
let map_wo_node =
......@@ -500,31 +502,33 @@ module G_graph = struct
then acc
else Gid_map.add id (G_node.remove_key node_id value) acc
) graph.map Gid_map.empty in
let node = Gid_map.find node_id graph.map in
let new_map =
match (G_node.get_prec node, G_node.get_succ node) with
| (Some id_prec, Some id_succ) ->
begin
let prec = Gid_map.find id_prec map_wo_node
and succ = Gid_map.find id_succ map_wo_node in
map_wo_node
|> (Gid_map.add id_prec (G_node.set_succ id_succ prec))
|> (Gid_map.add id_succ (G_node.set_prec id_prec succ))
end
| (Some id_prec, None) ->
begin
let prec = Gid_map.find id_prec map_wo_node in
map_wo_node
|> (Gid_map.add id_prec (G_node.remove_succ prec))
end
| (None, Some id_succ) ->
begin
let succ = Gid_map.find id_succ map_wo_node in
map_wo_node
|> (Gid_map.add id_succ (G_node.remove_prec succ))
end
| (None, None) -> map_wo_node in
{ graph with map = new_map }
try
let node = Gid_map.find node_id graph.map in
let new_map =
match (G_node.get_prec node, G_node.get_succ node) with
| (Some id_prec, Some id_succ) ->
begin
let prec = Gid_map.find id_prec map_wo_node
and succ = Gid_map.find id_succ map_wo_node in
map_wo_node
|> (Gid_map.add id_prec (G_node.set_succ id_succ prec))
|> (Gid_map.add id_succ (G_node.set_prec id_prec succ))
end
| (Some id_prec, None) ->
begin
let prec = Gid_map.find id_prec map_wo_node in
map_wo_node
|> (Gid_map.add id_prec (G_node.remove_succ prec))
end
| (None, Some id_succ) ->
begin
let succ = Gid_map.find id_succ map_wo_node in
map_wo_node
|> (Gid_map.add id_succ (G_node.remove_prec succ))
end
| (None, None) -> map_wo_node in
Some { graph with map = new_map }
with Not_found -> None
(* -------------------------------------------------------------------------------- *)
let insert id1 id2 graph =
......@@ -598,7 +602,7 @@ module G_graph = struct
(fun (acc_src_next,acc_tar_next) next_gid edge ->
if Label_cst.match_ ?domain label_cst edge && not (is_gid_local next_gid)
then
match Massoc_gid.add next_gid edge acc_tar_next with
match Massoc_gid.add_opt next_gid edge acc_tar_next with
| Some new_acc_tar_next -> (Massoc_gid.remove next_gid edge acc_src_next, new_acc_tar_next)
| None -> Error.run ~loc "The [shift_out] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string ?domain edge)
else (acc_src_next,acc_tar_next)
......
......@@ -126,11 +126,11 @@ module G_graph: sig
(** [del_edge ?edge_ident loc graph id_src label id_tar] removes the edge (id_src -[label]-> id_tar) from graph.
Log.critical if the edge is not in graph *)
val del_edge: ?domain:Domain.t -> ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t
val del_edge: ?domain:Domain.t -> ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t option
(** [del_node graph id] remove node [id] from [graph], with all its incoming and outcoming edges.
[graph] is unchanged if the node is not in it. *)
val del_node: t -> Gid.t -> t
None is returned if [id] not defined in [graph]*)
val del_node: t -> Gid.t -> t option
val add_before: Gid.t -> t -> (Gid.t * t)
val add_after: Gid.t -> t -> (Gid.t * t)
......
......@@ -71,7 +71,7 @@ module G_node = struct
let to_gr t = sprintf "[%s] " (G_fs.to_gr t.fs)
let add_edge g_edge gid_tar t =
match Massoc_gid.add gid_tar g_edge t.next with
match Massoc_gid.add_opt gid_tar g_edge t.next with
| Some l -> Some {t with next = l}
| None -> None
......@@ -107,7 +107,10 @@ module G_node = struct
let fresh ?prec ?succ pos = { empty with position = Ordered pos; prec; succ }
let fresh_unordered () = { empty with position = Unordered (fresh_index ())}
let remove (id_tar : Gid.t) label t = {t with next = Massoc_gid.remove id_tar label t.next}
let remove_opt (id_tar : Gid.t) label t =
match Massoc_gid.remove_opt id_tar label t.next with
| Some new_next -> Some {t with next = new_next}
| None -> None
let remove_key node_id t =
try {t with next = Massoc_gid.remove_key node_id t.next} with Not_found -> t
......@@ -174,7 +177,7 @@ module P_node = struct
} )
let add_edge p_edge pid_tar t =
match Massoc_pid.add pid_tar p_edge t.next with
match Massoc_pid.add_opt pid_tar p_edge t.next with
| Some l -> Some {t with next = l}
| None -> None
......
......@@ -57,7 +57,7 @@ module G_node: sig
val string_efs: t -> string
val is_conll_root: t -> bool
val remove: Gid.t -> G_edge.t -> t -> t
val remove_opt: Gid.t -> G_edge.t -> t -> t option
val remove_key: Gid.t -> t -> t
......
......@@ -949,36 +949,46 @@ module Rule = struct
| 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
(
{instance with
Instance.graph = G_graph.del_edge ?domain loc instance.Instance.graph src_gid edge tar_gid;
history = List_.sort_insert (Command.H_DEL_EDGE_EXPL (src_gid,tar_gid,edge)) instance.Instance.history
},
created_nodes
(match G_graph.del_edge ?domain loc instance.Instance.graph src_gid edge tar_gid with
| None -> Error.run "DEL_EDGE_EXPL: the edge '%s' does not exist %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
| Some new_graph ->
(
{instance with
Instance.graph = new_graph;
history = List_.sort_insert (Command.H_DEL_EDGE_EXPL (src_gid,tar_gid,edge)) instance.Instance.history
},
created_nodes
)
)
| Command.DEL_EDGE_NAME edge_ident ->
let (src_gid,edge,tar_gid) =
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
(match G_graph.del_edge ?domain ~edge_ident loc instance.Instance.graph src_gid edge tar_gid with
| None -> Error.bug "DEL_EDGE_NAME"
| Some new_graph ->
(
{instance with
Instance.graph = G_graph.del_edge ?domain ~edge_ident loc instance.Instance.graph src_gid edge tar_gid;
Instance.graph = new_graph;
history = List_.sort_insert (Command.H_DEL_EDGE_EXPL (src_gid,tar_gid,edge)) instance.Instance.history
},
created_nodes
)
))
| Command.DEL_NODE node_cn ->
let node_gid = node_find node_cn in
(match G_graph.del_node instance.Instance.graph node_gid with
| None -> Error.run "DEL_NODE: the node does not exist %s" (Loc.to_string loc)
| Some new_graph ->
(
{instance with
Instance.graph = G_graph.del_node instance.Instance.graph node_gid;
Instance.graph = new_graph;
history = List_.sort_insert (Command.H_DEL_NODE node_gid) instance.Instance.history
},
created_nodes
)
)
| Command.UPDATE_FEAT (tar_cn,tar_feat_name, item_list) ->
let tar_gid = node_find tar_cn in
let rule_items = List.map
......
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