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 open Register
...@@ -170,134 +170,139 @@ let (env_rif_decl: SasArg.t -> 'v Process.t list -> string) = ...@@ -170,134 +170,139 @@ let (env_rif_decl: SasArg.t -> 'v Process.t list -> string) =
let (make : bool -> string array -> 'v t) = let (make : bool -> string array -> 'v t) =
fun dynlink argv -> fun dynlink argv ->
let args = let args =
try SasArg.parse argv; try SasArg.parse argv;
with with
Failure(e) -> Failure(e) ->
output_string stdout e; output_string stdout e;
flush stdout ; flush stdout ;
exit 2 exit 2
| e -> | e ->
output_string stdout (Printexc.to_string e); output_string stdout (Printexc.to_string e);
flush stdout; flush stdout;
exit 2 exit 2
in in
try try
let dynlink = if args.output_algos then false else dynlink in let dynlink = if args.output_algos then false else dynlink in
let dot_file = args.topo in let dot_file = args.topo in
let g = Topology.read dot_file in let g = Topology.read dot_file in
let nl = g.nodes in let nl = g.nodes in
if args.output_algos then ( if args.output_algos then (
let fl = List.map (fun n -> n.Topology.file) nl in let fl = List.map (fun n -> n.Topology.file) nl in
let fl = List.sort_uniq compare fl in let fl = List.sort_uniq compare fl in
Printf.printf "%s\n%!" (String.concat " " fl); Printf.printf "%s\n%!" (String.concat " " fl);
exit 0 exit 0
); );
let cmxs = (Filename.chop_extension dot_file) ^ ".cma" in let cmxs = (Filename.chop_extension dot_file) ^ ".cma" in
if args.gen_register then ( if args.gen_register then (
let base = Filename.chop_extension dot_file in let base = Filename.chop_extension dot_file in
let base = Str.global_replace (Str.regexp "\\.") "" base in let base = Str.global_replace (Str.regexp "\\.") "" base in
let ml_register_file = base ^ ".ml" in let ml_register_file = base ^ ".ml" in
let ml_state_file = "state.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.map (fun n -> n.Topology.file) nl in
let algo_files = List.sort_uniq compare algo_files in let algo_files = List.sort_uniq compare algo_files in
let ml_inputs = String.concat " " algo_files in let ml_inputs = String.concat " " algo_files in
GenRegister.f algo_files (ml_state_file, ml_register_file); GenRegister.f algo_files (ml_state_file, ml_register_file);
Printf.printf "Hint: you may wish to generate %s out of %s with:\n" Printf.printf "Hint: you may wish to generate %s out of %s with:\n"
cmxs ml_register_file; cmxs ml_register_file;
Printf.printf " ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n%!" Printf.printf " ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n%!"
ml_state_file ml_inputs ml_register_file cmxs; ml_state_file ml_inputs ml_register_file cmxs;
exit 0 exit 0
); );
let nidl = List.map (fun n -> n.Topology.id) nl in let nidl = List.map (fun n -> n.Topology.id) nl in
let nstr = String.concat "," nidl in let nstr = String.concat "," nidl in
Register.set_card (fun () -> List.length nl); Register.set_card (fun () -> List.length nl);
Register.set_degrees (fun () -> Topology.get_degree g); Register.set_degrees (fun () -> Topology.get_degree g);
Register.set_mean_deg (fun () -> Topology.get_mean_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_is_connected_cyclic (fun () -> Topology.is_connected_and_cyclic g);
Register.set_height (Topology.get_height g); Register.set_height (Topology.get_height g);
Register.set_links_number (fun () -> Topology.get_nb_link g false); Register.set_links_number (fun () -> Topology.get_nb_link g false);
Register.set_diameter (fun () -> Diameter.get g); Register.set_diameter (fun () -> Diameter.get g);
Register.set_is_directed (fun () -> g.directed);
Register.verbose_level := args.verbose; Register.verbose_level := args.verbose;
if !Register.verbose_level > 1 then Printf.eprintf "==> nodes: %s\n" nstr; if !Register.verbose_level > 1 then Printf.eprintf "==> nodes: %s\n" nstr;
if dynlink then ( if dynlink then (
(* Dynamically link the cmxs file (not possible from rdbg) *) (* Dynamically link the cmxs file (not possible from rdbg) *)
let cmxs = Dynlink.adapt_filename cmxs in let cmxs = Dynlink.adapt_filename cmxs in
if !Register.verbose_level > 0 then Printf.printf "Loading %s...\n" cmxs; if !Register.verbose_level > 0 then Printf.printf "Loading %s...\n" cmxs;
Dynlink.loadfile_private cmxs; Dynlink.loadfile_private cmxs;
) else (); ) else ();
let initl = List.map (fun n -> let initl = List.map (fun n ->
let algo_id = Filename.chop_suffix n.Topology.file ".ml" in let algo_id = Filename.chop_suffix n.Topology.file ".ml" in
let value_of_string_opt = Register.get_value_of_string () in let value_of_string_opt = Register.get_value_of_string () in
if value_of_string_opt = None || n.Topology.init = "" then if value_of_string_opt = None || n.Topology.init = "" then
Register.get_init_state algo_id (List.length (g.succ n.id)) Register.get_init_state algo_id (List.length (g.succ n.id))
else else
match value_of_string_opt with match value_of_string_opt with
| None -> assert false (* sno *) | None -> assert false (* sno *)
| Some f -> f n.Topology.init | Some f -> f n.Topology.init
) )
nl nl
in in
if !Register.verbose_level > 0 then Printf.eprintf "==> get_neighors\n"; if !Register.verbose_level > 0 then Printf.eprintf "==> get_neighors\n";
let algo_neighors = List.map2 (get_neighors g) nidl initl in let algo_neighors = List.map2 (get_neighors g) nidl initl in
let pl = List.map2 (Process.make (args.demon=Custom)) nl initl in let pl = List.map2 (Process.make (args.demon=Custom)) nl initl in
let e = Env.init () in let e = Env.init () in
let e = update_env_with_init e pl in let e = update_env_with_init e pl in
let pl_n = List.combine pl algo_neighors in let pl_n = List.combine pl algo_neighors in
if !Register.verbose_level > 1 then List.iter dump_process pl_n; if !Register.verbose_level > 1 then List.iter dump_process pl_n;
if args.gen_lutin then ( if args.gen_lutin then (
let fn = (Filename.remove_extension args.topo) ^ ".lut" in let fn = (Filename.remove_extension args.topo) ^ ".lut" in
if Sys.file_exists fn then ( if Sys.file_exists fn then (
Printf.eprintf "%s already exists: rename it to proceed.\n%!" fn; Printf.eprintf "%s already exists: rename it to proceed.\n%!" fn;
exit 1 exit 1
) else ) else
let oc = open_out fn in let oc = open_out fn in
Printf.fprintf oc "%s%!" (GenLutin.f pl); Printf.fprintf oc "%s%!" (GenLutin.f pl);
close_out oc; close_out oc;
exit 0); exit 0);
if args.gen_oracle then ( if args.gen_oracle then (
let fn = (Filename.remove_extension args.topo) ^ "_oracle.lus" in let fn = (Filename.remove_extension args.topo) ^ "_oracle.lus" in
if Sys.file_exists fn then ( if Sys.file_exists fn then (
Printf.eprintf "%s already exists: rename it to proceed.\n%!" fn; exit 1 Printf.eprintf "%s already exists: rename it to proceed.\n%!" fn; exit 1
) else ) else
let oc = open_out fn in let oc = open_out fn in
Printf.fprintf oc "%s%!" (GenOracle.f g pl); Printf.fprintf oc "%s%!" (GenOracle.f g pl);
close_out oc; close_out oc;
exit 0); exit 0);
let seed = seed_get args in let seed = seed_get args in
if args.no_data_file then () else (
let oc = if args.rif then stderr else stdout in let oc = if args.rif then stderr else stdout in
if !Register.verbose_level > 0 then Printf.eprintf "==> open rif file...\n%!"; 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 "%s" (Mypervasives.entete "#" SasaVersion.str SasaVersion.sha);
Printf.fprintf oc "#seed %i\n" seed; 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 let inputs_decl = get_inputs_rif_decl args pl in
Printf.printf "#inputs "; 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; List.iter (fun (vn,vt) -> Printf.printf "\"%s\":%s " vn vt) inputs_decl;
Printf.printf "\n%!"; 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 "#outputs %s\n" (env_rif_decl args pl);
Printf.printf "\n%!"; Printf.printf "\n%!"
if args.ifi then ( );
if !Register.verbose_level > 0 then Printf.eprintf "==> read bool...\n%!"; if args.ifi then (
List.iter if !Register.verbose_level > 0 then Printf.eprintf "==> read bool...\n%!";
(fun p -> List.iter List.iter
(fun a -> ignore (RifRead.bool (args.verbose>1) p.pid a)) p.actions) (fun p -> List.iter
pl; (fun a -> ignore (RifRead.bool (args.verbose>1) p.pid a)) p.actions)
Printf.eprintf "Ignoring the first vectors of sasa inputs\n%!"; 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 if !Register.verbose_level > 0 then Printf.eprintf "==> Main.make done !\n%!";
with args, pl_n, e
| Dynlink.Error e -> with
Printf.printf "Error when dynlinking (Sasacore.make): %s\n%!" | Dynlink.Error e ->
(Dynlink.error_message e); Printf.printf "Error when dynlinking (Sasacore.make): %s\n%!"
exit 2 (Dynlink.error_message e);
| e -> exit 2
Printf.printf "Error (Sasacore.make): %s\n%!" (Printexc.to_string e); | e ->
exit 2 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 = { type t = {
...@@ -7,6 +7,7 @@ type t = { ...@@ -7,6 +7,7 @@ type t = {
mutable verbose: int; mutable verbose: int;
mutable demon: Demon.t; mutable demon: Demon.t;
mutable rif: bool; mutable rif: bool;
mutable no_data_file: bool;
mutable seed: int option; mutable seed: int option;
mutable replay_seed: bool; mutable replay_seed: bool;
mutable ifi: bool; mutable ifi: bool;
...@@ -38,6 +39,7 @@ let (make_args : unit -> t) = ...@@ -38,6 +39,7 @@ let (make_args : unit -> t) =
verbose = 0; verbose = 0;
demon = Demon.Distributed; demon = Demon.Distributed;
rif = false; rif = false;
no_data_file = false;
seed = None; seed = None;
replay_seed = false; replay_seed = false;
ifi = false; ifi = false;
...@@ -164,10 +166,14 @@ let (mkoptab : string array -> t -> unit) = ...@@ -164,10 +166,14 @@ let (mkoptab : string array -> t -> unit) =
(Arg.Unit(fun () -> args.demon <- Demon.Custom;args.rif <- true)) (Arg.Unit(fun () -> args.demon <- Demon.Custom;args.rif <- true))
["Use a Custom demon (forces --rif)"]; ["Use a Custom demon (forces --rif)"];
mkopt args ["--rif";"-rif"] mkopt args ~hide:true ["--rif";"-rif"]
(Arg.Unit(fun () -> args.rif <- true)) (Arg.Unit(fun () -> args.rif <- true))
["Display only outputs on stdout (i.e., behave as a rif input file)"]; ["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"] mkopt args ["--seed";"-seed"]
(Arg.Int(fun i -> seed_set args (Some i))) (Arg.Int(fun i -> seed_set args (Some i)))
["Set the pseudo-random generator seed of build-in demons (wins over --replay)"]; ["Set the pseudo-random generator seed of build-in demons (wins over --replay)"];
...@@ -190,10 +196,7 @@ let (mkoptab : string array -> t -> unit) = ...@@ -190,10 +196,7 @@ let (mkoptab : string array -> t -> unit) =
mkopt args ~hide:false ["--gen-register";"-reg"] mkopt args ~hide:false ["--gen-register";"-reg"]
(Arg.Unit(fun () -> args.gen_register <- true)) (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"] mkopt args ~hide:true ["--dummy-input"]
(Arg.Unit(fun () -> args.dummy_input <- true)) (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 = { type t = {
mutable topo: string; mutable topo: string;
...@@ -6,6 +6,7 @@ type t = { ...@@ -6,6 +6,7 @@ type t = {
mutable verbose: int; mutable verbose: int;
mutable demon: Demon.t; mutable demon: Demon.t;
mutable rif: bool; mutable rif: bool;
mutable no_data_file: bool;
mutable seed: int option; mutable seed: int option;
mutable replay_seed: bool; mutable replay_seed: bool;
mutable ifi: 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 = string
type node = { type node = {
id: node_id; (* The id of the node as stated in the dot file *) 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) *) file: string; (** the content of the algo field (a ml file) *)
init: string; (* store the content of the init field *) init: string; (** store the content of the init field *)
} }
type t = { type t = {
nodes: node list; nodes: node list; (** *)
succ: node_id -> (int option * node_id) list; succ: node_id -> (int option * node_id) list; (** get neighbors, with weigth if any *)
of_id: node_id -> node; of_id: node_id -> node; (** *)
directed:bool directed:bool (** true if the graph is directed *)
} }
(** Parse a sasa dot file *) (** Parse a sasa dot file *)
val read: string -> t val read: string -> t
(** Various eponymous utils *)
val to_adjency: t -> bool array array val to_adjency: t -> bool array array
val get_degree: t -> int*int
val get_nb_link: t -> bool -> int val get_nb_link: t -> bool -> int
val get_mean_degree : t -> float 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 height : string list -> t -> string -> int
val get_height : 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 open Sasacore
let (print_step : int -> int -> SasArg.t -> 'v Env.t -> 'v Process.t list -> string -> 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 -> fun n i args e pl activate_val enab_ll ->
let enable_val = let enable_val =
String.concat " " (List.map (fun b -> if b then "t" else "f") String.concat " " (List.map (fun b -> if b then "t" else "f")
(List.flatten enab_ll)) (List.flatten enab_ll))
in in
if args.demon = Demon.Custom then ( if args.no_data_file then () else (
(* in custom mode, to be able to talk with lurette, this should not be if args.demon = Demon.Custom then (
(* in custom mode, to be able to talk with lurette, this should not be
printed on stdout printed on stdout
*) *)
Printf.eprintf "\n#step %s\n" (string_of_int (n-i+1)) ; Printf.eprintf "\n#step %s\n" (string_of_int (n-i+1)) ;
Printf.eprintf "%s #outs " activate_val; flush stderr; Printf.eprintf "%s #outs " activate_val; flush stderr;
Printf.printf "%s %s\n" (StringOf.env_rif e pl) enable_val; Printf.printf "%s %s\n" (StringOf.env_rif e pl) enable_val;
) else ( ) else (
(* rif mode, internal demons *) (* rif mode, internal demons *)
if args.rif then if args.rif then
Printf.printf " %s %s %s\n" (StringOf.env_rif e pl) enable_val activate_val Printf.printf " %s %s %s\n" (StringOf.env_rif e pl) enable_val activate_val
else ( else (
Printf.printf "\n#step %s\n" (string_of_int (n-i+1)); 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.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 exception Silent of int
let (simustep: int -> int -> SasArg.t -> string -> 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