New: allow the sasa rdbg plugin to use its internal demons

Save/restore the PRGS at checkpoints (necessary for internal demons).

lib/sasacore/demon.ml

-(* Time-stamp: <modified the 03/04/2019 (at 21:33) by Erwan Jahier> *)
+(* Time-stamp: <modified the 14/05/2019 (at 10:18) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -13,18 +13,21 @@ let (random_list : 'a list -> 'a) = fun l ->
 
 let (random1: 'a list list -> 'a list) =
   fun all -> 
-   let al = List.map random_list all in
-   let a = random_list al in
-   [a]
+    if all = [] then [] else
+      let al = List.map random_list all in
+      let a = random_list al in
+      [a]
 
 let rec (random: 'a list list -> 'a list) =
   fun all ->
-    (*     assert (all <> []); *)
-    let al = List.map random_list all in
-    let al = List.filter (fun _ -> Random.bool ()) al in
-    if al = [] then random all else al
+    if all = [] then [] else
+      (*     assert (all <> []); *)
+      let al = List.map random_list all in
+      let al = List.filter (fun _ -> Random.bool ()) al in
+      if al = [] then random all else al
    
-let (synchrone: 'a list list -> 'a list) = fun all -> 
+let (synchrone: 'a list list -> 'a list) = fun all ->
+  if all = [] then [] else
   let al = List.map random_list all in
   al
 
@@ -38,19 +41,18 @@ let rec map3 f l1 l2 l3 =
   
 type pna = Process.t * Algo.neighbor list * Algo.action
 
-let (custom: bool -> pna list list -> Process.t list -> bool list list
-     -> string * pna list) =
-  fun verbose_mode pnall pl enab_ll -> 
+let (custom: pna list list -> Process.t list -> bool list list ->
+     (string -> string -> bool) -> bool list list * pna list) =
+  fun pnall pl enab_ll get_action_value -> 
     let f p pnal enab_l =
       let actions = p.Process.actions in
-      let trigger_l = List.map (fun a -> RifRead.bool verbose_mode p a) actions in
+      let trigger_l = List.map (get_action_value p.Process.pid) actions in
       let acti_l_al =
         map3
           (fun trig enab a ->
              let acti = trig && enab in
-             acti, if acti then
-               let pna = List.find (fun (_,_,a') -> a=a') pnal in 
-               [pna]
+             acti, if acti
+             then List.filter (fun (_,_,a') -> a=a') pnal 
              else []
           ) trigger_l enab_l actions
       in
@@ -58,25 +60,37 @@ let (custom: bool -> pna list list -> Process.t list -> bool list list
     in    
     let acti_l_all = map3 f pl pnall enab_ll in
     let acti_l_al = List.flatten acti_l_all in
-    let acti_l,al = List.split acti_l_al in
-    let acti = String.concat " " (List.map (fun b -> if b then "t" else "f") acti_l) in
+    let al = snd (List.split acti_l_al) in
+    let acti = List.map (List.map fst) acti_l_all in
     acti, List.flatten al
 
 let (remove_empty_list: 'a list list -> 'a list list) =
   fun ll ->
     List.filter (fun l -> l<>[]) ll
-      
+
+let (get_activate_val: pna list -> Process.t list -> bool list list)=
+  fun al pl ->
+    let actions =
+      List.map (fun p -> List.map (fun a -> p,a) p.Process.actions) pl
+    in
+    let al = List.map (fun (p,_,a) -> p,a) al in
+    List.map  (List.map (fun a -> List.mem a al)) actions 
+
+
 let (f: bool -> bool -> t -> Process.t list -> pna list list -> bool list list ->
-     string * pna list) =
-  fun dummy_input verbose_mode demon pl all enab ->
+     (string -> string -> bool) -> bool list list * pna list) =
+  fun dummy_input verbose_mode demon pl all enab get_action_value ->
     if demon <> Custom && dummy_input then
-      ignore (RifRead.bool verbose_mode (List.hd pl) "");
+      ignore (RifRead.bool verbose_mode ((List.hd pl).pid) "");
     match demon with
-    | Synchronous  -> "", synchrone (remove_empty_list all)
-    | Central -> "", random1 (remove_empty_list all)
+    | Synchronous  ->
+      let al = synchrone (remove_empty_list all) in
+      get_activate_val al pl, al
+    | Central ->
+      let al = random1 (remove_empty_list all) in
+      get_activate_val al pl, al
     | LocallyCentral -> assert false
-    | Distributed -> "", random (remove_empty_list all)
-    | Custom -> custom verbose_mode all pl enab
-
-
-
+    | Distributed ->
+      let al = random (remove_empty_list all) in
+      get_activate_val al pl, al
+    | Custom -> custom all pl enab get_action_value

lib/sasacore/demon.mli

-(* Time-stamp: <modified the 02/04/2019 (at 14:03) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/05/2019 (at 17:08) by Erwan Jahier> *)
 
 type t =
   | Synchronous (* select all actions *) 
@@ -37,5 +37,5 @@ nb: it is possible that we read on stdin that an action should be
 *)
 
 val f : bool -> bool -> t -> Process.t list -> pna list list -> bool list list ->
-  string * pna list
+  (string -> string -> bool) -> bool list list * pna list
 

lib/sasacore/rifRead.ml

-(* Time-stamp: <modified the 28/03/2019 (at 16:29) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/05/2019 (at 10:16) by Erwan Jahier> *)
 
 (* xxx use RifIO.read instead ! *)
-let bool verbose_mode p a =
+let bool verbose_mode pname a =
   if verbose_mode then ( 
-    Printf.eprintf "Enter a bool [1,t,T|0,f,F] for process %s\n" p.Process.pid;
+    Printf.eprintf "Enter a bool [1,t,T|0,f,F] for process %s\n" pname;
     flush stderr
   );
   let x = input_char stdin in
@@ -25,7 +25,7 @@ let bool verbose_mode p a =
   let res = aux x in
   if verbose_mode then (
     flush stderr;
-    Printf.eprintf "%s_%s<-%s\n" p.Process.pid a (if res then "t" else "f");
+    Printf.eprintf "%s_%s<-%s\n" pname a (if res then "t" else "f");
     flush stderr
   );
     res

lib/sasacore/rifRead.mli

-(* Time-stamp: <modified the 13/03/2019 (at 17:45) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/05/2019 (at 10:17) by Erwan Jahier> *)
 
 (** Reads on stdin a bool *)
 
-val bool: bool -> Process.t -> string -> bool
+val bool: bool -> string -> string -> bool

lib/sasacore/sasa.ml

-(* Time-stamp: <modified the 09/05/2019 (at 21:59) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/05/2019 (at 15:03) by Erwan Jahier> *)
 
 open Algo
 open Sasacore
@@ -119,8 +119,8 @@ let (get_inputs_rif_decl: SasArg.t -> Process.t list -> (string * string) list)
       in
       List.flatten (List.map f pl)
 
-let (get_outputs_rif_decl: Process.t list -> (string * string) list) =
-  fun pl -> 
+let (get_outputs_rif_decl: SasArg.t -> Process.t list -> (string * string) list) =
+  fun args pl -> 
     let lll = List.map 
         (fun p ->
            List.map
@@ -130,17 +130,24 @@ let (get_outputs_rif_decl: Process.t list -> (string * string) list) =
         pl
     in
     let algo_vars = List.flatten (List.flatten lll) in 
-    let action_vars = List.flatten
+    let action_vars_enab = List.flatten
         (List.map 
            (fun p -> List.map
                (fun a -> (Printf.sprintf "Enab_%s_%s" p.pid a),"bool") p.actions)
            pl)
     in
-    algo_vars @ action_vars
+    let action_vars = if args.demon = Custom then [] else
+        List.flatten
+          (List.map 
+             (fun p -> List.map
+                 (fun a -> (Printf.sprintf "%s_%s" p.pid a),"bool") p.actions)
+             pl)
+    in
+    algo_vars @ action_vars_enab @ action_vars
     
-let (env_rif_decl: Process.t list -> string) =
-  fun pl ->
-    let ssl = get_outputs_rif_decl pl in
+let (env_rif_decl: SasArg.t -> Process.t list -> string) =
+  fun args pl ->
+    let ssl = get_outputs_rif_decl args pl in
     String.concat " "
       (List.map (fun (base, tstr) -> Printf.sprintf "\"%s\":%s" base tstr) ssl)
     
@@ -217,7 +224,7 @@ let (make : bool -> string array -> t) =
              (List.map
                 (fun (vn,vt) -> Printf.sprintf "\"%s\":%s" vn vt) inputs_decl));
 
-        Printf.printf "#outputs %s\n" (env_rif_decl pl);
+        Printf.printf "#outputs %s\n" (env_rif_decl args pl);
         flush stdout
       ) else (
         if args.demon <> Demon.Custom then (
@@ -229,7 +236,7 @@ let (make : bool -> string array -> t) =
       if args.ifi then (
         List.iter
           (fun p -> List.iter
-              (fun a -> ignore (RifRead.bool (args.verbose > 1) p a)) p.actions)
+              (fun a -> ignore (RifRead.bool (args.verbose>1) p.pid a)) p.actions)
           pl;
         Printf.eprintf "Ignoring the first vectors of sasa inputs\n";
         flush stderr;

lib/sasacore/sasa.mli

-(* Time-stamp: <modified the 30/04/2019 (at 16:02) by Erwan Jahier> *)
+(* Time-stamp: <modified the 13/05/2019 (at 15:03) by Erwan Jahier> *)
 
 
 (* XXX find a better name *)
@@ -15,5 +15,5 @@ val get_enable_processes: layout -> Env.t -> enable_processes
   
 val do_step : (Process.t * Algo.neighbor list * Algo.action) list -> Env.t -> Env.t
 
-val get_inputs_rif_decl: SasArg.t -> Process.t list -> (string * string) list
-val get_outputs_rif_decl: Process.t list -> (string * string) list
+val get_inputs_rif_decl : SasArg.t -> Process.t list -> (string * string) list
+val get_outputs_rif_decl: SasArg.t -> Process.t list -> (string * string) list

lib/sasalib/sasaRun.ml

@@ -63,24 +63,18 @@ let (from_sasa_env : Sasa.layout -> Env.t -> RdbgPlugin.sl) =
     let sl = List.flatten sll in
     List.map (fun (vn,value) -> vn, of_sasa_value value) sl
 
-let (get_sl_out: Process.t list -> bool list list -> RdbgPlugin.sl) =
-  fun pl enab_ll -> List.flatten (
+let (get_sl_out: bool -> Process.t list -> bool list list -> RdbgPlugin.sl) =
+  fun enab pl ll ->
+    let str = if enab then "Enab_" else "" in
+    List.flatten (
       List.map2 (fun p enab_l ->
           List.map2 (fun a enab ->
-              Printf.sprintf "Enab_%s_%s" p.pid a, Data.B enab)
+              Printf.sprintf "%s%s_%s" str p.pid a, Data.B enab)
             p.actions enab_l)
-        pl enab_ll
+        pl ll
     )
 
-let rec map3 f l1 l2 l3 =
-  match (l1, l2, l3) with
-    ([], [], []) -> []
-  | (a1::l1, a2::l2, a3::l3) -> let r = f a1 a2 a3 in r :: map3 f l1 l2 l3
-  | ([], _, _) -> invalid_arg "map3 (1st arg too short)"
-  | (_, [], _) -> invalid_arg "map3 (2nd arg too short)"
-  | (_, _, []) -> invalid_arg "map3 (3rd arg too short)"
-
-      (* let (bool: Algo.value -> bool) = function B b -> b | _ -> assert false *)
+(* let (bool: Algo.value -> bool) = function B b -> b | _ -> assert false *)
 
 let (make_do: string array -> SasArg.t ->
      (Process.t * Algo.neighbor list) list -> Env.t -> RdbgPlugin.t) =
@@ -95,13 +89,13 @@ let (make_do: string array -> SasArg.t ->
     in
     let vntl_o =
       List.map (fun (vn,vt) -> vn, Data.type_of_string vt)
-        (Sasa.get_outputs_rif_decl pl)
+        (Sasa.get_outputs_rif_decl args pl)
     in
     let pre_enable_processes_opt = ref None in
     let sasa_env = ref e in
     let reset () =
-       pre_enable_processes_opt := None;
-       sasa_env := e
+      pre_enable_processes_opt := None;
+      sasa_env := e
     in
     (*  Do the same job as SasaMain.simustep *)
     let (step: RdbgPlugin.sl -> RdbgPlugin.sl) =
@@ -113,43 +107,42 @@ let (make_do: string array -> SasArg.t ->
           let pnall, enab_ll = Sasa.get_enable_processes pl_n e in
           let sasa_nenv = from_sasa_env pl_n e in 
           pre_enable_processes_opt := Some(pnall, enab_ll);
-          sasa_nenv @ (get_sl_out pl enab_ll)
-
-        | Some (pre_pnall, pre_enab_ll) -> 
+          sasa_nenv @ (get_sl_out true pl enab_ll) 
+        | Some (pre_pnall, pre_enab_ll) ->
           (* 2: read the actions from the outside process, i.e., from sl_in *)
-          let pnal =
-            (* do the same job as Demon.custom: i.e., it should look into sl_in
-               to choose the actions to trigger *)
-            let f p pnal enab_l =
-              let actions = p.Process.actions in
-              let trigger_l = List.map (get_action_value sl_in p.pid) actions in
-              let acti_l_al =
-                map3
-                  (fun trig enab a ->
-                     let acti = trig && enab in
-                     acti, if acti then
-                       let pna = List.find (fun (_,_,a') -> a=a') pnal in 
-                       [pna]
-                     else []
-                  ) trigger_l enab_l actions
-              in
-              acti_l_al
-            in    
-            let acti_l_all = map3 f pl pre_pnall pre_enab_ll in
-            let acti_l_al = List.flatten acti_l_all in
-            let _acti_l,al = List.split acti_l_al in
-            List.flatten al
+          let _, pnal = Demon.f args.dummy_input
+              (args.verbose > 1) args.demon pl pre_pnall pre_enab_ll
+              (get_action_value sl_in)
           in
           (* 3: Do the steps *)
           let ne = Sasa.do_step pnal e in
-          let sasa_nenv = from_sasa_env pl_n ne in 
+          let sasa_nenv = from_sasa_env pl_n ne in
           (* 1': Get enable processes *)
           let pnall, enab_ll = Sasa.get_enable_processes pl_n ne in
           pre_enable_processes_opt := Some(pnall, enab_ll);
           sasa_env := ne;
-          sasa_nenv @ (get_sl_out pl enab_ll)
-
+          sasa_nenv @ (get_sl_out true pl enab_ll) 
+    in
+    let (step_internal_demon: RdbgPlugin.sl -> RdbgPlugin.sl) =
+      fun sl_in ->
+        (* in this mode, sasa does not play first *)
+        let e = !sasa_env in
+        (* 1: Get enable processes *)
+        let pnall, enab_ll = Sasa.get_enable_processes pl_n e in
+        (* 2: read the actions from the outside process, i.e., from sl_in *)
+        let activate_val, pnal = Demon.f args.dummy_input
+            (args.verbose > 1) args.demon pl pnall enab_ll
+            (get_action_value sl_in)
+        in
+        (* 3: Do the steps *)
+        let ne = Sasa.do_step pnal e in
+        let sasa_nenv = from_sasa_env pl_n ne in
+        sasa_env := ne;
+        sasa_nenv @ (get_sl_out true pl enab_ll) @
+        (get_sl_out false pl activate_val) 
     in
+    let step = if args.demon = Demon.Custom then step else step_internal_demon in
+    let ss_table = Hashtbl.create 10 in
     let step_dbg sl_in ctx cont = cont (step sl_in) ctx in
 (*
    this event is useless actually; the same information is available at Rtop
@@ -186,8 +179,20 @@ let (make_do: string array -> SasArg.t ->
       init_outputs=mems_out;
       step=step;     
       step_dbg = step_dbg;
-      save_state = (fun _i -> ());
-      restore_state = (fun _i -> ());
+      save_state = (fun i ->
+          let prgs = Random.get_state () in
+          Hashtbl.replace ss_table i
+            (prgs, !sasa_env, !pre_enable_processes_opt)
+        );
+      restore_state = (fun i ->
+          match Hashtbl.find_opt ss_table i with
+          | Some (prgs, e, pepo) ->
+            Random.set_state prgs;
+            sasa_env := e; pre_enable_processes_opt := pepo
+          | None ->
+            Printf.eprintf "Cannot restore state %i from sasa\n" i;
+            flush stderr 
+        );
     }
 
 

src/sasaMain.ml

@@ -15,12 +15,14 @@ let (print_step : int -> int -> SasArg.t -> Env.t -> Process.t list -> string ->
            printed on stdout
         *)
         Printf.eprintf "\n#step %s\n" (string_of_int (n-i+1)) ;
-        Printf.eprintf "%s #outs " activate_val; flush stderr
+        Printf.eprintf "%s #outs " activate_val; flush stderr;
+        Printf.printf "%s %s\n" (StringOf.env_rif e pl) enable_val;
       ) else (
+        (* rif mode, internal demons *)
         Printf.printf "\n#step %s\n" (string_of_int (n-i+1)) ;
-        Printf.printf "%s #outs " activate_val; flush stdout
+        Printf.printf " #outs %s %s %s\n"
+          (StringOf.env_rif e pl) enable_val activate_val
       );
-      Printf.printf "%s %s\n" (StringOf.env_rif e pl) enable_val;
       flush stderr;
       flush stdout
     )
@@ -37,19 +39,32 @@ let (simustep: int -> int -> SasArg.t -> string ->
   fun n i args activate_val pl_n e ->
     (* 1: Get enable processes *)
     let all, enab_ll = get_enable_processes pl_n e in
-    let pl = fst(List.split pl_n) in
-    
-    if not (args.rif) && List.for_all (fun b -> not b) (List.flatten enab_ll) then (
+    let pl = fst(List.split pl_n) in    
+    if
+      (*  not (args.rif) && *)
+      List.for_all (fun b -> not b) (List.flatten enab_ll)
+    then (
       print_step n i args e pl activate_val enab_ll;
       raise (Silent (n-i+1))
     ) else 
+    if args.demon = Demon.Custom then
       print_step n i args e pl activate_val enab_ll;
     (* 2: read the actions *)
-    let next_activate_val, pnal =
-      Demon.f args.dummy_input (args.verbose > 1) args.demon pl all enab_ll
+    let get_action_value = RifRead.bool (args.verbose > 1) in
+    let next_activate_val, pnal = Demon.f args.dummy_input
+        (args.verbose > 1) args.demon pl all enab_ll get_action_value 
+    in
+    let next_activate_val =
+      String.concat " " 
+        (List.map
+           (fun b -> if b then "t" else "f")
+           (List.flatten next_activate_val)
+        )
     in
     (* 3: Do the steps *)
     let ne = do_step pnal e in
+    if args.demon <> Demon.Custom then
+      print_step n i args e pl next_activate_val enab_ll;
     ne, next_activate_val
 
 
@@ -73,8 +88,6 @@ let () =
   | Silent i ->
     let str = if args.rif then "#" else "" in
     Printf.eprintf "\n%sThis algo is silent after %i steps\n" str i ;
+    print_string "\nq\n"; 
     flush stderr;
-    flush stdout;
-    if args.rif then (
-      print_string "#q\n"; flush stdout
-    )
+    flush stdout