Commit 3b41ed0b authored by erwan's avatar erwan
Browse files

New: add a ligitimate function in the Algo api

Update: add the previous state in argument of the fault function.
parent b69ab053
(* Time-stamp: <modified the 06/07/2020 (at 17:03) by Erwan Jahier> *)
(* Time-stamp: <modified the 07/07/2020 (at 14:41) by Erwan Jahier> *)
open Sasacore
(* Process programmer API *)
......@@ -40,6 +40,8 @@ let (weight : 's neighbor -> int) = fun s -> s.weight ()
type 's enable_fun = 's -> 's neighbor list -> action list
type 's step_fun = 's -> 's neighbor list -> action -> 's
type 's state_init_fun = int -> string -> 's
type 's fault_fun = int -> string -> 's -> 's
type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
type pid = string
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
......@@ -58,7 +60,8 @@ type 's to_register = {
copy_state: 's -> 's;
actions: action list;
potential_function: 's potential_fun option;
fault_function : 's state_init_fun option
legitimate_function : 's legitimate_fun option;
fault_function : 's fault_fun option
}
let (to_reg_neigbor : 's Register.neighbor -> 's neighbor) =
......
(* Time-stamp: <modified the 06/07/2020 (at 17:01) by Erwan Jahier> *)
(* Time-stamp: <modified the 07/07/2020 (at 14:41) by Erwan Jahier> *)
(** {1 The Algorithm programming Interface.} *)
(**
{1 What's need to be provided by users.}
......@@ -81,11 +81,25 @@ val get_graph_attribute : string -> string
(** {1 Potential function }
useful to explore best/worst case daemons
Useful to explore best/worst case daemons
*)
type pid = string
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
(** {1 Legitimate Configurations} *)
type 's legitimate_fun = pid list -> (pid -> 's * 's neighbor list) -> bool
(** By default, legitimate configurations (i.e., global states) are
silent ones. But this is not true for all algorithms. Predicates
of this type are used to redefine what's a legimimate configuration
is. *)
(** {1 Fault Injection} *)
type 's fault_fun = int -> string -> 's -> 's
(** The fault function is called on each node to update their state
each time a legimimate configuration is reached. It takes 3
arguments: the number of node neighbors, the pid, and the value of
the current state. *)
(** {1 Code Registration}
......@@ -105,7 +119,8 @@ type 's to_register = {
copy_state: 's -> 's;
actions : action list (** Mandatory in custom daemon mode, or to use oracles *);
potential_function: 's potential_fun option (** Mandatory with Evil daemons *);
fault_function : 's state_init_fun option (** used when a legitimate configuration is reached *)
legitimate_function : 's legitimate_fun option;
fault_function : 's fault_fun option (** called at legitimate configuration *)
}
(** - For the [state_to_string] field, the idea is to print the raw
values contained in ['s]. If a value is omitted, one won't see it
......
......@@ -49,11 +49,12 @@ let (f: string list -> string * string -> unit) =
copy_state = %s.copy;
actions = %s.actions;
potential_function = %s.potential;
legitimate_function = %s.legitimate;
fault_function = %s.fault;
}
"
(String.concat ";" l)
state_module state_module state_module state_module state_module state_module;
state_module state_module state_module state_module state_module state_module state_module;
flush oc;
close_out oc;
Printf.eprintf " [sasa] The file %s has been generated\n" register_file;
......@@ -70,6 +71,7 @@ let to_string _ = \"define_me\"
let of_string = None
let copy x = x
let potential = None
let legitimate = None
let fault = None
";
flush oc;
......
(* Time-stamp: <modified the 06/07/2020 (at 17:01) by Erwan Jahier> *)
(* Time-stamp: <modified the 07/07/2020 (at 14:46) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
......@@ -16,6 +16,8 @@ type 's step_fun = 's neighbor list -> 's -> action -> 's
type pid = string
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
type 's fault_fun = int -> string -> 's -> 's
type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
type 's internal_tables = {
init_state: (string, Obj.t) Hashtbl.t;
......@@ -26,6 +28,7 @@ type 's internal_tables = {
copy_value : (string, Obj.t) Hashtbl.t;
graph_attributes : (string, string) Hashtbl.t;
mutable potential: Obj.t;
mutable legitimate: Obj.t;
mutable fault: Obj.t;
mutable actions:action list;
mutable card : int ;
......@@ -62,6 +65,7 @@ let (tbls:'s internal_tables) = {
copy_value = Hashtbl.create 1;
graph_attributes = Hashtbl.create 1;
potential = (Obj.repr None);
legitimate = (Obj.repr None);
fault = (Obj.repr None);
actions = [];
card = (-1);
......@@ -135,13 +139,20 @@ let (reg_potential : 's potential_fun option -> unit) = fun x ->
let (get_potential : unit -> 's potential_fun option) = fun () ->
Obj.obj tbls.potential
let (reg_fault : (int -> string -> 's) option -> unit) = fun x ->
let (reg_fault : 's fault_fun option -> unit) = fun x ->
if !verbose_level > 0 then Printf.eprintf "Registering fault function\n%!";
tbls.fault <- (Obj.repr x)
let (get_fault : unit -> (int -> string -> 's) option) = fun () ->
let (get_fault : unit -> 's fault_fun option) = fun () ->
Obj.obj tbls.fault
let (reg_legitimate : 's legitimate_fun option -> unit) = fun x ->
if !verbose_level > 0 then Printf.eprintf "Registering legitimate function\n%!";
tbls.legitimate <- (Obj.repr x)
let (get_legitimate : unit -> 's legitimate_fun option) = fun () ->
Obj.obj tbls.legitimate
let (reg_actions : action list -> unit) =
fun x ->
if !verbose_level > 0 then Printf.eprintf "Registering actions\n%!";
......
(* Time-stamp: <modified the 06/07/2020 (at 17:01) by Erwan Jahier> *)
(* Time-stamp: <modified the 07/07/2020 (at 14:47) by Erwan Jahier> *)
(** This module duplicates and extends the Algo module with get_*
functions.
......@@ -20,16 +20,19 @@ type algo_id = string
type action = string
type 's enable_fun = 's neighbor list -> 's -> action list
type 's step_fun = 's neighbor list -> 's -> action -> 's
type 's fault_fun = int -> string -> 's -> 's
type pid = string
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float
type 's legitimate_fun = string list -> (string -> 's * 's neighbor list) -> bool
val reg_init_state : algo_id -> (int -> string -> 's) -> unit
val reg_enable : algo_id -> 's enable_fun -> unit
val reg_step : algo_id -> 's step_fun -> unit
val reg_potential : 's potential_fun option -> unit
val reg_fault : (int -> string -> 's) option -> unit
val reg_legitimate : 's legitimate_fun option -> unit
val reg_fault : 's fault_fun option -> unit
val reg_actions : action list -> unit
val reg_value_to_string : ('s -> string) -> unit
val reg_value_of_string : (string -> 's) -> unit
......@@ -64,7 +67,8 @@ val get_step : algo_id -> 's step_fun
val get_init_state : algo_id -> int -> string -> 's
val get_actions : unit -> action list
val get_potential : unit -> 's potential_fun option
val get_fault : unit -> (int -> string -> 's) option
val get_legitimate : unit -> 's legitimate_fun option
val get_fault : unit -> 's fault_fun option
val get_value_to_string : unit -> 's -> string
val get_value_of_string : unit -> (string -> 's) option
val get_copy_value : unit -> ('s -> 's)
......
......@@ -5,4 +5,5 @@ let of_string = None
let copy = fun x -> x
let actions = ["C1";"C2"]
let potential = None
let legitimate = None
let fault = None
......@@ -5,4 +5,5 @@ let of_string = Some int_of_string
let copy x = x
let actions = ["a"]
let potential = None
let legitimate = None
let fault = None
......@@ -8,6 +8,7 @@ let of_string = Some int_of_string
let copy = fun x -> x
let actions = ["conflict"]
let potential = None
let legitimate = None
let fault = None
......@@ -5,4 +5,5 @@ let of_string = Some int_of_string
let copy x = x
let actions = ["I(p)"; "R(p)"]
let potential = None
let legitimate = None
let fault = None
......@@ -18,4 +18,5 @@ let (copy : ('v -> 'v)) = fun x -> x
let actions = ["CD";"CP"]
let potential = None
let legitimate = None
let fault = None
......@@ -19,4 +19,5 @@ let print_neighbor =
let actions = ["R0";"R1"]
let potential = None
let legitimate = None
let fault = None
......@@ -18,4 +18,5 @@ let pf pidl get =
float_of_int !clash
let potential = Some pf
let legitimate = None
let fault = None
......@@ -21,4 +21,5 @@ let of_string = None
let copy x = x
let actions = ["update_path";"compute_parent"]
let potential = None
let legitimate = None
let fault = None
......@@ -28,4 +28,5 @@ let (copy : t -> t) =
let of_string = None
let actions = ["update_path";"compute_parent"]
let potential = None
let legitimate = None
let fault = None
......@@ -5,4 +5,5 @@ let of_string = None
let copy x = x
let actions = ["T"]
let potential = None
let legitimate = None
let fault = None
......@@ -5,4 +5,5 @@ let of_string = Some int_of_string
let copy x = x
let actions = ["action1";"action2"]
let potential = None
let legitimate = None
let fault = None
......@@ -19,4 +19,5 @@ let print_neighbor =
let actions = ["R0";"R1";"R2"]
let potential = None
let legitimate = None
let fault = None
......@@ -5,4 +5,5 @@ let of_string = Some int_of_string
let copy x = x
let actions = ["R"]
let potential = None
let legitimate = None
let fault = None
......@@ -5,4 +5,5 @@ let of_string = Some int_of_string
let copy x = x
let actions = ["R";"R1"]
let potential = None
let legitimate = None
let fault = None
......@@ -5,4 +5,5 @@ let of_string = None
let copy x = x
let actions = ["g"]
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