Update: continue to refactor files and functions for SasaRun implementation

.merlin

-S bin
+S src
+S lib/sasacore
 S lib/algo
 
 B /home/jahier/.opam/4.07.0/lib/ocaml
 B /home/jahier/.opam/4.07.0/lib/ocamlgraph
-B _build/default/bin/.sasa.eobjs
+B _build/default/src/.sasaMain.eobjs
 B _build/default/lib/algo/.algo.objs
+B _build/default/lib/sasacore/.sascore.objs
 

Makefile.version

@@ -13,4 +13,5 @@ lib/sasacore/sasaVersion.ml:
 	echo "(* generated by ../Makefile.version *)" > lib/sasacore/sasaVersion.ml ; \
 	echo "let str=\"$(VERSION)\"" >> lib/sasacore/sasaVersion.ml ; \
 	echo "let sha=\"$(SHA)\"" >> lib/sasacore/sasaVersion.ml ; \
-	echo "let branch=\"$(BRANCH)\"" >> lib/sasacore/sasaVersion.ml
+	echo "let branch=\"$(BRANCH)\"" >> lib/sasacore/sasaVersion.ml ; \
+	echo "let maintainer = \"erwan.jahier@univ-grenoble-alpes.fr\"" >> lib/sasacore/sasaVersion.ml ;

lib/sasacore/sasArg.ml

-(* Time-stamp: <modified the 14/03/2019 (at 17:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 15/03/2019 (at 22:37) by Erwan> *)
 
 
 type t = {
@@ -19,10 +19,10 @@ type t = {
   mutable _margin : int;
 }
 
-let usage_msg = ("usage: " ^Sys.argv.(0) ^ " [<option>]* <topology>.dot 
+let usage_msg tool = ("usage: " ^ tool ^ " [<option>]* <topology>.dot 
 use -h to see the available options.
 " )
-let print_usage () = Printf.printf "%s\n" usage_msg; flush stdout
+let print_usage tool = Printf.printf "%s\n" (usage_msg tool); flush stdout
 
 
 let (make_args : unit -> t) = 
@@ -36,16 +36,15 @@ let (make_args : unit -> t) =
       seed = (Random.self_init (); Random.int 1073741823);
       ifi = false;
       gen_lutin = false;
-        _args = [];        
+      _args = [];        
       _user_man  = [];   
       _hidden_man  = []; 
       _others = [];
       _margin =12;
     }
 
-let (args : t) = make_args ()
 
-let pspec os  (c, ml) = (
+let pspec args os  (c, ml) = (
   let (m1, oth) = match ml with
 	 |	h::t -> (h,t)
 	 |	_ -> ("",[])
@@ -62,13 +61,13 @@ let pspec os  (c, ml) = (
 	 Printf.fprintf os "\n" ;
 )
 
-let options oc = (
+let options args oc = (
 	let l = List.rev args._user_man in
-	List.iter (pspec oc) l
+	List.iter (pspec args oc) l
 )
-let more_options oc = (
+let more_options args oc = (
 	let l = List.rev (args._hidden_man) in
-	List.iter (pspec oc) l
+	List.iter (pspec args oc) l
 )
 let (mkopt : t -> string list -> ?hide:bool -> ?arg:string -> Arg.spec ->
      string list -> unit) =
@@ -83,67 +82,66 @@ let (mkopt : t -> string list -> ?hide:bool -> ?arg:string -> Arg.spec ->
 let myexit i = exit i
 
 (*** User Options Tab **)
-let (mkoptab : t -> unit) = 
-  fun opt ->  
-  let _nl = "\n"^(String.make args._margin ' ') in
+let (mkoptab : string array -> t -> unit) = 
+  fun argv args ->  
     (
-    mkopt opt  ["--synchronous-demon";"-sd"]
+    mkopt args  ["--synchronous-demon";"-sd"]
       (Arg.Unit(fun () -> args.demon <- Demon.Synchronous))
       ["Use a Synchronous deamon"];
 
-    mkopt opt  ["--central-demon";"-cd"]
+    mkopt args  ["--central-demon";"-cd"]
       (Arg.Unit(fun () -> args.demon <- Demon.Central))
       ["Use a Central deamon (which selects exactly one action)"];
     
-    mkopt opt  ["--locally-central-demon";"-lcd"]
+    mkopt args  ["--locally-central-demon";"-lcd"]
       (Arg.Unit(fun () -> args.demon <- Demon.LocallyCentral))
       ["Use a Locally Central deamon (which never activates two neighbors";
        "actions in the same step)"];
-    mkopt opt  ["--distributed-demon";"-dd"]
+    mkopt args  ["--distributed-demon";"-dd"]
       (Arg.Unit(fun () -> args.demon <- Demon.Distributed))
       ["Use a Distributed deamon (which select at least one action)"];
     
-    mkopt opt  ["--custom-demon";"-custd"]
+    mkopt args  ["--custom-demon";"-custd"]
       (Arg.Unit(fun () -> args.demon <- Demon.Custom;args.rif <- true))
       ["Use a Custom deamon (forces --rif)"];
 
-   mkopt opt  ["--rif";"-rif"]
+   mkopt args  ["--rif";"-rif"]
       (Arg.Unit(fun () -> args.rif <- true))
       ["Follows RIF conventions"];
 
-    mkopt opt  ["--seed";"-seed"]
+    mkopt args  ["--seed";"-seed"]
       (Arg.Int(fun i -> args.seed <- i))
       ["Set the pseudo-random generator seed of build-in demons"];
 
-   mkopt opt ~hide:true ["--gen-lutin-demon";"-gld"]
+   mkopt args ~hide:true ["--gen-lutin-demon";"-gld"]
       (Arg.Unit(fun () -> args.gen_lutin <- true))
       ["Generate Lutin demons and exit"];
 
-    mkopt opt ~hide:true ["--ignore-first-inputs"; "-ifi"]
+    mkopt args ~hide:true ["--ignore-first-inputs"; "-ifi"]
       (Arg.Unit(fun () -> args.ifi <- true))
       ["Ignore first inputs (necessary to use luciole via lurette/rdbg/luciole-rif)"];
 
-    mkopt opt ["--length";"-l"] ~arg:" <int>"
+    mkopt args ["--length";"-l"] ~arg:" <int>"
       (Arg.Int (fun i -> args.length <- i))
       ["Maximum number of steps to be done (" ^ (string_of_int args.length) ^ " by default).\n"];
 
-    mkopt opt ~hide:true ["--version";"-version";"-v"]
+    mkopt args ~hide:true ["--version";"-version";"-v"]
       (Arg.Unit (fun _ ->
            (print_string (SasaVersion.str^"-"^SasaVersion.sha^"\n");flush stdout;exit 0)))
       ["Display the sasa version and exit."];
 
-    mkopt opt ~hide:true ["--ocaml-version"]
+    mkopt args ~hide:true ["--ocaml-version"]
       (Arg.Unit (fun _ -> (print_string (Sys.ocaml_version^"\n"); flush stdout; exit 0)))
       ["Display the version ocaml version sasa was compiled with and exit."];
 
-    mkopt opt  ["--verbose";"-vl"] ~arg:" <int>"
+    mkopt args  ["--verbose";"-vl"] ~arg:" <int>"
       (Arg.Int (fun i -> args.verbose <- i))   ["Set the verbose level"];
 
-    mkopt opt ["--help";"-help"; "-h"]
-      (Arg.Unit (fun _ -> print_usage();options stdout; exit 0))
+    mkopt args ["--help";"-help"; "-h"]
+      (Arg.Unit (fun _ -> print_usage (argv.(0)); options args stdout; exit 0))
       ["Display main options"];
 
-    mkopt opt ["--more";"-m"] (Arg.Unit (fun () -> more_options stdout; exit 0)) 
+    mkopt args ["--more";"-m"] (Arg.Unit (fun () -> more_options args stdout; exit 0)) 
       ["Display more options"]
 
   )
@@ -174,8 +172,9 @@ let unexpected s = (
 let parse argv = (
   let save_current = !current in
   try (
-    mkoptab args;
-	 Arg.parse_argv ~current:current argv args._args (add_other args) usage_msg;
+    let args = make_args () in 
+    mkoptab argv args;
+	 Arg.parse_argv ~current:current argv args._args (add_other args) (usage_msg argv.(0));
     (List.iter 
        (fun f -> 
          if (String.sub f 0 1 = "-") then
@@ -189,17 +188,17 @@ let parse argv = (
     args.topo <- (match args._others with
           [] -> 
           Printf.fprintf stderr "*** The topology file is missing in '%s'\n%s\n"
-            (Sys.argv.(0)) usage_msg;
+            (argv.(0)) (usage_msg argv.(0));  
           exit 2; 
         | x::_ -> x
-      )
+      );
+      args
   )
   with
-	   (* only 1rst line is interesting ! *)
   | Arg.Bad msg ->
-    Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (Sys.argv.(0))
-      (first_line msg) usage_msg; exit 2; 
+    Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (argv.(0))
+      (first_line msg) (usage_msg argv.(0)); exit 2; 
   | Arg.Help msg -> 
-    Printf.fprintf stdout "%s\n%s\n" msg usage_msg; 
-    options stdout; exit 0
+    Printf.fprintf stdout "%s\n%s\n" msg (usage_msg argv.(0)); 
+    exit 0
 )

lib/sasacore/sasArg.mli

+(* Time-stamp: <modified the 15/03/2019 (at 22:37) by Erwan> *)
+
+
+type t = {
+  mutable topo: string;
+  mutable length: int;
+  mutable verbose: int;
+  mutable demon: Demon.t;
+  mutable rif: bool;
+  mutable seed: int;
+  mutable ifi: bool;
+  mutable gen_lutin: bool;
+  
+  mutable _args : (string * Arg.spec * string) list;
+  mutable _user_man  : (string * string list) list; 
+  mutable _hidden_man: (string * string list) list; 
+
+  mutable _others : string list;
+  mutable _margin : int;
+}
+
+val usage_msg : string -> string
+
+
+val parse : string array -> t

src/sasa.ml → lib/sasacore/sasa.ml

-(* Time-stamp: <modified the 15/03/2019 (at 17:28) by Erwan Jahier> *)
+(* Time-stamp: <modified the 17/03/2019 (at 11:50) 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
@@ -62,13 +62,11 @@ let (to_algo_neighbor: Env.t -> Topology.neighbor -> Algo.neighbor) =
       n_vars = n.Topology.n_vars
     }
 
-exception Silent of int
-
-
-let (print_step : int -> int -> Env.t -> Process.t list -> string -> string -> unit) =
-  fun n i e pl activate_val enable_val ->
-    if SasArg.args.rif then (
-      if SasArg.args.demon = Demon.Custom then (
+let (print_step : int -> int -> SasArg.t -> Env.t -> Process.t list -> string ->
+     string -> unit) =
+  fun n i args e pl activate_val enable_val ->
+    if args.rif then (
+      if args.demon = Demon.Custom then (
         (* in custom mode, to be able to talk with lurette, this should not be 
            printed on stdout
         *)
@@ -86,12 +84,14 @@ let (print_step : int -> int -> Env.t -> Process.t list -> string -> string -> u
         (string_of_int (n-i+1)) (StringOf.env e pl) activate_val;
       flush stderr
     )
-          
 
-let rec (simu: int -> int -> Process.t list -> string -> 
-         (Process.t * Topology.neighbor list) list -> Env.t -> unit) =
-  fun n i pl activate_val pl_n e ->
+exception Silent of int
+
+let  (simustep: int -> int -> SasArg.t -> Process.t list -> string -> 
+         (Process.t * Topology.neighbor list) list -> Env.t -> Env.t * string) =
+  fun n i args pl activate_val pl_n e ->
     let custom = args.demon = Demon.Custom in
+    (* 1: Get enable processes *)
     let all = List.fold_left
         (fun acc (p,nl) ->
            let nl4algo = List.map (to_algo_neighbor e) nl in
@@ -117,15 +117,14 @@ let rec (simu: int -> int -> Process.t list -> string ->
                            (List.flatten enab_ll))
     in
     if (List.flatten all = []) then (
-      print_step n i e pl activate_val enable_val; 
+      print_step n i args e pl activate_val enable_val; 
       raise (Silent (n-i+1))
     );
-    print_step n i e pl activate_val enable_val;
+    print_step n i args e pl activate_val enable_val;
     let next_activate_val, pnal =
-      Demon.f (SasArg.args.verbose > 1) args.demon pl all enab_ll
+      Demon.f (args.verbose > 1) args.demon pl all enab_ll
     in
-
-    (* Do the steps *)
+    (* 2: Do the steps *)
     let lenv_list =
       List.map (fun (p,nl,a) ->
           let nl4algo = List.map (to_algo_neighbor e) nl in
@@ -133,33 +132,35 @@ let rec (simu: int -> int -> Process.t list -> string ->
           p, p.step nl4algo lenv a)
         pnal
     in
-    (* update the env *)
+    (* 3: update the env *)
     let ne = List.fold_left update_env e lenv_list in
+    ne, next_activate_val
 
-    if i > 0 then simu n (i-1) pl next_activate_val pl_n ne else (
-      if SasArg.args.rif then (
-        print_string "q\n"; flush stdout
-      ))
 
-let () =
-  ( try SasArg.parse Sys.argv;
-	 with
-	   Failure(e) ->
-	   output_string stdout e;
-	   flush stdout ;
-	   exit 2
-	 | e ->
-	   output_string stdout (Printexc.to_string e);
-	   flush stdout;
-	   exit 2
-  );
-  let dot_file = SasArg.args.topo in
-  let nl = Topology.read dot_file in
-  let nstrl = List.map (fun n -> n.Topology.id) nl in
-  let nstr = String.concat "," nstrl in
-  try
-    Algo.verbose_level := SasArg.args.verbose;
-    Random.init SasArg.args.seed;
+
+type t = SasArg.t * Process.t list * (Process.t * Topology.neighbor list) list * Env.t
+
+let (make : string array -> t) =
+  fun argv ->
+    let args = 
+      try SasArg.parse argv;
+	   with
+	     Failure(e) ->
+	     output_string stdout e;
+	     flush stdout ;
+	     exit 2
+	   | e ->
+	     output_string stdout (Printexc.to_string e);
+	     flush stdout;
+	     exit 2
+    in
+    try
+    let dot_file = args.topo in
+    let nl = Topology.read dot_file in
+    let nstrl = List.map (fun n -> n.Topology.id) nl in
+    let nstr = String.concat "," nstrl in
+    Algo.verbose_level := args.verbose;
+    Random.init args.seed;
     if !Algo.verbose_level > 0 then Printf.eprintf "nodes: %s\nedges:\n" nstr;
     let e = Env.init () in
     let pl = List.map (Process.make (args.demon=Custom)) nl in
@@ -168,23 +169,22 @@ let () =
     let e = update_env_with_init e pl algo_neighors in
     let pl_n = List.combine pl neighors in
     if !Algo.verbose_level > 0 then List.iter dump_process pl_n;
-    if SasArg.args.gen_lutin then (
-      let fn = (Filename.remove_extension SasArg.args.topo) ^ ".lut" in
+    if args.gen_lutin then (
+      let fn = (Filename.remove_extension args.topo) ^ ".lut" in
       if Sys.file_exists fn then (
         Printf.eprintf "%s already exists.\n" fn; flush stderr
       ) else 
         let oc = open_out fn in
-          Printf.fprintf oc "%s" (GenLutin.f pl);
-          flush oc;
-          close_out oc;
-          exit 0);
-    let n = SasArg.args.length in
-    if SasArg.args.rif then (
+        Printf.fprintf oc "%s" (GenLutin.f pl);
+        flush oc;
+        close_out oc;
+        exit 0);
+    if args.rif then (
       Printf.printf "%s" (Mypervasives.entete "#" SasaVersion.str SasaVersion.sha);
-      if SasArg.args.demon <> Demon.Custom then
-        Printf.printf "#seed %i\n" SasArg.args.seed;
+      if args.demon <> Demon.Custom then
+        Printf.printf "#seed %i\n" args.seed;
       Printf.printf "#inputs %s\n"
-        (if SasArg.args.demon = Demon.Custom then (
+        (if args.demon = Demon.Custom then (
             let f p = List.map
                 (fun a -> "\""^p.pid ^(if a="" then "" else "_")^a^ "\":bool")
                 p.actions
@@ -194,26 +194,21 @@ let () =
       Printf.printf "#outputs %s\n" (StringOf.env_rif_decl pl);
       flush stdout
     ) else (
-      if SasArg.args.demon <> Demon.Custom then (
-        Printf.printf "The pseudo-random engine is used with seed %i\n" SasArg.args.seed;
+      if args.demon <> Demon.Custom then (
+        Printf.printf "The pseudo-random engine is used with seed %i\n" args.seed;
         flush stdout
       );
     );
-    if SasArg.args.ifi then (
+    if args.ifi then (
       List.iter
         (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;
     );
-    simu n n pl "" pl_n e
-  with
-  | Dynlink.Error e -> Printf.printf "Error: %s\n" (Dynlink.error_message e)
-  | Failure msg -> Printf.printf "Error: %s\n" msg
-  | Silent i ->
-    let str = if SasArg.args.rif then "#" else "" in
-    Printf.printf "%sThis algo is silent after %i steps\n" str i ;
-    flush stdout;
-    if SasArg.args.rif && args.demon = Custom then (
-      print_string "q\n"; flush stdout
-    )
+    args, pl, pl_n, e
+    with
+    | Dynlink.Error e ->
+      Printf.printf "Error: %s\n" (Dynlink.error_message e); flush stdout;
+      exit 2
+    

lib/sasalib/dune

-;; Time-stamp: <modified the 15/03/2019 (at 16:03) by Erwan Jahier>
+;; Time-stamp: <modified the 17/03/2019 (at 11:34) by Erwan Jahier>
 
 (library
  (name     sasalib)
  (public_name  sasalib)
- (libraries dynlink ocamlgraph rdbg-plugin algo sasacore)
+ (libraries dynlink ocamlgraph rdbg-plugin algo sasacore lutils)
  (synopsis "The Sasa rdbg plugin")
 )
 

src/dune

-;; Time-stamp: <modified the 15/03/2019 (at 16:04) by Erwan Jahier>
+;; Time-stamp: <modified the 15/03/2019 (at 23:07) by Erwan>
 
 (executable
- (name sasa)
+ (name sasaMain)
  (libraries dynlink ocamlgraph lutils sasacore  algo)
 )
 
@@ -13,7 +13,7 @@
 
 (install
  (section bin)
-(files (sasa.exe as sasa))
+(files (sasaMain.exe as sasa))
 ; (files sasaRun.cmxa)
 )
 

src/sasaMain.ml

+open Sasacore
+open Sasa
+
+let rec (simuloop: int -> int -> SasArg.t -> Process.t list -> string -> 
+         (Process.t * Topology.neighbor list) list -> Env.t -> unit) =
+  fun n i args pl activate_val pl_n e ->
+
+    let ne, next_activate_val = simustep n i args pl activate_val pl_n e in
+    if i > 0 then simuloop n (i-1) args pl next_activate_val pl_n ne else (
+      if args.rif then (
+        print_string "q\n"; flush stdout
+      ))
+
+let () =
+  let args, pl, pl_n, e = Sasa.make Sys.argv in
+  try
+    let n = args.length in
+    simuloop n n args pl "" pl_n e
+  with
+  | Failure msg -> Printf.printf "Error: %s\n" msg
+  | Silent i ->
+    let str = if args.rif then "#" else "" in
+    Printf.printf "%sThis algo is silent after %i steps\n" str i ;
+    flush stdout;
+    if args.rif && args.demon = Custom then (
+      print_string "q\n"; flush stdout
+    )