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).
simple induction 1; intros; auto 10 with arith pts.
apply cumul_trans with (Prod T y); auto with arith pts.
Qed.
(* inversion de rt_cumul *)
Inductive cumul_hn_inv : env -> term -> term -> Prop :=
| cuhi_srt :
forall (e : env) (s s' : sort),
rt_univ s s' -> cumul_hn_inv e (Srt s) (Srt s')
| cuhi_ref : forall (e : env) (n : nat), cumul_hn_inv e (Ref n) (Ref n)
| cuhi_abs :
forall (e : env) (A A' M M' : term),
conv hdr e A A' ->
conv hdr (Ax A' :: e) M M' -> cumul_hn_inv e (Abs A M) (Abs A' M')
| cuhi_app :
forall (e : env) (u u' v v' : term),
conv hdr e u u' ->
conv hdr e v v' -> cumul_hn_inv e (App u v) (App u' v')
| cuhi_prod :
forall (e : env) (A A' B B' : term),
rt_cumul e A' A ->
rt_cumul (Ax A' :: e) B B' -> cumul_hn_inv e (Prod A B) (Prod A' B').
Hint Resolve cuhi_srt cuhi_ref cuhi_abs cuhi_app cuhi_prod: pts.

Lemma inv_cumul_trans :
forall (e : env) (x y z : term),
cumul_hn_inv e x y -> cumul_hn_inv e y z -> cumul_hn_inv e x z.