summaryrefslogtreecommitdiff
path: root/theories/Init/Logic.v
diff options
context:
space:
mode:
Diffstat (limited to 'theories/Init/Logic.v')
-rw-r--r--theories/Init/Logic.v188
1 files changed, 167 insertions, 21 deletions
diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v
index 85123cc4..15ca5abc 100644
--- a/theories/Init/Logic.v
+++ b/theories/Init/Logic.v
@@ -1,9 +1,11 @@
(************************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* * The Coq Proof Assistant / The Coq Development Team *)
+(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *)
+(* <O___,, * (see CREDITS file for the list of authors) *)
(* \VV/ **************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
Set Implicit Arguments.
@@ -125,6 +127,25 @@ Proof.
[apply Hl | apply Hr]; assumption.
Qed.
+Theorem imp_iff_compat_l : forall A B C : Prop,
+ (B <-> C) -> ((A -> B) <-> (A -> C)).
+Proof.
+ intros ? ? ? [Hl Hr]; split; intros H ?; [apply Hl | apply Hr]; apply H; assumption.
+Qed.
+
+Theorem imp_iff_compat_r : forall A B C : Prop,
+ (B <-> C) -> ((B -> A) <-> (C -> A)).
+Proof.
+ intros ? ? ? [Hl Hr]; split; intros H ?; [apply H, Hr | apply H, Hl]; assumption.
+Qed.
+
+Theorem not_iff_compat : forall A B : Prop,
+ (A <-> B) -> (~ A <-> ~B).
+Proof.
+ intros; apply imp_iff_compat_r; assumption.
+Qed.
+
+
(** Some equivalences *)
Theorem neg_false : forall A : Prop, ~ A <-> (A <-> False).
@@ -204,7 +225,7 @@ Proof.
Qed.
(** [(IF_then_else P Q R)], written [IF P then Q else R] denotes
- either [P] and [Q], or [~P] and [Q] *)
+ either [P] and [Q], or [~P] and [R] *)
Definition IF_then_else (P Q R:Prop) := P /\ Q \/ ~ P /\ R.
@@ -243,9 +264,16 @@ Notation "'exists' x .. y , p" := (ex (fun x => .. (ex (fun y => p)) ..))
Notation "'exists2' x , p & q" := (ex2 (fun x => p) (fun x => q))
(at level 200, x ident, p at level 200, right associativity) : type_scope.
-Notation "'exists2' x : t , p & q" := (ex2 (fun x:t => p) (fun x:t => q))
- (at level 200, x ident, t at level 200, p at level 200, right associativity,
- format "'[' 'exists2' '/ ' x : t , '/ ' '[' p & '/' q ']' ']'")
+Notation "'exists2' x : A , p & q" := (ex2 (A:=A) (fun x => p) (fun x => q))
+ (at level 200, x ident, A at level 200, p at level 200, right associativity,
+ format "'[' 'exists2' '/ ' x : A , '/ ' '[' p & '/' q ']' ']'")
+ : type_scope.
+
+Notation "'exists2' ' x , p & q" := (ex2 (fun x => p) (fun x => q))
+ (at level 200, x strict pattern, p at level 200, right associativity) : type_scope.
+Notation "'exists2' ' x : A , p & q" := (ex2 (A:=A) (fun x => p) (fun x => q))
+ (at level 200, x strict pattern, A at level 200, p at level 200, right associativity,
+ format "'[' 'exists2' '/ ' ' x : A , '/ ' '[' p & '/' q ']' ']'")
: type_scope.
(** Derived rules for universal quantification *)
@@ -294,8 +322,8 @@ Arguments eq_ind [A] x P _ y _.
Arguments eq_rec [A] x P _ y _.
Arguments eq_rect [A] x P _ y _.
-Hint Resolve I conj or_introl or_intror : core.
-Hint Resolve eq_refl: core.
+Hint Resolve I conj or_introl or_intror : core.
+Hint Resolve eq_refl: core.
Hint Resolve ex_intro ex_intro2: core.
Section Logic_lemmas.
@@ -424,7 +452,7 @@ Proof.
destruct e. reflexivity.
Defined.
-(** The goupoid structure of equality *)
+(** The groupoid structure of equality *)
Theorem eq_trans_refl_l : forall A (x y:A) (e:x=y), eq_trans eq_refl e = e.
Proof.
@@ -485,6 +513,11 @@ Proof.
reflexivity.
Defined.
+Lemma eq_refl_map_distr : forall A B x (f:A->B), f_equal f (eq_refl x) = eq_refl (f x).
+Proof.
+ reflexivity.
+Qed.
+
Lemma eq_trans_map_distr : forall A B x y z (f:A->B) (e:x=y) (e':y=z), f_equal f (eq_trans e e') = eq_trans (f_equal f e) (f_equal f e').
Proof.
destruct e'.
@@ -503,16 +536,29 @@ destruct e, e'.
reflexivity.
Defined.
+Lemma eq_trans_rew_distr : forall A (P:A -> Type) (x y z:A) (e:x=y) (e':y=z) (k:P x),
+ rew (eq_trans e e') in k = rew e' in rew e in k.
+Proof.
+ destruct e, e'; reflexivity.
+Qed.
+
+Lemma rew_const : forall A P (x y:A) (e:x=y) (k:P),
+ rew [fun _ => P] e in k = k.
+Proof.
+ destruct e; reflexivity.
+Qed.
+
+
(* Aliases *)
-Notation sym_eq := eq_sym (compat "8.3").
-Notation trans_eq := eq_trans (compat "8.3").
-Notation sym_not_eq := not_eq_sym (compat "8.3").
+Notation sym_eq := eq_sym (only parsing).
+Notation trans_eq := eq_trans (only parsing).
+Notation sym_not_eq := not_eq_sym (only parsing).
-Notation refl_equal := eq_refl (compat "8.3").
-Notation sym_equal := eq_sym (compat "8.3").
-Notation trans_equal := eq_trans (compat "8.3").
-Notation sym_not_equal := not_eq_sym (compat "8.3").
+Notation refl_equal := eq_refl (only parsing).
+Notation sym_equal := eq_sym (only parsing).
+Notation trans_equal := eq_trans (only parsing).
+Notation sym_not_equal := not_eq_sym (only parsing).
Hint Immediate eq_sym not_eq_sym: core.
@@ -553,9 +599,10 @@ Proof.
intros A P (x & Hp & Huniq); split.
- intro; exists x; auto.
- intros (x0 & HPx0 & HQx0) x1 HPx1.
- replace x1 with x0 by (transitivity x; [symmetry|]; auto).
+ assert (H : x0 = x1) by (transitivity x; [symmetry|]; auto).
+ destruct H.
assumption.
-Qed.
+Qed.
Lemma forall_exists_coincide_unique_domain :
forall A (P:A->Prop),
@@ -567,7 +614,7 @@ Proof.
exists x. split; [trivial|].
destruct H with (Q:=fun x'=>x=x') as (_,Huniq).
apply Huniq. exists x; auto.
-Qed.
+Qed.
(** * Being inhabited *)
@@ -589,6 +636,11 @@ Proof.
destruct 1; auto.
Qed.
+Lemma inhabited_covariant (A B : Type) : (A -> B) -> inhabited A -> inhabited B.
+Proof.
+ intros f [x];exact (inhabits (f x)).
+Qed.
+
(** Declaration of stepl and stepr for eq and iff *)
Lemma eq_stepl : forall (A : Type) (x y z : A), x = y -> x = z -> z = y.
@@ -606,3 +658,97 @@ Qed.
Declare Left Step iff_stepl.
Declare Right Step iff_trans.
+
+Local Notation "'rew' 'dependent' H 'in' H'"
+ := (match H with
+ | eq_refl => H'
+ end)
+ (at level 10, H' at level 10,
+ format "'[' 'rew' 'dependent' '/ ' H in '/' H' ']'").
+
+(** Equality for [ex] *)
+Section ex.
+ Local Unset Implicit Arguments.
+ Definition eq_ex_uncurried {A : Type} (P : A -> Prop) {u1 v1 : A} {u2 : P u1} {v2 : P v1}
+ (pq : exists p : u1 = v1, rew p in u2 = v2)
+ : ex_intro P u1 u2 = ex_intro P v1 v2.
+ Proof.
+ destruct pq as [p q].
+ destruct q; simpl in *.
+ destruct p; reflexivity.
+ Qed.
+
+ Definition eq_ex {A : Type} {P : A -> Prop} (u1 v1 : A) (u2 : P u1) (v2 : P v1)
+ (p : u1 = v1) (q : rew p in u2 = v2)
+ : ex_intro P u1 u2 = ex_intro P v1 v2
+ := eq_ex_uncurried P (ex_intro _ p q).
+
+ Definition eq_ex_hprop {A} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q)
+ (u1 v1 : A) (u2 : P u1) (v2 : P v1)
+ (p : u1 = v1)
+ : ex_intro P u1 u2 = ex_intro P v1 v2
+ := eq_ex u1 v1 u2 v2 p (P_hprop _ _ _).
+
+ Lemma rew_ex {A x} {P : A -> Type} (Q : forall a, P a -> Prop) (u : exists p, Q x p) {y} (H : x = y)
+ : rew [fun a => exists p, Q a p] H in u
+ = match u with
+ | ex_intro _ u1 u2
+ => ex_intro
+ (Q y)
+ (rew H in u1)
+ (rew dependent H in u2)
+ end.
+ Proof.
+ destruct H, u; reflexivity.
+ Qed.
+End ex.
+
+(** Equality for [ex2] *)
+Section ex2.
+ Local Unset Implicit Arguments.
+
+ Definition eq_ex2_uncurried {A : Type} (P Q : A -> Prop) {u1 v1 : A}
+ {u2 : P u1} {v2 : P v1}
+ {u3 : Q u1} {v3 : Q v1}
+ (pq : exists2 p : u1 = v1, rew p in u2 = v2 & rew p in u3 = v3)
+ : ex_intro2 P Q u1 u2 u3 = ex_intro2 P Q v1 v2 v3.
+ Proof.
+ destruct pq as [p q r].
+ destruct r, q, p; simpl in *.
+ reflexivity.
+ Qed.
+
+ Definition eq_ex2 {A : Type} {P Q : A -> Prop}
+ (u1 v1 : A)
+ (u2 : P u1) (v2 : P v1)
+ (u3 : Q u1) (v3 : Q v1)
+ (p : u1 = v1) (q : rew p in u2 = v2) (r : rew p in u3 = v3)
+ : ex_intro2 P Q u1 u2 u3 = ex_intro2 P Q v1 v2 v3
+ := eq_ex2_uncurried P Q (ex_intro2 _ _ p q r).
+
+ Definition eq_ex2_hprop {A} {P Q : A -> Prop}
+ (P_hprop : forall (x : A) (p q : P x), p = q)
+ (Q_hprop : forall (x : A) (p q : Q x), p = q)
+ (u1 v1 : A) (u2 : P u1) (v2 : P v1) (u3 : Q u1) (v3 : Q v1)
+ (p : u1 = v1)
+ : ex_intro2 P Q u1 u2 u3 = ex_intro2 P Q v1 v2 v3
+ := eq_ex2 u1 v1 u2 v2 u3 v3 p (P_hprop _ _ _) (Q_hprop _ _ _).
+
+ Lemma rew_ex2 {A x} {P : A -> Type}
+ (Q : forall a, P a -> Prop)
+ (R : forall a, P a -> Prop)
+ (u : exists2 p, Q x p & R x p) {y} (H : x = y)
+ : rew [fun a => exists2 p, Q a p & R a p] H in u
+ = match u with
+ | ex_intro2 _ _ u1 u2 u3
+ => ex_intro2
+ (Q y)
+ (R y)
+ (rew H in u1)
+ (rew dependent H in u2)
+ (rew dependent H in u3)
+ end.
+ Proof.
+ destruct H, u; reflexivity.
+ Qed.
+End ex2.
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-07 13:59:23 +0000