Skip to content
Snippets Groups Projects
Commit bec863f0 authored by erwan's avatar erwan
Browse files

New: add a --no-data-file

parent e6c1c102
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
lib/sasacore/main.ml
+ 123
− 118
View file @ bec863f0
(* 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
lib/sasacore/sasArg.ml
+ 9
− 6
View file @ bec863f0
(* 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))
......
lib/sasacore/sasArg.mli
+ 2
− 1
View file @ bec863f0
(* 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;
......
lib/sasacore/topology.mli
+ 13
− 12
View file @ bec863f0
(* 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
src/sasaMain.ml
+ 24
− 22
View file @ bec863f0
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 ->
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment