Inductive cumul : env -> term -> term -> Prop :=
| c_eq : forall (e : env) (x y : term), conv hdr e x y -> cumul e x y
| c_rule :
forall (e : env) (s1 s2 : sort),
univ s1 s2 -> cumul e (Srt s1) (Srt s2)
| c_prod :
forall (e : env) (A B C D : term),
cumul e C A -> cumul (Ax C :: e) B D -> cumul e (Prod A B) (Prod C D).
Let rt_univ := clos_refl_trans _ univ.
Let rt_cumul := R_rt cumul.
Let cumul_trans :
forall (e : env) (x y z : term),
rt_cumul e x y -> rt_cumul e y z -> rt_cumul e x z.
Proof fun e : env => rt_trans term (cumul e).
Hint Unfold rt_univ rt_cumul: pts.
Hint Resolve c_eq c_rule c_prod: pts.
Definition cumul_rule : Basic_rule.
apply Build_Basic_rule with cumul.
red in |- *.
simple induction 1; simpl in |- *; intros; auto with arith pts.
apply c_eq.
apply (conv_lift _ lifts) with (2 := H1); auto with arith pts.
apply c_prod; auto with arith pts.
apply H3.
replace (Ax (lift_rec 1 C k)) with (lift_decl 1 (Ax C) k);
auto with arith pts.
red in |- *.
simple induction 1; simpl in |- *; intros; auto with arith pts.
red in |- *.
cut (R_rt (conv hdr) f (subst_rec s x n) (subst_rec s y n)).
simple induction 1; intros; auto with arith pts.
apply rt_trans with y0; auto with arith pts.
apply (conv_subst _ substs) with (2 := H1); auto with arith pts.
red in |- *.
apply rt_trans with (Prod (subst_rec s C n) (subst_rec s B (S n))).
elim H1 with n f; intros; auto with arith pts.
auto 10 with arith pts.
apply rt_trans with (Prod y (subst_rec s B (S n))); auto with arith pts.
elim H3 with (S n) (subst_decl s (Ax C) n :: f); intros;
auto 10 with arith pts.
apply rt_trans with (Prod (subst_rec s C n) y); auto with arith pts.
red in |- *.
simple induction 1; intros; auto with arith pts.
apply c_eq.
apply stable_conv with R' e0; auto with arith pts.
Defined.
Definition cts_pts_functor : PTS_sub_spec :=
Build_PTS_sub_spec axiom rule (canonical_subtyping cumul_rule).
(* other properties *)
Let stable_rt_cumul : R_stable_env rt_cumul.
Proof R_rt_stable cumul (R_stable cumul_rule).

(* Specifications: *)
Lemma cumul_prod :
forall (e : env) (T A B : term),
rt_cumul (Ax T :: e) A B -> rt_cumul e (Prod T A) (Prod T B).