Commit 89d56e7e authored by Andrei Paskevich's avatar Andrei Paskevich

Env: organize supported languages in a tree

parent c37f6cd1
...@@ -122,7 +122,7 @@ An arithmetic goal: 2+2 = 4 ...@@ -122,7 +122,7 @@ An arithmetic goal: 2+2 = 4
let two : Term.term = Term.t_const (Number.ConstInt (Number.int_const_dec "2")) let two : Term.term = Term.t_const (Number.ConstInt (Number.int_const_dec "2"))
let four : Term.term = Term.t_const (Number.ConstInt (Number.int_const_dec "4")) let four : Term.term = Term.t_const (Number.ConstInt (Number.int_const_dec "4"))
let int_theory : Theory.theory = let int_theory : Theory.theory =
Env.find_theory env ["int"] "Int" Env.read_theory env ["int"] "Int"
let plus_symbol : Term.lsymbol = let plus_symbol : Term.lsymbol =
Theory.ns_find_ls int_theory.Theory.th_export ["infix +"] Theory.ns_find_ls int_theory.Theory.th_export ["infix +"]
let two_plus_two : Term.term = Term.fs_app plus_symbol [two;two] Ty.ty_int let two_plus_two : Term.term = Term.fs_app plus_symbol [two;two] Ty.ty_int
...@@ -301,13 +301,10 @@ declaration of ...@@ -301,13 +301,10 @@ declaration of
*) *)
(* import the ref.Ref module *) (* import the ref.Ref module *)
let ref_modules, ref_theories = let ref_module : Mlw_module.modul =
Env.read_lib_file (Mlw_main.library_of_env env) ["ref"] Mlw_module.read_module env ["ref"] "Ref"
let ref_module : Mlw_module.modul = Stdlib.Mstr.find "Ref" ref_modules
let ref_type : Mlw_ty.T.itysymbol = let ref_type : Mlw_ty.T.itysymbol =
Mlw_module.ns_find_its ref_module.Mlw_module.mod_export ["ref"] Mlw_module.ns_find_its ref_module.Mlw_module.mod_export ["ref"]
......
...@@ -31,7 +31,7 @@ let provers : Whyconf.config_prover Whyconf.Mprover.t = ...@@ -31,7 +31,7 @@ let provers : Whyconf.config_prover Whyconf.Mprover.t =
let env : Env.env = Env.create_env (Whyconf.loadpath main) let env : Env.env = Env.create_env (Whyconf.loadpath main)
let int_theory : Theory.theory = let int_theory : Theory.theory =
Env.find_theory env ["int"] "Int" Env.read_theory env ["int"] "Int"
let mul_int : Term.lsymbol = let mul_int : Term.lsymbol =
Theory.ns_find_ls int_theory.Theory.th_export ["infix *"] Theory.ns_find_ls int_theory.Theory.th_export ["infix *"]
...@@ -96,10 +96,8 @@ declaration of ...@@ -96,10 +96,8 @@ declaration of
(* import the ref.Ref module *) (* import the ref.Ref module *)
let ref_modules, ref_theories = let ref_module : Mlw_module.modul =
Env.read_lib_file (Mlw_main.library_of_env env) ["ref"] Mlw_module.read_module env ["ref"] "Ref"
let ref_module : Mlw_module.modul = Stdlib.Mstr.find "Ref" ref_modules
let ref_type : Mlw_ty.T.itysymbol = let ref_type : Mlw_ty.T.itysymbol =
Mlw_module.ns_find_its ref_module.Mlw_module.mod_export ["ref"] Mlw_module.ns_find_its ref_module.Mlw_module.mod_export ["ref"]
......
...@@ -31,7 +31,7 @@ let provers : Whyconf.config_prover Whyconf.Mprover.t = ...@@ -31,7 +31,7 @@ let provers : Whyconf.config_prover Whyconf.Mprover.t =
let env : Env.env = Env.create_env (Whyconf.loadpath main) let env : Env.env = Env.create_env (Whyconf.loadpath main)
let int_theory : Theory.theory = let int_theory : Theory.theory =
Env.find_theory env ["int"] "Int" Env.read_theory env ["int"] "Int"
let mul_int : Term.lsymbol = let mul_int : Term.lsymbol =
Theory.ns_find_ls int_theory.Theory.th_export ["infix *"] Theory.ns_find_ls int_theory.Theory.th_export ["infix *"]
...@@ -40,11 +40,9 @@ let unit_type = Ty.ty_tuple [] ...@@ -40,11 +40,9 @@ let unit_type = Ty.ty_tuple []
(* start a parsing *) (* start a parsing *)
let lib = Mlw_main.library_of_env env
let pathname = [] (* dummy pathname *) let pathname = [] (* dummy pathname *)
let t : Ptree.incremental = Mlw_typing.open_file lib pathname let t : Ptree.incremental = Mlw_typing.open_file env pathname
open Ptree open Ptree
......
...@@ -125,22 +125,17 @@ let parse th_uc filename cin = ...@@ -125,22 +125,17 @@ let parse th_uc filename cin =
let th_uc, vars = init_vars th_uc nb_vars in let th_uc, vars = init_vars th_uc nb_vars in
file th_uc vars 0 lexbuf) lb file th_uc vars 0 lexbuf) lb
let parse _env _path filename cin = let parse _env _path filename cin =
let th_uc = Theory.create_theory (Ident.id_fresh "Cnf") in let th_uc = Theory.create_theory (Ident.id_fresh "Cnf") in
let th_uc = parse th_uc filename cin in let th_uc = parse th_uc filename cin in
let pr = Decl.create_prsymbol (Ident.id_fresh "false") in let pr = Decl.create_prsymbol (Ident.id_fresh "false") in
let th_uc = Theory.add_prop_decl th_uc Decl.Pgoal pr Term.t_false in let th_uc = Theory.add_prop_decl th_uc Decl.Pgoal pr Term.t_false in
(), Mstr.singleton "Cnf" (Theory.close_theory th_uc) Mstr.singleton "Cnf" (Theory.close_theory th_uc)
let library_of_env = Env.register_format "Dimacs" ["cnf"] parse let () = Env.register_format "dimacs" ["cnf"] Env.base_language parse
~desc:"@[<hov>Parser for dimacs format.@]" ~desc:"@[<hov>Parser for dimacs format.@]"
} }
(* (*
Local Variables: Local Variables:
compile-command: "unset LANG; make -C ../.." compile-command: "unset LANG; make -C ../.."
......
...@@ -61,7 +61,7 @@ let scanf s = ...@@ -61,7 +61,7 @@ let scanf s =
(** the main function *) (** the main function *)
let read_channel env path filename cin = let read_channel env path filename cin =
(** Find the int theory and the needed operation *) (** Find the int theory and the needed operation *)
let th_int = Env.find_theory (Env.env_of_library env) ["int"] "Int" in let th_int = Env.read_theory env ["int"] "Int" in
let leq = ns_find_ls th_int.th_export ["infix <"] in let leq = ns_find_ls th_int.th_export ["infix <"] in
let plus_symbol = Theory.ns_find_ls th_int.Theory.th_export ["infix +"] in let plus_symbol = Theory.ns_find_ls th_int.Theory.th_export ["infix +"] in
let neg_symbol = Theory.ns_find_ls th_int.Theory.th_export ["prefix -"] in let neg_symbol = Theory.ns_find_ls th_int.Theory.th_export ["prefix -"] in
...@@ -123,9 +123,9 @@ let read_channel env path filename cin = ...@@ -123,9 +123,9 @@ let read_channel env path filename cin =
(** Read all the file *) (** Read all the file *)
let th_uc = Sysutil.fold_channel fold th_uc cin in let th_uc = Sysutil.fold_channel fold th_uc cin in
(** Return the map with the theory *) (** Return the map with the theory *)
(), Mstr.singleton "EquLin" (close_theory th_uc) Mstr.singleton "EquLin" (close_theory th_uc)
let library_of_env = Env.register_format "EquLin" ["equlin"] read_channel let () = Env.register_format "equlin" ["equlin"] Env.base_language read_channel
~desc:"@[<hov>Generate@ random@ linear@ arithmetic@ problems.@ \ ~desc:"@[<hov>Generate@ random@ linear@ arithmetic@ problems.@ \
The@ first@ line@ gives@ the@ seed.@ Each@ other@ line@ \ The@ first@ line@ gives@ the@ seed.@ Each@ other@ line@ \
describes@ a@ goal@ and@ contains@ three@ numbers:@]@\n \ describes@ a@ goal@ and@ contains@ three@ numbers:@]@\n \
......
...@@ -246,9 +246,9 @@ and comment_line = parse ...@@ -246,9 +246,9 @@ and comment_line = parse
let lb = Lexing.from_channel c in let lb = Lexing.from_channel c in
Loc.set_file file lb; Loc.set_file file lb;
let ast = Loc.with_location (tptp_file token) lb in let ast = Loc.with_location (tptp_file token) lb in
(), Tptp_typing.typecheck env path ast Tptp_typing.typecheck env path ast
let _library_of_env = Env.register_format "tptp" ["p";"ax"] read_channel let () = Env.register_format "tptp" ["p";"ax"] Env.base_language read_channel
~desc:"TPTP format (CNF FOF FOFX TFF)" ~desc:"TPTP format (CNF FOF FOFX TFF)"
} }
......
...@@ -82,9 +82,8 @@ type denv = { ...@@ -82,9 +82,8 @@ type denv = {
ts_rat : tysymbol; ts_rat : tysymbol;
} }
let make_denv lib = let make_denv env =
let env = Env.env_of_library lib in let get_theory s = Env.read_theory env ["tptp"] s in
let get_theory = Env.read_theory ~format:"why" env ["tptp"] in
let th_univ = get_theory "Univ" in let th_univ = get_theory "Univ" in
let th_ghost = get_theory "Ghost" in let th_ghost = get_theory "Ghost" in
let th_rat = get_theory "Rat" in let th_rat = get_theory "Rat" in
...@@ -125,7 +124,7 @@ let defined_arith ~loc denv env impl dw tl = ...@@ -125,7 +124,7 @@ let defined_arith ~loc denv env impl dw tl =
| { t_ty = Some {ty_node = Tyapp (ts,[]) }}::_ -> ts | { t_ty = Some {ty_node = Tyapp (ts,[]) }}::_ -> ts
| _::_ -> error ~loc NonNumeric | _::_ -> error ~loc NonNumeric
| [] -> error ~loc BadArity in | [] -> error ~loc BadArity in
let get_theory = Env.read_theory ~format:"why" denv.de_env ["tptp"] in let get_theory s = Env.read_theory denv.de_env ["tptp"] s in
let get_int_theory = function let get_int_theory = function
| DF DFquot -> errorm ~loc "$quotient/2 is not defined on $int" | DF DFquot -> errorm ~loc "$quotient/2 is not defined on $int"
| DF (DFquot_e|DFrem_e) -> get_theory "IntDivE" | DF (DFquot_e|DFrem_e) -> get_theory "IntDivE"
...@@ -667,4 +666,3 @@ let typecheck lib path ast = ...@@ -667,4 +666,3 @@ let typecheck lib path ast =
| [] -> add_prop_decl uc Pgoal pr_false t_false | [] -> add_prop_decl uc Pgoal pr_false t_false
in in
Mstr.singleton "T" (close_theory uc) Mstr.singleton "T" (close_theory uc)
...@@ -9,6 +9,6 @@ ...@@ -9,6 +9,6 @@
(* *) (* *)
(********************************************************************) (********************************************************************)
val typecheck : unit Why3.Env.library -> Why3.Env.pathname -> val typecheck : Why3.Env.env -> Why3.Env.pathname ->
Tptp_ast.tptp_file -> Why3.Theory.theory Why3.Stdlib.Mstr.t Tptp_ast.tptp_file -> Why3.Theory.theory Why3.Stdlib.Mstr.t
...@@ -303,9 +303,9 @@ let print_dep fmt = ...@@ -303,9 +303,9 @@ let print_dep fmt =
(* the task under construction *) (* the task under construction *)
let task = ref None let task = ref None
let th_int = lazy (Env.find_theory env ["int"] "Int") let th_int = lazy (Env.read_theory env ["int"] "Int")
let th_eucl = lazy (Env.find_theory env ["int"] "EuclideanDivision") let th_eucl = lazy (Env.read_theory env ["int"] "EuclideanDivision")
let th_real = lazy (Env.find_theory env ["real"] "Real") let th_real = lazy (Env.read_theory env ["real"] "Real")
let why_constant_int dep s = let why_constant_int dep s =
task := Task.use_export !task (Lazy.force th_int); task := Task.use_export !task (Lazy.force th_int);
......
This diff is collapsed.
This diff is collapsed.
...@@ -836,7 +836,7 @@ let on_meta _meta fn acc theory = ...@@ -836,7 +836,7 @@ let on_meta _meta fn acc theory =
(** Base theories *) (** Base theories *)
let builtin_theory = let builtin_theory =
let uc = empty_theory (id_fresh "BuiltIn") ["why3"] in let uc = empty_theory (id_fresh "BuiltIn") ["why3";"BuiltIn"] in
let uc = add_ty_decl uc ts_int in let uc = add_ty_decl uc ts_int in
let uc = add_ty_decl uc ts_real in let uc = add_ty_decl uc ts_real in
let uc = add_param_decl uc ps_equ in let uc = add_param_decl uc ps_equ in
...@@ -846,12 +846,12 @@ let create_theory ?(path=[]) n = ...@@ -846,12 +846,12 @@ let create_theory ?(path=[]) n =
use_export (empty_theory n path) builtin_theory use_export (empty_theory n path) builtin_theory
let bool_theory = let bool_theory =
let uc = empty_theory (id_fresh "Bool") ["why3"] in let uc = empty_theory (id_fresh "Bool") ["why3";"Bool"] in
let uc = add_data_decl uc [ts_bool, [fs_bool_true,[]; fs_bool_false,[]]] in let uc = add_data_decl uc [ts_bool, [fs_bool_true,[]; fs_bool_false,[]]] in
close_theory uc close_theory uc
let highord_theory = let highord_theory =
let uc = empty_theory (id_fresh "HighOrd") ["why3"] in let uc = empty_theory (id_fresh "HighOrd") ["why3";"HighOrd"] in
let uc = use_export uc bool_theory in let uc = use_export uc bool_theory in
let uc = add_ty_decl uc ts_func in let uc = add_ty_decl uc ts_func in
let uc = add_ty_decl uc ts_pred in let uc = add_ty_decl uc ts_pred in
...@@ -861,12 +861,13 @@ let highord_theory = ...@@ -861,12 +861,13 @@ let highord_theory =
let tuple_theory = Hint.memo 17 (fun n -> let tuple_theory = Hint.memo 17 (fun n ->
let ts = ts_tuple n and fs = fs_tuple n in let ts = ts_tuple n and fs = fs_tuple n in
let pl = List.map (fun _ -> None) ts.ts_args in let pl = List.map (fun _ -> None) ts.ts_args in
let uc = empty_theory (id_fresh ("Tuple" ^ string_of_int n)) ["why3"] in let nm = "Tuple" ^ string_of_int n in
let uc = empty_theory (id_fresh nm) ["why3";nm] in
let uc = add_data_decl uc [ts, [fs,pl]] in let uc = add_data_decl uc [ts, [fs,pl]] in
close_theory uc) close_theory uc)
let unit_theory = let unit_theory =
let uc = empty_theory (id_fresh "Unit") ["why3"] in let uc = empty_theory (id_fresh "Unit") ["why3";"Unit"] in
let ts = create_tysymbol (id_fresh "unit") [] (Some (ty_tuple [])) in let ts = create_tysymbol (id_fresh "unit") [] (Some (ty_tuple [])) in
let uc = use_export uc (tuple_theory 0) in let uc = use_export uc (tuple_theory 0) in
let uc = add_ty_decl uc ts in let uc = add_ty_decl uc ts in
......
...@@ -179,7 +179,7 @@ let load_driver = let driver_tag = ref (-1) in fun env file extra_files -> ...@@ -179,7 +179,7 @@ let load_driver = let driver_tag = ref (-1) in fun env file extra_files ->
let add_theory { thr_name = (loc,q); thr_rules = trl } = let add_theory { thr_name = (loc,q); thr_rules = trl } =
let f,id = let l = List.rev q in List.rev (List.tl l),List.hd l in let f,id = let l = List.rev q in List.rev (List.tl l),List.hd l in
let th = let th =
try Env.read_theory ~format:"why" env f id try Env.read_theory env f id
with e when not (Debug.test_flag Debug.stack_trace) -> with e when not (Debug.test_flag Debug.stack_trace) ->
raise (Loc.Located (loc,e)) raise (Loc.Located (loc,e))
in in
......
...@@ -9,8 +9,6 @@ ...@@ -9,8 +9,6 @@
(* *) (* *)
(********************************************************************) (********************************************************************)
val library_of_env : Env.env -> unit Env.library
val parse_logic_file : val parse_logic_file :
Env.env -> Env.pathname -> Lexing.lexbuf -> Theory.theory Stdlib.Mstr.t Env.env -> Env.pathname -> Lexing.lexbuf -> Theory.theory Stdlib.Mstr.t
......
...@@ -248,12 +248,10 @@ rule token = parse ...@@ -248,12 +248,10 @@ rule token = parse
let read_channel env path file c = let read_channel env path file c =
let lb = Lexing.from_channel c in let lb = Lexing.from_channel c in
Loc.set_file file lb; Loc.set_file file lb;
(), parse_logic_file env path lb parse_logic_file env path lb
let library_of_env = Env.register_format "why" ["why"] read_channel let () = Env.register_format "why" ["why"] Env.base_language read_channel
~desc:"Why@ logical@ language" ~desc:"Why@ logical@ language"
let parse_logic_file env = parse_logic_file (library_of_env env)
} }
(* (*
......
...@@ -665,9 +665,9 @@ let prop_kind = function ...@@ -665,9 +665,9 @@ let prop_kind = function
let find_theory env lenv q = match q with let find_theory env lenv q = match q with
| Qident { id = id } -> (* local theory *) | Qident { id = id } -> (* local theory *)
begin try Mstr.find id lenv begin try Mstr.find id lenv
with Not_found -> read_lib_theory env [] id end with Not_found -> read_theory env [] id end
| Qdot (p, { id = id }) -> (* theory in file f *) | Qdot (p, { id = id }) -> (* theory in file f *)
read_lib_theory env (string_list_of_qualid p) id read_theory env (string_list_of_qualid p) id
let rec clone_ns kn sl path ns2 ns1 s = let rec clone_ns kn sl path ns2 ns1 s =
let qualid fmt path = Pp.print_list let qualid fmt path = Pp.print_list
......
...@@ -23,14 +23,14 @@ val debug_type_only : Debug.flag ...@@ -23,14 +23,14 @@ val debug_type_only : Debug.flag
val add_decl : Loc.position -> theory_uc -> Ptree.decl -> theory_uc val add_decl : Loc.position -> theory_uc -> Ptree.decl -> theory_uc
val add_use_clone : val add_use_clone :
unit Env.library -> theory Mstr.t -> theory_uc -> Env.env -> theory Mstr.t -> theory_uc ->
Loc.position -> Ptree.use_clone -> theory_uc Loc.position -> Ptree.use_clone -> theory_uc
val close_namespace : Loc.position -> bool -> theory_uc -> theory_uc val close_namespace : Loc.position -> bool -> theory_uc -> theory_uc
val close_theory : theory Mstr.t -> theory_uc -> theory Mstr.t val close_theory : theory Mstr.t -> theory_uc -> theory Mstr.t
val open_file : unit Env.library -> Env.pathname -> Ptree.incremental val open_file : Env.env -> Env.pathname -> Ptree.incremental
val close_file : unit -> theory Mstr.t val close_file : unit -> theory Mstr.t
......
...@@ -928,7 +928,7 @@ let print_task printer_args realize ?old fmt task = ...@@ -928,7 +928,7 @@ let print_task printer_args realize ?old fmt task =
let f,id = let f,id =
let l = Strings.rev_split '.' s1 in let l = Strings.rev_split '.' s1 in
List.rev (List.tl l), List.hd l in List.rev (List.tl l), List.hd l in
let th = Env.find_theory printer_args.env f id in let th = Env.read_theory printer_args.env f id in
Mid.add th.Theory.th_name (th, if s2 = "" then s1 else s2) mid Mid.add th.Theory.th_name (th, if s2 = "" then s1 else s2) mid
| _ -> assert false | _ -> assert false
) Mid.empty task in ) Mid.empty task in
......
...@@ -66,7 +66,8 @@ let incremental_pat_match env holes = ...@@ -66,7 +66,8 @@ let incremental_pat_match env holes =
end end
| PatApp (sp,ss,sl,pl), Tapp (ls,tl) -> | PatApp (sp,ss,sl,pl), Tapp (ls,tl) ->
if List.length pl <> List.length tl then raise Not_found; if List.length pl <> List.length tl then raise Not_found;
let th = try Env.find_theory env sp ss with Env.TheoryNotFound _ -> raise Not_found in let th = try Env.read_theory env sp ss
with Env.TheoryNotFound _ -> raise Not_found in
let s = ns_find_ls th.th_export sl in let s = ns_find_ls th.th_export sl in
if not (ls_equal s ls) then raise Not_found; if not (ls_equal s ls) then raise Not_found;
List.iter2 aux pl tl List.iter2 aux pl tl
...@@ -103,7 +104,7 @@ let arith_meta = register_meta "gappa arith" ...@@ -103,7 +104,7 @@ let arith_meta = register_meta "gappa arith"
@]" @]"
let find_th env file th = let find_th env file th =
let theory = Env.find_theory env [file] th in let theory = Env.read_theory env [file] th in
fun id -> Theory.ns_find_ls theory.Theory.th_export [id] fun id -> Theory.ns_find_ls theory.Theory.th_export [id]
let get_info env task = let get_info env task =
......
...@@ -431,7 +431,7 @@ let print_task printer_args realize fmt task = ...@@ -431,7 +431,7 @@ let print_task printer_args realize fmt task =
let f,id = let f,id =
let l = Strings.rev_split '.' s1 in let l = Strings.rev_split '.' s1 in
List.rev (List.tl l), List.hd l in List.rev (List.tl l), List.hd l in
let th = Env.find_theory printer_args.env f id in let th = Env.read_theory printer_args.env f id in
Mid.add th.Theory.th_name (th, s1) mid Mid.add th.Theory.th_name (th, s1) mid
| _ -> assert false | _ -> assert false
) Mid.empty task in ) Mid.empty task in
......
...@@ -37,8 +37,8 @@ let incremental_pat_match env holes = ...@@ -37,8 +37,8 @@ let incremental_pat_match env holes =
end end
| PatApp (sp,ss,sl,pl), Tapp (ls,tl) -> | PatApp (sp,ss,sl,pl), Tapp (ls,tl) ->
if List.length pl <> List.length tl then raise Not_found; if List.length pl <> List.length tl then raise Not_found;
let th = try Env.find_theory env sp ss with Env.TheoryNotFound _ -> let th = try Env.read_theory env sp ss
raise Not_found in with Env.TheoryNotFound _ -> raise Not_found in
let s = ns_find_ls th.th_export sl in let s = ns_find_ls th.th_export sl in
if not (ls_equal s ls) then raise Not_found; if not (ls_equal s ls) then raise Not_found;
List.iter2 aux pl tl List.iter2 aux pl tl
...@@ -77,7 +77,7 @@ let arith_meta = register_meta "math arith" ...@@ -77,7 +77,7 @@ let arith_meta = register_meta "math arith"
let find_th env file th = let find_th env file th =
let theory = Env.find_theory env [file] th in let theory = Env.read_theory env [file] th in
fun id -> Theory.ns_find_ls theory.Theory.th_export [id] fun id -> Theory.ns_find_ls theory.Theory.th_export [id]
let get_info env task = let get_info env task =
......
...@@ -829,7 +829,7 @@ let print_task printer_args realize ?old fmt task = ...@@ -829,7 +829,7 @@ let print_task printer_args realize ?old fmt task =
let f,id = let f,id =
let l = Strings.rev_split '.' s1 in let l = Strings.rev_split '.' s1 in
List.rev (List.tl l), List.hd l in List.rev (List.tl l), List.hd l in
let th = Env.find_theory printer_args.env f id in let th = Env.read_theory printer_args.env f id in
Mid.add th.Theory.th_name Mid.add th.Theory.th_name
(th, (f, if s2 = "" then String.concat "." f else s2)) mid (th, (f, if s2 = "" then String.concat "." f else s2)) mid
| _ -> assert false | _ -> assert false
......
...@@ -1633,7 +1633,7 @@ let set_file_expanded f b = ...@@ -1633,7 +1633,7 @@ let set_file_expanded f b =
(* add a why file from a session *) (* add a why file from a session *)
(** Read file and sort theories by location *) (** Read file and sort theories by location *)
let read_file env ?format fn = let read_file env ?format fn =
let theories = Env.read_file env ?format fn in let theories = Env.read_file Env.base_language env ?format fn in
let ltheories = let ltheories =
Mstr.fold Mstr.fold
(fun name th acc -> (fun name th acc ->
...@@ -2085,17 +2085,9 @@ let merge_metas_in_task ~theories env task from_metas = ...@@ -2085,17 +2085,9 @@ let merge_metas_in_task ~theories env task from_metas =
let hpr = Hpr.create 10 in let hpr = Hpr.create 10 in
let obsolete = ref false in let obsolete = ref false in
(** TODO: replace that when retrieve theory will give the formats *)
let rec read_theory ip = function
| [] -> raise (Env.LibFileNotFound ip.ip_library)
| format::formats ->
try Env.read_theory ~format env.env ip.ip_library ip.ip_theory
with Env.LibFileNotFound _ | Env.TheoryNotFound _ ->
read_theory ip formats
in
let read_theory ip = let read_theory ip =
if ip.ip_library = [] then Mstr.find ip.ip_theory theories if ip.ip_library = [] then Mstr.find ip.ip_theory theories
else read_theory ip ["why";"whyml"] in else Env.read_theory env.env ip.ip_library ip.ip_theory in
let to_idpos_ts = Mts.fold_left (fun idpos_ts from_ts ip -> let to_idpos_ts = Mts.fold_left (fun idpos_ts from_ts ip ->
try try
......
...@@ -129,7 +129,7 @@ let () = try ...@@ -129,7 +129,7 @@ let () = try
in in
printf "@[Known input formats:@\n @[%a@]@]@." printf "@[Known input formats:@\n @[%a@]@]@."
(Pp.print_list Pp.newline2 print) (Pp.print_list Pp.newline2 print)
(List.sort Pervasives.compare (Env.list_formats ())) (List.sort Pervasives.compare (Env.list_formats Env.base_language))
end; end;
if !opt_list_provers then begin if !opt_list_provers then begin
opt_list := true; opt_list := true;
......
...@@ -47,13 +47,7 @@ let do_input f = ...@@ -47,13 +47,7 @@ let do_input f =
match f with match f with
| "-" -> "stdin", stdin | "-" -> "stdin", stdin
| f -> f, open_in f in | f -> f, open_in f in
if not (!opt_parser = Some "whyml" || Filename.check_suffix fname ".mlw") then let mm, _thm = Env.read_channel Mlw_module.mlw_language env fname cin in
begin
eprintf "Execution is available only for mlw files@.";
exit 1
end;
let lib = Mlw_main.library_of_env env in
let mm, _thm = Mlw_main.read_channel lib [] fname cin in
let do_exec (mid,name) = let do_exec (mid,name) =
let m = try Mstr.find mid mm with Not_found -> let m = try Mstr.find mid mm with Not_found ->
eprintf "Module '%s' not found.@." mid; eprintf "Module '%s' not found.@." mid;
......
...@@ -85,7 +85,7 @@ let opt_output = ...@@ -85,7 +85,7 @@ let opt_output =
| Some d -> d | Some d -> d
let opt_driver = let opt_driver =
match !opt_driver with try match !opt_driver with
| None -> | None ->
eprintf "Driver (-D) is required.@."; eprintf "Driver (-D) is required.@.";
exit 1 exit 1
...@@ -93,8 +93,10 @@ let opt_driver = ...@@ -93,8 +93,10 @@ let opt_driver =
let s = let s =
if Sys.file_exists s || String.contains s '/' || String.contains s '.' then s if Sys.file_exists s || String.contains s '/' || String.contains s '.' then s
else Filename.concat Config.datadir (Filename.concat "drivers" (s ^ ".drv")) in else Filename.concat Config.datadir (Filename.concat "drivers" (s ^ ".drv")) in
let lib = Mlw_main.library_of_env env in Mlw_driver.load_driver env s []
Mlw_driver.load_driver lib s [] with e when not (Debug.test_flag Debug.stack_trace) ->
eprintf "%a@." Exn_printer.exn_printer e;
exit 1
let extract_to ?fname th extract = let extract_to ?fname th extract =
let file = Filename.concat opt_output (Mlw_ocaml.extract_filename ?fname th) in let file = Filename.concat opt_output (Mlw_ocaml.extract_filename ?fname th) in
...@@ -147,24 +149,11 @@ let rec do_extract_module ?fname m = ...@@ -147,24 +149,11 @@ let rec do_extract_module ?fname m =
| None -> do_extract_theory ?fname th' in | None -> do_extract_theory ?fname th' in
use_iter extract_use m.Mlw_module.mod_theory use_iter extract_use m.Mlw_module.mod_theory
let do_global_extract (tname,p,t) = let do_global_extract (_,p,t) =
let lib = opt_driver.Mlw_driver.drv_lib in let env = opt_driver.Mlw_driver.drv_env in
try match Mlw_module.read_module_or_theory env p t with
let mm, thm = Env.read_lib_file lib p in | Mlw_module.Module m -> do_extract_module m
try | Mlw_module.Theory t -> do_extract_theory t
let m = Mstr.find t mm in
do_extract_module m
with Not_found ->
let th = Mstr.find t thm in
do_extract_theory th
with Env.LibFileNotFound _ | Not_found -> try
let format = Opt.get_def "why" !opt_parser in
let env = Env.env_of_library lib in
let th = Env.read_theory ~format env p t in
do_extract_theory th
with Env.LibFileNotFound _ | Env.TheoryNotFound _ ->
eprintf "Theory/module '%s' not found.@." tname;
exit 1
let do_extract_theory_from fname m (tname,_,t) = let do_extract_theory_from fname m (tname,_,t) =
let th = try Mstr.find t m with Not_found -> let th = try Mstr.find t m with Not_found ->
...@@ -183,9 +172,9 @@ let do_extract_module_from fname mm thm (tname,_,t) = ...@@ -183,9 +172,9 @@ let do_extract_module_from fname mm thm (tname,_,t) =
exit 1 exit 1
let do_local_extract fname cin tlist = let do_local_extract fname cin tlist =
let lib = opt_driver.Mlw_driver.drv_lib in let env = opt_driver.Mlw_driver.drv_env in
if !opt_parser = Some "whyml" || Filename.check_suffix fname ".mlw" then begin if !opt_parser = Some "whyml" || Filename.check_suffix fname ".mlw" then begin
let mm, thm = Mlw_main.read_channel lib [] fname cin in let mm, thm = Env.read_channel Mlw_module.mlw_language env fname cin in
if Queue.is_empty tlist then begin if Queue.is_empty tlist then begin
let do_m t m thm = let do_m t m thm =
do_extract_module ~fname m; Mstr.remove t thm in do_extract_module ~fname m; Mstr.remove t thm in
...@@ -194,7 +183,8 @@ let do_local_extract fname cin tlist = ...@@ -194,7 +183,8 @@ let do_local_extract fname cin tlist =
end else end else
Queue.iter (do_extract_module_from fname mm thm) tlist Queue.iter (do_extract_module_from fname mm thm) tlist
end else begin end else begin
let m = Env.read_channel ?format:!opt_parser env fname cin in let m = Env.read_channel ?format:!opt_parser
Env.base_language env fname cin in
if Queue.is_empty tlist then if Queue.is_empty tlist then
let add_th t th mi = Ident.Mid.add th.th_name (t,th) mi in let add_th t th mi = Ident.Mid.add th.th_name (t,th) mi in
let do_th _ (_,th) = do_extract_theory ~fname th in let do_th _ (_,th) = do_extract_theory ~fname th in
......
...@@ -327,11 +327,7 @@ let do_theory env drv fname tname th glist elist = ...@@ -327,11 +327,7 @@ let do_theory env drv fname tname th glist elist =