Fix: the potential computed in SasaRun was wrong (and not done at the first step with -custd)

lib/algo/algo.ml

-(* Time-stamp: <modified the 08/07/2020 (at 15:49) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:36) by Erwan Jahier> *)
 
 open Sasacore
 (* Process programmer API *)

lib/algo/algo.mli

-(* Time-stamp: <modified the 21/08/2020 (at 16:11) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:56) by Erwan Jahier> *)
 (** {1 The Algorithm programming Interface.} *)
 (** 
     {1 What's need to be provided by users.}
@@ -86,8 +86,8 @@ Useful to explore best/worst case daemons
 type pid = string
 type 's pf_info = {
     neighbors: 's neighbor list;
-    curr: 's ; (* the current state *)
-    next: 's; (* the state we want to compute the potential of *)
+    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

lib/sasa/sasaRun.ml

@@ -40,15 +40,14 @@ let (get_sl_out: bool -> 'v Process.t list -> bool list list -> RdbgPlugin.sl) =
 
 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 -> RdbgPlugin.sl) =
-  fun pnal p_nl_l e ->
+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 ->
   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 ne = Step.f pnal e in
     let get_info pid =
       {
         Register.neighbors = snd (List.find (fun (p,_) -> p.Process.pid = pid) p_nl_l);
@@ -88,12 +87,14 @@ let (make_do: string array -> SasArg.t ->
     fun sl_in ->
       let e = !sasa_env in
       match !pre_enable_processes_opt with
-      | None  -> (* the first step *)
-        (* 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 
-        pre_enable_processes_opt := Some(pnall, enab_ll);
-        sasa_nenv @ (get_sl_out true pl enab_ll)
+      | None  -> ( (* the first step *)
+          (* 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
+          pre_enable_processes_opt := Some(pnall, enab_ll);
+          sasa_nenv @ (get_sl_out true pl enab_ll) @ pot_sl
+        )
       | Some (pre_pnall, pre_enab_ll) ->
         (* 2: read the actions from the outside process, i.e., from sl_in *)
         let _, pnal = Daemon.f args.dummy_input
@@ -105,7 +106,7 @@ let (make_do: string array -> SasArg.t ->
         let sasa_nenv = from_sasa_env p_nl_l ne in
         (* 1': Get enable processes *)
         let pnall, enab_ll = Sasacore.Main.get_enable_processes p_nl_l ne in
-        let pot_sl = compute_potentiel pnal p_nl_l ne in
+        let pot_sl = compute_potentiel pnal p_nl_l e ne in
         pre_enable_processes_opt := Some(pnall, enab_ll);
         sasa_env := ne;    
         sasa_nenv @ (get_sl_out true pl enab_ll) @ pot_sl
@@ -123,7 +124,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 ne in
+      let pot_sl = compute_potentiel pnal p_nl_l e 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 17/07/2020 (at 09:27) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:39) by Erwan Jahier> *)
 
 
 

lib/sasacore/register.ml

-(* Time-stamp: <modified the 08/07/2020 (at 16:13) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:39) by Erwan Jahier> *)
 
 type 's neighbor = {
   state:  's ;

lib/sasacore/register.mli

-(* Time-stamp: <modified the 08/07/2020 (at 16:13) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 15:39) by Erwan Jahier> *)
 
 (**  This module  duplicates and  extends the  Algo module  with get_*
    functions.

test/coloring/p.ml

-(* Time-stamp: <modified the 22/04/2020 (at 10:24) by Erwan Jahier> *)
+(* Time-stamp: <modified the 24/08/2020 (at 14:31) by Erwan Jahier> *)
 (* This is algo 3.1 in the book *)
 
 open Algo
@@ -31,5 +31,6 @@ let (enable_f: 'v -> 'v neighbor list -> action list) =
   if List.exists (fun n -> state n = c) nl then ["conflict"] else []
   
 let (step_f : 'v -> 'v neighbor list -> action -> 'v) =
-  fun _ nl _ -> 
+  fun _ nl _ ->
+  incr State.x; 
   List.hd (free nl) (* Returns the smallest possible color *)

test/coloring/state.ml

@@ -13,10 +13,13 @@ 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)
+      List.iter (fun n -> if state n = color pid then incr clash) ((get pid).neighbors))
       pidl;
   float_of_int !clash
 
-let potential = Some pf
+let x = ref 0
+let incre _ _ = float_of_int !x
+
+let potential = Some incre
 let legitimate = None
 let fault = None