Prise en compte des let in dans les instances de globaux

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@976 85f007b7-540e-0410-9357-904b9bb8a0f7

3 files changed, 11 insertions, 6 deletions

diff --git a/kernel/sign.ml b/kernel/sign.ml
index 96531ef49..efdc08a3f 100644
--- a/kernel/sign.ml
+++ b/kernel/sign.ml
@@ -36,6 +36,10 @@ let pop_named_decl id = function
   | (id',_,_) :: sign -> assert (id = id'); sign
   | [] -> assert false
 let ids_of_named_context = List.map (fun (id,_,_) -> id)
+let rec instance_from_named_context = function
+  | (id,None,_) :: sign -> mkVar id :: instance_from_named_context sign
+  | _ :: sign -> instance_from_named_context sign
+  | [] -> []
 let map_named_context = map
 let rec mem_named_context id = function
   | (id',_,_) :: _ when id=id' -> true
@@ -98,8 +102,8 @@ let map_rel_context = map
 let instantiate_sign sign args =
   let rec instrec = function
     | ((id,None,_) :: sign, c::args) -> (id,c) :: (instrec (sign,args))
-    | ((id,Some c,_) :: sign, args)     -> (id,c) :: (instrec (sign,args))
-    | ([],[])                       -> []
+    | ((id,Some c,_) :: sign, args)  -> instrec (sign,args)
+    | ([],[])                        -> []
     | ([],_) | (_,[]) ->
     anomaly "Signature and its instance do not match"
   in 
diff --git a/kernel/sign.mli b/kernel/sign.mli
index 7ed3ae920..38d058042 100644
--- a/kernel/sign.mli
+++ b/kernel/sign.mli
@@ -34,6 +34,7 @@ val it_named_context_quantifier :
 val instantiate_sign :
   named_context -> constr list -> (identifier * constr) list
 val keep_hyps : Idset.t -> named_context -> named_context
+val instance_from_named_context : named_context -> constr list
 
 (*s Signatures of ordered optionally named variables, intended to be
    accessed by de Bruijn indices *)
diff --git a/library/declare.ml b/library/declare.ml
index 8aa6949e3..b3027a3a1 100644
--- a/library/declare.ml
+++ b/library/declare.ml
@@ -344,7 +344,7 @@ let constr_of_reference sigma env ref =
   let hyps = context_of_global_reference sigma env ref in
   let hyps0 = current_section_context () in
   let env0 = Environ.reset_context env in
-  let args = List.map mkVar (ids_of_named_context hyps) in
+  let args = instance_from_named_context hyps in
   let body = match ref with
     | EvarRef n -> mkEvar (n,Array.of_list args)
     | VarRef sp -> mkVar (basename sp)
@@ -392,7 +392,7 @@ let dirpath_of_global = function
 
 let is_global id =
   try 
-    let osp = Nametab.locate (make_qualid [] id) in
+    let osp = Nametab.locate (make_qualid [] (string_of_id id)) in
     list_prefix_of (dirpath_of_global osp) (Lib.cwd())
   with Not_found -> 
     false
@@ -426,8 +426,8 @@ let declare_eliminations sp i =
   if not (list_subset ids (ids_of_named_context (Global.named_context ()))) then
     error ("Declarations of elimination scheme outside the section "^
     "of the inductive definition is not implemented");
-  let ctxt = Array.of_list (List.map mkVar ids) in
-  let mispec = Global.lookup_mind_specif ((sp,i),ctxt) in 
+  let ctxt = instance_from_named_context mib.mind_hyps in
+  let mispec = Global.lookup_mind_specif ((sp,i),Array.of_list ctxt) in 
   let mindstr = string_of_id (mis_typename mispec) in
   let declare na c =
     declare_constant (id_of_string na)