New: Add an array datatype to the Algo API

Makefile

@@ -8,6 +8,7 @@ build:gen_version
 
 .PHONY:test
 test:
+	make
 	cd test; make
 
 

lib/algo/algo.ml

-(* Time-stamp: <modified the 11/03/2019 (at 10:40) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/03/2019 (at 16:12) by Erwan Jahier> *)
 
 (** Process programmer API *)
-type varT = It | Ft | Bt | Et of int | St | Nt
+type varT = It | Ft | Bt | Et of int | St | Nt | At of varT * int
 type action = string (* just a label *)
 type value = I of int | F of float | B of bool | E of int | S of string | N of int
+           | A of value array
 type local_env = string -> value
 
 type vars = (string * varT) list
@@ -24,8 +25,6 @@ type int_tables = {
   actions: (string, action list) Hashtbl.t;
 }
 
-
-
 let tbls = {
   vars = Hashtbl.create 1;
   init_vars = Hashtbl.create 1;
@@ -36,15 +35,39 @@ let tbls = {
 
 let verbose_level = ref 0
 
-let vart_to_rif_string = function
-  | It -> "int"
-  | Ft -> "real"
-  | Bt -> "bool"
-  | St -> "string"
-  | Et _i -> "int"
-  | Nt -> "int"
-    
-let value_to_string = function
+let vart_to_rif_string =
+  fun v base ->
+    match v with
+    | It -> Printf.sprintf "\"%s\":%s" base "int"
+    | Ft -> Printf.sprintf "\"%s\":%s" base "real"
+    | Bt -> Printf.sprintf "\"%s\":%s" base "bool"
+    | St -> Printf.sprintf "\"%s\":%s" base "string"
+    | Et _i -> Printf.sprintf "\"%s\":%s" base "int"
+    | Nt -> Printf.sprintf "\"%s\":%s" base "int"
+    | At(_) ->
+      let rec do_array base t = (* expand array names *)
+        match t with
+        | It -> [base], "int"
+        | Ft -> [base], "real"
+        | Bt -> [base], "bool"
+        | St -> [base], "string"
+        | Et _i -> [base], "int"
+        | Nt -> [base], "int"
+        | At(t,i) ->
+          let baselist, tstr = do_array base t in
+          let ext_list = List.init i (fun n -> "_"^(string_of_int n)) in
+          let baselist =
+            List.map (fun base -> List.map (fun ext -> base^ext) ext_list) baselist
+          in
+          List.flatten baselist, tstr
+
+      in
+      let base_list, tstr = do_array base v in
+      String.concat " "
+        (List.map (fun base -> Printf.sprintf "\"%s\":%s" base tstr) base_list)
+
+                   
+let rec value_to_string = function
   | I i
   | E i
   | N i -> string_of_int i
@@ -52,7 +75,9 @@ let value_to_string = function
   | B true -> "t" 
   | B false -> "f" 
   | S str -> str
-    
+  | A a -> (String.concat " "
+                   (Array.fold_right (fun e acc -> (value_to_string e)::acc) a []))
+
 exception Unregistred of string * string
 
 let print_table lbl tbl =
@@ -73,6 +98,20 @@ let (get_vars : string -> (string * varT) list) = fun algo_id ->
     print_table "vars" tbls.vars;
     raise (Unregistred ("variable", algo_id))
 
+
+let rec (init_var: neighbor list -> varT -> value) =
+  fun nl -> function
+    | Nt ->
+      assert (nl <> []);
+      N (try Random.int ((List.length nl)) with _ -> assert false)
+    | It -> I (Random.int 100000)
+    | Bt -> B (Random.bool ())
+    | Ft -> F (Random.float max_float)
+    | Et i -> I (Random.int i)
+    | St -> S "dummy"
+    | At(t,i) -> A(Array.make i (init_var nl t))
+
+
 let (reg_init_vars : algo_id -> (neighbor list -> local_env) -> unit) = fun algo_id x ->
   if !verbose_level > 0 then Printf.printf "Registering %s init_vars\n" algo_id;
   flush stdout;
@@ -83,15 +122,7 @@ let (get_init_vars : algo_id -> (string * varT) list -> (neighbor list -> local_
       (fun nl v ->
          match List.find_opt (fun (x,_t) -> x=v) vars with
            None -> failwith (v^" unknown var")
-         | Some(_,Nt) ->
-           assert (nl <> []);
-           N (Random.int ((List.length nl)-1))
-         | Some(_,It) -> I (Random.int 100000)
-         | Some(_,Bt) -> B (Random.bool ())
-         | Some(_,Ft) -> F (Random.float max_float)
-         | Some(_,Et i) -> I (Random.int i)
-         | Some(_,St) -> S "dummy"
-                             
+         | Some v -> init_var nl (snd v)
       )
     in
     try

lib/algo/algo.mli

-(* Time-stamp: <modified the 11/03/2019 (at 10:38) by Erwan Jahier> *)
+(* Time-stamp: <modified the 22/03/2019 (at 16:56) by Erwan Jahier> *)
 
 (** Process programmer API *)
-type varT = It | Ft | Bt | Et of int | St | Nt
+type varT = It | Ft | Bt | Et of int | St | Nt | At of varT * int
 type vars = (string * varT) list 
 
 type value = I of int | F of float | B of bool  | E of int | S of string
            | N of int  (* neighbor canal number *)
+           | A of value array
 type local_env = string -> value 
 type action = string (* label *)
     
@@ -39,7 +40,7 @@ val value_to_string : value -> string
 
 (**/**)
 (** functions below are not part of the API *)
-val vart_to_rif_string: varT -> string
+val vart_to_rif_string: varT -> string -> string
 val verbose_level: int ref
 
 

lib/sasacore/process.ml

-(* Time-stamp: <modified the 20/03/2019 (at 13:07) by Erwan Jahier> *)
+(* Time-stamp: <modified the 22/03/2019 (at 16:25) by Erwan Jahier> *)
 
 type t = {
   pid : string;
@@ -34,6 +34,7 @@ let (make: bool -> Topology.node -> t) =
             | Some(Algo.Ft) -> F (float_of_string x)
             | Some(Algo.Et _i) -> I (int_of_string x)
             | Some(Algo.St) -> S "dummy"
+            | Some(Algo.At(_t,_i)) -> assert false (* A (Array.make i *)
                                     
             | None ->
               failwith (Printf.sprintf "%s is not a variable of program %s" v cmxs)

lib/sasacore/stringOf.ml

 
 open Algo
-let (algo_varT: Algo.varT -> string) = function
+let rec (algo_varT: Algo.varT -> string) = function
   | It -> "int"
   | Ft -> "float"
   | Bt -> "bool"
   | Et i -> Printf.sprintf "enum(%d)" i
   | Nt -> "Neighbor"
   | St -> "string"
+  | At(t,i) -> Printf.sprintf "%s[%d]" (algo_varT t) i
 
 let (algo_vars : Algo.vars -> string) = fun vars -> 
   String.concat "," (List.map (fun (n,t) -> Printf.sprintf "%s:%s" n (algo_varT t)) vars)
@@ -48,7 +49,7 @@ let (env_rif_decl: Process.t list -> string) =
         (fun p ->
            List.map
              (fun (n,vt) ->
-                Printf.sprintf "\"%s_%s\":%s" p.pid n (Algo.vart_to_rif_string vt))
+                Algo.vart_to_rif_string vt (Printf.sprintf "%s_%s" p.pid n))
              p.variables)
         pl
     in

test/dfs/rdbg-session.ml

+(* Automatically generated by /home/jahier/.opam/4.07.0/bin/rdbg version "1.180.5-1-gd01bbe5" ("d01bbe5")*)
+(* on crevetete the 23/3/2019 at 13:47:49*)
+(*rdbg*)
+
+
+#use "topfind";; 
+#require "rdbg-plugin";;
+open Event;;
+open RdbgArg;;
+open RdbgRun;;
+open RdbgMain;;
+open RdbgStdLib;;
+open Data;;
+#require "lutin";;
+
+let plugin_0 = 
+  let args = ["lutin";"g.lut";"-n";"distributed"] in
+  let aargs = Array.of_list args in
+  let plugin = LutinRun.make aargs in
+  let skip_dbg sl e cont = cont (plugin.step sl) e in
+  { plugin with step_dbg = skip_dbg }
+;;
+
+let plugin_1 = 
+  let plugin = StdioRun.make "../../_build/install/default/bin/sasa -seed 42 g.dot -custd -rif" in
+  plugin
+;;
+let _ = args.suts <- [Ocaml(plugin_0)];;
+let _ = args.envs <- [Ocaml(plugin_1)];;
+let _ = args.oracles <- [];;
+
+let _ =
+ args.display_gnuplot <- false;
+ args.display_sim2chro <- false;
+ args.rdbg <- true;
+ args.step_nb <- 100;
+ args.output <- "g.rif";
+ args.cov_file <- "lurette.cov";
+ args.stop_on_oracle_error <- true;
+ args.debug_rdbg <- false;;
+
+       
+#use "my-rdbg-tuning.ml";;
+
+let _ = print_string "
+ --> type 'man' for online help
+" 
+;;
+
+(**********************************************************************)
+#require "ocamlgraph";;
+#mod_use "../../lib/algo/algo.ml";; 
+#mod_use "../../lib/sasacore/topology.ml";;
+#use "../rdbg-utils/dot.ml";;
+
+let dotfile = "g.dot";;
+let p = Topology.read dotfile;;
+let d () = print_dot p dotfile !e;;
+let sd () = s();d();;
+let nr () = e:=next_round p.nodes dotfile !e; d();;
+let _ = n (); d (); ignore (Sys.command ("zathura sasa-g.dot.pdf&"))