Commit f709f96d authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

store the full name of idents declared in theories and modules

The full name includes the library path to the theory/module (if any),
and the qualifier prefix of the ident in the theory/module.
parent a810c7c4
......@@ -296,9 +296,7 @@ let close_theory uc = match uc.uc_export with
| _ -> raise CloseTheory
let get_namespace uc = List.hd uc.uc_import
let get_prefix uc = List.rev uc.uc_prefix
let get_known uc = uc.uc_known
let get_rev_decls uc = uc.uc_decls
let open_namespace uc s = match uc.uc_import with
......@@ -353,7 +351,19 @@ let add_tdecl uc td = match td.td_node with
(** Declarations *)
let store_path, restore_path =
let id_to_path = Wid.create 17 in
let store_path uc path id =
(* this symbol already belongs to some theory *)
if Wid.mem id_to_path id then () else
let prefix = List.rev (id.id_string :: path @ uc.uc_prefix) in
Wid.set id_to_path id (uc.uc_path, uc.uc_name.id_string, prefix)
in
let restore_path id = Wid.find id_to_path id in
store_path, restore_path
let add_symbol add id v uc =
store_path uc [] id;
match uc.uc_import, uc.uc_export with
| i0 :: sti, e0 :: ste -> { uc with
uc_import = add false id.id_string v i0 :: sti;
......@@ -648,17 +658,23 @@ let clone_export uc th inst =
let g_ts _ ts = not (Mts.mem ts inst.inst_ts) in
let g_ls _ ls = not (Mls.mem ls inst.inst_ls) in
let f_ts ts = Mts.find_def ts ts cl.ts_table in
let f_ls ls = Mls.find_def ls ls cl.ls_table in
let f_pr pr = Mpr.find_def pr pr cl.pr_table in
let rec f_ns ns = {
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
let f_ts p ts =
try let ts = Mts.find ts cl.ts_table in store_path uc p ts.ts_name; ts
with Not_found -> ts in
let f_ls p ls =
try let ls = Mls.find ls cl.ls_table in store_path uc p ls.ls_name; ls
with Not_found -> ls in
let f_pr p pr =
try let pr = Mpr.find pr cl.pr_table in store_path uc p pr.pr_name; pr
with Not_found -> pr in
let rec f_ns p ns = {
ns_ts = Mstr.map (f_ts p) (Mstr.filter g_ts ns.ns_ts);
ns_ls = Mstr.map (f_ls p) (Mstr.filter g_ls ns.ns_ls);
ns_pr = Mstr.map (f_pr p) ns.ns_pr;
ns_ns = Mstr.mapi (fun n -> f_ns (n::p)) ns.ns_ns; } in
let ns = f_ns [] th.th_export in
match uc.uc_import, uc.uc_export with
| i0 :: sti, e0 :: ste -> { uc with
......
......@@ -133,11 +133,16 @@ val open_namespace : theory_uc -> string -> theory_uc
val close_namespace : theory_uc -> bool (* import *) -> theory_uc
val get_namespace : theory_uc -> namespace
val get_prefix : theory_uc -> string list
val get_known : theory_uc -> known_map
val get_rev_decls : theory_uc -> tdecl list
val restore_path : ident -> string list * string * string list
(* [restore_path id] returns the triple (library path, theory,
qualified symbol name) if the ident was ever introduced in
a theory declaration. If the ident was declared in several
different theories, the first association is retained.
Raises Not_found if the ident was never declared in a theory. *)
(** Declaration constructors *)
val create_decl : decl -> tdecl
......
......@@ -134,6 +134,8 @@ type modul = {
type module_uc = {
muc_theory : theory_uc;
muc_name : string;
muc_path : string list;
muc_decls : pdecl list;
muc_prefix : string list;
muc_import : namespace list;
......@@ -143,9 +145,13 @@ type module_uc = {
muc_used : Sid.t;
muc_env : Env.env;
}
(* FIXME? We wouldn't need to store muc_name, muc_path,
and muc_prefix if theory_uc was exported *)
let empty_module env n p = {
muc_theory = create_theory ~path:p n;
muc_name = Ident.preid_name n;
muc_path = p;
muc_decls = [];
muc_prefix = [];
muc_import = [empty_ns];
......@@ -167,7 +173,6 @@ let close_module uc =
let get_theory uc = uc.muc_theory
let get_namespace uc = List.hd uc.muc_import
let get_prefix uc = List.rev uc.muc_prefix
let get_known uc = uc.muc_known
let open_namespace uc s = match uc.muc_import with
......@@ -218,7 +223,19 @@ let use_export uc m =
let add_to_theory f uc x = { uc with muc_theory = f uc.muc_theory x }
let store_path, restore_path =
let id_to_path = Wid.create 17 in
let store_path uc path id =
(* this symbol already belongs to some theory *)
if Wid.mem id_to_path id then () else
let prefix = List.rev (id.id_string :: path @ uc.muc_prefix) in
Wid.set id_to_path id (uc.muc_path, uc.muc_name, prefix)
in
let restore_path id = Wid.find id_to_path id in
store_path, restore_path
let add_symbol add id v uc =
store_path uc [] id;
match uc.muc_import, uc.muc_export with
| i0 :: sti, e0 :: ste -> { uc with
muc_import = add false id.id_string v i0 :: sti;
......@@ -254,14 +271,18 @@ let clone_export_theory uc th inst =
| _ -> assert false in
let g_ts _ ts = not (Mts.mem ts inst.inst_ts) in
let g_ls _ ls = not (Mls.mem ls inst.inst_ls) in
let f_ts ts = TS (Mts.find_def ts ts sm.sm_ts) in
let f_ls ls = LS (Mls.find_def ls ls sm.sm_ls) in
let rec f_ns ns = {
ns_ts = Mstr.map f_ts (Mstr.filter g_ts ns.Theory.ns_ts);
ns_ps = Mstr.map f_ls (Mstr.filter g_ls ns.Theory.ns_ls);
ns_ns = Mstr.map f_ns ns.Theory.ns_ns; }
let f_ts p ts =
try let ts = Mts.find ts sm.sm_ts in store_path uc p ts.ts_name; TS ts
with Not_found -> TS ts in
let f_ls p ls =
try let ls = Mls.find ls sm.sm_ls in store_path uc p ls.ls_name; LS ls
with Not_found -> LS ls in
let rec f_ns p ns = {
ns_ts = Mstr.map (f_ts p) (Mstr.filter g_ts ns.Theory.ns_ts);
ns_ps = Mstr.map (f_ls p) (Mstr.filter g_ls ns.Theory.ns_ls);
ns_ns = Mstr.mapi (fun n -> f_ns (n::p)) ns.Theory.ns_ns; }
in
add_to_module uc nth (f_ns th.th_export)
add_to_module uc nth (f_ns [] th.th_export)
let add_meta uc m al =
{ uc with muc_theory = Theory.add_meta uc.muc_theory m al }
......@@ -406,7 +427,6 @@ let clone_export uc m inst =
let conv_pv pv =
create_pvsymbol (id_clone pv.pv_vs.vs_name) (conv_vtv pv.pv_vtv) in
let psh = Hid.create 3 in
let find_ps def id = try Hid.find psh id with Not_found -> def in
let conv_xs xs = try match Hid.find psh xs.xs_name with
| XS xs -> xs | _ -> assert false with Not_found -> xs in
let conv_eff eff =
......@@ -513,17 +533,36 @@ let clone_export uc m inst =
let g_ps _ = function
| LS ls -> not (Mls.mem ls inst.inst_ls)
| _ -> true in
let f_ts = function
| TS ts -> TS (Mts.find_def ts ts sm.Theory.sm_ts)
| PT pt -> PT (Mits.find_def pt pt psm.sm_its) in
let f_ps prs = match prs with
| LS ls -> LS (Mls.find_def ls ls sm.Theory.sm_ls)
| PL pl -> PL (Mls.find_def pl pl.pl_ls psm.sm_pls)
| PV pv -> find_ps prs pv.pv_vs.vs_name
| PS ps -> find_ps prs ps.ps_name
| XS xs -> find_ps prs xs.xs_name in
let rec f_ns ns = {
ns_ts = Mstr.map f_ts (Mstr.filter g_ts ns.ns_ts);
ns_ps = Mstr.map f_ps (Mstr.filter g_ps ns.ns_ps);
ns_ns = Mstr.map f_ns ns.ns_ns; } in
add_to_module uc nth (f_ns m.mod_export)
let f_ts p = function
| TS ts ->
begin try let ts = Mts.find ts sm.Theory.sm_ts in
store_path uc p ts.ts_name; TS ts
with Not_found -> TS ts end
| PT pt ->
begin try let pt = Mits.find pt psm.sm_its in
store_path uc p pt.its_pure.ts_name; PT pt
with Not_found -> PT pt end in
let find_prs p def id =
try let s = Hid.find psh id in match s with
| PV pv -> store_path uc p pv.pv_vs.vs_name; s
| PS ps -> store_path uc p ps.ps_name; s
| XS xs -> store_path uc p xs.xs_name; s
| LS _ | PL _ -> assert false
with Not_found -> def in
let f_ps p prs = match prs with
| LS ls ->
begin try let ls = Mls.find ls sm.Theory.sm_ls in
store_path uc p ls.ls_name; LS ls
with Not_found -> LS ls end
| PL pl ->
begin try let pl = Mls.find pl.pl_ls psm.sm_pls in
store_path uc p pl.pl_ls.ls_name; PL pl
with Not_found -> PL pl end
| PV pv -> find_prs p prs pv.pv_vs.vs_name
| PS ps -> find_prs p prs ps.ps_name
| XS xs -> find_prs p prs xs.xs_name in
let rec f_ns p ns = {
ns_ts = Mstr.map (f_ts p) (Mstr.filter g_ts ns.ns_ts);
ns_ps = Mstr.map (f_ps p) (Mstr.filter g_ps ns.ns_ps);
ns_ns = Mstr.mapi (fun n -> f_ns (n::p)) ns.ns_ns; } in
add_to_module uc nth (f_ns [] m.mod_export)
......@@ -74,9 +74,15 @@ val close_namespace : module_uc -> bool -> module_uc
val get_theory : module_uc -> theory_uc
val get_namespace : module_uc -> namespace
val get_prefix : module_uc -> string list
val get_known : module_uc -> known_map
val restore_path : ident -> string list * string * string list
(* [restore_path id] returns the triple (library path, module,
qualified symbol name) if the ident was ever introduced in
a module declaration. If the ident was declared in several
different modules, the first association is retained.
Raises Not_found if the ident was never declared in a module. *)
(** Use and clone *)
val use_export : module_uc -> modul -> module_uc
......
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