add a guard to each rule which is in the working set

core/grammar/ast.ml

@@ -164,7 +164,9 @@ type ('agent, 'agent_id, 'pattern, 'mixture, 'id, 'rule) instruction =
   | RULE of
       (string Loc.annoted option
       * string LKappa.guard option
-      * 'rule Loc.annoted)
+      * 'rule Loc.annoted
+      * bool)
+    (*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)
 
@@ -182,7 +184,7 @@ type ('agent, 'agent_sig, 'pattern, 'mixture, 'id, 'rule) compil = {
   rules:
     (string Loc.annoted option * string LKappa.guard option * 'rule Loc.annoted)
     list;
-      (** rules (possibly named, possibly with a guard): [name_option * rule_definition] *)
+      (** rules (possibly named, possibly with a guard): [name_option * guard * rule_definition] *)
   observables: ('pattern, 'id) Alg_expr.e Loc.annoted list;
       (** list of patterns to plot *)
   init: ('pattern, 'mixture, 'id) init_statement list;

core/grammar/ast.mli

@@ -143,7 +143,9 @@ type ('agent, 'agent_sig, 'pattern, 'mixture, 'id, 'rule) instruction =
   | RULE of
       (string Loc.annoted option
       * string LKappa.guard option
-      * 'rule Loc.annoted)
+      * 'rule Loc.annoted
+      * bool)
+    (*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)
 
@@ -160,7 +162,7 @@ type ('agent, 'agent_sig, 'pattern, 'mixture, 'id, 'rule) compil = {
   rules:
     (string Loc.annoted option * string LKappa.guard option * 'rule Loc.annoted)
     list;
-      (**rules (possibly named)*)
+      (** rules (possibly named, possibly with a guard)*)
   observables: ('pattern, 'id) Alg_expr.e Loc.annoted list;
       (** list of patterns to plot *)
   init: ('pattern, 'mixture, 'id) init_statement list;

core/grammar/cst.ml

@@ -6,41 +6,70 @@
 (* |_|\_\ * GNU Lesser General Public License Version 3                       *)
 (******************************************************************************)
 
+let add_working_set_guard guard k =
+  let guard_name = "@ws-rule-" ^ string_of_int k in
+  let guard_param = LKappa.Param guard_name in
+  match guard with
+  | None -> Some guard_param
+  | Some guard -> Some (LKappa.And (guard_param, guard))
+
 let append_to_ast_compil rev_instr compil =
-  List.fold_left
-    (fun r -> function
-      | Ast.RULE ru -> { r with Ast.rules = ru :: r.Ast.rules }
-      | Ast.SIG ag -> { r with Ast.signatures = ag :: r.Ast.signatures }
-      | Ast.TOKENSIG str_pos -> { r with Ast.tokens = str_pos :: r.Ast.tokens }
-      | Ast.VOLSIG (vol_type, vol, vol_param) ->
-        { r with Ast.volumes = (vol_type, vol, vol_param) :: r.Ast.volumes }
-      | Ast.INIT (alg, init_t) ->
-        { r with Ast.init = (alg, init_t) :: r.Ast.init }
-      | Ast.DECLARE var -> { r with Ast.variables = var :: r.Ast.variables }
-      | Ast.OBS (((lbl, pos), _) as var) ->
-        (*for backward compatibility, shortcut for %var + %plot*)
-        {
-          r with
-          Ast.variables = var :: r.Ast.variables;
-          Ast.observables = (Alg_expr.ALG_VAR lbl, pos) :: r.Ast.observables;
-        }
-      | Ast.PLOT expr -> { r with Ast.observables = expr :: r.Ast.observables }
-      | Ast.PERT ((alarm, pre, effect, opt), pos) ->
-        {
-          r with
-          Ast.perturbations =
-            ((alarm, pre, effect, opt), pos) :: r.Ast.perturbations;
-        }
-      | Ast.CONFIG (param_name, value_list) ->
-        {
-          r with
-          Ast.configurations = (param_name, value_list) :: r.Ast.configurations;
-        }
-      | Ast.GUARD_PARAM (params_sig, b) ->
-        {
-          r with
-          Ast.guard_param_values = (params_sig, b) :: r.Ast.guard_param_values;
-        }
-      | Ast.CONFLICT (agent, site1, site2) ->
-        { r with Ast.conflicts = (agent, site1, site2) :: r.Ast.conflicts })
-    compil (List.rev rev_instr)
+  fst
+  @@ List.fold_left
+       (fun (r, k) -> function
+         | Ast.RULE (label, guard, rule, is_in_working_set) ->
+           if is_in_working_set then
+             ( {
+                 r with
+                 Ast.rules =
+                   (label, add_working_set_guard guard k, rule) :: r.Ast.rules;
+               },
+               k + 1 )
+           else
+             { r with Ast.rules = (label, guard, rule) :: r.Ast.rules }, k
+         | Ast.SIG ag -> { r with Ast.signatures = ag :: r.Ast.signatures }, k
+         | Ast.TOKENSIG str_pos ->
+           { r with Ast.tokens = str_pos :: r.Ast.tokens }, k
+         | Ast.VOLSIG (vol_type, vol, vol_param) ->
+           ( { r with Ast.volumes = (vol_type, vol, vol_param) :: r.Ast.volumes },
+             k )
+         | Ast.INIT (alg, init_t) ->
+           { r with Ast.init = (alg, init_t) :: r.Ast.init }, k
+         | Ast.DECLARE var ->
+           { r with Ast.variables = var :: r.Ast.variables }, k
+         | Ast.OBS (((lbl, pos), _) as var) ->
+           (*for backward compatibility, shortcut for %var + %plot*)
+           ( {
+               r with
+               Ast.variables = var :: r.Ast.variables;
+               Ast.observables =
+                 (Alg_expr.ALG_VAR lbl, pos) :: r.Ast.observables;
+             },
+             k )
+         | Ast.PLOT expr ->
+           { r with Ast.observables = expr :: r.Ast.observables }, k
+         | Ast.PERT ((alarm, pre, effect, opt), pos) ->
+           ( {
+               r with
+               Ast.perturbations =
+                 ((alarm, pre, effect, opt), pos) :: r.Ast.perturbations;
+             },
+             k )
+         | Ast.CONFIG (param_name, value_list) ->
+           ( {
+               r with
+               Ast.configurations =
+                 (param_name, value_list) :: r.Ast.configurations;
+             },
+             k )
+         | Ast.GUARD_PARAM (params_sig, b) ->
+           ( {
+               r with
+               Ast.guard_param_values =
+                 (params_sig, b) :: r.Ast.guard_param_values;
+             },
+             k )
+         | Ast.CONFLICT (agent, site1, site2) ->
+           ( { r with Ast.conflicts = (agent, site1, site2) :: r.Ast.conflicts },
+             k ))
+       (compil, 0) (List.rev rev_instr)