From e978da8c41d8a3c19a29036d9c569fbe2a4616b0 Mon Sep 17 00:00:00 2001
From: Samuel Mimram <smimram@debian.org>
Date: Fri, 16 Jun 2006 14:41:51 +0000
Subject: Imported Upstream version 8.0pl3+8.1beta

---
 test-suite/failure/Uminus.v | 62 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 test-suite/failure/Uminus.v

(limited to 'test-suite/failure/Uminus.v')

diff --git a/test-suite/failure/Uminus.v b/test-suite/failure/Uminus.v
new file mode 100644
index 00000000..6866f19a
--- /dev/null
+++ b/test-suite/failure/Uminus.v
@@ -0,0 +1,62 @@
+(* Check that the encoding of system U- fails *)
+
+Inductive prop : Prop := down : Prop -> prop.
+
+Definition up (p:prop) : Prop := let (A) := p in A.
+
+Lemma p2p1 : forall A:Prop, up (down A) -> A.
+Proof.
+exact (fun A x => x).
+Qed.
+
+Lemma p2p2 : forall A:Prop, A -> up (down A).
+Proof.
+exact (fun A x => x).
+Qed.
+
+(** Hurkens' paradox *)
+
+Definition V := forall A:Prop, ((A -> prop) -> A -> prop) -> A -> prop.
+Definition U := V -> prop.
+Definition sb (z:V) : V := fun A r a => r (z A r) a.
+Definition le (i:U -> prop) (x:U) : prop :=
+  x (fun A r a => i (fun v => sb v A r a)).
+Definition induct (i:U -> prop) : Prop :=
+  forall x:U, up (le i x) -> up (i x).
+Definition WF : U := fun z => down (induct (z U le)).
+Definition I (x:U) : Prop :=
+  (forall i:U -> prop, up (le i x) -> up (i (fun v => sb v U le x))) -> False.
+
+Lemma Omega : forall i:U -> prop, induct i -> up (i WF).
+Proof.
+intros i y.
+apply y.
+unfold le, WF, induct in |- *.
+intros x H0.
+apply y.
+exact H0.
+Qed.
+
+Lemma lemma1 : induct (fun u => down (I u)).
+Proof.
+unfold induct in |- *.
+intros x p.
+intro q.
+apply (q (fun u => down (I u)) p).
+intro i.
+apply q with (i := fun y => i (fun v:V => sb v U le y)).
+Qed.
+
+Lemma lemma2 : (forall i:U -> prop, induct i -> up (i WF)) -> False.
+Proof.
+intro x.
+apply (x (fun u => down (I u)) lemma1).
+intros i H0.
+apply (x (fun y => i (fun v => sb v U le y))).
+apply H0.
+Qed.
+
+Theorem paradox : False.
+Proof.
+exact (lemma2 Omega).
+Qed.
-- 
cgit v1.2.3