Skip to content

GitLab

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

partial reloading of files

parent 1f4102c3
Hide whitespace changes
Inline Side-by-side
misc/header.txt
View file @ c2dc9cb2
Copyright (C) 2010
Copyright (C) 2010-2011
François Bobot
Jean-Christophe Filliâtre
Claude Marché
......
src/ide/gconfig.ml
View file @ c2dc9cb2
......@@ -180,7 +180,8 @@ let image ?size f =
| Some s ->
GdkPixbuf.from_file_at_size ~width:s ~height:s n
let iconname_default = "pausehalf32"
let iconname_default = "undone32"
let iconname_undone = "undone32"
let iconname_scheduled = "pausehalf32"
let iconname_running = "play32"
let iconname_valid = "accept32"
......@@ -205,6 +206,7 @@ let iconname_remove = "deletefile32"
let iconname_cleaning = "trashb32"
let image_default = ref (image ~size:20 iconname_default)
let image_undone = ref !image_default
let image_scheduled = ref !image_default
let image_running = ref !image_default
let image_valid = ref !image_default
......@@ -230,6 +232,7 @@ let image_cleaning = ref !image_default
let resize_images size =
image_default := image ~size iconname_default;
image_undone := image ~size iconname_undone;
image_scheduled := image ~size iconname_scheduled;
image_running := image ~size iconname_running;
image_valid := image ~size iconname_valid;
......@@ -278,7 +281,7 @@ let show_legend_window () =
ib image_prover;
i " External prover\n";
ib image_transf;
i " Split transformation\n";
i " Transformation\n";
it "Status column\n";
ib image_scheduled;
i " Scheduled external proof attempt\n";
......@@ -306,13 +309,13 @@ let show_legend_window () =
let show_about_window () =
let about_dialog =
GWindow.about_dialog
~name:"Why"
~name:"Why3"
~authors:["François Bobot";
"Jean-Christophe Filliâtre";
"Claude Marché";
"Andrei Paskevich"
]
~copyright:"Copyright 2010 Univ Paris-Sud, CNRS, INRIA"
~copyright:"Copyright 2010-2011 Univ Paris-Sud, CNRS, INRIA"
~license:"GNU Lesser General Public License"
~website:"https://gforge.inria.fr/projects/why3"
~website_label:"Project web site"
......
src/ide/gconfig.mli
View file @ c2dc9cb2
......@@ -76,6 +76,7 @@ val image_remove : GdkPixbuf.pixbuf ref
val image_cleaning : GdkPixbuf.pixbuf ref
(* status icons *)
val image_undone : GdkPixbuf.pixbuf ref
val image_scheduled : GdkPixbuf.pixbuf ref
val image_running : GdkPixbuf.pixbuf ref
val image_valid : GdkPixbuf.pixbuf ref
......
src/ide/newmain.ml
View file @ c2dc9cb2
......@@ -338,7 +338,7 @@ let clear model = model#clear ()
let image_of_result ~obsolete result =
match result with
| Session.Undone -> !image_scheduled (* TODO *)
| Session.Undone -> !image_undone
| Session.Scheduled -> !image_scheduled
| Session.Running -> !image_running
| Session.InternalFailure _ -> !image_failure
......@@ -424,14 +424,8 @@ let init =
| M.Transformation _ -> !image_transf);
goals_model#set ~row ~column:name_column
(match any with
| M.Goal g ->
(match g.M.goal_expl with
| None -> g.M.goal_name
| Some s -> s)
| M.Theory th -> th.M.theory_name
(*
th.M.theory.Theory.th_name.Ident.id_string
*)
| 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
......@@ -440,9 +434,9 @@ let init =
let notify any =
match any with
| M.Goal g ->
set_row_status g.M.goal_key g.M.proved
set_row_status (M.goal_key g) (M.goal_proved g)
| M.Theory th ->
set_row_status th.M.theory_key th.M.verified
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 ->
......@@ -488,22 +482,18 @@ let () =
let () =
let dbfname = Filename.concat project_dir "project.xml" in
try
eprintf "Opening session...@?";
M.open_session ~env:gconfig.env ~provers:gconfig.provers
~init ~notify dbfname;
~init ~notify project_dir;
M.maximum_running_proofs := gconfig.max_running_processes;
eprintf " done@."
with e ->
eprintf "Error while opening session with database '%s'@." dbfname;
eprintf "Error while opening session with database '%s'@." project_dir;
eprintf "Aborting...@.";
raise e
let read_file fn =
let fn = Filename.concat project_dir fn in
Env.read_file gconfig.env fn
......@@ -541,7 +531,7 @@ let () =
eprintf "Info: file %s already in database@." fn
else
try
M.add_file fn (read_file fn)
M.add_file fn
with e ->
eprintf "@[Error while reading file@ '%s':@ %a@.@]" fn
Exn_printer.exn_printer e;
......@@ -629,7 +619,7 @@ let select_file () =
let f = Sysutil.relativize_filename project_dir f in
eprintf "Adding file '%s'@." f;
try
M.add_file f (read_file f)
M.add_file f
with e ->
fprintf str_formatter
"@[Error while reading file@ '%s':@ %a@]" f
......@@ -719,24 +709,24 @@ let (_ : GMenu.image_menu_item) =
let rec collapse_proved_goal g =
if g.M.proved then
if M.goal_proved g then
begin
let row = g.M.goal_key in
let row = M.goal_key g in
goals_view#collapse_row (goals_model#get_path row);
end
else
Hashtbl.iter
(fun _ t -> List.iter collapse_proved_goal t.M.subgoals)
g.M.transformations
(M.transformations g)
let collapse_verified_theory th =
if th.M.verified then
if M.verified th then
begin
let row = th.M.theory_key in
let row = M.theory_key th in
goals_view#collapse_row (goals_model#get_path row);
end
else
List.iter collapse_proved_goal th.M.goals
List.iter collapse_proved_goal (M.goals th)
let collapse_verified_file f =
if f.M.file_verified then
......
src/ide/session.ml
View file @ c2dc9cb2
......@@ -151,7 +151,7 @@ and transf =
and theory =
{ theory_name : string;
theory : Theory.theory option;
mutable theory : Theory.theory option;
theory_key : O.key;
theory_parent : file;
mutable goals : goal list;
......@@ -172,6 +172,11 @@ type any =
| Proof_attempt of proof_attempt
| Transformation of transf
let theory_name t = t.theory_name
let theory_key t = t.theory_key
let verified t = t.verified
let goals t = t.goals
let get_theory t =
match t.theory with
| None ->
......@@ -179,6 +184,15 @@ let get_theory t =
assert false
| Some t -> t
let goal_name g = g.goal_name
let goal_expl g =
match g.goal_expl with
| None -> g.goal_name
| Some s -> s
let goal_key g = g.goal_key
let goal_proved g = g.proved
let transformations g = g.transformations
let get_task g =
match g.task with
| None ->
......@@ -256,11 +270,6 @@ let save fname =
fprintf fmt "@.";
close_out ch
let test_save () = save "essai.xml"
let test_load () = Xml.from_file "essai.xml"
(************************)
(* actions *)
(************************)
......@@ -314,38 +323,14 @@ and check_transf_proved t =
check_goal_proved t.parent_goal
end
let set_file_verified f =
f.file_verified <- true;
!notify_fun (File f)
let set_theory_proved ~propagate t =
t.verified <- true;
!notify_fun (Theory t);
let f = t.theory_parent in
if propagate then
if List.for_all (fun t ->
t.verified) f.theories
then set_file_verified f
let rec set_proved ~propagate g =
g.proved <- true;
!notify_fun (Goal g);
if propagate then
match g.parent with
| Parent_theory t ->
if List.for_all (fun g -> g.proved) t.goals then
set_theory_proved ~propagate t
| Parent_transf t ->
if List.for_all (fun g -> g.proved) t.subgoals then
begin
set_proved ~propagate t.parent_goal;
end
let set_proof_state ~obsolete a res =
a.proof_state <- res;
a.proof_obsolete <- obsolete;
!notify_fun (Proof_attempt a)
!notify_fun (Proof_attempt a);
match res with
| Done _ ->
check_goal_proved a.proof_goal
| _ -> ()
(*************************)
(* Scheduler *)
......@@ -645,7 +630,7 @@ let add_theory mfile name th =
tasks
in
mth.goals <- List.rev goals;
if goals = [] then set_theory_proved ~propagate:false mth;
check_theory_proved mth;
mth
let raw_add_file f =
......@@ -661,7 +646,15 @@ let raw_add_file f =
!notify_fun any;
mfile
let add_file f theories =
let current_env = ref None
let project_dir = ref ""
let read_file fn =
let fn = Filename.concat !project_dir fn in
let env = match !current_env with
| None -> assert false | Some e -> e
in
let theories = Env.read_file env fn in
let theories =
Theory.Mnm.fold
(fun name th acc ->
......@@ -670,10 +663,12 @@ let add_file f theories =
| _ -> (Loc.dummy_position,name,th)::acc)
theories []
in
let theories = List.sort
List.sort
(fun (l1,_,_) (l2,_,_) -> Loc.compare l1 l2)
theories
in
let add_file f =
let theories = read_file f in
let mfile = raw_add_file f in
let mths =
List.fold_left
......@@ -683,7 +678,7 @@ let add_file f theories =
[] theories
in
mfile.theories <- List.rev mths;
if theories = [] then set_file_verified mfile
check_file_verified mfile
let file_exists fn =
......@@ -855,57 +850,63 @@ let reimport_root_goal mth tname goals t : Model.goal * bool =
in
reimport_any_goal (Model.Theory mth) id gname t db_goal goal_obsolete
(* reimports all files *)
let files_in_db = Db.files ()
*)
let () =
List.iter
(fun (f,fn) ->
eprintf "Reimporting file '%s'@." fn;
let mfile = Helpers.add_file_row fn f in
try
let theories = read_file fn in
let ths = Db.theories f in
let (mths,file_proved) =
List.fold_left
(fun (acc,file_proved) (_,tname,th) ->
eprintf "Reimporting theory '%s'@."tname;
let db_th =
try
Util.Mstr.find tname ths
with Not_found -> Db.add_theory f tname
in
let mth = Helpers.add_theory_row mfile th db_th in
let goals = Db.goals db_th in
let tasks = List.rev (Task.split_theory th None None) in
let goals,proved = List.fold_left
(fun (acc,proved) t ->
let (g,p) = reimport_root_goal mth tname goals t in
(g::acc,proved && p))
([],true) tasks
in
mth.Model.goals <- List.rev goals;
(* TODO: what to do with remaining tasks in Db ???
for the moment they remain in the db, but they are not shown
*)
if proved then Helpers.set_theory_proved ~propagate:false mth;
(mth::acc,file_proved && proved))
([],true) theories
in
(* TODO: detecter d'eventuelles vieilles theories, qui seraient donc
dans [ths] mais pas dans [theories]
*)
mfile.Model.theories <- List.rev mths;
if file_proved then Helpers.set_file_verified mfile
with e ->
eprintf "@[Error while reading file@ '%s':@ %a@.@]" fn
Exn_printer.exn_printer e;
exit 1
)
files_in_db
(* reloads a file *)
let reload_file mf =
eprintf "[Reload] file '%s'@." mf.file_name;
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
in
let mths =
List.fold_left
(fun acc (_,tname,th) ->
eprintf "[Reload] theory '%s'@."tname;
let mth =
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
in
(*
let goals = Db.goals db_th in
let tasks = List.rev (Task.split_theory th None None) in
let goals,proved = List.fold_left
(fun (acc,proved) t ->
let (g,p) = reimport_root_goal mth tname goals t in
(g::acc,proved && p))
([],true) tasks
in
mth.Model.goals <- List.rev goals;
*)
(* TODO: what to do with remaining old theories?
for the moment they remain in the session
*)
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
with e ->
eprintf "@[Error while reading file@ '%s':@ %a@.@]" mf.file_name
Exn_printer.exn_printer e;
exit 1
(* reloads all files *)
let reload_all () = List.iter reload_file !all_files
(****************************)
(* session opening *)
......@@ -1058,18 +1059,17 @@ let load_session ~env ~provers xml =
eprintf "Session.load_session: unexpected element '%s'@." s;
assert false
let db_file = ref None
let db_filename = "why3session.xml"
let open_session ~env ~provers ~init ~notify file =
match !db_file with
let open_session ~env ~provers ~init ~notify dir =
match !current_env with
| None ->
init_fun := init; notify_fun := notify;
db_file := Some file;
project_dir := dir; current_env := Some env;
begin try
let xml = Xml.from_file file in
let xml = Xml.from_file (Filename.concat dir db_filename) in
load_session ~env ~provers xml;
(* TODO reload the files *)
()
reload_all ()
with
| Sys_error _ ->
(* xml does not exist yet *)
......@@ -1083,8 +1083,8 @@ let open_session ~env ~provers ~init ~notify file =
assert false
let save_session () =
match !db_file with
| Some f -> save f
match !current_env with
| Some _ -> save (Filename.concat !project_dir db_filename)
| None ->
eprintf "Session.save_session: no session opened@.";
assert false
......@@ -1105,11 +1105,6 @@ let redo_external_proof g a =
let p = a.prover in
let callback result =
set_proof_state ~obsolete:false a result;
match result with
| Done r ->
if r.Call_provers.pr_answer = Call_provers.Valid then
set_proved ~propagate:true a.proof_goal
| _ -> ()
in
let old = if a.edited_as = "" then None else
begin
......@@ -1364,11 +1359,10 @@ let edit_proof ~default_editor ~project_dir a =
file
| f -> f
in
let old_status = a.proof_state in
let callback res =
match res with
| Done _ ->
set_proof_state ~obsolete:false a old_status
set_proof_state ~obsolete:false a Undone
| _ ->
set_proof_state ~obsolete:false a res
in
......
src/ide/session.mli
View file @ c2dc9cb2
......@@ -20,6 +20,7 @@
open Why
(** {Prover's data} *)
type prover_data = private
{ prover_id : string;
prover_name : string;
......@@ -29,18 +30,24 @@ type prover_data = private
driver : Driver.driver;
mutable editor : string;
}
(** record of necessary data for a given external prover *)
val get_prover_data :
Env.env -> Util.Mstr.key -> Whyconf.config_prover ->
prover_data Util.Mstr.t -> prover_data Util.Mstr.t
(** loads all provers from the current configuration *)
(* transformations *)
(** {Transformation's data} *)
type transformation_data
(** record data for transformations *)
val transformation_id : transformation_data -> string
(** Why3 name of a transformation *)
val lookup_transformation : Env.env -> string -> transformation_data
(** returns a transformation from its Why3 name *)
(** {Proof attempts} *)
type proof_attempt_status = private
| Undone
| Scheduled (** external proof attempt is scheduled *)
......@@ -48,24 +55,55 @@ type proof_attempt_status = private
| Done of Call_provers.prover_result (** external proof done *)
| InternalFailure of exn (** external proof aborted by internal error *)
(** {Observers signature} *)
module type OBSERVER = sig
type key
(** type key allowing to uniquely identify an element of
of session: a goal, a transformation, a proof attempt,
a theory or a file. See type [any] below *)
val create: ?parent:key -> unit -> key
(** returns a fresh key, a new child of the given parent if any *)
val remove: key -> unit
(** removes a key *)
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
true, it must be rescheduled *)
val idle: (unit -> bool) -> unit
(** a handler for a delayed function, that can be called when
there is nothing else to do. When the given function returns
true, it must be rescheduled *)
end
(** {Main functor} *)
module Make(O: OBSERVER) : sig
(*****************************)
(* *)
(* static state of a session *)
(* *)
(*****************************)
(** {static state of a session} *)
type goal
(** a goal *)
type transf = private
{ transf : transformation_data;
parent_goal : goal;
mutable transf_proved : bool;
transf_key : O.key;
mutable subgoals : goal list;
}
(** a transformation of a given goal *)
val goal_name : goal -> string
val goal_expl : goal -> string
val get_task : goal -> Task.task
val goal_key : goal -> O.key
val goal_proved : goal -> bool
val transformations : goal -> (string, transf) Hashtbl.t
type proof_attempt = private
{ prover : prover_data;
......@@ -75,40 +113,18 @@ module Make(O: OBSERVER) : sig
mutable proof_obsolete : bool;
mutable edited_as : string;
}
(** a proof attempt for a given goal *)
and goal_parent =
| Parent_theory of theory
| Parent_transf of transf
and goal = private
{ goal_name : string;
goal_expl : string option;
parent : goal_parent;
task: Task.task option;
goal_key : O.key;
mutable proved : bool;
external_proofs: (string, proof_attempt) Hashtbl.t;
transformations : (string, transf) Hashtbl.t;
}
type theory
(** a theory, holding a collection of goals *)
and transf = private
{ transf : transformation_data;
parent_goal : goal;
mutable transf_proved : bool;
transf_key : O.key;
mutable subgoals : goal list;
}
and theory = private
{ theory_name : string;
theory : Theory.theory option;
theory_key : O.key;
theory_parent : file;
mutable goals : goal list;
mutable verified : bool;
}
val theory_name : theory -> string
val get_theory : theory -> Theory.theory
val theory_key : theory -> O.key
val verified : theory -> bool
val goals : theory -> goal list
and file = private
type file = private
{ file_name : string;
file_key : O.key;
mutable theories: theory list;
......@@ -123,10 +139,6 @@ module Make(O: OBSERVER) : sig
| Transformation of transf