diff --git a/bin/sasArg.ml b/bin/sasArg.ml
new file mode 100644
index 0000000000000000000000000000000000000000..eae36008a6cdb515bd467057e7ed5452a53cc6d2
--- /dev/null
+++ b/bin/sasArg.ml
@@ -0,0 +1,176 @@
+(* Time-stamp: <modified the 07/03/2019 (at 10:35) by Erwan> *)
+
+
+type t = {
+ mutable topo: string;
+ mutable length: int;
+ mutable verbose: int;
+ mutable demon: Demon.t;
+
+ 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;
+}
+
+let usage_msg = ("usage: " ^Sys.argv.(0) ^ " [<option>] [<topology>.dot file]
+use --help to see the available options.
+" )
+let print_usage () = Printf.printf "%s\n" usage_msg; flush stdout
+
+
+let (make_args : unit -> t) =
+ fun () ->
+ {
+ topo = "";
+ length = 100;
+ verbose = 0;
+ demon = Demon.Distributed;
+ _args = [];
+ _user_man = [];
+ _hidden_man = [];
+ _others = [];
+ _margin =12;
+ }
+
+let (args : t) = make_args ()
+
+let pspec os (c, ml) = (
+ let (m1, oth) = match ml with
+ | h::t -> (h,t)
+ | _ -> ("",[])
+ in
+ let t2 = String.make args._margin ' ' in
+ let cl = String.length c in
+ let t1 = if (cl < args._margin ) then
+ String.make (args._margin - cl) ' '
+ else
+ "\n"^t2
+ in
+ Printf.fprintf os "%s%s%s" c t1 m1;
+ List.iter (function x -> Printf.fprintf os "\n%s%s" t2 x) oth ;
+ Printf.fprintf os "\n" ;
+)
+
+let options oc = (
+ let l = List.rev args._user_man in
+ List.iter (pspec oc) l
+)
+let more_options oc = (
+ let l = List.rev (args._hidden_man) in
+ List.iter (pspec oc) l
+)
+let (mkopt : t -> string list -> ?hide:bool -> ?arg:string -> Arg.spec ->
+ string list -> unit) =
+ fun opt ol ?(hide=false) ?(arg="") se ml ->
+ let treto o = opt._args <- (o, se, "")::opt._args in
+ List.iter treto ol ;
+ let col1 = (String.concat ", " ol)^arg in
+ if hide
+ then opt._hidden_man <- (col1, ml)::opt._hidden_man
+ else opt._user_man <- (col1, ml)::opt._user_man
+
+let myexit i = exit i
+
+(*** User Options Tab **)
+let (mkoptab : t -> unit) =
+ fun opt ->
+ let _nl = "\n"^(String.make args._margin ' ') in
+ (
+ mkopt opt ["--synchronous-demon";"-sd"]
+ (Arg.Unit(fun () -> args.demon <- Demon.Synchronous))
+ ["Use a Synchronous deamon"];
+
+ mkopt opt ["--central-demon";"-cd"]
+ (Arg.Unit(fun () -> args.demon <- Demon.Synchronous))
+ ["Use a Central deamon (selects exactly one action)"];
+
+ mkopt opt ["--locally-central-demon";"-lcd"]
+ (Arg.Unit(fun () -> args.demon <- Demon.Synchronous))
+ ["Use a Locally Central deamon (never activates two neighbor";
+ "actions in the same step)"];
+ mkopt opt ["--distributed-demon";"-dd"]
+ (Arg.Unit(fun () -> args.demon <- Demon.Synchronous))
+ ["Use a Distributed deamon (select at least one action)"];
+
+ mkopt opt ["--custom-demon";"-custd"]
+ (Arg.Unit(fun () -> args.demon <- Demon.Synchronous))
+ ["Use a Custom deamon"];
+
+ mkopt opt ["--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 ["--ocaml-version"]
+ (Arg.Unit (fun _ -> (print_string (Sys.ocaml_version) ; flush stdout; exit 0)))
+ ["Display the version ocaml version sasa was compiled with and exit."];
+
+ mkopt opt ["--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))
+ ["Display main options"];
+
+ mkopt opt ["--more";"-m"] (Arg.Unit (fun () -> more_options stdout; exit 0))
+ ["Display more options"]
+
+ )
+
+(* all unrecognized options are accumulated *)
+let (add_other : t -> string -> unit) =
+ fun opt s ->
+ opt._others <- s::opt._others
+
+let current = ref 0;;
+let first_line b = (
+ try (
+ let f = String.index b '\n' in
+ String.sub b 0 f
+ ) with Not_found -> b
+)
+let file_notfound f = (
+ prerr_string ("File not found: \""^f^"\"");
+ prerr_newline ();
+ myexit 1
+)
+let unexpected s = (
+ prerr_string ("unexpected argument \""^s^"\"");
+ prerr_newline ();
+ myexit 1
+)
+
+let parse argv = (
+ let save_current = !current in
+ try (
+ mkoptab args;
+ Arg.parse_argv ~current:current argv args._args (add_other args) usage_msg;
+ (List.iter
+ (fun f ->
+ if (String.sub f 0 1 = "-") then
+ unexpected f
+ else if not (Sys.file_exists f) then
+ file_notfound f
+ else ()
+ )
+ args._others);
+ current := save_current;
+ args.topo <- (match args._others with
+ [] ->
+ Printf.fprintf stderr "*** The topology file is missing in '%s'\n%s\n"
+ (Sys.argv.(0)) usage_msg;
+ exit 2;
+ | x::_ -> x
+ )
+ )
+ 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;
+ | Arg.Help msg ->
+ Printf.fprintf stdout "%s\n%s\n" msg usage_msg;
+ options stdout; exit 0
+)
diff --git a/bin/sasa.ml b/bin/sasa.ml
index 7e9f14a83884c98dd451a1365a2ee59861c6a901..4743e27efdb72d802460b4a5780ff9f4b5f81ada 100644
--- a/bin/sasa.ml
+++ b/bin/sasa.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/03/2019 (at 09:43) by Erwan> *)
+(* Time-stamp: <modified the 07/03/2019 (at 10:29) by Erwan> *)
(* XXX Je pourrais utiliser Lwt pour rendre step non-bloquant, ce qui
permettrait d'accelerer la simu sur les machines qui ont plusieurs
@@ -63,7 +63,8 @@ let (update_env: Env.t -> Process.t * Algo.local_env -> Env.t) =
p.variables
open Process
-
+open SasArg
+
let (to_algo_neighbor: Env.t -> Topology.neighbor -> Algo.neighbor) =
fun e n ->
{
@@ -86,7 +87,7 @@ let rec (simu: int -> int -> Process.t list ->
[] pl_n
in
assert (all <> []);
- let al = Demon.f Demon.Distributed all in
+ let al = Demon.f args.demon all in
(* Do the steps *)
let lenv_list =
@@ -109,12 +110,25 @@ let rec (simu: int -> int -> Process.t list ->
| _ -> if i > 0 then simu n (i-1) pl pl_n ne else ()
let () =
- let dot_file = Sys.argv.(1) in
+ ( 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 :=1;
+ Algo.verbose_level := SasArg.args.verbose;
Random.self_init();
Printf.printf "nodes: %s\nedges:\n" nstr;
let e = Env.init () in
@@ -123,6 +137,6 @@ let () =
let neighors = List.map get_neighors pl in
let pl_n = List.combine pl neighors in
List.iter dump_process pl_n;
- let n = (int_of_string Sys.argv.(2)) in
+ let n = SasArg.args.length in
simu n n pl pl_n e
with Dynlink.Error e -> Printf.printf "E: %s\n"(Dynlink.error_message e)
diff --git a/test/dijkstra-ring/Makefile b/test/dijkstra-ring/Makefile
index b0baebca1089a15fc2c157ccb1c3a5b9b0688b09..39eb0379c47bbe94f9a38e8719dbf72974069e39 100644
--- a/test/dijkstra-ring/Makefile
+++ b/test/dijkstra-ring/Makefile
@@ -13,7 +13,7 @@ MLI=-I $(DIR)/lib/algo
ocamlopt -shared $(MLI) $^ -o $@
test: ring.cmxs ringroot.cmxs
- $(sasa) ring.dot 150
+ $(sasa) ring.dot
clean:
rm -f *.cmxs sasa *.cmi *.o *.cmx *.pdf