New: add a ligitimate function in the Algo api

Update: add the previous state in argument of the fault function.

lib/algo/algo.ml

-(* Time-stamp: <modified the 06/07/2020 (at 17:03) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/07/2020 (at 14:41) by Erwan Jahier> *)
 
 open Sasacore
 (* Process programmer API *)
@@ -40,6 +40,8 @@ let (weight : 's neighbor -> int) = fun s -> s.weight ()
 type 's enable_fun = 's -> 's neighbor list -> action list
 type 's step_fun   = 's -> 's neighbor list -> action -> 's
 type 's state_init_fun = int -> string -> 's
+type 's fault_fun = int -> string -> 's -> 's
+type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
 
 type pid = string
 type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
@@ -58,7 +60,8 @@ type 's to_register = {
   copy_state: 's -> 's;
   actions: action list;
   potential_function: 's potential_fun option;
-  fault_function : 's state_init_fun option 
+  legitimate_function : 's legitimate_fun option; 
+  fault_function : 's fault_fun option 
 }
 
 let (to_reg_neigbor : 's Register.neighbor -> 's neighbor) =

lib/algo/algo.mli

-(* Time-stamp: <modified the 06/07/2020 (at 17:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/07/2020 (at 14:41) by Erwan Jahier> *)
 (** {1 The Algorithm programming Interface.} *)
 (** 
     {1 What's need to be provided by users.}
@@ -81,11 +81,25 @@ val get_graph_attribute : string -> string
 
 (** {1 Potential function } 
 
-useful to explore best/worst case daemons
+Useful to explore best/worst case daemons
  *)
 type pid = string
 type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
 type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
+
+(** {1 Legitimate Configurations}  *)
+type 's legitimate_fun = pid list -> (pid -> 's * 's neighbor list) -> bool
+(** By  default, legitimate  configurations (i.e., global  states) are
+   silent ones.  But  this is not true for  all algorithms.  Predicates
+   of this type are used to redefine what's a legimimate configuration
+   is.  *)
+                      
+(** {1 Fault Injection}  *)
+type 's fault_fun = int -> string -> 's -> 's
+(** The  fault function is called  on each node to  update their state
+   each  time  a legimimate  configuration  is  reached.  It  takes  3
+   arguments: the number of node neighbors,  the pid, and the value of
+   the current state.  *)
                       
 (** {1 Code Registration}
 
@@ -105,7 +119,8 @@ type 's to_register = {
     copy_state: 's -> 's;
     actions   : action list (** Mandatory in custom daemon mode, or to use oracles *);
     potential_function: 's potential_fun option (** Mandatory with Evil daemons *);
-    fault_function : 's state_init_fun option (** used when a legitimate configuration is reached *)
+    legitimate_function : 's legitimate_fun option; 
+    fault_function : 's fault_fun option (** called at legitimate configuration *)
   }
 (** -  For the [state_to_string] field,  the idea is to  print the raw
    values contained in ['s].  If a  value is omitted, one won't see it

lib/sasacore/genRegister.ml

@@ -49,11 +49,12 @@ let (f: string list -> string * string -> unit) =
     copy_state = %s.copy;
     actions = %s.actions;
     potential_function = %s.potential;
+    legitimate_function = %s.legitimate;
     fault_function = %s.fault;
   }
 "
         (String.concat ";" l) 
-        state_module state_module state_module state_module state_module state_module;
+        state_module state_module state_module state_module state_module state_module state_module;
       flush oc;
       close_out oc;
       Printf.eprintf " [sasa] The file %s has been generated\n" register_file;
@@ -70,6 +71,7 @@ let to_string _ = \"define_me\"
 let of_string = None
 let copy x = x
 let potential = None
+let legitimate = None
 let fault = None
 ";
       flush oc;

lib/sasacore/register.ml

-(* Time-stamp: <modified the 06/07/2020 (at 17:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/07/2020 (at 14:46) by Erwan Jahier> *)
 
 type 's neighbor = {
   state:  's ;
@@ -16,6 +16,8 @@ type 's step_fun   = 's neighbor list -> 's -> action -> 's
 type pid = string
 type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
 type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
+type 's fault_fun = int -> string -> 's -> 's
+type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
 
 type 's internal_tables = {
   init_state: (string, Obj.t) Hashtbl.t;
@@ -26,6 +28,7 @@ type 's internal_tables = {
   copy_value  : (string, Obj.t) Hashtbl.t;
   graph_attributes  : (string, string) Hashtbl.t;
   mutable potential:  Obj.t;
+  mutable legitimate:  Obj.t;
   mutable fault:  Obj.t;
   mutable actions:action list;
   mutable card : int ;
@@ -62,6 +65,7 @@ let (tbls:'s internal_tables) = {
   copy_value   = Hashtbl.create 1;
   graph_attributes = Hashtbl.create 1;
   potential = (Obj.repr None);
+  legitimate = (Obj.repr None);
   fault = (Obj.repr None);
   actions   = [];
   card         = (-1);
@@ -135,13 +139,20 @@ let (reg_potential : 's potential_fun option -> unit) = fun x ->
 let (get_potential : unit -> 's potential_fun option) = fun () -> 
   Obj.obj tbls.potential
   
-let (reg_fault : (int -> string -> 's) option -> unit) = fun x -> 
+let (reg_fault : 's fault_fun option -> unit) = fun x -> 
   if !verbose_level > 0 then Printf.eprintf "Registering fault function\n%!";
   tbls.fault <- (Obj.repr x)
   
-let (get_fault : unit -> (int -> string -> 's) option) = fun () -> 
+let (get_fault : unit -> 's fault_fun option) = fun () -> 
   Obj.obj tbls.fault
+
+let (reg_legitimate : 's legitimate_fun option -> unit) = fun x -> 
+  if !verbose_level > 0 then Printf.eprintf "Registering legitimate function\n%!";
+  tbls.legitimate <- (Obj.repr x)
   
+let (get_legitimate : unit -> 's legitimate_fun option) = fun () -> 
+  Obj.obj tbls.legitimate
+
 let (reg_actions : action list -> unit) =
   fun x -> 
   if !verbose_level > 0 then Printf.eprintf "Registering actions\n%!";

lib/sasacore/register.mli

-(* Time-stamp: <modified the 06/07/2020 (at 17:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/07/2020 (at 14:47) by Erwan Jahier> *)
 
 (**  This module  duplicates and  extends the  Algo module  with get_*
    functions.
@@ -20,16 +20,19 @@ type algo_id = string
 type action  = string 
 type 's enable_fun = 's neighbor list -> 's -> action list
 type 's step_fun   = 's neighbor list -> 's -> action -> 's
+type 's fault_fun = int -> string -> 's -> 's
 
 type pid = string
 type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
 type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
+type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
 
 val reg_init_state : algo_id -> (int -> string -> 's) -> unit
 val reg_enable : algo_id -> 's enable_fun -> unit
 val reg_step : algo_id -> 's step_fun -> unit
 val reg_potential : 's potential_fun option -> unit
-val reg_fault : (int -> string -> 's) option -> unit
+val reg_legitimate : 's legitimate_fun option -> unit
+val reg_fault : 's fault_fun option -> unit
 val reg_actions : action list -> unit
 val reg_value_to_string : ('s -> string) -> unit
 val reg_value_of_string : (string -> 's) -> unit
@@ -64,7 +67,8 @@ val get_step   : algo_id -> 's step_fun
 val get_init_state : algo_id -> int -> string -> 's
 val get_actions   : unit -> action list
 val get_potential   : unit -> 's potential_fun option
-val get_fault   : unit -> (int -> string -> 's) option
+val get_legitimate   : unit -> 's legitimate_fun option
+val get_fault   : unit -> 's fault_fun option
 val get_value_to_string : unit -> 's -> string
 val get_value_of_string : unit -> (string -> 's) option
 val get_copy_value : unit -> ('s -> 's)

test/alea-coloring-alt/state.ml

@@ -5,4 +5,5 @@ let of_string = None
 let copy = fun x -> x
 let actions = ["C1";"C2"]
 let potential = None
+let legitimate = None
 let fault = None 

test/alea-coloring-unif/state.ml

@@ -5,4 +5,5 @@ let of_string = Some int_of_string
 let copy x = x
 let actions = ["a"]
 let potential = None
+let legitimate = None
 let fault = None 

test/alea-coloring/state.ml

@@ -8,6 +8,7 @@ let of_string = Some int_of_string
 let copy = fun x -> x
 let actions = ["conflict"]
 let potential = None
+let legitimate = None
 let fault = None 
 
 

test/async-unison/state.ml

@@ -5,4 +5,5 @@ let of_string = Some int_of_string
 let copy x = x
 let actions = ["I(p)"; "R(p)"]
 let potential = None
+let legitimate = None
 let fault = None 

test/bfs-spanning-tree/state.ml

@@ -18,4 +18,5 @@ let (copy : ('v -> 'v)) = fun x -> x
 
 let actions = ["CD";"CP"]
 let potential = None
+let legitimate = None
 let fault = None 

test/bfs-st-HC92/state.ml

@@ -19,4 +19,5 @@ let print_neighbor =
 
 let actions = ["R0";"R1"]
 let potential = None
+let legitimate = None
 let fault = None 

test/coloring/state.ml

@@ -18,4 +18,5 @@ let pf pidl get =
   float_of_int !clash
 
 let potential = Some pf
+let legitimate = None
 let fault = None 

test/dfs-list/state.ml

@@ -21,4 +21,5 @@ let of_string = None
 let copy x = x
 let actions = ["update_path";"compute_parent"]
 let potential = None
+let legitimate = None
 let fault = None 

test/dfs/state.ml

@@ -28,4 +28,5 @@ let (copy : t -> t) =
 let of_string = None
 let actions = ["update_path";"compute_parent"]
 let potential = None
+let legitimate = None
 let fault = None 

test/dijkstra-ring/state.ml

@@ -5,4 +5,5 @@ let of_string = None
 let copy x = x
 let actions = ["T"]
 let potential = None
+let legitimate = None
 let fault = None 

test/skeleton/state.ml

@@ -5,4 +5,5 @@ let of_string = Some int_of_string
 let copy x = x
 let actions = ["action1";"action2"]
 let potential = None
+let legitimate = None
 let fault = None 

test/st-CYH91/state.ml

@@ -19,4 +19,5 @@ let print_neighbor =
 
 let actions = ["R0";"R1";"R2"]
 let potential = None
+let legitimate = None
 let fault = None 

test/st-KK06-algo1/state.ml

@@ -5,4 +5,5 @@ let of_string = Some int_of_string
 let copy x = x
 let actions = ["R"]
 let potential = None
+let legitimate = None
 let fault = None 

test/st-KK06-algo2/state.ml

@@ -5,4 +5,5 @@ let of_string = Some int_of_string
 let copy x = x
 let actions = ["R";"R1"]
 let potential = None
+let legitimate = None
 let fault = None 

test/unison/state.ml

@@ -5,4 +5,5 @@ let of_string = None
 let copy x = x
 let actions = ["g"]
 let potential = None
+let legitimate = None
 let fault = None