From 8c9ae9e6edaa5b595a8fb571d7735bd44a0c75f6 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Tue, 2 Apr 2019 11:10:52 +0200
Subject: [PATCH] Update: remove the (intermediate) Topology.neighbor type
Rationale: it was not really necessary (Algo.neighbor contains almost
the same information), and the Topology.neighbor type was alone in its
module, which looked weird.
---
lib/sasacore/demon.ml | 4 ++--
lib/sasacore/demon.mli | 6 ++---
lib/sasacore/sasa.ml | 50 ++++++++++++++++++---------------------
lib/sasacore/stringOf.ml | 6 ++---
lib/sasacore/topology.ml | 8 +------
lib/sasacore/topology.mli | 11 ++-------
src/sasaMain.ml | 2 +-
7 files changed, 35 insertions(+), 52 deletions(-)
diff --git a/lib/sasacore/demon.ml b/lib/sasacore/demon.ml
index fdb52fe0..25026063 100644
--- a/lib/sasacore/demon.ml
+++ b/lib/sasacore/demon.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 28/03/2019 (at 20:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/04/2019 (at 10:48) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
@@ -30,7 +30,7 @@ let (synchrone: 'a list list -> 'a list) = fun all ->
-type pna = Process.t * Topology.neighbor list * Algo.action
+type pna = Process.t * Algo.neighbor list * Algo.action
(* From a list of enabled actions (pna) returns:
- a string containing the values (in RIF) of activing_variables
- the list of activated actions
diff --git a/lib/sasacore/demon.mli b/lib/sasacore/demon.mli
index 6d0d74f0..ed7ae474 100644
--- a/lib/sasacore/demon.mli
+++ b/lib/sasacore/demon.mli
@@ -1,11 +1,11 @@
-(* Time-stamp: <modified the 28/03/2019 (at 18:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/04/2019 (at 10:48) by Erwan Jahier> *)
type t =
| Synchronous (* select all actions *)
| Central (* select 1 action *)
| LocallyCentral (* never activates two neighbors actions in the same step *)
| Distributed (* select at least one action *)
- | Custom
+ | Custom (* enable/actions are communicated via stdin/stdout in RIF *)
(** At the inner list level, exactly one action is chosen. At the
outter list level, the number of chosen actions depends on the kind
@@ -20,7 +20,7 @@ type t =
f dummy_input verbose_mode demon pl all enab
*)
-type pna = Process.t * Topology.neighbor list * Algo.action
+type pna = Process.t * Algo.neighbor list * Algo.action
val f : bool -> bool -> t -> Process.t list -> pna list list -> bool list list ->
string * pna list
diff --git a/lib/sasacore/sasa.ml b/lib/sasacore/sasa.ml
index b6eb2cde..89b19888 100644
--- a/lib/sasacore/sasa.ml
+++ b/lib/sasacore/sasa.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 28/03/2019 (at 18:10) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/04/2019 (at 11:03) by Erwan Jahier> *)
open Algo
open Sasacore
@@ -22,26 +22,30 @@ let (reply: Topology.t -> string -> string -> int) =
in
f 0 (g.succ target)
-let (get_neighors: Topology.t -> Process.t -> Topology.neighbor list) =
- fun g p ->
+
+let (get_neighors: Topology.t -> Env.t -> Process.t -> Algo.neighbor list) =
+ fun g e p ->
let source_id = p.Process.pid in
let idl = g.succ source_id in
List.map
(fun id ->
let node = g.of_id id in
let algo_id = Filename.chop_suffix node.file ".cmxs" in
- {
- Topology.n_id = node.id;
- Topology.n_vars = Algo.get_vars algo_id;
- Topology.n_reply = reply g source_id id;
+ {
+ lenv= Env.get e node.id;
+ n_vars = Algo.get_vars algo_id;
+ (* XXX For the 2 fields above, check the graph kind (anonymous,
+ identified, etc. *)
+ pid = (fun () -> node.id);
+ reply = (fun () -> reply g source_id id);
}
)
idl
-let (dump_process: Process.t * Topology.neighbor list -> unit) =
+let (dump_process: Process.t * Algo.neighbor list -> unit) =
fun (p,nl) ->
let pvars = StringOf.algo_vars p.variables in
- let neighbors = List.map StringOf.topology_neighbor nl in
+ let neighbors = List.map StringOf.algo_neighbor nl in
Printf.printf "process %s\n\tvars:%s\n\tneighors: \n\t\t%s\n" p.pid pvars
(String.concat "\n\t\t" neighbors)
@@ -55,17 +59,6 @@ let (update_env: Env.t -> Process.t * Algo.local_env -> Env.t) =
open Process
open SasArg
-let (to_algo_neighbor: Env.t -> Topology.neighbor -> Algo.neighbor) =
- fun e n ->
- {
- lenv= Env.get e n.Topology.n_id;
- n_vars = n.Topology.n_vars;
- (* XXX For the 2 fields above, check the graph kind (anonymous,
- identified, etc. *)
- pid = (fun () -> n.n_id);
- reply = (fun () -> n.n_reply);
- }
-
let (print_step : int -> int -> SasArg.t -> Env.t -> Process.t list -> string ->
string -> unit) =
fun n i args e pl activate_val enable_val ->
@@ -90,15 +83,19 @@ let (print_step : int -> int -> SasArg.t -> Env.t -> Process.t list -> string ->
flush stderr
)
+
+let (update_neighbor_env: Env.t -> Algo.neighbor -> Algo.neighbor) =
+ fun e n ->
+ { n with lenv= Env.get e (n.Algo.pid ())}
exception Silent of int
let (simustep: int -> int -> SasArg.t -> Process.t list -> string ->
- (Process.t * Topology.neighbor list) list -> Env.t -> Env.t * string) =
+ (Process.t * Algo.neighbor list) list -> Env.t -> Env.t * string) =
fun n i args pl activate_val pl_n e ->
(* 1: Get enable processes *)
let all = List.fold_left
(fun acc (p,nl) ->
- let nl4algo = List.map (to_algo_neighbor e) nl in
+ let nl4algo = List.map (update_neighbor_env e) nl in
let lenv = Env.get e p.pid in
let al = p.enable nl4algo lenv in
let al = List.map (fun a -> p,nl,a) al in
@@ -130,7 +127,7 @@ let (simustep: int -> int -> SasArg.t -> Process.t list -> string ->
(* 2: Do the steps *)
let lenv_list =
List.map (fun (p,nl,a) ->
- let nl4algo = List.map (to_algo_neighbor e) nl in
+ let nl4algo = List.map (update_neighbor_env e) nl in
let lenv = Env.get e p.pid in
p, p.step nl4algo lenv a)
pnal
@@ -141,7 +138,7 @@ let (simustep: int -> int -> SasArg.t -> Process.t list -> string ->
-type t = SasArg.t * Process.t list * (Process.t * Topology.neighbor list) list * Env.t
+type t = SasArg.t * Process.t list * (Process.t * Algo.neighbor list) list * Env.t
let (make : string array -> t) =
fun argv ->
@@ -168,10 +165,9 @@ let (make : string array -> t) =
if !Algo.verbose_level > 0 then Printf.eprintf "nodes: %s\nedges:\n" nstr;
let e = Env.init () in
let pl = List.map (Process.make (args.demon=Custom)) nl in
- let neighors = List.map (get_neighors g) pl in
- let algo_neighors = List.map (List.map (to_algo_neighbor e)) neighors in
+ let algo_neighors = List.map (get_neighors g e) pl in
let e = update_env_with_init e pl algo_neighors in
- let pl_n = List.combine pl neighors in
+ let pl_n = List.combine pl algo_neighors in
if !Algo.verbose_level > 0 then List.iter dump_process pl_n;
if args.gen_lutin then (
let fn = (Filename.remove_extension args.topo) ^ ".lut" in
diff --git a/lib/sasacore/stringOf.ml b/lib/sasacore/stringOf.ml
index 16dccd3a..3f61415b 100644
--- a/lib/sasacore/stringOf.ml
+++ b/lib/sasacore/stringOf.ml
@@ -12,9 +12,9 @@ let rec (algo_varT: Algo.varT -> string) = function
let (algo_vars : Algo.vars -> string) = fun vars ->
String.concat "," (List.map (fun (n,t) -> Printf.sprintf "%s:%s" n (algo_varT t)) vars)
-open Topology
-let (topology_neighbor :Topology.neighbor -> string) = fun n ->
- Printf.sprintf "%s (%s)" n.n_id (algo_vars n.n_vars)
+open Algo
+let (algo_neighbor : Algo.neighbor -> string) = fun n ->
+ Printf.sprintf "%s (%s)" (n.pid()) (algo_vars n.n_vars)
open Process
let (env: Env.t -> Process.t list -> string) =
diff --git a/lib/sasacore/topology.ml b/lib/sasacore/topology.ml
index fade466b..620d1b71 100644
--- a/lib/sasacore/topology.ml
+++ b/lib/sasacore/topology.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/03/2019 (at 17:02) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/04/2019 (at 10:13) by Erwan Jahier> *)
open Graph
open Graph.Dot_ast
@@ -120,9 +120,3 @@ let (read: string -> t) = fun f ->
failwith (str^ " unknown node id")
)
}
-
-type neighbor = {
- n_id: string;
- n_vars: (string * Algo.varT) list;
- n_reply: int;
-}
diff --git a/lib/sasacore/topology.mli b/lib/sasacore/topology.mli
index 685d2b18..102d2f20 100644
--- a/lib/sasacore/topology.mli
+++ b/lib/sasacore/topology.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 26/03/2019 (at 17:07) by Erwan Jahier> *)
+(* Time-stamp: <modified the 02/04/2019 (at 10:13) by Erwan Jahier> *)
type node_id = string
type node = {
@@ -9,13 +9,6 @@ type node = {
type edge = node_id * node_id list
-(* Neighbor view from sasa: in Algo.neighbor we hide the pid and
- compute the lenv *)
-type neighbor = {
- n_id: string;
- n_vars: (string * Algo.varT) list;
- n_reply: int;
-}
type t = {
nodes: node list;
@@ -23,5 +16,5 @@ type t = {
of_id: node_id -> node;
}
-(** Parse a dot file *)
+(** Parse a sasa dot file *)
val read: string -> t
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index ef042bbd..5856c7e3 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -2,7 +2,7 @@ open Sasacore
open Sasa
let rec (simuloop: int -> int -> SasArg.t -> Process.t list -> string ->
- (Process.t * Topology.neighbor list) list -> Env.t -> unit) =
+ (Process.t * Algo.neighbor list) list -> Env.t -> unit) =
fun n i args pl activate_val pl_n e ->
let ne, next_activate_val = simustep n i args pl activate_val pl_n e in
--
GitLab