Commit 50255d75 authored by erwan's avatar erwan
Browse files

Update: write all sasa error msgs on stderr

parent 2382ba69
......@@ -36,7 +36,7 @@ let (f: string list -> string * string -> unit) =
fun ml_ins (state_file, register_file) ->
let state_module = ml_filename_to_module state_file in
if Sys.file_exists register_file then (
Printf.printf "Warning: %s already exist.\n" register_file
Printf.eprintf " [sasa] Warning: %s already exist.\n%!" register_file
) else (
let oc = open_out register_file in
let entete = Mypervasives.entete2 "(*" "*)" SasaVersion.str SasaVersion.sha in
......@@ -54,11 +54,11 @@ let (f: string list -> string * string -> unit) =
state_module state_module state_module ;
flush oc;
close_out oc;
Printf.printf " [sasa] The file %s has been generated\n" register_file;
flush stdout
Printf.eprintf " [sasa] The file %s has been generated\n" register_file;
flush stderr
);
if Sys.file_exists state_file then (
Printf.printf " [sasa] Warning: %s already exist.\n" state_file
Printf.eprintf " [sasa] Warning: %s already exist.\n%!" state_file
) else (
let oc = open_out state_file in
let entete = Mypervasives.entete2 "(*" "*)" SasaVersion.str SasaVersion.sha in
......@@ -70,6 +70,6 @@ let copy x = x
";
flush oc;
close_out oc;
Printf.printf " [sasa] The file %s has been generated\n" state_file;
flush stdout
Printf.eprintf " [sasa] The file %s has been generated\n" state_file;
flush stderr
)
(* Time-stamp: <modified the 30/01/2020 (at 16:07) by Erwan Jahier> *)
(* Time-stamp: <modified the 04/02/2020 (at 10:43) by Erwan Jahier> *)
open Register
......@@ -203,9 +203,9 @@ let (make : bool -> string array -> 'v t) =
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 " [sasa] Hint: you may wish to generate %s out of %s with:\n"
Printf.eprintf " [sasa] Hint: you may wish to generate %s out of %s with:\n"
cmxs ml_register_file;
Printf.printf " [sasa] ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n%!"
Printf.eprintf " [sasa] ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n%!"
ml_state_file ml_inputs ml_register_file cmxs;
exit 0
);
......@@ -228,7 +228,7 @@ let (make : bool -> string array -> 'v t) =
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 " [sasa] Loading %s...\n" cmxs;
if !Register.verbose_level > 0 then Printf.eprintf " [sasa] Loading %s...\n" cmxs;
Dynlink.loadfile_private cmxs;
) else ();
......@@ -261,7 +261,7 @@ let (make : bool -> string array -> 'v t) =
let oc = open_out fn in
Printf.fprintf oc "%s%!" (GenLutin.f pl);
close_out oc;
Printf.printf " [sasa] %s has been generated.\n%!" fn;
Printf.eprintf " [sasa] %s has been generated.\n%!" fn;
exit 0);
if args.gen_oracle then (
let fn = (Filename.remove_extension args.topo) ^ "_oracle.lus" in
......@@ -271,7 +271,7 @@ let (make : bool -> string array -> 'v t) =
let oc = open_out fn in
Printf.fprintf oc "%s%!" (GenOracle.f g pl);
close_out oc;
Printf.printf " [sasa] %s has been generated.\n%!" fn;
Printf.eprintf " [sasa] %s has been generated.\n%!" fn;
exit 0);
let seed = seed_get args in
if args.no_data_file then () else (
......@@ -302,9 +302,9 @@ let (make : bool -> string array -> 'v t) =
args, pl_n, e
with
| Dynlink.Error e ->
Printf.printf " [sasa] Error when dynlinking (Sasacore.make): %s\n%!"
Printf.eprintf " [sasa] Error when dynlinking (Sasacore.make): %s\n%!"
(Dynlink.error_message e);
exit 2
| e ->
Printf.printf " [sasa] Error (Sasacore.make): %s\n%!" (Printexc.to_string e);
Printf.eprintf " [sasa] Error (Sasacore.make): %s\n%!" (Printexc.to_string e);
exit 2
(* Time-stamp: <modified the 17/10/2019 (at 21:08) by Erwan Jahier> *)
(* Time-stamp: <modified the 04/02/2020 (at 10:45) by Erwan Jahier> *)
type 's neighbor = {
state: 's ;
......@@ -84,14 +84,12 @@ exception Unregistred of string * string
let print_table lbl tbl =
let keys = Hashtbl.fold (fun k _ acc -> Printf.sprintf "%s,%s" k acc) tbl "" in
if !verbose_level > 0 then Printf.printf "Defined keys for %s: %s\n" lbl keys;
flush stdout
if !verbose_level > 0 then Printf.eprintf "Defined keys for %s: %s\n%!" lbl keys
let (reg_init_state : algo_id -> (int -> 's) -> unit) =
fun algo_id x ->
if !verbose_level > 0 then Printf.printf "Registering %s init_vars\n" algo_id;
flush stdout;
if !verbose_level > 0 then Printf.eprintf "Registering %s init_vars\n%!" algo_id;
Hashtbl.replace tbls.init_state algo_id (Obj.repr x)
......@@ -104,8 +102,7 @@ let (get_init_state : algo_id -> int -> 's) =
let (reg_enable : algo_id -> 's enable_fun -> unit) = fun algo_id x ->
if !verbose_level > 0 then Printf.printf "Registering %s enable\n" algo_id;
flush stdout;
if !verbose_level > 0 then Printf.eprintf "Registering %s enable\n%!" algo_id;
Hashtbl.replace tbls.enable algo_id (Obj.repr x)
let (get_enable : algo_id -> 's enable_fun) = fun algo_id ->
try Obj.obj (Hashtbl.find tbls.enable algo_id)
......@@ -114,8 +111,7 @@ let (get_enable : algo_id -> 's enable_fun) = fun algo_id ->
raise (Unregistred ("enable", algo_id))
let (reg_step : algo_id -> 's step_fun -> unit) = fun algo_id x ->
if !verbose_level > 0 then Printf.printf "Registering %s step\n" algo_id;
flush stdout;
if !verbose_level > 0 then Printf.eprintf "Registering %s step\n%!" algo_id;
Hashtbl.replace tbls.step algo_id (Obj.repr x)
let (get_step : algo_id -> 's step_fun) = fun algo_id ->
......@@ -126,8 +122,7 @@ let (get_step : algo_id -> 's step_fun) = fun algo_id ->
let (reg_actions : algo_id -> action list -> unit) =
fun algo_id x ->
if !verbose_level > 0 then Printf.printf "Registering %s actions\n" algo_id;
flush stdout;
if !verbose_level > 0 then Printf.eprintf "Registering %s actions\n%!" algo_id;
Hashtbl.replace tbls.actions algo_id x
let (get_actions : algo_id -> action list) = fun algo_id ->
try Hashtbl.find tbls.actions algo_id
......@@ -137,8 +132,7 @@ let (get_actions : algo_id -> action list) = fun algo_id ->
let (reg_value_to_string : ('s -> string) -> unit) =
fun f ->
if !verbose_level > 0 then Printf.printf "Registering value_to_string\n";
flush stdout;
if !verbose_level > 0 then Printf.eprintf "Registering value_to_string\n%!";
Hashtbl.replace tbls.value_to_string "_global" (Obj.repr f)
let (get_value_to_string : unit -> 's -> string) = fun () ->
try Obj.obj (Hashtbl.find tbls.value_to_string "_global")
......@@ -148,8 +142,7 @@ let (get_value_to_string : unit -> 's -> string) = fun () ->
let (reg_value_of_string : (string -> 's) -> unit) =
fun f ->
if !verbose_level > 0 then Printf.printf "Registering value_of_string\n";
flush stdout;
if !verbose_level > 0 then Printf.eprintf "Registering value_of_string\n%!";
Hashtbl.replace tbls.value_of_string "_global" (Obj.repr f)
let (get_value_of_string : unit -> (string -> 's) option) = fun () ->
try Some (Obj.obj (Hashtbl.find tbls.value_of_string "_global"))
......@@ -158,8 +151,7 @@ let (get_value_of_string : unit -> (string -> 's) option) = fun () ->
let (reg_copy_value : ('s -> 's) -> unit) =
fun f ->
if !verbose_level > 0 then Printf.printf "Registering copy_value\n";
flush stdout;
if !verbose_level > 0 then Printf.eprintf "Registering copy_value\n%!";
Hashtbl.replace tbls.copy_value "_global" (Obj.repr f)
let (get_copy_value : unit -> ('s -> 's)) = fun () ->
......
(* Time-stamp: <modified the 22/01/2020 (at 10:02) by Erwan Jahier> *)
(* Time-stamp: <modified the 04/02/2020 (at 10:38) by Erwan Jahier> *)
type t = {
......@@ -287,7 +287,7 @@ let parse argv = (
)
with
| Arg.Bad msg ->
Printf.fprintf stderr "*** Error when calling '%s': %s\n%s\n" (argv.(0))
Printf.fprintf stderr " [sasa] 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 argv.(0));
......
......@@ -80,7 +80,7 @@ let () =
let n = args.length in
simuloop n n args "" pl_n e
with
| Failure msg -> Printf.printf "Error: %s\n" msg
| Failure msg -> Printf.eprintf " [sasa] Error: %s\n%!" msg
| Silent i ->
let str = if args.rif then "#" else "" in
Printf.eprintf "\n%sThis algo is silent after %i steps\n" str i ;
......
# Time-stamp: <modified the 27/01/2020 (at 22:40) by Erwan Jahier>
# Time-stamp: <modified the 05/02/2020 (at 14:37) by Erwan Jahier>
DIR=../../_build/install/default
......@@ -30,6 +30,8 @@ LIB=-package algo
osage -Tpdf $*.dot -o $*.pdf
xpdf $*.pdf
%.ocd: %.ml
rdbg -camldebug -sut "sasa $.dot" -l 1000
......@@ -38,7 +40,7 @@ s:sim2chrogtk
genclean:
rm -f *.cmxs sasa *.cm* *.o *.pdf *.rif *.gp *.log *.dro *.seed *.c *.h sasa-*.dot
rm -f rdbg-session*.ml luretteSession*.ml *.lut a.out *.cov
rm -f rdbg-session*.ml luretteSession* *.lut a.out *.cov read_dot.ml
rm -f *.exec *.sh
##################################################################################
-include Makefile.untracked
(* Time-stamp: <modified the 04/12/2019 (at 17:17) by Erwan Jahier> *)
(* Time-stamp: <modified the 06/02/2020 (at 11:05) by Erwan Jahier> *)
(* This is algo 3.1 in the book *)
......@@ -44,7 +44,7 @@ let (free : 'v neighbor list -> 'v list) = fun nl ->
let (enable_f: 'v -> 'v neighbor list -> action list) =
fun e nl ->
if (clash e nl) then ["conflict"] else []
if (clash e nl) then ["conflict"] else []
let (step_f : 'v -> 'v neighbor list -> action -> 'v) =
fun e nl a ->
......
# Time-stamp: <modified the 23/10/2019 (at 15:40) by Erwan Jahier>
# Time-stamp: <modified the 05/02/2020 (at 13:42) by Erwan Jahier>
test: test1 test2 lurette0 lurette1 rdbg_test
......@@ -35,8 +35,7 @@ lurette1: ring.lut ring_oracle.lus
lurette: lurette0 s g
rdbg: ring.ml
rdbg -o unison.rif \
-sut "$(sasa) ring.dot -sd -rif" \
rdbg -o unison.rif -sut "$(sasa) ring.dot -sd -rif"
rdbg_test: ring.ml
echo "\nnr\nsd\n" | rdbg -o unison.rif \
......
Supports Markdown
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