From 44fa68e2f2ccac08f12247b8b84017db0095ce4c Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Sun, 17 Mar 2019 12:06:46 +0100
Subject: [PATCH] Update: continue to refactor files and functions for SasaRun
implementation
---
.merlin | 6 +-
Makefile.version | 3 +-
lib/sasacore/sasArg.ml | 75 ++++++++++----------
lib/sasacore/sasArg.mli | 25 +++++++
{src => lib/sasacore}/sasa.ml | 127 ++++++++++++++++------------------
lib/sasalib/dune | 4 +-
src/dune | 6 +-
src/sasaMain.ml | 27 ++++++++
8 files changed, 161 insertions(+), 112 deletions(-)
create mode 100644 lib/sasacore/sasArg.mli
rename {src => lib/sasacore}/sasa.ml (69%)
create mode 100644 src/sasaMain.ml
diff --git a/.merlin b/.merlin
index 0a7376f6..46441a54 100644
--- a/.merlin
+++ b/.merlin
@@ -1,8 +1,10 @@
-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
diff --git a/Makefile.version b/Makefile.version
index a0b49833..50094420 100644
--- a/Makefile.version
+++ b/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 ;
diff --git a/lib/sasacore/sasArg.ml b/lib/sasacore/sasArg.ml
index af4c3e86..3a9f473f 100644
--- a/lib/sasacore/sasArg.ml
+++ b/lib/sasacore/sasArg.ml
@@ -1,4 +1,4 @@
-(* 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
)
diff --git a/lib/sasacore/sasArg.mli b/lib/sasacore/sasArg.mli
new file mode 100644
index 00000000..77b81b62
--- /dev/null
+++ b/lib/sasacore/sasArg.mli
@@ -0,0 +1,25 @@
+(* 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
diff --git a/src/sasa.ml b/lib/sasacore/sasa.ml
similarity index 69%
rename from src/sasa.ml
rename to lib/sasacore/sasa.ml
index 40115cbb..5175a77d 100644
--- a/src/sasa.ml
+++ b/lib/sasacore/sasa.ml
@@ -1,4 +1,4 @@
-(* 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
+
diff --git a/lib/sasalib/dune b/lib/sasalib/dune
index eaa1558b..644a9a8a 100644
--- a/lib/sasalib/dune
+++ b/lib/sasalib/dune
@@ -1,9 +1,9 @@
-;; 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")
)
diff --git a/src/dune b/src/dune
index 772ce39a..6db187e4 100644
--- a/src/dune
+++ b/src/dune
@@ -1,7 +1,7 @@
-;; 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)
)
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
new file mode 100644
index 00000000..b6b28869
--- /dev/null
+++ b/src/sasaMain.ml
@@ -0,0 +1,27 @@
+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
+ )
--
GitLab