aboutsummaryrefslogtreecommitdiff
path: root/plugins
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2020-09-22 10:44:51 +0200
committerPierre-Marie Pédrot2020-10-21 12:19:02 +0200
commit2b91a8989687e152f7120aa6c907ffeba8495bab (patch)
tree0fd0362eccc5c894b08c65147f0229fcdc8d2814 /plugins
parent8f16b1c5b97411b7ea88279699f0f410f1c77723 (diff)
Deprecate the non-qualified equality functions on kerpairs.
This allows to quickly spot the parts of the code that rely on the canonical ordering. When possible we directly introduce the quotient-aware versions.
Diffstat (limited to 'plugins')
-rw-r--r--plugins/extraction/extraction.ml2
-rw-r--r--plugins/extraction/table.ml2
-rw-r--r--plugins/funind/functional_principles_proofs.ml2
-rw-r--r--plugins/funind/functional_principles_types.ml4
-rw-r--r--plugins/funind/gen_principle.ml7
-rw-r--r--plugins/funind/invfun.ml3
-rw-r--r--plugins/ltac/rewrite.ml2
-rw-r--r--plugins/ssrmatching/ssrmatching.ml6
8 files changed, 15 insertions, 13 deletions
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index 2dca1d5e49..6869f9c47e 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -741,7 +741,7 @@ and extract_cst_app env sg mle mlt kn args =
(* Can we instantiate types variables for this constant ? *)
(* In Ocaml, inside the definition of this constant, the answer is no. *)
let instantiated =
- if lang () == Ocaml && List.mem_f Constant.equal kn !current_fixpoints
+ if lang () == Ocaml && List.mem_f Constant.CanOrd.equal kn !current_fixpoints
then var2var' (snd schema)
else instantiation schema
in
diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml
index f8449bcda1..e56d66ca2d 100644
--- a/plugins/extraction/table.ml
+++ b/plugins/extraction/table.ml
@@ -32,7 +32,7 @@ module Refset' = GlobRef.Set_env
let occur_kn_in_ref kn = let open GlobRef in function
| IndRef (kn',_)
- | ConstructRef ((kn',_),_) -> MutInd.equal kn kn'
+ | ConstructRef ((kn',_),_) -> MutInd.CanOrd.equal kn kn'
| ConstRef _ | VarRef _ -> false
let repr_of_r = let open GlobRef in function
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index e50c6087bb..73eb943418 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -674,7 +674,7 @@ let build_proof (interactive_proof : bool) (fnames : Constant.t list) ptes_infos
|Prod _ ->
let new_infos = {dyn_infos with info = (f, args)} in
build_proof_args env sigma do_finalize new_infos
- | Const (c, _) when not (List.mem_f Constant.equal c fnames) ->
+ | Const (c, _) when not (List.mem_f Constant.CanOrd.equal c fnames) ->
let new_infos = {dyn_infos with info = (f, args)} in
(* Pp.msgnl (str "proving in " ++ pr_lconstr_env (pf_env g) dyn_infos.info); *)
build_proof_args env sigma do_finalize new_infos
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 1ab747ca09..0ab9ac65d7 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -100,8 +100,8 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
let pre_princ = substl (List.map mkVar ptes_vars) pre_princ in
let is_dom c =
match Constr.kind c with
- | Ind ((u, _), _) -> MutInd.equal u rel_as_kn
- | Construct (((u, _), _), _) -> MutInd.equal u rel_as_kn
+ | Ind ((u, _), _) -> Environ.QMutInd.equal env u rel_as_kn
+ | Construct (((u, _), _), _) -> Environ.QMutInd.equal env u rel_as_kn
| _ -> false
in
let get_fun_num c =
diff --git a/plugins/funind/gen_principle.ml b/plugins/funind/gen_principle.ml
index 012fcee486..314c8abcaf 100644
--- a/plugins/funind/gen_principle.ml
+++ b/plugins/funind/gen_principle.ml
@@ -1316,9 +1316,9 @@ let make_scheme evd (fas : (Constr.pconstant * Sorts.family) list) : _ list =
let prop_sort = Sorts.InProp in
let funs_indexes =
let this_block_funs_indexes = Array.to_list this_block_funs_indexes in
+ let eq c1 c2 = Environ.QConstant.equal env c1 c2 in
List.map
- (function
- | cst -> List.assoc_f Constant.equal (fst cst) this_block_funs_indexes)
+ (function cst -> List.assoc_f eq (fst cst) this_block_funs_indexes)
funs
in
let ind_list =
@@ -2228,7 +2228,8 @@ let build_case_scheme fa =
let prop_sort = Sorts.InProp in
let funs_indexes =
let this_block_funs_indexes = Array.to_list this_block_funs_indexes in
- List.assoc_f Constant.equal funs this_block_funs_indexes
+ let eq c1 c2 = Environ.QConstant.equal env c1 c2 in
+ List.assoc_f eq funs this_block_funs_indexes
in
let ind, sf =
let ind = (first_fun_kn, funs_indexes) in
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 5d631aac84..118a917381 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -27,12 +27,13 @@ open Indfun_common
*)
let revert_graph kn post_tac hid =
Proofview.Goal.enter (fun gl ->
+ let env = Proofview.Goal.env gl in
let sigma = project gl in
let typ = pf_get_hyp_typ hid gl in
match EConstr.kind sigma typ with
| App (i, args) when isInd sigma i ->
let ((kn', num) as ind'), u = destInd sigma i in
- if MutInd.equal kn kn' then
+ if Environ.QMutInd.equal env kn kn' then
(* We have generated a graph hypothesis so that we must change it if we can *)
let info =
match find_Function_of_graph ind' with
diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml
index 5ef76dbdc1..3e4a96b10d 100644
--- a/plugins/ltac/rewrite.ml
+++ b/plugins/ltac/rewrite.ml
@@ -968,7 +968,7 @@ let fold_match ?(force=false) env sigma c =
let unfold_match env sigma sk app =
match EConstr.kind sigma app with
- | App (f', args) when Constant.equal (fst (destConst sigma f')) sk ->
+ | App (f', args) when QConstant.equal env (fst (destConst sigma f')) sk ->
let v = Environ.constant_value_in (Global.env ()) (sk,Univ.Instance.empty)(*FIXME*) in
let v = EConstr.of_constr v in
Reductionops.whd_beta env sigma (mkApp (v, args))
diff --git a/plugins/ssrmatching/ssrmatching.ml b/plugins/ssrmatching/ssrmatching.ml
index cdd15acb0d..bd514f15d5 100644
--- a/plugins/ssrmatching/ssrmatching.ml
+++ b/plugins/ssrmatching/ssrmatching.ml
@@ -463,8 +463,8 @@ let nb_cs_proj_args pc f u =
try match kind f with
| Prod _ -> na Prod_cs
| Sort s -> na (Sort_cs (Sorts.family s))
- | Const (c',_) when Constant.equal c' pc -> nargs_of_proj u.up_f
- | Proj (c',_) when Constant.equal (Projection.constant c') pc -> nargs_of_proj u.up_f
+ | Const (c',_) when Constant.CanOrd.equal c' pc -> nargs_of_proj u.up_f
+ | Proj (c',_) when Constant.CanOrd.equal (Projection.constant c') pc -> nargs_of_proj u.up_f
| Var _ | Ind _ | Construct _ | Const _ -> na (Const_cs (fst @@ destRef f))
| _ -> -1
with Not_found -> -1
@@ -508,7 +508,7 @@ let filter_upat i0 f n u fpats =
let () = if !i0 < np then i0 := n in (u, np) :: fpats
let eq_prim_proj c t = match kind t with
- | Proj(p,_) -> Constant.equal (Projection.constant p) c
+ | Proj(p,_) -> Constant.CanOrd.equal (Projection.constant p) c
| _ -> false
let filter_upat_FO i0 f n u fpats =