safe_commands

src/grew_base.ml

@@ -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

src/grew_base.mli

@@ -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

src/grew_graph.ml

@@ -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)
 
   (* -------------------------------------------------------------------------------- *)

src/grew_graph.mli

@@ -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 *)

src/grew_node.ml

@@ -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 }

src/grew_node.mli

@@ -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