Env: organize supported languages in a tree

examples/use_api/logic.ml

@@ -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"]

examples/use_api/mlw.ml

@@ -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"]

examples/use_api/mlw_tree.ml

@@ -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
 

plugins/parser/dimacs.mll

@@ -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 ../.."

plugins/parser/genequlin.ml

@@ -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  \

plugins/tptp/tptp_lexer.mll

@@ -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)"
 
 }

plugins/tptp/tptp_typing.ml

@@ -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)
-

plugins/tptp/tptp_typing.mli

@@ -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
 

src/coq-tactic/why3tac.ml

@@ -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);

src/core/theory.ml

@@ -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

src/driver/driver.ml

@@ -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

src/parser/lexer.mli

@@ -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
 

src/parser/lexer.mll

@@ -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)
 }
 
 (*

src/parser/typing.ml

@@ -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

src/parser/typing.mli

@@ -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
 

src/printer/coq.ml

@@ -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

src/printer/gappa.ml

@@ -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 =

src/printer/isabelle.ml

@@ -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

src/printer/mathematica.ml

@@ -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 =

src/printer/pvs.ml

@@ -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

src/session/session.ml

@@ -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

src/tools/main.ml

@@ -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;

src/tools/why3execute.ml

@@ -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;

src/tools/why3extract.ml

@@ -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

src/tools/why3prove.ml

@@ -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,21 +348,22 @@ 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
-              close_in cin;
-              if Debug.test_flag Typing.debug_type_only then
-                ()
-              else
-                if Queue.is_empty tlist then
-                  let glist = Queue.create () in
-                  let elist = Queue.create () in
-                  let add_th t th mi = Ident.Mid.add th.th_name (t,th) mi in
-                  let do_th _ (t,th) =
-                    do_theory env drv fname t th glist elist
-                  in
-                  Ident.Mid.iter do_th (Mstr.fold add_th m Ident.Mid.empty)
-                else
-                  Queue.iter (do_local_theory env drv fname m) tlist
+      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
+        ()
+      else
+        if Queue.is_empty tlist then
+          let glist = Queue.create () in
+          let elist = Queue.create () in
+          let add_th t th mi = Ident.Mid.add th.th_name (t,th) mi in
+          let do_th _ (t,th) =
+            do_theory env drv fname t th glist elist
+          in
+          Ident.Mid.iter do_th (Mstr.fold add_th m Ident.Mid.empty)
+        else
+          Queue.iter (do_local_theory env drv fname m) tlist
 
 let driver_file s =
   if Sys.file_exists s || String.contains s '/' || String.contains s '.' 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

src/tools/why3realize.ml

@@ -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

src/transform/reduction_engine.ml

@@ -192,23 +192,20 @@ let built_in_theories =
   ]
 
 let add_builtin_th env (l,n,t,d) =
-  try
-    let th = Env.find_theory env l n in
-    List.iter
-      (fun (id,r) ->
-        let ts = Theory.ns_find_ts th.Theory.th_export [id] in
-        r ts)
-      t;
-    List.iter
-      (fun (id,r,f) ->
-        let ls = Theory.ns_find_ls th.Theory.th_export [id] in
-        Hls.add builtins ls f;
-        match r with
-          | None -> ()
-          | Some r -> r := ls)
-      d
-  with Not_found ->
-    Format.eprintf "[Compute] theory %s not found@." n
+  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
+      r ts)
+    t;
+  List.iter
+    (fun (id,r,f) ->
+      let ls = Theory.ns_find_ls th.Theory.th_export [id] in
+      Hls.add builtins ls f;
+      match r with
+        | None -> ()
+        | Some r -> r := ls)
+    d
 
 let get_builtins env =