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);
......
...@@ -10,8 +10,6 @@ ...@@ -10,8 +10,6 @@
(********************************************************************) (********************************************************************)
open Stdlib open Stdlib
open Ident
open Theory
(** Library environment *) (** Library environment *)
...@@ -22,10 +20,13 @@ type pathname = string list (* library path *) ...@@ -22,10 +20,13 @@ type pathname = string list (* library path *)
exception KnownFormat of fformat exception KnownFormat of fformat
exception UnknownFormat of fformat exception UnknownFormat of fformat
exception UnknownExtension of extension exception InvalidFormat of fformat
exception UnspecifiedFormat exception UnspecifiedFormat
exception LibFileNotFound of pathname exception KnownExtension of extension * fformat
exception UnknownExtension of extension
exception LibraryNotFound of pathname
exception TheoryNotFound of pathname * string exception TheoryNotFound of pathname * string
exception AmbiguousPath of filename * filename exception AmbiguousPath of filename * filename
...@@ -47,16 +48,80 @@ let create_env = let c = ref (-1) in fun lp -> { ...@@ -47,16 +48,80 @@ let create_env = let c = ref (-1) in fun lp -> {
let get_loadpath env = Sstr.elements env.env_path let get_loadpath env = Sstr.elements env.env_path
let read_format_table = Hstr.create 17 (* format name -> read_format *) (** Input languages *)
let extensions_table = Hstr.create 17 (* suffix -> format name *)
type 'a format_parser = env -> pathname -> filename -> in_channel -> 'a
module Hpath = Hashtbl.Make(struct
type t = pathname
let hash = Hashtbl.hash
let equal = (=)
end)
type 'a language = {
memo : 'a Hpath.t;
push : pathname -> 'a -> unit;
mutable fmts : (fformat * extension list * Pp.formatted) list;
}
let base_language = {
memo = Hpath.create 17;
push = (fun _ _ -> ());
fmts = [];
}
exception LibraryConflict of pathname
let store lang path c =
lang.push path c;
Hpath.add lang.memo path c
let store lang path c =
if path = [] then store lang path c
else try
let d = Hpath.find lang.memo path in
if c != d then raise (LibraryConflict path)
with Not_found -> store lang path c
let retrieve_file lang ff path =
try Hpath.find lang.memo path
with Not_found -> raise (InvalidFormat ff)
let retrieve_lib lang path =
try Hpath.find lang.memo path
with Not_found -> raise (LibraryNotFound path)
let register_language parent convert = {
memo = Hpath.create 17;
push = (fun path c -> store parent path (convert c));
fmts = [];
}
let extension_table = ref Mstr.empty
let format_table = ref Mstr.empty
let builtin_list = ref []
let lookup_format name = let register_format ~desc ff extl lang fp =
try Hstr.find read_format_table name let fp env path fn ch = store lang path (fp env path fn ch) in
with Not_found -> raise (UnknownFormat name) format_table := Mstr.add_new (KnownFormat ff) ff fp !format_table;
let add_ext m e = Mstr.change (function
| Some ff -> raise (KnownExtension (e,ff))
| None -> Some ff) e m in
extension_table := List.fold_left add_ext !extension_table extl;
lang.fmts <- (ff,extl,desc) :: lang.fmts
let list_formats () = let list_formats lang = List.rev lang.fmts (* older to newer *)
let add n (_,_,l,desc) acc = (n,l,desc)::acc in
Hstr.fold add read_format_table [] let add_builtin lang bp =
let bp path = store lang ("why3" :: path) (bp path) in
builtin_list := bp :: !builtin_list
let read_builtin lang path =
let read bp = try bp path with Not_found -> () in
List.iter read !builtin_list;
retrieve_lib lang ("why3" :: path)
(** Input file parsing *)
let get_extension file = let get_extension file =
let s = try Filename.chop_extension file let s = try Filename.chop_extension file
...@@ -66,131 +131,117 @@ let get_extension file = ...@@ -66,131 +131,117 @@ let get_extension file =
let get_format file = let get_format file =
let ext = get_extension file in let ext = get_extension file in
try Hstr.find extensions_table ext Mstr.find_exn (UnknownExtension ext) ext !extension_table
with Not_found -> raise (UnknownExtension ext)
let read_channel ?format env file ic =
let name = match format with
| Some name -> name
| None -> get_format file in
let rc,_,_,_ = lookup_format name in
rc env file ic
let read_file ?format env file =
let ic = open_in file in
try
let mth = read_channel ?format env file ic in
close_in ic;
mth
with e -> close_in ic; raise e
let read_theory ~format env path th = let get_format ?format file = match format with
let _,rl,_,_ = lookup_format format in | Some ff -> ff
rl env path th | None -> get_format file
let find_theory = read_theory ~format:"why" let get_parser ff =
Mstr.find_exn (UnknownFormat ff) ff !format_table
(** Navigation in the library *) let read_channel ?format lang env file ch =
let ff = get_format ?format file in
let fp = get_parser ff in
fp env [] file ch;
retrieve_file lang ff []
let read_file_raw ?format lang env path file =
let ff = get_format ?format file in
let fp = get_parser ff in
let ch = open_in file in
begin try fp env path file ch; close_in ch
with exn -> close_in ch; raise exn; end;
retrieve_file lang ff path
exception InvalidQualifier of string let read_file ?format lang env file =
read_file_raw ?format lang env [] file
let check_qualifier s = (** Navigation in the library *)
if (s = Filename.parent_dir_name ||
s = Filename.current_dir_name ||
Filename.basename s <> s)
then raise (InvalidQualifier s)
let locate_lib_file env path exts = let locate_library env path =
if path = [] || path = ["why3"] then raise (LibFileNotFound path); if path = [] || path = ["why3"]
then invalid_arg "Env.locate_library";
let check_qualifier s =
if (s = Filename.parent_dir_name ||
s = Filename.current_dir_name ||
Filename.basename s <> s)
then invalid_arg "Env.locate_library" in
List.iter check_qualifier path; List.iter check_qualifier path;
let file = List.fold_left Filename.concat "" path in let file = List.fold_left Filename.concat "" path in
let add_ext ext = file ^ "." ^ ext in let add_ext ext = file ^ "." ^ ext in
let fl = if exts = [] then [file] else List.map add_ext exts in let fl = List.map add_ext (Mstr.keys !extension_table) in
if fl = [] then failwith "Env.locate_library (no formats)";
let add_dir dir = List.map (Filename.concat dir) fl in let add_dir dir = List.map (Filename.concat dir) fl in
let fl = List.concat (List.map add_dir (get_loadpath env)) in let fl = List.concat (List.map add_dir (get_loadpath env)) in
if fl = [] then failwith "Env.locate_library (empty loadpath)";
match List.filter Sys.file_exists fl with match List.filter Sys.file_exists fl with
| [] -> raise (LibFileNotFound path) | [] -> raise (LibraryNotFound path)
| [file] -> file | [file] -> file
| file1 :: file2 :: _ -> raise (AmbiguousPath (file1, file2)) | file1 :: file2 :: _ -> raise (AmbiguousPath (file1, file2))
(** Input formats *)
exception CircularDependency of pathname exception CircularDependency of pathname
type 'a contents = 'a * theory Mstr.t let read_library lang env path =
let file = locate_library env path in
module Hpath = Hashtbl.Make(struct read_file_raw lang env path file
type t = pathname
let hash = Hashtbl.hash
let equal = (=)
end)
type 'a library = {
lib_env : env;
lib_read : 'a read_format;
lib_exts : extension list;
lib_memo : ('a contents option) Hpath.t;
}
and 'a read_format =
'a library -> pathname -> filename -> in_channel -> 'a contents
let mk_library read exts env = {
lib_env = env;
lib_read = read;
lib_exts = exts;
lib_memo = Hpath.create 17;
}
let env_of_library lib = lib.lib_env let libstack = Hpath.create 17
let read_lib_file lib path = let read_library lang env path =
let file = locate_lib_file lib.lib_env path lib.lib_exts in if Hpath.mem libstack path then
let ic = open_in file in raise (CircularDependency path);
Hpath.add libstack path ();
try try
Hpath.replace lib.lib_memo path None; let c = read_library lang env path in
let res = lib.lib_read lib path file ic in Hpath.remove libstack path;
Hpath.replace lib.lib_memo path (Some res); c
close_in ic;
res
with e -> with e ->
Hpath.remove lib.lib_memo path; Hpath.remove libstack path;
close_in ic;
raise e raise e
let read_lib_file lib path = let read_library lang env = function
try match Hpath.find lib.lib_memo path with | "why3" :: path -> read_builtin lang path
| Some res -> res | path -> read_library lang env path
| None -> raise (CircularDependency path)
with Not_found -> read_lib_file lib path let read_library lang env path =
let path = if path = [] then ["why3"] else path in
let get_builtin s = try Hpath.find lang.memo path with Not_found ->
if s = builtin_theory.th_name.id_string then builtin_theory else if Hpath.mem base_language.memo path then begin
if s = bool_theory.th_name.id_string then bool_theory else match path with (* loaded for another format *)
if s = unit_theory.th_name.id_string then unit_theory else | "why3" :: _ ->
if s = highord_theory.th_name.id_string then highord_theory else raise (LibraryNotFound path)
match tuple_theory_name s with | _ ->
| Some n -> tuple_theory n let file = locate_library env path in
| None -> raise (TheoryNotFound ([],s)) raise (InvalidFormat (get_format file))
end else
let read_lib_theory lib path th = read_library lang env path
if path = [] || path = ["why3"] then get_builtin th else
let _,mth = read_lib_file lib path in let read_theory env path s =
try Mstr.find th mth with Not_found -> let path = if path = [] then ["why3"; s] else path in
raise (TheoryNotFound (path,th)) let mt = read_library base_language env path in
Mstr.find_exn (TheoryNotFound (path,s)) s mt
let register_format ~(desc:Pp.formatted) name exts read =
if Hstr.mem read_format_table name then raise (KnownFormat name); (* Builtin theories *)
let getlib = Wenv.memoize 5 (mk_library read exts) in
let rc env file ic = snd (read (getlib env) [] file ic) in open Ident
let rl env path th = read_lib_theory (getlib env) path th in open Theory
Hstr.add read_format_table name (rc,rl,exts,desc);
List.iter (fun s -> Hstr.replace extensions_table s name) exts; let base_builtin path =
getlib let builtin s =
if s = builtin_theory.th_name.id_string then builtin_theory else
let locate_lib_file env format path = if s = highord_theory.th_name.id_string then highord_theory else
let _,_,exts,_ = lookup_format format in if s = bool_theory.th_name.id_string then bool_theory else
locate_lib_file env path exts if s = unit_theory.th_name.id_string then unit_theory else
match tuple_theory_name s with
| Some n -> tuple_theory n
| None -> raise Not_found
in
match path with
| [s] -> Mstr.singleton s (builtin s)
| _ -> raise Not_found
let () = add_builtin base_language base_builtin
(* Exception reporting *) (* Exception reporting *)
...@@ -199,24 +250,27 @@ let print_path fmt sl = ...@@ -199,24 +250,27 @@ let print_path fmt sl =
let () = Exn_printer.register let () = Exn_printer.register
begin fun fmt exn -> match exn with begin fun fmt exn -> match exn with
| CircularDependency sl -> | CircularDependency sl -> Format.fprintf fmt
Format.fprintf fmt "Circular dependency in %a" print_path sl "Circular dependency in %a" print_path sl
| LibFileNotFound sl -> | LibraryNotFound sl -> Format.fprintf fmt
Format.fprintf fmt "Library file not found: %a" print_path sl "Library file not found: %a" print_path sl
| TheoryNotFound (sl,s) -> | TheoryNotFound (sl,s) -> Format.fprintf fmt
Format.fprintf fmt "Theory not found: %a" print_path (sl @ [s]) "Theory %s not found in library %a" s print_path sl
| KnownFormat s -> | KnownFormat s -> Format.fprintf fmt
Format.fprintf fmt "Format %s is already registered" s "Format %s is already registered" s
| UnknownFormat s -> | UnknownFormat s -> Format.fprintf fmt
Format.fprintf fmt "Unknown input format: %s" s "Unknown input format: %s" s
| UnknownExtension s -> | UnknownExtension s -> Format.fprintf fmt
Format.fprintf fmt "Unknown file extension: `%s'" s "Unknown file extension: `%s'" s
| UnspecifiedFormat -> | KnownExtension (s,f) -> Format.fprintf fmt
Format.fprintf fmt "Format not specified" "File extension `%s' is already registered for input format %s" s f
| AmbiguousPath (f1,f2) -> | UnspecifiedFormat -> Format.fprintf fmt
Format.fprintf fmt "Ambiguous path:@ both `%s'@ and `%s'@ match" f1 f2 "Format not specified"
| InvalidQualifier s -> | AmbiguousPath (f1,f2) -> Format.fprintf fmt
Format.fprintf fmt "Invalid qualifier `%s'" s "Ambiguous path:@ both %s@ and %s@ match" f1 f2
| InvalidFormat f -> Format.fprintf fmt
"Input format %s is unsuitable for the desired content" f
| LibraryConflict sl -> Format.fprintf fmt
"Conflicting definitions for library %a" print_path sl
| _ -> raise exn | _ -> raise exn
end end
...@@ -10,22 +10,14 @@ ...@@ -10,22 +10,14 @@
(********************************************************************) (********************************************************************)
open Stdlib open Stdlib
open Theory
(** Local type aliases and exceptions *) (** Local type aliases *)
type fformat = string (* format name *) type fformat = string (* format name *)
type filename = string (* file name *) type filename = string (* file name *)
type extension = string (* file extension *) type extension = string (* file extension *)
type pathname = string list (* library path *) type pathname = string list (* library path *)
exception KnownFormat of fformat
exception UnknownFormat of fformat
exception UnknownExtension of extension
exception UnspecifiedFormat
exception LibFileNotFound of pathname
exception TheoryNotFound of pathname * string
(** Library environment *) (** Library environment *)
type env type env
...@@ -41,93 +33,138 @@ val create_env : filename list -> env ...@@ -41,93 +33,138 @@ val create_env : filename list -> env
val get_loadpath : env -> filename list val get_loadpath : env -> filename list
(** returns the loadpath of a given environment *) (** returns the loadpath of a given environment *)
val read_channel : (** Input languages *)
?format:fformat -> env -> filename -> in_channel -> theory Mstr.t
(** [read_channel ?format env path file ch] returns the theories in [ch]. type 'a language
When given, [format] enforces the format, otherwise we choose
the format according to [file]'s extension. Nothing ensures