diff --git a/lib/sasa/dune b/lib/sasa/dune
index f96076b6db6ce9388aa0d0cf233f47dd7b296280..107e0e96505182acfec7b088067a1088a3c3dc1c 100644
--- a/lib/sasa/dune
+++ b/lib/sasa/dune
@@ -3,7 +3,7 @@
(library
(name sasa)
(public_name sasa)
- (libraries ocamlgraph rdbg algo sasacore lutils)
+ (libraries ocamlgraph rdbg algo sasacore lutils sasaExplore)
; (wrapped false)
(library_flags -linkall)
(synopsis "The Sasa rdbg plugin")
diff --git a/lib/sasa/sasaRun.ml b/lib/sasa/sasaRun.ml
index adac46d817e6b1a75e314f9bf570ee252d757c69..005be63f311f51a8e825137a9ffaee4de54ffa55 100644
--- a/lib/sasa/sasaRun.ml
+++ b/lib/sasa/sasaRun.ml
@@ -102,7 +102,11 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
(* let was_silent = List.for_all (fun b -> not b) (List.flatten pre_enab_ll) in *)
(* 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
+ let daemon_func = match st.sasarg.use_sasaExplore with
+ | "" -> Daemon.f
+ | s -> SasaExplore.Build.get s
+ in
+ let _, pnal = daemon_func st.sasarg.dummy_input
(st.sasarg.verbose > 0) st.sasarg.daemon st.network
(SimuState.neigbors_of_pid st) st pre_pnall pre_enab_ll
(get_action_value sl_in) Step.f
@@ -140,8 +144,12 @@ 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 daemon_func = match st.sasarg.use_sasaExplore with
+ | "" -> Daemon.f
+ | s -> SasaExplore.Build.get s
+ in
let activate_val, pnal =
- Daemon.f st.sasarg.dummy_input
+ daemon_func st.sasarg.dummy_input
(st.sasarg.verbose > 0) st.sasarg.daemon st.network
(SimuState.neigbors_of_pid st) st pnall enab_ll
(get_action_value sl_in) Step.f
diff --git a/lib/sasaExplore/build.ml b/lib/sasaExplore/build.ml
deleted file mode 100644
index 863f37c125039cf072c12962850687824569da4c..0000000000000000000000000000000000000000
--- a/lib/sasaExplore/build.ml
+++ /dev/null
@@ -1,80 +0,0 @@
-open Sasacore
-open Exploring
-
-module SimStManag = SimuStateManager
-
-type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
-type 'v step = 'v pna list -> 'v SimuState.t -> 'v SimuState.t
-
-type 'v t = bool -> 'v SimuState.t -> 'v Process.t list ->
- (string -> 'v * ('v Register.neighbor * string) list) ->
- 'v step -> 'v pna list list -> 'v pna list
-;;
-
-module Make(Expl: Explorer): Exploring.S =
-struct
- type 'a accu = 'a Expl.accu;;
-
- let exec (init_state: 'v SimStManag.t) (accumul: 'v Expl.accu): 'v Expl.accu =
- if SimStManag.legitimate init_state
- then (
- accumul (* Nothing to do *)
- ) else (
- (* Parse initial state *)
- let accumul = Expl.parse_state (SimStManag.t_of_saved init_state) NoChoice accumul in
- let rec iterator acc: 'a Expl.accu =
- let (choice, acc) = Expl.choose acc in
- match choice with
- | NoChoice -> acc
- | State (_, _, end_state) -> (
- let new_state = SimStManag.t_of_saved end_state in
- let acc = match SimStManag.legitimate new_state with
- | true -> Expl.parse_legit new_state choice acc
- | false -> Expl.parse_state new_state choice acc
- in
- (* Finish by looping *)
- iterator acc
- )
- | Enab (state, triggers) -> (
- (* Step *)
- let new_state = SimStManag.step state triggers in
- let acc = match SimStManag.legitimate new_state with
- | true -> Expl.parse_legit new_state choice acc
- | false -> Expl.parse_state new_state choice acc
- in
- (* Finish by looping *)
- iterator acc
- )
- in
- iterator accumul
- )
- ;;
- let run_from (simstate: 'v SimuState.t) (topology: Topology.t): int * 'v proc_chosen_action list list =
- let state = SimStManag.read simstate None in
- let results = exec state (Expl.default_accu topology) in
- Expl.get_results results
- ;;
-end
-
-let get (name: string): 'v t =
- let module Expl = (Make(val List.assoc name RegisterExplo.explorers): Exploring.S) in
- let path = ref (Some []) in
- let rec explorer (verb: bool) (st: 'v SimuState.t) (processes: 'v Process.t list)
- (get_neighors: (string -> 'v * ('v Register.neighbor * string) list))
- (step: 'v step) (enables: 'v pna list list): 'v pna list =
- match !path with
- | Some [] -> (
- if verb then Printf.eprintf "[SasaExplore] Error: no step remaining.\n%!";
- assert false
- )
- | Some (ch::rem) -> (path := Some rem; ch)
- | None -> (
- let topo = Register.get_topology () in
- if verb then Printf.eprintf "[SasaExplore] Running...\n%!";
- let (_, new_path) = Expl.run_from st topo in
- if verb then Printf.eprintf "[SasaExplore] Finished.\n%!";
- path := Some (List.map (List.map (fun ((p, n), act) -> p,n,act)) new_path);
- explorer verb st processes get_neighors step enables (* Get first element *)
- )
- in explorer
-;;
\ No newline at end of file
diff --git a/lib/sasaExplore/explorers/exhaust.ml b/lib/sasaExplore/explorers/exhaust.ml
index c43274a3a4364d0908466e308bcd32f63b2ff8ef..f609edd4a222151647cb7b9d0eaa0af449a4c60f 100644
--- a/lib/sasaExplore/explorers/exhaust.ml
+++ b/lib/sasaExplore/explorers/exhaust.ml
@@ -1,39 +1,10 @@
open Exploring;;
-(* module Tools = struct
- (* Make blacklist of nodes with a smaller name that are not neighbours *)
- let gen_blacklist (node_enable) (enables) =
- (* node_enable shoud not have "Enabl_", but the elements of enables should *)
- (* 1- Get all enabled nodes *)
- let trimed_names = List.map trim_five enables in
- (* 2- Remove neighbours *)
- let node_name = before_underscore node_enable in
- let new_black = StrSet.filter (fun elem ->
- let elem = before_underscore elem in
- not (List.exists2 (fun a b -> node_name = a || node_name = b)
- (List.map snd (topology.succ elem)) (topology.pred elem))
- ) (StrSet.of_list trimed_names) in
- (* 3- Remove enables higher or equal to node_name *)
- let (new_black, _, _) = StrSet.split node_name new_black in
- new_black
- ;;
-
- (* Return : (enables, removed) *)
- let apply_blacklist (blacklist) (enables) : (string list * string list) =
- let (l1, l2) = List.fold_left (fun (new_list, removed) e ->
- if None == StrSet.find_opt e blacklist
- then (e::new_list, removed)
- else (new_list, e::removed)
- ) ([],[]) enables in
- List.rev l1, l2
- ;;
-end;; *)
-
module V1: Explorer = struct
type 'v accu = {
- path: (int * 'v proc_chosen_action list list) (* Current path *);
- best: (int * 'v proc_chosen_action list list) (* Best path *);
- todo: ('v process_actions list * 'v SimuStateManager.saved) list;
+ path: (int * proc_chosen_action list list) (* Current path *);
+ best: (int * proc_chosen_action list list) (* Best path *);
+ todo: (process_actions list * 'v SimuStateManager.saved) list;
};;
let default_accu _ = {path=(0, []); best=(0, []); todo=[]};;
@@ -49,10 +20,11 @@ module V1: Explorer = struct
match td with
| [] -> assert(false)
| ([], _)::[] -> None
- | ([], _)::rest ->
+ | ([], _)::rest -> (
parse_todo rest (current_depth - 1, List.tl current_path)
+ )
| ((_, [])::others, state)::rest ->
- parse_todo ((others, state)::rest) (current_depth, List.tl current_path)
+ parse_todo ((others, state)::rest) (current_depth, current_path)
| ((p, act::rem_acts)::others, state)::rest ->
Some (((p, act), state), ((p, rem_acts)::others, state)::rest, (current_depth, current_path))
in
@@ -80,81 +52,4 @@ module V1: Explorer = struct
let get_results {best=best; _} = fst best, (List.rev (snd best));;
end;;
-(* module Devismes = struct
- open Tools
-
- (* État courant de l'exécution à une profondeur donnée *)
- type depth_level = {
- remain: string list (* Remaining cases *);
- state: SimuState.saved (* the state when started *);
- (* blacklist: StrSet.t (* blacklist *); *)
- c_done: string list (* cases done *);
- }
-
- module Def = struct
- open Explore;;
-
- type accu = (int * string list list * StrSet.t) (* Current path and next blacklist *)
- * (int * string list list) (* Best path *)
- * (bool array array * (string, int) Hashtbl.t) (* topology info *)
- * depth_level list;; (* todolist *)
- ;;
-
- let default_accu (topo: Topology.t): accu =
- let name_to_index = Hashtbl.create (List.length topo.nodes) in
- List.iteri (fun i e -> Hashtbl.add name_to_index e.id i) topo.nodes;
- (0, [], StrSet.empty), (0, []), (to_adjacency topo, name_to_index), []
- ;;
-
- let parse_state state _ ((depth, path, blackl), best, (adj, tbl), to_do) =
- let all_enables = SimuState.get_enables state in
- let (choices, removed) = apply_blacklist blackl all_enables in
- let saved = SimuState.save state in
- let to_do = {remain=choices; state=saved; (* blacklist=blackl; *)c_done=[]}::to_do in
- ((depth, path, blackl), best, (adj, tbl), to_do)
-
- let choose ((curdepth, curpath, _), best, (adj, tbl), to_do: accu) : (choice * accu) =
- let rec parse_todo td (curr_depth, curr_path) =
- match td with
- | [] -> assert(false)
- | {remain=[]; _}::[] -> None
- | {remain=[]; _}::rest -> parse_todo rest (curr_depth - 1, List.tl curr_path)
- | {remain=enab::others; state=state; c_done=c_done}::rest ->
- Some (
- (enab, state), (* Choice *)
- {remain=others; state=state; c_done=c_done}::rest, (* remaining *)
- c_done, (* Done nodes *)
- (curr_depth, curr_path) (* current path *)
- )
- in
- let choice, acc = match parse_todo to_do (curdepth, curpath) with
- | None -> NoChoice, (
- (0, [], StrSet.empty), best, (adj, tbl), [] (* End, the get_results will parse this *)
- )
- | Some ((enab, state), remaining, c_done, (depth, path)) ->
- let get_id enable = Hashtbl.find tbl (before_underscore enable) in
- let new_blacklist = StrSet.of_list (
- List.filter (fun n -> not (adj.(get_id n).(get_id enab))) c_done
- ) in
- Enab (Some state, [enab]), (
- (depth + 1, [enab]::path, new_blacklist),
- best,
- (adj, tbl),
- remaining
- )
- in choice, acc
- ;;
-
- let parse_legit _ _ ((depth, path, _), best, topo, to_do) =
- if (depth) > (fst best)
- then (depth - 1, List.tl path, StrSet.empty), (depth, path), topo, to_do
- else (depth - 1, List.tl path, StrSet.empty), best, topo, to_do
-
- let get_results (_, best, _, _) = fst best, (List.rev (snd best));;
- end
-
- include Explore.Make(Def);;
- let run () = run_h2 run_event;;
-end;; *)
-
include V1;;
diff --git a/lib/sasaExplore/exploring.ml b/lib/sasaExplore/exploring.ml
index 907f2d2e2cb4821ab4433d1745e79dba2353e5cf..aa29b32d4de335d77ae751595b2ea07c2d424dad 100644
--- a/lib/sasaExplore/exploring.ml
+++ b/lib/sasaExplore/exploring.ml
@@ -1,15 +1,18 @@
open Sasacore
+type action = Register.action;;
module SimStManag = SimuStateManager;;
-type 'v process_actions = 'v SimStManag.process_actions;;
-type 'v proc_chosen_action = 'v SimStManag.proc_chosen_action;;
+type process_name = string;;
+type process_actions = (process_name * action list);;
+type proc_chosen_action = (process_name * action);;
+
(* A type defining everything to do a step : the starting state and a list of the nodes to
activate. If the starting state is None, it will be replaced by the current state *)
type 'v choice =
- | Enab of ('v SimStManag.saved * 'v proc_chosen_action list)
+ | Enab of ('v SimStManag.saved * proc_chosen_action list)
(* A path to execute from the optionnaly given state *)
- | State of ('v SimStManag.saved * 'v proc_chosen_action list * 'v SimStManag.saved)
+ | State of ('v SimStManag.saved * proc_chosen_action list * 'v SimStManag.saved)
(* A path alredy executed from an optionnally given state, ending at a already saved state *)
| NoChoice
;;
@@ -42,7 +45,7 @@ module type Explorer =
val choose: 'v accu -> 'v choice * 'v accu
(* Given the accumulator, returns the best execution *)
- val get_results: 'v accu -> (int * 'v proc_chosen_action list list)
+ val get_results: 'v accu -> (int * proc_chosen_action list list)
end
;;
@@ -50,6 +53,6 @@ module type S =
sig
type 'a accu
val exec: 'v SimuStateManager.t -> 'v accu -> 'v accu
- val run_from: 'v Sasacore.SimuState.t -> Sasacore.Topology.t -> int * 'v proc_chosen_action list list
+ val run_from: 'v Sasacore.SimuState.t -> Sasacore.Topology.t -> int * proc_chosen_action list list
end
;;
diff --git a/lib/sasaExplore/sasamode/build.ml b/lib/sasaExplore/sasamode/build.ml
new file mode 100644
index 0000000000000000000000000000000000000000..fded799d7019b298e96fa1c22fe80ef8b37859c0
--- /dev/null
+++ b/lib/sasaExplore/sasamode/build.ml
@@ -0,0 +1,151 @@
+open Sasacore
+open Exploring
+
+module SimStManag = SimuStateManager;;
+module StringMap = Map.Make(String);;
+
+type 'v pna = 'v Process.t * 'v Register.neighbor list * Register.action
+type 'v step = 'v pna list -> 'v SimuState.t -> 'v SimuState.t
+
+type 'v t = bool -> bool -> 'v SimuState.t -> 'v Process.t list ->
+ (string -> 'v * ('v Register.neighbor * string) list) ->
+ 'v step -> 'v pna list list -> 'v pna list
+;;
+
+module Make(Expl: Explorer): Exploring.S =
+struct
+ type 'a accu = 'a Expl.accu;;
+
+ let exec (init_state: 'v SimStManag.t) (accumul: 'v Expl.accu): 'v Expl.accu =
+ if SimStManag.legitimate init_state
+ then (
+ accumul (* Nothing to do *)
+ ) else (
+ (* Parse initial state *)
+ let accumul = Expl.parse_state (SimStManag.t_of_saved init_state) NoChoice accumul in
+ let rec iterator acc: 'a Expl.accu =
+ let (choice, acc) = Expl.choose acc in
+ match choice with
+ | NoChoice -> (
+ acc
+ )
+ | State (_, _, end_state) -> (
+ let new_state = SimStManag.t_of_saved end_state in
+ let acc = match SimStManag.legitimate new_state with
+ | true -> (
+ Expl.parse_legit new_state choice acc
+ )
+ | false -> (
+ Expl.parse_state new_state choice acc
+ )
+ in
+ (* Finish by looping *)
+ iterator acc
+ )
+ | Enab (state, triggers) -> (
+ (* Step *)
+ let new_state = SimStManag.step state triggers in
+ let acc = match SimStManag.legitimate new_state with
+ | true -> (
+ Expl.parse_legit new_state choice acc
+ )
+ | false -> (
+ Expl.parse_state new_state choice acc
+ )
+ in
+ (* Finish by looping *)
+ iterator acc
+ )
+ in
+ iterator accumul
+ )
+ ;;
+ let run_from (simstate: 'v SimuState.t) (topology: Topology.t): int * proc_chosen_action list list =
+ let state = SimStManag.read simstate None in
+ let results = exec state (Expl.default_accu topology) in
+ Expl.get_results results
+ ;;
+end
+
+let (get_activate_val: 'v pna list -> 'v 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 disp_action out (p,a: proc_chosen_action) =
+ Printf.fprintf out "%s:%s" p a
+
+let rec disp_actions_rec out (act: proc_chosen_action list) =
+ match act with
+ | [] -> ()
+ | elem::remain -> (
+ Printf.fprintf out ", %a" disp_action elem;
+ disp_actions_rec out remain
+ )
+
+let disp_actions out (act: proc_chosen_action list) =
+ match act with
+ | [] -> ()
+ | elem::remain -> (
+ Printf.fprintf out "[%a%a]" disp_action elem disp_actions_rec remain
+ )
+
+let rec disp_path_rec out (path: proc_chosen_action list list) =
+ match path with
+ | [] -> ()
+ | elem::remain -> (
+ Printf.fprintf out "-> %a" disp_actions elem;
+ disp_path_rec out remain
+ )
+
+let disp_path out (path: proc_chosen_action list list) =
+ match path with
+ | [] -> ()
+ | elem::remain -> (
+ Printf.fprintf out "%a" disp_actions elem;
+ disp_path_rec out remain
+ )
+
+let get (name: string) (dummy: bool) (verb: bool) (_: DaemonType.t) (processes: 'v Process.t list)
+ (get_neighors: (string -> 'v * ('v Register.neighbor * string) list)) (st: 'v SimuState.t)
+ (enables: 'v pna list list) (_: bool list list) (_: 'a) (step: 'v step): bool list list * 'v pna list =
+ let module Expl = (Make(val List.assoc name RegisterExplo.explorers): Exploring.S) in
+ let path = ref (None) in
+
+ let rec explorer (dummy: bool) (verb: bool) (st: 'v SimuState.t) (processes: 'v Process.t list)
+ (get_neighors: (string -> 'v * ('v Register.neighbor * string) list))
+ (step: 'v step) (enables: 'v pna list list): 'v pna list =
+ if dummy then
+ ignore (RifRead.bool verb ((List.hd processes).pid) "");
+ match !path with
+ | Some [] -> (
+ Printf.eprintf "[SasaExplore] Error: no step remaining.\n%!";
+ flush stderr;
+ assert false
+ )
+ | Some (elem::rem) -> (
+ path := Some rem;
+ List.map (fun (p, act) ->
+ let proc = List.find (fun p2 -> p2.Process.pid = p) st.network in
+ let neig = StringMap.find p st.neighbors in
+ proc, neig, act
+ ) elem
+ )
+ | None -> (
+ let topo = Register.get_topology () in
+ if verb then Printf.eprintf "[SasaExplore] Running...\n%!";
+ let (l, new_path) = Expl.run_from st topo in
+ if verb then Printf.eprintf "[SasaExplore] Finished.\n%!";
+ if verb then Printf.eprintf "[SasaExplore] Path found : %a (len: %d)\n%!" disp_path new_path (List.length new_path);
+ if verb then Printf.eprintf "[SasaExplore] Length found : %d\n%!" l;
+ path := Some new_path;
+ explorer false verb st processes get_neighors step enables (* Get first element *)
+ )
+ in
+ let actions = explorer dummy verb st processes get_neighors step enables in
+ get_activate_val actions processes, actions
+;;
diff --git a/lib/sasaExplore/simuStateManager.ml b/lib/sasaExplore/simuStateManager.ml
index 76ca8483301748c10a8e2ce043919b15024bba19..c6b7d3546cb94190e155aa5f9ed4816f9088c688 100644
--- a/lib/sasaExplore/simuStateManager.ml
+++ b/lib/sasaExplore/simuStateManager.ml
@@ -1,11 +1,17 @@
open Sasacore;;
type action = Register.action;;
+module StringMap = Map.Make(String);;
+
(******************************************************************************)
-type 'v process_info = ('v Process.t * 'v Register.neighbor list);;
-type 'v process_actions = ('v process_info * action list);;
-type 'v proc_chosen_action = ('v process_info * action);;
+type process_name = string;;
+type process_actions = (process_name * action list);;
+type proc_chosen_action = (process_name * action);;
+
+(* type 'v process_info = ('v Process.t * 'v Register.neighbor list);;
+type process_actions = ('v process_info * action list);;
+type proc_chosen_action = ('v process_info * action);; *)
type 'v pna = ('v Process.t * 'v Register.neighbor list * action);;
(******************************************************************************)
@@ -13,28 +19,29 @@ type 'v pna = ('v Process.t * 'v Register.neighbor list * action);;
(* Adds to the data the event from which it was created.
If already saved, will not re-save. Opaque *)
type 'v t = {
- mutable enables: 'v process_actions list option;
+ mutable enables: process_actions list option;
mutable legitimate: bool option;
state: 'v SimuState.t; (* Obligé pour pouvoir step *)
+ stateof: 'v Process.t StringMap.t;
mutable potential: float option;
rand_state: Random.State.t;
};;
type 'v saved = 'v t;;
-let read_actions (actions: 'v pna list list): 'v process_actions list =
+let read_actions (actions: 'v pna list list): process_actions list =
let actions = List.filter (fun e -> e <> []) actions in
List.map (fun pna_l ->
let (process, neighbors, _) = List.hd pna_l in
let acts = List.map (fun (p, n, a) -> (
- assert(p = process && n = neighbors); a
+ assert(p == process && n == neighbors); a
)) pna_l
in
- ((process, neighbors), acts)
+ (process.Process.pid, acts)
) actions
-let is_silent (actions: 'v pna list list) =
- actions = [] || List.for_all (fun al -> al = []) (actions)
+let is_silent (actions: process_actions list) =
+ actions = [] || List.for_all (fun (_, al) -> al = []) (actions)
;;
(******************************************************************************)
@@ -42,39 +49,27 @@ let is_silent (actions: 'v pna list list) =
(* Generates a state manager from a state *)
let read (state: 'v SimuState.t) (actions: 'v pna list list option): 'v t =
{
- enables = (match actions with None -> None | Some a -> Some (read_actions a));
- legitimate = (
- match actions with
- | None -> None
- | Some a -> if (is_silent a) then Some true else None
- );
+ enables = (match actions with None -> None | Some a -> (
+ ignore (Some (read_actions a));
+ assert false
+ )
+ );
+ legitimate = None;
state = state;
+ stateof =
+ List.fold_left (fun acc e -> StringMap.add e.Process.pid e acc) StringMap.empty state.network;
potential = None;
rand_state = Random.get_state ();
}
;;
(* Gives the data stored in a state *)
-let get_enables (state_man: 'v t): 'v process_actions list =
+let get_enables (state_man: 'v t): process_actions list =
match state_man.enables with
| Some en -> en
| None ->
- let all_enables, activations = SimuState.get_enable_processes state_man.state in
- let enables = List.fold_left2 (fun accu pna_l bl -> (
- assert (pna_l <> []);
- let (process, neighbors, _) = List.hd pna_l in
- let acts = List.fold_left2 (fun accu (p, n, a) b -> (
- assert(p = process && n = neighbors);
- if (b)
- then a::accu
- else accu
- )) [] pna_l bl
- in
- if (acts = [])
- then accu
- else ((process, neighbors), acts)::accu
- )) [] all_enables activations
- in
+ let all_enables, _ = SimuState.get_enable_processes state_man.state in
+ let enables = read_actions (all_enables) in
state_man.enables <- Some enables;
enables
;;
@@ -88,12 +83,16 @@ let legitimate (state_man: 'v t) =
match state_man.legitimate with
| Some b -> b
| None ->
- let legit = match Register.get_legitimate () with
- | None -> false
- | Some func -> func (List.map (fun p -> p.Process.pid) state_man.state.network) (SimuState.neigbors_of_pid state_man.state)
- in
- state_man.legitimate <- Some legit;
- legit
+ if (is_silent (get_enables state_man))
+ then true
+ else (
+ let legit = match Register.get_legitimate () with
+ | None -> false
+ | Some func -> func (List.map (fun p -> p.Process.pid) state_man.state.network) (SimuState.neigbors_of_pid state_man.state)
+ in
+ state_man.legitimate <- Some legit;
+ legit
+ )
;;
let s_legitimate : 'v saved -> bool = legitimate;;
@@ -119,9 +118,11 @@ let save (state_man: 'v t): 'v saved = state_man;;
(* Restores a saved state *)
let restore (state_man: 'v saved) = Random.set_state state_man.rand_state ;;
-let step (state_man: 'v t) (triggers: 'v proc_chosen_action list) =
+let step (state_man: 'v t) (triggers: proc_chosen_action list) =
restore state_man;
- read (Step.f (List.map (fun ((p,n),a) -> p,n,a) triggers) state_man.state) None
+ read (Step.f (List.map (fun (pid,a) ->
+ (StringMap.find pid state_man.stateof), (StringMap.find pid state_man.state.neighbors), a
+ ) triggers) state_man.state) None
;;
-let s_step : 'v saved -> 'v proc_chosen_action list -> 'v t = step;;
+let s_step : 'v saved -> proc_chosen_action list -> 'v t = step;;
diff --git a/lib/sasacore/daemon.ml b/lib/sasacore/daemon.ml
index 3194e8dacec7ab7e3bac22a00bb1c510e45114d7..d4bf5cac853f94e298469e372dcc74b06eefe1da 100644
--- a/lib/sasacore/daemon.ml
+++ b/lib/sasacore/daemon.ml
@@ -153,7 +153,6 @@ let (f: bool -> bool -> DaemonType.t -> 'v Process.t list ->
| Greedy -> Evil.greedy verbose_mode st pl neigbors_of_pid step nall
| GreedyCentral -> Evil.greedy_central verbose_mode st pl neigbors_of_pid step nall
| Bad i -> Evil.bad i st nall
- (* | Explore expl -> expl verbose_mode st pl neigbors_of_pid step nall *)
| Custom -> assert false
in
get_activate_val al pl, al
diff --git a/lib/sasacore/sasArg.ml b/lib/sasacore/sasArg.ml
index 25ae8bfb29e28d58e0cc3dc738670df7eba5d60b..66b53935544ae07b6bfcc28fb9745fa15ea49f0b 100644
--- a/lib/sasacore/sasArg.ml
+++ b/lib/sasacore/sasArg.ml
@@ -15,6 +15,8 @@ type t = {
mutable dummy_input: bool;
mutable output_algos: bool;
mutable gen_register: bool;
+
+ mutable use_sasaExplore: string;
mutable _args : (string * Arg.spec * string) list;
mutable _user_man : (string * string list) list;
@@ -46,6 +48,7 @@ let (make_args : unit -> t) =
dummy_input = false;
output_algos = false;
gen_register = false;
+ use_sasaExplore = "";
_args = [];
_user_man = [];
_hidden_man = [];
@@ -132,10 +135,9 @@ let (mkoptab : string array -> t -> unit) =
(* ["Use a daemon that tries to maximize the potential function, "; *)
(* "considering sub-graphs of a given maximal size"]; *)
- (* mkopt args ["--explore-daemon";"-expd"] ~arg:" <string>"
- (Arg.String(fun s -> args.daemon <- SasaExplore.Build.get s))
- ["Use the daemon that maximizes the potential function";
- "for the next step (greedy). Performs 2^|enabled| trials) "]; *)
+ mkopt args ["--explore-daemon";"-expd"] ~arg:" <string>"
+ (Arg.String(fun s -> args.use_sasaExplore <- s))
+ [""];
mkopt args ~hide:true ["--rif";"-rif"]
(Arg.Unit(fun () -> args.rif <- true))
diff --git a/lib/sasacore/sasArg.mli b/lib/sasacore/sasArg.mli
index 8dd6466bcd9a224cec096b81849d04ee2f7eb0d0..ca23165f09a7ae4089a9c96dfba14ab0566ca904 100644
--- a/lib/sasacore/sasArg.mli
+++ b/lib/sasacore/sasArg.mli
@@ -15,6 +15,8 @@ type t = {
mutable output_algos: bool;
mutable gen_register: bool;
+ mutable use_sasaExplore: string; (* Empty when not using sasaExplore *)
+
mutable _args : (string * Arg.spec * string) list;
mutable _user_man : (string * string list) list;
mutable _hidden_man: (string * string list) list;
diff --git a/src/dune b/src/dune
index 543ea36c59fed958bb87b69741e97da459456901..bcf5e4055d419aa71354ed295d271099e5e819ca 100644
--- a/src/dune
+++ b/src/dune
@@ -4,7 +4,7 @@
(name sasaMain)
(flags -noassert)
(link_flags (-linkall))
- (libraries dynlink ocamlgraph lutils sasacore algo)
+ (libraries dynlink ocamlgraph lutils sasacore algo sasaExplore)
)
(install
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index 249374939750a761cd084160d0f3552988764e9c..e3c0f800730a98122d03577ed68935e87d72b154 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -141,7 +141,11 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
(* 2: read the actions *)
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
+ let daemon_func = match st.sasarg.use_sasaExplore with
+ | "" -> Daemon.f
+ | s -> SasaExplore.Build.get s
+ in
+ let next_activate_val, pnal = daemon_func st.sasarg.dummy_input
(st.sasarg.verbose >= 1) st.sasarg.daemon st.network (SimuState.neigbors_of_pid st)
st all enab_ll get_action_value Step.f
in
diff --git a/tools/rdbg4sasa/sasa-rdbg-cmds.ml b/tools/rdbg4sasa/sasa-rdbg-cmds.ml
index feaf7726f646076e4f2d2bfd2d7c505cb8b4f818..b89f64ae98c137073f3cf09350a4ee6ee453b828 100644
--- a/tools/rdbg4sasa/sasa-rdbg-cmds.ml
+++ b/tools/rdbg4sasa/sasa-rdbg-cmds.ml
@@ -165,23 +165,23 @@ let sasa_next e =
let next_round e =
next_cond_gen e round sasa_next
-let back_step e =
+(* let back_step e =
let e = rev_cond_gen e (fun ne -> ne.kind = e.kind && ne.name = e.name)
sasa_next restore_round_nb
in
store e.nb;
clean_round_st_tbl e.nb;
e
-
+ *)
(**********************************************************************)
(* redefine (more meaningful) step and back-step for sasa *)
let sasa_step e = next_cond e (fun ne -> ne.kind = e.kind && ne.name = e.name)
let s () = e:=sasa_step !e ; emacs_udate !e; store !e.nb;pe()
-let b () =
+(* let b () =
let ne = back_step !e in
e:=ne ;
emacs_udate !e; store !e.nb;pe()
-
+ *)
let p =
try Topology.read dotfile
with _ -> failwith "This is not a sasa rdbg session!";;