aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormsozeau2008-04-21 13:57:03 +0000
committermsozeau2008-04-21 13:57:03 +0000
commit880a83169c1d1df8726d301a9f8a9fc845cc7d1e (patch)
tree11f101429c8d8759b11a5b6589ec28e70585abcd
parent6a8e2a2e13978b40f246563d7cfda0ec58370006 (diff)
- Parameterize unification by two sets of transparent_state, one for open
term unification (for constant and variable delta unfolding) and one to parameterize closed-term conversion. Most of the time conversion uses full delta and unification does no delta. This fine-grain is used in rewrite/setoid_rewrite, where only closed-term delta on global constants is allowed. - Interpret Hint Unfold as a directive for delta conversion in auto/eauto when applying lemmas (i.e., for Resolve and Immediate hints). - Remove ad-hoc support for this in typeclasses. Now setoid_rewrite works correctly w.r.t. the old version regarding local definitions. - Fix closed bugs which needed updating due to syntax modifications. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@10824 85f007b7-540e-0410-9357-904b9bb8a0f7
-rw-r--r--contrib/firstorder/sequent.ml2
-rw-r--r--contrib/funind/functional_principles_proofs.ml2
-rw-r--r--contrib/interface/blast.ml30
-rw-r--r--kernel/names.ml4
-rw-r--r--kernel/names.mli4
-rw-r--r--pretyping/unification.ml37
-rw-r--r--pretyping/unification.mli5
-rw-r--r--proofs/clenvtac.ml5
-rw-r--r--tactics/auto.ml74
-rw-r--r--tactics/auto.mli10
-rw-r--r--tactics/class_tactics.ml4220
-rw-r--r--tactics/eauto.ml418
-rw-r--r--tactics/eauto.mli2
-rw-r--r--tactics/setoid_replace.ml10
-rw-r--r--tactics/tactics.ml5
-rw-r--r--test-suite/bugs/closed/shouldsucceed/1411.v1
-rw-r--r--test-suite/bugs/closed/shouldsucceed/1634.v2
-rw-r--r--test-suite/bugs/closed/shouldsucceed/1784.v16
-rw-r--r--theories/Classes/Equivalence.v4
-rw-r--r--theories/Classes/SetoidClass.v2
20 files changed, 177 insertions, 276 deletions
diff --git a/contrib/firstorder/sequent.ml b/contrib/firstorder/sequent.ml
index fd5972fb74..e540058f14 100644
--- a/contrib/firstorder/sequent.ml
+++ b/contrib/firstorder/sequent.ml
@@ -281,7 +281,7 @@ let create_with_auto_hints l depth gl=
searchtable_map dbname
with Not_found->
error ("Firstorder: "^dbname^" : No such Hint database") in
- Hint_db.iter g hdb in
+ Hint_db.iter g (snd hdb) in
List.iter h l;
!seqref
diff --git a/contrib/funind/functional_principles_proofs.ml b/contrib/funind/functional_principles_proofs.ml
index c82e607d4e..895fa613fe 100644
--- a/contrib/funind/functional_principles_proofs.ml
+++ b/contrib/funind/functional_principles_proofs.ml
@@ -1400,7 +1400,7 @@ let new_prove_with_tcc is_mes acc_inv hrec tcc_hyps eqs : tactic =
false
(true,5)
[Lazy.force refl_equal]
- [Auto.Hint_db.empty]
+ [empty_transparent_state, Auto.Hint_db.empty]
)
)
)
diff --git a/contrib/interface/blast.ml b/contrib/interface/blast.ml
index 48caa3777c..4df6108b6f 100644
--- a/contrib/interface/blast.ml
+++ b/contrib/interface/blast.ml
@@ -161,7 +161,7 @@ let rec e_trivial_fail_db db_list local_db goal =
let d = pf_last_hyp g' in
let hintl = make_resolve_hyp (pf_env g') (project g') d in
(e_trivial_fail_db db_list
- (Hint_db.add_list hintl local_db) g'))) ::
+ (add_hint_list hintl local_db) g'))) ::
(List.map fst (e_trivial_resolve db_list local_db (pf_concl goal)) )
in
tclFIRST (List.map tclCOMPLETE tacl) goal
@@ -170,16 +170,16 @@ and e_my_find_search db_list local_db hdc concl =
let hdc = head_of_constr_reference hdc in
let hintl =
if occur_existential concl then
- list_map_append (Hint_db.map_all hdc) (local_db::db_list)
+ list_map_append (fun (st, db) -> List.map (fun x -> (st, x)) (Hint_db.map_all hdc db)) (local_db::db_list)
else
- list_map_append (Hint_db.map_auto (hdc,concl)) (local_db::db_list)
+ list_map_append (fun (st, db) -> List.map (fun x -> (st, x)) (Hint_db.map_auto (hdc,concl) db)) (local_db::db_list)
in
let tac_of_hint =
- fun ({pri=b; pat = p; code=t} as _patac) ->
+ fun (st, ({pri=b; pat = p; code=t} as _patac)) ->
(b,
let tac =
match t with
- | Res_pf (term,cl) -> unify_resolve (term,cl)
+ | Res_pf (term,cl) -> unify_resolve st (term,cl)
| ERes_pf (term,cl) -> unify_e_resolve (term,cl)
| Give_exact (c) -> e_give_exact_constr c
| Res_pf_THEN_trivial_fail (term,cl) ->
@@ -227,8 +227,8 @@ module MySearchProblem = struct
depth : int; (*r depth of search before failing *)
tacres : goal list sigma * validation;
last_tactic : std_ppcmds;
- dblist : Auto.Hint_db.t list;
- localdb : Auto.Hint_db.t list }
+ dblist : Auto.hint_db list;
+ localdb : Auto.hint_db list }
let success s = (sig_it (fst s.tacres)) = []
@@ -276,7 +276,7 @@ module MySearchProblem = struct
let hintl =
make_resolve_hyp (pf_env g') (project g') (pf_last_hyp g')
in
- let ldb = Hint_db.add_list hintl (List.hd s.localdb) in
+ let ldb = add_hint_list hintl (List.hd s.localdb) in
{ depth = s.depth; tacres = res;
last_tactic = pp; dblist = s.dblist;
localdb = ldb :: List.tl s.localdb })
@@ -372,7 +372,7 @@ let rec trivial_fail_db db_list local_db gl =
tclTHEN intro
(fun g'->
let hintl = make_resolve_hyp (pf_env g') (project g') (pf_last_hyp g')
- in trivial_fail_db db_list (Hint_db.add_list hintl local_db) g')
+ in trivial_fail_db db_list (add_hint_list hintl local_db) g')
in
tclFIRST
(assumption::intro_tac::
@@ -382,21 +382,21 @@ let rec trivial_fail_db db_list local_db gl =
and my_find_search db_list local_db hdc concl =
let tacl =
if occur_existential concl then
- list_map_append (fun db -> Hint_db.map_all hdc db) (local_db::db_list)
+ list_map_append (fun (st, db) -> List.map (fun x -> st, x) (Hint_db.map_all hdc db)) (local_db::db_list)
else
- list_map_append (fun db -> Hint_db.map_auto (hdc,concl) db)
+ list_map_append (fun (st, db) -> List.map (fun x -> st, x) (Hint_db.map_auto (hdc,concl) db))
(local_db::db_list)
in
List.map
- (fun ({pri=b; pat=p; code=t} as _patac) ->
+ (fun (st, {pri=b; pat=p; code=t} as _patac) ->
(b,
match t with
- | Res_pf (term,cl) -> unify_resolve (term,cl)
+ | Res_pf (term,cl) -> unify_resolve st (term,cl)
| ERes_pf (_,c) -> (fun gl -> error "eres_pf")
| Give_exact c -> exact_check c
| Res_pf_THEN_trivial_fail (term,cl) ->
tclTHEN
- (unify_resolve (term,cl))
+ (unify_resolve st (term,cl))
(trivial_fail_db db_list local_db)
| Unfold_nth c -> unfold_in_concl [[],c]
| Extern tacast ->
@@ -472,7 +472,7 @@ let rec search_gen decomp n db_list local_db extra_sign goal =
with Failure _ -> []
in
(free_try
- (search_gen decomp n db_list (Hint_db.add_list hintl local_db) [d])
+ (search_gen decomp n db_list (add_hint_list hintl local_db) [d])
g'))
in
let rec_tacs =
diff --git a/kernel/names.ml b/kernel/names.ml
index 60b5b6e421..38eb38beaf 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -317,6 +317,10 @@ let hcons_names () =
type transparent_state = Idpred.t * Cpred.t
+let empty_transparent_state = (Idpred.empty, Cpred.empty)
+let full_transparent_state = (Idpred.full, Cpred.full)
+let var_full_transparent_state = (Idpred.full, Cpred.empty)
+
type 'a tableKey =
| ConstKey of constant
| VarKey of identifier
diff --git a/kernel/names.mli b/kernel/names.mli
index 64edf1702e..340f6e812f 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -169,6 +169,10 @@ type 'a tableKey =
type transparent_state = Idpred.t * Cpred.t
+val empty_transparent_state : transparent_state
+val full_transparent_state : transparent_state
+val var_full_transparent_state : transparent_state
+
type inv_rel_key = int (* index in the [rel_context] part of environment
starting by the end, {\em inverse}
of de Bruijn indice *)
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index f11ed36dac..c5e9dff8b4 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -117,31 +117,28 @@ let sort_eqns = unify_r2l
*)
type unify_flags = {
- modulo_conv_on_closed_terms : bool;
+ modulo_conv_on_closed_terms : Names.transparent_state option;
use_metas_eagerly : bool;
- modulo_delta : Cpred.t;
- modulo_zeta : bool;
+ modulo_delta : Names.transparent_state;
}
let default_unify_flags = {
- modulo_conv_on_closed_terms = true;
+ modulo_conv_on_closed_terms = Some full_transparent_state;
use_metas_eagerly = true;
- modulo_delta = Cpred.full;
- modulo_zeta = true;
+ modulo_delta = full_transparent_state;
}
let default_no_delta_unify_flags = {
- modulo_conv_on_closed_terms = true;
+ modulo_conv_on_closed_terms = Some full_transparent_state;
use_metas_eagerly = true;
- modulo_delta = Cpred.empty;
- modulo_zeta = true;
+ modulo_delta = empty_transparent_state;
}
let expand_constant env flags c =
let (ids,csts) = Conv_oracle.freeze() in
match kind_of_term c with
- | Const cst when Cpred.mem cst csts && Cpred.mem cst flags.modulo_delta -> constant_opt_value env cst
- | Var id when flags.modulo_zeta && Idpred.mem id ids -> named_body id env
+ | Const cst when Cpred.mem cst csts && Cpred.mem cst (snd flags.modulo_delta) -> constant_opt_value env cst
+ | Var id when Idpred.mem id ids && Idpred.mem id (fst flags.modulo_delta) -> named_body id env
| _ -> None
let unify_0_with_initial_metas metas conv_at_top env sigma cv_pb flags m n =
@@ -149,9 +146,10 @@ let unify_0_with_initial_metas metas conv_at_top env sigma cv_pb flags m n =
let trivial_unify pb (metasubst,_) m n =
match subst_defined_metas metas m with
| Some m ->
- if flags.modulo_conv_on_closed_terms
- then is_fconv (conv_pb_of pb) env sigma m n
- else eq_constr m n
+ (match flags.modulo_conv_on_closed_terms with
+ Some flags ->
+ is_trans_fconv (conv_pb_of pb) flags env sigma m n
+ | None -> eq_constr m n)
| _ -> false in
let rec unirec_rec curenv pb b ((metasubst,evarsubst) as substn) curm curn =
let cM = Evarutil.whd_castappevar sigma curm
@@ -224,7 +222,7 @@ let unify_0_with_initial_metas metas conv_at_top env sigma cv_pb flags m n =
and expand curenv pb b substn cM f1 l1 cN f2 l2 =
if trivial_unify pb substn cM cN then substn
- else if b & not (Cpred.is_empty flags.modulo_delta) then
+ else if b then
match expand_constant curenv flags f1 with
| Some c ->
unirec_rec curenv pb b substn (whd_betaiotazeta (mkApp(c,l1))) cN
@@ -239,9 +237,10 @@ let unify_0_with_initial_metas metas conv_at_top env sigma cv_pb flags m n =
in
if (not(occur_meta m)) &&
- (if flags.modulo_conv_on_closed_terms
- then is_fconv (conv_pb_of cv_pb) env sigma m n
- else eq_constr m n)
+ (match flags.modulo_conv_on_closed_terms with
+ Some flags ->
+ is_trans_fconv (conv_pb_of cv_pb) flags env sigma m n
+ | None -> eq_constr m n)
then
(metas,[])
else
@@ -637,7 +636,7 @@ let w_unify_to_subterm_list env flags allow_K oplist t evd =
let secondOrderAbstraction env flags allow_K typ (p, oplist) evd =
(* Remove delta when looking for a subterm *)
- let flags = { flags with modulo_delta = Cpred.empty } in
+ let flags = { flags with modulo_delta = (fst flags.modulo_delta, Cpred.empty) } in
let (evd',cllist) =
w_unify_to_subterm_list env flags allow_K oplist typ evd in
let typp = Typing.meta_type evd' p in
diff --git a/pretyping/unification.mli b/pretyping/unification.mli
index 8e8168e5c9..9156623f50 100644
--- a/pretyping/unification.mli
+++ b/pretyping/unification.mli
@@ -15,10 +15,9 @@ open Evd
(*i*)
type unify_flags = {
- modulo_conv_on_closed_terms : bool;
+ modulo_conv_on_closed_terms : Names.transparent_state option;
use_metas_eagerly : bool;
- modulo_delta : Names.Cpred.t;
- modulo_zeta : bool;
+ modulo_delta : Names.transparent_state;
}
val default_unify_flags : unify_flags
diff --git a/proofs/clenvtac.ml b/proofs/clenvtac.ml
index c966e876f9..22dcca2890 100644
--- a/proofs/clenvtac.ml
+++ b/proofs/clenvtac.ml
@@ -96,10 +96,9 @@ let e_res_pf clenv = res_pf clenv ~with_evars:true ~allow_K:false ~flags:dft
open Unification
let fail_quick_unif_flags = {
- modulo_conv_on_closed_terms = true;
+ modulo_conv_on_closed_terms = Some full_transparent_state;
use_metas_eagerly = false;
- modulo_delta = Cpred.empty;
- modulo_zeta = true;
+ modulo_delta = empty_transparent_state;
}
(* let unifyTerms m n = walking (fun wc -> fst (w_Unify CONV m n [] wc)) *)
diff --git a/tactics/auto.ml b/tactics/auto.ml
index 00d7b8cb4c..2709502c67 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -137,14 +137,16 @@ end
module Hintdbmap = Gmap
-type frozen_hint_db_table = (string,Hint_db.t) Hintdbmap.t
+type hint_db = Names.transparent_state * Hint_db.t
-type hint_db_table = (string,Hint_db.t) Hintdbmap.t ref
+type frozen_hint_db_table = (string,hint_db) Hintdbmap.t
+
+type hint_db_table = (string,hint_db) Hintdbmap.t ref
type hint_db_name = string
let searchtable = (ref Hintdbmap.empty : hint_db_table)
-
+
let searchtable_map name =
Hintdbmap.find name !searchtable
let searchtable_add (name,db) =
@@ -277,18 +279,32 @@ open Vernacexpr
(* declaration of the AUTOHINT library object *)
(**************************************************************************)
+let add_hint_list hintlist (st,db) =
+ let db' = Hint_db.add_list hintlist db in
+ let st' =
+ List.fold_left
+ (fun (ids, csts as st) (_, hint) ->
+ match hint.code with
+ | Unfold_nth egr ->
+ (match egr with
+ | EvalVarRef id -> (Idpred.add id ids, csts)
+ | EvalConstRef cst -> (ids, Cpred.add cst csts))
+ | _ -> st)
+ st hintlist
+ in (st', db')
+
(* If the database does not exist, it is created *)
(* TODO: should a warning be printed in this case ?? *)
let add_hint dbname hintlist =
try
let db = searchtable_map dbname in
- let db' = Hint_db.add_list hintlist db in
+ let db' = add_hint_list hintlist db in
searchtable_add (dbname,db')
with Not_found ->
- let db = Hint_db.add_list hintlist Hint_db.empty in
+ let db = add_hint_list hintlist (empty_transparent_state, Hint_db.empty) in
searchtable_add (dbname,db)
-let cache_autohint (_,(local,name,hintlist)) = add_hint name hintlist
+let cache_autohint (_,(local,name,hints)) = add_hint name hints
let forward_subst_tactic =
ref (fun _ -> failwith "subst_tactic is not installed for auto")
@@ -476,7 +492,7 @@ let fmt_hint_list_for_head c =
let dbs = Hintdbmap.to_list !searchtable in
let valid_dbs =
map_succeed
- (fun (name,db) -> (name,db,Hint_db.map_all c db))
+ (fun (name,(_,db)) -> (name,db,Hint_db.map_all c db))
dbs
in
if valid_dbs = [] then
@@ -502,11 +518,11 @@ let fmt_hint_term cl =
let valid_dbs =
if occur_existential cl then
map_succeed
- (fun (name, db) -> (name, db, Hint_db.map_all hd db))
+ (fun (name, (_, db)) -> (name, db, Hint_db.map_all hd db))
dbs
else
map_succeed
- (fun (name, db) ->
+ (fun (name, (_, db)) ->
(name, db, Hint_db.map_auto (hd,applist(hdc,args)) db))
dbs
in
@@ -537,14 +553,14 @@ let print_hint_db db =
let print_hint_db_by_name dbname =
try
- let db = searchtable_map dbname in print_hint_db db
+ let db = snd (searchtable_map dbname) in print_hint_db db
with Not_found ->
error (dbname^" : No such Hint database")
(* displays all the hints of all databases *)
let print_searchtable () =
Hintdbmap.iter
- (fun name db ->
+ (fun name (_, db) ->
msg (str "In the database " ++ str name ++ fnl ());
print_hint_db db)
!searchtable
@@ -565,17 +581,16 @@ let priority l = List.map snd (List.filter (fun (pr,_) -> pr = 0) l)
open Unification
let auto_unif_flags = {
- modulo_conv_on_closed_terms = true;
+ modulo_conv_on_closed_terms = Some full_transparent_state;
use_metas_eagerly = false;
- modulo_delta = Cpred.empty;
- modulo_zeta = true;
+ modulo_delta = empty_transparent_state;
}
(* Try unification with the precompiled clause, then use registered Apply *)
-let unify_resolve (c,clenv) gls =
+let unify_resolve st (c,clenv) gls =
let clenv' = connect_clenv gls clenv in
- let _ = clenv_unique_resolver false ~flags:auto_unif_flags clenv' gls in
+ let _ = clenv_unique_resolver false ~flags:{auto_unif_flags with modulo_delta = st} clenv' gls in
h_simplest_apply c gls
(* builds a hint database from a constr signature *)
@@ -585,7 +600,7 @@ let make_local_hint_db eapply lems g =
let sign = pf_hyps g in
let hintlist = list_map_append (pf_apply make_resolve_hyp g) sign in
let hintlist' = list_map_append (pf_apply make_resolves g (eapply,false) None) lems in
- Hint_db.add_list hintlist' (Hint_db.add_list hintlist Hint_db.empty)
+ (empty_transparent_state, Hint_db.add_list hintlist' (Hint_db.add_list hintlist Hint_db.empty))
(* Serait-ce possible de compiler d'abord la tactique puis de faire la
substitution sans passer par bdize dont l'objectif est de préparer un
@@ -623,7 +638,7 @@ let rec trivial_fail_db db_list local_db gl =
tclTHEN intro
(fun g'->
let hintl = make_resolve_hyp (pf_env g') (project g') (pf_last_hyp g')
- in trivial_fail_db db_list (Hint_db.add_list hintl local_db) g')
+ in trivial_fail_db db_list (add_hint_list hintl local_db) g')
in
tclFIRST
(assumption::intro_tac::
@@ -633,21 +648,24 @@ let rec trivial_fail_db db_list local_db gl =
and my_find_search db_list local_db hdc concl =
let tacl =
if occur_existential concl then
- list_map_append (fun db -> Hint_db.map_all hdc db) (local_db::db_list)
+ list_map_append
+ (fun (st, db) -> List.map (fun x -> (st,x)) (Hint_db.map_all hdc db))
+ (local_db::db_list)
else
- list_map_append (fun db -> Hint_db.map_auto (hdc,concl) db)
+ list_map_append (fun (st, db) ->
+ List.map (fun x -> (st,x)) (Hint_db.map_auto (hdc,concl) db))
(local_db::db_list)
in
- List.map
- (fun {pri=b; pat=p; code=t} ->
- (b,
+ List.map
+ (fun (st, {pri=b; pat=p; code=t}) ->
+ (b,
match t with
- | Res_pf (term,cl) -> unify_resolve (term,cl)
+ | Res_pf (term,cl) -> unify_resolve st (term,cl)
| ERes_pf (_,c) -> (fun gl -> error "eres_pf")
| Give_exact c -> exact_check c
| Res_pf_THEN_trivial_fail (term,cl) ->
tclTHEN
- (unify_resolve (term,cl))
+ (unify_resolve st (term,cl))
(trivial_fail_db db_list local_db)
| Unfold_nth c -> unfold_in_concl [[],c]
| Extern tacast ->
@@ -749,7 +767,7 @@ let rec search_gen decomp n db_list local_db extra_sign goal =
(mkVar hid, htyp)]
with Failure _ -> []
in
- search_gen decomp n db_list (Hint_db.add_list hintl local_db) [d] g')
+ search_gen decomp n db_list (add_hint_list hintl local_db) [d] g')
in
let rec_tacs =
List.map
@@ -881,7 +899,7 @@ let rec super_search n db_list local_db argl goal =
(tclTHEN intro
(fun g ->
let hintl = pf_apply make_resolve_any_hyp g (pf_last_hyp g) in
- super_search n db_list (Hint_db.add_list hintl local_db)
+ super_search n db_list (add_hint_list hintl local_db)
argl g))
::
((List.map
@@ -899,7 +917,7 @@ let search_superauto n to_add argl g =
(fun (id,c) -> add_named_decl (id, None, pf_type_of g c))
to_add empty_named_context in
let db0 = list_map_append (make_resolve_hyp (pf_env g) (project g)) sigma in
- let db = Hint_db.add_list db0 (make_local_hint_db false [] g) in
+ let db = add_hint_list db0 (make_local_hint_db false [] g) in
super_search n [Hintdbmap.find "core" !searchtable] db argl g
let superauto n to_add argl =
diff --git a/tactics/auto.mli b/tactics/auto.mli
index 4fe9f03a90..bb22b6c81b 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -58,10 +58,14 @@ module Hint_db :
type hint_db_name = string
-val searchtable_map : hint_db_name -> Hint_db.t
+type hint_db = transparent_state * Hint_db.t
+
+val searchtable_map : hint_db_name -> hint_db
val current_db_names : unit -> hint_db_name list
+val add_hint_list : (global_reference * pri_auto_tactic) list -> hint_db -> hint_db
+
val add_hints : locality_flag -> hint_db_name list -> hints -> unit
val print_searchtable : unit -> unit
@@ -128,14 +132,14 @@ val set_extern_subst_tactic :
Useful to take the current goal hypotheses as hints;
Boolean tells if lemmas with evars are allowed *)
-val make_local_hint_db : bool -> constr list -> goal sigma -> Hint_db.t
+val make_local_hint_db : bool -> constr list -> goal sigma -> hint_db
val priority : (int * 'a) list -> 'a list
val default_search_depth : int ref
(* Try unification with the precompiled clause, then use registered Apply *)
-val unify_resolve : (constr * clausenv) -> tactic
+val unify_resolve : transparent_state -> (constr * clausenv) -> tactic
(* [ConclPattern concl pat tacast]:
if the term concl matches the pattern pat, (in sense of
diff --git a/tactics/class_tactics.ml4 b/tactics/class_tactics.ml4
index a1d978b1f9..b46d0e05e8 100644
--- a/tactics/class_tactics.ml4
+++ b/tactics/class_tactics.ml4
@@ -40,18 +40,18 @@ open Command
open Libnames
open Evd
-let check_required_library d =
+let check_imported_library d =
let d' = List.map id_of_string d in
let dir = make_dirpath (List.rev d') in
- if (* not (Library.library_is_opened dir) || *)not (Library.library_is_loaded dir) then
- error ("Library "^(list_last d)^" has to be required first")
-
+ if not (Library.library_is_loaded dir) then
+ error ("Library "^(list_last d)^" has to be imported first")
+
let classes_dirpath =
make_dirpath (List.map id_of_string ["Classes";"Coq"])
let init_setoid () =
if is_dirpath_prefix_of classes_dirpath (Lib.cwd ()) then ()
- else check_required_library ["Coq";"Setoids";"Setoid"]
+ else check_imported_library ["Coq";"Setoids";"Setoid"]
(** Typeclasses instance search tactic / eauto *)
@@ -67,21 +67,24 @@ let assumption id = e_give_exact (mkVar id)
open Unification
-let auto_unif_flags = ref {
- modulo_conv_on_closed_terms = true;
+let auto_unif_flags = {
+ modulo_conv_on_closed_terms = Some full_transparent_state;
use_metas_eagerly = true;
- modulo_delta = Cpred.empty;
- modulo_zeta = true;
+ modulo_delta = var_full_transparent_state;
}
-let unify_e_resolve (c,clenv) gls =
+let unify_e_resolve st (c,clenv) gls =
let clenv' = connect_clenv gls clenv in
- let clenv' = clenv_unique_resolver false ~flags:(!auto_unif_flags) clenv' gls in
+ let clenv' = clenv_unique_resolver false
+ ~flags:{auto_unif_flags with modulo_delta = st} clenv' gls
+ in
Clenvtac.clenv_refine true clenv' gls
-
-let unify_resolve (c,clenv) gls =
+
+let unify_resolve st (c,clenv) gls =
let clenv' = connect_clenv gls clenv in
- let clenv' = clenv_unique_resolver false ~flags:(!auto_unif_flags) clenv' gls in
+ let clenv' = clenv_unique_resolver false
+ ~flags:{auto_unif_flags with modulo_delta = st} clenv' gls
+ in
Clenvtac.clenv_refine false clenv' gls
let rec e_trivial_fail_db db_list local_db goal =
@@ -92,7 +95,7 @@ let rec e_trivial_fail_db db_list local_db goal =
let d = pf_last_hyp g' in
let hintl = make_resolve_hyp (pf_env g') (project g') d in
(e_trivial_fail_db db_list
- (Hint_db.add_list hintl local_db) g'))) ::
+ (add_hint_list hintl local_db) g'))) ::
(List.map pi1 (e_trivial_resolve db_list local_db (pf_concl goal)) )
in
tclFIRST (List.map tclCOMPLETE tacl) goal
@@ -101,19 +104,23 @@ and e_my_find_search db_list local_db hdc concl =
let hdc = head_of_constr_reference hdc in
let hintl =
if occur_existential concl then
- list_map_append (Hint_db.map_all hdc) (local_db::db_list)
+ list_map_append
+ (fun (st, db) -> List.map (fun x -> (st, x)) (Hint_db.map_all hdc db))
+ (local_db::db_list)
else
- list_map_append (Hint_db.map_auto (hdc,concl)) (local_db::db_list)
+ list_map_append
+ (fun (st, db) -> List.map (fun x -> (st, x)) (Hint_db.map_auto (hdc,concl) db))
+ (local_db::db_list)
in
let tac_of_hint =
- fun {pri=b; pat = p; code=t} ->
+ fun (st, {pri=b; pat = p; code=t}) ->
let tac =
match t with
- | Res_pf (term,cl) -> unify_resolve (term,cl)
- | ERes_pf (term,cl) -> unify_e_resolve (term,cl)
+ | Res_pf (term,cl) -> unify_resolve st (term,cl)
+ | ERes_pf (term,cl) -> unify_e_resolve st (term,cl)
| Give_exact (c) -> e_give_exact c
| Res_pf_THEN_trivial_fail (term,cl) ->
- tclTHEN (unify_e_resolve (term,cl))
+ tclTHEN (unify_e_resolve st (term,cl))
(e_trivial_fail_db db_list local_db)
| Unfold_nth c -> unfold_in_concl [[],c]
| Extern tacast -> conclPattern concl
@@ -144,9 +151,8 @@ type search_state = {
tacres : goal list sigma * validation;
pri : int;
last_tactic : std_ppcmds;
-(* filter : constr -> constr -> bool; *)
- dblist : Auto.Hint_db.t list;
- localdb : Auto.Hint_db.t list }
+ dblist : Auto.hint_db list;
+ localdb : Auto.hint_db list }
let filter_hyp t =
match kind_of_term t with
@@ -215,7 +221,6 @@ module SearchProblem = struct
let nbgl = List.length (sig_it lg) in
assert (nbgl > 0);
let g = find_first_goal lg in
-(* let filt = s.filter (pf_concl g) in *)
let assumption_tacs =
let l =
filter_tactics s.tacres
@@ -314,7 +319,6 @@ let make_initial_state n gls dblist localdbs =
{ depth = n;
tacres = gls;
pri = 0;
-(* filter = filter; *)
last_tactic = (mt ());
dblist = dblist;
localdb = localdbs }
@@ -395,9 +399,6 @@ let has_undefined p evd =
(Evd.evars_of evd) false
let resolve_all_evars debug m env p oevd =
-(* let evd = resolve_all_evars_once ~tac debug m env p evd in *)
-(* if has_undefined p evd then raise Not_found *)
-(* else evd *)
try
let rec aux n evd =
if has_undefined p evd then
@@ -409,77 +410,12 @@ let resolve_all_evars debug m env p oevd =
in aux 3 oevd
with Not_found -> None
-(** Handling of the state of unfolded constants. *)
-
-open Libobject
-
-let freeze () = !auto_unif_flags.modulo_delta
-
-let unfreeze delta =
- auto_unif_flags := { !auto_unif_flags with modulo_delta = delta }
-
-let init () =
- auto_unif_flags := {
- modulo_conv_on_closed_terms = true;
- use_metas_eagerly = true;
- modulo_delta = Cpred.empty;
- modulo_zeta = true;
- }
-
-let _ =
- Summary.declare_summary "typeclasses_unfold"
- { Summary.freeze_function = freeze;
- Summary.unfreeze_function = unfreeze;
- Summary.init_function = init;
- Summary.survive_module = false;
- Summary.survive_section = true }
-
-let cache_autounfold (_,unfoldlist) =
- auto_unif_flags := { !auto_unif_flags with
- modulo_delta = Cpred.union !auto_unif_flags.modulo_delta unfoldlist }
-
-let subst_autounfold (_,subst,(unfoldlist as obj)) =
- let b, l' = Cpred.elements unfoldlist in
- let l'' = list_smartmap (fun x -> fst (Mod_subst.subst_con subst x)) l' in
- if l'' == l' then obj
- else
- let set = List.fold_right Cpred.add l'' Cpred.empty in
- if not b then set
- else Cpred.complement set
-
-let classify_autounfold (_,obj) = Substitute obj
-
-let export_autounfold obj =
- Some obj
-
-let (inAutoUnfold,outAutoUnfold) =
- declare_object
- {(default_object "AUTOUNFOLD") with
- cache_function = cache_autounfold;
- load_function = (fun _ -> cache_autounfold);
- subst_function = subst_autounfold;
- classify_function = classify_autounfold;
- export_function = export_autounfold }
-
-let cpred_of_list l =
- List.fold_right Cpred.add l Cpred.empty
-
VERNAC COMMAND EXTEND Typeclasses_Unfold_Settings
-| [ "Typeclasses" "unfold" constr_list(cl) ] -> [
- let csts =
- List.map
- (fun c ->
- let c = Constrintern.interp_constr Evd.empty (Global.env ()) c in
- match kind_of_term c with
- | Const c -> c
- | _ -> error "Not a constant reference")
- cl
- in
- Lib.add_anonymous_leaf (inAutoUnfold (cpred_of_list csts))
+| [ "Typeclasses" "unfold" reference_list(cl) ] -> [
+ add_hints true ["typeclass_instances"] (Vernacexpr.HintsUnfold cl)
]
END
-
(** Typeclass-based rewriting. *)
let respect_proj = lazy (mkConst (List.hd (Lazy.force morphism_class).cl_projs))
@@ -537,10 +473,7 @@ let arrow_morphism a b =
Lazy.force impl
else
mkApp(Lazy.force arrow, [|a;b|])
-(* mkLambda (Name (id_of_string "A"), a, *)
-(* mkLambda (Name (id_of_string "B"), b, *)
-(* mkProd (Anonymous, mkRel 2, mkRel 2))) *)
-
+
let setoid_refl pars x =
applistc (Lazy.force setoid_refl_proj) (pars @ [x])
@@ -666,10 +599,9 @@ type hypinfo = {
abs : (constr * types) option;
}
-let convertible env evd x y =
+let evd_convertible env evd x y =
try ignore(Evarconv.the_conv_x env x y evd); true
with _ -> false
- (* ignore(Reduction.conv env x y) *)
let decompose_setoid_eqhyp env sigma c left2right =
let ctype = Typing.type_of env sigma c in
@@ -684,7 +616,7 @@ let decompose_setoid_eqhyp env sigma c left2right =
let ty1, ty2 =
Typing.mtype_of env eqclause.evd c1, Typing.mtype_of env eqclause.evd c2
in
- if not (convertible env eqclause.evd ty1 ty2) then
+ if not (evd_convertible env eqclause.evd ty1 ty2) then
error "The term does not end with an applied homogeneous relation"
else
{ cl=eqclause; prf=(Clenv.clenv_value eqclause);
@@ -692,38 +624,22 @@ let decompose_setoid_eqhyp env sigma c left2right =
l2r=left2right; c1=c1; c2=c2; c=Some c; abs=None }
let rewrite_unif_flags = {
- Unification.modulo_conv_on_closed_terms = false;
+ Unification.modulo_conv_on_closed_terms = None;
Unification.use_metas_eagerly = true;
- Unification.modulo_delta = Cpred.empty;
- Unification.modulo_zeta = false;
+ Unification.modulo_delta = empty_transparent_state;
}
+let conv_transparent_state = (Idpred.empty, Cpred.full)
+
let rewrite2_unif_flags = {
- Unification.modulo_conv_on_closed_terms = true;
+ Unification.modulo_conv_on_closed_terms = Some conv_transparent_state;
Unification.use_metas_eagerly = true;
- Unification.modulo_delta = Cpred.empty;
- Unification.modulo_zeta = false;
+ Unification.modulo_delta = empty_transparent_state;
}
-(* let unification_rewrite c1 c2 cl but gl = *)
-(* let (env',c1) = *)
-(* try *)
-(* (\* ~flags:(false,true) to allow to mark occurrences that must not be *)
-(* rewritten simply by replacing them with let-defined definitions *)
-(* in the context *\) *)
-(* w_unify_to_subterm ~flags:rewrite_unif_flags (pf_env gl) (c1,but) cl.evd *)
-(* with *)
-(* Pretype_errors.PretypeError _ -> *)
-(* (\* ~flags:(true,true) to make Ring work (since it really *)
-(* exploits conversion) *\) *)
-(* w_unify_to_subterm ~flags:rewrite2_unif_flags *)
-(* (pf_env gl) (c1,but) cl.evd *)
-(* in *)
-(* let cl' = {cl with evd = env' } in *)
-(* let c2 = Clenv.clenv_nf_meta cl' c2 in *)
-(* check_evar_map_of_evars_defs env' ; *)
-(* env',Clenv.clenv_value cl', c1, c2 *)
-
+let convertible env evd x y =
+ Reductionops.is_trans_conv conv_transparent_state env (Evd.evars_of evd) x y
+
let allowK = true
let refresh_hypinfo env sigma hypinfo =
@@ -743,12 +659,7 @@ let unify_eqn env sigma hypinfo t =
let left = if l2r then c1 else c2 in
match abs with
Some _ ->
- (* Disallow unfolding of a local var. *)
- if isVar left || isVar t then
- if eq_constr left t then
- cl, c1, c2, car, rel
- else raise Not_found
- else if convertible env cl.evd left t then
+ if convertible env cl.evd left t then
cl, c1, c2, car, rel
else raise Not_found
| None ->
@@ -813,23 +724,6 @@ let unfold_all t =
| _ -> assert false)
| _ -> assert false
-(* let lift_cstr env sigma evars args cstr = *)
-(* let codom = *)
-(* match cstr with *)
-(* | Some c -> c *)
-(* | None -> *)
-(* let ty = Evarutil.e_new_evar evars env (new_Type ()) in *)
-(* let rel = Evarutil.e_new_evar evars env (mk_relation ty) in *)
-(* (ty, rel) *)
-(* in *)
-(* Array.fold_right *)
-(* (fun arg (car, rel) -> *)
-(* let ty = Typing.type_of env sigma arg in *)
-(* let car' = mkProd (Anonymous, ty, car) in *)
-(* let rel' = mkApp (Lazy.force pointwise_relation, [| ty; car; rel |]) in *)
-(* (car', rel')) *)
-(* args codom *)
-
let rec decomp_pointwise n c =
if n = 0 then c
else
@@ -1498,17 +1392,11 @@ let unification_rewrite l2r c1 c2 cl car rel but gl =
let prfty = Clenv.clenv_type cl' in
let cl' = { cl' with templval = mk_freelisted prf ; templtyp = mk_freelisted prfty } in
{cl=cl'; prf=(mkRel 1); car=car; rel=rel; l2r=l2r; c1=c1; c2=c2; c=None; abs=Some (prf, prfty)}
-(* if occur_meta prf then *)
-(* else *)
-(* {cl=cl'; prf=prf; rel=rel; l2r=l2r; c1=c1; c2=c2; c=None; abs=None} *)
let get_hyp gl c clause l2r =
-(* match kind_of_term (pf_type_of gl c) with *)
-(* Prod _ -> *)
- let hi = decompose_setoid_eqhyp (pf_env gl) (project gl) c l2r in
- let but = match clause with Some id -> pf_get_hyp_typ gl id | None -> pf_concl gl in
- unification_rewrite hi.l2r hi.c1 hi.c2 hi.cl hi.car hi.rel but gl
-(* | _ -> decompose_setoid_eqhyp (pf_env gl) (project gl) c l2r *)
+ let hi = decompose_setoid_eqhyp (pf_env gl) (project gl) c l2r in
+ let but = match clause with Some id -> pf_get_hyp_typ gl id | None -> pf_concl gl in
+ unification_rewrite hi.l2r hi.c1 hi.c2 hi.cl hi.car hi.rel but gl
let general_rewrite_flags = { under_lambdas = false; on_morphisms = false }
@@ -1556,9 +1444,6 @@ let setoid_reflexivity gl =
with Not_found ->
tclFAIL 0 (str" The relation " ++ Printer.pr_constr_env env rel ++ str" is not a declared reflexive relation")
gl
-
-(* let setoid_reflexivity gl = *)
-(* try_loaded setoid_reflexivity gl *)
let setoid_symmetry gl =
let env = pf_env gl in
@@ -1568,9 +1453,6 @@ let setoid_symmetry gl =
with Not_found ->
tclFAIL 0 (str" The relation " ++ Printer.pr_constr_env env rel ++ str" is not a declared symmetric relation")
gl
-
-(* let setoid_symmetry gl = *)
-(* try_loaded setoid_symmetry gl *)
let setoid_transitivity c gl =
let env = pf_env gl in
@@ -1582,9 +1464,6 @@ let setoid_transitivity c gl =
with Not_found ->
tclFAIL 0
(str" The relation " ++ Printer.pr_constr_env env rel ++ str" is not a declared transitive relation") gl
-
-(* let setoid_transitivity c gl = *)
-(* try_loaded (setoid_transitivity c) gl *)
let setoid_symmetry_in id gl =
let ctype = pf_type_of gl (mkVar id) in
@@ -1604,9 +1483,6 @@ let setoid_symmetry_in id gl =
tclTHENLIST [ intros; setoid_symmetry; apply (mkVar id); Tactics.assumption ] ]
gl
-(* let setoid_symmetry_in h gl = *)
-(* try_loaded (setoid_symmetry_in h) gl *)
-
let _ = Tactics.register_setoid_reflexivity setoid_reflexivity
let _ = Tactics.register_setoid_symmetry setoid_symmetry
let _ = Tactics.register_setoid_symmetry_in setoid_symmetry_in
diff --git a/tactics/eauto.ml4 b/tactics/eauto.ml4
index 5c59e8244a..0facf23939 100644
--- a/tactics/eauto.ml4
+++ b/tactics/eauto.ml4
@@ -103,7 +103,7 @@ let rec e_trivial_fail_db db_list local_db goal =
let d = pf_last_hyp g' in
let hintl = make_resolve_hyp (pf_env g') (project g') d in
(e_trivial_fail_db db_list
- (Hint_db.add_list hintl local_db) g'))) ::
+ (add_hint_list hintl local_db) g'))) ::
(List.map fst (e_trivial_resolve db_list local_db (pf_concl goal)) )
in
tclFIRST (List.map tclCOMPLETE tacl) goal
@@ -112,16 +112,16 @@ and e_my_find_search db_list local_db hdc concl =
let hdc = head_of_constr_reference hdc in
let hintl =
if occur_existential concl then
- list_map_append (Hint_db.map_all hdc) (local_db::db_list)
+ list_map_append (fun (st, db) -> List.map (fun x -> st, x) (Hint_db.map_all hdc db)) (local_db::db_list)
else
- list_map_append (Hint_db.map_auto (hdc,concl)) (local_db::db_list)
+ list_map_append (fun (st, db) -> List.map (fun x -> st, x) (Hint_db.map_auto (hdc,concl) db)) (local_db::db_list)
in
let tac_of_hint =
- fun {pri=b; pat = p; code=t} ->
+ fun (st, {pri=b; pat = p; code=t}) ->
(b,
let tac =
match t with
- | Res_pf (term,cl) -> unify_resolve (term,cl)
+ | Res_pf (term,cl) -> unify_resolve st (term,cl)
| ERes_pf (term,cl) -> unify_e_resolve (term,cl)
| Give_exact (c) -> e_give_exact_constr c
| Res_pf_THEN_trivial_fail (term,cl) ->
@@ -168,8 +168,8 @@ type search_state = {
depth : int; (*r depth of search before failing *)
tacres : goal list sigma * validation;
last_tactic : std_ppcmds;
- dblist : Auto.Hint_db.t list;
- localdb : Auto.Hint_db.t list }
+ dblist : Auto.hint_db list;
+ localdb : Auto.hint_db list }
module SearchProblem = struct
@@ -235,7 +235,7 @@ module SearchProblem = struct
make_resolve_hyp (pf_env g') (project g') (pf_last_hyp g')
in
- let ldb = Hint_db.add_list hintl (match s.localdb with [] -> assert false | hd :: _ -> hd) in
+ let ldb = add_hint_list hintl (List.hd s.localdb) in
{ depth = s.depth; tacres = res;
last_tactic = pp; dblist = s.dblist;
localdb = ldb :: List.tl s.localdb })
@@ -255,7 +255,7 @@ module SearchProblem = struct
{ depth = pred s.depth; tacres = res;
dblist = s.dblist; last_tactic = pp;
localdb =
- list_addn (nbgl'-nbgl) (match s.localdb with [] -> assert false | hd :: _ -> hd) s.localdb })
+ list_addn (nbgl'-nbgl) (List.hd s.localdb) s.localdb })
l
in
List.sort compare (assumption_tacs @ intro_tac @ rec_tacs)
diff --git a/tactics/eauto.mli b/tactics/eauto.mli
index d1883aa664..1c6f9920fa 100644
--- a/tactics/eauto.mli
+++ b/tactics/eauto.mli
@@ -34,4 +34,4 @@ val gen_eauto : bool -> bool * int -> constr list ->
val eauto_with_bases :
bool ->
bool * int ->
- Term.constr list -> Auto.Hint_db.t list -> Proof_type.tactic
+ Term.constr list -> Auto.hint_db list -> Proof_type.tactic
diff --git a/tactics/setoid_replace.ml b/tactics/setoid_replace.ml
index e3c4e26493..b19df1aee9 100644
--- a/tactics/setoid_replace.ml
+++ b/tactics/setoid_replace.ml
@@ -1732,17 +1732,15 @@ let check_evar_map_of_evars_defs evd =
returns the modified objects (in particular [c1] and [c2]) *)
let rewrite_unif_flags = {
- modulo_conv_on_closed_terms = false;
+ modulo_conv_on_closed_terms = None;
use_metas_eagerly = true;
- modulo_delta = Cpred.empty;
- modulo_zeta = false;
+ modulo_delta = empty_transparent_state;
}
let rewrite2_unif_flags = {
- modulo_conv_on_closed_terms = true;
+ modulo_conv_on_closed_terms = Some full_transparent_state;
use_metas_eagerly = true;
- modulo_delta = Cpred.empty;
- modulo_zeta = false;
+ modulo_delta = empty_transparent_state;
}
let unification_rewrite c1 c2 cl but gl =
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 9eec0c0645..34c2f690c0 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -549,10 +549,9 @@ let last_arg c = match kind_of_term c with
| _ -> anomaly "last_arg"
let elim_flags = {
- modulo_conv_on_closed_terms = true;
+ modulo_conv_on_closed_terms = Some full_transparent_state;
use_metas_eagerly = true;
- modulo_delta = Cpred.empty;
- modulo_zeta = true;
+ modulo_delta = empty_transparent_state;
}
let elimination_clause_scheme with_evars allow_K elimclause indclause gl =
diff --git a/test-suite/bugs/closed/shouldsucceed/1411.v b/test-suite/bugs/closed/shouldsucceed/1411.v
index bb475bdc2a..e330d46fd1 100644
--- a/test-suite/bugs/closed/shouldsucceed/1411.v
+++ b/test-suite/bugs/closed/shouldsucceed/1411.v
@@ -1,4 +1,5 @@
Require Import List.
+Require Import Program.
Inductive Tree : Set :=
| Br : Tree -> Tree -> Tree
diff --git a/test-suite/bugs/closed/shouldsucceed/1634.v b/test-suite/bugs/closed/shouldsucceed/1634.v
index 205e827982..e0c540f36e 100644
--- a/test-suite/bugs/closed/shouldsucceed/1634.v
+++ b/test-suite/bugs/closed/shouldsucceed/1634.v
@@ -10,7 +10,7 @@ Hypothesis Seq_sym : forall {a:A} (x y : S a), Seq x y -> Seq y x.
Hypothesis Seq_trans : forall {a:A} (x y z : S a), Seq x y -> Seq y z ->
Seq x z.
-Add Relation (S a) Seq
+Add Parametric Relation a : (S a) Seq
reflexivity proved by Seq_refl
symmetry proved by Seq_sym
transitivity proved by Seq_trans
diff --git a/test-suite/bugs/closed/shouldsucceed/1784.v b/test-suite/bugs/closed/shouldsucceed/1784.v
index 12c92a8f7f..d6b7660b2d 100644
--- a/test-suite/bugs/closed/shouldsucceed/1784.v
+++ b/test-suite/bugs/closed/shouldsucceed/1784.v
@@ -85,17 +85,17 @@ Program Fixpoint lt_dec (x y:sv) { struct x } : {slt x y}+{~slt x y} :=
end
end.
-Next Obligation. intro; apply H; inversion H0; subst; trivial. Defined.
-Next Obligation. intro; inversion H. Defined.
-Next Obligation. intro H; inversion H. Defined.
-Next Obligation. intro; inversion H; subst. Defined.
+Next Obligation. apply H; inversion H0; subst; trivial. reflexivity. Defined.
+Next Obligation. inversion H. Defined.
+Next Obligation. inversion H. Defined.
+Next Obligation. inversion H; subst. Defined.
Next Obligation.
- contradict H. inversion H; subst. assumption.
+ contradict H. inversion H1; subst. assumption.
contradict H0; assumption. Defined.
Next Obligation.
- contradict H0. inversion H0; subst. assumption. Defined.
+ contradict H0. inversion H1; subst. assumption. Defined.
Next Obligation.
- contradict H. inversion H; subst. assumption. Defined.
+ contradict H. inversion H0; subst. assumption. Defined.
Next Obligation.
- contradict H. inversion H; subst; auto. Defined.
+ contradict H. inversion H0; subst; auto. Defined.
diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v
index 5e34a44379..23af8a744e 100644
--- a/theories/Classes/Equivalence.v
+++ b/theories/Classes/Equivalence.v
@@ -30,7 +30,7 @@ Open Local Scope signature_scope.
Definition equiv [ Equivalence A R ] : relation A := R.
-Typeclasses unfold @equiv.
+Typeclasses unfold equiv.
(** Overloaded notations for setoid equivalence and inequivalence. Not to be confused with [eq] and [=]. *)
@@ -44,7 +44,7 @@ Open Local Scope equiv_scope.
Definition pequiv [ PER A R ] : relation A := R.
-Typeclasses unfold @pequiv.
+Typeclasses unfold pequiv.
(** Overloaded notation for partial equivalence. *)
diff --git a/theories/Classes/SetoidClass.v b/theories/Classes/SetoidClass.v
index 526264612f..3220f599c6 100644
--- a/theories/Classes/SetoidClass.v
+++ b/theories/Classes/SetoidClass.v
@@ -31,7 +31,7 @@ Class Setoid A :=
equiv : relation A ;
setoid_equiv :> Equivalence A equiv.
-Typeclasses unfold @equiv.
+Typeclasses unfold equiv.
(* Too dangerous instance *)
(* Program Instance [ eqa : Equivalence A eqA ] => *)