Skip to content
Snippets Groups Projects
Commit 220c5cc2 authored by erwan's avatar erwan
Browse files

Chore: use a string map instead of an assoc list for getting pid's neighbors

parent 4eb78d9d
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
lib/sasa/sasaRun.ml
+ 11
− 18
View file @ 220c5cc2
......@@ -18,7 +18,7 @@ open Process
let (from_sasa_env : 'v SimuState.t -> RdbgPlugin.sl) =
fun st ->
List.fold_left
(fun acc (p,_) ->
(fun acc p ->
let state = Env.get st.config p.pid in
let sl = SasaState.to_rdbg_subst p.pid state in
acc@sl
......@@ -37,18 +37,14 @@ let (get_sl_out: bool -> 'v Process.t list -> bool list list -> RdbgPlugin.sl) =
pl ll
)
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 get_info pid =
let nl = snd (List.find (fun (p,_) -> p.Process.pid = pid) st.network) in
Env.get st.config pid,
List.map (fun n -> n, n.Register.pid) nl
in
let p = (user_pf pidl get_info) in
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)]
let (compute_legitimate: bool -> 'v SimuState.t -> bool) =
......@@ -57,18 +53,13 @@ let (compute_legitimate: bool -> 'v SimuState.t -> bool) =
match Register.get_legitimate () with
| None -> silent
| Some f ->
let pidl = List.map (fun (p,_) -> p.Process.pid) st.network in
let get_info pid =
let nl = snd (List.find (fun (p,_) -> p.Process.pid = pid) st.network) in
Env.get st.config pid,
List.map (fun n -> n, n.Register.pid) nl
in
f pidl get_info
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 = fst (List.split st.network) in
let pl = st.network in
let prog_id = Printf.sprintf "%s (with sasa Version %s)"
(String.concat " " (Array.to_list argv)) SasaVersion.str
in
......@@ -111,7 +102,8 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
(* if was_silent then failwith "Silent"; *)
(* 2: read the actions from the outside process, i.e., from sl_in *)
let _, pnal = Daemon.f st.sasarg.dummy_input
(st.sasarg.verbose > 0) st.sasarg.daemon st.network st.config pre_pnall pre_enab_ll
(st.sasarg.verbose > 0) st.sasarg.daemon st.network
(SimuState.neigbors_of_pid st) st.config pre_pnall pre_enab_ll
(get_action_value sl_in)
in
(* 3: Do the steps *)
......@@ -148,7 +140,8 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
else
(* 2: read the actions from the outside process, i.e., from sl_in *)
let activate_val, pnal = Daemon.f st.sasarg.dummy_input
(st.sasarg.verbose > 0) st.sasarg.daemon st.network st.config pnall enab_ll
(st.sasarg.verbose > 0) st.sasarg.daemon st.network (SimuState.neigbors_of_pid st)
st.config pnall enab_ll
(get_action_value sl_in)
in
(* 3: Do the steps *)
......
lib/sasacore/daemon.ml
+ 31
− 31
View file @ 220c5cc2
(* Time-stamp: <modified the 08/12/2020 (at 16:09) by Erwan Jahier> *)
(* Time-stamp: <modified the 03/05/2021 (at 16:16) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
......@@ -120,35 +120,35 @@ let (get_activate_val: 'v pna list -> 'v Process.t list -> bool list list)=
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 -> ('v Process.t * 'v Register.neighbor list) list ->
'v Env.t -> 'v pna list list -> bool list list ->
(string -> string -> bool) -> bool list list * 'v pna list) =
fun dummy_input verbose_mode daemon p_nl_l e all enab get_action_value ->
let (f: bool -> bool -> t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) -> 'v Env.t ->
'v pna list list -> bool list list -> (string -> string -> bool) ->
bool list list * 'v pna list) =
fun dummy_input verbose_mode daemon pl neigbors_of_pid e all enab get_action_value ->
let nall = remove_empty_list all in
if nall = [] then assert false (* failwith "Silent" *);
let pl = fst(List.split p_nl_l) in
if daemon <> Custom && dummy_input then
ignore (RifRead.bool verbose_mode ((List.hd pl).pid) "");
match daemon with
| Synchronous ->
let al = synchrone nall in
get_activate_val al pl, al
| Central ->
let al = central nall in
get_activate_val al pl, al
| LocallyCentral ->
let al = locally_central nall in
get_activate_val al pl, al
| Distributed ->
let al = distributed nall in
get_activate_val al pl, al
| Greedy ->
let al = Evil.greedy verbose_mode e p_nl_l nall in
get_activate_val al pl, al
| GreedyCentral ->
let al = Evil.greedy_central verbose_mode e p_nl_l nall in
get_activate_val al pl, al
| Bad i ->
let al = Evil.bad i e nall in
get_activate_val al pl, al
| Custom -> custom all pl enab get_action_value
if daemon <> Custom && dummy_input then
ignore (RifRead.bool verbose_mode ((List.hd pl).pid) "");
match daemon with
| Synchronous ->
let al = synchrone nall in
get_activate_val al pl, al
| Central ->
let al = central nall in
get_activate_val al pl, al
| LocallyCentral ->
let al = locally_central nall in
get_activate_val al pl, al
| Distributed ->
let al = distributed nall in
get_activate_val al pl, al
| Greedy ->
let al = Evil.greedy verbose_mode e pl neigbors_of_pid nall in
get_activate_val al pl, al
| GreedyCentral ->
let al = Evil.greedy_central verbose_mode e pl neigbors_of_pid nall in
get_activate_val al pl, al
| Bad i ->
let al = Evil.bad i e nall in
get_activate_val al pl, al
| Custom -> custom all pl enab get_action_value
lib/sasacore/daemon.mli
+ 5
− 4
View file @ 220c5cc2
(* Time-stamp: <modified the 30/09/2020 (at 13:53) by Erwan Jahier> *)
(* Time-stamp: <modified the 03/05/2021 (at 16:16) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
......@@ -44,7 +44,8 @@ nb: it is possible that we read on stdin that an action should be
inhibit the activation.
*)
val f : bool -> bool -> t -> ('v Process.t * 'v Register.neighbor list) list ->
'v Env.t -> 'v pna list list -> bool list list ->
(string -> string -> bool) -> bool list list * 'v pna list
val f : bool -> bool -> t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) ->
'v Env.t -> 'v pna list list -> bool list list ->
(string -> string -> bool) -> bool list list * 'v pna list
lib/sasacore/evil.ml
+ 15
− 15
View file @ 220c5cc2
(* Time-stamp: <modified the 07/12/2020 (at 10:20) by Erwan Jahier> *)
(* Time-stamp: <modified the 03/05/2021 (at 16:17) by Erwan Jahier> *)
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
......@@ -118,20 +118,20 @@ let time3 verb lbl f x y z =
if verb then Printf.eprintf " [%s] Execution time: %fs\n" lbl (Sys.time() -. t);
fxy
let (greedy: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list ->
'v pna list list -> 'v pna list) =
fun verb e p_nl_l all ->
let (greedy: bool -> 'v Env.t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) -> 'v pna list list ->
'v pna list) =
fun verb e pl neigbors_of_pid all ->
assert (all<>[]);
match Register.get_potential () with
| None -> failwith "No potential function has been provided"
| Some user_pf ->
let pf pnal = (* pnal contains a list of activated processes *)
let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
let pidl = List.map (fun p -> p.Process.pid) pl 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,
List.map (fun n -> n, n.Register.pid) nl
let _, nl = neigbors_of_pid pid in
Env.get ne pid, nl
in
user_pf pidl get_info
in
......@@ -160,20 +160,20 @@ let (greedy: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list
if verb then Printf.eprintf " [Evil.greedy] Number of trials: %i\n%!" !cpt;
res
let (greedy_central: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list
-> 'v pna list list -> 'v pna list) =
fun verb e p_nl_l all ->
(* val greedy_central: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list -> *)
let (greedy_central: bool -> 'v Env.t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) -> 'v pna list list -> 'v pna list) =
fun verb e pl neigbors_of_pid all ->
assert (all<>[]);
match Register.get_potential () with
| None -> failwith "No potential function has been provided"
| Some user_pf ->
let pf pna =
let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
let pidl = List.map (fun p -> p.Process.pid) pl 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,
List.map (fun n -> n, n.Register.pid) nl
let _, nl = neigbors_of_pid pid in
Env.get ne pid, nl
in
user_pf pidl get_info
in
......
lib/sasacore/evil.mli
+ 7
− 5
View file @ 220c5cc2
(* Time-stamp: <modified the 07/12/2020 (at 10:16) by Erwan Jahier> *)
(* Time-stamp: <modified the 03/05/2021 (at 16:17) by Erwan Jahier> *)
(** This module gathers daemons that tries to reach the worst case with
......@@ -6,15 +6,17 @@
type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
(** [greedy verb e p_nl_l all] take the worst case among the combinations of
(** [greedy verb e pl neigbors_of_pid all] take the worst case among the combinations of
length 1, i.e., O(2^n) where n is the number of enabled processes
(|all|) *)
val greedy: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list ->
val greedy: bool -> 'v Env.t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) ->
'v pna list list -> 'v pna list
(** Ditto, but for central daemons (of a connected component) *)
val greedy_central: bool -> 'v Env.t -> ('v Process.t * 'v Register.neighbor list) list ->
'v pna list list -> 'v pna list
val greedy_central: bool -> 'v Env.t -> 'v Process.t list ->
(string -> 'v * ('v Register.neighbor * string) list) -> 'v pna list list ->
'v pna list
(** Returns the worst case among the combinations of length 1 for
convex potential functions, and just a bad one otherwise (O(n)
......
lib/sasacore/simuState.ml
+ 30
− 8
View file @ 220c5cc2
(* Time-stamp: <modified the 16/04/2021 (at 15:39) by Erwan Jahier> *)
(* Time-stamp: <modified the 04/05/2021 (at 08:36) by Erwan Jahier> *)
open Register
......@@ -37,32 +37,49 @@ let (dump_process: string -> 'v Process.t * 'v Register.neighbor list -> unit) =
open Process
open SasArg
module StringMap = Map.Make(String)
type 'v t = {
sasarg: SasArg.t;
network: ('v Process.t * 'v Register.neighbor list) list;
(* 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
}
let (neigbors_of_pid : 'v t -> pid -> 's * ('s neighbor * pid) list) =
fun st pid ->
let nl =
match StringMap.find_opt pid st.neighbors with
| Some x -> x
| None ->
failwith (
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
let (update_neighbor_env: 'v Env.t -> 'v Register.neighbor list -> 'v Register.neighbor list) =
fun e nl ->
List.map (fun n -> { n with state = Env.get_copy e n.Register.pid }) nl
let update_network config network = List.map
(fun (p,nl) -> p, update_neighbor_env config nl)
network
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) =
fun e st ->
let verb = !Register.verbose_level > 0 in
if verb then Printf.eprintf " ===> update_neighbor_env\n%!";
{ st with network = update_network e st.network ; config = e }
{ st with neighbors = update_neighbors e st.neighbors ; config = e }
type 'v enable_processes =
('v Process.t * 'v Register.neighbor list * Register.action) list list * bool list list
let (get_enable_processes: 'v t -> 'v enable_processes) =
fun st ->
let pl_n = st.network in
let pl_n = List.map (fun p -> p, StringMap.find p.pid st.neighbors) st.network in
let e = st.config in
assert (pl_n <> []);
let all = List.fold_left
......@@ -306,9 +323,14 @@ let (make : bool -> string array -> 'v t) =
Printf.eprintf "Ignoring the first vectors of sasa inputs\n%!";
);
if !Register.verbose_level > 0 then Printf.eprintf "==> SimuState.make done !\n%!";
let neighbors =
List.fold_left (fun acc (p,nl) -> StringMap.add p.pid nl acc)
StringMap.empty pl_n
in
{
sasarg = args;
network = pl_n;
network = pl;
neighbors = neighbors;
config = e
}
with
......
lib/sasacore/simuState.mli
+ 9
− 5
View file @ 220c5cc2
(* Time-stamp: <modified the 16/04/2021 (at 15:31) by Erwan Jahier> *)
(* Time-stamp: <modified the 04/05/2021 (at 08:27) by Erwan Jahier> *)
(** The module is used by
- the main sasa simulation loop (in ../../src/sasaMain.ml)
......@@ -6,10 +6,13 @@
*)
(* type 'v t = SasArg.t * 'v layout * 'v Env.t *)
type 'v t = {
sasarg: SasArg.t;
network: ('v Process.t * 'v Register.neighbor list) list;
network: 'v Process.t list;
neighbors: ('v Register.neighbor list) Map.Make(String).t; (* pid's neigbors *)
config: 'v Env.t
}
......@@ -23,9 +26,10 @@ val get_enable_processes: 'v t -> 'v enable_processes
(** update the config and network processes *)
val update_config: 'v Env.t -> 'v t -> 'v t
(** Get pid's state and neigbors *)
val neigbors_of_pid : 'v t -> string -> 'v * ('v Register.neighbor * string) list
(* 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
src/sasaMain.ml
+ 14
− 32
View file @ 220c5cc2
......@@ -55,28 +55,20 @@ let bool_ll_to_string bll =
String.concat " "
(List.map (fun b -> if b then "t" else "f") (List.flatten bll))
let legitimate p_nl_l e =
open Sasacore.SimuState
let legitimate st =
match Register.get_legitimate () with
| None -> false
| Some ulf ->
let pidl = List.map (fun (p,_) -> p.Process.pid) p_nl_l in
let rec from_pid p_nl_l pid = (* XXX use StringMap instead *)
match p_nl_l with
| [] -> assert false (* sno *)
| (p,nl)::tail ->
if p.Process.pid = pid then
let nl = List.map (fun n -> n,n.Register.pid) nl in
Env.get e pid,
nl
else
from_pid tail pid
in
ulf pidl (from_pid p_nl_l)
let pidl = List.map (fun p -> p.Process.pid) st.network in
ulf pidl (SimuState.neigbors_of_pid st)
open Sasacore.SimuState
module StringMap = Map.Make(String)
let inject_fault ff st =
let update_nodes e (p,nl) =
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 = ff (List.length nl) pid v in
......@@ -92,19 +84,8 @@ let (compute_potentiel: 'v SimuState.t -> string) =
match Register.get_potential () with
| None -> ""
| Some user_pf ->
let pidl = List.map (fun (p,_) -> p.Process.pid) st.network in
let get_info pid =
let nl = match List.find_opt (fun (p,_) -> p.Process.pid = pid) st.network with
None ->
failwith (
Printf.sprintf "no %s found in %s" pid
(String.concat "," (List.map (fun (p,_) -> p.Process.pid) st.network)))
| Some (_,x) -> x
in
Env.get st.config pid,
List.map (fun n -> n, n.Register.pid) nl
in
let p = user_pf pidl get_info in
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
......@@ -115,7 +96,7 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
if verb then Printf.eprintf "==> SasaSimuState.simustep :1: Get enable processes\n%!";
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
let pot = compute_potentiel st in
let pl = fst(List.split st.network) in
let pl = st.network in
let st, all, enab_ll =
if
(* not (args.rif) && *)
......@@ -136,7 +117,7 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
let all, enab_ll = Sasacore.SimuState.get_enable_processes st in
st, all, enab_ll
)
else if legitimate st.network st.config then (
else if legitimate st then (
match Register.get_fault () with
| None ->
print_step n i pot st.sasarg st.config pl activate_val enab_ll;
......@@ -161,7 +142,8 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
if verb then Printf.eprintf "==> SasaSimuState.simustep : 2: read the actions\n%!";
let get_action_value = RifRead.bool (st.sasarg.verbose > 1) in
let next_activate_val, pnal = Daemon.f st.sasarg.dummy_input
(st.sasarg.verbose >= 1) st.sasarg.daemon st.network st.config all enab_ll get_action_value
(st.sasarg.verbose >= 1) st.sasarg.daemon st.network (SimuState.neigbors_of_pid st)
st.config all enab_ll get_action_value
in
List.iter (List.iter (fun b -> if b then incr moves)) next_activate_val;
update_round next_activate_val enab_ll;
......
test/coloring/config.ml
+ 1
− 0
View file @ 220c5cc2
......@@ -10,5 +10,6 @@ let clash_number pidl get =
float_of_int !clash
let potential = Some clash_number
(* let potential = None *)
let legitimate = None
let fault = None
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