Prise en compte des coercions dans les clauses "with" même si le type

de l'argument donné contient des métavariables (souhait
#1408). Beaucoup d'infrastructure autour des constantes pour cela mais
qu'on devrait pouvoir récupérer pour analyser plus finement le
comportement des constantes en général :

1- Pour insérer les coercions, on utilise une transformation
   (expérimentale) de Metas vers Evars le temps d'appeler coercion.ml.
2- Pour la compatibilité, on s'interdit d'insérer une coercion entre
   classes flexibles parce que sinon l'insertion de coercion peut prendre
   précédence sur la résolution des evars ce qui peut changer les 
   comportements (comme dans la preuve de fmg_cs_inv dans CFields de CoRN).
3- Pour se souvenir rapidement de la nature flexible ou rigide du
   symbole de tête d'une constante vis à vis de l'évaluation, on met en
   place une table associant à chaque constante sa constante de tête (heads.ml)
4- Comme la table des constantes de tête a besoin de connaître
   l'opacité des variables de section, la partie tables de declare.ml va
   dans un nouveau decls.ml.

Au passage, simplification de coercion.ml, correction de petits bugs
(l'interface de Gset.fold n'était pas assez générale; specialize 
 cherchait à typer un terme dans un mauvais contexte d'evars [tactics.ml];
 whd_betaiotazeta avait un argument env inutile [reduction.ml, inductive.ml])
 et nettoyage (declare.ml, decl_kinds.ml, avec incidence sur class.ml,
 classops.ml et autres ...; uniformisation noms tables dans autorewrite.ml).



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

1 files changed, 76 insertions, 0 deletions

diff --git a/library/decls.ml b/library/decls.ml
new file mode 100644
index 000000000..d84703271
--- /dev/null
+++ b/library/decls.ml
@@ -0,0 +1,76 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* $Id:$ *)
+
+(** This module registers tables for some non-logical informations
+     associated declarations *)
+
+open Names
+open Term
+open Sign
+open Decl_kinds
+open Libnames
+
+(** Datas associated to section variables and local definitions *)
+
+type variable_data =
+    dir_path * bool (* opacity *) * Univ.constraints * logical_kind
+
+let vartab = ref (Idmap.empty : variable_data Idmap.t)
+
+let _ = Summary.declare_summary "VARIABLE"
+  { Summary.freeze_function = (fun () -> !vartab);
+    Summary.unfreeze_function = (fun ft -> vartab := ft);
+    Summary.init_function = (fun () -> vartab := Idmap.empty);
+    Summary.survive_module = false;
+    Summary.survive_section = false }
+
+let add_variable_data id o = vartab := Idmap.add id o !vartab
+
+let variable_path id = let (p,_,_,_) = Idmap.find id !vartab in p
+let variable_opacity id = let (_,opaq,_,_) = Idmap.find id !vartab in opaq
+let variable_kind id = let (_,_,_,k) = Idmap.find id !vartab in k
+let variable_constraints id = let (_,_,cst,_) = Idmap.find id !vartab in cst
+
+let variable_exists id = Idmap.mem id !vartab
+
+(** Datas associated to global parameters and constants *)
+
+let csttab = ref (Cmap.empty : logical_kind Cmap.t)
+
+let _ = Summary.declare_summary "CONSTANT"
+	  { Summary.freeze_function = (fun () -> !csttab);
+	    Summary.unfreeze_function = (fun ft -> csttab := ft);
+	    Summary.init_function = (fun () -> csttab := Cmap.empty);
+	    Summary.survive_module = false;
+	    Summary.survive_section = false }
+
+let add_constant_kind kn k = csttab := Cmap.add kn k !csttab
+
+let constant_kind kn = Cmap.find kn !csttab
+
+(** Miscellaneous functions. *)
+
+let clear_proofs sign =
+  List.fold_right
+    (fun (id,c,t as d) signv -> 
+      let d = if variable_opacity id then (id,None,t) else d in
+      Environ.push_named_context_val d signv) sign Environ.empty_named_context_val
+
+let last_section_hyps dir =
+  fold_named_context
+    (fun (id,_,_) sec_ids ->
+      try if dir=variable_path id then id::sec_ids else sec_ids
+      with Not_found -> sec_ids)
+    (Environ.named_context (Global.env()))
+    ~init:[]
+
+let is_section_variable = function
+  | VarRef _ -> true
+  | _ -> false