Commit 1d57deed authored by Bruno Guillaume's avatar Bruno Guillaume

safe_commands

parent 1bd378e0
......@@ -442,8 +442,6 @@ module type S = sig
exception Not_disjoint
val disjoint_union: 'a t -> 'a t -> 'a t
exception Duplicate
val merge_key: key -> key -> 'a t -> 'a t
val exists: (key -> 'a -> bool) -> 'a t -> bool
......@@ -523,17 +521,6 @@ module Massoc_make (Ord: OrderedType) = struct
| List_.Not_disjoint -> raise Not_disjoint
) t1 t2
exception Duplicate
let merge_key i j t =
try
let old_i = M.find i t in
let old_j = try M.find j t with Not_found -> [] in
M.add j (List_.sort_disjoint_union old_i old_j) (M.remove i t)
with
| Not_found -> (* no key i *) t
| List_.Not_disjoint -> raise Duplicate
exception True
let exists fct t =
try
......@@ -631,5 +618,5 @@ module Global = struct
| (fo, Some l) -> current_loc := (fo, Some (l+1))
let debug = ref false
let strict = ref false
let safe_commands = ref false
end
......@@ -225,9 +225,6 @@ module type S =
exception Not_disjoint
val disjoint_union: 'a t -> 'a t -> 'a t
exception Duplicate
val merge_key: key -> key -> 'a t -> 'a t
val exists: (key -> 'a -> bool) -> 'a t -> bool
val rename: (key * key) list -> 'a t -> 'a t
......@@ -294,5 +291,5 @@ module Global: sig
val label_flag: bool ref
val debug: bool ref
val strict: bool ref
val safe_commands: bool ref
end
......@@ -560,7 +560,7 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *)
(* move out-edges (which respect cst [labels,neg]) from id_src are moved to out-edges out off node id_tar *)
let shift_out loc strict src_gid tar_gid is_gid_local label_cst graph =
let shift_out loc src_gid tar_gid is_gid_local label_cst graph =
let domain = get_domain graph in
let del_edges = ref [] and add_edges = ref [] in
......@@ -576,7 +576,7 @@ module G_graph = struct
if Label_cst.match_ ?domain label_cst edge && not (is_gid_local next_gid)
then
match Massoc_gid.add_opt next_gid edge acc_tar_next with
| None when strict -> Error.run ~loc "The [shift_out] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string ?domain edge)
| None when !Global.safe_commands -> Error.run ~loc "The [shift_out] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string ?domain edge)
| None ->
del_edges := (src_gid,edge,next_gid) :: !del_edges;
(Massoc_gid.remove next_gid edge acc_src_next, acc_tar_next)
......@@ -597,7 +597,7 @@ module G_graph = struct
)
(* -------------------------------------------------------------------------------- *)
let shift_in loc strict src_gid tar_gid is_gid_local label_cst graph =
let shift_in loc src_gid tar_gid is_gid_local label_cst graph =
let domain = get_domain graph in
let del_edges = ref [] and add_edges = ref [] in
let new_map =
......@@ -617,7 +617,7 @@ module G_graph = struct
if Label_cst.match_ ?domain label_cst edge
then
match List_.usort_insert edge acc_node_tar_edges with
| None when strict ->
| None when !Global.safe_commands ->
Error.run ~loc "The [shift_in] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string ?domain edge)
| None ->
del_edges := (node_id,edge,src_gid) :: !del_edges;
......@@ -641,9 +641,9 @@ module G_graph = struct
)
(* -------------------------------------------------------------------------------- *)
let shift_edges loc strict src_gid tar_gid is_gid_local label_cst graph =
let (g1,de1,ae1) = shift_out loc strict src_gid tar_gid is_gid_local label_cst graph in
let (g2,de2,ae2) = shift_in loc strict src_gid tar_gid is_gid_local label_cst g1 in
let shift_edges loc src_gid tar_gid is_gid_local label_cst graph =
let (g1,de1,ae1) = shift_out loc src_gid tar_gid is_gid_local label_cst graph in
let (g2,de2,ae2) = shift_in loc src_gid tar_gid is_gid_local label_cst g1 in
(g2, de1 @ de2, ae1 @ ae2)
(* -------------------------------------------------------------------------------- *)
......
......@@ -136,7 +136,6 @@ module G_graph: sig
(** shift all crown-edges ending in [src_gid] to edges ending in [tar_gid] *)
val shift_in:
Loc.t -> (* localization of the command *)
bool -> (* true iff strict rewriting *)
Gid.t -> (* [src_gid] the source gid of the "shift_in" *)
Gid.t -> (* [tar_gid] the target gid of the "shift_in" *)
(Gid.t -> bool) -> (* a locality test: true iff the node is a pattern node *)
......@@ -150,7 +149,6 @@ module G_graph: sig
(** shift all crown-edges starting from [src_gid] to edges starting from [tar_gid] *)
val shift_out:
Loc.t -> (* localization of the command *)
bool -> (* true iff strict rewriting *)
Gid.t -> (* [src_gid] the source gid of the "shift_out" *)
Gid.t -> (* [tar_gid] the target gid of the "shift_out" *)
(Gid.t -> bool) -> (* a locality test: true iff the node is a pattern node *)
......@@ -164,7 +162,6 @@ module G_graph: sig
(** move all incident crown-edges from/to [src_gid] are moved to incident edges on node [tar_gid] from graph *)
val shift_edges:
Loc.t -> (* localization of the command *)
bool -> (* true iff strict rewriting *)
Gid.t -> (* [src_gid] the source gid of the "shift_edges" *)
Gid.t -> (* [tar_gid] the target gid of the "shift_edges" *)
(Gid.t -> bool) -> (* a locality test: true iff the node is a pattern node *)
......
......@@ -115,14 +115,6 @@ module G_node = struct
let remove_key node_id t =
try {t with next = Massoc_gid.remove_key node_id t.next} with Not_found -> t
let merge_key ?(strict=false) src_id tar_id t =
try Some {t with next = Massoc_gid.merge_key src_id tar_id t.next}
with Massoc_gid.Duplicate -> if strict then None else Some t
let shift_out ?(strict=false) src_t tar_t =
try Some {tar_t with next = Massoc_gid.disjoint_union src_t.next tar_t.next}
with Massoc_gid.Not_disjoint -> if strict then None else Some tar_t
let rm_out_edges t = {t with next = Massoc_gid.empty}
(* let build_neighbour t = { empty with position = (get_position t) +. 0.01 }
......
......@@ -61,8 +61,6 @@ module G_node: sig
val remove_key: Gid.t -> t -> t
val merge_key: ?strict:bool -> Gid.t -> Gid.t -> t -> t option
val shift_out: ?strict:bool -> t -> t -> t option
val rm_out_edges: t -> t
......
This diff is collapsed.
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