From 9d4e5566302f2b01b2dedff03f26101c384d4c10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= <francois@bobot.eu> Date: Wed, 2 Nov 2011 17:43:45 +0100 Subject: [PATCH] session_ro : Fix provers handling - add the provers list which can be found in the session. - remove Detected/Undetected since we use only the information provided by the session, not which provers are currently available on the current computer. --- src/ide/html_session.ml | 12 ++++------- src/ide/session.ml | 7 ++++-- src/ide/session.mli | 4 ++++ src/ide/session_ro.ml | 48 +++++++++++++++++++++++++++-------------- src/ide/session_ro.mli | 17 ++++++++------- src/ide/stats.ml | 15 ++++++------- 6 files changed, 61 insertions(+), 42 deletions(-) diff --git a/src/ide/html_session.ml b/src/ide/html_session.ml index 672577f0c1..3adf2275a6 100644 --- a/src/ide/html_session.ml +++ b/src/ide/html_session.ml @@ -154,9 +154,7 @@ let run_file (context : context) print_session f = module Simple = struct - let print_prover fmt = function - | Detected_prover pd -> fprintf fmt "%s" pd.prover_name - | Undetected_prover s -> fprintf fmt "%s" s + let print_prover fmt pd = fprintf fmt "%s" pd.prover_name let print_proof_status fmt = function | Undone -> fprintf fmt "Undone" @@ -196,7 +194,7 @@ struct let print_session _name fmt s = fprintf fmt "<ul>%a</ul>" - (Pp.print_list Pp.newline print_file) s + (Pp.print_list Pp.newline print_file) s.files let context : context = "<!DOCTYPE html @@ -225,9 +223,7 @@ struct then fprintf fmt "class='verified'" else fprintf fmt "class='notverified'" - let print_prover fmt = function - | Detected_prover pd -> fprintf fmt "%s" pd.prover_name - | Undetected_prover s -> fprintf fmt "%s" s + let print_prover fmt pd = fprintf fmt "%s" pd.prover_name let print_proof_status fmt = function | Undone -> fprintf fmt "<span class='notverified'>Undone</span>" @@ -325,7 +321,7 @@ onclick=\"showedited('%s'); return false;\">%a : %a</a></li>@]" let print_session_aux name fmt s = fprintf fmt "@[<hov><ul><a href='#'>%s</a>@,%a</ul>@]" name - (Pp.print_list Pp.newline print_file) s + (Pp.print_list Pp.newline print_file) s.files let print_session name fmt s = diff --git a/src/ide/session.ml b/src/ide/session.ml index 59095b9861..0dcbab64e4 100644 --- a/src/ide/session.ml +++ b/src/ide/session.ml @@ -1487,13 +1487,16 @@ available on this computer@." eprintf "[Warning] Session.load_file: unexpected element '%s'@." s; old_provers +let old_provers = ref Util.Mstr.empty +let get_old_provers () = !old_provers + let load_session ~env xml = let cont = xml.Xml.content in match cont.Xml.name with | "why3session" -> - let _old_provers = + (** just to keep the old_provers somewhere *) + old_provers := List.fold_left (load_file ~env) Util.Mstr.empty cont.Xml.elements - in () | s -> eprintf "[Warning] Session.load_session: unexpected element '%s'@." s diff --git a/src/ide/session.mli b/src/ide/session.mli index a839fb8ee5..5414a7ea9a 100644 --- a/src/ide/session.mli +++ b/src/ide/session.mli @@ -210,6 +210,10 @@ module Make(O: OBSERVER) : sig *) val get_provers : unit -> prover_data Util.Mstr.t + (** The provers on this computer *) + + val get_old_provers : unit -> (string * string) Util.Mstr.t + (** The provers in this session (name * version ) *) val maximum_running_proofs : int ref diff --git a/src/ide/session_ro.ml b/src/ide/session_ro.ml index 1c676abb09..2a46b01bb4 100644 --- a/src/ide/session_ro.ml +++ b/src/ide/session_ro.ml @@ -25,7 +25,9 @@ open Util -type session = file list +type session = + { files : file list; + provers : prover_data Mstr.t} and file = { file_name : string; @@ -53,21 +55,17 @@ and transf = and prover_data = { prover_name : string; prover_version : string; - prover_interactive : bool; + (** will be added again when session records it *) + (* prover_interactive : bool; *) } -and prover_option = - | Detected_prover of prover_data - | Undetected_prover of string - - and proof_attempt_status = | Undone | Done of Call_provers.prover_result (** external proof done *) | InternalFailure of exn (** external proof aborted by internal error *) and proof_attempt = - { prover : prover_option; + { prover : prover_data; proof_state : proof_attempt_status; timelimit : int; proof_obsolete : bool; @@ -86,6 +84,16 @@ let read_config ?(includes=[]) conf_path_opt = {env = env; config = config} +let get_provers env = + let provers = Whyconf.get_provers env.config in + let get_prover_data pr = + { prover_name = pr.Whyconf.name; + prover_version = pr.Whyconf.version; + (* prover_interactive = pr.Whyconf.interactive; *) + } + in + Mstr.map get_prover_data provers + module Observer_dumb : Session.OBSERVER = struct type key = unit @@ -103,13 +111,16 @@ module Read_project (O : Session.OBSERVER) struct module M = Session.Make(Observer_dumb) - let read_prover_option = function - | M.Detected_prover pd -> Detected_prover - { prover_name = pd.Session.prover_name; - prover_version = pd.Session.prover_version; - prover_interactive = pd.Session.interactive; - } - | M.Undetected_prover s -> Undetected_prover s + let old_provers = ref Mstr.empty + + let get_prover_by_id pid = + try Mstr.find pid !old_provers + with Not_found -> assert false (** the provers must be an old_provers *) + + let read_prover_option po = + get_prover_by_id (match po with + | M.Detected_prover pd -> pd.Session.prover_id + | M.Undetected_prover s -> s) let read_attempt_status = function | Session.Undone | Session.Scheduled | Session.Interrupted @@ -167,7 +178,12 @@ struct let _found_obs = M.open_session ~allow_obsolete ~env:env.env ~config:env.config ~init ~notify P.project_dir in - List.map read_file (M.get_all_files ()) + let prover_data (name,version) = + { prover_name = name; prover_version = version} in + let op = Mstr.map prover_data (M.get_old_provers ()) in + old_provers := op; + {files = List.map read_file (M.get_all_files ()); + provers = op} end diff --git a/src/ide/session_ro.mli b/src/ide/session_ro.mli index dd9355036e..d7185f3e4d 100644 --- a/src/ide/session_ro.mli +++ b/src/ide/session_ro.mli @@ -23,7 +23,9 @@ open Why3 open Util -type session = file list +type session = + { files : file list; + provers : prover_data Mstr.t} and file = private { file_name : string; @@ -51,21 +53,17 @@ and transf = private and prover_data = private { prover_name : string; prover_version : string; - prover_interactive : bool; + (** will be added again when session records it *) + (* prover_interactive : bool; *) } -and prover_option = private - | Detected_prover of prover_data - | Undetected_prover of string - - and proof_attempt_status = private | Undone | Done of Call_provers.prover_result (** external proof done *) | InternalFailure of exn (** external proof aborted by internal error *) and proof_attempt = private - { prover : prover_option; + { prover : prover_data; proof_state : proof_attempt_status; timelimit : int; proof_obsolete : bool; @@ -82,6 +80,9 @@ val read_config : ?includes:string list -> string option -> env [conf_path] or use the default location if [conf_path] is [None]. Add the directory in [includes] in the loadpath *) +val get_provers : env -> prover_data Util.Mstr.t +(** Get the provers on this computer *) + val read_project_dir : allow_obsolete:bool -> env:env -> string -> session diff --git a/src/ide/stats.ml b/src/ide/stats.ml index 5e270cc214..fda17e767a 100644 --- a/src/ide/stats.ml +++ b/src/ide/stats.ml @@ -170,20 +170,19 @@ let stats_of_file stats file = let theories = file.theories in List.iter (stats_of_theory file stats) theories -let fill_prover_data stats = - let provers = Mstr.empty (* FIXME get_provers ()*) in +let fill_prover_data stats session = Mstr.iter (fun prover data -> Hashtbl.add stats.prover_data prover - (data.Session.prover_name ^ " " ^ data.Session.prover_version)) - provers + (data.prover_name ^ " " ^ data.prover_version)) + session.provers let extract_stats_from_file stats fname = let project_dir = get_project_dir fname in try - let file_list = read_project_dir ~allow_obsolete ~env project_dir in - fill_prover_data stats; - List.iter (stats_of_file stats) file_list + let session = read_project_dir ~allow_obsolete ~env project_dir in + fill_prover_data stats session; + List.iter (stats_of_file stats) session.files with e when not (Debug.test_flag Debug.stack_trace) -> eprintf "Error while opening session with database '%s' : %a@." project_dir Exn_printer.exn_printer e; @@ -198,7 +197,7 @@ let finalize_stats stats = stats.prover_avg_time let print_stats stats = - printf "== Provers used ==@\n @["; + printf "== Provers available ==@\n @["; Hashtbl.iter (fun prover data -> printf "%-10s: %s@\n" prover data) stats.prover_data; printf "@]@\n"; -- GitLab