API change: change the API of potential and legitimate functions

and attach  the pid to  the list of neighbors  of returned by  the get
function. Indeed, this is needed in some anomymous (or semi-anonymous)
algorithms, such as the k-clustering.

lib/algo/algo.ml

-(* Time-stamp: <modified the 02/09/2020 (at 10:30) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/10/2020 (at 15:55) by Erwan Jahier> *)
 
 open Sasacore
 (* Process programmer API *)
@@ -43,9 +43,9 @@ 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 = pid list -> (pid -> 's * 's neighbor list) -> bool
+type 's legitimate_fun = pid list -> (pid -> 's *  ('s neighbor * pid) list) -> bool
 
-type 's potential_fun = pid list -> (pid -> 's * 's neighbor list) -> float
+type 's potential_fun = pid list -> (pid -> 's *  ('s neighbor * pid) list) -> float
 
 type 's algo_to_register = {
   algo_id: string;
@@ -72,11 +72,11 @@ let (to_reg_neigbor : 's Register.neighbor -> 's neighbor) =
       spid = n.Register.spid;
       reply = n.Register.reply; 
       weight = n.Register.weight; 
-    } 
+    }
 
-let (to_reg_info : 's * 's Register.neighbor list -> 's * 's neighbor list) =
+let (to_reg_info : 's * ('s Register.neighbor * pid) list -> 's * ('s neighbor *pid) list) =
   fun (s, nl) ->
-  s, List.map to_reg_neigbor nl
+  s, List.map (fun (n,pid) -> to_reg_neigbor n, pid) nl
   
 let (to_reg_enable_fun : 's enable_fun ->
      's Register.neighbor list -> 's -> action list) =
@@ -89,17 +89,17 @@ 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 * 's Register.neighbor list) -> float) =
+       's potential_fun -> pid list -> (pid -> 's * ('s Register.neighbor * pid) list) -> float) =
   fun pf pidl f ->
   let nf pid = to_reg_info (f pid) in
   pf pidl nf
 
 let (to_reg_legitimate_fun :
-       's legitimate_fun -> pid list -> (pid -> 's * 's Register.neighbor list) -> bool) =
+       's legitimate_fun -> pid list -> (pid -> 's * ('s Register.neighbor * pid) list) -> bool) =
   fun lf pidl from_pid ->
   let n_from_pid pid =
     let s, nl = from_pid pid in
-    s, List.map to_reg_neigbor nl
+    s, List.map (fun (n,pid) -> to_reg_neigbor n, pid) nl
   in
     lf pidl n_from_pid
   

lib/algo/algo.mli

-(* Time-stamp: <modified the 16/09/2020 (at 15:42) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/10/2020 (at 15:30) by Erwan Jahier> *)
 (** {1 The Algorithm programming Interface} 
 
     A SASA process is an instance of an algorithm defined via this
@@ -53,12 +53,12 @@ type 's state_init_fun = int -> string -> 's
 *)
   
 type pid = string
-type 's potential_fun = pid list -> (pid -> 's * 's neighbor list) -> float
+type 's potential_fun = pid list -> (pid -> 's * ('s neighbor * pid) list) -> float
 
 
 (** {3 Legitimate Configurations} *)
   
-type 's legitimate_fun = pid list -> (pid -> 's * 's neighbor list) -> bool
+type 's legitimate_fun = pid list -> (pid -> 's * ('s neighbor * pid) 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 legitimate configuration

lib/sasa/sasaRun.ml

@@ -45,8 +45,9 @@ let (compute_potentiel: ('v Process.t * 'v Register.neighbor list) list ->
   | Some user_pf ->
     let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
     let get_info pid =
+      let nl = snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l) in
       Env.get ne pid,
-      snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l)
+      List.map (fun n -> n, n.Register.pid) nl
     in 
     let p = (user_pf pidl get_info) in
     [("potential", Data.F p)]

lib/sasacore/evil.ml

-(* Time-stamp: <modified the 28/09/2020 (at 11:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/10/2020 (at 16:06) by Erwan Jahier> *)
 
 type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
 
@@ -129,8 +129,9 @@ let (worst: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list
       let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
       let ne = Step.f pnal e in
       let get_info pid =
+        let nl = snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l) in
         Env.get ne pid,
-        snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l)
+        List.map (fun n -> n, n.Register.pid) nl
       in
       user_pf pidl get_info
     in
@@ -170,8 +171,9 @@ let (worst_central: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor lis
       let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
       let ne = Step.f [pna] e in
       let get_info pid =
+        let nl = snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l) in
         Env.get ne pid,
-        snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l)
+        List.map (fun n -> n, n.Register.pid) nl
       in
       user_pf pidl get_info
     in

lib/sasacore/register.ml

-(* Time-stamp: <modified the 02/09/2020 (at 10:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/10/2020 (at 15:37) by Erwan Jahier> *)
 
 type 's neighbor = {
   state:  's ;
@@ -14,9 +14,9 @@ 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 potential_fun = pid list -> (pid -> 's * 's neighbor list) -> float
+type 's potential_fun = pid list -> (pid -> 's * ('s neighbor * pid) list) -> float
 type 's fault_fun = int -> string -> 's -> 's
-type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
+type 's legitimate_fun = string list -> (string -> 's * ('s neighbor * pid) list) -> bool
 
 type 's internal_tables = {
   init_state: (string, Obj.t) Hashtbl.t;

lib/sasacore/register.mli

-(* Time-stamp: <modified the 02/09/2020 (at 10:32) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/10/2020 (at 15:36) by Erwan Jahier> *)
 
 (**  This module  duplicates and  extends the  Algo module  with get_*
    functions.
@@ -23,8 +23,8 @@ type 's step_fun   = 's neighbor list -> 's -> action -> 's
 type 's fault_fun = int -> string -> 's -> 's
 
 type pid = string
-type 's potential_fun = pid list -> (pid -> 's * 's neighbor list) -> float
-type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
+type 's potential_fun = pid list -> (pid -> 's * ('s neighbor * pid) list) -> float
+type 's legitimate_fun = string list -> (string -> 's * ('s neighbor * pid) list) -> bool
 
 val reg_init_state : algo_id -> (int -> string -> 's) -> unit
 val reg_enable : algo_id -> 's enable_fun -> unit

src/sasaMain.ml

@@ -62,8 +62,10 @@ let legitimate p_nl_l e =
        | [] -> assert false (* sno *)
        | (p,nl)::tail ->
          if p.Process.pid = pid then
+           let nl = List.map (Sasacore.Main.update_neighbor_env e) nl in
+           let nl = List.map (fun n -> n,n.Register.pid) nl in
            Env.get e pid,
-           List.map (Sasacore.Main.update_neighbor_env e) nl
+           nl 
          else
            from_pid tail pid
      in

test/coloring/config.ml

@@ -5,7 +5,7 @@ let clash_number pidl get =
   let clash = ref 0 in
   let color pid = fst (get pid) in
   List.iter (fun pid ->
-      List.iter (fun n -> if state n = color pid then incr clash) (snd (get pid)))
+      List.iter (fun (n,_) -> if state n = color pid then incr clash) (snd (get pid)))
     pidl;
   float_of_int !clash
 

test/dijkstra-ring/config.ml

@@ -10,6 +10,7 @@ let (legitimate: t Algo.legitimate_fun) =
   (* only one node is enabled *)
   let incr_token i pid =
     let s, nl = get pid in
+    let nl = List.map fst nl in
     let have_token = (if s.root then Root.enable_f s nl else P.enable_f s nl) <> [] in
     if have_token then i+1 else i
   in