aboutsummaryrefslogtreecommitdiff
path: root/src/Util/Decidable.v
diff options
context:
space:
mode:
authorGravatar Jason Gross <jagro@google.com>2016-07-29 12:26:12 -0700
committerGravatar Jason Gross <jagro@google.com>2016-07-29 12:42:33 -0700
commit74e7e2bb0b2414ea598b76a88c4a4550e2b3e554 (patch)
treef6de1c40836680b26c6101648c8756a862c70465 /src/Util/Decidable.v
parentad90f29cf77dc5f29a04941480a862f2f06923c2 (diff)
Add instances to decide equality of sigma types
After | File Name | Before || Change ------------------------------------------------------------------------------------ 2m49.20s | Total | 3m11.76s || -0m22.56s ------------------------------------------------------------------------------------ 0m35.37s | CompleteEdwardsCurve/ExtendedCoordinates | 0m47.05s || -0m11.67s 0m36.07s | Specific/GF25519 | 0m47.02s || -0m10.95s 0m03.24s | ModularArithmetic/ModularBaseSystemOpt | 0m05.04s || -0m01.79s 0m01.85s | Util/Tuple | 0m00.73s || +0m01.12s 0m01.75s | Util/Decidable | 0m00.63s || +0m01.12s 0m16.52s | CompleteEdwardsCurve/CompleteEdwardsCurveTheorems | 0m16.72s || -0m00.19s 0m16.26s | ModularArithmetic/ModularBaseSystemProofs | 0m16.72s || -0m00.45s 0m11.45s | Experiments/SpecEd25519 | 0m12.30s || -0m00.85s 0m07.37s | Specific/GF1305 | 0m07.57s || -0m00.20s 0m05.85s | Algebra | 0m05.78s || +0m00.06s 0m05.27s | WeierstrassCurve/Pre | 0m04.94s || +0m00.32s 0m03.94s | ModularArithmetic/Tutorial | 0m03.90s || +0m00.04s 0m03.50s | CompleteEdwardsCurve/Pre | 0m03.38s || +0m00.12s 0m01.99s | Experiments/EdDSARefinement | 0m02.07s || -0m00.07s 0m01.67s | ModularArithmetic/PrimeFieldTheorems | 0m01.64s || +0m00.03s 0m01.63s | ModularArithmetic/ModularArithmeticTheorems | 0m01.56s || +0m00.06s 0m01.59s | Encoding/PointEncodingPre | 0m02.01s || -0m00.41s 0m01.38s | ModularArithmetic/ExtendedBaseVector | 0m01.17s || +0m00.20s 0m01.05s | Util/IterAssocOp | 0m00.69s || +0m00.36s 0m00.96s | ModularArithmetic/ModularBaseSystemListProofs | 0m00.88s || +0m00.07s 0m00.95s | ModularArithmetic/ExtPow2BaseMulProofs | 0m00.71s || +0m00.24s 0m00.93s | Encoding/ModularWordEncodingPre | 0m00.62s || +0m00.31s 0m00.91s | ModularArithmetic/ModularBaseSystemField | 0m00.97s || -0m00.05s 0m00.89s | Experiments/DerivationsOptionRectLetInEncoding | 0m00.97s || -0m00.07s 0m00.72s | ModularArithmetic/ModularBaseSystemList | 0m00.64s || +0m00.07s 0m00.72s | Spec/ModularWordEncoding | 0m00.61s || +0m00.10s 0m00.72s | Spec/EdDSA | 0m00.69s || +0m00.03s 0m00.72s | Encoding/ModularWordEncodingTheorems | 0m00.99s || -0m00.27s 0m00.71s | Spec/WeierstrassCurve | 0m00.44s || +0m00.26s 0m00.71s | Experiments/SpecificCurve25519 | 0m00.70s || +0m00.01s 0m00.66s | Util/AdditionChainExponentiation | 0m00.62s || +0m00.04s 0m00.63s | ModularArithmetic/ModularBaseSystem | 0m00.63s || +0m00.00s 0m00.61s | ModularArithmetic/PseudoMersenneBaseParamProofs | 0m00.86s || -0m00.25s 0m00.42s | Spec/CompleteEdwardsCurve | 0m00.41s || +0m00.01s 0m00.20s | Util/Sum | 0m00.11s || +0m00.09s
Diffstat (limited to 'src/Util/Decidable.v')
-rw-r--r--src/Util/Decidable.v39
1 files changed, 37 insertions, 2 deletions
diff --git a/src/Util/Decidable.v b/src/Util/Decidable.v
index c2094c765..20ec7f0c9 100644
--- a/src/Util/Decidable.v
+++ b/src/Util/Decidable.v
@@ -1,6 +1,9 @@
(** Typeclass for decidable propositions *)
Require Import Coq.Logic.Eqdep_dec.
+Require Import Crypto.Util.Sigma.
+Require Import Crypto.Util.HProp.
+Require Import Crypto.Util.Equality.
Local Open Scope type_scope.
@@ -8,19 +11,48 @@ Class Decidable (P : Prop) := dec : {P} + {~P}.
Notation DecidableRel R := (forall x y, Decidable (R x y)).
+Global Instance hprop_eq_dec {A} `{DecidableRel (@eq A)} : IsHPropRel (@eq A) | 10.
+Proof. repeat intro; apply UIP_dec; trivial with nocore. Qed.
+
+Global Instance eq_dec_hprop {A} {x y : A} `{hp : IsHProp A} : Decidable (@eq A x y) | 5.
+Proof. left; apply hp. Qed.
+
+Ltac no_equalities_about x0 y0 :=
+ lazymatch goal with
+ | [ H' : x0 = y0 |- _ ] => fail
+ | [ H' : y0 = x0 |- _ ] => fail
+ | [ H' : x0 <> y0 |- _ ] => fail
+ | [ H' : y0 <> x0 |- _ ] => fail
+ | _ => idtac
+ end.
+
Ltac destruct_decidable_step :=
match goal with
| [ H : Decidable _ |- _ ] => destruct H
+ | [ H : forall x y : ?A, Decidable (x = y), x0 : ?A, y0 : ?A |- _ ]
+ => no_equalities_about x0 y0; destruct (H x0 y0)
+ | [ H : forall a0 (x y : _), Decidable (x = y), x0 : ?A, y0 : ?A |- _ ]
+ => no_equalities_about x0 y0; destruct (H _ x0 y0)
end.
Ltac destruct_decidable := repeat destruct_decidable_step.
+Ltac pre_decide_destruct_sigma_step :=
+ match goal with
+ | [ H : sigT _ |- _ ] => destruct H
+ | [ H : sig _ |- _ ] => destruct H
+ | [ H : ex _ |- _ ] => destruct H
+ end.
+Ltac pre_decide_destruct_sigma := repeat pre_decide_destruct_sigma_step.
+
Ltac pre_decide :=
repeat (intros
- || destruct_decidable
|| subst
+ || destruct_decidable
|| split
+ || pre_decide_destruct_sigma
|| unfold Decidable in *
- || hnf ).
+ || hnf
+ || pre_hprop).
Ltac solve_decidable_transparent_with tac :=
pre_decide;
@@ -31,6 +63,7 @@ Ltac solve_decidable_transparent_with tac :=
Ltac solve_decidable_transparent := solve_decidable_transparent_with firstorder.
Local Hint Extern 0 => solve [ solve_decidable_transparent ] : typeclass_instances.
+Local Hint Extern 1 => progress inversion_sigma : core.
Global Instance dec_True : Decidable True | 10 := left I.
Global Instance dec_False : Decidable False | 10 := right (fun x => x).
@@ -50,6 +83,8 @@ Global Instance dec_eq_Empty_set : DecidableRel (@eq Empty_set) | 10. exact _. D
Global Instance dec_eq_nat : DecidableRel (@eq nat) | 10. exact _. Defined.
Global Instance dec_eq_prod {A B} `{DecidableRel (@eq A), DecidableRel (@eq B)} : DecidableRel (@eq (A * B)) | 10. exact _. Defined.
Global Instance dec_eq_sum {A B} `{DecidableRel (@eq A), DecidableRel (@eq B)} : DecidableRel (@eq (A + B)) | 10. exact _. Defined.
+Global Instance dec_eq_sigT_hprop {A P} `{DecidableRel (@eq A), forall a : A, IsHProp (P a)} : DecidableRel (@eq (@sigT A P)) | 10. exact _. Defined.
+Global Instance dec_eq_sig_hprop {A} {P : A -> Prop} `{DecidableRel (@eq A), forall a : A, IsHProp (P a)} : DecidableRel (@eq (@sig A P)) | 10. exact _. Defined.
Lemma Decidable_respects_iff A B (H : A <-> B) : (Decidable A -> Decidable B) * (Decidable B -> Decidable A).
Proof. solve_decidable_transparent. Defined.