Commit 7212f2ea authored by erwan's avatar erwan
Browse files

Bug fix: handle array properly among processes (copying them when necessary)

parent 0802502f
(* module Dico = Map.Make(struct type t = string * string let compare = compare end) *)
(* Time-stamp: <modified the 09/05/2019 (at 21:52) by Erwan Jahier> *)
module Dico = Map.Make(String)
open Algo
(*
module Dico = Map.Make(String)
type t = value Dico.t Dico.t
*)
type t = local_env Dico.t
let (get: t -> string -> string -> value) =
fun e pid v ->
try ((Dico.find pid e) v)
with _ -> failwith (Printf.sprintf "Unknown value: %s.%s" pid v)
let rec (copy_value : value -> value) =
fun v ->
match v with
| I _ | F _ | B _ | E _ | S _ | N _ -> v
| A a -> A (Array.copy (Array.map copy_value a))
let (get_copy: t -> string -> string -> value) =
fun e pid v ->
copy_value (get e pid v)
let (set: t -> string -> string -> value -> t) =
fun e pid v value ->
Dico.add pid (fun x -> if x=v then value else Dico.find pid e x) e
......
......@@ -8,3 +8,9 @@ val set: t -> string -> string -> Algo.value -> t
(** [get env process_id var_name] *)
val get: t -> string -> string -> Algo.value
(** In order to make sure that arrays ref are not shared between processes,
this function performs an array copy of the value (if it is an array)
*)
val get_copy: t -> string -> string -> Algo.value
(* Time-stamp: <modified the 30/04/2019 (at 16:02) by Erwan Jahier> *)
(* Time-stamp: <modified the 09/05/2019 (at 21:58) by Erwan Jahier> *)
open Algo
open Sasacore
let (update_env_with_init : Env.t -> Process.t list -> Algo.neighbor list list -> Env.t) =
let (update_env_with_init : Env.t -> Process.t list -> Algo.neighbor list list
-> Env.t) =
fun e pl neighbors ->
let (aux: Env.t -> Process.t -> Algo.neighbor list -> Env.t) =
fun e p nl ->
......@@ -32,7 +33,7 @@ let (get_neighors: Topology.t -> Env.t -> Process.t -> Algo.neighbor list) =
let node = g.of_id id in
let algo_id = Filename.chop_suffix node.file ".cmxs" in
{
lenv= Env.get e node.id;
lenv= Env.get_copy e node.id;
n_vars = Algo.get_vars algo_id;
(* XXX For the 2 fields above, check the graph kind (anonymous,
identified, etc. *)
......@@ -61,7 +62,7 @@ open SasArg
let (update_neighbor_env: Env.t -> Algo.neighbor -> Algo.neighbor) =
fun e n ->
{ n with lenv= Env.get e (n.Algo.pid ())}
{ n with lenv= Env.get_copy e (n.Algo.pid ())}
type layout = (Process.t * Algo.neighbor list) list
......@@ -123,15 +124,16 @@ let (get_outputs_rif_decl: Process.t list -> (string * string) list) =
let lll = List.map
(fun p ->
List.map
(fun (n,vt) -> Algo.vart_to_rif_decl vt (Printf.sprintf "%s_%s" p.pid n))
(fun (n,vt) ->
Algo.vart_to_rif_decl vt (Printf.sprintf "%s_%s" p.pid n))
p.variables)
pl
in
let algo_vars = List.flatten (List.flatten lll) in
let action_vars = List.flatten
(List.map
(fun p ->
List.map (fun a -> (Printf.sprintf "Enab_%s_%s" p.pid a),"bool") p.actions)
(fun p -> List.map
(fun a -> (Printf.sprintf "Enab_%s_%s" p.pid a),"bool") p.actions)
pl)
in
algo_vars @ action_vars
......@@ -185,19 +187,22 @@ let (make : bool -> string array -> t) =
close_out oc;
exit 0);
if args.rif then (
Printf.printf "%s" (Mypervasives.entete "#" SasaVersion.str SasaVersion.sha);
Printf.printf "%s"
(Mypervasives.entete "#" SasaVersion.str SasaVersion.sha);
if args.demon <> Demon.Custom then
Printf.printf "#seed %i\n" args.seed;
let inputs_decl = get_inputs_rif_decl args pl in
Printf.printf "#inputs %s\n"
(String.concat " "
(List.map (fun (vn,vt) -> Printf.sprintf "\"%s\":%s" vn vt) inputs_decl));
(List.map
(fun (vn,vt) -> Printf.sprintf "\"%s\":%s" vn vt) inputs_decl));
Printf.printf "#outputs %s\n" (env_rif_decl pl);
flush stdout
) else (
if args.demon <> Demon.Custom then (
Printf.printf "The pseudo-random engine is used with seed %i\n" args.seed;
Printf.printf "The pseudo-random engine is used with seed %i\n"
args.seed;
flush stdout
);
);
......@@ -206,7 +211,8 @@ let (make : bool -> string array -> t) =
(fun p -> List.iter
(fun a -> ignore (RifRead.bool (args.verbose > 1) p a)) p.actions)
pl;
Printf.eprintf "Ignoring the first vectors of sasa inputs\n"; flush stderr;
Printf.eprintf "Ignoring the first vectors of sasa inputs\n";
flush stderr;
);
args, pl_n, e
with
......
(* Time-stamp: <modified the 04/04/2019 (at 21:07) by Erwan Jahier> *)
(* Time-stamp: <modified the 09/05/2019 (at 21:59) by Erwan Jahier> *)
(* cf Collin-Dolex-94 *)
......@@ -43,7 +43,6 @@ let rec end_of_a a i =
let (concat_path : value array -> int -> value array) =
fun a alpha ->
let s = Array.length a in
let a = Array.copy a in (* ouch! *)
let last = end_of_a a 1 in
if last=s then (
for i = 1 to s-1 do
......
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