From bec863f0726666e91c64228f81631579d0ec0c66 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 23 Oct 2019 12:34:38 +0200
Subject: [PATCH] New: add a --no-data-file
---
lib/sasacore/main.ml | 241 +++++++++++++++++++-------------------
lib/sasacore/sasArg.ml | 15 ++-
lib/sasacore/sasArg.mli | 3 +-
lib/sasacore/topology.mli | 25 ++--
src/sasaMain.ml | 46 ++++----
5 files changed, 171 insertions(+), 159 deletions(-)
diff --git a/lib/sasacore/main.ml b/lib/sasacore/main.ml
index 47f257fd..a6f2b13c 100644
--- a/lib/sasacore/main.ml
+++ b/lib/sasacore/main.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 17/10/2019 (at 11:12) by Erwan Jahier> *)
+(* Time-stamp: <modified the 23/10/2019 (at 09:57) by Erwan Jahier> *)
open Register
@@ -170,134 +170,139 @@ let (env_rif_decl: SasArg.t -> 'v Process.t list -> string) =
let (make : bool -> string array -> 'v t) =
fun dynlink 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 dynlink = if args.output_algos then false else dynlink in
- let dot_file = args.topo in
- let g = Topology.read dot_file in
- let nl = g.nodes in
- if args.output_algos then (
- let fl = List.map (fun n -> n.Topology.file) nl in
- let fl = List.sort_uniq compare fl in
- Printf.printf "%s\n%!" (String.concat " " fl);
- exit 0
- );
- let cmxs = (Filename.chop_extension dot_file) ^ ".cma" in
- if args.gen_register then (
- let base = Filename.chop_extension dot_file in
- let base = Str.global_replace (Str.regexp "\\.") "" base in
- let ml_register_file = base ^ ".ml" in
- let ml_state_file = "state.ml" in
- let algo_files = List.map (fun n -> n.Topology.file) nl in
- let algo_files = List.sort_uniq compare algo_files in
- let ml_inputs = String.concat " " algo_files in
- GenRegister.f algo_files (ml_state_file, ml_register_file);
- Printf.printf "Hint: you may wish to generate %s out of %s with:\n"
- cmxs ml_register_file;
- Printf.printf " ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n%!"
- ml_state_file ml_inputs ml_register_file cmxs;
- exit 0
- );
+ 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 dynlink = if args.output_algos then false else dynlink in
+ let dot_file = args.topo in
+ let g = Topology.read dot_file in
+ let nl = g.nodes in
+ if args.output_algos then (
+ let fl = List.map (fun n -> n.Topology.file) nl in
+ let fl = List.sort_uniq compare fl in
+ Printf.printf "%s\n%!" (String.concat " " fl);
+ exit 0
+ );
+ let cmxs = (Filename.chop_extension dot_file) ^ ".cma" in
+ if args.gen_register then (
+ let base = Filename.chop_extension dot_file in
+ let base = Str.global_replace (Str.regexp "\\.") "" base in
+ let ml_register_file = base ^ ".ml" in
+ let ml_state_file = "state.ml" in
+ let algo_files = List.map (fun n -> n.Topology.file) nl in
+ let algo_files = List.sort_uniq compare algo_files in
+ let ml_inputs = String.concat " " algo_files in
+ GenRegister.f algo_files (ml_state_file, ml_register_file);
+ Printf.printf "Hint: you may wish to generate %s out of %s with:\n"
+ cmxs ml_register_file;
+ Printf.printf " ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n%!"
+ ml_state_file ml_inputs ml_register_file cmxs;
+ exit 0
+ );
- let nidl = List.map (fun n -> n.Topology.id) nl in
- let nstr = String.concat "," nidl in
- Register.set_card (fun () -> List.length nl);
- Register.set_degrees (fun () -> Topology.get_degree g);
- Register.set_mean_deg (fun () -> Topology.get_mean_degree g);
- Register.set_is_connected_cyclic (fun () -> Topology.is_connected_and_cyclic g);
- Register.set_height (Topology.get_height g);
- Register.set_links_number (fun () -> Topology.get_nb_link g false);
- Register.set_diameter (fun () -> Diameter.get g);
+ let nidl = List.map (fun n -> n.Topology.id) nl in
+ let nstr = String.concat "," nidl in
+ Register.set_card (fun () -> List.length nl);
+ Register.set_degrees (fun () -> Topology.get_degree g);
+ Register.set_mean_deg (fun () -> Topology.get_mean_degree g);
+ Register.set_is_connected_cyclic (fun () -> Topology.is_connected_and_cyclic g);
+ Register.set_height (Topology.get_height g);
+ Register.set_links_number (fun () -> Topology.get_nb_link g false);
+ Register.set_diameter (fun () -> Diameter.get g);
+ Register.set_is_directed (fun () -> g.directed);
- Register.verbose_level := args.verbose;
-
- if !Register.verbose_level > 1 then Printf.eprintf "==> nodes: %s\n" nstr;
+ Register.verbose_level := args.verbose;
+
+ if !Register.verbose_level > 1 then Printf.eprintf "==> nodes: %s\n" nstr;
- if dynlink then (
- (* Dynamically link the cmxs file (not possible from rdbg) *)
- let cmxs = Dynlink.adapt_filename cmxs in
- if !Register.verbose_level > 0 then Printf.printf "Loading %s...\n" cmxs;
- Dynlink.loadfile_private cmxs;
- ) else ();
+ if dynlink then (
+ (* Dynamically link the cmxs file (not possible from rdbg) *)
+ let cmxs = Dynlink.adapt_filename cmxs in
+ if !Register.verbose_level > 0 then Printf.printf "Loading %s...\n" cmxs;
+ Dynlink.loadfile_private cmxs;
+ ) else ();
- let initl = List.map (fun n ->
- let algo_id = Filename.chop_suffix n.Topology.file ".ml" in
- let value_of_string_opt = Register.get_value_of_string () in
- if value_of_string_opt = None || n.Topology.init = "" then
- Register.get_init_state algo_id (List.length (g.succ n.id))
- else
- match value_of_string_opt with
- | None -> assert false (* sno *)
- | Some f -> f n.Topology.init
- )
- nl
- in
+ let initl = List.map (fun n ->
+ let algo_id = Filename.chop_suffix n.Topology.file ".ml" in
+ let value_of_string_opt = Register.get_value_of_string () in
+ if value_of_string_opt = None || n.Topology.init = "" then
+ Register.get_init_state algo_id (List.length (g.succ n.id))
+ else
+ match value_of_string_opt with
+ | None -> assert false (* sno *)
+ | Some f -> f n.Topology.init
+ )
+ nl
+ in
- if !Register.verbose_level > 0 then Printf.eprintf "==> get_neighors\n";
- let algo_neighors = List.map2 (get_neighors g) nidl initl in
- let pl = List.map2 (Process.make (args.demon=Custom)) nl initl in
- let e = Env.init () in
- let e = update_env_with_init e pl in
- let pl_n = List.combine pl algo_neighors in
- if !Register.verbose_level > 1 then List.iter dump_process pl_n;
- 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: rename it to proceed.\n%!" fn;
- exit 1
- ) else
- let oc = open_out fn in
- Printf.fprintf oc "%s%!" (GenLutin.f pl);
- close_out oc;
- exit 0);
- if args.gen_oracle then (
- let fn = (Filename.remove_extension args.topo) ^ "_oracle.lus" in
- if Sys.file_exists fn then (
- Printf.eprintf "%s already exists: rename it to proceed.\n%!" fn; exit 1
- ) else
- let oc = open_out fn in
- Printf.fprintf oc "%s%!" (GenOracle.f g pl);
- close_out oc;
- exit 0);
- let seed = seed_get args in
+ if !Register.verbose_level > 0 then Printf.eprintf "==> get_neighors\n";
+ let algo_neighors = List.map2 (get_neighors g) nidl initl in
+ let pl = List.map2 (Process.make (args.demon=Custom)) nl initl in
+ let e = Env.init () in
+ let e = update_env_with_init e pl in
+ let pl_n = List.combine pl algo_neighors in
+ if !Register.verbose_level > 1 then List.iter dump_process pl_n;
+ 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: rename it to proceed.\n%!" fn;
+ exit 1
+ ) else
+ let oc = open_out fn in
+ Printf.fprintf oc "%s%!" (GenLutin.f pl);
+ close_out oc;
+ exit 0);
+ if args.gen_oracle then (
+ let fn = (Filename.remove_extension args.topo) ^ "_oracle.lus" in
+ if Sys.file_exists fn then (
+ Printf.eprintf "%s already exists: rename it to proceed.\n%!" fn; exit 1
+ ) else
+ let oc = open_out fn in
+ Printf.fprintf oc "%s%!" (GenOracle.f g pl);
+ close_out oc;
+ exit 0);
+ let seed = seed_get args in
+ if args.no_data_file then () else (
let oc = if args.rif then stderr else stdout in
if !Register.verbose_level > 0 then Printf.eprintf "==> open rif file...\n%!";
Printf.fprintf oc "%s" (Mypervasives.entete "#" SasaVersion.str SasaVersion.sha);
Printf.fprintf oc "#seed %i\n" seed;
- if !Register.verbose_level > 0 then Printf.eprintf "==> get input var names...\n%!";
let inputs_decl = get_inputs_rif_decl args pl in
Printf.printf "#inputs ";
+ if !Register.verbose_level > 0 then
+ Printf.eprintf "==> get input var names...\n%!";
List.iter (fun (vn,vt) -> Printf.printf "\"%s\":%s " vn vt) inputs_decl;
Printf.printf "\n%!";
- if !Register.verbose_level > 0 then Printf.eprintf "==> get output var names...\n%!";
+ if !Register.verbose_level > 0 then
+ Printf.eprintf "==> get output var names...\n%!";
Printf.printf "#outputs %s\n" (env_rif_decl args pl);
- Printf.printf "\n%!";
- if args.ifi then (
- if !Register.verbose_level > 0 then Printf.eprintf "==> read bool...\n%!";
- List.iter
- (fun p -> List.iter
- (fun a -> ignore (RifRead.bool (args.verbose>1) p.pid a)) p.actions)
- pl;
- Printf.eprintf "Ignoring the first vectors of sasa inputs\n%!";
- );
- if !Register.verbose_level > 0 then Printf.eprintf "==> Main.make done !\n%!";
- args, pl_n, e
- with
- | Dynlink.Error e ->
- Printf.printf "Error when dynlinking (Sasacore.make): %s\n%!"
- (Dynlink.error_message e);
- exit 2
- | e ->
- Printf.printf "Error (Sasacore.make): %s\n%!" (Printexc.to_string e);
- exit 2
+ Printf.printf "\n%!"
+ );
+ if args.ifi then (
+ if !Register.verbose_level > 0 then Printf.eprintf "==> read bool...\n%!";
+ List.iter
+ (fun p -> List.iter
+ (fun a -> ignore (RifRead.bool (args.verbose>1) p.pid a)) p.actions)
+ pl;
+ Printf.eprintf "Ignoring the first vectors of sasa inputs\n%!";
+ );
+ if !Register.verbose_level > 0 then Printf.eprintf "==> Main.make done !\n%!";
+ args, pl_n, e
+ with
+ | Dynlink.Error e ->
+ Printf.printf "Error when dynlinking (Sasacore.make): %s\n%!"
+ (Dynlink.error_message e);
+ exit 2
+ | e ->
+ Printf.printf "Error (Sasacore.make): %s\n%!" (Printexc.to_string e);
+ exit 2
diff --git a/lib/sasacore/sasArg.ml b/lib/sasacore/sasArg.ml
index 06d613f2..635e9def 100644
--- a/lib/sasacore/sasArg.ml
+++ b/lib/sasacore/sasArg.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/10/2019 (at 21:51) by Erwan Jahier> *)
+(* Time-stamp: <modified the 23/10/2019 (at 09:51) by Erwan Jahier> *)
type t = {
@@ -7,6 +7,7 @@ type t = {
mutable verbose: int;
mutable demon: Demon.t;
mutable rif: bool;
+ mutable no_data_file: bool;
mutable seed: int option;
mutable replay_seed: bool;
mutable ifi: bool;
@@ -38,6 +39,7 @@ let (make_args : unit -> t) =
verbose = 0;
demon = Demon.Distributed;
rif = false;
+ no_data_file = false;
seed = None;
replay_seed = false;
ifi = false;
@@ -164,10 +166,14 @@ let (mkoptab : string array -> t -> unit) =
(Arg.Unit(fun () -> args.demon <- Demon.Custom;args.rif <- true))
["Use a Custom demon (forces --rif)"];
- mkopt args ["--rif";"-rif"]
+ mkopt args ~hide:true ["--rif";"-rif"]
(Arg.Unit(fun () -> args.rif <- true))
["Display only outputs on stdout (i.e., behave as a rif input file)"];
+ mkopt args ~hide:true ["--no-data-file";"-nd"]
+ (Arg.Unit(fun () -> args.no_data_file <- true))
+ ["Do not generate any data file"];
+
mkopt args ["--seed";"-seed"]
(Arg.Int(fun i -> seed_set args (Some i)))
["Set the pseudo-random generator seed of build-in demons (wins over --replay)"];
@@ -190,10 +196,7 @@ let (mkoptab : string array -> t -> unit) =
mkopt args ~hide:false ["--gen-register";"-reg"]
(Arg.Unit(fun () -> args.gen_register <- true))
- ["Generates the registering file and exit.
-
-
- "];
+ ["Generates the registering file and exit. "];
mkopt args ~hide:true ["--dummy-input"]
(Arg.Unit(fun () -> args.dummy_input <- true))
diff --git a/lib/sasacore/sasArg.mli b/lib/sasacore/sasArg.mli
index 3c3d2593..f096ef34 100644
--- a/lib/sasacore/sasArg.mli
+++ b/lib/sasacore/sasArg.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/10/2019 (at 16:11) by Erwan Jahier> *)
+(* Time-stamp: <modified the 23/10/2019 (at 08:55) by Erwan Jahier> *)
type t = {
mutable topo: string;
@@ -6,6 +6,7 @@ type t = {
mutable verbose: int;
mutable demon: Demon.t;
mutable rif: bool;
+ mutable no_data_file: bool;
mutable seed: int option;
mutable replay_seed: bool;
mutable ifi: bool;
diff --git a/lib/sasacore/topology.mli b/lib/sasacore/topology.mli
index 9f2fde2c..dd2f690e 100644
--- a/lib/sasacore/topology.mli
+++ b/lib/sasacore/topology.mli
@@ -1,30 +1,31 @@
-(* Time-stamp: <modified the 17/10/2019 (at 20:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 23/10/2019 (at 11:04) by Erwan Jahier> *)
type node_id = string
type node = {
- id: node_id; (* The id of the node as stated in the dot file *)
- file: string; (* the content of the algo field (a cxms file) *)
- init: string; (* store the content of the init field *)
+ id: node_id; (** The id of the node as stated in the dot file *)
+ file: string; (** the content of the algo field (a ml file) *)
+ init: string; (** store the content of the init field *)
}
type t = {
- nodes: node list;
- succ: node_id -> (int option * node_id) list;
- of_id: node_id -> node;
- directed:bool
+ nodes: node list; (** *)
+ succ: node_id -> (int option * node_id) list; (** get neighbors, with weigth if any *)
+ of_id: node_id -> node; (** *)
+ directed:bool (** true if the graph is directed *)
}
(** Parse a sasa dot file *)
val read: string -> t
+(** Various eponymous utils *)
+
val to_adjency: t -> bool array array
-val get_degree: t -> int*int
val get_nb_link: t -> bool -> int
val get_mean_degree : t -> float
-val is_connected_and_cyclic : t -> bool*bool
+val is_connected_and_cyclic : t -> bool * bool
val height : string list -> t -> string -> int
val get_height : t -> string -> int
-
-
+(** Watch out, computing the degree is expensive *)
+val get_degree: t -> int * int
diff --git a/src/sasaMain.ml b/src/sasaMain.ml
index c42cfc7b..7f126aa7 100644
--- a/src/sasaMain.ml
+++ b/src/sasaMain.ml
@@ -1,31 +1,33 @@
open Sasacore
let (print_step : int -> int -> SasArg.t -> 'v Env.t -> 'v Process.t list -> string ->
- bool list list -> unit) =
+ bool list list -> unit) =
fun n i args e pl activate_val enab_ll ->
- let enable_val =
- String.concat " " (List.map (fun b -> if b then "t" else "f")
- (List.flatten enab_ll))
- in
- if args.demon = Demon.Custom then (
- (* in custom mode, to be able to talk with lurette, this should not be
+ let enable_val =
+ String.concat " " (List.map (fun b -> if b then "t" else "f")
+ (List.flatten enab_ll))
+ in
+ if args.no_data_file then () else (
+ if args.demon = Demon.Custom then (
+ (* in custom mode, to be able to talk with lurette, this should not be
printed on stdout
- *)
- Printf.eprintf "\n#step %s\n" (string_of_int (n-i+1)) ;
- Printf.eprintf "%s #outs " activate_val; flush stderr;
- Printf.printf "%s %s\n" (StringOf.env_rif e pl) enable_val;
- ) else (
- (* rif mode, internal demons *)
- if args.rif then
- Printf.printf " %s %s %s\n" (StringOf.env_rif e pl) enable_val activate_val
- else (
- Printf.printf "\n#step %s\n" (string_of_int (n-i+1));
- Printf.printf "#outs %s %s %s\n" (StringOf.env_rif e pl) enable_val activate_val
- );
+ *)
+ Printf.eprintf "\n#step %s\n" (string_of_int (n-i+1)) ;
+ Printf.eprintf "%s #outs " activate_val; flush stderr;
+ Printf.printf "%s %s\n" (StringOf.env_rif e pl) enable_val;
+ ) else (
+ (* rif mode, internal demons *)
+ if args.rif then
+ Printf.printf " %s %s %s\n" (StringOf.env_rif e pl) enable_val activate_val
+ else (
+ Printf.printf "\n#step %s\n" (string_of_int (n-i+1));
+ Printf.printf "#outs %s %s %s\n" (StringOf.env_rif e pl) enable_val activate_val
);
- flush stderr;
- flush stdout
-
+ );
+ flush stderr;
+ flush stdout
+ )
+
exception Silent of int
let (simustep: int -> int -> SasArg.t -> string ->
--
GitLab