Skip to content
Snippets Groups Projects
Commit 7212f2ea authored by erwan's avatar erwan
Browse files

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

parent 0802502f
No related branches found
No related tags found
No related merge requests found
(* Time-stamp: <modified the 09/05/2019 (at 21:52) by Erwan Jahier> *)
(* module Dico = Map.Make(struct type t = string * string let compare = compare end) *)
module Dico = Map.Make(String) module Dico = Map.Make(String)
open Algo open Algo
(*
module Dico = Map.Make(String)
type t = value Dico.t Dico.t
*)
type t = local_env Dico.t type t = local_env Dico.t
let (get: t -> string -> string -> value) = let (get: t -> string -> string -> value) =
fun e pid v -> fun e pid v ->
try ((Dico.find pid e) v) try ((Dico.find pid e) v)
with _ -> failwith (Printf.sprintf "Unknown value: %s.%s" pid 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) = let (set: t -> string -> string -> value -> t) =
fun e pid v value -> fun e pid v value ->
Dico.add pid (fun x -> if x=v then value else Dico.find pid e x) e 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 ...@@ -8,3 +8,9 @@ val set: t -> string -> string -> Algo.value -> t
(** [get env process_id var_name] *) (** [get env process_id var_name] *)
val get: t -> string -> string -> Algo.value 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 Algo
open Sasacore 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 -> fun e pl neighbors ->
let (aux: Env.t -> Process.t -> Algo.neighbor list -> Env.t) = let (aux: Env.t -> Process.t -> Algo.neighbor list -> Env.t) =
fun e p nl -> fun e p nl ->
...@@ -32,7 +33,7 @@ let (get_neighors: Topology.t -> Env.t -> Process.t -> Algo.neighbor list) = ...@@ -32,7 +33,7 @@ let (get_neighors: Topology.t -> Env.t -> Process.t -> Algo.neighbor list) =
let node = g.of_id id in let node = g.of_id id in
let algo_id = Filename.chop_suffix node.file ".cmxs" 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; n_vars = Algo.get_vars algo_id;
(* XXX For the 2 fields above, check the graph kind (anonymous, (* XXX For the 2 fields above, check the graph kind (anonymous,
identified, etc. *) identified, etc. *)
...@@ -61,7 +62,7 @@ open SasArg ...@@ -61,7 +62,7 @@ open SasArg
let (update_neighbor_env: Env.t -> Algo.neighbor -> Algo.neighbor) = let (update_neighbor_env: Env.t -> Algo.neighbor -> Algo.neighbor) =
fun e n -> 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 type layout = (Process.t * Algo.neighbor list) list
...@@ -123,15 +124,16 @@ let (get_outputs_rif_decl: Process.t list -> (string * string) list) = ...@@ -123,15 +124,16 @@ let (get_outputs_rif_decl: Process.t list -> (string * string) list) =
let lll = List.map let lll = List.map
(fun p -> (fun p ->
List.map 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) p.variables)
pl pl
in in
let algo_vars = List.flatten (List.flatten lll) in let algo_vars = List.flatten (List.flatten lll) in
let action_vars = List.flatten let action_vars = List.flatten
(List.map (List.map
(fun p -> (fun p -> List.map
List.map (fun a -> (Printf.sprintf "Enab_%s_%s" p.pid a),"bool") p.actions) (fun a -> (Printf.sprintf "Enab_%s_%s" p.pid a),"bool") p.actions)
pl) pl)
in in
algo_vars @ action_vars algo_vars @ action_vars
...@@ -185,19 +187,22 @@ let (make : bool -> string array -> t) = ...@@ -185,19 +187,22 @@ let (make : bool -> string array -> t) =
close_out oc; close_out oc;
exit 0); exit 0);
if args.rif then ( 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 if args.demon <> Demon.Custom then
Printf.printf "#seed %i\n" args.seed; Printf.printf "#seed %i\n" args.seed;
let inputs_decl = get_inputs_rif_decl args pl in let inputs_decl = get_inputs_rif_decl args pl in
Printf.printf "#inputs %s\n" Printf.printf "#inputs %s\n"
(String.concat " " (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); Printf.printf "#outputs %s\n" (env_rif_decl pl);
flush stdout flush stdout
) else ( ) else (
if args.demon <> Demon.Custom then ( 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 flush stdout
); );
); );
...@@ -206,7 +211,8 @@ let (make : bool -> string array -> t) = ...@@ -206,7 +211,8 @@ let (make : bool -> string array -> t) =
(fun p -> List.iter (fun p -> List.iter
(fun a -> ignore (RifRead.bool (args.verbose > 1) p a)) p.actions) (fun a -> ignore (RifRead.bool (args.verbose > 1) p a)) p.actions)
pl; 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 args, pl_n, e
with 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 *) (* cf Collin-Dolex-94 *)
...@@ -43,7 +43,6 @@ let rec end_of_a a i = ...@@ -43,7 +43,6 @@ let rec end_of_a a i =
let (concat_path : value array -> int -> value array) = let (concat_path : value array -> int -> value array) =
fun a alpha -> fun a alpha ->
let s = Array.length a in let s = Array.length a in
let a = Array.copy a in (* ouch! *)
let last = end_of_a a 1 in let last = end_of_a a 1 in
if last=s then ( if last=s then (
for i = 1 to s-1 do for i = 1 to s-1 do
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment