(** More properties of [ex] and [ex2] that rely on equality being present *)

(** We define restricted versions of [ex_rect] and [ex_rec] which
    allow elimination into non-Prop sorts when the inductive is not
    informative *)

(** η Principles *)
Definition ex_eta {A : Prop} {P} (p : exists a : A, P a)
  : p = ex_intro _ (ex_proj1 p) (ex_proj2 p).Definition ex2_eta {A : Prop} {P Q} (p : exists2 a : A, P a & Q a)
  : p = ex_intro2 _ _ (ex_proj1 (ex_of_ex2 p)) (ex_proj2 (ex_of_ex2 p)) (ex_proj3 p).Definition ex_rect (P0 : ex P -> Type) (f : forall x p, P0 (ex_intro P x p))
    : forall e, P0 e
    := fun e => rew <- ex_eta e in f _ _.Definition ex_rec : forall (P0 : ex P -> Set) (f : forall x p, P0 (ex_intro P x p)),
      forall e, P0 e
    := ex_rect.(** Projecting an equality of a pair to equality of the first components *)
  Definition ex_proj1_eq {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (p : u = v)
    : ex_proj1 u = ex_proj1 v
    := f_equal (@ex_proj1 _ _) p.(** Projecting an equality of a pair to equality of the second components *)
  Definition ex_proj2_eq {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (p : u = v)
    : rew ex_proj1_eq p in ex_proj2 u = ex_proj2 v
    := rew dependent p in eq_refl.(** Equality of [ex] is itself a [ex] (forwards-reasoning version) *)
  Definition eq_ex_intro_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 _ u1 u2 = ex_intro _ v1 v2.(** Equality of [ex] is itself a [ex] (backwards-reasoning version) *)
  Definition eq_ex_uncurried {A : Prop} {P : A -> Prop} (u v : exists a : A, P a)
             (pq : exists p : ex_proj1 u = ex_proj1 v, rew p in ex_proj2 u = ex_proj2 v)
    : u = v.(** Curried version of proving equality of [ex] types *)
  Definition eq_ex_intro {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 _ u1 u2 = ex_intro _ v1 v2
    := eq_ex_intro_uncurried (ex_intro _ p q).(** Curried version of proving equality of [ex] types *)
  Definition eq_ex {A : Prop} {P : A -> Prop} (u v : exists a : A, P a)
             (p : ex_proj1 u = ex_proj1 v) (q : rew p in ex_proj2 u = ex_proj2 v)
    : u = v
    := eq_ex_uncurried u v (ex_intro _ p q).(** In order to have a performant [inversion_sigma], we define
      specialized versions for when we have constructors on one or
      both sides of the equality *)
  Definition eq_ex_intro_l {A : Prop} {P : A -> Prop} u1 u2 (v : exists a : A, P a)
             (p : u1 = ex_proj1 v) (q : rew p in u2 = ex_proj2 v)
    : ex_intro P u1 u2 = v
    := eq_ex (ex_intro P u1 u2) v p q.Definition eq_ex_intro_r {A : Prop} {P : A -> Prop} (u : exists a : A, P a) v1 v2
             (p : ex_proj1 u = v1) (q : rew p in ex_proj2 u = v2)
    : u = ex_intro P v1 v2
    := eq_ex u (ex_intro P v1 v2) p q.(** Induction principle for [@eq (ex _)] *)
  Definition eq_ex_eta {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (p : u = v) : p = eq_ex u v (ex_proj1_eq p) (ex_proj2_eq p).Definition eq_ex_rect {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (Q : u = v -> Type)
             (f : forall p q, Q (eq_ex u v p q))
    : forall p, Q p
    := fun p => rew <- eq_ex_eta p in f _ _.Definition eq_ex_rec {A : Prop} {P : A -> Prop} {u v} (Q : u = v :> (exists a : A, P a) -> Set) := eq_ex_rect Q.Definition eq_ex_ind {A : Prop} {P : A -> Prop} {u v} (Q : u = v :> (exists a : A, P a) -> Prop) := eq_ex_rec Q.(** In order to have a performant [inversion_sigma], we define
      specialized versions for when we have constructors on one or
      both sides of the equality *)
  Definition eq_ex_rect_ex_intro_l {A : Prop} {P : A -> Prop} {u1 u2 v} (Q : _ -> Type)
             (f : forall p q, Q (eq_ex_intro_l (P:=P) u1 u2 v p q))
    : forall p, Q p
    := eq_ex_rect Q f.Definition eq_ex_rect_ex_intro_r {A : Prop} {P : A -> Prop} {u v1 v2} (Q : _ -> Type)
             (f : forall p q, Q (eq_ex_intro_r (P:=P) u v1 v2 p q))
    : forall p, Q p
    := eq_ex_rect Q f.Definition eq_ex_rect_ex_intro {A : Prop} {P : A -> Prop} {u1 u2 v1 v2} (Q : _ -> Type)
             (f : forall p q, Q (@eq_ex_intro A P u1 v1 u2 v2 p q))
    : forall p, Q p
    := eq_ex_rect Q f.Definition eq_ex_rect_uncurried {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (Q : u = v -> Type)
             (f : forall pq, Q (eq_ex u v (ex_proj1 pq) (ex_proj2 pq)))
    : forall p, Q p
    := eq_ex_rect Q (fun p q => f (ex_intro _ p q)).Definition eq_ex_rec_uncurried {A : Prop} {P : A -> Prop} {u v} (Q : u = v :> (exists a : A, P a) -> Set) := eq_ex_rect_uncurried Q.Definition eq_ex_ind_uncurried {A : Prop} {P : A -> Prop} {u v} (Q : u = v :> (exists a : A, P a) -> Prop) := eq_ex_rec_uncurried Q.(** Equality of [ex] when the property is an hProp *)
  Definition eq_ex_hprop {A : Prop} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q)
             (u v : exists a : A, P a)
             (p : ex_proj1 u = ex_proj1 v)
    : u = v
    := eq_ex u v p (P_hprop _ _ _).Definition eq_ex_intro_hprop {A : Type} {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_intro p (P_hprop _ _ _).(** Equivalence of equality of [ex] with a [ex] of equality *)
  (** We could actually prove an isomorphism here, and not just [<->],
      but for simplicity, we don't. *)
  Definition eq_ex_uncurried_iff {A : Prop} {P : A -> Prop} (u v : exists a : A, P a)
    : u = v <-> exists p : ex_proj1 u = ex_proj1 v, rew p in ex_proj2 u = ex_proj2 v.(** Equivalence of equality of [ex] involving hProps with equality of the first components *)
  Definition eq_ex_hprop_iff {A : Prop} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q)
             (u v : exists a : A, P a)
    : u = v <-> (ex_proj1 u = ex_proj1 v)
    := conj (fun p => f_equal (@ex_proj1 _ _) p) (eq_ex_hprop P_hprop u v).

(* Specifications: *)
Lemma rew_ex {A' : Type} {x} {P : A' -> Prop} (Q : forall a, P a -> Prop) (u : exists p : P x, Q x p) {y} (H : x = y) : rew [fun a => exists p : P a, Q a p] H in u = ex_intro (Q y) (rew H in ex_proj1 u) (rew dependent H in ex_proj2 u).