Record norm_sound_CTS : Set :=
{ncts_sr : rule_sound cts_pts_functor hdr;
ncts_typ_sn :
forall (e : env) (t T : term),
typ cts_pts_functor e t T -> sn red_step e t;
ncts_axiom : forall s : sort, ppal_dec (axiom s) rt_univ;
ncts_rule :
forall x1 x2 : sort,
{x3 : sort | rule x1 x2 x3 &
forall s1 s2 s3 : sort,
rule s1 s2 s3 -> rt_univ x1 s1 -> rt_univ x2 s2 -> rt_univ x3 s3};
ncts_hierarchy :
forall s1 s2 : sort,
rt_univ s1 s2 -> typed_sort axiom s2 -> typed_sort axiom s1}.
Variable the_ncts : norm_sound_CTS.
(* open it *)
Let subj_red := ncts_sr the_ncts.
Let typ_sn :
forall (e : env) (t T : term),
typ cts_pts_functor e t T -> sn red_step e t :=
ncts_typ_sn the_ncts.
Let inf_axiom := ncts_axiom the_ncts.
Let inf_rule := ncts_rule the_ncts.
Let univ_hierarchy := ncts_hierarchy the_ncts.
simple induction 1; intros.
apply typ_sn with (Srt s); auto with arith pts.
red in |- *.
apply Acc_intro; intros.
inversion_clear H0.
elim shn_sort with e s (Srt s) y; auto with arith pts.
Qed.
Hint Resolve cumul_type_sn: pts.
unfold red, hdr in |- *.
apply clos_refl_trans_sound.
apply ctxt_sound; simpl in |- *; auto 10 with arith pts.
Qed.
simple induction 1; intros.
apply wft_typed with s.
apply subject_reduction_cumul with T0; auto with arith pts.
cut (conv_hn_inv hd_rule e (Srt s) U); intros.
inversion_clear H1; auto with arith pts.
apply inv_red_hn; auto with arith pts.
Qed.

Lemma cumul_least_sort :
forall (e : env) (t : term),
wf_type cts_pts_functor e t -> red_to_sort_dec cts_pts_functor e t.