Commit 8c9ae9e6 authored by erwan's avatar erwan
Browse files

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.
parent 8b0755d6
(* 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
......
(* 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
(* 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
......
......@@ -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) =
......
(* 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;
}
(* 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
......@@ -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
......
Supports Markdown
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