From 7212f2eabf9c7560389ce616c6c1394ef824d679 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 9 May 2019 22:00:49 +0200
Subject: [PATCH] Bug fix: handle array properly among processes (copying them
when necessary)
---
lib/sasacore/env.ml | 22 +++++++++++++++-------
lib/sasacore/env.mli | 6 ++++++
lib/sasacore/sasa.ml | 28 +++++++++++++++++-----------
test/dfs/p.ml | 3 +--
4 files changed, 39 insertions(+), 20 deletions(-)
diff --git a/lib/sasacore/env.ml b/lib/sasacore/env.ml
index 2116b7c9..f1069da0 100644
--- a/lib/sasacore/env.ml
+++ b/lib/sasacore/env.ml
@@ -1,20 +1,28 @@
-
-(* 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
diff --git a/lib/sasacore/env.mli b/lib/sasacore/env.mli
index 50f60fb8..ef7c9400 100644
--- a/lib/sasacore/env.mli
+++ b/lib/sasacore/env.mli
@@ -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
+
diff --git a/lib/sasacore/sasa.ml b/lib/sasacore/sasa.ml
index d48a349c..ad66f48b 100644
--- a/lib/sasacore/sasa.ml
+++ b/lib/sasacore/sasa.ml
@@ -1,10 +1,11 @@
-(* 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
diff --git a/test/dfs/p.ml b/test/dfs/p.ml
index 47322840..019f61c6 100644
--- a/test/dfs/p.ml
+++ b/test/dfs/p.ml
@@ -1,4 +1,4 @@
-(* 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
--
GitLab