Commit f856d94a authored by MARCHE Claude's avatar MARCHE Claude

reloading in IDE

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