diff --git a/lib/algo/algo.ml b/lib/algo/algo.ml
index 406fcdc0990da5d0a2376bbb41291b66661d1bb4..7a1f9a13a011da08a884cee4a1f5057173f88a5a 100644
--- a/lib/algo/algo.ml
+++ b/lib/algo/algo.ml
@@ -1,4 +1,4 @@
-(* 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
diff --git a/lib/algo/algo.mli b/lib/algo/algo.mli
index b4c01f3b54c59bdb0795914c62ef3d8b5d6f2ef1..282c8ebb1ab5caeb0838119228b1f5c4e7fdd86c 100644
--- a/lib/algo/algo.mli
+++ b/lib/algo/algo.mli
@@ -1,4 +1,4 @@
-(* 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. *)
diff --git a/lib/sasa/sasaRun.ml b/lib/sasa/sasaRun.ml
index a106cb3ce18360fea845330c056824da9974e163..1fd939eef44182dcd67151bdceaf0650bfda0208 100644
--- a/lib/sasa/sasaRun.ml
+++ b/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
diff --git a/lib/sasacore/evil.ml b/lib/sasacore/evil.ml
index c570ee600a03d9abaabaca08f0cdb72b7ab4f09e..18862ace79a7b390de15c366357feb5ac7d6befd 100644
--- a/lib/sasacore/evil.ml
+++ b/lib/sasacore/evil.ml
@@ -1,4 +1,4 @@
-(* 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
diff --git a/lib/sasacore/register.ml b/lib/sasacore/register.ml
index a1e7fc810dca8e994d7f332a15b4df8465af739a..350e829acf2b44d5a4990cd7e501764fd5c40032 100644
--- a/lib/sasacore/register.ml
+++ b/lib/sasacore/register.ml
@@ -1,4 +1,4 @@
-(* 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
diff --git a/lib/sasacore/register.mli b/lib/sasacore/register.mli
index 55242e758b4f3e10b8b7780c51eae7c8b66395db..2b93b06b5d586d9f7b44af524fe3dba32e678a3c 100644
--- a/lib/sasacore/register.mli
+++ b/lib/sasacore/register.mli
@@ -1,4 +1,4 @@
-(* 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
diff --git a/test/coloring/config.ml b/test/coloring/config.ml
index c02877c9151272f5c89fef682cb7c2a68f627d3a..186c7a4b9d4913901cab23099450b04f304e1671 100644
--- a/test/coloring/config.ml
+++ b/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
diff --git a/test/coloring/p.ml b/test/coloring/p.ml
index e1b52c24fa93237e540e7c4937264df83751c92a..650ae823952ff7b97eb3b778d4ddea0214a17733 100644
--- a/test/coloring/p.ml
+++ b/test/coloring/p.ml
@@ -1,4 +1,4 @@
-(* 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 *)
diff --git a/test/coloring/state.ml b/test/coloring/state.ml
index 73b47fe7fe29c83f04cb4789e0cc2edfffd737eb..3a603c02fcdac6a078c1c8dc14764550c2b4f6e9 100644
--- a/test/coloring/state.ml
+++ b/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
-