Commit 2e2e0d83 authored by François Bobot's avatar François Bobot

Session doesn't use anymore prover id.

Prover ids are only used for the command line option "-P".
The user can choose what he wants (they must be unique)
The prover name and version should not be modified. If someone want to
test different command line options for a prover he can use the
"alternative" field.

If someone want to replay an external proof but he doesn't have the
corresponding prover (same name,version,alternative), why3ide ask for
a replacement among the known provers. The choice can be saved.
parent ac98a7a4
......@@ -28,6 +28,10 @@ s
is not changed by a transformation, it will stay in the hash table forever,
since the key is the value. Should we use generation numbers in arguments
and results of transformations?
François -- I don't get that point the weak Hashtbl that we use
are designed to work on this case, even with the identity function.
What we should do is a way to remove the task from a session when
they are not needed anymore.
- uses : pour l'instant, l'ordre des théories dans le fichier est important
i.e. les théories mentionnées par uses doivent être définies précédemment
......@@ -41,3 +45,17 @@ error reporting
- should we create a common [exception Why.Error of exn] to facilitate
integration of the library? This would require a special [raise] call:
why_raise e = raise (Why.Error e)
session
-------
- save the output of the prover
- escape the string in the xml
tools
-----
- the tools should verify that the provers have the same version
than reported in the configuration
- Maybe : make something generic for the dialog box with memory.
- autodetection can be modified now that only name/version/altern
are taken into account in session.
\ No newline at end of file
......@@ -247,8 +247,8 @@ let () =
if !opt_list_provers then begin
opt_list := true;
let config = read_config !opt_config in
let print fmt prover _ = fprintf fmt "%s (%s)@\n"
prover.prover_id prover.prover_name in
let print fmt prover pc = fprintf fmt "%s (%a)@\n"
pc.id print_prover prover in
let print fmt m = Mprover.iter (print fmt) m in
let provers = get_provers config in
printf "@[<hov 2>Known provers:@\n%a@]@." print provers
......
......@@ -155,8 +155,11 @@ let detect_exec main data com =
supported, use it at your own risk!@." nam ver
end;
let c = make_command com data.prover_command in
Some {name = data.prover_name;
version = ver;
let prover = {Whyconf.prover_name = data.prover_name;
prover_version = ver;
prover_altern = ""} in
Some {prover = prover;
id = data.prover_id;
command = c;
driver = Filename.concat (datadir main) data.prover_driver;
editor = data.prover_editor;
......@@ -180,10 +183,7 @@ let detect_prover main acc l =
with Not_found -> None
in
let prover = Util.list_first detect_execs l in
let prover_id = {Whyconf.prover_id = prover_id;
prover_name = prover.name;
prover_version = prover.version} in
Mprover.add prover_id prover acc
Mprover.add prover.prover prover acc
with Not_found ->
eprintf "Prover %s not found.@." prover_id;
acc
......
......@@ -54,34 +54,37 @@ let default_conf_file =
(* Prover *)
type prover =
{ prover_id : string;
prover_name : string;
{ prover_name : string;
prover_version : string;
prover_altern : string;
}
let print_prover fmt p =
Format.fprintf fmt "%s(%s)" p.prover_name p.prover_version
Format.fprintf fmt "%s(%s%s%s)"
p.prover_name p.prover_version
(if p.prover_altern = "" then "" else " ") p.prover_altern
module Prover = struct
type t = prover
let compare s1 s2 =
if s1 == s2 then 0 else
let c = String.compare s1.prover_id s2.prover_id in
if c <> 0 then c else
let c = String.compare s1.prover_name s2.prover_name in
if c <> 0 then c else
let c = String.compare s1.prover_version s2.prover_version in
if c <> 0 then c else
let c = String.compare s1.prover_altern s2.prover_altern in
c
let equal s1 s2 =
s1.prover_id = s2.prover_id &&
s1.prover_name = s2.prover_name &&
s1.prover_version = s2.prover_version
s1 == s2 ||
(s1.prover_name = s2.prover_name &&
s1.prover_version = s2.prover_version &&
s1.prover_altern = s2.prover_altern)
let hash s1 =
2 * Hashtbl.hash s1.prover_id +
3 * Hashtbl.hash s1.prover_name +
5 * Hashtbl.hash s1.prover_version
2 * Hashtbl.hash s1.prover_name +
3 * Hashtbl.hash s1.prover_version +
5 * Hashtbl.hash s1.prover_altern
end
......@@ -93,10 +96,10 @@ module Hprover = Hashtbl.Make(Prover)
(* Configuration file *)
type config_prover = {
name : string; (* "Alt-Ergo v2.95 (special)" *)
command : string; (* "exec why-limit %t %m alt-ergo %f" *)
driver : string; (* "/usr/local/share/why/drivers/ergo-spec.drv" *)
version : string; (* "v2.95" *)
prover : prover;
id : string;
command : string;
driver : string;
editor : string;
interactive : bool;
}
......@@ -197,35 +200,41 @@ let set_main rc main =
let section = set_stringl section "plugin" main.plugins in
set_section rc "main" section
let set_prover prover_id prover family =
exception NonUniqueId
let set_prover _ prover (ids,family) =
if Sstr.mem prover.id ids then raise NonUniqueId;
let section = empty_section in
let section = set_string section "name" prover.name in
let section = set_string section "name" prover.prover.prover_name in
let section = set_string section "command" prover.command in
let section = set_string section "driver" prover.driver in
let section = set_string section "version" prover.version in
let section = set_string section "version" prover.prover.prover_version in
let section = set_string ~default:""
section "alternative" prover.prover.prover_altern in
let section = set_string section "editor" prover.editor in
let section = set_bool section "interactive" prover.interactive in
(prover_id.prover_id,section)::family
(Sstr.add prover.id ids,(prover.id,section)::family)
let set_provers rc provers =
let family = Mprover.fold set_prover provers [] in
let _,family = Mprover.fold set_prover provers (Sstr.empty,[]) in
set_family rc "prover" family
let absolute_filename = Sysutil.absolutize_filename
let load_prover dirname provers (id,section) =
let version = get_string ~default:"" section "version" in
let altern = get_string ~default:"" section "alternative" in
let name = get_string section "name" in
let prover =
{ prover_id = id;
prover_name = name;
prover_version = version }
{ prover_name = name;
prover_version = version;
prover_altern = altern}
in
Mprover.add prover
{ name = name;
{ id = id;
prover = prover;
command = get_string section "command";
driver = absolute_filename dirname (get_string section "driver");
version = version;
editor = get_string ~default:"" section "editor";
interactive = get_bool ~default:false section "interactive";
} provers
......@@ -261,6 +270,8 @@ let () = Exn_printer.register (fun fmt e -> match e with
Format.fprintf fmt "error in config file %s: %s" f s
| WrongMagicNumber ->
Format.fprintf fmt "outdated config file; rerun why3config"
| NonUniqueId ->
Format.fprintf fmt "InternalError : two provers share the same id"
| _ -> raise e)
let get_config (filename,rc) =
......@@ -330,7 +341,7 @@ exception ProverAmbiguity of config * string * prover list
let prover_by_id whyconf id =
let potentials =
Mprover.filter (fun p _ -> p.prover_id = id) whyconf.provers in
Mprover.filter (fun _ p -> p.id = id) whyconf.provers in
match Mprover.keys potentials with
| [] -> raise (ProverNotFound(whyconf,id))
| [_] -> snd (Mprover.choose potentials)
......
......@@ -85,9 +85,9 @@ val load_plugins : main -> unit
(** {3 Prover's identifier} *)
type prover =
{ prover_id : string;
prover_name : string;
prover_version : string;
{ prover_name : string; (* "Alt-Ergo" *)
prover_version : string; (* "2.95" *)
prover_altern : string; (* "special" *)
}
(** record of necessary data for a given external prover
In the future prover_id will disappear.
......@@ -103,10 +103,10 @@ module Hprover : Hashtbl.S with type key = prover
(** {3 Prover configuration} *)
type config_prover = {
name : string; (* "Alt-Ergo v2.95 (special)" *)
prover : prover; (* unique name for session *)
id : string; (* unique name for command line *)
command : string; (* "exec why-limit %t %m alt-ergo %f" *)
driver : string; (* "/usr/local/share/why/drivers/ergo-spec.drv" *)
version : string; (* "v2.95" *)
editor : string; (* Dedicated editor *)
interactive : bool; (* Interative theorem prover *)
}
......
......@@ -26,6 +26,13 @@ open Whyconf
(* config file *)
type altern_provers = prover option Mprover.t
(** Todo do something generic perhaps*)
type conf_replace_prover =
| CRP_Ask
| CRP_Not_Obsolete
type t =
{ mutable window_width : int;
mutable window_height : int;
......@@ -48,6 +55,8 @@ type t =
(** colors *)
mutable env : Env.env;
mutable config : Whyconf.config;
mutable altern_provers : altern_provers;
mutable replace_prover : conf_replace_prover;
}
......@@ -66,6 +75,7 @@ type ide = {
ide_goal_color : string;
ide_error_color : string;
ide_default_editor : string;
ide_replace_prover : conf_replace_prover;
}
let default_ide =
......@@ -82,9 +92,10 @@ let default_ide =
ide_premise_color = "chartreuse";
ide_goal_color = "gold";
ide_error_color = "orange";
ide_replace_prover = CRP_Ask;
ide_default_editor =
try Sys.getenv "EDITOR" ^ " %f"
with Not_found -> "editor %f";
with Not_found -> "editor %f"
}
let load_ide section =
......@@ -106,7 +117,8 @@ let load_ide section =
ide_show_locs =
get_bool section ~default:default_ide.ide_show_locs "print_locs";
ide_show_time_limit =
get_bool section ~default:default_ide.ide_show_time_limit "print_time_limit";
get_bool section ~default:default_ide.ide_show_time_limit
"print_time_limit";
ide_saving_policy =
get_int section ~default:default_ide.ide_saving_policy "saving_policy";
ide_premise_color =
......@@ -121,6 +133,12 @@ let load_ide section =
ide_default_editor =
get_string section ~default:default_ide.ide_default_editor
"default_editor";
ide_replace_prover =
match get_stringo section "replace_prover" with
| None -> default_ide.ide_replace_prover
| Some "never not obsolete" -> CRP_Not_Obsolete
| Some "ask" | Some _ -> CRP_Ask
}
......@@ -134,11 +152,31 @@ let set_locs_flag =
fun b ->
(if b then Debug.set_flag else Debug.unset_flag) fl
let load_altern alterns (_,section) =
let unknown =
{prover_name = get_string section "unknown_name";
prover_version = get_string section "unknown_version";
prover_altern = get_string ~default:"" section "unknown_alternative"
} in
let name = get_stringo section "known_name" in
let known = match name with
| None -> None
| Some name ->
Some
{prover_name = name;
prover_version = get_string section "known_version";
prover_altern = get_string ~default:"" section "known_alternative";
} in
Mprover.add unknown known alterns
let load_config config =
let main = get_main config in
let ide = match get_section config "ide" with
| None -> default_ide
| Some s -> load_ide s in
let alterns =
List.fold_left load_altern
Mprover.empty (get_family config "alternative_prover") in
(* temporary sets env to empty *)
let env = Env.create_env [] in
set_labels_flag ide.ide_show_labels;
......@@ -161,15 +199,33 @@ let load_config config =
max_running_processes = Whyconf.running_provers_max main;
default_editor = ide.ide_default_editor;
config = config;
env = env
env = env;
altern_provers = alterns;
replace_prover = ide.ide_replace_prover;
}
let save_altern unknown known (id,family) =
let alt = empty_section in
let alt = set_string alt "unknown_name" unknown.prover_name in
let alt = set_string alt "unknown_version" unknown.prover_version in
let alt =
set_string ~default:"" alt "unknown_alternative" unknown.prover_altern in
let alt = match known with
| None -> alt
| Some known ->
let alt = set_string alt "known_name" known.prover_name in
let alt = set_string alt "known_version" known.prover_version in
set_string ~default:"" alt "known_alternative" known.prover_altern in
(id+1,(sprintf "alt%i" id,alt)::family)
let save_config t =
let config = t.config in
let config = set_main config
(set_limits (get_main config)
t.time_limit t.mem_limit t.max_running_processes)
in
let _,alterns = Mprover.fold save_altern t.altern_provers (0,[]) in
let config = set_family config "alternative_prover" alterns in
let ide = empty_section in
let ide = set_int ide "window_height" t.window_height in
let ide = set_int ide "window_width" t.window_width in
......@@ -185,6 +241,10 @@ let save_config t =
let ide = set_string ide "goal_color" t.goal_color in
let ide = set_string ide "error_color" t.error_color in
let ide = set_string ide "default_editor" t.default_editor in
let ide = set_string ~default:"ask" ide "replace_prover"
(match t.replace_prover with
| CRP_Ask -> "ask"
| CRP_Not_Obsolete -> "never not obsolete") in
let config = set_section config "ide" ide in
(* TODO: store newly detected provers !
let config = set_provers config
......@@ -388,6 +448,48 @@ let show_about_window () =
let ( _ : GWindow.Buttons.about) = about_dialog#run () in
about_dialog#destroy ()
let alternatives_frame c (notebook:GPack.notebook) =
let label = GMisc.label ~text:"Alternative provers" () in
let page =
GPack.vbox ~homogeneous:false ~packing:
(fun w -> ignore(notebook#append_page ~tab_label:label#coerce w)) ()
in
let replace_prover =
GButton.check_button ~label:"never replace not obsolete external proof"
~packing:page#add ()
~active:(c.replace_prover = CRP_Not_Obsolete)
in
let (_ : GtkSignal.id) =
replace_prover#connect#toggled ~callback:
(fun () ->
if replace_prover#active
then c.replace_prover <- CRP_Not_Obsolete
else c.replace_prover <- CRP_Ask
)
in
let frame =
GBin.frame ~label:"Click for removing an association"
~packing:page#add ()
in
let box =
GPack.button_box `VERTICAL ~border_width:5 ~spacing:5
~packing:frame#add ()
in
let remove button unknown () =
button#destroy ();
c.altern_provers <- Mprover.remove unknown c.altern_provers in
let iter unknown known =
let label =
match known with
| None -> Pp.sprintf_wnl "%a ignored" print_prover unknown
| Some known ->
Pp.sprintf_wnl "%a -> %a" print_prover unknown print_prover known in
let button = GButton.button ~label ~packing:box#add () in
let (_ : GtkSignal.id) =
button#connect#released ~callback:(remove button unknown)
in () in
Mprover.iter iter c.altern_provers
let preferences c =
let dialog = GWindow.dialog ~title:"Why3: preferences" () in
let vbox = dialog#vbox in
......@@ -570,6 +672,8 @@ let preferences c =
let (_ : GtkSignal.id) =
choice2#connect#toggled ~callback:(set_saving_policy 2)
in
(* page 4 *)
alternatives_frame c notebook;
(* buttons *)
dialog#add_button "Close" `CLOSE ;
let ( _ : GWindow.Buttons.about) = dialog#run () in
......@@ -591,7 +695,86 @@ let run_auto_detection gconfig =
(* let () = eprintf "[Info] end of configuration initialization@." *)
let read_config conf_file = read_config conf_file; init ()
let unknown_prover c eS unknown =
try Mprover.find unknown c.altern_provers
with Not_found ->
let others,names,versions = Session_tools.unknown_to_known_provers
(Whyconf.get_provers eS.Session.whyconf) unknown in
let dialog = GWindow.dialog ~title:"Why3: Unknown prover" () in
let vbox = dialog#vbox in
let text = Pp.sprintf "The prover %a is unknown. Could you please choose \
an alternative?" Whyconf.print_prover unknown in
let _label1 = GMisc.label ~text ~packing:vbox#add () in
let frame = vbox in
let prover_choosed = ref None in
let set_prover prover () = prover_choosed := Some prover in
let box =
GPack.button_box `VERTICAL ~border_width:5 ~spacing:5
~packing:frame#add ()
in
let choice0 = GButton.radio_button
~label:"ignore this prover"
~active:true
~packing:box#add () in
ignore (choice0#connect#toggled
~callback:(fun () -> prover_choosed := None));
let alternatives_section text alternatives =
if alternatives <> [] then
let _label1 = GMisc.label ~text ~packing:frame#add () in
let box =
GPack.button_box `VERTICAL ~border_width:5 ~spacing:5
~packing:frame#add ()
in
let iter_alter prover =
let choice = GButton.radio_button
~label:(Pp.string_of_wnl print_prover prover)
~group:choice0#group
~active:false
~packing:box#add () in
ignore (choice#connect#toggled ~callback:(set_prover prover))
in
List.iter iter_alter alternatives in
alternatives_section "Same name and same version:" versions;
alternatives_section "Same name and different version:" names;
alternatives_section "Different name and different version:" others;
let save =
GButton.check_button
~label:"always use this association"
~packing:frame#add ()
~active:true
in
dialog#add_button "Ok" `CLOSE ;
ignore (dialog#run ());
dialog#destroy ();
if save#active then
c.altern_provers <- Mprover.add unknown !prover_choosed c.altern_provers;
!prover_choosed
let replace_prover c to_be_removed to_be_copied =
if not to_be_removed.Session.proof_obsolete &&
c.replace_prover = CRP_Not_Obsolete
then false
else
let dialog = GWindow.dialog ~title:"Why3: replace proof" () in
let vbox = dialog#vbox in
let text = Pp.sprintf
"Do you want to replace the external proof %a by the external proof %a \
(with the prover of the first)"
Session.print_external_proof to_be_removed
Session.print_external_proof to_be_copied in
let _label1 = GMisc.label ~text ~line_wrap:true ~packing:vbox#add () in
dialog#add_button "Replace" `Replace;
dialog#add_button "Keep" `Keep;
dialog#add_button "Never replace an external proof valid and not obsolete"
`Never;
let res = match dialog#run () with
| `Replace -> true
| `Never -> c.replace_prover <- CRP_Not_Obsolete; false
| `DELETE_EVENT | `Keep -> false in
dialog#destroy ();
res
let read_config conf_file = read_config conf_file; init ()
(*
Local Variables:
......
......@@ -18,6 +18,12 @@
(**************************************************************************)
open Why3
open Whyconf
(** Todo do something generic perhaps*)
type conf_replace_prover =
| CRP_Ask
| CRP_Not_Obsolete
type t =
{ mutable window_width : int;
......@@ -39,6 +45,8 @@ type t =
mutable error_color : string;
mutable env : Why3.Env.env;
mutable config : Whyconf.config;
mutable altern_provers : prover option Mprover.t;
mutable replace_prover : conf_replace_prover;
}
val read_config : string option -> unit
......@@ -94,7 +102,10 @@ val image_failure_obs : GdkPixbuf.pixbuf ref
val show_legend_window : unit -> unit
val show_about_window : unit -> unit
val preferences : t -> unit
val unknown_prover :
t -> 'key Session.env_session -> Whyconf.prover -> Whyconf.prover option
val replace_prover :
t -> 'key Session.proof_attempt -> 'key Session.proof_attempt -> bool
(*
Local Variables:
compile-command: "unset LANG; make -C ../.. bin/why3ide.byte"
......
......@@ -549,6 +549,10 @@ let init =
| S.Transf tr -> tr.S.transf_name);
notify any
let unknown_prover = Gconfig.unknown_prover gconfig
let replace_prover = Gconfig.replace_prover gconfig
end)
......@@ -556,6 +560,7 @@ let init =
(* opening database *)
(********************)
(** TODO remove that should done only in session *)
let project_dir, file_to_read =
if Sys.file_exists fname then
begin
......@@ -1358,8 +1363,8 @@ let edit_selected_row r =
| S.File _file ->
()
| S.Proof_attempt a ->
M.edit_proof !env_session sched ~default_editor:gconfig.default_editor
~project_dir a
M.edit_proof
!env_session sched ~default_editor:gconfig.default_editor a
| S.Transf _ -> ()
let edit_current_proof () =
......
......@@ -211,6 +211,9 @@ let notify _any = ()
(Session.transformation_id tr.M.transf) tr.M.transf_proved
*)
let unknown_prover _ _ = None
let replace_prover _ _ = false
end)
......
......@@ -68,31 +68,33 @@ let () =
Debug.Opt.set_flags_selected ();
if Debug.Opt.option_list () then exit 0
let string_of_prover p = Pp.string_of_wnl C.print_prover p
type proof_stats =
{ mutable no_proof : Sstr.t;
mutable only_one_proof : Sstr.t;
prover_min_time : (string, float) Hashtbl.t;
prover_avg_time : (string, float) Hashtbl.t;
prover_max_time : (string, float) Hashtbl.t;
prover_num_proofs : (string, int) Hashtbl.t;
prover_data : (string, string) Hashtbl.t
prover_min_time : float C.Hprover.t;
prover_avg_time : float C.Hprover.t;
prover_max_time : float C.Hprover.t;
prover_num_proofs : int C.Hprover.t;
prover_data : (string) C.Hprover.t
}
let new_proof_stats () =
{ no_proof = Sstr.empty;
only_one_proof = Sstr.empty;