Integrate a few improvements on typeclasses and Program from the equations branch

and remove equations stuff which moves to a separate plugin.

Classes:
- Ability to define classes post-hoc from constants or inductive types.
- Correctly rebuild the hint database associated to local hypotheses when 
  they are changed by a [Hint Extern] in typeclass resolution.

Tactics and proofs:
- Change [revert] so that it keeps let-ins (but not [generalize]).
- Various improvements to the [generalize_eqs] tactic to make it more robust
  and produce the smallest proof terms possible.
  Move [specialize_hypothesis] in tactics.ml as it goes hand in hand with 
  [generalize_eqs].
- A few new general purpose tactics in Program.Tactics like [revert_until]
- Make transitive closure well-foundedness proofs transparent.
- More uniform testing for metas/evars in pretyping/unification.ml
  (might introduce a few changes in the contribs).

Program:
- Better sorting of dependencies in obligations.
- Ability to start a Program definition from just a type and no obligations, 
  automatically adding an obligation for this type.
- In compilation of Program's well-founded definitions, make the functional a
  separate definition for easier reasoning.
- Add a hint database for every Program populated by [Hint Unfold]s for 
  every defined obligation constant.


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

1 files changed, 30 insertions, 11 deletions

diff --git a/plugins/subtac/subtac_command.ml b/plugins/subtac/subtac_command.ml
index 937f7d0650..2a31d4e18d 100644
--- a/plugins/subtac/subtac_command.ml
+++ b/plugins/subtac/subtac_command.ml
@@ -234,11 +234,6 @@ let build_wellfounded (recname,n,bl,arityc,body) r measure notation boxed =
   let argtyp, letbinders, make = telescope binders_rel in
   let argname = id_of_string "recarg" in
   let arg = (Name argname, None, argtyp) in
-  let wrapper x =
-    if List.length binders_rel > 1 then
-      it_mkLambda_or_LetIn (mkApp (x, [|make|])) binders_rel
-    else x
-  in
   let binders = letbinders @ [arg] in
   let binders_env = push_rel_context binders_rel env in
   let rel = interp_constr isevars env r in
@@ -310,22 +305,46 @@ let build_wellfounded (recname,n,bl,arityc,body) r measure notation boxed =
   in
   let intern_body_lam = it_mkLambda_or_LetIn intern_body (curry_fun :: lift_lets @ fun_bl) in
   let prop = mkLambda (Name argname, argtyp, top_arity_let) in
-  let fix_def =
+  let def =
     mkApp (constr_of_global (Lazy.force fix_sub_ref),
 	  [| argtyp ; wf_rel ;
 	     make_existential dummy_loc ~opaque:(Define false) env isevars wf_proof ;
 	     prop ; intern_body_lam |])
   in
-  let def = wrapper fix_def in
-  let typ = it_mkProd_or_LetIn top_arity binders_rel in
+  let hook, recname, typ = 
+    if List.length binders_rel > 1 then
+      let name = add_suffix recname "_func" in
+      let hook l gr = 
+	let body = it_mkLambda_or_LetIn (mkApp (constr_of_global gr, [|make|])) binders_rel in
+	let ty = it_mkProd_or_LetIn top_arity binders_rel in
+	let ce =
+	  { const_entry_body = body;
+	    const_entry_type = Some ty;
+	    const_entry_opaque = false;
+	    const_entry_boxed = false} 
+	in 
+	let c = Declare.declare_constant recname (DefinitionEntry ce, IsDefinition Definition) in
+	let gr = ConstRef c in
+	  if Impargs.is_implicit_args () || impls <> [] then
+	    Impargs.declare_manual_implicits false gr impls
+      in
+      let typ = it_mkProd_or_LetIn top_arity binders in
+	hook, name, typ
+    else 
+      let typ = it_mkProd_or_LetIn top_arity binders_rel in
+      let hook l gr = 
+	if Impargs.is_implicit_args () || impls <> [] then
+	  Impargs.declare_manual_implicits false gr impls
+      in hook, recname, typ
+  in
   let _ = isevars := Evarutil.nf_evar_defs !isevars in
   let fullcoqc = Evarutil.nf_isevar !isevars def in
   let fullctyp = Evarutil.nf_isevar !isevars typ in
   let evm = evars_of_term !isevars Evd.empty fullctyp in
   let evm = evars_of_term !isevars evm fullcoqc in
   let evm = non_instanciated_map env isevars evm in
-  let evars, evars_def, evars_typ = Eterm.eterm_obligations env recname !isevars evm 0 fullcoqc fullctyp in
-    Subtac_obligations.add_definition recname evars_def evars_typ ~implicits:impls evars
+  let evars, _, evars_def, evars_typ = Eterm.eterm_obligations env recname !isevars evm 0 fullcoqc fullctyp in
+    Subtac_obligations.add_definition recname ~term:evars_def evars_typ evars ~hook
 
 let nf_evar_context isevars ctx =
   List.map (fun (n, b, t) ->
@@ -454,7 +473,7 @@ let interp_recursive fixkind l boxed =
     in
     let evm' = Subtac_utils.evars_of_term evm Evd.empty def in
     let evm' = Subtac_utils.evars_of_term evm evm' typ in
-    let evars, def, typ = Eterm.eterm_obligations env id isevars evm' recdefs def typ in
+    let evars, _, def, typ = Eterm.eterm_obligations env id isevars evm' recdefs def typ in
       (id, def, typ, imps, evars)
   in
   let defs = list_map4 collect_evars fixnames fixdefs fixtypes fiximps in