(**********************************************************************)
(** * Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *)
(** This is an adaptation of Diaconescu's theorem, exploiting the form of extensionality provided by proof-irrelevance *)
Section ProofIrrel_RelChoice_imp_EqEM.
Variable rel_choice : RelationalChoice.
Variable proof_irrelevance : forall P:Prop , forall x y:P, x=y.
(** Let [a1] and [a2] be two elements in some type [A] *)
Variable A :Type.
Variables a1 a2 : A.
(** We build the subset [A'] of [A] made of [a1] and [a2] *)
Definition A' := @sigT A (fun x => x=a1 \/ x=a2).
Definition a1':A'.
exists a1 ; auto.
Defined.
Definition a2':A'.
exists a2 ; auto.
Defined.
(** By proof-irrelevance, projection is a retraction *)

(* Specifications: *)
Lemma projT1_injective : a1=a2 -> a1'=a2'.
(** But from the actual proofs of being in [A'], we can assert in the proof-irrelevant world the existence of relevant boolean witnesses *)
Lemma decide : forall x:A', exists y:bool ,
(projT1 x = a1 /\ y = true ) \/ (projT1 x = a2 /\ y = false).