(* 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                                                     *)
(** To define the type of natural numbers, we introduce an extra universe Typ0 *below* the universe Typ1 (so that we are now working in the PTS lambda-omega.3).  Another possibility would be to consider an axiomatized type of natural numbers (as in the author's LICS submission). *)
Definition Typ0 : Typ1 := Type.
(*******************************************)
(** * The type of Church numerals in Typ1  *)
(*******************************************)
(** ** Definition of natural numbers **)
(** Notice that the following definition is *predicative*, and the dependent product ranging over all X:Typ0 builds a type in the next universe Typ1.  In practice, this "predicativisation" of the type of natural numbers induces some minor changes in the implementation of the predecessor function. *)
Definition nat : Typ1 := forall X : Typ0, X -> (X -> X) -> X.
Definition O : nat := fun X x f => x.
Definition S (n : nat) : nat := fun X x f => f (n X x f).
(** A natural number is `well-formed' if it is in the smallest class containing zero and closed under the successor function. *)
Definition wf_nat (n : nat) : Prop :=
forall P : nat -> Prop, P O -> (forall p : nat, P p -> P (S p)) -> P n.
(** ** The predecessor function **)
(** For any type X : Typ0, we define the pseudo-square (sqr X) : Typ0 and the constructor (pair X) : X->X->(sqr X) by setting: *)
Definition sqr (X : Typ0) : Typ0 := (X -> X -> X) -> X.
Definition pair (X : Typ0) (x y : X) : sqr X := fun f => f x y.
(** The corresponding projections *)
Definition fst (X : Typ0) (p : sqr X) : X := p (fun x _ => x).
Definition snd (X : Typ0) (p : sqr X) : X := p (fun _ y => y).
(** enjoy the expected definitional equalities:  (fst X (pair X x y)) = x   and   (snd X (pair X x y)) = y. *)
(** Now, consider an arbitrary function f : X->X.  From this function, we define a function  (step X f) : (sqr X)->(sqr X)  that maps the pair (x, y) to the pair (y, (f y)) by setting: *)
Definition step (X : Typ0) (f : X -> X) (p : sqr X) :
sqr X := pair X (snd X p) (f (snd X p)).
(** If we iterate the function (step X f) from an arbitrary pair of the form (x, x), we obtain  (step X f)^0 (x, x) = (x, x) (step X f)^1 (x, x) = (x, (f x)) (step X f)^2 (x, x) = ((f x), (f (f x)) ... (step X f)^n (x, x) = ((f ... (f x) ...), (f ... (f x) ...)) ^^^^^^^^           ^^^^^^^^ n-1 times          n times  By extracting the first component of the result and abstracting it w.r.t. the variables X:Typ0, x:X and f:X->X, we thus obtain the predecessor of Church numeral n.  This is how the predecessor function is implemented: *)
Definition pred (n : nat) : nat :=
fun X x f => fst X (n (sqr X) (pair X x x) (step X f)).
(** We easily check the following definitional equalities: *)
Proof eq_refl nat O.
Proof eq_refl nat O.
(** The following equality is really definitional! "I can see it, but I don't believe it"... *)
Proof fun n => eq_refl nat (pred (S (S n))).
(** From this, we prove that the predecessor cancels a previous application of the successor function (by induction) *)
(*******************************)
(** * Deriving Peano's axioms  *)
(*******************************)
(** ** First axiom of Peano **)
Proof fun P HO HS => HO.
(** ** Second axiom of Peano **)
Proof fun n H P HO HS => HS n (H P HO HS).
(** ** Third axiom of Peano **)
Proof fun n _ H => H (fun p => p Prop bot (fun _ => top)) top_intro.
Proof fun n _ H => H (fun p => p Prop top (fun _ => bot)) top_intro.
(** Note that in the proofs of the two lemmas above, the assumption (wf_nat n) is not used. *)
(** ** Fourth axiom of Peano **)
(** ** Fifth axiom of Peano **)
Proof fun n Hn P HO HS => nat_ind P HO HS n Hn.
(****************)
(** * Ordering  *)
(****************)
Definition le (n m : nat) : Prop :=
forall P : nat -> Prop, P n -> (forall p : nat, P p -> P (S p)) -> P m.
(** This relation is reflexive and transitive, and closed under the successor function.  Notice that these lemmas do not rely on the well-formedness assumption: *)
Proof fun n P H _ => H.
Proof fun n1 n2 n3 H1 H2 P Hn1 HS => H2 P (H1 P Hn1 HS) HS.
Proof fun n m H P Hn HS => HS m (H P Hn HS).
(** The successor of a natural number cannot be less than or equal to zero: *)
Proof
fun n H =>
H (fun k => k Prop bot (fun _ => top)) top_intro (fun _ _ => top_intro).
(** Inversion lemma for (le n m): *)

Lemma le_inv :
forall n m : nat,
le n m -> or (eq nat n m) (ex nat (fun k => and (le n k) (eq nat m (S k)))).