(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
(** Let (X, A, a) and (Y, B, b) be two pointed graphs (with X,Y : Typ1). The unordered pair formed by the sets represented by these pointed graphs is itself represented by the pointed graph  ((sum X Y), (PAIR X A a Y B b), (out X Y))  whose edge relation (PAIR X A a Y B b) : (Rel (sum X Y)) is defined by the following four clauses :  1. Delocate A in the new graph via (inl X Y):  if (A x' x), then (PAIR X A a Y B b (inl X Y x') (inl X Y x))  2. Delocate B in the new graph via (inr X Y):  if (B y' y), then (PAIR X A a Y B b (inr X Y y') (inr X Y y))  3. Connect the (image of the) root a to the new root (out X Y):  (PAIR X A a Y B b (inl X Y a) (out X Y))  4. Connect the (image of the) root b to the new root (out X Y):  (PAIR X A a Y B b (inr X Y b) (out X Y))  As usual, we define this relation by a direct impredicative encoding: *)
Definition PAIR (X : Typ1) (A : Rel X) (a : X) (Y : Typ1)
(B : Rel Y) (b : Y) (z' z : sum X Y) :=
forall E : Prop,
(forall x x' : X,
eq (sum X Y) z (inl X Y x) -> eq (sum X Y) z' (inl X Y x') -> A x' x -> E) ->
(forall y y' : Y,
eq (sum X Y) z (inr X Y y) -> eq (sum X Y) z' (inr X Y y') -> B y' y -> E) ->
(eq (sum X Y) z' (inl X Y a) -> eq (sum X Y) z (out X Y) -> E) ->
(eq (sum X Y) z' (inr X Y b) -> eq (sum X Y) z (out X Y) -> E) -> E.
(** The introduction rules corresponding to the 4 clauses of the definition of (PAIR X A a Y B b) are the following: *)
Proof
fun X A a Y B b x x' H E H1 H2 H3 H4 =>
H1 x x' (eq_refl (sum X Y) (inl X Y x)) (eq_refl (sum X Y) (inl X Y x')) H.
Proof
fun X A a Y B b y y' H E H1 H2 H3 H4 =>
H2 y y' (eq_refl (sum X Y) (inr X Y y)) (eq_refl (sum X Y) (inr X Y y')) H.
Proof
fun X A a Y B b E H1 H2 H3 H4 =>
H3 (eq_refl (sum X Y) (inl X Y a)) (eq_refl (sum X Y) (out X Y)).
Proof
fun X A a Y B b E H1 H2 H3 H4 =>
H4 (eq_refl (sum X Y) (inr X Y b)) (eq_refl (sum X Y) (out X Y)).
(** We first check that the left injection (inl X Y) : X -> (sum X Y) is a delocation, and deduce that the pointed graphs (X, A, a) and ((sum X Y), (PAIR X A a Y B b), (inl X Y a)) are bisimilar. *)
(** The same for the right injection (inr X Y) : Y -> (sum X Y). *)
(** From PAIR_eqv1 and PAIR_eqv2, we easily get that the pointed graphs (X, A, a) and (Y, B, b) are elements of the unordered pair. *)

Lemma pairing_intro1 :
forall (X : Typ1) (A : Rel X) (a : X) (Y : Typ1) (B : Rel Y) (b : Y),
ELT X A a (sum X Y) (PAIR X A a Y B b) (out X Y).