Commit 82e12726 authored by erwan's avatar erwan
Browse files

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

Save/restore the PRGS at checkpoints (necessary for internal demons).
parent c2b91e54
(* 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
(* 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
(* 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
(* 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
(* 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;
......
(* 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
......@@ -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
);
}
......
......@@ -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
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment