Une nouvelle version du portail de gestion des comptes externes sera mise en production lundi 09 août. Elle permettra d'allonger la validité d'un compte externe jusqu'à 3 ans. Pour plus de détails sur cette version consulter : https://doc-si.inria.fr/x/FCeS

Commit f856d94a authored by MARCHE Claude's avatar MARCHE Claude
Browse files

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 ()
......@@ -415,12 +418,33 @@ let get_any row =
Hashtbl.find model_index idx
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 cpt = ref 0 in
let cpt = ref (-1) in
fun row any ->
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;
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
......@@ -435,20 +459,9 @@ let init =
| 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
(********************)
......@@ -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 *)
(*************)
......
......@@ -78,6 +78,8 @@ module M = Session.Make
let remove _row = ()
let reset () = ()
let idle f =
match !idle_handler with
| None -> idle_handler := Some f;
......
......@@ -109,6 +109,7 @@ module type OBSERVER = sig
type key
val create: ?parent:key -> unit -> key
val remove: key -> unit
val reset: unit -> unit
val timeout: ms:int -> (unit -> bool) -> unit
val idle: (unit -> bool) -> unit
......@@ -138,7 +139,7 @@ and goal =
goal_expl : string option;
parent : goal_parent;
mutable task: Task.task option;
checksum : string;
mutable checksum : string;
goal_key : O.key;
mutable proved : bool;
external_proofs: (string, proof_attempt) Hashtbl.t;
......@@ -250,8 +251,8 @@ let opt lab fmt = function
| Some s -> fprintf fmt "%s=\"%s\" " lab s
let rec save_goal fmt g =
fprintf fmt "@\n@[<v 1><goal name=\"%s\" %aproved=\"%b\">"
g.goal_name (opt "expl") g.goal_expl g.proved;
fprintf fmt "@\n@[<v 1><goal name=\"%s\" %asum=\"%s\" proved=\"%b\">"
g.goal_name (opt "expl") g.goal_expl g.checksum g.proved;
Hashtbl.iter (save_proof_attempt fmt) g.external_proofs;
Hashtbl.iter (save_trans fmt) g.transformations;
fprintf fmt "@]@\n</goal>"
......@@ -581,25 +582,24 @@ let raw_add_external_proof ~obsolete ~edit g p result =
edited_as = edit;
}
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
!init_fun key any;
!notify_fun any;
(* !notify_fun (Goal g) ? *)
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
*)
let raw_add_goal parent name expl topt =
let raw_add_goal parent name expl sum topt =
let parent_key = match parent with
| Parent_theory mth -> mth.theory_key
| Parent_transf mtr -> mtr.transf_key
in
let key = O.create ~parent:parent_key () in
let sum = match topt with
| None -> ""
| None -> sum
| Some t -> task_checksum t
in
let goal = { goal_name = name;
......@@ -664,7 +664,7 @@ let add_theory mfile name th =
let id = (Task.task_goal t).Decl.pr_name in
let name = id.Ident.id_string 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)
[]
tasks
......@@ -732,48 +732,38 @@ let file_exists fn =
(* reload a file *)
(**********************************)
let rec reimport_any_goal _parent gid _gname t goal __goal_obsolete =
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
let reload_proof ~provers obsolete goal pid old_a =
try
let p = Util.Mstr.find pname gconfig.provers in
let s,t,o,edit = Db.status_and_time a in
if goal_obsolete && not o then Db.set_obsolete a;
let obsolete = goal_obsolete or o in
let s = match s with
| Db.Undone -> Call_provers.HighFailure
| 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)
let p = Util.Mstr.find pid provers in
let old_res = old_a.proof_state in
let obsolete = obsolete or old_a.proof_obsolete in
eprintf "proof_obsolete : %b@." obsolete;
let _a =
raw_add_external_proof ~obsolete ~edit:old_a.edited_as goal p old_res
in
((* something TODO ?*))
with Not_found ->
eprintf
"Warning: prover %s appears in database but is not installed.@."
pname
)
external_proofs;
let transformations = Db.transformations db_goal in
Db.Htransf.iter
(fun tr_id tr ->
pid
let rec reload_any_goal ~provers parent gid gname sum t old_goal goal_obsolete =
let info = get_explanation gid (Task.task_goal_fmla t) in
let goal = raw_add_goal parent gname info sum (Some t) in
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
eprintf "Reimporting transformation %s for goal %s @." trname gname;
let trans = trans_of_name trname in
......@@ -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 =
(* re-imports database informations of a goal in theory mth (named tname)
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 *)
(* reloads the task [t] in theory mth (named tname) *)
let reload_root_goal ~provers mth tname old_goals t : goal =
let id = (Task.task_goal t).Decl.pr_name in
let gname = id.Ident.id_string
in
let gname = id.Ident.id_string 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
dbg,false
let goal = raw_add_goal (Parent_theory mth) gname expl sum (Some t) in
*)
in
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;
let old_goal, goal_obsolete =
try
let theories = read_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
let old_goal = Util.Mstr.find gname old_goals in
let old_sum = old_goal.checksum in
(Some old_goal,sum <> old_sum)
with Not_found -> (None,false)
in
let mths =
List.fold_left
(fun acc (_,tname,th) ->
if goal_obsolete then
eprintf "Goal %s.%s has changed@." tname gname;
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;
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
let mth = Util.Mstr.find tname old_theories in
mth.theory <- Some th;
mth
with Not_found ->
raw_add_theory mf (Some th) tname
let old_mth = Util.Mstr.find tname old_theories in
old_mth.goals
with Not_found -> []
in
let goals = List.fold_left
(fun acc g -> Util.Mstr.add g.goal_name g acc)
Util.Mstr.empty mth.goals
let goalsmap = List.fold_left
(fun goalsmap g -> Util.Mstr.add g.goal_name g goalsmap)
Util.Mstr.empty old_goals
in
let tasks = List.rev (Task.split_theory th None None) in
let goals = List.fold_left
let new_goals = List.fold_left
(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)
[] tasks
in
mth.goals <- List.rev goals;
(* TODO: what to do with remaining old theories?
for the moment they remain in the session
*)
mth.goals <- List.rev new_goals;
check_theory_proved mth;
mth::acc
)
[] theories
in
(* TODO: detecter d'eventuelles vieilles theories, qui seraient donc
dans [old_theories] mais pas dans [theories]
*)
mf.theories <- List.rev mths;
check_file_verified mf
mth
(* reloads a file *)
let reload_file ~provers mf =
eprintf "[Reload] file '%s'@." mf.file_name;
let theories =
try
read_file mf.file_name
with e ->
eprintf "@[Error while reading file@ '%s':@ %a@.@]" mf.file_name
Exn_printer.exn_printer e;
(* TODO: do something clever than that! *)
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 *)
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 *)
......@@ -1002,7 +982,11 @@ let rec load_goal ~env ~provers parent acc g =
try Some (List.assoc "expl" g.Xml.attributes)
with Not_found -> None
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;
mg::acc
| s ->
......@@ -1116,7 +1100,7 @@ let open_session ~env ~provers ~init ~notify dir =
begin try
let xml = Xml.from_file (Filename.concat dir db_filename) in
load_session ~env ~provers xml;
reload_all ()
reload_all provers
with
| Sys_error _ ->
(* xml does not exist yet *)
......@@ -1306,7 +1290,7 @@ let transformation_on_goal g tr =
in
let goal =
raw_add_goal (Parent_transf tr)
subgoal_name expl (Some subtask)
subgoal_name expl "" (Some subtask)
in
(goal :: acc, count+1)
in
......
......@@ -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