Module Type Protothetic (dolce:DOLCE_root).
(************************** Meta-rules of Protothetic in Coq ***************************)
Parameter eqP : Prop -> Prop -> Prop.
Notation "a ≡≡ b" := (eqP a b)  (at level 80).
(* elimination rules for equivalence *)
Parameter detachL     : forall (p q:Prop), (p ≡≡ q) -> p -> q.
Parameter detachR     : forall (p q:Prop), (p ≡≡ q) -> q -> p.
(* substitution rules for equivalence -> use rewrite *)
Add Parametric Relation  : Prop (eqP)
reflexivity proved by (ProtoReflex)
symmetry proved by (ProtoSymm)
transitivity proved by (ProtoTrans)
as eq_Prop.
Structure Morphism  : Type := {
f       :> Prop -> Prop;
compat  : forall (x1 x2: Prop), (x1 ≡≡ x2) -> ((f x1) ≡≡ (f x2))}.
Add Parametric Morphism  (M : Morphism) :
(@f M) with signature (@eqP ==> @eqP) as extensional_prop.
(***************** Basic definitions ************************)
(* Affirmation of the consequent *)
Parameter  mu       : Prop -> Prop -> Prop.
Parameter  D1       : forall p q:Prop, mu p q ≡≡ (p ≡≡ (p ≡≡ q)).
(* binary tautology *)
Parameter  to       : Prop -> Prop -> Prop.
Parameter  D2       : forall p q:Prop, to p q ≡≡ ((p ≡≡ q) ≡≡ (p ≡≡ q)).
(* Affirmation of the antecedent *)
Parameter  alpha    : Prop -> Prop.
Parameter  D3       : forall p, alpha p ≡≡ (p ≡≡ (forall q, q ≡≡ q)).
(* negation *)
Parameter neg       : Morphism.
Notation "¬ a" := (neg a)  (at level 75).
Parameter not       : forall p:Prop, (¬p) ≡≡ (p ≡≡ forall q:Prop, q). (* D4 *)
(* exclusive OR *)
Parameter  omega    : Prop -> Prop -> Prop.
Parameter  D5       : forall p q:Prop, omega p q ≡≡ ¬(p ≡≡ q).
Parameter  phi       : Prop->Prop->Prop.
Parameter  D6       : forall p q:Prop, phi p q ≡≡ ((p ≡≡ q) ≡≡ (q ≡≡ p)).
(* True *)
Parameter T    : Prop.
Parameter Verum : T ≡≡ forall p:Prop, (p ≡≡ p).
(*False *)
Parameter F      : Prop.
Parameter Falsum : F ≡≡ forall p:Prop, p.
(* distrib des quantificateurs  ***)
(* si on a la these: forall x1 x2 ... xi ... xk ... xn, A ≡≡ B. alors: on obtient une nouvelle these: forall x1 x2 ... xi-1 ... xk+1 ... xn, forall xi ... xk, A ≡≡ forall xi ... xk, B. *)
Parameter dist_q : forall p:Prop, ((forall q : Prop, (p ≡≡ q)) ≡≡ (p ≡≡ forall q : Prop, q)).
Parameter dist_2 : (forall (p q:Prop), phi p q ≡≡ ((p ≡≡ q) ≡≡ (q ≡≡ p))) -> (forall (p q:Prop), phi p q) ≡≡ (forall (p q:Prop), ((p ≡≡ q) ≡≡ (q ≡≡ p))).
(************************ Logical operators  ******************)
Parameter Ass    : Morphism.
Parameter Assert : forall p:Prop, (Ass p ≡≡ p).
Parameter and    : Prop -> Prop -> Prop.
Notation "a ∧ b" := (and a b)  (at level 60).
Parameter DP14   : forall (p q:Prop)(f:Morphism), (p ∧ q) ≡≡ (p ≡≡ ((forall r, p ≡≡ f r) ≡≡ forall r, (q ≡≡ f r))).
(****** alternative definitions for p ∧ q assuming the law of extensionality  *********)
Parameter conj2  : forall (p q:Prop)(f:Morphism), (p ∧ q) ≡≡ (p ≡≡ (f p ≡≡ f q)).
Parameter conj3  : forall (p q:Prop)(r:Prop)(f : Prop->Prop->Prop), (p ∧ q) ≡≡ (f p r ≡≡ (f q r ≡≡ p)).
Parameter imply  : Prop -> Prop -> Prop.
Notation "a ⊃ b" := (imply a b)  (at level 90).
Parameter DP15   : forall (p q:Prop), (p ⊃ q) ≡≡ ¬(p ∧ (¬ q)).
Parameter DP15b   : forall (p q:Prop), (p ⊃ q) ≡≡ (p ≡≡ (p ∧ q)).
Parameter or     : Prop -> Prop -> Prop.
Notation "a ∨ b" := (or a b)  (at level 60).
Parameter DP16   : forall (p q:Prop), (p ∨ q) ≡≡ ¬((¬p) ∧ (¬q)).
Parameter DP16b   : forall (p q:Prop), (p ∨ q) ≡≡ ((¬p) ⊃ q).
Parameter dist_3 : forall (p q:Prop), (forall (r:Prop)(f : Prop->Prop->Prop), (p ∧ q) ≡≡ (f p r ≡≡ (f q r ≡≡ p))) -> ((p ∧ q) ≡≡ forall (r:Prop)(f : Prop->Prop->Prop), (f p r ≡≡ (f q r ≡≡ p))).
(************************ Theorems  and metatheorems *************************)
Parameter implication : forall (p q :Prop), (p -> q) ≡≡ (p ⊃ q).
intro p.
assert (H:forall p:Prop, (¬p) ≡≡ (p ≡≡ F)).
apply T5.
specialize (H (¬p)).
assert (H1:((¬p ≡≡ p) ≡≡ F)).
apply (contradict p).
assert (H2:((¬p ≡≡ p) ≡≡ F) ≡≡ (F ≡≡ (¬p ≡≡ p))).
apply (T4 (¬p ≡≡ p) F).
apply (detachL ((¬p ≡≡ p) ≡≡ F)(F ≡≡ (¬p ≡≡ p))) in H2;[
clear H1;assert (H1:(F ≡≡ (¬p ≡≡ p)) ≡≡ ((F ≡≡ ¬p) ≡≡ p));[
apply (A2 F (¬p) p) |
apply (detachL (F ≡≡ (¬p ≡≡ p))((F ≡≡ ¬p) ≡≡ p)) in H1;[
clear H2;assert (H2:(F ≡≡ ¬p) ≡≡ ((¬p) ≡≡ F));[
apply (T4 F (¬p)) |
rewrite H2 in H1;clear H2;assert (H2:((¬p ≡≡ F) ≡≡ p) ≡≡ (¬(¬p) ≡≡ (¬p ≡≡ F)));[
apply (intro_eqP ((¬p ≡≡ F) ≡≡ p)(¬(¬p) ≡≡ (¬p ≡≡ F)) H1 H) |
assert (H3:(((¬p ≡≡ F) ≡≡ p) ≡≡ (¬(¬p) ≡≡ (¬p ≡≡ F))) ≡≡ (p ≡≡ ¬(¬p)));[
apply (A1 (¬p ≡≡ F)(¬(¬p)) p) |
apply (detachL (((¬p ≡≡ F) ≡≡ p) ≡≡ (¬(¬p) ≡≡ (¬p ≡≡ F)))(p ≡≡ ¬(¬p))) in H3;[
clear H2;assert (H2:(p ≡≡ ¬(¬p)) ≡≡ (¬(¬p) ≡≡ p));[
apply (T4 p (¬(¬p))) |
apply (detachL (p ≡≡ ¬(¬p))(¬(¬p) ≡≡ p)) in H2;assumption ] |
assumption ]]]] |
assumption ]] |
assumption ].
Qed.

Lemma T8 : F ≡≡ F.