(* 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                                                     *)
(***************************************************)
(** * 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. *)
(** 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.
(** It is then easy to check the expected property of non-confusion holds for the constructors foo_in and foo_rt: *)
Proof fun X Y Z x y R z e => e (fun u => u (fun _ _ _ _ => top)) top_intro.

Lemma eq_foo_rt_in :
forall (X Y : Typ1) (Z : X -> Y -> Typ1) (x : X) (y : Y)
(R : Rel (Z x y)) (z : Z x y),
eq (foo X Y Z) (foo_rt X Y Z) (foo_in X Y Z x y R z) -> bot.