(************************************************************************)
(*         *      The Rocq Prover / The Rocq Development Team           *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    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)         *)
(************************************************************************)
(*                              Hurkens.v                               *)
(************************************************************************)
(** Exploiting Hurkens's paradox [[Hurkens95]] for system U- so as to derive various contradictory contexts.  The file is divided into various sub-modules which all follow the same structure: a section introduces the contradictory hypotheses and a theorem named [paradox] concludes the module with a proof of [False].  - The [Generic] module contains the actual Hurkens's paradox for a postulated shallow encoding of system U- in Coq. This is an adaptation by Arnaud Spiwack of a previous, more restricted implementation by Herman Geuvers. It is used to derive every other special cases of the paradox in this file.  - The [NoRetractToImpredicativeUniverse] module contains a simple and effective formulation by Herman Geuvers [[Geuvers01]] of a result by Thierry Coquand [[Coquand90]]. It states that no impredicative sort can contain a type of which it is a retract. This result implies that Coq with classical logic stated in impredicative Set is inconsistent and that classical logic stated in Prop implies proof-irrelevance (see [ClassicalFacts.v])  - The [NoRetractFromSmallPropositionToProp] module is a specialisation of the [NoRetractToImpredicativeUniverse] module to the case where the impredicative sort is [Prop].  - The [NoRetractToModalProposition] module is a strengthening of the [NoRetractFromSmallPropositionToProp] module.  It shows that given a monadic modality (aka closure operator) [M], the type of modal propositions (i.e. such that [M A -> A]) cannot be a retract of a modal proposition. It is an example of use of the paradox where the universes of system U- are not mapped to universes of Coq.  - The [NoRetractToNegativeProp] module is the specialisation of the [NoRetractFromSmallPropositionToProp] module where the modality is double-negation. This result implies that the principle of weak excluded middle ([forall A, ~~A\/~A]) implies a weak variant of proof irrelevance.  - The [NoRetractFromTypeToProp] module proves that [Prop] cannot be a retract of a larger type.  - The [TypeNeqSmallType] module proves that [Type] is different from any smaller type.  - The [PropNeqType] module proves that [Prop] is different from any larger [Type]. It is an instance of the previous result.  References:  - [[Coquand90]] T. Coquand, "Metamathematical Investigations of a Calculus of Constructions", Proceedings of Logic in Computer Science (LICS'90), 1990.  - [[Hurkens95]] A. J. Hurkens, "A simplification of Girard's paradox", Proceedings of the 2nd international conference Typed Lambda-Calculi and Applications (TLCA'95), 1995.  - [[Geuvers01]] H. Geuvers, "Inconsistency of Classical Logic in Type Theory", 2001, revised 2007 (see external link {{http://www.cs.ru.nl/~herman/PUBS/newnote.ps.gz}}). *)
Set Universe Polymorphism.
(* begin show *)
(** * A modular proof of Hurkens's paradox. *)
(** It relies on an axiomatisation of a shallow embedding of system U- (i.e.  types of U- are interpreted by types of Coq). The universes are encoded in a style, due to Martin-Löf, where they are given by a set of names and a family [El:Name->Type] which interprets each name into a type. This allows the encoding of universe to be decoupled from Coq's universes. Dependent products and abstractions are similarly postulated rather than encoded as Coq's dependent products and abstractions. *)
Module Generic.
(* begin hide *)
(* Notations used in the proof. Hidden in coqdoc. *)
Reserved Notation "'∀₁' x : A , B" (at level 200, x name, A at level 200,right associativity).
Reserved Notation "A '⟶₁' B" (at level 99, right associativity, B at level 200).
Reserved Notation "'λ₁' x , u" (at level 200, x name, right associativity).
Reserved Notation "f '·₁' x" (at level 5, left associativity).
Reserved Notation "'∀₂' A , F" (at level 200, A name, right associativity).
Reserved Notation "'λ₂' x , u" (at level 200, x name, right associativity).
#[warning="-postfix-notation-not-level-1"]
Reserved Notation "f '·₁' [ A ]" (at level 5, left associativity).
Reserved Notation "'∀₀' x : A , B" (at level 200, x name, A at level 200,right associativity).
Reserved Notation "A '⟶₀' B" (at level 99, right associativity, B at level 200).
Reserved Notation "'λ₀' x , u" (at level 200, x name, right associativity).
Reserved Notation "f '·₀' x" (at level 5, left associativity).
Reserved Notation "'∀₀¹' A : U , F" (at level 200, A name, right associativity).
Reserved Notation "'λ₀¹' x , u" (at level 200, x name, right associativity).
#[warning="-postfix-notation-not-level-1"]
Reserved Notation "f '·₀' [ A ]" (at level 5, left associativity).
(* end hide *)
Section Paradox.
(** ** Axiomatisation of impredicative universes in a Martin-Löf style *)
(** System U- has two impredicative universes. In the proof of the paradox they are slightly asymmetric (in particular the reduction rules of the small universe are not needed).  Therefore, the axioms are duplicated allowing for a weaker requirement than the actual system U-. *)
(** *** Large universe *)
Variable U1 : Type.
Variable El1 : U1 -> Type.
(** **** Closure by small product *)
Variable Forall1 : forall u:U1, (El1 u -> U1) -> U1.
Notation "'∀₁' x : A , B" := (Forall1 A (fun x => B)).
Notation "A '⟶₁' B" := (Forall1 A (fun _ => B)).
Variable lam1 : forall u B, (forall x:El1 u, El1 (B x)) -> El1 (∀₁ x:u, B x).
Notation "'λ₁' x , u" := (lam1 _ _ (fun x => u)).
Variable app1 : forall u B (f:El1 (Forall1 u B)) (x:El1 u), El1 (B x).
Notation "f '·₁' x" := (app1 _ _ f x).
Variable beta1 : forall u B (f:forall x:El1 u, El1 (B x)) x,
(λ₁ y, f y) ·₁ x = f x.
(** **** Closure by large products *)
(** [U1] only needs to quantify over itself. *)
Variable ForallU1 : (U1->U1) -> U1.
Notation "'∀₂' A , F" := (ForallU1 (fun A => F)).
Variable lamU1 : forall F, (forall A:U1, El1 (F A)) -> El1 (∀₂ A, F A).
Notation "'λ₂' x , u" := (lamU1 _ (fun x => u)).
Variable appU1 : forall F (f:El1(∀₂ A,F A)) (A:U1), El1 (F A).
Notation "f '·₁' [ A ]" := (appU1 _ f A).
Variable betaU1 : forall F (f:forall A:U1, El1 (F A)) A,
(λ₂ x, f x) ·₁ [ A ] = f A.
(** *** Small universe *)
(** The small universe is an element of the large one. *)
Variable u0 : U1.
Notation U0 := (El1 u0).
Variable El0 : U0 -> Type.
(** **** Closure by small product *)
(** [U0] does not need reduction rules *)
Variable Forall0 : forall u:U0, (El0 u -> U0) -> U0.
Notation "'∀₀' x : A , B" := (Forall0 A (fun x => B)).
Notation "A '⟶₀' B" := (Forall0 A (fun _ => B)).
Variable lam0 : forall u B, (forall x:El0 u, El0 (B x)) -> El0 (∀₀ x:u, B x).
Notation "'λ₀' x , u" := (lam0 _ _ (fun x => u)).
Variable app0 : forall u B (f:El0 (Forall0 u B)) (x:El0 u), El0 (B x).
Notation "f '·₀' x" := (app0 _ _ f x).
(** **** Closure by large products *)
Variable ForallU0 : forall u:U1, (El1 u->U0) -> U0.
Notation "'∀₀¹' A : U , F" := (ForallU0 U (fun A => F)).
Variable lamU0 : forall U F, (forall A:El1 U, El0 (F A)) -> El0 (∀₀¹ A:U, F A).
Notation "'λ₀¹' x , u" := (lamU0 _ _ (fun x => u)).
Variable appU0 : forall U F (f:El0(∀₀¹ A:U,F A)) (A:El1 U), El0 (F A).
Notation "f '·₀' [ A ]" := (appU0 _ _ f A).
(** ** Automating the rewrite rules of our encoding. *)
Local Ltac simplify :=
(* spiwack: ideally we could use [rewrite_strategy] here, but I am a tad scared of the idea of depending on setoid rewrite in such a simple file. *)
(repeat rewrite ?beta1, ?betaU1);
lazy beta.
Local Ltac simplify_in h :=
(repeat rewrite ?beta1, ?betaU1 in h);
lazy beta in h.
(** ** Hurkens's paradox. *)
(** An inhabitant of [U0] standing for [False]. *)
Variable F:U0.
(** *** Preliminary definitions *)
Definition V : U1 := ∀₂ A, ((A ⟶₁ u0) ⟶₁ A ⟶₁ u0) ⟶₁ A ⟶₁ u0.
Definition U : U1 := V ⟶₁ u0.
Definition sb (z:El1 V) : El1 V := λ₂ A, λ₁ r, λ₁ a, r ·₁ (z·₁[A]·₁r) ·₁ a.
Definition le (i:El1 (U⟶₁u0)) (x:El1 U) : U0 :=
x ·₁ (λ₂ A, λ₁ r, λ₁ a, i ·₁ (λ₁ v, (sb v) ·₁ [A] ·₁ r ·₁ a)).
Definition le' : El1 ((U⟶₁u0) ⟶₁ U ⟶₁ u0) := λ₁ i, λ₁ x, le i x.
Definition induct (i:El1 (U⟶₁u0)) : U0 :=
∀₀¹ x:U, le i x ⟶₀ i ·₁ x.
Definition WF : El1 U := λ₁ z, (induct (z·₁[U] ·₁ le')).
Definition I (x:El1 U) : U0 :=
(∀₀¹ i:U⟶₁u0, le i x ⟶₀ i ·₁ (λ₁ v, (sb v) ·₁ [U] ·₁ le' ·₁ x)) ⟶₀ F
.
(** *** Proof *)

Lemma lemma2 : El0 ((∀₀¹i:U⟶₁u0, induct i ⟶₀ i·₁WF) ⟶₀ F).