Update: change the type of the potential function to something that makes more sense.

lib/algo/algo.ml

-(* Time-stamp: <modified the 24/08/2020 (at 15:36) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/09/2020 (at 10:30) by Erwan Jahier> *)
 
 open Sasacore
 (* Process programmer API *)
@@ -45,8 +45,7 @@ type 's state_init_fun = int -> string -> 's
 type 's fault_fun = int -> string -> 's -> 's
 type 's legitimate_fun = pid list -> (pid -> 's * 's neighbor list) -> bool
 
-type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action option }
-type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
+type 's potential_fun = pid list -> (pid -> 's * 's neighbor list) -> float
 
 type 's algo_to_register = {
   algo_id: string;
@@ -75,15 +74,9 @@ let (to_reg_neigbor : 's Register.neighbor -> 's neighbor) =
       weight = n.Register.weight; 
     } 
 
-let (to_reg_info : 's Register.pf_info -> 's pf_info) =
-  fun pfi ->
-  {
-    neighbors = List.map to_reg_neigbor pfi.Register.neighbors ;
-    curr = pfi.Register.curr ;
-    next = pfi.Register.next ;
-    action = pfi.Register.action 
-  }
-
+let (to_reg_info : 's * 's Register.neighbor list -> 's * 's neighbor list) =
+  fun (s, nl) ->
+  s, List.map to_reg_neigbor nl
   
 let (to_reg_enable_fun : 's enable_fun ->
      's Register.neighbor list -> 's -> action list) =
@@ -96,7 +89,7 @@ let (to_reg_step_fun : 's step_fun ->
     f s (List.map to_reg_neigbor nl) a
   
 let (to_reg_potential_fun :
-       's potential_fun -> pid list -> (pid -> 's Register.pf_info) -> float) =
+       's potential_fun -> pid list -> (pid -> 's * 's Register.neighbor list) -> float) =
   fun pf pidl f ->
   let nf pid = to_reg_info (f pid) in
   pf pidl nf

lib/algo/algo.mli

-(* Time-stamp: <modified the 02/09/2020 (at 10:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/09/2020 (at 10:27) by Erwan Jahier> *)
 (** {1 The Algorithm programming Interface.} *)
 (** 
     {1 What's need to be provided by users.}
@@ -81,30 +81,23 @@ val get_graph_attribute : string -> string
 
 (** {1 Potential function } 
 
-Useful to explore best/worst case daemons
- *)
+    Let the user define what the potential of a configuration is.
+    Used to explore best/worst case daemons (--worst-daemon)
+*)
 type pid = string
-type 's pf_info = {
-    neighbors: 's neighbor list;
-    curr: 's; (* the current state *)
-    next: 's; (* the state we would reach if action is activated (<> None) *)
-    action: action option (* None if the pid has not been activated *)
-  }
-type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
-(** The first input is the  *)
-
+type 's potential_fun = pid list -> (pid -> 's * 's neighbor list) -> 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.  *)
+   of this type are used to redefine what's a legitimate 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
+   each  time  a legitimate  configuration  is  reached.  It  takes  3
    arguments: the number of node neighbors,  the pid, and the value of
    the current state.  *)
                       

lib/sasa/sasaRun.ml

@@ -38,24 +38,17 @@ let (get_sl_out: bool -> 'v Process.t list -> bool list list -> RdbgPlugin.sl) =
         pl ll
     )
 
-type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
-
-let (compute_potentiel: 'v pna list ->  ('v Process.t * 'v Register.neighbor list) list ->
-     'v Env.t -> 'v Env.t -> RdbgPlugin.sl) =
-  fun pnal p_nl_l e ne ->
+let (compute_potentiel: ('v Process.t * 'v Register.neighbor list) list ->
+     'v Env.t -> RdbgPlugin.sl) =
+  fun p_nl_l ne ->
   match Register.get_potential () with
   | None -> []
   | Some user_pf ->
     let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
-    let p_a_l =  List.map (fun (p,_,a) -> p.Process.pid, a) pnal in
     let get_info pid =
-      {
-        Register.neighbors = snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l);
-        Register.curr = Env.get e pid ;
-        Register.next = Env.get ne pid ;
-        Register.action = List.assoc_opt pid p_a_l
-      }
-    in
+      Env.get ne pid,
+      snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l)
+    in 
     let p = (user_pf pidl get_info) in
     [("potential", Data.F p)]
      
@@ -91,7 +84,7 @@ let (make_do: string array -> SasArg.t ->
           (* 1: Get enable processes *)
           let pnall, enab_ll = Sasacore.Main.get_enable_processes p_nl_l e in
           let sasa_nenv = from_sasa_env p_nl_l e in 
-          let pot_sl = compute_potentiel (List.hd pnall) p_nl_l e e in
+          let pot_sl = compute_potentiel p_nl_l e in
           pre_enable_processes_opt := Some(pnall, enab_ll);
           sasa_nenv @ (get_sl_out true pl enab_ll) @ pot_sl
         )
@@ -107,7 +100,7 @@ let (make_do: string array -> SasArg.t ->
         (* 1': Get enable processes *)
         let new_p_nl_l = List.map (fun (p,nl) -> p, List.map (Sasacore.Main.update_neighbor_env ne) nl ) p_nl_l in
         let pnall, enab_ll = Sasacore.Main.get_enable_processes p_nl_l ne in
-        let pot_sl = compute_potentiel pnal new_p_nl_l e ne in
+        let pot_sl = compute_potentiel new_p_nl_l ne in
         pre_enable_processes_opt := Some(pnall, enab_ll);
         sasa_env := ne;    
         sasa_nenv @ (get_sl_out true pl enab_ll) @ pot_sl
@@ -125,7 +118,7 @@ let (make_do: string array -> SasArg.t ->
       in
       (* 3: Do the steps *)
       let ne = Sasacore.Step.f pnal e in
-      let pot_sl = compute_potentiel pnal p_nl_l e ne in
+      let pot_sl = compute_potentiel p_nl_l ne in
       sasa_env := ne;
       (from_sasa_env p_nl_l e) @ (get_sl_out true pl enab_ll) @
       (get_sl_out false pl activate_val) @ pot_sl

lib/sasacore/evil.ml

-(* Time-stamp: <modified the 27/08/2020 (at 18:06) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/09/2020 (at 10:33) by Erwan Jahier> *)
 
 
 
@@ -111,15 +111,10 @@ let (worst: 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list ->
   | Some user_pf ->
     let pf pnal = (* pnal contains a list of activated processes *)
       let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
-      let p_a_l =  List.map (fun (p,_,a) -> p.Process.pid, a) pnal in
       let ne = Step.f pnal e in
       let get_info pid =
-        {
-          Register.neighbors = snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l);
-          Register.curr = Env.get e pid ;
-          Register.next = Env.get ne pid ;
-          Register.action = List.assoc_opt pid p_a_l
-        }
+        Env.get ne pid,
+        snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l)
       in
       user_pf pidl get_info
     in

lib/sasacore/register.ml

-(* Time-stamp: <modified the 24/08/2020 (at 15:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/09/2020 (at 10:31) by Erwan Jahier> *)
 
 type 's neighbor = {
   state:  's ;
@@ -14,8 +14,7 @@ type 's enable_fun = 's neighbor list -> 's -> action list
 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 option }
-type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
+type 's potential_fun = pid list -> (pid -> 's * 's neighbor list) -> float
 type 's fault_fun = int -> string -> 's -> 's
 type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
 

lib/sasacore/register.mli

-(* Time-stamp: <modified the 24/08/2020 (at 15:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/09/2020 (at 10:32) by Erwan Jahier> *)
 
 (**  This module  duplicates and  extends the  Algo module  with get_*
    functions.
@@ -23,8 +23,7 @@ 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 option }
-type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
+type 's potential_fun = pid list -> (pid -> 's * 's neighbor list) -> float
 type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
 
 val reg_init_state : algo_id -> (int -> string -> 's) -> unit

test/coloring/config.ml

@@ -5,9 +5,9 @@
 open Algo
 let pf pidl get =
   let clash = ref 0 in
-  let color pid = (get pid).next in
+  let color pid = fst (get pid) in
   List.iter (fun pid ->
-      List.iter (fun n -> if state n = color pid then incr clash) ((get pid).neighbors))
+      List.iter (fun n -> if state n = color pid then incr clash) (snd (get pid)))
     pidl;
   float_of_int !clash
 

test/coloring/p.ml

-(* Time-stamp: <modified the 24/08/2020 (at 14:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/09/2020 (at 10:37) by Erwan Jahier> *)
 (* This is algo 3.1 in the book *)
 
 open Algo
@@ -32,5 +32,4 @@ let (enable_f: 'v -> 'v neighbor list -> action list) =
   
 let (step_f : 'v -> 'v neighbor list -> action -> 'v) =
   fun _ nl _ ->
-  incr State.x; 
   List.hd (free nl) (* Returns the smallest possible color *)

test/coloring/state.ml

@@ -9,16 +9,4 @@ let copy = fun x -> x
 let actions = ["conflict"]
 
 
-open Algo
-let pf pidl get =
-  let clash = ref 0 in
-  let color pid = (get pid).next in
-  List.iter (fun pid ->
-      List.iter (fun n -> if state n = color pid then incr clash) ((get pid).neighbors))
-    pidl;
-  float_of_int !clash
-
-let x = ref 0
-let incre _ _ = float_of_int !x
-