Skip to content

GitLab

Commit 40eece7c authored by erwan's avatar erwan
Browse files

Chore: code refactoring

parent a872f728
Hide whitespace changes
Inline Side-by-side
lib/sasacore/register.ml
View file @ 40eece7c
(* Time-stamp: <modified the 13/10/2020 (at 15:37) by Erwan Jahier> *)
(* Time-stamp: <modified the 07/04/2021 (at 10:16) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
......@@ -30,29 +30,22 @@ type 's internal_tables = {
mutable legitimate: Obj.t;
mutable fault: Obj.t;
mutable actions:action list;
mutable card : int ;
mutable min_deg : int;
mutable mean_deg : float;
mutable max_deg : int;
mutable topology : Topology.t option;
mutable card : int option;
mutable min_deg : int option;
mutable mean_deg : float option;
mutable max_deg : int option;
mutable is_cyclic : bool option;
mutable is_connected : bool option;
mutable is_tree : bool option;
mutable is_directed : bool option;
mutable height : (string -> int);
mutable links_number : int;
mutable diameter : int;
mutable height : (string -> int) option;
mutable sub_tree_size: (string -> int) option;
mutable parent : (string -> int option) option;
mutable links_number : int option;
mutable diameter : int option;
}
type properties_functions = {
mutable card : unit -> int;
mutable min_max : unit -> int*int;
mutable mean_deg : unit -> float;
mutable is_connected_cyclic : unit -> bool*bool;
mutable is_directed : unit -> bool;
mutable links_number : unit -> int;
mutable diameter : unit -> int
}
type node_id = string (* cf topology.mli *)
let (tbls:'s internal_tables) = {
......@@ -67,27 +60,20 @@ let (tbls:'s internal_tables) = {
legitimate = (Obj.repr None);
fault = (Obj.repr None);
actions = [];
card = (-1);
min_deg = (-1);
mean_deg = (-1.);
max_deg = (-1);
topology = None;
card = None;
min_deg = None;
mean_deg = None;
max_deg = None;
is_cyclic = None;
is_connected = None;
is_tree = None;
is_directed = None;
height = (fun _ -> -1);
links_number = (-1);
diameter = (-1)
}
let (prop_funs:properties_functions) = {
card = (fun () -> -1);
min_max = (fun () -> (-1,-1));
mean_deg = (fun () -> -1.);
is_connected_cyclic = (fun () -> (false,false));
is_directed = (fun () -> false);
links_number = (fun () -> -1);
diameter = (fun () -> -1)
height = None;
parent = None;
sub_tree_size =None;
links_number = None;
diameter = None
}
let verbose_level = ref 0
......@@ -96,14 +82,13 @@ exception Unregistred of string * string
let print_table lbl tbl =
let keys = Hashtbl.fold (fun k _ acc -> Printf.sprintf "%s,%s" k acc) tbl "" in
if !verbose_level > 0 then Printf.eprintf "Defined keys for %s: %s\n%!" lbl keys
let (reg_init_state : algo_id -> (int -> string -> 's) -> unit) =
fun algo_id x ->
if !verbose_level > 0 then Printf.eprintf "Registering %s init_vars\n%!" algo_id;
Hashtbl.replace tbls.init_state algo_id (Obj.repr x)
if !verbose_level > 0 then
Printf.eprintf "Registering %s init_vars\n%!" algo_id;
Hashtbl.replace tbls.init_state algo_id (Obj.repr x)
let (get_init_state : algo_id -> int -> string -> 's) =
fun algo_id ->
try Obj.obj (Hashtbl.find tbls.init_state algo_id)
......@@ -111,7 +96,6 @@ let (get_init_state : algo_id -> int -> string -> 's) =
print_table "init_state" tbls.init_state;
raise (Unregistred ("init_state", algo_id))
let (reg_enable : algo_id -> 's enable_fun -> unit) = fun algo_id x ->
if !verbose_level > 0 then Printf.eprintf "Registering %s enable\n%!" algo_id;
Hashtbl.replace tbls.enable algo_id (Obj.repr x)
......@@ -177,7 +161,6 @@ let (get_value_of_string : unit -> (string -> 's) option) = fun () ->
try Some (Obj.obj (Hashtbl.find tbls.value_of_string "_global"))
with Not_found -> None
let (reg_copy_value : ('s -> 's) -> unit) =
fun f ->
if !verbose_level > 0 then Printf.eprintf "Registering copy_value\n%!";
......@@ -190,70 +173,71 @@ let (get_copy_value : unit -> ('s -> 's)) = fun () ->
raise (Unregistred ("copy_value", "_global"))
let set_min_max : (unit -> unit) =
fun () ->
let (x,y) = prop_funs.min_max () in
tbls.min_deg <- x;
tbls.max_deg <- y
let set_connec_cycl : (unit -> unit) =
fun () ->
let (x,y) = prop_funs.is_connected_cyclic () in
tbls.is_connected <- Some x;
tbls.is_cyclic <- Some y
let set_topology g = tbls.topology <- Some g
let get_topology () = match tbls.topology with
| None -> assert false (* SNO if set_topology is called in Main *)
| Some g -> g
let (card : unit -> int) = fun () ->
match tbls.card with
| -1 ->
let c = prop_funs.card () in
tbls.card <- c;
c
| c -> c
| None ->
let x = List.length (get_topology()).nodes in
tbls.card <- Some x;
x
| Some b -> b
let (is_directed : unit -> bool) = fun () ->
match tbls.is_directed with
| None ->
let c = prop_funs.is_directed () in
tbls.is_directed <- Some c;
c
| Some c -> c
let (min_degree : unit -> int) =
fun () -> match tbls.min_deg with
| -1 -> (set_min_max (); tbls.min_deg)
| m -> m
let x = (get_topology()).directed in
tbls.is_directed <- Some x;
x
| Some b -> b
let (mean_degree : unit -> float) = fun () ->
match tbls.mean_deg with
| -1. ->
let m = prop_funs.mean_deg () in
tbls.mean_deg <- m;
m
| m -> m
| None ->
let x = Topology.get_mean_degree (get_topology()) in
tbls.mean_deg <- Some x;
x
| Some b -> b
let (max_degree : unit -> int) =
fun () -> match tbls.max_deg with
| -1 -> (set_min_max (); tbls.max_deg)
| m -> m
let (min_degree : unit -> int) = fun () ->
match tbls.min_deg with
| None ->
let mind,maxd = Topology.get_degree (get_topology()) in
tbls.max_deg <- Some maxd;
tbls.min_deg <- Some mind;
mind
| Some b -> b
let (max_degree : unit -> int) = fun () ->
match tbls.max_deg with
| None ->
let mind,maxd = Topology.get_degree (get_topology()) in
tbls.max_deg <- Some maxd;
tbls.min_deg <- Some mind;
maxd
| Some b -> b
let (is_cyclic : unit -> bool) = fun () ->
match tbls.is_cyclic with
| None ->
set_connec_cycl ();
(match tbls.is_cyclic with
| Some b -> b
| _ -> assert false)
let connect, cyclic = Topology.is_connected_and_cyclic (get_topology()) in
tbls.is_connected <- Some connect;
tbls.is_cyclic <- Some cyclic;
cyclic
| Some b -> b
let (is_connected : unit -> bool) = fun () ->
match tbls.is_connected with
| None -> (
set_connec_cycl ();
match tbls.is_connected with
| Some b -> b
| _ -> assert false)
| None ->
let connect, cyclic = Topology.is_connected_and_cyclic (get_topology()) in
tbls.is_connected <- Some connect;
tbls.is_cyclic <- Some cyclic;
connect
| Some b -> b
let (is_tree : unit -> bool) = fun () ->
match tbls.is_tree with
| None ->
......@@ -262,60 +246,60 @@ let (is_tree : unit -> bool) = fun () ->
b
| Some b -> b
(* Caution : this option is not the same as the option in the type tbls.height.
* If height () = None, then the graph doesn't have a height (because it isn't a tree)*)
let height : (unit -> (string -> int) option) =
exception Not_a_tree
let height : (unit -> string -> int) =
fun () ->
if is_tree () then
Some tbls.height
else None
if is_tree () then (
match tbls.height with
| Some h -> h
| None ->
let h = Topology.get_height (get_topology ()) in
tbls.height <- Some h; h
)
else raise Not_a_tree
let sub_tree_size : (unit -> string -> int) =
fun () ->
if is_tree () then (
match tbls.sub_tree_size with
| Some s -> s
| None ->
let s = Topology.get_sub_tree_size (get_topology ()) in
tbls.sub_tree_size <- Some s; s
)
else raise Not_a_tree
let parent : (unit -> string -> int option) =
fun () ->
if is_tree () then (
match tbls.parent with
| Some p -> p
| None ->
let p = Topology.get_parent (get_topology ()) in
tbls.parent <- Some p; p
)
else raise Not_a_tree
let (links_number : unit -> int) =
fun () ->
match tbls.links_number with
| -1 ->
let n = prop_funs.links_number () in
tbls.links_number <- n;
n
| n -> n
match tbls.links_number with
| Some x -> x
| None ->
let x = Topology.get_nb_link (get_topology ()) in
tbls.links_number <- Some x;
x
let (diameter : unit -> int) =
fun () ->
match tbls.diameter with
| -1 ->
let d = (prop_funs.diameter ()) in
tbls.diameter <- d;
d
| d -> d
let set_card : ((unit -> int) -> unit) =
fun f -> prop_funs.card <- f
let set_is_directed : ((unit -> bool) -> unit) =
fun f -> prop_funs.is_directed <- f
let set_degrees : ((unit -> int*int) -> unit) =
fun f -> prop_funs.min_max <- f
let set_mean_deg : ((unit -> float) -> unit) =
fun f -> prop_funs.mean_deg <- f
let set_is_connected_cyclic : ((unit -> bool*bool) -> unit) =
fun f -> prop_funs.is_connected_cyclic <- f
let set_height : ((node_id -> int) -> unit) =
fun f -> tbls.height <- f
let set_links_number : ((unit -> int) -> unit) =
fun f -> prop_funs.links_number <- f
let set_diameter : ((unit -> int) -> unit) =
fun f -> prop_funs.diameter <- f
| Some x -> x
| None ->
let x = Topology.get_nb_link (get_topology ()) in
tbls.diameter <- Some x;
x
let (to_string : 's -> string) =
fun v ->
(get_value_to_string ()) v
......
Markdown is supported
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