Skip to content

GitLab

Commit ac98a7a4 authored by François Bobot's avatar François Bobot
Browse files

use prover instead of string as key for provers

parent ab164266
Hide whitespace changes
Inline Side-by-side
Showing with 199 additions and 149 deletions
src/bench/benchdb.ml
View file @ ac98a7a4
......@@ -55,7 +55,7 @@ let rec goal whyconf env path dbgoal wgoal =
let prover_name = Db.prover_name prover_id in
let driver,command =
try
let p = Mstr.find prover_name (Whyconf.get_provers whyconf) in
let p = Whyconf.prover_by_id whyconf prover_name in
p.Whyconf.driver ,p.Whyconf.command
with
(* TODO add exceptions pehaps inside rc.ml in fact*)
......
src/bench/benchrc.ml
View file @ ac98a7a4
......@@ -75,7 +75,7 @@ let read_tools absf wc map (name,section) =
(* provers *)
let provers = get_stringl ~default:[] section "prover" in
let find_provers s =
try let p = Mstr.find s (get_provers wc) in
try let p = prover_by_id wc s in
s,p.driver ,p.command
with
(* TODO add exceptions pehaps inside rc.ml in fact*)
......@@ -90,7 +90,7 @@ let read_tools absf wc map (name,section) =
let load_driver (n,d,c) = n,Driver.load_driver env d,c in
let provers = List.map load_driver provers in
let create_tool (n,driver,command) =
{ tval = {tool_name = name; prover_name = n; tool_db =
{ tval = {Bench.tool_name = name; prover_name = n; tool_db =
if Db.is_initialized () then Some (Db.prover_from_name n) else None};
ttrans = transforms;
tdriver = driver;
......
src/bench/whybench.ml
View file @ ac98a7a4
......@@ -247,8 +247,9 @@ let () =
if !opt_list_provers then begin
opt_list := true;
let config = read_config !opt_config in
let print fmt s prover = fprintf fmt "%s (%s)@\n" s prover.name in
let print fmt m = Mstr.iter (print fmt) m in
let print fmt prover _ = fprintf fmt "%s (%s)@\n"
prover.prover_id prover.prover_name 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
end;
......@@ -333,9 +334,7 @@ let () =
let map_prover s =
let prover = try Mstr.find s (get_provers config) with
| Not_found -> eprintf "Prover %s not found.@." s; exit 1
in
let prover = prover_by_id config s in
{ B.tval = {B.tool_name = "cmdline"; prover_name = s; tool_db = None};
ttrans = [Trans.identity,None];
tdriver = load_driver env prover.driver;
......
src/driver/autodetection.ml
View file @ ac98a7a4
......@@ -180,7 +180,10 @@ let detect_prover main acc l =
with Not_found -> None
in
let prover = Util.list_first detect_execs l in
Mstr.add prover_id prover acc
let prover_id = {Whyconf.prover_id = prover_id;
prover_name = prover.name;
prover_version = prover.version} in
Mprover.add prover_id prover acc
with Not_found ->
eprintf "Prover %s not found.@." prover_id;
acc
......@@ -202,7 +205,7 @@ let run_auto_detection config =
let l = read_auto_detection_data main in
let cmp p q = String.compare p.prover_id q.prover_id in
let l = Util.list_part cmp l in
let detect = List.fold_left (detect_prover main) Mstr.empty l in
let length = Mstr.cardinal detect in
let detect = List.fold_left (detect_prover main) Mprover.empty l in
let length = Mprover.cardinal detect in
eprintf "%d provers detected.@." length;
set_provers config detect
src/driver/whyconf.ml
View file @ ac98a7a4
......@@ -20,6 +20,7 @@
open Format
open Util
open Rc
open Stdlib
(* magicnumber for the configuration :
- 0 before the magic number
......@@ -50,6 +51,45 @@ let default_conf_file =
| None -> Filename.concat (Rc.get_home_dir ()) ".why3.conf"
| Some d -> Filename.concat d "why3.conf"
(* Prover *)
type prover =
{ prover_id : string;
prover_name : string;
prover_version : string;
}
let print_prover fmt p =
Format.fprintf fmt "%s(%s)" p.prover_name p.prover_version
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
c
let equal s1 s2 =
s1.prover_id = s2.prover_id &&
s1.prover_name = s2.prover_name &&
s1.prover_version = s2.prover_version
let hash s1 =
2 * Hashtbl.hash s1.prover_id +
3 * Hashtbl.hash s1.prover_name +
5 * Hashtbl.hash s1.prover_version
end
module Mprover = Map.Make(Prover)
module Sprover = Mprover.Set
module Hprover = Hashtbl.Make(Prover)
(* Configuration file *)
type config_prover = {
......@@ -128,7 +168,7 @@ type config = {
conf_file : string; (* "/home/innocent_user/.why3.conf" *)
config : Rc.t;
main : main;
provers : config_prover Mstr.t;
provers : config_prover Mprover.t;
}
let default_main =
......@@ -157,7 +197,7 @@ let set_main rc main =
let section = set_stringl section "plugin" main.plugins in
set_section rc "main" section
let set_prover id prover family =
let set_prover prover_id prover family =
let section = empty_section in
let section = set_string section "name" prover.name in
let section = set_string section "command" prover.command in
......@@ -165,20 +205,27 @@ let set_prover id prover family =
let section = set_string section "version" prover.version in
let section = set_string section "editor" prover.editor in
let section = set_bool section "interactive" prover.interactive in
(id,section)::family
(prover_id.prover_id,section)::family
let set_provers rc provers =
let family = Mstr.fold set_prover provers [] in
let family = Mprover.fold set_prover provers [] in
set_family rc "prover" family
let absolute_filename = Sysutil.absolutize_filename
let load_prover dirname provers (id,section) =
Mstr.add id
{ name = get_string section "name";
let version = get_string ~default:"" section "version" in
let name = get_string section "name" in
let prover =
{ prover_id = id;
prover_name = name;
prover_version = version }
in
Mprover.add prover
{ name = name;
command = get_string section "command";
driver = absolute_filename dirname (get_string section "driver");
version = get_string ~default:"" section "version";
version = version;
editor = get_string ~default:"" section "editor";
interactive = get_bool ~default:false section "interactive";
} provers
......@@ -224,7 +271,7 @@ let get_config (filename,rc) =
| Some main -> rc, load_main dirname main
in
let provers = get_family rc "prover" in
let provers = List.fold_left (load_prover dirname) Mstr.empty provers in
let provers = List.fold_left (load_prover dirname) Mprover.empty provers in
{ conf_file = filename;
config = rc;
main = main;
......@@ -268,9 +315,43 @@ let set_provers config provers =
provers = provers;
}
(*******)
let set_conf_file config conf_file = {config with conf_file = conf_file}
let get_conf_file config = config.conf_file
(*******)
let is_prover_known whyconf prover =
Mprover.mem prover (get_provers whyconf)
exception ProverNotFound of config * string
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
match Mprover.keys potentials with
| [] -> raise (ProverNotFound(whyconf,id))
| [_] -> snd (Mprover.choose potentials)
| l -> raise (ProverAmbiguity(whyconf,id,l))
let () = Exn_printer.register
(fun fmt exn ->
match exn with
| ProverNotFound (config,s) ->
fprintf fmt "Prover '%s' not found in %s@."
s (get_conf_file config)
| ProverAmbiguity (config,s,l) ->
fprintf fmt "More than one provers corresponds to '%s' in %s:@.%a@."
s (get_conf_file config)
(Pp.print_list Pp.newline print_prover) l
| e -> raise e
)
(******)
let get_section config name = assert (name <> "main");
get_section config.config name
......@@ -283,3 +364,4 @@ let set_section config name section = assert (name <> "main");
let set_family config name section = assert (name <> "prover");
{config with config = set_family config.config name section}
src/driver/whyconf.mli
View file @ ac98a7a4
......@@ -82,6 +82,26 @@ val load_plugins : main -> unit
(** {2 Provers} *)
(** {3 Prover's identifier} *)
type prover =
{ prover_id : string;
prover_name : string;
prover_version : string;
}
(** record of necessary data for a given external prover
In the future prover_id will disappear.
*)
val print_prover : Format.formatter -> prover -> unit
(** Printer for prover *)
module Mprover : Stdlib.Map.S with type key = prover
module Sprover : Mprover.Set
module Hprover : Hashtbl.S with type key = prover
(** {3 Prover configuration} *)
type config_prover = {
name : string; (* "Alt-Ergo v2.95 (special)" *)
command : string; (* "exec why-limit %t %m alt-ergo %f" *)
......@@ -91,14 +111,21 @@ type config_prover = {
interactive : bool; (* Interative theorem prover *)
}
val get_provers : config -> config_prover Mstr.t
val get_provers : config -> config_prover Mprover.t
(** [get_main config] get the prover family stored in the Rc file. The
keys are the unique ids of the prover (argument of the family) *)
val set_provers : config -> config_prover Mstr.t -> config
val set_provers : config -> config_prover Mprover.t -> config
(** [set_provers config provers] replace all the family prover by the
one given *)
val is_prover_known : config -> prover -> bool
(** test if a prover is detected *)
val prover_by_id : config -> string -> config_prover
(** {2 For accesing other parts of the configuration } *)
(** Access to the Rc.t *)
val get_section : config -> string -> Rc.section option
(** [get_section config name] Same as {!Rc.get_section} except name
......
src/ide/gmain.ml
View file @ ac98a7a4
......@@ -31,6 +31,7 @@ open Whyconf
open Gconfig
open Util
open Debug
module C = Whyconf
let debug = register_flag "gui"
......@@ -133,20 +134,20 @@ let source_text fname =
(* loading WhyIDE configuration *)
(********************************)
let loadpath = (Whyconf.loadpath (get_main ())) @ List.rev !includes
let loadpath = (C.loadpath (get_main ())) @ List.rev !includes
let gconfig =
let c = Gconfig.config () in
c.env <- Env.create_env loadpath;
(*
let provers = Whyconf.get_provers c.Gconfig.config in
let provers = C.get_provers c.Gconfig.config in
c.provers <-
Util.Mstr.fold (Session.get_prover_data c.env) provers Util.Mstr.empty;
*)
c
let () =
Whyconf.load_plugins (get_main ())
C.load_plugins (get_main ())
let () =
Debug.Opt.set_flags_selected ();
......@@ -544,7 +545,7 @@ let init =
| S.File f -> Filename.basename f.S.file_name
| S.Proof_attempt a ->
let p = a.S.proof_prover in
p.Session.prover_name ^ " " ^ p.Session.prover_version
p.C.prover_name ^ " " ^ p.C.prover_version
| S.Transf tr -> tr.S.transf_name);
notify any
......@@ -612,7 +613,7 @@ let info_window ?(callback=(fun () -> ())) mt s =
(* check if provers are present *)
let () =
if Util.Mstr.is_empty (Whyconf.get_provers gconfig.Gconfig.config) then
if C.Mprover.is_empty (C.get_provers gconfig.Gconfig.config) then
begin
info_window `ERROR
"No prover configured.\nPlease run 'why3config --detect-provers' first"
......@@ -989,16 +990,16 @@ let () = add_refresh_provers (fun () ->
let () =
let add_item_provers () =
S.Sprover.iter
(fun p ->
let n = p.S.prover_name ^ " " ^ p.S.prover_version in
C.Mprover.iter
(fun p _ ->
let n = p.C.prover_name ^ " " ^ p.C.prover_version in
let (_ : GMenu.image_menu_item) =
tools_factory#add_image_item ~label:n
~callback:(fun () -> prover_on_selected_goals p)
()
in
let b = GButton.button ~packing:provers_box#add ~label:n () in
b#misc#set_tooltip_markup ("Start <tt>" ^ p.S.prover_name ^
b#misc#set_tooltip_markup ("Start <tt>" ^ p.C.prover_name ^
"</tt> on the <b>selected goals</b>");
(* prend de la place pour rien
......@@ -1009,7 +1010,7 @@ let () =
b#connect#pressed
~callback:(fun () -> prover_on_selected_goals p)
in ())
(S.get_known_provers !env_session)
(C.get_provers gconfig.Gconfig.config)
in
add_refresh_provers add_item_provers "Add in tools menu and provers box";
add_item_provers ()
......
src/ide/html_session.ml
View file @ ac98a7a4
......@@ -19,6 +19,7 @@
open Format
open Why3
module C = Whyconf
let files = Queue.create ()
let opt_version = ref false
......@@ -152,7 +153,7 @@ let run_file (context : context) print_session f =
module Simple =
struct
let print_prover fmt pd = fprintf fmt "%s" pd.prover_name
let print_prover fmt pd = fprintf fmt "%s" pd.C.prover_name
let print_proof_status fmt = function
| Undone _ -> fprintf fmt "Undone"
......@@ -222,7 +223,7 @@ struct
then fprintf fmt "class='verified'"
else fprintf fmt "class='notverified'"
let print_prover fmt pd = fprintf fmt "%s" pd.prover_name
let print_prover fmt pd = fprintf fmt "%s" pd.C.prover_name
let print_proof_status fmt = function
| Undone _ -> fprintf fmt "<span class='notverified'>Undone</span>"
......
src/ide/replay.ml
View file @ ac98a7a4
......@@ -21,6 +21,7 @@
open Format
open Why3
module S = Session
module C = Whyconf
let includes = ref []
let file = ref None
......@@ -183,7 +184,7 @@ let init =
| S.File f -> Filename.basename f.S.file_name
| S.Proof_attempt a ->
let p = a.S.proof_prover in
p.S.prover_name ^ " " ^ p.S.prover_version
p.C.prover_name ^ " " ^ p.C.prover_version
| S.Transf tr -> tr.S.transf_name
in
(* eprintf "Item '%s' loaded@." name *)
......@@ -339,7 +340,7 @@ let rec provers_latex_stats provers theory =
S.theory_iter_proof_attempt (fun a ->
Hashtbl.replace provers a.S.proof_prover a.S.proof_prover) theory
let prover_name a = a.S.prover_name ^ " " ^ a.S.prover_version
let prover_name a = a.C.prover_name ^ " " ^ a.C.prover_version
let protect s =
let b = Buffer.create 7 in
......@@ -498,7 +499,7 @@ let print_head n depth provers fmt =
(depth + 1)
else
fprintf fmt "\\hline Proof obligations ";
List.iter (fun a -> fprintf fmt "& \\provername{%s} " a.S.prover_name)
List.iter (fun a -> fprintf fmt "& \\provername{%s} " a.C.prover_name)
provers;
fprintf fmt "\\\\ @."
......@@ -549,7 +550,7 @@ let theory_latex_stat n table dir t =
let provers = Hashtbl.fold (fun _ pr acc -> pr :: acc)
provers [] in
let provers =
List.sort (fun p1 p2 -> String.compare p1.S.prover_name p2.S.prover_name)
List.sort (fun p1 p2 -> String.compare p1.C.prover_name p2.C.prover_name)
provers in
let depth = theory_depth t in
let name = t.S.theory_name.Ident.id_string in
......@@ -571,7 +572,7 @@ let print_latex_statistics n table dir session =
S.PHstr.iter (fun _ f -> file_latex_stat n table dir f) files
let print_report (g,p,r) =
printf " goal '%s', prover '%a': " g.Ident.id_string S.print_prover p;
printf " goal '%s', prover '%a': " g.Ident.id_string C.print_prover p;
match r with
| M.Result(new_res,old_res) ->
(* begin match !opt_smoke with *)
......
src/ide/stats.ml
View file @ ac98a7a4
......@@ -16,6 +16,7 @@
open Format
open Why3
open Util
module C = Whyconf
open Session
......@@ -142,7 +143,7 @@ let rec stats_of_goal prefix_name stats goal =
begin
match result.Call_provers.pr_answer with
| Call_provers.Valid ->
(prover.prover_name, result.Call_provers.pr_time) :: acc
(prover.C.prover_name, result.Call_provers.pr_time) :: acc
| _ ->
acc
end
......@@ -176,11 +177,11 @@ let stats_of_file stats _ file =
List.iter (stats_of_theory file stats) theories
let fill_prover_data stats session =
Sprover.iter
C.Sprover.iter
(fun prover ->
Hashtbl.add stats.prover_data prover.prover_id
(prover.prover_name ^ " " ^ prover.prover_version))
(get_provers session)
Hashtbl.add stats.prover_data prover.C.prover_id
(prover.C.prover_name ^ " " ^ prover.C.prover_version))
(get_used_provers session)
let extract_stats_from_file stats fname =
let project_dir = get_project_dir fname in
......
src/main.ml
View file @ ac98a7a4
......@@ -257,8 +257,9 @@ let () = try
if !opt_list_provers then begin
opt_list := true;
let config = read_config !opt_config in
let print fmt s prover = fprintf fmt "%s (%s)@\n" s prover.name in
let print fmt m = Mstr.iter (print fmt) m in
let print fmt prover _ = fprintf fmt "%s (%s)@\n"
prover.prover_id prover.prover_name 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
end;
......@@ -319,12 +320,9 @@ let () = try
if !opt_memlimit = None then opt_memlimit := Some (Whyconf.memlimit main);
begin match !opt_prover with
| Some s ->
let prover = try Mstr.find s (get_provers config) with
| Not_found -> eprintf "Prover '%s' not found in %s@."
s (Whyconf.get_conf_file config); exit 1
in
opt_command := Some prover.command;
opt_driver := Some prover.driver
let prover = Whyconf.prover_by_id config s in
opt_command := Some prover.command;
opt_driver := Some prover.driver
| None ->
()
end;
......
src/session/session.ml
View file @ ac98a7a4
......@@ -20,49 +20,17 @@
open Stdlib
open Debug
module Mprover = Whyconf.Mprover
module Sprover = Whyconf.Sprover
module PHprover = Whyconf.Hprover
module C = Whyconf
let debug = Debug.register_flag "session"
(** {2 Type definitions} *)
module PHstr = Util.Hstr
type prover =
{ prover_id : string;
prover_name : string;
prover_version : string;
}
let print_prover fmt p =
Format.fprintf fmt "%s(%s)" p.prover_name p.prover_version
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
c
let equal s1 s2 =
s1.prover_id = s2.prover_id &&
s1.prover_name = s2.prover_name &&
s1.prover_version = s2.prover_version
let hash s1 =
2 * Hashtbl.hash s1.prover_id +
3 * Hashtbl.hash s1.prover_name +
5 * Hashtbl.hash s1.prover_version
end
module Mprover = Map.Make(Prover)
module Sprover = Mprover.Set
module PHprover = Hashtbl.Make(Prover)
type undone_proof =
| Scheduled (** external proof attempt is scheduled *)
| Interrupted
......@@ -92,7 +60,7 @@ type 'a goal =
and 'a proof_attempt =
{ proof_key : 'a;
proof_prover : prover;
proof_prover : Whyconf.prover;
proof_parent : 'a goal;
mutable proof_state : proof_attempt_status;
mutable proof_timelimit : int;
......@@ -143,7 +111,7 @@ type loaded_prover =
{ prover_config : Whyconf.config_prover;
prover_driver : Driver.driver}
type loaded_provers = loaded_prover option PHstr.t
type loaded_provers = loaded_prover option PHprover.t
type 'a env_session =
{ env : Env.env;
......@@ -203,7 +171,8 @@ let iter_transf f t =
List.iter (fun g -> f g) t.transf_goals
let goal_iter f g =
PHprover.iter (fun _ a -> f (Proof_attempt a)) g.goal_external_proofs;
PHprover.iter
(fun _ a -> f (Proof_attempt a)) g.goal_external_proofs;
PHstr.iter (fun _ t -> f (Transf t)) g.goal_transformations
let transf_iter f t =
......@@ -239,7 +208,8 @@ module PTreeT = struct
if g.goal_task = None
then g.goal_name.Ident.id_string^"*"
else g.goal_name.Ident.id_string
| Proof_attempt pr -> Pp.string_of_wnl print_prover pr.proof_prover
| Proof_attempt pr ->
Pp.string_of_wnl Whyconf.print_prover pr.proof_prover
| Transf tr -> tr.transf_name in
let l = ref [] in
iter (fun a -> l := (Any a)::!l) t;
......@@ -279,7 +249,7 @@ let load_env_session ?(includes=[]) session conf_path_opt =
{ session = session;
env = env;
whyconf = config;
loaded_provers = PHstr.create 5;
loaded_provers = PHprover.create 5;
}
(************************)
......@@ -299,7 +269,7 @@ and get_session_trans transf = get_session_goal transf.transf_parent
let get_session_proof_attempt pa = get_session_goal pa.proof_parent
let get_provers session =
let get_used_provers session =
let sprover = ref Sprover.empty in
session_iter_proof_attempt
(fun pa -> sprover := Sprover.add pa.proof_prover !sprover)
......@@ -407,7 +377,7 @@ let save_file provers fmt _ f =
let save_prover fmt p (provers,id) =
fprintf fmt "@\n@[<v 1><prover@ id=\"%i\"@ prover_id=\"%s\" \
name=\"%s\"@ version=\"%s\"/>@]"
id p.prover_id p.prover_name p.prover_version;
id p.C.prover_id p.C.prover_name p.