(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(****************************************************************************)
(*                 The Calculus of Inductive Constructions                  *)
(*                                                                          *)
(*                                Projet Coq                                *)
(*                                                                          *)
(*                     INRIA                        ENS-CNRS                *)
(*              Rocquencourt                        Lyon                    *)
(*                                                                          *)
(*                                Coq V5.10                                 *)
(*                              Nov 25th 1994                               *)
(*                                                                          *)
(****************************************************************************)
(*                                  Pol2.v                                  *)
(****************************************************************************)
(*****************************************************************************)
(*          Projet Coq  - Calculus of Inductive Constructions V5.8           *)
(*****************************************************************************)
(*                                                                           *)
(*      Meta-theory of the explicit substitution calculus lambda-env         *)
(*      Amokrane Saibi                                                       *)
(*                                                                           *)
(*      September 1993                                                       *)
(*                                                                           *)
(*****************************************************************************)
(* Preuve de terminaison: polynome P2 *)
Definition e_P2 (b : wsort) (U : TS b) : nat :=
(fix F (w : wsort) (t : TS w) {struct t} : nat :=
match t with
| var _ => 1
| app t0 t1 => S (F wt t0 + F wt t1)
| lambda t0 => 2 * F wt t0
| env t0 t1 => F wt t0 * S (F ws t1)
| id => 1
| shift => 1
| cons t0 t1 => S (F wt t0 + F ws t1)
| comp t0 t1 => F ws t0 * S (F ws t1)
| lift t0 => 4 * F ws t0
| meta_X _ => 1
| meta_x _ => 1
end) b U.
(* var *)
(* app *)
(* lam *)
(* env *)
(*  id *)
(*  |  *)
(*  .  *)
(*  o  *)
(*  || *)
(*  X  *)
(*  x  *)
Notation P2 := (e_P2 _) (only parsing).
(* <Warning> : Syntax is discontinued *)
Hint Resolve P2_pos.
Hint Resolve P2_app.
Hint Resolve P2_lambda.
Hint Resolve P2_clos.
Hint Resolve P2_varshift1.
Hint Resolve P2_varshift2.
Hint Resolve P2_fvarcons.
Hint Resolve P2_fvarlift1.
Hint Resolve P2_fvarlift2.
Hint Resolve P2_rvarcons.
Hint Resolve P2_rvarlift1.
Hint Resolve P2_rvarlift2.
Hint Resolve P2_assenv.
Hint Resolve P2_mapenv.
Hint Resolve P2_shiftcons.

Theorem P2_shiftlift1 :
forall M N : sub_explicits, reg_shiftlift1 M N -> e_P2 _ M > e_P2 _ N.