(***************************************************)
(** * The intuitionistic Hilbert epsilon operator  *)
(***************************************************)

(** The following axioms mimick (a specialized version of) the
    intuitionistic Hilbert epsilon operator described in the
    author's LICS'03 submitted paper. *)

(** We first introduce a type of codes, that could be defined as a
    primitive type of natural numbers by following the paper.  But
    since the actual structure of its inhabitants will never be
    used in the forthcoming proofs, we prefer to keep it abstract. *)

Axiom Code : Typ1.(* We could set Code := nat. *)

(** We now introduce a specialized version of the epsilon operator
    described in the paper.  This version only works for predicates
    over the (large) type Typ1, which is sufficent for what we want
    to prove (i.e. the collection scheme). *)

Axiom eps : (Typ1 -> Prop) -> Code -> Typ1.(** The following axiom states that if a predicate P : Typ1->Prop
    holds for some type X : Typ1, then there exists a code c : Code
    such that P holds for (eps P c).

    Technically, this axiom shows that we can always replace an
    existential statement over a large type (i.e. Typ1) by an
    existential statement over a small type (i.e. Code), which is
    crucial for interpreting the collection scheme. *)

Axiom
  choice : forall P : Typ1 -> Prop, exT P -> ex Code (fun c => P (eps P c)).(*********************************************)
(** * An implementation of a super-powerset  *)
(*********************************************)

(** On a fixed small type Z, we can build several pointed graphs of
    the form (Z, A, a), whose two extra parameters A and a range over
    (Rel Z) and Z respectively.  But since the cartesian product
    (Rel Z) * Z is itself a small type, it is not difficult to build
    a variant of the powerset (foo, FOO, foo_rt) that contains all the
    pointed graphs of the form (Z, A, a), that is, a pointed graph
    (called the "super-powerset" of Z) such that

                      (Z, A, a) \in (foo, FOO, foo_rt)

    for any edge relation A : (Rel A) and for any root a : Z.

    In what follows, we propose to achieve this construction, but in
    a more general setting.  For that, instead of considering a small
    type Z : Typ1, we will rather consider a family of small types
    Z : X->Y->Typ1 indexed by the inhabitants of two given small types
    X, Y : Typ1, and from these parameters, we propose to build a
    pointed graph ((foo X Y Z), (FOO X Y Z), (foo_rt X Y Z)) such that

      ((Z x y), A, a) \in ((foo X Y Z), (FOO X Y Z), (foo_rt X Y Z))

    for any x : X, y : Y, A : (Rel (Z x y)) and a : (Z x y).
    Intuitively, this pointed graph represents the union of the
    super-powersets associated to the carriers (Z x y) when x and
    y range over the small types X and Y respectively. *)

(** ** Building the carrier of the super-powerset **)

(** The carrier (foo X Y Z) of the super-powerset associated to a
    given family of small types Z : X->Y->Typ1 indexed by two small
    types X and Y would be naturally defined in Coq as follows:

      Inductive foo [X,Y:Typ1; Z:X->Y->Typ1] : Typ1 :=
      | foo_in : (x:X; y:Y)(Rel (Z x y))->(Z x y)->(foo X Y Z)
      | foo_rt : (foo X Y Z).

    Intuitively, this type is the disjoint union of the cartesian
    products (Rel (Z x y)) * (Z x y) where x and y range over X and
    Y respectively, plus an extra element (foo_rt X Y Z) that will
    be used as the new root.  In our framework, this inductive
    definition is easily mimicked as follows: *)

Definition foo (X Y : Typ1) (Z : X -> Y -> Typ1) : Typ1 :=
  (forall (x : X) (y : Y), Rel (Z x y) -> Z x y -> Prop) -> Prop.Definition foo_in (X Y : Typ1) (Z : X -> Y -> Typ1) 
  (x : X) (y : Y) (R : Rel (Z x y)) (z : Z x y) : foo X Y Z :=
  fun f => f x y R z.Definition foo_rt (X Y : Typ1) (Z : X -> Y -> Typ1) : 
  foo X Y Z := fun _ => bot.

Lemma eq_foo_in_in : forall (X Y : Typ1) (Z : X -> Y -> Typ1) (x1 x2 : X) (y1 y2 : Y) (R1 : Rel (Z x1 y1)) (R2 : Rel (Z x2 y2)) (z1 : Z x1 y1) (z2 : Z x2 y2), (* Equality of the images... *) eq (foo X Y Z) (foo_in X Y Z x1 y1 R1 z1) (foo_in X Y Z x2 y2 R2 z2) (* ... implies dependent equality: *) -> forall P : forall (x : X) (y : Y), Rel (Z x y) -> Z x y -> Prop, P x1 y1 R1 z1 -> P x2 y2 R2 z2.