algo.ml 4.23 KB
Newer Older
1
(* Time-stamp: <modified the 06/07/2020 (at 17:03) by Erwan Jahier> *)
erwan's avatar
erwan committed
2

erwan's avatar
erwan committed
3
4
open Sasacore
(* Process programmer API *)
5
type action = string (* just a label *)
erwan's avatar
erwan committed
6

7
type 's neighbor = {
8
9
  pid:  string; 
  spid: string; 
10
  state:  's ;
11
  reply: unit -> int; 
12
  weight: unit -> int; 
erwan's avatar
erwan committed
13
14
}

15
16
17
18
let (_compare_neighbor: 's neighbor -> 's neighbor -> int) =
  fun x y ->
  compare x.pid y.pid

19
let (print_neighbor: 's neighbor -> unit) =
20
  fun n -> Format.print_string n.pid
21
22
23
      
let (fmt_print_neighbor: Format.formatter -> 's neighbor -> unit) =
  fun fmt n ->
24
  Format.pp_print_string fmt n.pid 
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

(** processes local state (user defined) *) 
let (state : 's neighbor -> 's) = fun s -> s.state

(** Returns the channel number that let this neighbor access to the
   content of the process, if it neighbor can access it.  Returns -1
   if the neigbor can not access to the process, which may happen in
   directed graphs only.  This info is not available in all
   simulation modes. *)
let (reply : 's neighbor -> int) = fun s -> s.reply ()
                
(** Makes sense in directed graphs only *)
let (weight : 's neighbor -> int) = fun s -> s.weight ()
                    

40
41
type 's enable_fun = 's -> 's neighbor list -> action list
type 's step_fun   = 's -> 's neighbor list -> action -> 's
42
type 's state_init_fun = int -> string -> 's
erwan's avatar
erwan committed
43

44
type pid = string
45
type 's pf_info = { neighbors: 's neighbor list; curr: 's ; next: 's; action: action }
46
47
type 's potential_fun = pid list -> (pid -> 's pf_info) -> float

48
49
type 's algo_to_register = {
  algo_id: string;
50
  init_state: 's state_init_fun;
51
  enab: 's enable_fun;
52
  step: 's step_fun
53
54
55
56
}
type 's to_register = {
  algo : 's algo_to_register list;
  state_to_string: 's -> string;
57
  state_of_string: (string -> 's) option;
58
  copy_state: 's -> 's;
59
  actions: action list;
60
61
  potential_function: 's potential_fun option;
  fault_function : 's state_init_fun option 
62
63
}

erwan's avatar
erwan committed
64
65
66
67
let (to_reg_neigbor : 's Register.neighbor -> 's neighbor) =
  fun n ->
    {
      state = n.Register.state ;
68
      pid = n.Register.pid;
erwan's avatar
erwan committed
69
      spid = n.Register.spid;
erwan's avatar
erwan committed
70
      reply = n.Register.reply; 
71
      weight = n.Register.weight; 
erwan's avatar
erwan committed
72
73
    } 

74
75
76
let (to_reg_info : 's Register.pf_info -> 's pf_info) =
  fun pfi ->
  {
77
    neighbors = List.map to_reg_neigbor pfi.Register.neighbors ;
78
79
    curr = pfi.Register.curr ;
    next = pfi.Register.next ;
80
    action = pfi.Register.action 
81
82
83
  }

  
erwan's avatar
erwan committed
84
85
86
let (to_reg_enable_fun : 's enable_fun ->
     's Register.neighbor list -> 's -> action list) =
  fun f nl s ->
87
    f s (List.map to_reg_neigbor nl)
erwan's avatar
erwan committed
88
89
90
91
  
let (to_reg_step_fun : 's step_fun ->
     's Register.neighbor list -> 's -> action -> 's) =
  fun f nl s a ->
92
    f s (List.map to_reg_neigbor nl) a
erwan's avatar
erwan committed
93
  
94
95
96
97
98
let (to_reg_potential_fun :
       's potential_fun -> pid list -> (pid -> 's Register.pf_info) -> float) =
  fun pf pidl f ->
  let nf pid = to_reg_info (f pid) in
  pf pidl nf
99

100
101
let (register1 : 's algo_to_register -> unit) =
  fun s ->
erwan's avatar
erwan committed
102
103
104
    Register.reg_enable     s.algo_id (to_reg_enable_fun s.enab);
    Register.reg_step       s.algo_id (to_reg_step_fun s.step);
    Register.reg_init_state s.algo_id s.init_state;
105
    ()
106
      
107
let registered = ref false
108
(* exported *)
109
110
let (register : 's to_register -> unit) =
  fun s ->
111
112
    if !registered then failwith "Register can only be called once!";
    registered := true;
erwan's avatar
erwan committed
113
114
    Register.reg_value_to_string s.state_to_string;
    Register.reg_copy_value s.copy_state;
115
    List.iter register1 s.algo;
116
    (match s.state_of_string with None -> () | Some f -> Register.reg_value_of_string f);
117
    Register.reg_actions s.actions;
118
119
120
121
    (match s.potential_function with
     | None -> ()
     | Some pf -> Register.reg_potential (Some (to_reg_potential_fun pf))
    );
122
123
124
125
    (match s.fault_function with
     | None -> ()
     | Some ff -> Register.reg_fault (Some ff)
    );
126
    ()
127

erwan's avatar
erwan committed
128
let card = Register.card
129
let get_graph_attribute = Register.get_graph_attribute                           
130
let min_degree = Register.min_degree
131
let mean_degree = Register.mean_degree
132
let max_degree = Register.max_degree
133
134
let is_cyclic = Register.is_cyclic
let is_connected = Register.is_connected
135
let is_directed = Register.is_directed
136
137
138
let is_tree = Register.is_tree
let height = Register.height
let links_number = Register.links_number
139
let diameter = Register.diameter
140
141
142
143
144
145


(*
let pid n = n.pid
let spid n = n.spid
*)