Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

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 ()
...@@ -415,12 +418,33 @@ let get_any row = ...@@ -415,12 +418,33 @@ let get_any row =
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 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 init =
let cpt = ref 0 in let cpt = ref (-1) in
fun row any -> fun row any ->
let ind = goals_model#get ~row:row#iter ~column:index_column in
if ind < 0 then
begin
incr cpt; incr cpt;
Hashtbl.add model_index !cpt any; Hashtbl.add model_index !cpt any;
goals_model#set ~row:row#iter ~column:index_column !cpt; 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 goals_model#set ~row:row#iter ~column:icon_column
(match any with (match any with
| M.Goal _ -> !image_file | M.Goal _ -> !image_file
...@@ -435,20 +459,9 @@ let init = ...@@ -435,20 +459,9 @@ let init =
| 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
(********************) (********************)
...@@ -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 *)
(*************) (*************)
......
...@@ -78,6 +78,8 @@ module M = Session.Make ...@@ -78,6 +78,8 @@ module M = Session.Make
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;
......
...@@ -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;
...@@ -250,8 +251,8 @@ let opt lab fmt = function ...@@ -250,8 +251,8 @@ 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 =
fprintf fmt "@\n@[<v 1><goal name=\"%s\" %aproved=\"%b\">" fprintf fmt "@\n@[<v 1><goal name=\"%s\" %asum=\"%s\" proved=\"%b\">"
g.goal_name (opt "expl") g.goal_expl g.proved; g.goal_name (opt "expl") g.goal_expl g.checksum g.proved;
Hashtbl.iter (save_proof_attempt fmt) g.external_proofs; Hashtbl.iter (save_proof_attempt fmt) g.external_proofs;
Hashtbl.iter (save_trans fmt) g.transformations; Hashtbl.iter (save_trans fmt) g.transformations;
fprintf fmt "@]@\n</goal>" fprintf fmt "@]@\n</goal>"
...@@ -581,25 +582,24 @@ let raw_add_external_proof ~obsolete ~edit g p result = ...@@ -581,25 +582,24 @@ let raw_add_external_proof ~obsolete ~edit g p result =
edited_as = edit; edited_as = edit;
} }
in in
Hashtbl.add g.external_proofs p.prover_name a; Hashtbl.add g.external_proofs p.prover_id a;
let any = Proof_attempt a in let any = Proof_attempt a in
!init_fun key any; !init_fun key any;
!notify_fun any; !notify_fun any;
(* !notify_fun (Goal g) ? *)
a a
(* [raw_add_goal parent name expl t] adds a goal to the given parent (* [raw_add_goal parent name expl sum t] adds a goal to the given parent
DOES NOT record the new goal in its parent, thus this should not be exported DOES NOT record the new goal in its parent, thus this should not be exported
*) *)
let raw_add_goal parent name expl topt = let raw_add_goal parent name expl sum topt =
let parent_key = match parent with let parent_key = match parent with
| Parent_theory mth -> mth.theory_key | Parent_theory mth -> mth.theory_key
| Parent_transf mtr -> mtr.transf_key | Parent_transf mtr -> mtr.transf_key
in in
let key = O.create ~parent:parent_key () in let key = O.create ~parent:parent_key () in
let sum = match topt with let sum = match topt with
| None -> "" | None -> sum
| Some t -> task_checksum t | Some t -> task_checksum t
in in
let goal = { goal_name = name; let goal = { goal_name = name;
...@@ -664,7 +664,7 @@ let add_theory mfile name th = ...@@ -664,7 +664,7 @@ let add_theory mfile name th =
let id = (Task.task_goal t).Decl.pr_name in let id = (Task.task_goal t).Decl.pr_name in
let name = id.Ident.id_string in let name = id.Ident.id_string in
let expl = get_explanation id (Task.task_goal_fmla t) in let expl = get_explanation id (Task.task_goal_fmla t) in
let goal = raw_add_goal (Parent_theory mth) name expl (Some t) in let goal = raw_add_goal (Parent_theory mth) name expl "" (Some t) in
goal :: acc) goal :: acc)
[] []
tasks tasks
...@@ -732,48 +732,38 @@ let file_exists fn = ...@@ -732,48 +732,38 @@ let file_exists fn =
(* reload a file *) (* reload a file *)
(**********************************) (**********************************)
let rec reimport_any_goal _parent gid _gname t goal __goal_obsolete = let reload_proof ~provers obsolete goal pid old_a =
let _info = get_explanation gid (Task.task_goal_fmla t) in
goal.task <- Some t;
goal
(*
let goal = raw_add_goal parent gname info t in
let proved = ref false in
let external_proofs = Db.external_proofs db_goal in
Db.Hprover.iter
(fun pid a ->
let pname = Db.prover_name pid in
try try
let p = Util.Mstr.find pname gconfig.provers in let p = Util.Mstr.find pid provers in
let s,t,o,edit = Db.status_and_time a in let old_res = old_a.proof_state in
if goal_obsolete && not o then Db.set_obsolete a; let obsolete = obsolete or old_a.proof_obsolete in
let obsolete = goal_obsolete or o in eprintf "proof_obsolete : %b@." obsolete;
let s = match s with let _a =
| Db.Undone -> Call_provers.HighFailure raw_add_external_proof ~obsolete ~edit:old_a.edited_as goal p old_res
| Db.Done r ->
if r = Call_provers.Valid then
if not obsolete then proved := true;
r
in
let r = { Call_provers.pr_answer = s;
Call_provers.pr_output = "";
Call_provers.pr_time = t;
}
in
let (_pa : Model.proof_attempt) =
Helpers.add_external_proof_row ~obsolete ~edit goal p a
(Gscheduler.Done r)
in in
((* something TODO ?*)) ((* something TODO ?*))
with Not_found -> with Not_found ->
eprintf eprintf
"Warning: prover %s appears in database but is not installed.@." "Warning: prover %s appears in database but is not installed.@."
pname pid
)
external_proofs; let rec reload_any_goal ~provers parent gid gname sum t old_goal goal_obsolete =
let transformations = Db.transformations db_goal in let info = get_explanation gid (Task.task_goal_fmla t) in
Db.Htransf.iter let goal = raw_add_goal parent gname info sum (Some t) in
(fun tr_id tr -> goal.task <- Some t;
begin
match old_goal with
| None -> ()
| Some g ->
Hashtbl.iter (reload_proof ~provers goal_obsolete goal) g.external_proofs;
Hashtbl.iter (reload_trans ~provers goal_obsolete goal) g.transformations
end;
goal
and reload_trans ~provers:_ _goal_obsolete _goal _tr_id _tr =
()
(*
let trname = Db.transf_name tr_id in let trname = Db.transf_name tr_id in
eprintf "Reimporting transformation %s for goal %s @." trname gname; eprintf "Reimporting transformation %s for goal %s @." trname gname;
let trans = trans_of_name trname in let trans = trans_of_name trname in
...@@ -867,93 +857,83 @@ let rec reimport_any_goal _parent gid _gname t goal __goal_obsolete = ...@@ -867,93 +857,83 @@ let rec reimport_any_goal _parent gid _gname t goal __goal_obsolete =
*) *)
let reimport_root_goal mth tname goals t : goal = (* reloads the task [t] in theory mth (named tname) *)
(* re-imports database informations of a goal in theory mth (named tname) let reload_root_goal ~provers mth tname old_goals t : goal =
goals is a table, indexed by names of DB goals formerly known to be
a in theory mth. returns true whenever the task t is known to be
proved *)
let id = (Task.task_goal t).Decl.pr_name in let id = (Task.task_goal t).Decl.pr_name in
let gname = id.Ident.id_string let gname = id.Ident.id_string in
in
let sum = task_checksum t in let sum = task_checksum t in
let goal, goal_obsolete =
try
let dbg = Util.Mstr.find gname goals in
let db_sum = dbg.checksum in
let goal_obsolete = sum <> db_sum in
if goal_obsolete then
begin
eprintf "Goal %s.%s has changed@." tname gname;
(*
Db.change_checksum dbg sum
*)
end;
dbg,goal_obsolete
with Not_found ->
assert false (* TODO *)
(* (*
let dbg = Db.add_goal mth.Model.theory_db gname sum in let goal = raw_add_goal (Parent_theory mth) gname expl sum (Some t) in
dbg,false
*) *)
in let old_goal, goal_obsolete =
reimport_any_goal (Parent_theory mth) id gname t goal goal_obsolete
(* reloads a file *)
let reload_file mf =
eprintf "[Reload] file '%s'@." mf.file_name;
try try
let theories = read_file mf.file_name in let old_goal = Util.Mstr.find gname old_goals in
let old_theories = List.fold_left let old_sum = old_goal.checksum in
(fun acc t -> Util.Mstr.add t.theory_name t acc) (Some old_goal,sum <> old_sum)
Util.Mstr.empty with Not_found -> (None,false)
mf.theories
in in
let mths = if goal_obsolete then
List.fold_left eprintf "Goal %s.%s has changed@." tname gname;
(fun acc (_,tname,th) -> reload_any_goal ~provers (Parent_theory mth) id gname sum t old_goal goal_obsolete
(* reloads a theory *)
let reload_theory ~provers mfile old_theories (_,tname,th) =
eprintf "[Reload] theory '%s'@."tname; eprintf "[Reload] theory '%s'@."tname;
let mth = let tasks = List.rev (Task.split_theory th None None) in
let mth = raw_add_theory mfile (Some th) tname in
let old_goals =
try try
let mth = Util.Mstr.find tname old_theories in let old_mth = Util.Mstr.find tname old_theories in
mth.theory <- Some th; old_mth.goals
mth with Not_found -> []
with Not_found ->
raw_add_theory mf (Some th) tname
in in
let goals = List.fold_left let goalsmap = List.fold_left
(fun acc g -> Util.Mstr.add g.goal_name g acc) (fun goalsmap g -> Util.Mstr.add g.goal_name g goalsmap)
Util.Mstr.empty mth.goals Util.Mstr.empty old_goals
in in
let tasks = List.rev (Task.split_theory th None None) in let new_goals = List.fold_left
let goals = List.fold_left
(fun acc t -> (fun acc t ->
let g = reimport_root_goal mth tname goals t in let g = reload_root_goal ~provers mth tname goalsmap t in
g::acc) g::acc)
[] tasks [] tasks
in in
mth.goals <- List.rev goals; mth.goals <- List.rev new_goals;
(* TODO: what to do with remaining old theories?
for the moment they remain in the session
*)
check_theory_proved mth; check_theory_proved mth;
mth::acc mth
)
[] theories
in (* reloads a file *)
(* TODO: detecter d'eventuelles vieilles theories, qui seraient donc let reload_file ~provers mf =
dans [old_theories] mais pas dans [theories] eprintf "[Reload] file '%s'@." mf.file_name;
*) let theories =
mf.theories <- List.rev mths; try
check_file_verified mf read_file mf.file_name
with e -> with e ->
eprintf "@[Error while reading file@ '%s':@ %a@.@]" mf.file_name eprintf "@[Error while reading file@ '%s':@ %a@.@]" mf.file_name
Exn_printer.exn_printer e; Exn_printer.exn_printer e;
(* TODO: do something clever than that! *)
exit 1 exit 1
in
let new_mf = raw_add_file mf.file_name in
let old_theories = List.fold_left
(fun acc t -> Util.Mstr.add t.theory_name t acc)
Util.Mstr.empty
mf.theories
in
let mths = List.fold_left
(fun acc th -> reload_theory ~provers new_mf old_theories th :: acc)
[] theories
in
new_mf.theories <- List.rev mths;
check_file_verified new_mf
(* reloads all files *) (* reloads all files *)
let reload_all () = List.iter reload_file !all_files let reload_all provers =
let files = !all_files in
all_files := [];
O.reset ();
List.iter (reload_file ~provers) files
(****************************) (****************************)
(* session opening *) (* session opening *)
...@@ -1002,7 +982,11 @@ let rec load_goal ~env ~provers parent acc g = ...@@ -1002,7 +982,11 @@ let rec load_goal ~env ~provers parent acc g =
try Some (List.assoc "expl" g.Xml.attributes) try Some (List.assoc "expl" g.Xml.attributes)
with Not_found -> None with Not_found -> None
in in
let mg = raw_add_goal parent gname expl None in let sum =
try List.assoc "sum" g.Xml.attributes
with Not_found -> ""
in
let mg = raw_add_goal parent gname expl sum None in
List.iter (load_proof_or_transf ~env ~provers mg) g.Xml.elements; List.iter (load_proof_or_transf ~env ~provers mg) g.Xml.elements;
mg::acc mg::acc
| s -> | s ->
...@@ -1116,7 +1100,7 @@ let open_session ~env ~provers ~init ~notify dir = ...@@ -1116,7 +1100,7 @@ let open_session ~env ~provers ~init ~notify dir =
begin try begin try
let xml = Xml.from_file (Filename.concat dir db_filename) in let xml = Xml.from_file (Filename.concat dir db_filename) in
load_session ~env ~provers xml; load_session ~env ~provers xml;
reload_all () reload_all provers
with with
| Sys_error _ -> | Sys_error _ ->
(* xml does not exist yet *) (* xml does not exist yet *)
...@@ -1306,7 +1290,7 @@ let transformation_on_goal g tr = ...@@ -1306,7 +1290,7 @@ let transformation_on_goal g tr =
in in
let goal = let goal =
raw_add_goal (Parent_transf tr) raw_add_goal (Parent_transf tr)
subgoal_name expl (Some subtask) subgoal_name expl "" (Some subtask)
in in
(goal :: acc, count+1) (goal :: acc, count+1)
in in
......
...@@ -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