Commit 1914661d authored by Andrei Paskevich's avatar Andrei Paskevich

replace Theory.[MS]nm by Util.[MS]str everywhere

parent d4ccd8f2
......@@ -151,7 +151,7 @@ let file whyconf env (dbf,wf) =
"Error : No sketch of proof for the theory %s of file %s.@."
thname wf
in
Theory.Mnm.iter iter wths
Util.Mstr.iter iter wths
let db whyconf env =
......
......@@ -134,7 +134,7 @@ let gen_from_file ~format ~prob_name ~file_path ~file_name env lth =
in
let m = Env.read_channel ?format:format env file_name cin in
close_in cin;
Mnm.bindings m in
Mstr.bindings m in
let file_id = if Db.is_initialized () then
let file_db = Sysutil.relativize_filename
(Filename.dirname (Db.db_name ())) file_path in
......
......@@ -17,6 +17,7 @@
(* *)
(**************************************************************************)
open Util
open Ident
open Theory
......@@ -40,7 +41,7 @@ type find_channel = fformat -> pathname -> filename * in_channel
type env = {
env_find : find_channel;
env_memo : (string list, theory Mnm.t) Hashtbl.t;
env_memo : (string list, theory Mstr.t) Hashtbl.t;
env_tag : Hashweak.tag;
}
......@@ -50,7 +51,7 @@ module Wenv = Hashweak.Make(struct type t = env let tag = env_tag end)
(** Input formats *)
type read_channel = env -> filename -> in_channel -> theory Mnm.t
type read_channel = env -> filename -> in_channel -> theory Mstr.t
let read_channel_table = Hashtbl.create 17 (* format name -> read_channel *)
let extensions_table = Hashtbl.create 17 (* suffix -> format name *)
......@@ -128,7 +129,7 @@ let find_channel env = env.env_find
let find_library env sl =
let file, ic = env.env_find "why" sl in
try
Hashtbl.replace env.env_memo sl Mnm.empty;
Hashtbl.replace env.env_memo sl Mstr.empty;
let mth = read_channel ~format:"why" env file ic in
Hashtbl.replace env.env_memo sl mth;
close_in ic;
......@@ -152,7 +153,7 @@ let get_builtin s =
let find_theory env sl s =
if sl = [] then get_builtin s else
let mth = find_library env sl in
try Mnm.find s mth with Not_found ->
try Mstr.find s mth with Not_found ->
raise (TheoryNotFound (sl,s))
(* Exception reporting *)
......
......@@ -44,7 +44,7 @@ exception TheoryNotFound of pathname * string
open Theory
type read_channel = env -> filename -> in_channel -> theory Mnm.t
type read_channel = env -> filename -> in_channel -> theory Util.Mstr.t
(** a function of type [read_channel] parses a channel using
its own syntax. The string argument indicates the origin of
the stream (e.g. file name) to be used in error messages. *)
......@@ -69,7 +69,7 @@ val read_channel : ?format:fformat -> read_channel
@raise UnspecifiedFormat if format is not given and [file]
has no extension *)
val read_file : ?format:fformat -> env -> filename -> theory Mnm.t
val read_file : ?format:fformat -> env -> filename -> theory Util.Mstr.t
(** [read_file ?format env file] returns the theories in [file].
When given, [format] enforces the format, otherwise we choose
the format according to [file]'s extension. *)
......
......@@ -434,10 +434,10 @@ module NsTree = struct
if s = "real" && ts_equal ts ts_real then acc else
Leaf ("type " ^ s) :: acc
in
let acc = Mnm.fold add_ns ns.ns_ns [] in
let acc = Mnm.fold add_pr ns.ns_pr acc in
let acc = Mnm.fold add_ls ns.ns_ls acc in
let acc = Mnm.fold add_ts ns.ns_ts acc in acc
let acc = Mstr.fold add_ns ns.ns_ns [] in
let acc = Mstr.fold add_pr ns.ns_pr acc in
let acc = Mstr.fold add_ls ns.ns_ls acc in
let acc = Mstr.fold add_ts ns.ns_ts acc in acc
let decomp = function
| Namespace (s,ns,kn) -> s, contents ns kn
......
......@@ -26,21 +26,18 @@ open Decl
(** Namespace *)
module Snm = Sstr
module Mnm = Mstr
type namespace = {
ns_ts : tysymbol Mnm.t; (* type symbols *)
ns_ls : lsymbol Mnm.t; (* logic symbols *)
ns_pr : prsymbol Mnm.t; (* propositions *)
ns_ns : namespace Mnm.t; (* inner namespaces *)
ns_ts : tysymbol Mstr.t; (* type symbols *)
ns_ls : lsymbol Mstr.t; (* logic symbols *)
ns_pr : prsymbol Mstr.t; (* propositions *)
ns_ns : namespace Mstr.t; (* inner namespaces *)
}
let empty_ns = {
ns_ts = Mnm.empty;
ns_ls = Mnm.empty;
ns_pr = Mnm.empty;
ns_ns = Mnm.empty;
ns_ts = Mstr.empty;
ns_ls = Mstr.empty;
ns_pr = Mstr.empty;
ns_ns = Mstr.empty;
}
exception ClashSymbol of string
......@@ -51,20 +48,20 @@ let ns_replace eq chk x vo vn =
raise (ClashSymbol x)
let ns_union eq chk =
Mnm.union (fun x vn vo -> Some (ns_replace eq chk x vo vn))
Mstr.union (fun x vn vo -> Some (ns_replace eq chk x vo vn))
let rec merge_ns chk ns1 ns2 =
let fusion _ ns1 ns2 = Some (merge_ns chk ns1 ns2) in
{ ns_ts = ns_union ts_equal chk ns1.ns_ts ns2.ns_ts;
ns_ls = ns_union ls_equal chk ns1.ns_ls ns2.ns_ls;
ns_pr = ns_union pr_equal chk ns1.ns_pr ns2.ns_pr;
ns_ns = Mnm.union fusion ns1.ns_ns ns2.ns_ns; }
ns_ns = Mstr.union fusion ns1.ns_ns ns2.ns_ns; }
let nm_add chk x ns m = Mnm.change x (function
let nm_add chk x ns m = Mstr.change x (function
| None -> Some ns
| Some os -> Some (merge_ns chk ns os)) m
let ns_add eq chk x v m = Mnm.change x (function
let ns_add eq chk x v m = Mstr.change x (function
| None -> Some v
| Some vo -> Some (ns_replace eq chk x vo v)) m
......@@ -79,8 +76,8 @@ let add_ns chk x nn ns = { ns with ns_ns = nm_add chk x nn ns.ns_ns }
let rec ns_find get_map ns = function
| [] -> assert false
| [a] -> Mnm.find a (get_map ns)
| a::l -> ns_find get_map (Mnm.find a ns.ns_ns) l
| [a] -> Mstr.find a (get_map ns)
| a::l -> ns_find get_map (Mstr.find a ns.ns_ns) l
let ns_find_ts = ns_find (fun ns -> ns.ns_ts)
let ns_find_ls = ns_find (fun ns -> ns.ns_ls)
......@@ -631,10 +628,10 @@ let clone_export uc th inst =
let f_pr pr = Mpr.find_default pr pr cl.pr_table in
let rec f_ns ns = {
ns_ts = Mnm.map f_ts (Mnm.filter g_ts ns.ns_ts);
ns_ls = Mnm.map f_ls (Mnm.filter g_ls ns.ns_ls);
ns_pr = Mnm.map f_pr ns.ns_pr;
ns_ns = Mnm.map f_ns ns.ns_ns; } in
ns_ts = Mstr.map f_ts (Mstr.filter g_ts ns.ns_ts);
ns_ls = Mstr.map f_ls (Mstr.filter g_ls ns.ns_ls);
ns_pr = Mstr.map f_pr ns.ns_pr;
ns_ns = Mstr.map f_ns ns.ns_ns; } in
let ns = f_ns th.th_export in
......
......@@ -18,6 +18,7 @@
(**************************************************************************)
open Stdlib
open Util
(** Theories and Namespaces *)
......@@ -26,14 +27,11 @@ open Ty
open Term
open Decl
module Mnm : Map.S with type key = string
module Snm : Mnm.Set
type namespace = private {
ns_ts : tysymbol Mnm.t; (* type symbols *)
ns_ls : lsymbol Mnm.t; (* logic symbols *)
ns_pr : prsymbol Mnm.t; (* propositions *)
ns_ns : namespace Mnm.t; (* inner namespaces *)
ns_ts : tysymbol Mstr.t; (* type symbols *)
ns_ls : lsymbol Mstr.t; (* logic symbols *)
ns_pr : prsymbol Mstr.t; (* propositions *)
ns_ns : namespace Mstr.t; (* inner namespaces *)
}
val ns_find_ts : namespace -> string list -> tysymbol
......
......@@ -742,7 +742,7 @@ let read_file fn =
in
let theories = Env.read_file env fn in
let theories =
Theory.Mnm.fold
Util.Mstr.fold
(fun name th acc ->
match th.Theory.th_name.Ident.id_loc with
| Some l -> (l,name,th)::acc
......
......@@ -461,14 +461,14 @@ let do_global_theory env drv (tname,p,t,glist) =
do_theory env drv "lib" tname th glist
let do_local_theory env drv fname m (tname,_,t,glist) =
let th = try Mnm.find t m with Not_found ->
let th = try Mstr.find t m with Not_found ->
eprintf "Theory '%s' not found in file '%s'.@." tname fname;
exit 1
in
do_theory env drv fname tname th glist
let do_coq_realize_theory env _drv oldf fname m (tname,_,t,_glist) =
let th = try Mnm.find t m with Not_found ->
let th = try Mstr.find t m with Not_found ->
eprintf "Theory '%s' not found in file '%s'.@." tname fname;
exit 1
in
......@@ -509,7 +509,7 @@ let do_input env drv = function
let glist = 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 in
Ident.Mid.iter do_th (Mnm.fold add_th m Ident.Mid.empty)
Ident.Mid.iter do_th (Mstr.fold add_th m Ident.Mid.empty)
else
Queue.iter (do_local_theory env drv fname m) tlist
......
......@@ -19,7 +19,7 @@
(** parsing entry points *)
val parse_logic_file : Env.env -> Lexing.lexbuf -> Theory.theory Theory.Mnm.t
val parse_logic_file : Env.env -> Lexing.lexbuf -> Theory.theory Util.Mstr.t
val parse_program_file : Lexing.lexbuf -> Ptree.program_file
......
......@@ -32,7 +32,7 @@ module Incremental = struct
let ref_set ref v = ref := v :: ref_tail ref
let open_logic_file env =
ref_push env_ref env; ref_push lenv_ref Theory.Mnm.empty
ref_push env_ref env; ref_push lenv_ref Util.Mstr.empty
let close_logic_file () =
ref_drop env_ref; ref_pop lenv_ref
......@@ -243,7 +243,7 @@ end
%type <Env.env -> unit> pre_logic_file
%start pre_logic_file
%type <Theory.theory Theory.Mnm.t> logic_file
%type <Theory.theory Util.Mstr.t> logic_file
%start logic_file
%type <Ptree.program_file> program_file
%start program_file
......
......@@ -1057,7 +1057,7 @@ let prop_kind = function
let find_theory env lenv q id = match q with
| [] ->
(* local theory *)
begin try Mnm.find id lenv
begin try Mstr.find id lenv
with Not_found -> find_theory env [] id end
| _ :: _ ->
(* theory in file f *)
......@@ -1065,23 +1065,23 @@ let find_theory env lenv q id = match q with
let rec clone_ns loc sl ns2 ns1 s =
let clash id = error ~loc (Clash id.id_string) in
let s = Mnm.fold (fun nm ns1 acc ->
if not (Mnm.mem nm ns2.ns_ns) then acc else
let ns2 = Mnm.find nm ns2.ns_ns in
let s = Mstr.fold (fun nm ns1 acc ->
if not (Mstr.mem nm ns2.ns_ns) then acc else
let ns2 = Mstr.find nm ns2.ns_ns in
clone_ns loc sl ns2 ns1 acc) ns1.ns_ns s
in
let inst_ts = Mnm.fold (fun nm ts1 acc ->
if not (Mnm.mem nm ns2.ns_ts) then acc else
let inst_ts = Mstr.fold (fun nm ts1 acc ->
if not (Mstr.mem nm ns2.ns_ts) then acc else
if not (Sid.mem ts1.ts_name sl) then acc else
if Mts.mem ts1 acc then clash ts1.ts_name else
let ts2 = Mnm.find nm ns2.ns_ts in
let ts2 = Mstr.find nm ns2.ns_ts in
Mts.add ts1 ts2 acc) ns1.ns_ts s.inst_ts
in
let inst_ls = Mnm.fold (fun nm ls1 acc ->
if not (Mnm.mem nm ns2.ns_ls) then acc else
let inst_ls = Mstr.fold (fun nm ls1 acc ->
if not (Mstr.mem nm ns2.ns_ls) then acc else
if not (Sid.mem ls1.ls_name sl) then acc else
if Mls.mem ls1 acc then clash ls1.ls_name else
let ls2 = Mnm.find nm ns2.ns_ls in
let ls2 = Mstr.find nm ns2.ns_ls in
Mls.add ls1 ls2 acc) ns1.ns_ls s.inst_ls
in
{ s with inst_ts = inst_ts; inst_ls = inst_ls }
......@@ -1180,8 +1180,8 @@ let close_theory loc lenv th =
if Debug.test_flag debug_parse_only then lenv else
let th = close_theory th in
let id = th.th_name.id_string in
if Mnm.mem id lenv then error ~loc (ClashTheory id);
Mnm.add id th lenv
if Mstr.mem id lenv then error ~loc (ClashTheory id);
Mstr.add id th lenv
let close_namespace loc import name th =
let id = option_map (fun id -> id.id) name in
......
......@@ -29,12 +29,12 @@ val debug_type_only : Debug.flag
(** incremental parsing *)
val add_decl : Env.env -> theory Mnm.t -> theory_uc -> Ptree.decl -> theory_uc
val add_decl : Env.env -> theory Mstr.t -> theory_uc -> Ptree.decl -> theory_uc
val close_namespace :
Loc.position -> bool -> Ptree.ident option -> theory_uc -> theory_uc
val close_theory : Loc.position -> theory Mnm.t -> theory_uc -> theory Mnm.t
val close_theory : Loc.position -> theory Mstr.t -> theory_uc -> theory Mstr.t
(******************************************************************************)
(** The following is exported for program typing (src/programs/pgm_typing.ml) *)
......
......@@ -18,10 +18,11 @@
(**************************************************************************)
open Why
open Util
open Theory
open Pgm_module
type module_file = Theory.theory Mnm.t * Pgm_module.t Mnm.t
type module_file = Theory.theory Mstr.t * Pgm_module.t Mstr.t
type t = {
env : Env.env;
......@@ -45,7 +46,7 @@ let find_library penv sl =
try
Hashtbl.find penv.memo sl
with Not_found ->
Hashtbl.add penv.memo sl (Mnm.empty, Mnm.empty);
Hashtbl.add penv.memo sl (Mstr.empty, Mstr.empty);
let file, c = Env.find_channel penv.env "whyml" sl in
let r = penv.retrieve penv file c in
close_in c;
......@@ -53,5 +54,5 @@ let find_library penv sl =
r
let find_module penv sl s =
try Mnm.find s (snd (find_library penv sl))
try Mstr.find s (snd (find_library penv sl))
with Not_found -> raise (ModuleNotFound (sl, s))
......@@ -25,7 +25,7 @@ type t
val get_env : t -> Env.env
type module_file = Theory.theory Mnm.t * Pgm_module.t Mnm.t
type module_file = Theory.theory Util.Mstr.t * Pgm_module.t Util.Mstr.t
type retrieve_module = t -> string -> in_channel -> module_file
......
......@@ -36,7 +36,7 @@ let () = Exn_printer.register (fun fmt e -> match e with
let add_module ?(type_only=false) env penv (ltm, lmod) m =
let id = m.mod_name in
let loc = id.id_loc in
if Mnm.mem id.id lmod then raise (Loc.Located (loc, ClashModule id.id));
if Mstr.mem id.id lmod then raise (Loc.Located (loc, ClashModule id.id));
let wp = not type_only in
let uc = create_module (Ident.id_user id.id loc) in
let prelude = Env.find_theory env ["bool"] "Bool" in
......@@ -45,20 +45,20 @@ let add_module ?(type_only=false) env penv (ltm, lmod) m =
List.fold_left (Pgm_typing.decl ~wp env penv ltm lmod) uc m.mod_decl
in
let m = close_module uc in
Mnm.add id.id m.m_pure ltm,
Mnm.add id.id m lmod
Mstr.add id.id m.m_pure ltm,
Mstr.add id.id m lmod
let retrieve penv file c =
let lb = Lexing.from_channel c in
Loc.set_file file lb;
let ml = Lexer.parse_program_file lb in
if Debug.test_flag Typing.debug_parse_only then
Mnm.empty, Mnm.empty
Mstr.empty, Mstr.empty
else
let type_only = Debug.test_flag Typing.debug_type_only in
let env = Pgm_env.get_env penv in
List.fold_left (add_module ~type_only env penv)
(Mnm.empty, Mnm.empty) ml
(Mstr.empty, Mstr.empty) ml
let pgm_env_of_env =
let h = Env.Wenv.create 17 in
......
......@@ -30,13 +30,13 @@ open Pgm_types.T
open Pgm_ttree
type namespace = {
ns_ex : esymbol Mnm.t; (* exceptions*)
ns_ns : namespace Mnm.t; (* inner namespaces *)
ns_ex : esymbol Mstr.t; (* exceptions*)
ns_ns : namespace Mstr.t; (* inner namespaces *)
}
let empty_ns = {
ns_ex = Mnm.empty;
ns_ns = Mnm.empty;
ns_ex = Mstr.empty;
ns_ns = Mstr.empty;
}
exception ClashSymbol of string
......@@ -47,18 +47,18 @@ let ns_replace eq chk x vo vn =
raise (ClashSymbol x)
let ns_union eq chk =
Mnm.union (fun x vn vo -> Some (ns_replace eq chk x vo vn))
Mstr.union (fun x vn vo -> Some (ns_replace eq chk x vo vn))
let rec merge_ns chk ns1 ns2 =
let fusion _ ns1 ns2 = Some (merge_ns chk ns1 ns2) in
{ ns_ex = ns_union ls_equal chk ns1.ns_ex ns2.ns_ex;
ns_ns = Mnm.union fusion ns1.ns_ns ns2.ns_ns; }
ns_ns = Mstr.union fusion ns1.ns_ns ns2.ns_ns; }
let nm_add chk x ns m = Mnm.change x (function
let nm_add chk x ns m = Mstr.change x (function
| None -> Some ns
| Some os -> Some (merge_ns chk ns os)) m
let ns_add eq chk x v m = Mnm.change x (function
let ns_add eq chk x v m = Mstr.change x (function
| None -> Some v
| Some vo -> Some (ns_replace eq chk x vo v)) m
......@@ -70,8 +70,8 @@ let add_ns chk x nn ns = { ns with ns_ns = nm_add chk x nn ns.ns_ns }
let rec ns_find get_map ns = function
| [] -> assert false
| [a] -> Mnm.find a (get_map ns)
| a::l -> ns_find get_map (Mnm.find a ns.ns_ns) l
| [a] -> Mstr.find a (get_map ns)
| a::l -> ns_find get_map (Mstr.find a ns.ns_ns) l
let ns_find_ex = ns_find (fun ns -> ns.ns_ex)
let ns_find_ns = ns_find (fun ns -> ns.ns_ns)
......@@ -259,8 +259,8 @@ let use_export_theory uc th =
(create_mtsymbol ~impure:ts ~effect:ts ~pure:ts ~singleton:false)
in
let rec add_ns ns uc =
Mnm.iter add_ts ns.Theory.ns_ts;
Mnm.fold (fun _ -> add_ns) ns.Theory.ns_ns uc
Mstr.iter add_ts ns.Theory.ns_ts;
Mstr.fold (fun _ -> add_ns) ns.Theory.ns_ns uc
in
add_ns th.th_export uc
......
......@@ -26,8 +26,8 @@ open Pgm_types
open Pgm_types.T
type namespace = private {
ns_ex : esymbol Mnm.t; (* exception symbols *)
ns_ns : namespace Mnm.t; (* inner namespaces *)
ns_ex : esymbol Util.Mstr.t; (* exception symbols *)
ns_ns : namespace Util.Mstr.t; (* inner namespaces *)
}
val ns_find_ex : namespace -> string list -> esymbol
......@@ -74,14 +74,14 @@ val add_effect_decl : Decl.decl -> uc -> uc
val add_pure_decl : Decl.decl -> uc -> uc
val add_impure_pdecl :
Env.env -> Theory.theory Theory.Mnm.t -> Ptree.decl -> uc -> uc
Env.env -> Theory.theory Util.Mstr.t -> Ptree.decl -> uc -> uc
val add_effect_pdecl :
Env.env -> Theory.theory Theory.Mnm.t -> Ptree.decl -> uc -> uc
Env.env -> Theory.theory Util.Mstr.t -> Ptree.decl -> uc -> uc
val add_pure_pdecl :
Env.env -> Theory.theory Theory.Mnm.t -> Ptree.decl -> uc -> uc
Env.env -> Theory.theory Util.Mstr.t -> Ptree.decl -> uc -> uc
val add_pdecl :
Env.env -> Theory.theory Theory.Mnm.t -> Ptree.decl -> uc -> uc
Env.env -> Theory.theory Util.Mstr.t -> Ptree.decl -> uc -> uc
(** add in impure, effect and pure *)
(** builtins *)
......
......@@ -2176,7 +2176,7 @@ let add_logics env ltm uc d =
let find_module penv lmod q id = match q with
| [] ->
(* local module *)
Mnm.find id lmod
Mstr.find id lmod
| _ :: _ ->
(* theory in file f *)
Pgm_env.find_module penv q id
......
......@@ -18,12 +18,11 @@
(**************************************************************************)
open Why
open Util
val debug : Debug.flag
val decl :
wp:bool -> Env.env -> Pgm_env.t ->
Theory.theory Theory.Mnm.t ->
Pgm_module.t Theory.Mnm.t ->
Theory.theory Util.Mstr.t ->
Pgm_module.t Util.Mstr.t ->
Pgm_module.uc -> Ptree.program_decl -> Pgm_module.uc
......@@ -72,10 +72,10 @@ end = struct
let decls = getDeclsFromChan c in
if Debug.test_flag Typing.debug_parse_only ||
Debug.test_flag Typing.debug_type_only
then Theory.Mnm.empty
then Util.Mstr.empty
else
let my_theory = theory_of_decls file decls in
Theory.Mnm.add "Tptp" my_theory Theory.Mnm.empty
Util.Mstr.add "Tptp" my_theory Util.Mstr.empty
end
......
......@@ -73,7 +73,7 @@ let do_file env fname =
Doc_html.print_footer fmt ();
close_out c
in
Mnm.iter print_theory m
Mstr.iter print_theory m
let () =
try
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment