Commit f856d94a authored by MARCHE Claude's avatar MARCHE Claude

reloading in IDE

parent d89815f1
......@@ -11,7 +11,7 @@ version_bad = "0.92"
version_bad = "0.91"
version_bad = "0.9"
version_bad = "0.8"
command = "@LOCALBIN@why3-cpulimit %t %m -s %e %f"
command = "@LOCALBIN@why3-cpulimit %t %m -s %e -proof %f"
driver = "drivers/alt_ergo_trunk.drv"
[ATP alt-ergo]
......
......@@ -202,6 +202,7 @@ let iconname_prover = "wizard32"
let iconname_transf = "configure32"
let iconname_editor = "edit32"
let iconname_replay = "refresh32"
let iconname_reload = "movefile32"
let iconname_remove = "deletefile32"
let iconname_cleaning = "trashb32"
......@@ -227,6 +228,7 @@ let image_prover = ref !image_default
let image_transf = ref !image_default
let image_editor = ref !image_default
let image_replay = ref !image_default
let image_reload = ref !image_default
let image_remove = ref !image_default
let image_cleaning = ref !image_default
......@@ -253,6 +255,7 @@ let resize_images size =
image_transf := image ~size iconname_transf;
image_editor := image ~size iconname_editor;
image_replay := image ~size iconname_replay;
image_reload := image ~size iconname_reload;
image_remove := image ~size iconname_remove;
image_cleaning := image ~size iconname_cleaning;
()
......
......@@ -72,6 +72,7 @@ val image_prover : GdkPixbuf.pixbuf ref
val image_transf : GdkPixbuf.pixbuf ref
val image_editor : GdkPixbuf.pixbuf ref
val image_replay : GdkPixbuf.pixbuf ref
val image_reload : GdkPixbuf.pixbuf ref
val image_remove : GdkPixbuf.pixbuf ref
val image_cleaning : GdkPixbuf.pixbuf ref
......
......@@ -367,12 +367,15 @@ module M = Session.Make
| Some r -> Some r#iter
in
let iter = goals_model#append ?parent () in
goals_model#set ~row:iter ~column:index_column (-1);
goals_model#get_row_reference (goals_model#get_path iter)
let remove row =
let (_:bool) = goals_model#remove row#iter in ()
let reset () = goals_model#clear ()
let idle f =
let (_ : GMain.Idle.id) = GMain.Idle.add f in ()
......@@ -408,47 +411,57 @@ let set_proof_state ~obsolete a =
let model_index = Hashtbl.create 17
let get_any row =
try
let get_any row =
try
let row = goals_model#get_iter row in
let idx = goals_model#get ~row ~column:index_column in
Hashtbl.find model_index idx
with Not_found -> invalid_arg "Gmain.get_index"
let init =
let cpt = ref 0 in
let notify any =
match any with
| M.Goal g ->
set_row_status (M.goal_key g) (M.goal_proved g)
| M.Theory th ->
set_row_status (M.theory_key th) (M.verified th)
| M.File file ->
set_row_status file.M.file_key file.M.file_verified
| M.Proof_attempt a ->
set_proof_state ~obsolete:a.M.proof_obsolete a
| M.Transformation tr ->
set_row_status tr.M.transf_key tr.M.transf_proved
let init =
let cpt = ref (-1) in
fun row any ->
incr cpt;
Hashtbl.add model_index !cpt any;
goals_model#set ~row:row#iter ~column:index_column !cpt;
goals_model#set ~row:row#iter ~column:icon_column
let ind = goals_model#get ~row:row#iter ~column:index_column in
if ind < 0 then
begin
incr cpt;
Hashtbl.add model_index !cpt any;
goals_model#set ~row:row#iter ~column:index_column !cpt
end
else
begin
Hashtbl.replace model_index ind any;
end;
goals_model#set ~row:row#iter ~column:icon_column
(match any with
| M.Goal _ -> !image_file
| M.Theory _
| M.Theory _
| M.File _ -> !image_directory
| M.Proof_attempt _ -> !image_prover
| M.Transformation _ -> !image_transf);
goals_model#set ~row:row#iter ~column:name_column
goals_model#set ~row:row#iter ~column:name_column
(match any with
| M.Goal g -> M.goal_expl g
| M.Theory th -> M.theory_name th
| M.File f -> Filename.basename f.M.file_name
| M.Proof_attempt a -> let p = a.M.prover in
p.Session.prover_name ^ " " ^ p.Session.prover_version
| M.Transformation tr -> Session.transformation_id tr.M.transf)
| M.Transformation tr -> Session.transformation_id tr.M.transf);
notify any
let notify any =
match any with
| M.Goal g ->
set_row_status (M.goal_key g) (M.goal_proved g)
| M.Theory th ->
set_row_status (M.theory_key th) (M.verified th)
| M.File file ->
set_row_status file.M.file_key file.M.file_verified
| M.Proof_attempt a ->
set_proof_state ~obsolete:false a
| M.Transformation tr ->
set_row_status tr.M.transf_key tr.M.transf_proved
(********************)
......@@ -490,7 +503,7 @@ let () =
let () =
try
eprintf "Opening session...@?";
M.open_session ~env:gconfig.env ~provers:gconfig.provers
M.open_session ~env:gconfig.env ~provers:gconfig.provers
~init ~notify project_dir;
M.maximum_running_proofs := gconfig.max_running_processes;
eprintf " done@."
......@@ -567,7 +580,7 @@ let replay_obsolete_proofs () =
List.iter
(fun row ->
let a = get_any row in
M.replay ~obsolete_only:true
M.replay ~obsolete_only:true
~context_unproved_goals_only:!context_unproved_goals_only a)
goals_view#selection#get_selected_rows
......@@ -685,14 +698,14 @@ let exit_function () =
match l with
| [] -> ()
| f :: _ ->
eprintf "first element is a '%s' with %d sub-elements@."
eprintf "first element is a '%s' with %d sub-elements@."
f.Xml.name (List.length f.Xml.elements);
with e -> eprintf "test reloading failed with exception %s@."
(Printexc.to_string e)
end;
let ret = Sys.command "xmllint --noout --dtdvalid share/why3session.dtd essai.xml" in
if ret = 0 then eprintf "DTD validation succeeded, good!@.";
if ret = 0 then eprintf "DTD validation succeeded, good!@.";
*)
M.save_session ();
GMain.quit ()
......@@ -911,7 +924,7 @@ let () =
let () = b#set_image i#coerce in
let (_ : GtkSignal.id) =
b#connect#pressed ~callback:inline_selected_goals
in
in
()
......@@ -1091,13 +1104,13 @@ let select_row p =
match a with
| M.Goal g ->
let callback = function
| [t] ->
| [t] ->
let task_text = Pp.string_of Pretty.print_task t in
task_view#source_buffer#set_text task_text;
task_view#scroll_to_mark `INSERT;
scroll_to_source_goal g
| _ -> assert false
in
in
M.apply_transformation ~callback intro_transformation (M.get_task g)
| M.Theory th ->
......@@ -1177,6 +1190,18 @@ let () =
b#connect#pressed ~callback:replay_obsolete_proofs
in ()
let () =
let b = GButton.button ~packing:tools_box#add ~label:"Reload" () in
b#misc#set_tooltip_markup "Reloads the files";
let i = GMisc.image ~pixbuf:(!image_reload) () in
let () = b#set_image i#coerce in
let (_ : GtkSignal.id) =
b#connect#pressed ~callback:(fun () ->
current_file := "";
M.reload_all gconfig.provers)
in ()
(*************)
(* removing *)
(*************)
......
......@@ -56,7 +56,7 @@ let loadpath = (Whyconf.loadpath (Whyconf.get_main config))
let env = Lexer.create_env loadpath
let provers = Whyconf.get_provers config
let provers = Whyconf.get_provers config
let provers =
Util.Mstr.fold (Session.get_prover_data env) provers Util.Mstr.empty
......@@ -71,13 +71,15 @@ module M = Session.Make
(struct
type key = int
let create ?parent () =
let create ?parent () =
match parent with
| None -> 0
| Some n -> n+1
let remove _row = ()
let reset () = ()
let idle f =
match !idle_handler with
| None -> idle_handler := Some f;
......@@ -115,16 +117,16 @@ let main_loop () =
else
(* attempt to run the idle handler *)
match !idle_handler with
| None ->
begin
let ms =
| None ->
begin
let ms =
match !timeout_handler with
| None -> raise Exit
| Some(ms,_) -> ms
in
usleep (ms -. time)
end
| Some f ->
| Some f ->
let b = f () in
if b then () else
begin
......@@ -136,8 +138,8 @@ open Format
let model_index = Hashtbl.create 257
let init =
let cpt = ref 0 in
let init =
let cpt = ref 0 in
fun _row any ->
incr cpt;
Hashtbl.add model_index !cpt any;
......@@ -152,7 +154,7 @@ let init =
in
printf "Item '%s' loaded@." name
let string_of_result result =
let string_of_result result =
match result with
| Session.Undone -> "undone"
| Session.Scheduled -> "scheduled"
......@@ -166,7 +168,7 @@ let string_of_result result =
| Call_provers.Failure _ -> "failure"
| Call_provers.HighFailure -> "high failure"
let print_result fmt res =
let print_result fmt res =
let t = match res with
| Session.Done { Call_provers.pr_time = time } ->
Format.sprintf "(%.2f)" time
......@@ -186,8 +188,8 @@ let notify any =
file.M.file_verified
| M.Proof_attempt a ->
let p = a.M.prover in
printf "Proof with '%s %s' gives %a@."
p.Session.prover_name p.Session.prover_version
printf "Proof with '%s %s' gives %a@."
p.Session.prover_name p.Session.prover_version
print_result a.M.proof_state
| M.Transformation tr ->
printf "Transformation '%s' proved: %b@."
......@@ -220,12 +222,12 @@ let main () =
try
eprintf "Opening session...@?";
M.open_session ~env ~provers ~init ~notify project_dir;
M.maximum_running_proofs :=
M.maximum_running_proofs :=
Whyconf.running_provers_max (Whyconf.get_main config);
eprintf " done@.";
let files = M.get_all_files () in
List.iter
(fun f ->
List.iter
(fun f ->
eprintf "Replaying file '%s'@." f.M.file_name;
M.replay ~obsolete_only:false
~context_unproved_goals_only:false (M.File f)) files;
......
This diff is collapsed.
......@@ -69,6 +69,9 @@ module type OBSERVER = sig
val remove: key -> unit
(** removes a key *)
val reset: unit -> unit
(** deletes all keys *)
val timeout: ms:int -> (unit -> bool) -> unit
(** a handler for functions that must be called after a given time
elapsed, in milliseconds. When the given function returns
......@@ -149,18 +152,20 @@ module Make(O: OBSERVER) : sig
env:Env.env ->
provers:prover_data Util.Mstr.t ->
init:(O.key -> any -> unit) ->
notify:(any -> unit) -> string -> unit
notify:(any -> unit) ->
string -> unit
(** starts a new proof session, using directory given as argument
this reloads the previous session database if any.
Opening a session must be done prior to any other actions.
And it cannot be done twice.
the [notify] function is a function that will be called at each
update of element of the state
the [init] function is a function that will be called at each
creation of element of the state
the [notify] function is a function that will be called at each
update of element of the state
*)
val maximum_running_proofs : int ref
......@@ -216,6 +221,11 @@ module Make(O: OBSERVER) : sig
if context_unproved_goals_only is set then reruns only proofs with result was 'valid'
*)
val reload_all: prover_data Util.Mstr.t -> unit
(** reloads all the files
If for a given file, the parsing or typing fails, then
then old version is kept, but marked obsolete
*)
(*
TODO
......
Markdown is supported
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