diff --git a/lib/sasa/sasaRun.ml b/lib/sasa/sasaRun.ml index 441686aa8cb5aa1c329b3203e850527258b2701c..6b1b1b45dd950d950d274bdf11042256783f5549 100644 --- a/lib/sasa/sasaRun.ml +++ b/lib/sasa/sasaRun.ml @@ -19,7 +19,7 @@ let (from_sasa_env : 'v SimuState.t -> RdbgPlugin.sl) = fun st -> List.fold_left (fun acc p -> - let state = Env.get st.config p.pid in + let state = Conf.get st.config p.pid in let sl = SasaState.to_rdbg_subst p.pid state in acc@sl ) @@ -37,15 +37,12 @@ let (get_sl_out: bool -> 'v Process.t list -> bool list list -> RdbgPlugin.sl) = pl ll ) +open SimuState + module StringMap = Map.Make(String) let (compute_potentiel: 'v SimuState.t -> RdbgPlugin.sl) = fun st -> - match Register.get_potential () with - | None -> [] - | Some user_pf -> - let pidl = List.map (fun p -> p.Process.pid) st.network in - let p = user_pf pidl (SimuState.neigbors_of_pid st) in - [("potential", Data.F p)] + [("potential", Data.F (SimuState.compute_potentiel st))] let (compute_legitimate: bool -> 'v SimuState.t -> bool) = fun silent st -> @@ -56,7 +53,6 @@ let (compute_legitimate: bool -> 'v SimuState.t -> bool) = let pidl = List.map (fun p -> p.Process.pid) st.network in f pidl (SimuState.neigbors_of_pid st) -open SimuState let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) = fun argv st -> let pl = st.network in diff --git a/lib/sasacore/env.ml b/lib/sasacore/conf.ml similarity index 100% rename from lib/sasacore/env.ml rename to lib/sasacore/conf.ml diff --git a/lib/sasacore/env.mli b/lib/sasacore/conf.mli similarity index 53% rename from lib/sasacore/env.mli rename to lib/sasacore/conf.mli index 2b3505d3c16af7ed8cbe74d0f1c07d97d3320d95..af278e1734bee8853b8658fb1575f66c369c9aa3 100644 --- a/lib/sasacore/env.mli +++ b/lib/sasacore/conf.mli @@ -1,9 +1,8 @@ -(* Time-stamp: <modified the 15/04/2021 (at 11:46) by Erwan Jahier> *) +(* Time-stamp: <modified the 14/10/2021 (at 15:35) by Erwan Jahier> *) (** Storing process variables values. -nb: in order to be closer to the SS community wordings, this module - could (should?) be named Configuration (or maybe just Conf). + nb: this type is opaque iff 'v is opaque. *) type 'v t @@ -15,6 +14,6 @@ val set: 'v t -> string -> 'v -> 'v t (** [get env process_id] *) val get: 'v t -> string -> 'v -(** Use registered copy function to returns an hopefully (if the user +(** Use registered copy function to return an hopefully (if the user provided copy state function is correct) fresh copy *) val get_copy: 'v t -> string -> 'v diff --git a/lib/sasacore/evil.ml b/lib/sasacore/evil.ml index 6689d77951cdd9b97a016b4a5683dd800305ea78..06dbee44f0606e7b1e2bc1410d0af88781a3d867 100644 --- a/lib/sasacore/evil.ml +++ b/lib/sasacore/evil.ml @@ -1,4 +1,4 @@ -(* Time-stamp: <modified the 31/07/2021 (at 09:15) by Erwan Jahier> *) +(* Time-stamp: <modified the 14/10/2021 (at 15:45) by Erwan Jahier> *) type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action type 'v enabled = 'v pna list list @@ -134,7 +134,7 @@ let (greedy: bool -> 'v SimuState.t -> 'v Process.t list -> let nst = step pnal st in let get_info pid = let _, nl = neigbors_of_pid nst pid in - Env.get nst.config pid, nl + Conf.get nst.config pid, nl in user_pf pidl get_info in @@ -165,7 +165,7 @@ let (greedy: bool -> 'v SimuState.t -> 'v Process.t list -> if verb then Printf.eprintf " [Evil.greedy] Number of trials: %i\n%!" !cpt; res -(* val greedy_central: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list -> *) +(* val greedy_central: bool -> 'v Conf.t -> ('v Process.t * 'v Register.neighbor list) list -> *) let (greedy_central: bool -> 'v SimuState.t -> 'v Process.t list -> ('v SimuState.t -> string -> 'v * ('v Register.neighbor * string) list) -> 'v step -> 'v pna list list -> 'v pna list) = @@ -179,7 +179,7 @@ let (greedy_central: bool -> 'v SimuState.t -> 'v Process.t list -> let nst = step [pna] st in let get_info pid = let _, nl = neigbors_of_pid nst pid in - Env.get nst.config pid, nl + Conf.get nst.config pid, nl in user_pf pidl get_info in @@ -222,4 +222,3 @@ let (bad: int -> 'v SimuState.t -> 'v pna list list -> 'v pna list) = let (worst4convex: 'v SimuState.t -> 'v pna list list -> 'v pna list) = fun _e _all -> assert false (* todo *) - diff --git a/lib/sasacore/simuState.ml b/lib/sasacore/simuState.ml index 5ac3ed680a8902555355f4d9d0a09785cbddf5bb..c8a16968e5917f4f389042a1f91b9bcf19498756 100644 --- a/lib/sasacore/simuState.ml +++ b/lib/sasacore/simuState.ml @@ -1,13 +1,13 @@ -(* Time-stamp: <modified the 11/10/2021 (at 16:10) by Erwan Jahier> *) +(* Time-stamp: <modified the 14/10/2021 (at 15:45) by Erwan Jahier> *) open Register open Topology -let (update_env_with_init : 'v Env.t -> 'v Process.t list -> 'v Env.t) = +let (update_env_with_init : 'v Conf.t -> 'v Process.t list -> 'v Conf.t) = fun e pl -> - let (aux: 'v Env.t -> 'v Process.t -> 'v Env.t) = + let (aux: 'v Conf.t -> 'v Process.t -> 'v Conf.t) = fun e p -> - Env.set e p.pid p.init + Conf.set e p.pid p.init in List.fold_left aux e pl @@ -45,7 +45,7 @@ type 'v t = { (* network: ('v Process.t * 'v Register.neighbor list) list; *) network: 'v Process.t list; neighbors: ('v Register.neighbor list) Map.Make(String).t; - config: 'v Env.t + config: 'v Conf.t } let (neigbors_of_pid : 'v t -> pid -> 's * ('s neighbor * pid) list) = @@ -58,19 +58,19 @@ let (neigbors_of_pid : 'v t -> pid -> 's * ('s neighbor * pid) list) = Printf.sprintf "no %s found in %s" pid (String.concat "," (List.map (fun p -> p.Process.pid) st.network))) in - Env.get st.config pid, List.map (fun n -> n, n.Register.pid) nl + Conf.get st.config pid, List.map (fun n -> n, n.Register.pid) nl let (update_neighbor_env: - 'v Env.t -> 'v Register.neighbor list -> 'v Register.neighbor list) = + 'v Conf.t -> 'v Register.neighbor list -> 'v Register.neighbor list) = fun e nl -> - List.map (fun n -> { n with state = Env.get e n.Register.pid }) nl + List.map (fun n -> { n with state = Conf.get e n.Register.pid }) nl let update_neighbors config neighbors = StringMap.map (fun nl -> update_neighbor_env config nl) neighbors -let (update_config: 'v Env.t -> 'v t -> 'v t) = +let (update_config: 'v Conf.t -> 'v t -> 'v t) = fun e st -> let verb = !Register.verbose_level > 0 in if verb then Printf.eprintf " ===> update_neighbor_env\n%!"; @@ -86,7 +86,7 @@ let (get_enable_processes: 'v t -> 'v enable_processes) = assert (pl_n <> []); let all = List.fold_left (fun acc (p,nl) -> - let lenv = Env.get e p.pid in + let lenv = Conf.get e p.pid in let al = p.enable nl lenv in let al = List.map (fun a -> @@ -261,7 +261,7 @@ let (make : bool -> string array -> 'v t) = if !Register.verbose_level > 0 then Printf.eprintf "==> get_neighors\n"; let algo_neighors = List.map2 (get_neighors g) nidl initl in let pl = List.map2 (Process.make (args.daemon=Custom)) nl initl in - let e = Env.init () in + let e = Conf.init () in let e = update_env_with_init e pl in let algo_neighors = List.map (update_neighbor_env e) algo_neighors in let pl_n = List.combine pl algo_neighors in @@ -352,7 +352,7 @@ let (to_dot : 'v t -> string) = (List.map (fun node -> Printf.sprintf " %s [algo=\"%s\" init=\"%s\"]" node.id node.file - (Register.to_string (Env.get ss.config node.id)) + (Register.to_string (Conf.get ss.config node.id)) ) g.nodes) in @@ -389,4 +389,13 @@ let (to_dot : 'v t -> string) = Printf.sprintf "%sgraph %s {\n graph %s\n\n%s\n\n%s\n}\n" (if g.directed then "di" else "") "g" - (if attributes="" then "" else "["^attributes^"]") nodes_decl trans_str; + (if attributes="" then "" else "["^attributes^"]") nodes_decl trans_str + +let (compute_potentiel: 'v t -> float) = + fun st -> + match Register.get_potential () with + | None -> failwith "potential function not registered" + | Some user_pf -> + let pidl = List.map (fun p -> p.Process.pid) st.network in + let p = user_pf pidl (neigbors_of_pid st) in + p diff --git a/lib/sasacore/simuState.mli b/lib/sasacore/simuState.mli index d25b26dd162b15a1b00bf50517d1a445f47b5305..f484876b6c7710a646acf5862dc9a0319b7745c6 100644 --- a/lib/sasacore/simuState.mli +++ b/lib/sasacore/simuState.mli @@ -1,4 +1,4 @@ -(* Time-stamp: <modified the 19/09/2021 (at 23:06) by Erwan Jahier> *) +(* Time-stamp: <modified the 14/10/2021 (at 15:48) by Erwan Jahier> *) (** The module is used by - the main sasa simulation loop (in ../../src/sasaMain.ml) @@ -8,12 +8,12 @@ -(* type 'v t = SasArg.t * 'v layout * 'v Env.t *) +(* type 'v t = SasArg.t * 'v layout * 'v Conf.t *) type 'v t = { sasarg: SasArg.t; network: 'v Process.t list; - neighbors: ('v Register.neighbor list) Map.Make(String).t; (* pid's neigbors *) - config: 'v Env.t + neighbors: ('v Register.neighbor list) Map.Make(String).t; (* pid's neighbors *) + config: 'v Conf.t } (* [make dynlink_flag argv] *) @@ -24,12 +24,15 @@ type 'v enable_processes = val get_enable_processes: 'v t -> 'v enable_processes -(** update the config *) -val update_config: 'v Env.t -> 'v t -> 'v t +(** update the neighbors field using the config one *) +val update_config: 'v Conf.t -> 'v t -> 'v t -(** Get pid's state and neigbors *) +(** Get pid's state and neighbors *) val neigbors_of_pid : 'v t -> string -> 'v * ('v Register.neighbor * string) list +val compute_potentiel: 'v t -> float + + (* For SasaRun *) val get_inputs_rif_decl : SasArg.t -> 'v Process.t list -> (string * string) list val get_outputs_rif_decl: SasArg.t -> 'v Process.t list -> (string * string) list diff --git a/lib/sasacore/step.ml b/lib/sasacore/step.ml index a97f5fbd3025297dee243caf2da5ed2168f5b375..6c5129be575ac334a30a6679e8e67948a307cc6d 100644 --- a/lib/sasacore/step.ml +++ b/lib/sasacore/step.ml @@ -4,19 +4,19 @@ open Process -let (update_env: 'v Env.t -> 'v Process.t * 'v -> 'v Env.t) = +let (update_env: 'v Conf.t -> 'v Process.t * 'v -> 'v Conf.t) = fun e (p, st) -> - Env.set e p.pid st + Conf.set e p.pid st let (f2 : - ('v Process.t * 'v Register.neighbor list * action) list -> 'v Env.t -> 'v Env.t) = + ('v Process.t * 'v Register.neighbor list * action) list -> 'v Conf.t -> 'v Conf.t) = fun pnal e -> let lenv_list = List.map (fun (p,nl,a) -> (* I perform a copy of the local env to make sure the configuration update is atomic *) - let lenv = Env.get_copy e p.pid in + let lenv = Conf.get_copy e p.pid in p, p.step nl lenv a) pnal in diff --git a/lib/sasacore/stringOf.ml b/lib/sasacore/stringOf.ml index 42d1c69da2264752a112204a206dc62e89cf6443..779094abb19291459bbec4abb29bbba94bb31308 100644 --- a/lib/sasacore/stringOf.ml +++ b/lib/sasacore/stringOf.ml @@ -6,23 +6,23 @@ let (algo_neighbor : 'v Register.neighbor -> string) = fun n -> Printf.sprintf "%s (%s)" n.pid (Register.to_string n.state) open Process -let (env: 'v Env.t -> 'v Process.t list -> string) = +let (env: 'v Conf.t -> 'v Process.t list -> string) = fun env pl -> let value_to_string = Register.get_value_to_string () in let l = List.map (fun p -> Printf.sprintf "%s: %s" p.pid - (value_to_string (Env.get env p.pid))) + (value_to_string (Conf.get env p.pid))) pl in String.concat ", " l -let (env_rif: 'v Env.t -> 'v Process.t list -> string) = +let (env_rif: 'v Conf.t -> 'v Process.t list -> string) = fun env pl -> let l = List.map (fun p -> - Printf.sprintf "%s" (SasaState.to_rif_data (Env.get env p.pid))) + Printf.sprintf "%s" (SasaState.to_rif_data (Conf.get env p.pid))) pl in String.concat " " l diff --git a/lib/sasacore/worstInit.ml b/lib/sasacore/worstInit.ml index 545d78487b792f22476da217940b045cc11679ad..c0bd1ae0a336a95c6ba2899ca00f245e106e7bf9 100644 --- a/lib/sasacore/worstInit.ml +++ b/lib/sasacore/worstInit.ml @@ -1,4 +1,4 @@ -(* Time-stamp: <modified the 12/10/2021 (at 16:22) by Erwan Jahier> *) +(* Time-stamp: <modified the 14/10/2021 (at 15:45) by Erwan Jahier> *) open Register @@ -101,8 +101,8 @@ let (point_to_ss : point -> 'v SimuState.t -> 'v SimuState.t) = List.fold_left (fun (e,j) p -> let value = make_value [] state_size (j*state_size) in - let st = values_to_state value (Env.get e p.pid) in - let e = Env.set e p.pid st in + let st = values_to_state value (Conf.get e p.pid) in + let e = Conf.set e p.pid st in e, j+1 ) (ss.config, 0) diff --git a/src/sasaMain.ml b/src/sasaMain.ml index 75d56a4d43cf087003ced512a742ab5d085bb769..47231db694ffae922a87984f9123a6fdb9ad01f0 100644 --- a/src/sasaMain.ml +++ b/src/sasaMain.ml @@ -1,7 +1,7 @@ open Sasacore let (print_step : out_channel -> 'v SimuState.t -> int -> int -> string -> string -> SasArg.t -> - 'v Env.t -> 'v Process.t list -> string -> bool list list -> unit) = + 'v Conf.t -> 'v Process.t list -> string -> bool list list -> unit) = fun log st n i legitimate pot args e pl activate_val enab_ll -> let enable_val = String.concat " " (List.map (fun b -> if b then "t" else "f") @@ -75,23 +75,15 @@ let inject_fault ff st = let update_nodes e p = let nl = StringMap.find p.Process.pid st.neighbors in let pid = p.Process.pid in - let v = Env.get e pid in + let v = Conf.get e pid in let v = ff (List.length nl) pid v in - Env.set e pid v + Conf.set e pid v in let e = List.fold_left update_nodes st.config st.network in update_config e st let plur i = if i>1 then "s" else "" -let (compute_potentiel: 'v SimuState.t -> string) = - fun st -> - match Register.get_potential () with - | None -> "" - | Some user_pf -> - let pidl = List.map (fun p -> p.Process.pid) st.network in - let p = user_pf pidl (SimuState.neigbors_of_pid st) in - string_of_float p let (simustep: out_channel -> int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string) =