Add macro for sequential binding of sites

core/KaSa_rep/frontend/prepreprocess.ml

@@ -739,42 +739,32 @@ let dump_rule_no_rate rule =
   let () = Format.pp_print_flush fmt () in
   Buffer.contents buf
 
-(**Find all agents where site1 appears as a non-bound site on the lhs and as a bound site on the rhs.*)
-let add_conflict_site_to_rule parameters error agent site1 site2 rule =
-  let there_is_a_potential_conflict site1 site2 interface1 interface2 =
-    let conflict_between_sites site1 site2 =
-      Ckappa_sig.has_free_site site1 interface1
-      && Ckappa_sig.has_bound_site site1 interface2
-      && (not (Ckappa_sig.has_site site2 interface1))
-      && not (Ckappa_sig.has_site site2 interface2)
-    in
-    conflict_between_sites site1 site2 || conflict_between_sites site2 site1
-  in
-  let add_conflict_site_to_agents error agent1 agent2 site1 site2 =
-    let new_port_name =
-      if Ckappa_sig.has_site site1 agent1.Ckappa_sig.ag_intf then
-        site2
-      else
-        site1
-    in
-    let new_port =
-      {
-        Ckappa_sig.port_name = new_port_name;
-        Ckappa_sig.port_link = Ckappa_sig.FREE;
-        Ckappa_sig.port_int = [];
-        Ckappa_sig.port_free = Some true;
-      }
-    in
-    let interface1 =
-      Ckappa_sig.PORT_SEP (new_port, agent1.Ckappa_sig.ag_intf)
-    in
-    let interface2 =
-      Ckappa_sig.PORT_SEP (new_port, agent2.Ckappa_sig.ag_intf)
-    in
-    ( error,
-      { agent1 with Ckappa_sig.ag_intf = interface1 },
-      { agent2 with Ckappa_sig.ag_intf = interface2 } )
+(*------------------------------------------------------------*)
+(*DUPLICATE RULES FOR POTENTAL CONFLICTS OR SEQUENTIAL BINDING**)
+
+let conflict_between_sites site1 site2 interface1 interface2 =
+  Ckappa_sig.has_free_site site1 interface1
+  && Ckappa_sig.has_bound_site site1 interface2
+  && (not (Ckappa_sig.has_site site2 interface1))
+  && not (Ckappa_sig.has_site site2 interface2)
+
+let add_conflict_site_to_agents new_port_name port_link error agent1 agent2 =
+  let new_port =
+    {
+      Ckappa_sig.port_name = new_port_name;
+      Ckappa_sig.port_link;
+      Ckappa_sig.port_int = [];
+      Ckappa_sig.port_free = Some true;
+    }
   in
+  let interface1 = Ckappa_sig.PORT_SEP (new_port, agent1.Ckappa_sig.ag_intf) in
+  let interface2 = Ckappa_sig.PORT_SEP (new_port, agent2.Ckappa_sig.ag_intf) in
+  ( error,
+    { agent1 with Ckappa_sig.ag_intf = interface1 },
+    { agent2 with Ckappa_sig.ag_intf = interface2 } )
+
+let traverse_rule_and_add_site parameters error lhs rhs agent
+    there_is_a_potential_conflict add_conflict_site =
   let rec aux lhs rhs =
     match lhs, rhs with
     | Ckappa_sig.SKIP lhs', Ckappa_sig.SKIP rhs'
@@ -797,10 +787,10 @@ let add_conflict_site_to_rule parameters error agent site1 site2 rule =
       let (error, agent1, agent2), was_changed =
         if
           agent = agent1.Ckappa_sig.agent_name
-          && there_is_a_potential_conflict site1 site2 agent1.Ckappa_sig.ag_intf
+          && there_is_a_potential_conflict agent1.Ckappa_sig.ag_intf
                agent2.Ckappa_sig.ag_intf
         then
-          add_conflict_site_to_agents error agent1 agent2 site1 site2, true
+          add_conflict_site error agent1 agent2, true
         else
           (error, agent1, agent2), was_changed
       in
@@ -818,16 +808,49 @@ let add_conflict_site_to_rule parameters error agent site1 site2 rule =
     | Ckappa_sig.EMPTY_MIX, _ ->
       Exception.warn parameters error __POS__ Exit (lhs, rhs, false)
   in
+  aux lhs rhs
+
+(**Find all agents where site1 appears as a non-bound site on the lhs and as a bound site on the rhs.*)
+let add_conflict_site_to_rule parameters error agent site1 site2 rule =
+  let there_is_a_potential_conflict interface1 interface2 =
+    conflict_between_sites site1 site2 interface1 interface2
+    || conflict_between_sites site2 site1 interface1 interface2
+  in
+  let add_conflict_site error agent1 agent2 =
+    let new_port_name =
+      if Ckappa_sig.has_site site1 agent1.Ckappa_sig.ag_intf then
+        site2
+      else
+        site1
+    in
+    add_conflict_site_to_agents new_port_name Ckappa_sig.FREE error agent1
+      agent2
+  in
   let error, (lhs, rhs, was_changed) =
-    aux rule.Ckappa_sig.lhs rule.Ckappa_sig.rhs
+    traverse_rule_and_add_site parameters error rule.Ckappa_sig.lhs
+      rule.Ckappa_sig.rhs agent there_is_a_potential_conflict add_conflict_site
+  in
+  error, { rule with Ckappa_sig.lhs; Ckappa_sig.rhs }, was_changed
+
+(**Find all agents where site2 appears as a non-bound site on the lhs and as a bound site on the rhs.
+Add site1 as a bound site.*)
+let add_sequential_site_to_rule parameters error agent site1 site2 rule =
+  let error, (lhs, rhs, was_changed) =
+    traverse_rule_and_add_site parameters error rule.Ckappa_sig.lhs
+      rule.Ckappa_sig.rhs agent
+      (conflict_between_sites site2 site1)
+      (add_conflict_site_to_agents site1 (Ckappa_sig.LNK_SOME Loc.dummy))
   in
   error, { rule with Ckappa_sig.lhs; Ckappa_sig.rhs }, was_changed
 
 let conflicts_guard_p_name agent site1 site2 =
   "@co-" ^ agent ^ "-" ^ site1 ^ "-" ^ site2
 
-let add_conflict_to_guard guard_opt agent site1 site2 negate loc =
-  let guardp = LKappa.Param (conflicts_guard_p_name agent site1 site2, loc) in
+let sequential_guard_p_name agent site1 site2 =
+  "@sq-" ^ agent ^ "-" ^ site1 ^ "-" ^ site2
+
+let add_param_to_guard guard_opt agent site1 site2 negate loc guard_p_name =
+  let guardp = LKappa.Param (guard_p_name agent site1 site2, loc) in
   let guardp =
     if negate then
       LKappa.Not guardp
@@ -855,22 +878,22 @@ let rename_rules rules =
             Some (rule_string ^ String.make i '\'', p), guard, rule)
         rules)
 
-let add_rules_with_conflicts parameters error (rule_string, guard, (rule, p))
-    conflicts =
-  let error, new_rules =
+let add_rules_with_conflicts_and_sequential parameters error
+    (rule_string, guard, (rule, p)) conflicts sequential_bonds =
+  let add_rules error add_site_to_rule guard_p_name inital_rules modifications =
     List.fold_left
       (fun (error, rules) ((agent, _), (site1, _), (site2, _)) ->
         List.fold_left
           (fun (error, rules) (id, guard, (rule, p)) ->
             let error, new_rule, was_changed =
-              add_conflict_site_to_rule parameters error agent site1 site2 rule
+              add_site_to_rule parameters error agent site1 site2 rule
             in
             if was_changed then (
               let guard_new_rule =
-                add_conflict_to_guard guard agent site1 site2 false p
+                add_param_to_guard guard agent site1 site2 false p guard_p_name
               in
               let guard_og_rule =
-                add_conflict_to_guard guard agent site1 site2 true p
+                add_param_to_guard guard agent site1 site2 true p guard_p_name
               in
               ( error,
                 (id, guard_og_rule, (rule, p))
@@ -879,10 +902,19 @@ let add_rules_with_conflicts parameters error (rule_string, guard, (rule, p))
             ) else
               error, (id, guard, (rule, p)) :: rules)
           (error, []) rules)
-      (error, [ rule_string, guard, (rule, p) ])
+      (error, inital_rules) modifications
+  in
+  let error, new_rules =
+    add_rules error add_conflict_site_to_rule conflicts_guard_p_name
+      [ rule_string, guard, (rule, p) ]
       conflicts
   in
+  let error, new_rules =
+    add_rules error add_sequential_site_to_rule sequential_guard_p_name
+      new_rules sequential_bonds
+  in
   error, rename_rules new_rules
+(*------------------------------------------------------------*)
 
 let translate_compil parameters error
     (compil :
@@ -1144,9 +1176,9 @@ let translate_compil parameters error
     List.fold_left
       (fun (error, list) (rule_string, guard, (rule, p)) ->
         let error, rules_with_conflicts =
-          add_rules_with_conflicts parameters error
+          add_rules_with_conflicts_and_sequential parameters error
             (rule_string, guard, (rule, p))
-            compil.Ast.conflicts
+            compil.Ast.conflicts compil.Ast.sequential_bonds
         in
         error, rules_with_conflicts @ list)
       (error, []) rules_rev
@@ -1165,4 +1197,5 @@ let translate_compil parameters error
       Ast.volumes = compil.Ast.volumes;
       Ast.guard_param_values = compil.Ast.guard_param_values;
       Ast.conflicts = compil.Ast.conflicts;
+      Ast.sequential_bonds = compil.Ast.sequential_bonds;
     } )

core/grammar/ast.ml

@@ -171,6 +171,8 @@ type ('agent, 'agent_id, 'pattern, 'mixture, 'id, 'rule) instruction =
     (*label, guard, rule, is_in_working_set*)
   | GUARD_PARAM of (string Loc.annoted * bool)
   | CONFLICT of (string Loc.annoted * string Loc.annoted * string Loc.annoted)
+  | SEQUENTIAL_BOND of
+      (string Loc.annoted * string Loc.annoted * string Loc.annoted)
 
 type ('pattern, 'mixture, 'id, 'rule) command =
   | RUN of ('pattern, 'id) Alg_expr.bool Loc.annoted
@@ -199,6 +201,8 @@ type ('agent, 'agent_sig, 'pattern, 'mixture, 'id, 'rule) compil = {
       (** The guard parameters that have a defined value (true or false).*)
   conflicts: ('id Loc.annoted * 'id Loc.annoted * 'id Loc.annoted) list;
       (** A conflict (A, s1, s2) states that there might be a conflict between the two sites s1, s2 of the agent A.*)
+  sequential_bonds: ('id Loc.annoted * 'id Loc.annoted * 'id Loc.annoted) list;
+      (** sequential_bonds (A, s1, s2) states that the site s2 of the agent A may only be able to bind if s1 is already bound.*)
 }
 
 type parsing_compil = (agent, agent_sig, mixture, mixture, string, rule) compil
@@ -242,6 +246,7 @@ let empty_compil =
     volumes = [];
     guard_param_values = Mods.StringMap.empty;
     conflicts = [];
+    sequential_bonds = [];
   }
 
 (*
@@ -1134,7 +1139,8 @@ let print_perturbation f ((alarm, cond, modif, rep), _) =
     rep
 
 let print_parsing_compil_kappa f c =
-  Format.fprintf f "@[<v>%a@,@,%a@,%a@,@,%a@,@,%a@,%a@,@,%a@,@,%a@,%a@,%a@,@]@."
+  Format.fprintf f
+    "@[<v>%a@,@,%a@,%a@,@,%a@,@,%a@,%a@,@,%a@,@,%a@,%a@,%a@,%a@,@]@."
     (Pp.list Pp.space print_configuration)
     c.configurations
     (Pp.list Pp.space (fun f a ->
@@ -1166,6 +1172,9 @@ let print_parsing_compil_kappa f c =
     (Pp.list Pp.space (fun f ((a, _), (s1, _), (s2, _)) ->
          Format.fprintf f "%%conflict: %s %s %s" a s1 s2))
     c.conflicts
+    (Pp.list Pp.space (fun f ((a, _), (s1, _), (s2, _)) ->
+         Format.fprintf f "%%sequential_bond: %s %s %s" a s1 s2))
+    c.sequential_bonds
 
 let arrow_notation_to_yojson filenames f_mix f_var r =
   JsonUtil.smart_assoc
@@ -1757,6 +1766,13 @@ let compil_to_json c =
              (Loc.string_annoted_to_json ~filenames)
              (Loc.string_annoted_to_json ~filenames))
           c.conflicts );
+      ( "sequential_bonds",
+        JsonUtil.of_list
+          (JsonUtil.of_triple
+             (Loc.string_annoted_to_json ~filenames)
+             (Loc.string_annoted_to_json ~filenames)
+             (Loc.string_annoted_to_json ~filenames))
+          c.sequential_bonds );
     ]
 
 let compil_of_json = function
@@ -1870,6 +1886,19 @@ let compil_of_json = function
                 (Loc.string_annoted_of_json ~filenames)
                 (Loc.string_annoted_of_json ~filenames))
              (List.assoc "conflicts" l);
+         sequential_bonds =
+           JsonUtil.to_list
+             ~error_msg:
+               (JsonUtil.exn_msg_cant_import_from_json
+                  "AST sequential_bonds sig")
+             (JsonUtil.to_triple
+                ~error_msg:
+                  (JsonUtil.exn_msg_cant_import_from_json
+                     "AST sequential_bonds sig")
+                (Loc.string_annoted_of_json ~filenames)
+                (Loc.string_annoted_of_json ~filenames)
+                (Loc.string_annoted_of_json ~filenames))
+             (List.assoc "sequential_bonds" l);
        }
      with Not_found ->
        raise (Yojson.Basic.Util.Type_error ("Incorrect AST", x)))

core/grammar/ast.mli

@@ -150,6 +150,8 @@ type ('agent, 'agent_sig, 'pattern, 'mixture, 'id, 'rule) instruction =
     (*label, guard, rule, is_in_working_set*)
   | GUARD_PARAM of (string Loc.annoted * bool)
   | CONFLICT of (string Loc.annoted * string Loc.annoted * string Loc.annoted)
+  | SEQUENTIAL_BOND of
+      (string Loc.annoted * string Loc.annoted * string Loc.annoted)
 
 type ('pattern, 'mixture, 'id, 'rule) command =
   | RUN of ('pattern, 'id) Alg_expr.bool Loc.annoted
@@ -175,6 +177,7 @@ type ('agent, 'agent_sig, 'pattern, 'mixture, 'id, 'rule) compil = {
   volumes: (string * float * string) list;
   guard_param_values: bool Mods.StringMap.t;
   conflicts: ('id Loc.annoted * 'id Loc.annoted * 'id Loc.annoted) list;
+  sequential_bonds: ('id Loc.annoted * 'id Loc.annoted * 'id Loc.annoted) list;
 }
 
 type parsing_compil = (agent, agent_sig, mixture, mixture, string, rule) compil

core/grammar/cst.ml

@@ -78,5 +78,12 @@ let append_to_ast_compil rev_instr compil =
              k )
          | Ast.CONFLICT (agent, site1, site2) ->
            ( { r with Ast.conflicts = (agent, site1, site2) :: r.Ast.conflicts },
+             k )
+         | Ast.SEQUENTIAL_BOND (agent, site1, site2) ->
+           ( {
+               r with
+               Ast.sequential_bonds =
+                 (agent, site1, site2) :: r.Ast.sequential_bonds;
+             },
              k ))
        (compil, 0) (List.rev rev_instr)

core/grammar/kappaParser.mly

@@ -103,6 +103,9 @@ start_rule:
           | Ast.CONFLICT (a,s1,s2) ->
           {r with
 			  Ast.conflicts = (a,s1,s2)::r.Ast.conflicts}
+          | Ast.SEQUENTIAL_BOND (a,s1,s2) ->
+          {r with
+			  Ast.sequential_bonds = (a,s1,s2)::r.Ast.sequential_bonds}
 		  }
     | error
 	{raise (ExceptionDefn.Syntax_Error (add_pos "Syntax error"))}

core/grammar/klexer4.mll

@@ -93,6 +93,7 @@ rule token = parse
     | "guard_param" -> GUARD_PARAM
     | "working_set" -> WORKING_SET
     | "conflict" -> CONFLICT
+    | "sequential_bond" -> SEQUENTIAL_BOND
     | _ as s -> raise (ExceptionDefn.Syntax_Error
       ("Unknown directive: "^s,
        Loc.of_pos (Lexing.lexeme_start_p lexbuf)

core/grammar/kparser4.mly

@@ -28,6 +28,7 @@
 %token COLON NEWLINE BACKSLASH SIGNATURE TOKEN INIT OBS PLOT PERT CONFIG APPLY
 %token DELETE INTRO SNAPSHOT STOP FLUX TRACK ASSIGN PRINTF PLOTENTRY SPECIES_OF
 %token DO REPEAT ALARM RUN LET GUARD_PARAM SHARP_OP_BRA IF CONFLICT WORKING_SET
+%token SEQUENTIAL_BOND
 %token <int> INT
 %token <float> FLOAT
 %token <string> ID LABEL STRING
@@ -845,6 +846,7 @@ an algebraic expression is expected")) }
     { add (Ast.CONFIG (($3,rhs_pos 3),$5)) }
   | GUARD_PARAM annoted ID annoted boolean annoted { add (Ast.GUARD_PARAM (($3,rhs_pos 3), $5)) }
   | CONFLICT annoted ID annoted ID annoted ID annoted { add (Ast.CONFLICT (($3,rhs_pos 3), ($5,rhs_pos 5), ($7,rhs_pos 7))) }
+  | SEQUENTIAL_BOND annoted ID annoted ID annoted ID annoted { add (Ast.SEQUENTIAL_BOND (($3,rhs_pos 3), ($5,rhs_pos 5), ($7,rhs_pos 7))) }
   ;
 
 model_body:

core/grammar/lKappa_compiler.ml

@@ -2780,6 +2780,9 @@ let compil_of_ast ~warning ~debug_mode ~syntax_version ~var_overwrite ast_compil
   in
 
   let conflicts = conflicts_to_id agents_sig ast_compil.conflicts in
+  let sequential_bonds =
+    conflicts_to_id agents_sig ast_compil.sequential_bonds
+  in
 
   let init =
     init_of_ast ~warning ~syntax_version agents_sig counters_info contact_map
@@ -2807,5 +2810,6 @@ let compil_of_ast ~warning ~debug_mode ~syntax_version ~var_overwrite ast_compil
         configurations = ast_compil.configurations;
         guard_param_values = ast_compil.guard_param_values;
         conflicts;
+        sequential_bonds;
       };
   }