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;
......
...@@ -25,7 +25,7 @@ open Format ...@@ -25,7 +25,7 @@ open Format
(* provers *) (* provers *)
(***************************) (***************************)
type prover_data = type prover_data =
{ prover_id : string; { prover_id : string;
prover_name : string; prover_name : string;
prover_version : string; prover_version : string;
...@@ -50,7 +50,7 @@ let get_prover_data env id pr acc = ...@@ -50,7 +50,7 @@ let get_prover_data env id pr acc =
acc acc
with e -> with e ->
eprintf "Failed to load driver %s for prover %s (%a). prover disabled@." eprintf "Failed to load driver %s for prover %s (%a). prover disabled@."
pr.Whyconf.driver pr.Whyconf.driver
pr.Whyconf.name pr.Whyconf.name
Exn_printer.exn_printer e Exn_printer.exn_printer e
; ;
...@@ -64,7 +64,7 @@ type trans = ...@@ -64,7 +64,7 @@ type trans =
| Trans_one of Task.task Trans.trans | Trans_one of Task.task Trans.trans
| Trans_list of Task.task Trans.tlist | Trans_list of Task.task Trans.tlist
type transformation_data = type transformation_data =
{ transformation_name : string; { transformation_name : string;
transformation : trans; transformation : trans;
} }
...@@ -82,7 +82,7 @@ let lookup_trans env name = ...@@ -82,7 +82,7 @@ let lookup_trans env name =
let lookup_transformation env = let lookup_transformation env =
let h = Hashtbl.create 13 in let h = Hashtbl.create 13 in
fun name -> fun name ->
try try
Hashtbl.find h name Hashtbl.find h name
with Not_found -> with Not_found ->
let t = {transformation_name = name; let t = {transformation_name = name;
...@@ -109,6 +109,7 @@ module type OBSERVER = sig ...@@ -109,6 +109,7 @@ module type OBSERVER = sig
type key type key
val create: ?parent:key -> unit -> key val create: ?parent:key -> unit -> key
val remove: key -> unit val remove: key -> unit
val reset: unit -> unit
val timeout: ms:int -> (unit -> bool) -> unit val timeout: ms:int -> (unit -> bool) -> unit
val idle: (unit -> bool) -> unit val idle: (unit -> bool) -> unit
...@@ -138,7 +139,7 @@ and goal = ...@@ -138,7 +139,7 @@ and goal =
goal_expl : string option; goal_expl : string option;
parent : goal_parent; parent : goal_parent;
mutable task: Task.task option; mutable task: Task.task option;
checksum : string; mutable checksum : string;
goal_key : O.key; goal_key : O.key;
mutable proved : bool; mutable proved : bool;
external_proofs: (string, proof_attempt) Hashtbl.t; external_proofs: (string, proof_attempt) Hashtbl.t;
...@@ -181,25 +182,25 @@ let theory_key t = t.theory_key ...@@ -181,25 +182,25 @@ let theory_key t = t.theory_key
let verified t = t.verified let verified t = t.verified
let goals t = t.goals let goals t = t.goals
let get_theory t = let get_theory t =
match t.theory with match t.theory with
| None -> | None ->
eprintf "Session: theory not yet reimported, this should not happen@."; eprintf "Session: theory not yet reimported, this should not happen@.";
assert false assert false
| Some t -> t | Some t -> t
let goal_name g = g.goal_name let goal_name g = g.goal_name
let goal_expl g = let goal_expl g =
match g.goal_expl with match g.goal_expl with
| None -> g.goal_name | None -> g.goal_name
| Some s -> s | Some s -> s
let goal_key g = g.goal_key let goal_key g = g.goal_key
let goal_proved g = g.proved let goal_proved g = g.proved
let transformations g = g.transformations let transformations g = g.transformations
let get_task g = let get_task g =
match g.task with match g.task with
| None -> | None ->
begin begin
match g.parent with match g.parent with
| Parent_theory _th -> | Parent_theory _th ->
...@@ -213,7 +214,7 @@ let get_task g = ...@@ -213,7 +214,7 @@ let get_task g =
let all_files : file list ref = ref [] let all_files : file list ref = ref []
let get_all_files () = !all_files let get_all_files () = !all_files
(************************) (************************)
(* saving state on disk *) (* saving state on disk *)
(************************) (************************)
...@@ -232,14 +233,14 @@ let save_result fmt r = ...@@ -232,14 +233,14 @@ let save_result fmt r =
let save_status fmt s = let save_status fmt s =
match s with match s with
| Undone | Scheduled | Running -> | Undone | Scheduled | Running ->
fprintf fmt "<undone/>@\n" fprintf fmt "<undone/>@\n"
| InternalFailure msg -> | InternalFailure msg ->
fprintf fmt "<internalfailure reason=\"%s\"/>@\n" fprintf fmt "<internalfailure reason=\"%s\"/>@\n"
(Printexc.to_string msg) (Printexc.to_string msg)
| Done r -> save_result fmt r | Done r -> save_result fmt r
let save_proof_attempt fmt _key a = let save_proof_attempt fmt _key a =
fprintf fmt "@\n@[<v 1><proof prover=\"%s\" edited=\"%s\">" fprintf fmt "@\n@[<v 1><proof prover=\"%s\" edited=\"%s\">"
a.prover.prover_id a.prover.prover_id
a.edited_as; a.edited_as;
save_status fmt a.proof_state; save_status fmt a.proof_state;
...@@ -250,20 +251,20 @@ let opt lab fmt = function ...@@ -250,20 +251,20 @@ let opt lab fmt = function
| Some s -> fprintf fmt "%s=\"%s\" " lab s | Some s -> fprintf fmt "%s=\"%s\" " lab s
let rec save_goal fmt g = let rec save_goal fmt g =