From 40eece7cdb14c6fd1968c2a4c2c119d6905bd0e0 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 8 Apr 2021 15:08:16 +0200
Subject: [PATCH] Chore: code refactoring
---
lib/sasacore/register.ml | 248 ++++++++++++++++++---------------------
1 file changed, 116 insertions(+), 132 deletions(-)
diff --git a/lib/sasacore/register.ml b/lib/sasacore/register.ml
index 2c646c47..e92a5b32 100644
--- a/lib/sasacore/register.ml
+++ b/lib/sasacore/register.ml
@@ -1,4 +1,4 @@
-(* 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
--
GitLab