diff --git a/tools/rdbg4sasa/gtkgui.ml b/tools/rdbg4sasa/gtkgui.ml index 32cb0bce7dfe8c69cdc8f03e54b970c43306c8e3..509191fddbe1438b449b3ff2e5d8661debc9b2a2 100644 --- a/tools/rdbg4sasa/gtkgui.ml +++ b/tools/rdbg4sasa/gtkgui.ml @@ -1,4 +1,4 @@ -(* Time-stamp: <modified the 22/06/2022 (at 23:27) by Erwan Jahier> *) +(* Time-stamp: <modified the 03/07/2022 (at 17:36) by Erwan Jahier> *) #thread #require "lablgtk3" @@ -507,7 +507,7 @@ let custom_daemon p gtext vbox step_button back_step_button round_button let to_activate = Daemon.central nodes in Hashtbl.clear daemongui_activate; List.iter (fun n -> - Printf.printf "Activating %s\n" n; + (* Printf.printf "Activating %s\n" n; *) Hashtbl.replace daemongui_activate n true) to_activate ) | LocCentral -> ( @@ -686,7 +686,7 @@ let main () = let ne = rev_cond_gen !e (fun ne -> - if ne.step = !e.step-1 && ne.kind = !e.kind then true else ( + if ne.step = !e.step-1 && ne.kind = !e.kind then true else ( Printf.printf "%d: ne.step=%d (!e.step-1)=%d\n%!" ne.nb ne.step (!e.step-1); false ) diff --git a/tools/rdbg4sasa/sasa-rdbg-cmds.ml b/tools/rdbg4sasa/sasa-rdbg-cmds.ml index 725460c958fb553df158b505a98dc6f2e8a1877d..ba0e9278cffcc7a965f23bafd6b1fdb8d7c4299d 100644 --- a/tools/rdbg4sasa/sasa-rdbg-cmds.ml +++ b/tools/rdbg4sasa/sasa-rdbg-cmds.ml @@ -9,6 +9,9 @@ open Sasacore.Topology;; #use "dot4sasa.ml";; let verbose = ref false +let p = + try Topology.read dotfile + with _ -> failwith "This is not a sasa rdbg session!";; let is_silent ?(dflt=true) e = match List.assoc_opt "silent" e.data with @@ -24,7 +27,6 @@ let is_legitimate e = | _ -> failwith ("legitimate not available at this event: "^(string_of_event e)) (**********************************************************************) - let round_cpt = ref 0 (* make the round nb available at ell events *) let is_round = ref false (* ditto *) @@ -50,37 +52,7 @@ let (round : RdbgEvent.t -> bool) = fun e -> if e.kind=Exit && e.name = "sasa" then get_round e else false -let sasa_next e = - let ne = e.next () in - List.iter - (fun str -> if str<>"print_event" then (RdbgStdLib.get_hook str) ne) - (RdbgStdLib.list_hooks ()); - ne - -let next_round e = - next_cond_gen e (fun e -> round e || is_legitimate e) sasa_next - - -let back_step e = - let e = rev_cond_gen e (fun ne -> ne.kind = e.kind && ne.name = e.name) - sasa_next (fun _ -> ()) - in - store e.nb; - e - (**********************************************************************) -(* redefine (more meaningful) step and back-step for sasa *) -let sasa_step e = next_cond e (fun ne -> ne.kind = e.kind && ne.name = e.name) -let s () = e:=sasa_step !e ; emacs_udate !e; store !e.nb;pe() -let b () = - let ne = back_step !e in - e:=ne ; - emacs_udate !e; store !e.nb;pe() - -let p = - try Topology.read dotfile - with _ -> failwith "This is not a sasa rdbg session!";; - let d_par () = dot true (get_round_nb !e) p dotfile !e;; let dot_par () = dot true (get_round_nb !e) p dotfile !e;; let ne_par () = neato true (get_round_nb !e) p dotfile !e;; @@ -100,7 +72,6 @@ let sf () = sfdp false (get_round_nb !e) p dotfile !e;; let pa () = patchwork false (get_round_nb !e) p dotfile !e;; let os () = osage false (get_round_nb !e) p dotfile !e;; - (* To change the default dot/graph viewer: dot_view := ci;; *) @@ -110,6 +81,44 @@ let dot_view : (unit -> unit) ref = if Algo.is_directed () then dot else ne) let d () = !dot_view () + +(**********************************************************************) +let sasa_next e = + if e.step = args.step_nb then d (); + let ne = e.next () in + List.iter + (fun str -> if str<>"print_event" then (RdbgStdLib.get_hook str) ne) + (RdbgStdLib.list_hooks ()); + ne + +let next_cond e = + if e.step = args.step_nb then d (); + next_cond e + +let next_cond_gen e p n = + if e.step = args.step_nb then d (); + next_cond_gen e p n + +let next_round e = + next_cond_gen e (fun e -> round e || is_legitimate e) sasa_next + + +let back_step e = + let e = rev_cond_gen e (fun ne -> ne.kind = e.kind && ne.name = e.name) + sasa_next (fun _ -> ()) + in + store e.nb; + e + +(**********************************************************************) +(* redefine (more meaningful) step and back-step for sasa *) +let sasa_step e = next_cond e (fun ne -> ne.kind = e.kind && ne.name = e.name) +let s () = e:=sasa_step !e ; emacs_udate !e; store !e.nb;pe() +let b () = + let ne = back_step !e in + e:=ne ; + emacs_udate !e; store !e.nb;pe() + let sd () = s();!dot_view();; let bd()= e:=prev !e ; emacs_udate !e; pe();!dot_view();; @@ -144,8 +153,9 @@ let r () = (**********************************************************************) (* Move forward until silence *) -let goto_silence e = next_cond e (is_silent ~dflt:false) -let silence () = e:=goto_silence !e; !dot_view ();; +let is_silent_or_end e = is_silent ~dflt:false e || e.step = args.step_nb +let goto_silence e = next_cond e is_silent_or_end +let silence () = e:=goto_silence !e; !dot_view () ;; let _ = add_doc_entry "silence" "unit -> unit" "Move forward until is_silent returns true" @@ -156,7 +166,8 @@ let _ = add_doc_entry "sasa" "sasa-rdbg-cmds.ml";; -let goto_legitimate e = next_cond e is_legitimate +let is_legitimate_or_end e = is_legitimate e || e.step = args.step_nb +let goto_legitimate e = next_cond e is_legitimate_or_end let legitimate () = e:=goto_legitimate !e; !dot_view ();; let _ = add_doc_entry