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
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 int_theory : Theory.theory =
Env.find_theory env ["int"] "Int"
Env.read_theory env ["int"] "Int"
let plus_symbol : Term.lsymbol =
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
......@@ -301,13 +301,10 @@ declaration of
*)
(* import the ref.Ref module *)
let ref_modules, ref_theories =
Env.read_lib_file (Mlw_main.library_of_env env) ["ref"]
let ref_module : Mlw_module.modul = Stdlib.Mstr.find "Ref" ref_modules
let ref_module : Mlw_module.modul =
Mlw_module.read_module env ["ref"] "Ref"
let ref_type : Mlw_ty.T.itysymbol =
Mlw_module.ns_find_its ref_module.Mlw_module.mod_export ["ref"]
......
......@@ -31,7 +31,7 @@ let provers : Whyconf.config_prover Whyconf.Mprover.t =
let env : Env.env = Env.create_env (Whyconf.loadpath main)
let int_theory : Theory.theory =
Env.find_theory env ["int"] "Int"
Env.read_theory env ["int"] "Int"
let mul_int : Term.lsymbol =
Theory.ns_find_ls int_theory.Theory.th_export ["infix *"]
......@@ -96,10 +96,8 @@ declaration of
(* import the ref.Ref module *)
let ref_modules, ref_theories =
Env.read_lib_file (Mlw_main.library_of_env env) ["ref"]
let ref_module : Mlw_module.modul = Stdlib.Mstr.find "Ref" ref_modules
let ref_module : Mlw_module.modul =
Mlw_module.read_module env ["ref"] "Ref"
let ref_type : Mlw_ty.T.itysymbol =
Mlw_module.ns_find_its ref_module.Mlw_module.mod_export ["ref"]
......
......@@ -31,7 +31,7 @@ let provers : Whyconf.config_prover Whyconf.Mprover.t =
let env : Env.env = Env.create_env (Whyconf.loadpath main)
let int_theory : Theory.theory =
Env.find_theory env ["int"] "Int"
Env.read_theory env ["int"] "Int"
let mul_int : Term.lsymbol =
Theory.ns_find_ls int_theory.Theory.th_export ["infix *"]
......@@ -40,11 +40,9 @@ let unit_type = Ty.ty_tuple []
(* start a parsing *)
let lib = Mlw_main.library_of_env env
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
......
......@@ -125,22 +125,17 @@ let parse th_uc filename cin =
let th_uc, vars = init_vars th_uc nb_vars in
file th_uc vars 0 lexbuf) lb
let parse _env _path filename cin =
let th_uc = Theory.create_theory (Ident.id_fresh "Cnf") in
let th_uc = parse th_uc filename cin 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
(), 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.@]"
}
(*
Local Variables:
compile-command: "unset LANG; make -C ../.."
......
......@@ -61,7 +61,7 @@ let scanf s =
(** the main function *)
let read_channel env path filename cin =
(** 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 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
......@@ -123,9 +123,9 @@ let read_channel env path filename cin =
(** Read all the file *)
let th_uc = Sysutil.fold_channel fold th_uc cin in
(** 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.@ \
The@ first@ line@ gives@ the@ seed.@ Each@ other@ line@ \
describes@ a@ goal@ and@ contains@ three@ numbers:@]@\n \
......
......@@ -246,9 +246,9 @@ and comment_line = parse
let lb = Lexing.from_channel c in
Loc.set_file file lb;
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)"
}
......
......@@ -82,9 +82,8 @@ type denv = {
ts_rat : tysymbol;
}
let make_denv lib =
let env = Env.env_of_library lib in
let get_theory = Env.read_theory ~format:"why" env ["tptp"] in
let make_denv env =
let get_theory s = Env.read_theory env ["tptp"] s in
let th_univ = get_theory "Univ" in
let th_ghost = get_theory "Ghost" in
let th_rat = get_theory "Rat" in
......@@ -125,7 +124,7 @@ let defined_arith ~loc denv env impl dw tl =
| { t_ty = Some {ty_node = Tyapp (ts,[]) }}::_ -> ts
| _::_ -> error ~loc NonNumeric
| [] -> 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
| DF DFquot -> errorm ~loc "$quotient/2 is not defined on $int"
| DF (DFquot_e|DFrem_e) -> get_theory "IntDivE"
......@@ -667,4 +666,3 @@ let typecheck lib path ast =
| [] -> add_prop_decl uc Pgoal pr_false t_false
in
Mstr.singleton "T" (close_theory uc)
......@@ -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
......@@ -303,9 +303,9 @@ let print_dep fmt =
(* the task under construction *)
let task = ref None
let th_int = lazy (Env.find_theory env ["int"] "Int")
let th_eucl = lazy (Env.find_theory env ["int"] "EuclideanDivision")
let th_real = lazy (Env.find_theory env ["real"] "Real")
let th_int = lazy (Env.read_theory env ["int"] "Int")
let th_eucl = lazy (Env.read_theory env ["int"] "EuclideanDivision")
let th_real = lazy (Env.read_theory env ["real"] "Real")
let why_constant_int dep s =
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 =
(** Base theories *)
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_real in
let uc = add_param_decl uc ps_equ in
......@@ -846,12 +846,12 @@ let create_theory ?(path=[]) n =
use_export (empty_theory n path) builtin_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
close_theory uc
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 = add_ty_decl uc ts_func in
let uc = add_ty_decl uc ts_pred in
......@@ -861,12 +861,13 @@ let highord_theory =
let tuple_theory = Hint.memo 17 (fun n ->
let ts = ts_tuple n and fs = fs_tuple n 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
close_theory uc)
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 uc = use_export uc (tuple_theory 0) 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 ->
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 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) ->
raise (Loc.Located (loc,e))
in
......
......@@ -9,8 +9,6 @@
(* *)
(********************************************************************)
val library_of_env : Env.env -> unit Env.library
val parse_logic_file :
Env.env -> Env.pathname -> Lexing.lexbuf -> Theory.theory Stdlib.Mstr.t
......
......@@ -248,12 +248,10 @@ rule token = parse
let read_channel env path file c =
let lb = Lexing.from_channel c in
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"
let parse_logic_file env = parse_logic_file (library_of_env env)
}
(*
......
......@@ -665,9 +665,9 @@ let prop_kind = function
let find_theory env lenv q = match q with
| Qident { id = id } -> (* local theory *)
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 *)
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 qualid fmt path = Pp.print_list
......
......@@ -23,14 +23,14 @@ val debug_type_only : Debug.flag
val add_decl : Loc.position -> theory_uc -> Ptree.decl -> theory_uc
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
val close_namespace : Loc.position -> bool -> theory_uc -> theory_uc
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
......
......@@ -928,7 +928,7 @@ let print_task printer_args realize ?old fmt task =
let f,id =
let l = Strings.rev_split '.' s1 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
| _ -> assert false
) Mid.empty task in
......
......@@ -66,7 +66,8 @@ let incremental_pat_match env holes =
end
| PatApp (sp,ss,sl,pl), Tapp (ls,tl) ->
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
if not (ls_equal s ls) then raise Not_found;
List.iter2 aux pl tl
......@@ -103,7 +104,7 @@ let arith_meta = register_meta "gappa arith"
@]"
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]
let get_info env task =
......
......@@ -431,7 +431,7 @@ let print_task printer_args realize fmt task =
let f,id =
let l = Strings.rev_split '.' s1 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
| _ -> assert false
) Mid.empty task in
......
......@@ -37,8 +37,8 @@ let incremental_pat_match env holes =
end
| PatApp (sp,ss,sl,pl), Tapp (ls,tl) ->
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
if not (ls_equal s ls) then raise Not_found;
List.iter2 aux pl tl
......@@ -77,7 +77,7 @@ let arith_meta = register_meta "math arith"
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]
let get_info env task =
......
......@@ -829,7 +829,7 @@ let print_task printer_args realize ?old fmt task =
let f,id =
let l = Strings.rev_split '.' s1 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, (f, if s2 = "" then String.concat "." f else s2)) mid
| _ -> assert false
......
......@@ -1633,7 +1633,7 @@ let set_file_expanded f b =
(* add a why file from a session *)
(** Read file and sort theories by location *)
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 =
Mstr.fold
(fun name th acc ->
......@@ -2085,17 +2085,9 @@ let merge_metas_in_task ~theories env task from_metas =
let hpr = Hpr.create 10 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 =
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 ->
try
......
......@@ -129,7 +129,7 @@ let () = try
in
printf "@[Known input formats:@\n @[%a@]@]@."
(Pp.print_list Pp.newline2 print)
(List.sort Pervasives.compare (Env.list_formats ()))
(List.sort Pervasives.compare (Env.list_formats Env.base_language))
end;
if !opt_list_provers then begin
opt_list := true;
......
......@@ -47,13 +47,7 @@ let do_input f =
match f with
| "-" -> "stdin", stdin
| f -> f, open_in f in
if not (!opt_parser = Some "whyml" || Filename.check_suffix fname ".mlw") then
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 mm, _thm = Env.read_channel Mlw_module.mlw_language env fname cin in
let do_exec (mid,name) =
let m = try Mstr.find mid mm with Not_found ->
eprintf "Module '%s' not found.@." mid;
......
......@@ -85,7 +85,7 @@ let opt_output =
| Some d -> d
let opt_driver =
match !opt_driver with
try match !opt_driver with
| None ->
eprintf "Driver (-D) is required.@.";
exit 1
......@@ -93,8 +93,10 @@ let opt_driver =
let 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
let lib = Mlw_main.library_of_env env in
Mlw_driver.load_driver lib s []
Mlw_driver.load_driver env 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 file = Filename.concat opt_output (Mlw_ocaml.extract_filename ?fname th) in
......@@ -147,24 +149,11 @@ let rec do_extract_module ?fname m =
| None -> do_extract_theory ?fname th' in
use_iter extract_use m.Mlw_module.mod_theory
let do_global_extract (tname,p,t) =
let lib = opt_driver.Mlw_driver.drv_lib in
try
let mm, thm = Env.read_lib_file lib p in
try
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_global_extract (_,p,t) =
let env = opt_driver.Mlw_driver.drv_env in
match Mlw_module.read_module_or_theory env p t with
| Mlw_module.Module m -> do_extract_module m
| Mlw_module.Theory t -> do_extract_theory t
let do_extract_theory_from fname m (tname,_,t) =
let th = try Mstr.find t m with Not_found ->
......@@ -183,9 +172,9 @@ let do_extract_module_from fname mm thm (tname,_,t) =
exit 1
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
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
let do_m t m thm =
do_extract_module ~fname m; Mstr.remove t thm in
......@@ -194,7 +183,8 @@ let do_local_extract fname cin tlist =
end else
Queue.iter (do_extract_module_from fname mm thm) tlist
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
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
......
......@@ -327,11 +327,7 @@ let do_theory env drv fname tname th glist elist =
end
let do_global_theory env drv (tname,p,t,glist,elist) =
let format = Opt.get_def "why" !opt_parser in
let th = try Env.read_theory ~format env p t with Env.TheoryNotFound _ ->
eprintf "Theory '%s' not found.@." tname;
exit 1
in
let th = Env.read_theory env p t in
do_theory env drv "lib" tname th glist elist
let do_local_theory env drv fname m (tname,_,t,glist,elist) =
......@@ -352,7 +348,8 @@ let do_input env drv = function
| "-" -> "stdin", stdin
| f -> f, open_in f
in
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
close_in cin;
if Debug.test_flag Typing.debug_type_only then
()
......@@ -378,11 +375,6 @@ let load_driver env (s,ef) =
let file = driver_file s in
load_driver env file ef
let load_driver_extract env s =
let file = driver_file s in
let lib = Mlw_main.library_of_env env in
Mlw_driver.load_driver lib file []
let () =
try
let drv = Opt.map (load_driver env) !opt_driver in
......
......@@ -74,7 +74,7 @@ let opt_output =
| Some d -> d
let opt_driver =
match !opt_driver with
try match !opt_driver with
| None ->
eprintf "Driver (-D) is required.@.";
exit 1
......@@ -83,14 +83,12 @@ let opt_driver =
if Sys.file_exists s || String.contains s '/' || String.contains s '.' then s
else Filename.concat Config.datadir (Filename.concat "drivers" (s ^ ".drv")) in
Driver.load_driver env s []
let do_global_theory (tname,p,t) =
let format = Opt.get_def "why" !opt_parser in
let th = try Env.read_theory ~format env p t with Env.TheoryNotFound _ ->
eprintf "Theory '%s' not found.@." tname;
with e when not (Debug.test_flag Debug.stack_trace) ->
eprintf "%a@." Exn_printer.exn_printer e;
exit 1
in
let do_global_theory (_tname,p,t) =
let th = Env.read_theory env p t in
let task = Task.use_export None th in
let dest = Driver.file_of_theory opt_driver "lib" th in
let file = Filename.concat opt_output dest in
......
......@@ -192,8 +192,7 @@ let built_in_theories =
]
let add_builtin_th env (l,n,t,d) =
try
let th = Env.find_theory env l n in
let th = Env.read_theory env l n in
List.iter
(fun (id,r) ->
let ts = Theory.ns_find_ts th.Theory.th_export [id] in
......@@ -207,8 +206,6 @@ let add_builtin_th env (l,n,t,d) =
| None -> ()
| Some r -> r := ls)
d
with Not_found ->
Format.eprintf "[Compute] theory %s not found@." n
let get_builtins env =
Hls.clear builtins;
......
......@@ -11,22 +11,11 @@
open Term
open Theory
open Env
let prelude = ["map"]
let array = "Map"
let store = ["set"]
let select = ["get"]
let make_rt_rf env =
let array =
try
read_theory ~format:"why" env prelude array
with TheoryNotFound (_,s) ->
Format.eprintf "The theory %s is unknown" s;
exit 1 in
let store = (ns_find_ls array.th_export store).ls_name in
let select = (ns_find_ls array.th_export select).ls_name in
let array = Env.read_theory env ["map"] "Map" in
let store = (ns_find_ls array.th_export ["set"]).ls_name in
let select = (ns_find_ls array.th_export ["get"]).ls_name in
let rec rt t =
let t = TermTF.t_map rt rf t in
match t.t_node with
......
......@@ -67,7 +67,7 @@ let css =
let do_file env fname =
try
ignore (Env.read_file env fname)
ignore (Env.read_file Env.base_language env fname)
with e ->
eprintf "warning: could not read file '%s'@." fname;
eprintf "(%a)@." Exn_printer.exn_printer e
......
......@@ -9,7 +9,6 @@
(* *)
(********************************************************************)
open Stdlib
open Ident
open Ty
open Term
......@@ -21,7 +20,7 @@ open Mlw_expr
open Mlw_module
type driver = {
drv_lib : Mlw_typing.mlw_library;
drv_env : Env.env;
drv_printer : string option;
drv_prelude : Printer.prelude;
drv_thprelude : Printer.prelude_map;
......@@ -47,9 +46,6 @@ let load_file file =
Stack.iter close_in to_close;
f
(* dead code
exception NoPrinter
*)
exception Duplicate of string
exception UnknownType of (string list * string list)
exception UnknownLogic of (string list * string list)
......@@ -59,7 +55,7 @@ exception UnknownExn of (string list * string list)
exception FSymExpected of lsymbol
exception PSymExpected of lsymbol
let load_driver lib file extra_files =
let load_driver env file extra_files =
let prelude = ref [] in
let printer = ref None in
let blacklist = Queue.create () in
......@@ -142,9 +138,7 @@ let load_driver lib file extra_files =
let m = lookup_meta s in
ignore (create_meta m (List.map convert al))
in
let add_local th (loc,rule) =
try add_local th rule with e -> raise (Loc.Located (loc,e))
in
let add_local th (loc,rule) = Loc.try2 ~loc add_local th rule in
let find_val m (loc,q) =
try match ns_find_prog_symbol m.mod_export q with
| PV pv -> pv.pv_vs.vs_name
......@@ -169,23 +163,17 @@ let load_driver lib file extra_files =
add_converter id s
in
let add_local_module m (loc,rule) =
try add_local_module loc m rule with e -> raise (Loc.Located (loc,e))
Loc.try3 ~loc add_local_module loc m rule
in
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 th =
try Env.read_theory ~format:"why" (Env.env_of_library lib) f id
with e -> raise (Loc.Located (loc,e))
in
let th = Loc.try3 ~loc Env.read_theory env f id in
qualid := q;
List.iter (add_local th) trl
in
let add_module { mor_name = (loc,q); mor_rules = mrl } =
let f,id = let l = List.rev q in List.rev (List.tl l),List.hd l in
let m =
try let mm, _ = Env.read_lib_file lib f in Mstr.find id mm
with e -> raise (Loc.Located (loc,e))
in
let m = Loc.try3 ~loc read_module env f id in
qualid := q;
List.iter (add_local_module m) mrl
in
......@@ -197,7 +185,7 @@ let load_driver lib file extra_files =
List.iter add_module fe.fe_mo_rules)
extra_files;
{
drv_lib = lib;
drv_env = env;
drv_printer = !printer;
drv_prelude = List.rev !prelude;
drv_thprelude = Mid.map List.rev !thprelude;
......@@ -206,18 +194,12 @@ let load_driver lib file extra_files =
drv_converter = !converter_map;
}
(* exception report *)
let string_of_qualid thl idl =
String.concat "." thl ^ "." ^ String.concat "." idl
let () = Exn_printer.register (fun fmt exn -> match exn with
(* dead code
| NoPrinter -&