diff --git a/lib/sasa/sasaRun.ml b/lib/sasa/sasaRun.ml index 14d3917b5ee6c6efc830cd35ccbab728c23bdaca..c57e650402dfa0c7d0576ce49d5a612024de8ecd 100644 --- a/lib/sasa/sasaRun.ml +++ b/lib/sasa/sasaRun.ml @@ -65,8 +65,8 @@ let (compute_legitimate: bool -> 'v SimuState.t -> bool) = let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) = fun argv st -> let pl = st.network in - let prog_id = Printf.sprintf "%s (with sasa Version %s)" - (String.concat " " (Array.to_list argv)) SasaVersion.str + let prog_id = Printf.sprintf "%s" + (String.concat " " (Array.to_list argv)) in let vntl_i = List.map (fun (vn,vt) -> vn, Data.type_of_string vt) diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml index 509191fddbe1438b449b3ff2e5d8661debc9b2a2..411bd7a0ed765ed3f697d5f6335f9e2d567a4104 100644 --- a/tools/rdbg4sasa/gtkgui.ml +++ b/tools/rdbg4sasa/gtkgui.ml @@ -1,4 +1,4 @@ -(* Time-stamp: <modified the 03/07/2022 (at 17:36) by Erwan Jahier> *) +(* Time-stamp: <modified the 11/07/2022 (at 14:12) by Erwan Jahier> *) #thread #require "lablgtk3" @@ -210,11 +210,11 @@ let start () = !e.save_state !e.nb let restart p _ = + !e.RdbgEvent.reset(); Seed.replay_seed := true; let seed = Seed.get dotfile in Seed.set seed; p (Printf.sprintf "Restarting using the seed %d" seed); - !e.RdbgEvent.reset(); Round.reinit(); e:=RdbgStdLib.run ~call_hooks:true (); start (); @@ -803,12 +803,13 @@ let main () = let _ = make_button `REFRESH "_New Seed" "Restart from the beginning using a New Seed" (button_cb true true (fun ()-> + !e.RdbgEvent.reset(); Seed.reset(); Seed.replay_seed := false; let seed = Seed.get dotfile in + change_sasa_seed seed; Seed.set (seed); p (Printf.sprintf "Restarting using the seed %d" seed); - !e.RdbgEvent.reset(); e:=RdbgStdLib.run ~call_hooks:true (); Round.reinit(); redos := [1]; @@ -935,7 +936,7 @@ let main () = let gui = main (* todo -- les oracles sont violés en silence +- les oracles sont violés en silence (lancer un pop-up ?) - couper les grosses fonctions en morceaux - cacher les messages issus du #use - lire les commandes dans text_in (comment ? c'est rdbgtop qui lance gtk maintenant...) diff --git a/tools/rdbg4sasa/sasa-rdbg-cmds.ml b/tools/rdbg4sasa/sasa-rdbg-cmds.ml index ba0e9278cffcc7a965f23bafd6b1fdb8d7c4299d..1f356ba56ffeb9ac2c07e9a37b222b3c95500697 100644 --- a/tools/rdbg4sasa/sasa-rdbg-cmds.ml +++ b/tools/rdbg4sasa/sasa-rdbg-cmds.ml @@ -135,6 +135,35 @@ let pr () = (* I need to overrides those *) + +(**********************************************************************) +(* change the sasa seed in the rdbgplugin + +I've suposed that all Ocaml plugins called from sasa have a --seed option. Is it true? +It is the case for sasa and lutin at least. + *) + +let (string_to_string_list : string -> string list) = + fun str -> + Str.split (Str.regexp "[ \t]+") str + +let (change_ocaml_plugin_seed: int -> RdbgPlugin.t -> RdbgPlugin.t) = + fun seed rdbgplugin -> + let new_sasa_call = Printf.sprintf "%s --seed %d" rdbgplugin.id seed in + Sasa.SasaRun.make(Array.of_list (string_to_string_list new_sasa_call)) + +let (change_plugin_seed : int -> RdbgArg.reactive_program -> RdbgArg.reactive_program) = + fun seed plugin -> + match plugin with + | Ocaml rdbgplugin -> Ocaml (change_ocaml_plugin_seed seed rdbgplugin) + | o -> o + +let change_sasa_seed seed = + args.suts <- List.map (change_plugin_seed seed) args.suts; + args.envs <- List.map (change_plugin_seed seed) args.envs + +(**********************************************************************) + (* won't work in semi-auto modes, but the buttons are hided *) let u () = undo (); ignore (round !e);; let r () =