decidable.v 8.26 KB
Newer Older
Robbert Krebbers's avatar
Robbert Krebbers committed
1
(* Copyright (c) 2012-2014, Robbert Krebbers. *)
2
3
4
5
(* This file is distributed under the terms of the BSD license. *)
(** This file collects theorems, definitions, tactics, related to propositions
with a decidable equality. Such propositions are collected by the [Decision]
type class. *)
6
Require Export proof_irrel.
7

Robbert Krebbers's avatar
Robbert Krebbers committed
8
9
Hint Extern 200 (Decision _) => progress (lazy beta) : typeclass_instances.

10
11
Lemma dec_stable `{Decision P} : ¬¬P  P.
Proof. firstorder. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
12

13
14
15
Lemma Is_true_reflect (b : bool) : reflect b b.
Proof. destruct b. by left. right. intros []. Qed.

16
17
18
19
20
21
22
23
24
(** We introduce [decide_rel] to avoid inefficienct computation due to eager
evaluation of propositions by [vm_compute]. This inefficiency occurs if
[(x = y) := (f x = f y)] as [decide (x = y)] evaluates to [decide (f x = f y)]
which then might lead to evaluation of [f x] and [f y]. Using [decide_rel]
we hide [f] under a lambda abstraction to avoid this unnecessary evaluation. *)
Definition decide_rel {A B} (R : A  B  Prop) {dec :  x y, Decision (R x y)}
  (x : A) (y : B) : Decision (R x y) := dec x y.
Lemma decide_rel_correct {A B} (R : A  B  Prop) `{ x y, Decision (R x y)}
  (x : A) (y : B) : decide_rel R x y = decide (R x y).
25
Proof. done. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
26

Robbert Krebbers's avatar
Robbert Krebbers committed
27
Lemma decide_True {A} `{Decision P} (x y : A) :
28
29
  P  (if decide P then x else y) = x.
Proof. by destruct (decide P). Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
30
Lemma decide_False {A} `{Decision P} (x y : A) :
31
32
33
  ¬P  (if decide P then x else y) = y.
Proof. by destruct (decide P). Qed.

34
35
(** The tactic [destruct_decide] destructs a sumbool [dec]. If one of the
components is double negated, it will try to remove the double negation. *)
36
Tactic Notation "destruct_decide" constr(dec) "as" ident(H) :=
37
38
39
40
  destruct dec as [H|H];
  try match type of H with
  | ¬¬_ => apply dec_stable in H
  end.
41
42
Tactic Notation "destruct_decide" constr(dec) :=
  let H := fresh in destruct_decide dec as H.
43

44
(** The tactic [case_decide] performs case analysis on an arbitrary occurrence
45
of [decide] or [decide_rel] in the conclusion or hypotheses. *)
46
Tactic Notation "case_decide" "as" ident(Hd) :=
Robbert Krebbers's avatar
Robbert Krebbers committed
47
  match goal with
48
  | H : context [@decide ?P ?dec] |- _ =>
49
    destruct_decide (@decide P dec) as Hd
50
  | H : context [@decide_rel _ _ ?R ?x ?y ?dec] |- _ =>
51
    destruct_decide (@decide_rel _ _ R x y dec) as Hd
52
  | |- context [@decide ?P ?dec] =>
53
    destruct_decide (@decide P dec) as Hd
54
  | |- context [@decide_rel _ _ ?R ?x ?y ?dec] =>
55
    destruct_decide (@decide_rel _ _ R x y dec) as Hd
Robbert Krebbers's avatar
Robbert Krebbers committed
56
  end.
57
58
Tactic Notation "case_decide" :=
  let H := fresh in case_decide as H.
Robbert Krebbers's avatar
Robbert Krebbers committed
59

60
61
(** The tactic [solve_decision] uses Coq's [decide equality] tactic together
with instance resolution to automatically generate decision procedures. *)
Robbert Krebbers's avatar
Robbert Krebbers committed
62
63
Ltac solve_trivial_decision :=
  match goal with
64
65
  | |- Decision (?P) => apply _
  | |- sumbool ?P (¬?P) => change (Decision P); apply _
Robbert Krebbers's avatar
Robbert Krebbers committed
66
  end.
67
68
69
Ltac solve_decision := intros; first
  [ solve_trivial_decision
  | unfold Decision; decide equality; solve_trivial_decision ].
Robbert Krebbers's avatar
Robbert Krebbers committed
70

71
72
(** The following combinators are useful to create Decision proofs in
combination with the [refine] tactic. *)
73
Notation swap_if S := (match S with left H => right H | right H => left H end).
74
75
76
77
78
Notation cast_if S := (if S then left _ else right _).
Notation cast_if_and S1 S2 := (if S1 then cast_if S2 else right _).
Notation cast_if_and3 S1 S2 S3 := (if S1 then cast_if_and S2 S3 else right _).
Notation cast_if_and4 S1 S2 S3 S4 :=
  (if S1 then cast_if_and3 S2 S3 S4 else right _).
79
80
Notation cast_if_and5 S1 S2 S3 S4 S5 :=
  (if S1 then cast_if_and4 S2 S3 S4 S5 else right _).
81
82
Notation cast_if_and6 S1 S2 S3 S4 S5 S6 :=
  (if S1 then cast_if_and5 S2 S3 S4 S5 S6 else right _).
83
Notation cast_if_or S1 S2 := (if S1 then left _ else cast_if S2).
84
Notation cast_if_or3 S1 S2 S3 := (if S1 then left _ else cast_if_or S2 S3).
85
86
87
Notation cast_if_not_or S1 S2 := (if S1 then cast_if S2 else left _).
Notation cast_if_not S := (if S then right _ else left _).

88
89
90
(** We can convert decidable propositions to booleans. *)
Definition bool_decide (P : Prop) {dec : Decision P} : bool :=
  if dec then true else false.
Robbert Krebbers's avatar
Robbert Krebbers committed
91

92
93
94
Lemma bool_decide_reflect P `{dec : Decision P} : reflect P (bool_decide P).
Proof. unfold bool_decide. destruct dec. by left. by right. Qed.

95
Tactic Notation "case_bool_decide" "as" ident (Hd) :=
96
97
  match goal with
  | H : context [@bool_decide ?P ?dec] |- _ =>
98
    destruct_decide (@bool_decide_reflect P dec) as Hd
99
  | |- context [@bool_decide ?P ?dec] =>
100
    destruct_decide (@bool_decide_reflect P dec) as Hd
101
  end.
102
103
Tactic Notation "case_bool_decide" :=
  let H := fresh in case_bool_decide as H.
104

Robbert Krebbers's avatar
Robbert Krebbers committed
105
Lemma bool_decide_unpack (P : Prop) {dec : Decision P} : bool_decide P  P.
106
Proof. unfold bool_decide. by destruct dec. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
107
Lemma bool_decide_pack (P : Prop) {dec : Decision P} : P  bool_decide P.
108
Proof. unfold bool_decide. by destruct dec. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
109

110
111
112
113
(** * Decidable Sigma types *)
(** Leibniz equality on Sigma types requires the equipped proofs to be
equal as Coq does not support proof irrelevance. For decidable we
propositions we define the type [dsig P] whose Leibniz equality is proof
114
115
116
irrelevant. That is [∀ x y : dsig P, x = y ↔ `x = `y]. Due to the absence of
universe polymorpic definitions we also define a variant [dsigS] for types
in [Set]. *)
117
118
Definition dsig `(P : A  Prop) `{ x : A, Decision (P x)} :=
  { x | bool_decide (P x) }.
119
120
121
Definition dsigS {A : Set} (P : A  Prop) `{ x : A, Decision (P x)} : Set :=
  { x | bool_decide (P x) }.

122
123
124
125
Definition proj2_dsig `{ x : A, Decision (P x)} (x : dsig P) : P (`x) :=
  bool_decide_unpack _ (proj2_sig x).
Definition dexist `{ x : A, Decision (P x)} (x : A) (p : P x) : dsig P :=
  xbool_decide_pack _ p.
126
Lemma dsig_eq `(P : A  Prop) `{ x, Decision (P x)}
127
  (x y : dsig P) : x = y  `x = `y.
128
Proof. apply (sig_eq_pi _). Qed.
129
130
131
Lemma dexists_proj1 `(P : A  Prop) `{ x, Decision (P x)} (x : dsig P) p :
  dexist (`x) p = x.
Proof. by apply dsig_eq. Qed.
132
133
134

(** * Instances of Decision *)
(** Instances of [Decision] for operators of propositional logic. *)
135
136
Instance True_dec: Decision True := left I.
Instance False_dec: Decision False := right (False_rect False).
137
138
Instance Is_true_dec b : Decision (Is_true b).
Proof. destruct b; apply _. Defined.
139
140
141
142

Section prop_dec.
  Context `(P_dec : Decision P) `(Q_dec : Decision Q).

143
144
  Global Instance not_dec: Decision (¬P).
  Proof. refine (cast_if_not P_dec); intuition. Defined.
145
  Global Instance and_dec: Decision (P  Q).
146
  Proof. refine (cast_if_and P_dec Q_dec); intuition. Defined.
147
  Global Instance or_dec: Decision (P  Q).
148
  Proof. refine (cast_if_or P_dec Q_dec); intuition. Defined.
149
  Global Instance impl_dec: Decision (P  Q).
150
  Proof. refine (if P_dec then cast_if Q_dec else left _); intuition. Defined.
151
End prop_dec.
152
153
Instance iff_dec `(P_dec : Decision P) `(Q_dec : Decision Q) :
  Decision (P  Q) := and_dec _ _.
154
155

(** Instances of [Decision] for common data types. *)
Robbert Krebbers's avatar
Robbert Krebbers committed
156
157
Instance bool_eq_dec (x y : bool) : Decision (x = y).
Proof. solve_decision. Defined.
158
Instance unit_eq_dec (x y : unit) : Decision (x = y).
159
Proof. solve_decision. Defined.
160
Instance prod_eq_dec `(A_dec :  x y : A, Decision (x = y))
Robbert Krebbers's avatar
Robbert Krebbers committed
161
  `(B_dec :  x y : B, Decision (x = y)) (x y : A * B) : Decision (x = y).
162
Proof. solve_decision. Defined.
163
Instance sum_eq_dec `(A_dec :  x y : A, Decision (x = y))
Robbert Krebbers's avatar
Robbert Krebbers committed
164
  `(B_dec :  x y : B, Decision (x = y)) (x y : A + B) : Decision (x = y).
165
Proof. solve_decision. Defined.
Robbert Krebbers's avatar
Robbert Krebbers committed
166
167
168
169
170
171
172
173

Instance curry_dec `(P_dec :  (x : A) (y : B), Decision (P x y)) p :
    Decision (curry P p) :=
  match p as p return Decision (curry P p) with
  | (x,y) => P_dec x y
  end.
Instance uncurry_dec `(P_dec :  (p : A * B), Decision (P p)) x y :
  Decision (uncurry P x y) := P_dec (x,y).
174
175
176
177

Instance sig_eq_dec `(P : A  Prop) `{ x, ProofIrrel (P x)}
  `{ x y : A, Decision (x = y)} (x y : sig P) : Decision (x = y).
Proof. refine (cast_if (decide (`x = `y))); by rewrite sig_eq_pi. Defined.
178
179

(** Some laws for decidable propositions *)
180
181
182
183
184
Lemma not_and_l {P Q : Prop} `{Decision P} : ¬(P  Q)  ¬P  ¬Q.
Proof. destruct (decide P); tauto. Qed.
Lemma not_and_r {P Q : Prop} `{Decision Q} : ¬(P  Q)  ¬P  ¬Q.
Proof. destruct (decide Q); tauto. Qed.
Lemma not_and_l_alt {P Q : Prop} `{Decision P} : ¬(P  Q)  ¬P  (¬Q  P).
185
Proof. destruct (decide P); tauto. Qed.
186
Lemma not_and_r_alt {P Q : Prop} `{Decision Q} : ¬(P  Q)  (¬P  Q)  ¬Q.
187
Proof. destruct (decide Q); tauto. Qed.