aboutsummaryrefslogtreecommitdiffhomepage
path: root/library/libnames.ml
diff options
context:
space:
mode:
authorGravatar soubiran <soubiran@85f007b7-540e-0410-9357-904b9bb8a0f7>2009-10-21 15:12:52 +0000
committerGravatar soubiran <soubiran@85f007b7-540e-0410-9357-904b9bb8a0f7>2009-10-21 15:12:52 +0000
commitfe1979bf47951352ce32a6709cb5138fd26f311d (patch)
tree5921dabde1ab3e16da5ae08fe16adf514f1fc07a /library/libnames.ml
parent148a8ee9dec2c04a8d73967b427729c95f039a6a (diff)
This big commit addresses two problems:
1- Management of the name-space in a modular development / sharing of non-logical objects. 2- Performance of atomic module operations (adding a module to the environment, subtyping ...). 1- There are 3 module constructions which derive equalities on fields from a module to another: Let P be a module path and foo a field of P Module M := P. Module M. Include P. ... End M. Declare Module K : S with Module M := P. In this 3 cases we don't want to be bothered by the duplication of names. Of course, M.foo delta reduce to P.foo but many non-logical features of coq do not work modulo conversion (they use eq_constr or constr_pat object). To engender a transparent name-space (ie using P.foo or M.foo is the same thing) we quotient the name-space by the equivalence relation on names induced by the 3 constructions above. To implement this, the types constant and mutual_inductive are now couples of kernel_names. The first projection correspond to the name used by the user and the second projection to the canonical name, for example the internal name of M.foo is (M.foo,P.foo). So: ************************************************************************************* * Use the eq_(con,mind,constructor,gr,egr...) function and not = on names values * ************************************************************************************* Map and Set indexed on names are ordered on user name for the kernel side and on canonical name outside. Thus we have sharing of notation, hints... for free (also for a posteriori declaration of them, ex: a notation on M.foo will be avaible on P.foo). If you want to use this, use the appropriate compare function defined in name.ml or libnames.ml. 2- No more time explosion (i hoppe) when using modules i have re-implemented atomic module operations so that they are all linear in the size of the module. We also have no more unique identifier (internal module names) for modules, it is now based on a section_path like mechanism => we have less substitutions to perform at require, module closing and subtyping but we pre-compute more information hence if we instanciate several functors then we have bigger vo. Last thing, the checker will not work well on vo(s) that contains one of the 3 constructions above, i will work on it soon... git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12406 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'library/libnames.ml')
-rw-r--r--library/libnames.ml58
1 files changed, 36 insertions, 22 deletions
diff --git a/library/libnames.ml b/library/libnames.ml
index 2b335ea6c..fad0336fc 100644
--- a/library/libnames.ml
+++ b/library/libnames.ml
@@ -27,13 +27,21 @@ let isConstRef = function ConstRef _ -> true | _ -> false
let isIndRef = function IndRef _ -> true | _ -> false
let isConstructRef = function ConstructRef _ -> true | _ -> false
+let eq_gr gr1 gr2 =
+ match gr1,gr2 with
+ ConstRef con1, ConstRef con2 ->
+ eq_constant con1 con2
+ | IndRef kn1,IndRef kn2 -> eq_ind kn1 kn2
+ | ConstructRef kn1,ConstructRef kn2 -> eq_constructor kn1 kn2
+ | _,_ -> gr1=gr2
+
let destVarRef = function VarRef ind -> ind | _ -> failwith "destVarRef"
let destConstRef = function ConstRef ind -> ind | _ -> failwith "destConstRef"
let destIndRef = function IndRef ind -> ind | _ -> failwith "destIndRef"
let destConstructRef = function ConstructRef ind -> ind | _ -> failwith "destConstructRef"
let subst_constructor subst ((kn,i),j as ref) =
- let kn' = subst_kn subst kn in
+ let kn' = subst_ind subst kn in
if kn==kn' then ref, mkConstruct ref
else ((kn',i),j), mkConstruct ((kn',i),j)
@@ -43,7 +51,7 @@ let subst_global subst ref = match ref with
let kn',t = subst_con subst kn in
if kn==kn' then ref, mkConst kn else ConstRef kn', t
| IndRef (kn,i) ->
- let kn' = subst_kn subst kn in
+ let kn' = subst_ind subst kn in
if kn==kn' then ref, mkInd (kn,i) else IndRef(kn',i), mkInd (kn',i)
| ConstructRef ((kn,i),j as c) ->
let c',t = subst_constructor subst c in
@@ -65,15 +73,25 @@ let constr_of_global = function
let constr_of_reference = constr_of_global
let reference_of_constr = global_of_constr
-module RefOrdered =
- struct
- type t = global_reference
- let compare = Pervasives.compare
- end
-
+(* outside of the kernel, names are ordered on their canonical part *)
+module RefOrdered = struct
+ type t = global_reference
+ let compare x y =
+ let make_name = function
+ | ConstRef con ->
+ ConstRef(constant_of_kn(canonical_con con))
+ | IndRef (kn,i) ->
+ IndRef(mind_of_kn(canonical_mind kn),i)
+ | ConstructRef ((kn,i),j )->
+ ConstructRef((mind_of_kn(canonical_mind kn),i),j)
+ | VarRef id -> VarRef id
+ in
+ Pervasives.compare (make_name x) (make_name y)
+end
+
module Refset = Set.Make(RefOrdered)
module Refmap = Map.Make(RefOrdered)
-
+
(* Extended global references *)
type syndef_name = kernel_name
@@ -191,26 +209,22 @@ let restrict_path n sp =
let dir' = list_firstn n (repr_dirpath dir) in
make_path (make_dirpath dir') s
-let encode_kn dir id = make_kn (MPfile dir) empty_dirpath (label_of_id id)
+let encode_mind dir id = make_mind (MPfile dir) empty_dirpath (label_of_id id)
let encode_con dir id = make_con (MPfile dir) empty_dirpath (label_of_id id)
-let decode_kn kn =
- let rec dirpath_of_module = function
+let decode_mind kn =
+ let rec dir_of_mp = function
| MPfile dir -> repr_dirpath dir
- | MPbound mbid ->
+ | MPbound mbid ->
let _,_,dp = repr_mbid mbid in
let id = id_of_mbid mbid in
id::(repr_dirpath dp)
- | MPself msid ->
- let _,_,dp = repr_msid msid in
- let id = id_of_msid msid in
- id::(repr_dirpath dp)
- | MPdot(mp,l) -> (id_of_label l)::(dirpath_of_module mp)
+ | MPdot(mp,l) -> (id_of_label l)::(dir_of_mp mp)
in
- let mp,sec_dir,l = repr_kn kn in
+ let mp,sec_dir,l = repr_mind kn in
if (repr_dirpath sec_dir) = [] then
- (make_dirpath (dirpath_of_module mp)),id_of_label l
+ (make_dirpath (dir_of_mp mp)),id_of_label l
else
anomaly "Section part should be empty!"
@@ -289,8 +303,8 @@ let pop_con con =
Names.make_con mp (pop_dirpath dir) l
let pop_kn kn =
- let (mp,dir,l) = repr_kn kn in
- Names.make_kn mp (pop_dirpath dir) l
+ let (mp,dir,l) = repr_mind kn in
+ Names.make_mind mp (pop_dirpath dir) l
let pop_global_reference = function
| ConstRef con -> ConstRef (pop_con con)