Commit f6b5f40b authored by Francois Bobot's avatar Francois Bobot

refactorisation of rc, whyconf, gconfig

parent 395e8644
...@@ -41,10 +41,12 @@ let debug = ...@@ -41,10 +41,12 @@ let debug =
with Not_found -> false with Not_found -> false
let config = Whyconf.read_config None let config = Whyconf.read_config None
let main = Whyconf.get_main config
let cprovers = Whyconf.get_provers config
let timelimit = config.main.timelimit let timelimit = main.timelimit
let env = Env.create_env (Lexer.retrieve config.main.loadpath) let env = Env.create_env (Lexer.retrieve main.loadpath)
let provers = Hashtbl.create 17 let provers = Hashtbl.create 17
...@@ -52,7 +54,7 @@ let get_prover s = ...@@ -52,7 +54,7 @@ let get_prover s =
try try
Hashtbl.find provers s Hashtbl.find provers s
with Not_found -> with Not_found ->
let cp = Util.Mstr.find s config.provers in let cp = Util.Mstr.find s cprovers in
let drv = Driver.load_driver env cp.driver in let drv = Driver.load_driver env cp.driver in
Hashtbl.add provers s (cp, drv); Hashtbl.add provers s (cp, drv);
cp, drv cp, drv
......
This diff is collapsed.
...@@ -41,20 +41,9 @@ type main = { ...@@ -41,20 +41,9 @@ type main = {
(* max number of running prover processes *) (* max number of running prover processes *)
} }
type ide = {
window_width : int;
window_height : int;
tree_width : int;
task_height : int;
verbose : int;
default_editor : string;
}
type config = { type config = {
conf_file : string; (* "/home/innocent_user/.why.conf" *) conf_file : string; (* "/home/innocent_user/.why.conf" *)
provers : config_prover Mstr.t; (* indexed by short identifiers *) config : Rc.t;
main : main;
ide : ide;
} }
val default_config : config val default_config : config
...@@ -66,5 +55,12 @@ val read_config : string option -> config ...@@ -66,5 +55,12 @@ val read_config : string option -> config
val save_config : config -> unit val save_config : config -> unit
val get_main : config -> main
val get_provers : config -> config_prover Mstr.t
val set_main : config -> main -> config
val set_provers : config -> config_prover Mstr.t -> config
(** Replace the provers by autodetected one *) (** Replace the provers by autodetected one *)
val run_auto_detection : config -> config val run_auto_detection : unit -> config_prover Mstr.t
...@@ -3,6 +3,7 @@ open Format ...@@ -3,6 +3,7 @@ open Format
open Why open Why
open Util open Util
open Whyconf open Whyconf
open Rc
type prover_data = type prover_data =
{ prover_id : string; { prover_id : string;
...@@ -29,20 +30,40 @@ type t = ...@@ -29,20 +30,40 @@ type t =
mutable config : Whyconf.config; mutable config : Whyconf.config;
} }
let load_main c (key, value) =
match key with
| "width" -> c.window_width <- Rc.int value
| "height" -> c.window_height <- Rc.int value
| "tree_width" -> c.tree_width <- Rc.int value
| "task_height" -> c.task_height <- Rc.int value
| "time_limit" -> c.time_limit <- Rc.int value
| "verbose" -> c.verbose <- Rc.int value
| "max_processes" -> c.max_running_processes <- Rc.int value
| "default_editor" -> c.default_editor <- Rc.string value
| s ->
eprintf "Warning: ignore unknown key [%s] in whyide config file@." s
type ide = {
ide_window_width : int;
ide_window_height : int;
ide_tree_width : int;
ide_task_height : int;
ide_verbose : int;
ide_default_editor : string;
}
let default_ide =
{ ide_window_width = 1024;
ide_window_height = 768;
ide_tree_width = 512;
ide_task_height = 384;
ide_verbose = 0;
ide_default_editor = "";
}
let load_ide section =
{ ide_window_width =
get_int section ~default:default_ide.ide_window_width "window_width";
ide_window_height =
get_int section ~default:default_ide.ide_window_height "window_height";
ide_tree_width =
get_int section ~default:default_ide.ide_tree_width "tree_width";
ide_task_height =
get_int section ~default:default_ide.ide_task_height "task_height";
ide_verbose =
get_int section ~default:default_ide.ide_verbose "verbose";
ide_default_editor =
get_string section ~default:default_ide.ide_default_editor
"default_editor";
}
let get_prover_data env id pr acc = let get_prover_data env id pr acc =
try try
...@@ -61,17 +82,22 @@ let get_prover_data env id pr acc = ...@@ -61,17 +82,22 @@ let get_prover_data env id pr acc =
acc acc
let load_config config = let load_config config =
let env = Env.create_env (Lexer.retrieve config.main.loadpath) in let main = get_main config in
{ window_height = config.ide.Whyconf.window_height; let ide = match get_section config.Whyconf.config "ide" with
window_width = config.ide.Whyconf.window_width; | None -> default_ide
tree_width = config.ide.Whyconf.tree_width; | Some s -> load_ide s in
task_height = config.ide.Whyconf.task_height; let provers = get_provers config in
time_limit = config.main.Whyconf.timelimit; let env = Env.create_env (Lexer.retrieve main.loadpath) in
mem_limit = config.main.Whyconf.memlimit; { window_height = ide.ide_window_height;
verbose = config.ide.Whyconf.verbose; window_width = ide.ide_window_width;
max_running_processes = config.main.Whyconf.running_provers_max; tree_width = ide.ide_tree_width;
provers = Mstr.fold (get_prover_data env) config.Whyconf.provers []; task_height = ide.ide_task_height;
default_editor = config.ide.Whyconf.default_editor; time_limit = main.Whyconf.timelimit;
mem_limit = main.Whyconf.memlimit;
verbose = ide.ide_verbose;
max_running_processes = main.Whyconf.running_provers_max;
provers = Mstr.fold (get_prover_data env) provers [];
default_editor = ide.ide_default_editor;
config = config; config = config;
env = env env = env
} }
...@@ -92,24 +118,23 @@ let save_config t = ...@@ -92,24 +118,23 @@ let save_config t =
editor = pr.editor; editor = pr.editor;
} acc in } acc in
let config = t.config in let config = t.config in
let main = { config.main with let config = set_main config
Whyconf.timelimit = t.time_limit; { (get_main config) with
memlimit = t.mem_limit; timelimit = t.time_limit;
running_provers_max = t.max_running_processes; memlimit = t.mem_limit;
} in running_provers_max = t.max_running_processes;
let ide = { } in
Whyconf.window_height = t.window_height; let ide = empty_section in
window_width = t.window_width; let ide = set_int ide "window_height" t.window_height in
tree_width = t.tree_width; let ide = set_int ide "window_width" t.window_width in
task_height = t.task_height; let ide = set_int ide "tree_width" t.tree_width in
verbose = t.verbose; let ide = set_int ide "task_height" t.task_height in
default_editor = t.default_editor; let ide = set_int ide "verbose" t.verbose in
} in let ide = set_string ide "default_editor" t.default_editor in
let config = {config with let rc = set_section config.Whyconf.config "ide" ide in
Whyconf.provers = List.fold_left save_prover Mstr.empty t.provers; let config = {config with Whyconf.config = rc} in
main = main; let config = set_provers config
ide = ide; (List.fold_left save_prover Mstr.empty t.provers) in
} in
save_config config save_config config
(* (*
...@@ -287,19 +312,8 @@ let preferences c = ...@@ -287,19 +312,8 @@ let preferences c =
dialog#destroy () dialog#destroy ()
let run_auto_detection gconfig = let run_auto_detection gconfig =
let config2 = run_auto_detection gconfig.config in let provers = run_auto_detection () in
let gconfig2 = load_config config2 in gconfig.provers <- Mstr.fold (get_prover_data gconfig.env) provers [];
gconfig.window_width <- gconfig2.window_width;
gconfig.window_height <- gconfig2.window_height;
gconfig.tree_width <- gconfig2.tree_width;
gconfig.task_height <- gconfig2.task_height;
gconfig.time_limit <- gconfig2.time_limit;
gconfig.mem_limit <- gconfig2.mem_limit;
gconfig.verbose <- gconfig2.verbose;
gconfig.max_running_processes <- gconfig2.max_running_processes;
gconfig.provers <- gconfig2.provers;
gconfig.default_editor <- gconfig2.default_editor;
gconfig.config <- gconfig2.config
(* (*
Local Variables: Local Variables:
......
...@@ -224,7 +224,8 @@ let () = ...@@ -224,7 +224,8 @@ let () =
let config = read_config !opt_config in let config = read_config !opt_config in
let print fmt s prover = fprintf fmt "%s (%s)@\n" s prover.name 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 m = Mstr.iter (print fmt) m in
printf "@[<hov 2>Known provers:@\n%a@]@." print config.provers let provers = get_provers config in
printf "@[<hov 2>Known provers:@\n%a@]@." print provers
end; end;
if !opt_list_metas then begin if !opt_list_metas then begin
opt_list := true; opt_list := true;
...@@ -291,12 +292,13 @@ let () = ...@@ -291,12 +292,13 @@ let () =
default_config default_config
in in
opt_loadpath := List.rev_append !opt_loadpath config.main.loadpath; let main = get_main config in
if !opt_timelimit = None then opt_timelimit := Some config.main.timelimit; opt_loadpath := List.rev_append !opt_loadpath main.loadpath;
if !opt_memlimit = None then opt_memlimit := Some config.main.memlimit; if !opt_timelimit = None then opt_timelimit := Some main.timelimit;
if !opt_memlimit = None then opt_memlimit := Some main.memlimit;
begin match !opt_prover with begin match !opt_prover with
| Some s -> | Some s ->
let prover = try Mstr.find s config.provers with let prover = try Mstr.find s (get_provers config) with
| Not_found -> eprintf "Driver %s not found.@." s; exit 1 | Not_found -> eprintf "Driver %s not found.@." s; exit 1
in in
opt_command := Some prover.command; opt_command := Some prover.command;
......
...@@ -58,13 +58,22 @@ let print_iter1 iter sep print fmt l = ...@@ -58,13 +58,22 @@ let print_iter1 iter sep print fmt l =
let print_iter2 iter sep1 sep2 print1 print2 fmt l = let print_iter2 iter sep1 sep2 print1 print2 fmt l =
let first = ref true in let first = ref true in
iter (fun x y -> iter (fun x y ->
if !first if !first
then first := false then first := false
else sep1 fmt (); else sep1 fmt ();
print1 fmt x;sep2 fmt (); print2 fmt y) l print1 fmt x;sep2 fmt (); print2 fmt y) l
let print_iter22 iter sep print fmt l =
let first = ref true in
iter (fun x y ->
if !first
then first := false
else sep fmt ();
print fmt x y) l
let print_pair_delim start sep stop pr1 pr2 fmt (a,b) = let print_pair_delim start sep stop pr1 pr2 fmt (a,b) =
fprintf fmt "%a%a%a%a%a" start () pr1 a sep () pr2 b stop () fprintf fmt "%a%a%a%a%a" start () pr1 a sep () pr2 b stop ()
......
...@@ -55,13 +55,28 @@ val print_iter1 : ...@@ -55,13 +55,28 @@ val print_iter1 :
(Format.formatter -> 'a -> unit) -> (Format.formatter -> 'a -> unit) ->
Format.formatter -> 'b -> unit Format.formatter -> 'b -> unit
val print_iter2: val print_iter2:
(('a -> 'b -> unit) -> 'c -> unit) -> (('a -> 'b -> unit) -> 'c -> unit) ->
(Format.formatter -> unit -> unit) -> (Format.formatter -> unit -> unit) ->
(Format.formatter -> unit -> unit) -> (Format.formatter -> unit -> unit) ->
(Format.formatter -> 'a -> unit) -> (Format.formatter -> 'a -> unit) ->
(Format.formatter -> 'b -> unit) -> (Format.formatter -> 'b -> unit) ->
Format.formatter -> 'c -> unit
(** [print_iter2 iter sep1 sep2 print1 print2 fmt t]
iter iterator on [t : 'c]
print1 k sep2 () print2 v sep1 () print1 sep2 () ...
*)
val print_iter22:
(('a -> 'b -> unit) -> 'c -> unit) ->
(Format.formatter -> unit -> unit) ->
(Format.formatter -> 'a -> 'b -> unit) ->
Format.formatter -> 'c -> unit Format.formatter -> 'c -> unit
(** [print_iter22 iter sep print fmt t]
iter iterator on [t : 'c]
print k v sep () print k v sep () ...
*)
val space : formatter -> unit -> unit val space : formatter -> unit -> unit
val alt : formatter -> unit -> unit val alt : formatter -> unit -> unit
......
...@@ -18,31 +18,117 @@ ...@@ -18,31 +18,117 @@
(**************************************************************************) (**************************************************************************)
(** Parse rc files *) (** Parse rc files *)
type rc_value = exception Bad_value_type of string * string * string
| RCint of int (** key * expected * found *)
| RCbool of bool exception Key_not_found of string
| RCfloat of float (** key *)
| RCstring of string exception Multiple_value of string
| RCident of string (** key *)
exception Yet_defined_key of string
(** key *)
exception Multiple_section of string
exception Section_b_family of string
exception Family_two_many_args of string
exception Not_exhaustive of string
exception Yet_defined_section of string
(** key *)
type t = (string list * (string * rc_value) list) list
val int : rc_value -> int type t
(** raise Failure "Rc.int" if not a int value *) type section
type family = (string * section) list
val bool : rc_value -> bool val empty : t
(** raise Failure "Rc.bool" if not a int value *) val empty_section : section
val string : rc_value -> string val get_section : t -> string -> section option
(** raise Failure "Rc.string" if not a string or an ident value *) (** return None if the section is not in the rc file *)
val get_family : t -> string -> family
val set_section : t -> string -> section -> t
val set_family : t -> string -> family -> t
val get_int : ?default:int -> section -> string -> int
(** raise Bad_value_type
raise Key_not_found
raise Multiple_value
*)
val get_intl : ?default:int list -> section -> string -> int list
(** raise Bad_value_type
raise Key_not_found *)
val set_int : section -> string -> int -> section
(** raise Yet_defined_key *)
val set_intl : section -> string -> int list -> section
(** raise Yet_defined_key *)
val get_bool : ?default:bool -> section -> string -> bool
(** raise Bad_value_type
raise Key_not_found
raise Multiple_value
*)
val get_booll : ?default:bool list -> section -> string -> bool list
(** raise Bad_value_type
raise Key_not_found *)
val set_bool : section -> string -> bool -> section
(** raise Yet_defined_key *)
val set_booll : section -> string -> bool list -> section
(** raise Yet_defined_key *)
val get_string : ?default:string -> section -> string -> string
(** raise Bad_value_type
raise Key_not_found
raise Multiple_value
*)
val get_stringl : ?default:string list -> section -> string -> string list
(** raise Bad_value_type
raise Key_not_found *)
val set_string : section -> string -> string -> section
(** raise Yet_defined_key *)
val set_stringl : section -> string -> string list -> section
(** raise Yet_defined_key *)
(* val ident : ?default:string -> section -> string -> string *)
(* (\** raise Bad_value_type *)
(* raise Key_not_found *)
(* raise Multiple_value *)
(* *\) *)
(* val identl : ?default:string list -> section -> string -> string list *)
(* (\** raise Bad_value_type *)
(* raise Key_not_found *\) *)
(* val set_ident : section -> string -> string -> section *)
(* (\** raise Yet_defined_key *)
(* raise Bad_value_type *)
(* *\) *)
(* val set_identl : section -> string -> string list -> section *)
(* (\** raise Yet_defined_key *)
(* raise Bad_value_type *)
(* *\) *)
val check_exhaustive : section -> Util.Sstr.t -> unit
(** raise Not_exhaustive of string *)
val from_file : string -> t val from_file : string -> t
(** returns the records of the file [f] (** returns the records of the file [f]
@raise Not_found is f does not exists @raise Not_found is f does not exists
@raise Failure "lexing" in case of incorrect syntax *) @raise Failure "lexing" in case of incorrect syntax *)
val to_file : string -> t -> unit val to_file : string -> t -> unit
(** save the records in the filr [f] *) (** [to_file f t] save the records [t] in the file [f] *)
val get_home_dir : unit -> string val get_home_dir : unit -> string
(** returns the home dir of the user *) (** returns the home dir of the user *)
......
...@@ -20,6 +20,7 @@ ...@@ -20,6 +20,7 @@
{ {
open Lexing open Lexing
open Util
let get_home_dir () = let get_home_dir () =
try Sys.getenv "HOME" try Sys.getenv "HOME"
...@@ -28,6 +29,19 @@ ...@@ -28,6 +29,19 @@
try Sys.getenv "USERPROFILE" try Sys.getenv "USERPROFILE"
with Not_found -> "" with Not_found -> ""
exception Bad_value_type of string * string * string
(** key * expected * found *)
exception Key_not_found of string
(** key *)
exception Multiple_value of string
(** key *)
exception Multiple_section of string
exception Section_b_family of string
exception Family_two_many_args of string
exception Not_exhaustive of string
exception Yet_defined_section of string
exception Yet_defined_key of string
type rc_value = type rc_value =
| RCint of int | RCint of int
| RCbool of bool | RCbool of bool
...@@ -35,20 +49,122 @@ type rc_value = ...@@ -35,20 +49,122 @@ type rc_value =
| RCstring of string | RCstring of string
| RCident of string | RCident of string
type t = (string list * (string * rc_value) list) list type section = rc_value list Mstr.t
type family = (string * section) list
type ofamily = (string option * section) list
type t = ofamily Mstr.t
let empty = Mstr.empty
let empty_section = Mstr.empty
let make_t tl =
let add_key acc (key,value) =
let l = try Mstr.find key acc with Not_found -> [] in
Mstr.add key (value::l) acc in
let add_section t (args,sectionl) =
let sname,arg = match args with
| [] -> assert false
| [sname] -> sname,None
| [sname;arg] -> sname,Some arg
| sname::_ -> raise (Family_two_many_args sname) in
let m = List.fold_left add_key empty_section sectionl in
let m = Mstr.map List.rev m in
let l = try Mstr.find sname t with Not_found -> [] in
Mstr.add sname ((arg,m)::l) t in
List.fold_left add_section empty tl
let get_section t sname =
try
let l = Mstr.find sname t in
match l with
| [None,v] -> Some v
| [Some _,_] -> raise (Section_b_family sname)
| _ -> raise (Multiple_section sname)
with Not_found -> None
let get_family t sname =
try
let l = Mstr.find sname t in
let get (arg,section) =
(match arg with None -> raise (Section_b_family sname) | Some v -> v,
section) in
List.map get l
with Not_found -> []
let set_section t sname section =
Mstr.add sname [None,section] t
let set_family t sname sections =
if sections = [] then Mstr.remove sname t else
let set (arg,section) = (Some arg,section) in
Mstr.add sname (List.map set sections) t
let get_value read ?default section key =
try
let l = Mstr.find key section in
match l with
| [v] -> read v
| _ -> raise (Multiple_value key)
with Not_found ->
match default with
| None -> raise (Key_not_found key)
| Some v -> v
let get_valuel read ?default section key =
try
let l = Mstr.find key section in
List.map read l
with Not_found ->
match default with
| None -> raise (Key_not_found key)
| Some v -> v
let int = function let set_value write section key value =
Mstr.add key [write value] section
let set_valuel write section key valuel =
if valuel = [] then Mstr.remove key section else
Mstr.add key (List.map write valuel) section
let rint = function
| RCint n -> n | RCint n -> n
| _ -> failwith "Rc.int" | _ -> failwith "Rc.int"
let bool = function