diff options
| author | msozeau | 2012-02-20 12:40:35 +0000 |
|---|---|---|
| committer | msozeau | 2012-02-20 12:40:35 +0000 |
| commit | 18ea9b8400e03b815f81fcff3c79459d2b5db1f6 (patch) | |
| tree | 8c6e95c724471aa7cc44803157b0150d08f4f0e1 /plugins/subtac/subtac_classes.ml | |
| parent | 18e6108339aaf18499c1c64f05655f442ab100f8 (diff) | |
Correct application of head reduction.
Fix a regression in subtac_pretyping, avoiding application of bidirectional application checking in
case the return type is a subset (bad interaction with typeclass overloading). Should be done only
on constructor applications.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@14985 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'plugins/subtac/subtac_classes.ml')
| -rw-r--r-- | plugins/subtac/subtac_classes.ml | 6 |
1 files changed, 5 insertions, 1 deletions
diff --git a/plugins/subtac/subtac_classes.ml b/plugins/subtac/subtac_classes.ml index 4b53a20385..cac0988c01 100644 --- a/plugins/subtac/subtac_classes.ml +++ b/plugins/subtac/subtac_classes.ml @@ -107,9 +107,11 @@ let new_instance ?(global=false) ctx (instid, bk, cl) props ?(generalize=true) p let i = Nameops.add_suffix (Classes.id_of_class k) "_instance_0" in Namegen.next_global_ident_away i (Termops.ids_of_context env) in - let env' = push_rel_context ctx env in evars := Typeclasses.mark_resolvables (Evarutil.nf_evar_map !evars); evars := resolve_typeclasses ~onlyargs:false ~fail:true env !evars; + let ctx = Evarutil.nf_rel_context_evar !evars ctx + and ctx' = Evarutil.nf_rel_context_evar !evars ctx' in + let env' = push_rel_context ctx env in let sigma = !evars in let subst = List.map (Evarutil.nf_evar sigma) subst in let props = @@ -157,6 +159,8 @@ let new_instance ?(global=false) ctx (instid, bk, cl) props ?(generalize=true) p Inl (type_ctx_instance evars (push_rel_context ctx' env') k.cl_props props subst) in evars := Evarutil.nf_evar_map !evars; + evars := Typeclasses.mark_resolvables !evars; + evars := resolve_typeclasses ~onlyargs:true ~fail:true env !evars; let term, termtype = match subst with | Inl subst -> |