From 4280ff1404523303233575717d5a06a0ab9e6801 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Fri, 6 Mar 2020 13:38:52 +0100
Subject: [PATCH] Breaking: remove Algo.pid and Algo.spid, and add the pid in
the init function
The rationale is that the Algo.spid that gave processes access to
their pid via their neighbors was a bit weird. Also, it makes the anonymity
of the algorithm more explicit: an access to the pid could appear anywhere
in the program, while now, the pid must be in state.t!
Now, if the user needs the pid, he must store it explicitly in the
state via the initialization function.
---
lib/algo/algo.ml | 34 +++++++++++------------
lib/algo/algo.mli | 51 ++++++++++++----------------------
lib/sasacore/daemon.ml | 4 +--
lib/sasacore/genRegister.ml | 2 +-
lib/sasacore/main.ml | 15 +++++-----
lib/sasacore/register.ml | 10 +++----
lib/sasacore/register.mli | 10 +++----
lib/sasacore/sasaState.ml | 4 ++-
lib/sasacore/stringOf.ml | 2 +-
test/alea-coloring/p.ml | 6 ++--
test/async-unison/p.ml | 4 +--
test/bfs-spanning-tree/p.ml | 8 +++---
test/bfs-spanning-tree/root.ml | 6 ++--
test/bfs-st-HC92/p.ml | 27 ++++++------------
test/bfs-st-HC92/root.ml | 6 ++--
test/bfs-st-HC92/state.ml | 3 +-
test/coloring/p.ml | 12 ++------
test/dfs-list/p.ml | 6 ++--
test/dfs-list/root.ml | 6 ++--
test/dfs/p.ml | 6 ++--
test/dfs/root.ml | 6 ++--
test/dijkstra-ring/p.ml | 8 +++---
test/dijkstra-ring/root.ml | 8 +++---
test/skeleton/p.ml | 6 ++--
test/st-CYH91/p.ml | 32 ++++++++-------------
test/st-CYH91/root.ml | 8 +++---
test/st-CYH91/state.ml | 5 ++--
test/st-KK06-algo1/p.ml | 6 ++--
test/st-KK06-algo1/root.ml | 6 ++--
test/st-KK06-algo2/p.ml | 6 ++--
test/st-KK06-algo2/root.ml | 6 ++--
test/unison/unison.ml | 6 ++--
32 files changed, 143 insertions(+), 182 deletions(-)
diff --git a/lib/algo/algo.ml b/lib/algo/algo.ml
index c7cccb69..58b381a8 100644
--- a/lib/algo/algo.ml
+++ b/lib/algo/algo.ml
@@ -1,37 +1,31 @@
-(* Time-stamp: <modified the 05/03/2020 (at 17:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 10:20) by Erwan Jahier> *)
open Sasacore
(* Process programmer API *)
type action = string (* just a label *)
type 's neighbor = {
+ pid: string;
+ spid: string;
state: 's ;
- pid: unit -> string;
- spid: unit -> string;
reply: unit -> int;
weight: unit -> int;
}
+let (_compare_neighbor: 's neighbor -> 's neighbor -> int) =
+ fun x y ->
+ compare x.pid y.pid
+
let (print_neighbor: 's neighbor -> unit) =
- fun n -> Format.print_string (n.pid ())
+ fun n -> Format.print_string n.pid
let (fmt_print_neighbor: Format.formatter -> 's neighbor -> unit) =
fun fmt n ->
- Format.pp_print_string fmt (n.pid ())
-
-exception Not_available of string
+ Format.pp_print_string fmt n.pid
(** processes local state (user defined) *)
let (state : 's neighbor -> 's) = fun s -> s.state
-(** This pid is not available in all simulation modes (e.g.,
- anonymous) *)
-let (pid : 's neighbor -> string) = fun s -> s.pid ()
-
-
-(* spid (self-pid) of the process this neighbor is the neighbor of *)
-let (spid : 's neighbor -> string) = fun s -> s.spid ()
-
(** 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
@@ -45,11 +39,11 @@ 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 -> 's
+type 's state_init_fun = int -> string -> 's
type 's algo_to_register = {
algo_id: string;
- init_state: int -> 's;
+ init_state: 's state_init_fun;
enab: 's enable_fun;
step: 's step_fun
}
@@ -116,3 +110,9 @@ let is_tree = Register.is_tree
let height = Register.height
let links_number = Register.links_number
let diameter = Register.diameter
+
+
+(*
+let pid n = n.pid
+let spid n = n.spid
+*)
diff --git a/lib/algo/algo.mli b/lib/algo/algo.mli
index a4bc6245..8d9a5d17 100644
--- a/lib/algo/algo.mli
+++ b/lib/algo/algo.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/03/2020 (at 14:47) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 10:19) by Erwan Jahier> *)
(** {1 The Algorithm programming Interface.} *)
(**
{1 What's need to be provided by users.}
@@ -29,41 +29,28 @@ type 's step_fun = 's -> 's neighbor list -> action -> 's
various information thanks to the functions below.
*)
-type 's state_init_fun = int -> 's
+type 's state_init_fun = int -> string -> 's
(** The initial value of the local state can be set using an
- initialization function that takes as unique argument the number of
- neighbors of the node. *)
+ initialization function that takes as input 2 arguments: the number
+ of node neighbors, and the pid. Anonymous algorithms are not
+ supposed to use the pid. *)
-(** When an information can not be accessed (e.g., the pid anonymous
- networks) the Not_available exception is raised. *)
-exception Not_available of string
-
(** Returns the processes local state *)
val state : 's neighbor -> 's
-(** Returns the process id of the current process neighbor. This info
- is not available in all simulation modes. *)
-val pid : 's neighbor -> string
-
-(** Returns the process id of the current process
-
- “To see ourselves as others see us is a most salutary gift. Hardly
- less important is the capacity to see others as they see
- themselves.†― Aldous Huxley, The Doors of Perception.
- *)
-val spid : 's neighbor -> string
+(** Returns the channel number, that let this neighbor access to the
+ content of the current process, if its neighbor can access it. The
+ channel number is the rank,starting at 0, in the neighbors' list.
+ Returns -1 if the neighbor can not access to the process, which may
+ happen in directed graphs.
-(** Returns the channel number that let this neighbor access to the
- content of the process, if its neighbor can access it. Returns -1
- if the neighbor can not access to the process, which may happen in
- directed graphs only. This info is not available in all simulation
- modes. An algorithm that can access to the reply, and not the spid is
- called semi-anonymous. It is called anonymous if it can access none. *)
+ An algorithm that uses reply, and not the pid, is called
+ semi-anonymous. It is called anonymous if it can access none. *)
val reply : 's neighbor -> int
-(** Returns the weight of the edge between the current node and its neighbor.
- Note that "weight" is an edge (dot) attribute.
- *)
+(** Returns the weight of the edge from the current node to the
+ neighbor. Note that "weight" is an edge (dot) attribute. 1 is
+ returned if not weight is set in the graph. *)
val weight : 's neighbor -> int
val print_neighbor: 's neighbor -> unit
@@ -118,10 +105,8 @@ type 's to_register = {
- For the [state_of_string] field, if some function is provided,
sasa should be able to parse state init values in the dot.
-
*)
-
(** To be called once *)
val register : 's to_register -> unit
@@ -158,8 +143,8 @@ val register : 's to_register -> unit
(2) All the algos mentioned in the dot file should define the
following functions:
{[
- let (init_state: int -> State.t) = xxx
- let (enable_f: State.t neighbor list -> State.t -> action list) = xxx
- let (step_f : State.t neighbor list -> State.t -> action -> State.t ) = xxx
+ let (init_state: int -> string -> State.t) = finishme
+ let (enable_f: State.t neighbor list -> State.t -> action list) = finishme
+ let (step_f : State.t neighbor list -> State.t -> action -> State.t ) = finishme
]}
*)
diff --git a/lib/sasacore/daemon.ml b/lib/sasacore/daemon.ml
index 2fa1faaf..078d558d 100644
--- a/lib/sasacore/daemon.ml
+++ b/lib/sasacore/daemon.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 22/01/2020 (at 10:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 10:03) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
@@ -57,7 +57,7 @@ let (locally_central: 'v pna list list -> 'v pna list) =
let rec remove_conflicts al =
let activated_pids = List.map (fun (p,_,_) -> p.Process.pid) al in
let conflicts, ok = List.partition (fun (_p,nl,_a) ->
- List.exists (fun n -> List.mem (n.Register.pid ()) activated_pids) nl
+ List.exists (fun n -> List.mem (n.Register.pid) activated_pids) nl
) al
in
if conflicts = [] then ok else
diff --git a/lib/sasacore/genRegister.ml b/lib/sasacore/genRegister.ml
index 10c6c849..fd5ac0c6 100644
--- a/lib/sasacore/genRegister.ml
+++ b/lib/sasacore/genRegister.ml
@@ -8,7 +8,7 @@ the following interface:
val name: string
val actions : string list;
type state
- val init_state: int -> state
+ val init_state: int -> string -> state
val enable_f: state Algo.neighbor list -> state -> Algo.action list
val step_f : state Algo.neighbor list -> state -> Algo.action -> state
val state_to_string: state -> string
diff --git a/lib/sasacore/main.ml b/lib/sasacore/main.ml
index 39797082..0ea29b1b 100644
--- a/lib/sasacore/main.ml
+++ b/lib/sasacore/main.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/02/2020 (at 17:13) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 13:22) by Erwan Jahier> *)
open Register
@@ -30,10 +30,8 @@ let (get_neighors: Topology.t -> Topology.node_id -> 'v -> 'v Register.neighbor
let node = g.of_id neighbor_id in
{
state = init;
- (* XXX For the 2 fields above, check the graph kind (anonymous,
- identified, etc. *)
- pid = (fun () -> node.id);
- spid = (fun () -> source_id);
+ pid = node.id;
+ spid = source_id;
reply = (fun () -> reply g source_id neighbor_id);
weight = (fun () -> w)
}
@@ -57,7 +55,7 @@ open SasArg
let (update_neighbor_env: 'v Env.t -> 'v Register.neighbor -> 'v Register.neighbor) =
fun e n ->
- { n with state = Env.get_copy e (n.Register.pid ()) }
+ { n with state = Env.get_copy e n.Register.pid }
type 'v layout = ('v Process.t * 'v Register.neighbor list) list
@@ -129,7 +127,8 @@ let (get_outputs_rif_decl: SasArg.t -> 'v Process.t list -> (string * string) li
List.fold_left
(fun acc p ->
List.fold_left
- (fun acc a -> ((Printf.sprintf "%s_%s" p.pid (StringOf.action a)),"bool")::acc)
+ (fun acc a ->
+ ((Printf.sprintf "%s_%s" p.pid (StringOf.action a)),"bool")::acc)
acc
p.actions
)
@@ -236,7 +235,7 @@ let (make : bool -> string array -> 'v t) =
let algo_id = Filename.chop_suffix n.Topology.file ".ml" in
let value_of_string_opt = Register.get_value_of_string () in
if value_of_string_opt = None || n.Topology.init = "" then
- Register.get_init_state algo_id (List.length (g.succ n.id))
+ Register.get_init_state algo_id (List.length (g.succ n.id)) n.id
else
match value_of_string_opt with
| None -> assert false (* sno *)
diff --git a/lib/sasacore/register.ml b/lib/sasacore/register.ml
index f6f4da66..97945a21 100644
--- a/lib/sasacore/register.ml
+++ b/lib/sasacore/register.ml
@@ -1,9 +1,9 @@
-(* Time-stamp: <modified the 05/03/2020 (at 17:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 10:20) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
- pid: unit -> string;
- spid: unit -> string;
+ pid: string;
+ spid: string;
reply: unit -> int;
weight: unit -> int;
}
@@ -87,13 +87,13 @@ let print_table lbl tbl =
if !verbose_level > 0 then Printf.eprintf "Defined keys for %s: %s\n%!" lbl keys
-let (reg_init_state : algo_id -> (int -> 's) -> unit) =
+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)
-let (get_init_state : algo_id -> int -> 's) =
+let (get_init_state : algo_id -> int -> string -> 's) =
fun algo_id ->
try Obj.obj (Hashtbl.find tbls.init_state algo_id)
with Not_found ->
diff --git a/lib/sasacore/register.mli b/lib/sasacore/register.mli
index 7c5c541f..23a67d67 100644
--- a/lib/sasacore/register.mli
+++ b/lib/sasacore/register.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/03/2020 (at 17:15) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 10:20) by Erwan Jahier> *)
(** This module duplicates and extends the Algo module with get_*
functions.
@@ -10,8 +10,8 @@
type 's neighbor = {
state: 's ;
- pid: unit -> string;
- spid: unit -> string;
+ pid: string;
+ spid: string;
reply: unit -> int;
weight: unit -> int;
}
@@ -22,7 +22,7 @@ type 's enable_fun = 's neighbor list -> 's -> action list
type 's step_fun = 's neighbor list -> 's -> action -> 's
-val reg_init_state : algo_id -> (int -> 's) -> unit
+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_actions : action list -> unit
@@ -56,7 +56,7 @@ val get_graph_attribute : string -> string
val get_enable : algo_id -> 's enable_fun
val get_step : algo_id -> 's step_fun
-val get_init_state : algo_id -> int -> 's
+val get_init_state : algo_id -> int -> string -> 's
val get_actions : unit -> action list
val get_value_to_string : unit -> 's -> string
val get_value_of_string : unit -> (string -> 's) option
diff --git a/lib/sasacore/sasaState.ml b/lib/sasacore/sasaState.ml
index 371cde9d..bdb8ef17 100644
--- a/lib/sasacore/sasaState.ml
+++ b/lib/sasacore/sasaState.ml
@@ -9,6 +9,8 @@
type pid = string
type data_or_name = Data of Data.v * Data.t | Name of string
+
+
let (string_to_data : string -> data_or_name) =
fun str ->
match int_of_string_opt str with
@@ -20,7 +22,7 @@ let (string_to_data : string -> data_or_name) =
match str with
| "true" | "True" | "t" | "T" -> Data (Data.B true, Data.Bool)
| "false" | "False" | "f" | "F" -> Data (Data.B false, Data.Bool)
- | _ -> Name str
+ | _ -> Data (Data.Str(str), Data.String)
)
)
diff --git a/lib/sasacore/stringOf.ml b/lib/sasacore/stringOf.ml
index 0e764e27..42d1c69d 100644
--- a/lib/sasacore/stringOf.ml
+++ b/lib/sasacore/stringOf.ml
@@ -3,7 +3,7 @@
open Register
let (algo_neighbor : 'v Register.neighbor -> string) = fun n ->
- Printf.sprintf "%s (%s)" (n.pid()) (Register.to_string n.state)
+ Printf.sprintf "%s (%s)" n.pid (Register.to_string n.state)
open Process
let (env: 'v Env.t -> 'v Process.t list -> string) =
diff --git a/test/alea-coloring/p.ml b/test/alea-coloring/p.ml
index 2b8bc118..c7fb2513 100644
--- a/test/alea-coloring/p.ml
+++ b/test/alea-coloring/p.ml
@@ -1,10 +1,10 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:52) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:08) by Erwan Jahier> *)
open Algo
-let k=3
+let k=max_degree ()
-let (init_state: int -> 'v) = fun _i -> Random.int k
+let (init_state: int -> string -> 'v) = fun _i _ -> Random.int k
let (clash : 'v neighbor list -> 'v list) = fun nl ->
let res = List.map (fun n -> state n) nl in
diff --git a/test/async-unison/p.ml b/test/async-unison/p.ml
index 5732096e..d48ddc0a 100644
--- a/test/async-unison/p.ml
+++ b/test/async-unison/p.ml
@@ -1,11 +1,11 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:53) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 20:33) by Erwan Jahier> *)
open Algo
let n = Algo.card()
let k = n * n + 1
-let (init_state: int state_init_fun) = fun _n -> (Random.int k)
+let (init_state: int state_init_fun) = fun _n _ -> (Random.int k)
let modulo x n = if x < 0 then n+x mod n else x mod n
diff --git a/test/bfs-spanning-tree/p.ml b/test/bfs-spanning-tree/p.ml
index e32866e2..416f9060 100644
--- a/test/bfs-spanning-tree/p.ml
+++ b/test/bfs-spanning-tree/p.ml
@@ -1,15 +1,15 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:53) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:40) by Erwan Jahier> *)
(* This is algo 5.4 in the book *)
open Algo
open State
-let (init_state: int -> 'v) =
- fun i ->
+let (init_state: int -> string -> 'v) =
+ fun i _ ->
{
d = Random.int d;
- par = Random.int i;
+ par = Random.int i
}
diff --git a/test/bfs-spanning-tree/root.ml b/test/bfs-spanning-tree/root.ml
index 56d25f2f..dc0aea30 100644
--- a/test/bfs-spanning-tree/root.ml
+++ b/test/bfs-spanning-tree/root.ml
@@ -1,12 +1,12 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:54) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:41) by Erwan Jahier> *)
(* This is algo 5.3 in the book *)
open Algo
open State
-let (init_state: int -> State.t) =
- fun i ->
+let (init_state: int -> string -> State.t) =
+ fun i _ ->
{
d = Random.int d;
par = -1;
diff --git a/test/bfs-st-HC92/p.ml b/test/bfs-st-HC92/p.ml
index 00149e0a..679f43b3 100644
--- a/test/bfs-st-HC92/p.ml
+++ b/test/bfs-st-HC92/p.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:54) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 10:12) by Erwan Jahier> *)
(* A self-stabilizing algorithm for constructing breadth-first trees
Shing-Tsaan Huang, Nian-Shing Chen
@@ -7,14 +7,14 @@ Information Processing Letters 41(1992) 109-117 14 February 1992
Hyp:
- distributed daemon
- connected un-directed graph
-
+- anonymous
*)
open Algo
open State
-let (init_state: int -> 'st) =
- fun i ->
+let (init_state: int -> string -> 'st) =
+ fun i _ ->
{
level = 2+Random.int (n-1);
par = Random.int i;
@@ -46,29 +46,18 @@ let (enable_f: 'st -> 'st neighbor list -> action list) =
l_p > level k
then ["R1"] else
[]
-
-let rank k l = (* returns the rank of k in l *)
- let rec aux i l =
- match l with
- | x::t -> if pid x = pid k then i else aux (i+1) t
- | [] ->
- Printf.eprintf "rank called with an element that is not in the list!\n%!";
- exit 2
- in
- aux 0 l
let (step_f : 'st -> 'st neighbor list -> action -> 'st ) =
fun e nl a ->
- (* Printf.printf "step_f [%s]\n%!" a; *)
match a with
| "R0" -> { e with level = 1 + par_level nl e }
| "R1" ->
- let k = List.fold_left
- (fun acc n -> if level acc < level n then acc else n)
- (List.hd nl)
+ let k, rank, _ = List.fold_left
+ (fun (k,rank,i) n -> if level k < level n then k,rank,i+1 else n,i,i+1)
+ (List.hd nl, 0, 1)
(List.tl nl)
in
- { level = 1 + level k ; par = rank k nl }
+ { level = 1 + level k ; par = rank }
| _ -> e
diff --git a/test/bfs-st-HC92/root.ml b/test/bfs-st-HC92/root.ml
index a6b39842..de6a8aa0 100644
--- a/test/bfs-st-HC92/root.ml
+++ b/test/bfs-st-HC92/root.ml
@@ -1,7 +1,7 @@
-(* Time-stamp: <modified the 06/02/2020 (at 14:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 09:51) by Erwan Jahier> *)
-let (init_state: int -> 'st) =
- fun i ->
+let (init_state: int -> string -> 'st) =
+ fun _i _ ->
{
State.level = 0;
State.par = -1;
diff --git a/test/bfs-st-HC92/state.ml b/test/bfs-st-HC92/state.ml
index 799f097e..72ea8d1b 100644
--- a/test/bfs-st-HC92/state.ml
+++ b/test/bfs-st-HC92/state.ml
@@ -5,7 +5,8 @@ type t = { level: int; par:int }
let to_string = (fun s -> Printf.sprintf "level=%i par=%i" s.level s.par)
let of_string = Some
(fun s ->
- Scanf.sscanf s "{level=%d;par=%d}" (fun d par -> { level = d; par = par}))
+ Scanf.sscanf s "{level=%d;par=%d}"
+ (fun d par -> { level = d; par = par }))
let copy x = x
diff --git a/test/coloring/p.ml b/test/coloring/p.ml
index a89e490a..6bfb45cc 100644
--- a/test/coloring/p.ml
+++ b/test/coloring/p.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:54) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:09) by Erwan Jahier> *)
(* This is algo 3.1 in the book *)
@@ -6,7 +6,7 @@ open Algo
let k=max_degree ()
-let (init_state: int -> 'v) = fun _i -> Random.int k
+let (init_state: int -> string -> 'v) = fun _i _ -> Random.int k
let verbose = false
let (state_to_string: ('v -> string)) = string_of_int
@@ -18,15 +18,7 @@ let (neigbhors_values : 'v neighbor list -> 'v list) =
let (clash : 'v -> 'v neighbor list -> bool) = fun v nl ->
let vnl = neigbhors_values nl in
- let inl = List.map (fun n -> pid n) nl in
let res = List.mem v vnl in
- if verbose then (
- Printf.printf "%s %s in [%s] (%s)\n" (state_to_string v)
- (if res then "" else "not")
- (String.concat "," (List.map state_to_string vnl))
- (String.concat "," (inl));
- flush stdout
- );
res
let (free : 'v neighbor list -> 'v list) = fun nl ->
diff --git a/test/dfs-list/p.ml b/test/dfs-list/p.ml
index 2d657153..e7c178f4 100644
--- a/test/dfs-list/p.ml
+++ b/test/dfs-list/p.ml
@@ -1,12 +1,12 @@
-(* Time-stamp: <modified the 26/02/2020 (at 16:04) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:27) by Erwan Jahier> *)
(* cf Collin-Dolex-94 *)
open Algo
open State
-let (init_state: int -> 'v) =
- fun i ->
+let (init_state: int -> string -> 'v) =
+ fun i _ ->
{
path = [-1]; (* XXX put random values here too! *)
par = try Random.int i with _ -> assert false
diff --git a/test/dfs-list/root.ml b/test/dfs-list/root.ml
index 6ee63f32..4cd61965 100644
--- a/test/dfs-list/root.ml
+++ b/test/dfs-list/root.ml
@@ -1,12 +1,12 @@
-(* Time-stamp: <modified the 25/02/2020 (at 17:20) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:28) by Erwan Jahier> *)
(* cf Collin-Dolex-94 *)
open Algo
open State
-let (init_state: int -> 'v) =
- fun i ->
+let (init_state: int -> string -> 'v) =
+ fun i _ ->
{
path = [-1];
par = -10
diff --git a/test/dfs/p.ml b/test/dfs/p.ml
index fc868b04..483d5c8a 100644
--- a/test/dfs/p.ml
+++ b/test/dfs/p.ml
@@ -1,12 +1,12 @@
-(* Time-stamp: <modified the 26/02/2020 (at 16:41) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:43) by Erwan Jahier> *)
(* cf Collin-Dolex-94 *)
open Algo
open State
-let (init_state: int -> State.t ) =
- fun i ->
+let (init_state: int -> string -> State.t) =
+ fun i _ ->
{
path = Array.make delta (-1) (* XXX put random values here too! *);
par = try Random.int i with _ -> assert false
diff --git a/test/dfs/root.ml b/test/dfs/root.ml
index baaa6c9b..8f398c3e 100644
--- a/test/dfs/root.ml
+++ b/test/dfs/root.ml
@@ -1,12 +1,12 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:43) by Erwan Jahier> *)
(* cf Collin-Dolex-94 *)
open Algo
open State
-let (init_state: int -> State.t ) =
- fun i ->
+let (init_state: int -> string -> State.t) =
+ fun i _ ->
{
path = Array.make delta (-1);
par = -10
diff --git a/test/dijkstra-ring/p.ml b/test/dijkstra-ring/p.ml
index 30d641d9..9fd4c769 100644
--- a/test/dijkstra-ring/p.ml
+++ b/test/dijkstra-ring/p.ml
@@ -1,11 +1,11 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:31) by Erwan Jahier> *)
open Algo
-let k = 42
+let k = card()
-let (init_state: int -> 's) =
- fun _ ->
+let (init_state: int -> string -> 's) =
+ fun _ _ ->
(* let k = (card() - 1) in *)
(* let _ = assert (k > 0) in *)
Random.int k
diff --git a/test/dijkstra-ring/root.ml b/test/dijkstra-ring/root.ml
index 9b863dd1..27a0805e 100644
--- a/test/dijkstra-ring/root.ml
+++ b/test/dijkstra-ring/root.ml
@@ -1,11 +1,11 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:31) by Erwan Jahier> *)
open Algo
-let k = 42
+let k = card()
-let (init_state: int -> 's) =
- fun _n ->
+let (init_state: int -> string -> 's) =
+ fun _n _ ->
(* let k = (card() - 1) in *)
(* let _ = assert (k > 0) in *)
Random.int k
diff --git a/test/skeleton/p.ml b/test/skeleton/p.ml
index 8e2b7527..cf5a61d9 100644
--- a/test/skeleton/p.ml
+++ b/test/skeleton/p.ml
@@ -1,11 +1,11 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 20:32) by Erwan Jahier> *)
(* a dumb algo *)
open Algo
-let (init_state: int -> 'st) =
- fun _nl -> (Random.int 10)
+let (init_state: int -> string -> 'st) =
+ fun _nl _ -> (Random.int 10)
let (enable_f: 'st -> 'st neighbor list -> action list) =
diff --git a/test/st-CYH91/p.ml b/test/st-CYH91/p.ml
index 65c5eb88..76d01951 100644
--- a/test/st-CYH91/p.ml
+++ b/test/st-CYH91/p.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/02/2020 (at 17:18) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 09:45) by Erwan Jahier> *)
(* "A self-stabilizing algorithm for constructing spanning trees"
Nian-Shing Chen, Wey-Pyng Yu and Shing-Tsaan Huang
@@ -13,8 +13,8 @@ Hyp:
open Algo
open State
-let (init_state: int -> 'st) =
- fun i ->
+let (init_state: int -> string -> 'st) =
+ fun i _ ->
{
level = Random.int n;
par = Random.int i;
@@ -42,19 +42,7 @@ let (enable_f: 'st -> 'st neighbor list -> action list) =
List.exists (fun k -> l_i=n && (state k).level<n-1) nl
then ["R2"] else
[]
-
-let rank k l = (* returns the rank of k in l *)
- let rec aux i l =
- match l with
- | x::t -> if pid x = pid k then i else aux (i+1) t
- | [] ->
- Printf.eprintf "rank called with an element that is not in the list!\n%!";
- exit 2
- in
- aux 0 l
-
-let (printn : 'st neighbor -> unit) =
- fun n -> print_string (Algo.pid n)
+
let (step_f : 'st -> 'st neighbor list -> action -> 'st ) =
fun e nl a ->
@@ -64,10 +52,14 @@ let (step_f : 'st -> 'st neighbor list -> action -> 'st ) =
| "R1" -> { e with level = n }
| "R2" ->
let l_i = e.level in
- let k = List.hd (* we take the first neighbor satisfying the condition *)
- (List.filter (fun k -> l_i=n && (state k).level<n-1) nl)
- in
- { level = (state k).level+1; par = rank k nl }
+ let cond k = l_i=n && (state k).level<n-1 in
+ let rec find_neighbor i = function
+ (* returns the first neighbor satisfying cond (and its rank) *)
+ | [] -> assert false
+ | k::t -> if cond k then i,k else find_neighbor (i+1) t
+ in
+ let parent,k = find_neighbor 0 nl in
+ { level = (state k).level+1; par = parent }
| _ -> e
diff --git a/test/st-CYH91/root.ml b/test/st-CYH91/root.ml
index 8cd3f53d..3d3bb454 100644
--- a/test/st-CYH91/root.ml
+++ b/test/st-CYH91/root.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 06/03/2020 (at 09:43) by Erwan Jahier> *)
(* "A self-stabilizing algoritm for constructing spanning trees"
Nian-Shing Chen, Wey-Pyng Yu and Shing-Tsaan Huang
@@ -10,11 +10,11 @@ Hyp:
*)
-let (init_state: int -> 'st) =
- fun i ->
+let (init_state: int -> string -> 'st) =
+ fun i _ ->
{
State.level = 0;
- State.par = -1;
+ State.par = -1
}
(* The root is never enabled... *)
diff --git a/test/st-CYH91/state.ml b/test/st-CYH91/state.ml
index 8ab59c0f..49ab0241 100644
--- a/test/st-CYH91/state.ml
+++ b/test/st-CYH91/state.ml
@@ -1,11 +1,12 @@
let n = Algo.card()
-type t = { level: int; par:int }
+type t = { level:int; par:int }
let to_string = (fun s -> Printf.sprintf "level=%i par=%i" s.level s.par)
let of_string = Some
(fun s ->
- Scanf.sscanf s "{level=%d;par=%d}" (fun d par -> { level = d; par = par}))
+ Scanf.sscanf s "{level=%d;par=%d}"
+ (fun d par -> { level = d; par = par }))
let copy x = x
diff --git a/test/st-KK06-algo1/p.ml b/test/st-KK06-algo1/p.ml
index 1b0f4da6..9438d153 100644
--- a/test/st-KK06-algo1/p.ml
+++ b/test/st-KK06-algo1/p.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:37) by Erwan Jahier> *)
(*
A Self-stabilizing Algorithm for Finding a Spanning Tree in a Polynomial Number of Moves
@@ -13,8 +13,8 @@ Hyp:
open Algo
-let (init_state: int -> 'st) =
- fun _nl -> (Random.int 10)
+let (init_state: int -> string -> 'st) =
+ fun _nl _ -> (Random.int 10)
let min_n nl = (* returns the min of the neigbhors *)
diff --git a/test/st-KK06-algo1/root.ml b/test/st-KK06-algo1/root.ml
index 596eeafd..974aa159 100644
--- a/test/st-KK06-algo1/root.ml
+++ b/test/st-KK06-algo1/root.ml
@@ -1,7 +1,7 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:58) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:38) by Erwan Jahier> *)
-let (init_state: int -> 'st) =
- fun i -> 0
+let (init_state: int -> string -> 'st) =
+ fun _ _ -> 0
(* The root is never enabled... *)
let enable_f = fun _ _ -> []
diff --git a/test/st-KK06-algo2/p.ml b/test/st-KK06-algo2/p.ml
index e4e462d0..b2c76112 100644
--- a/test/st-KK06-algo2/p.ml
+++ b/test/st-KK06-algo2/p.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:51) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:48) by Erwan Jahier> *)
(*
A Self-stabilizing Algorithm for Finding a Spanning Tree in a Polynomial Number of Moves
@@ -18,8 +18,8 @@ let n = Algo.card ()
(* for some known constant N>=n *)
let bigN = 2*n
-let (init_state: int -> 'st) =
- fun _nl -> (Random.int bigN)
+let (init_state: int -> string -> 'st) =
+ fun _nl _ -> (Random.int bigN)
let min_n nl = (* returns the min of the neigbhors *)
diff --git a/test/st-KK06-algo2/root.ml b/test/st-KK06-algo2/root.ml
index cb49f4e6..c2f1ce46 100644
--- a/test/st-KK06-algo2/root.ml
+++ b/test/st-KK06-algo2/root.ml
@@ -1,7 +1,7 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:51) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:49) by Erwan Jahier> *)
-let (init_state: int -> 'st) =
- fun i -> 0
+let (init_state: int -> string -> 'st) =
+ fun _ _ -> 0
(* The root is never enabled... *)
let enable_f = fun _ _ -> []
diff --git a/test/unison/unison.ml b/test/unison/unison.ml
index 45ab6dcd..87a840a5 100644
--- a/test/unison/unison.ml
+++ b/test/unison/unison.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 19/02/2020 (at 09:50) by Erwan Jahier> *)
+(* Time-stamp: <modified the 05/03/2020 (at 21:38) by Erwan Jahier> *)
open Algo
@@ -7,8 +7,8 @@ let diameter = Algo.diameter ()
let m = max 2 (1+2*diameter)
-let (init_state: int -> 'v) =
- fun _nl ->
+let (init_state: int -> string -> 'v) =
+ fun _ _ ->
(* Printf.eprintf "unison.ml: tossing!\n";flush stderr; *)
Random.int m
--
GitLab