Skip to content
GitLab
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
Hide whitespace changes
Inline Side-by-side
lib/sasa/sasaRun.ml
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
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
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
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
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
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
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
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
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
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