Add a tactic to eliminate hprop trivial proofs

1 files changed, 15 insertions, 0 deletions

diff --git a/src/Util/HProp.v b/src/Util/HProp.v
index b85797176..273611fad 100644
--- a/src/Util/HProp.v
+++ b/src/Util/HProp.v
@@ -46,3 +46,18 @@ Global Instance ishprop_prod {A B} `{IsHProp A, IsHProp B} : IsHProp (A * B). ex
 Global Instance ishprop_and {A B : Prop} `{IsHProp A, IsHProp B} : IsHProp (A /\ B). exact _. Defined.
 Global Instance ishprop_sigT {A P} `{IsHProp A, forall a : A, IsHProp (P a)} : IsHProp (@sigT A P). exact _. Defined.
 Global Instance ishprop_sig {A} {P : A -> Prop} `{IsHProp A, forall a : A, IsHProp (P a)} : IsHProp (@sig A P). exact _. Defined.
+
+
+(** Tactics to eliminate proofs of type [x = x :> T] when [T] is an hProp. *)
+Ltac eliminate_hprop_eq_helper proof_of_eq hprop_hyp :=
+  assert (eq_refl = proof_of_eq) by apply hprop_hyp;
+  subst proof_of_eq.
+Ltac eliminate_hprop_eq_at T :=
+  let hprop_hyp := constr:(_ : IsHPropRel (@eq T)) in
+  repeat match goal with
+         | [ H : ?x = ?x :> T |- _ ] => eliminate_hprop_eq_helper H hprop_hyp
+         end.
+Ltac eliminate_hprop_eq :=
+  repeat match goal with
+         | [ H : ?x = ?x :> ?T |- _ ] => clear H || (progress eliminate_hprop_eq_at T)
+         end.