Commit f4301641 authored by erwan's avatar erwan
Browse files

New: Add a process id and a reply fields to neighbors.

Depending on the kind of network, we should raise an exception. Indeed
such information should not be available in anonymous networks.

We will add such checks later.
parent bdc5c552
(* Time-stamp: <modified the 26/03/2019 (at 16:12) by Erwan Jahier> *)
(* Time-stamp: <modified the 26/03/2019 (at 16:25) by Erwan Jahier> *)
(** Process programmer API *)
type varT = It | Ft | Bt | Et of int | St | Nt | At of varT * int
......@@ -9,9 +9,10 @@ type local_env = string -> value
type vars = (string * varT) list
type neighbor = {
(* n_id: string; (* to hide? *) *)
lenv: local_env;
n_vars: vars;
pid: unit -> string;
reply: unit -> int;
}
type enable_fun = neighbor list -> local_env -> action list
......
(* Time-stamp: <modified the 22/03/2019 (at 16:56) by Erwan Jahier> *)
(* Time-stamp: <modified the 26/03/2019 (at 16:25) by Erwan Jahier> *)
(** Process programmer API *)
type varT = It | Ft | Bt | Et of int | St | Nt | At of varT * int
......@@ -13,6 +13,8 @@ type action = string (* label *)
type neighbor = {
lenv: local_env;
n_vars: vars;
pid: unit -> string; (* this info is not available in all modes (e.g., anonymous) *)
reply: unit -> int; (* ditto *)
}
type enable_fun = neighbor list -> local_env -> action list
......
(* Time-stamp: <modified the 22/03/2019 (at 09:44) by Erwan Jahier> *)
(* XXX Je pourrais utiliser Lwt pour rendre step non-bloquant, ce qui
permettrait d'accelerer la simu sur les machines qui ont plusieurs
coeurs
step : action -> (string -> value) Lwt.t ;
*)
(* Time-stamp: <modified the 26/03/2019 (at 17:20) by Erwan Jahier> *)
open Algo
open Sasacore
......@@ -20,11 +13,19 @@ let (update_env_with_init : Env.t -> Process.t list -> Algo.neighbor list list -
p.variables
in
List.fold_left2 aux e pl neighbors
let (reply: Topology.t -> string -> string -> int) =
fun g source target ->
let rec f i = function
| [] -> assert false
| x::t -> if x=source then i else f (i+1) t
in
f 0 (g.succ target)
let (get_neighors: Topology.t -> Process.t -> Topology.neighbor list) =
fun g p ->
let id = p.Process.pid in
let idl = g.succ id in
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
......@@ -32,6 +33,7 @@ let (get_neighors: Topology.t -> Process.t -> Topology.neighbor list) =
{
Topology.n_id = node.id;
Topology.n_vars = Algo.get_vars algo_id;
Topology.n_reply = reply g source_id id;
}
)
idl
......@@ -57,7 +59,11 @@ 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
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 ->
......
(* Time-stamp: <modified the 22/03/2019 (at 09:40) by Erwan Jahier> *)
(* Time-stamp: <modified the 26/03/2019 (at 17:02) by Erwan Jahier> *)
open Graph
open Graph.Dot_ast
......@@ -124,4 +124,5 @@ let (read: string -> t) = fun f ->
type neighbor = {
n_id: string;
n_vars: (string * Algo.varT) list;
n_reply: int;
}
(* Time-stamp: <modified the 22/03/2019 (at 09:36) by Erwan Jahier> *)
(* Time-stamp: <modified the 26/03/2019 (at 17:07) by Erwan Jahier> *)
type node_id = string
type node = {
......@@ -9,12 +9,12 @@ type node = {
type edge = node_id * node_id list
(* neighbor view from the sasa: in Algo.neighbor we hide the pid and
(* 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 = {
......
# Time-stamp: <modified the 21/03/2019 (at 14:50) by Erwan Jahier>
# Time-stamp: <modified the 24/03/2019 (at 10:32) by Erwan Jahier>
DIR=../../_build/install/default
sasa=$(DIR)/bin/sasa -seed 42
......@@ -7,7 +6,7 @@ sasa=$(DIR)/bin/sasa -seed 42
LIB=-I $(DIR)/lib/algo
# LIB=-I +algo
%.cmxs: %.ml
%.cmxs: rdbg%.ml
ocamlopt -shared $(LIB) $^ -o $@
%.lut: %.dot
......@@ -21,3 +20,11 @@ s:sim2chrogtk
clean:
rm -f *.cmxs sasa *.cmi *.o *.cmx *.pdf *.rif *.gp *.log *.dro *.seed *.c sasa-*.dot
##################################################################################
# Essais en cours
LIB2=-I $(DIR)/lib/algo -I $(DIR)/lib/sasacore
# XXX pour lancer rdbg en bactch (pour les tests) ; ne compile pas XXX
rdbg.%.cmxs: rdbg.%.ml
ocamlfind ocamlopt -shared $(LIB2) -o $@ -package lutin,ocamlgraph -linkpkg algo.cmxa ../../lib/sasacore/topology.mli ../../lib/sasacore/topology.ml ../rdbg-utils/dot.ml $^
(* Time-stamp: <modified the 10/03/2019 (at 20:50) by Erwan Jahier> *)
(* Time-stamp: <modified the 22/03/2019 (at 17:48) by Erwan Jahier> *)
(* This is algo 5.4 in the book *)
......@@ -11,7 +11,7 @@ let actions = ["CD";"CP"]
let (init_vars: neighbor list -> local_env) =
fun nl -> function
| "d" -> I (Random.int d)
| "par" -> N (Random.int ((List.length nl)-1))
| "par" -> N (Random.int ((List.length nl)))
| _ -> raise Not_found
(* casting *)
......
......@@ -33,8 +33,8 @@ let (get_processes : string -> Event.t -> process list) =
let rec sortv (enab, other) (x,v) =
match x with
| ["Enab";pid;a] -> (pid,a,v)::enab, other
| [pid; str] -> enab, (pid,str,v)::other
| _ -> assert false
| pid::tail -> enab, (pid,(String.concat "_" tail),v)::other
| [] -> assert false
in
let enab, other = List.fold_left sortv ([],[]) l in
let rec (build_pidl: process list -> (string * string * Data.v) list ->
......
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