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.
(* Realizer [e:env; t:term] Cases (whnf e t) of (Srt s) => (inleft ? s) | _ => (inright sort) end. *)
intros.
case (whnf e t); auto with pts.
simple destruct x; intros.
left; exists s.
split; simpl in |- *; intros.
auto with arith pts.
replace (R_rt cumul) with (Rule (Le_type (pts_le_type cts_pts_functor)));
trivial with arith pts.
apply sub_sort_env_indep with e; simpl in |- *.
apply cumul_trans with t; auto 10 with arith pts.
right; red in |- *; intros.
cut (cumul_hn_inv e (Ref n) (Srt x0)); intros.
inversion_clear H1.
apply inv_cumul_hn with t (Srt x0); auto with arith pts.
right; red in |- *; intros.
cut (cumul_hn_inv e (Abs t0 t1) (Srt x0)); intros.
inversion_clear H1.
apply inv_cumul_hn with t (Srt x0); auto with arith pts.
right; red in |- *; intros.
cut (cumul_hn_inv e (App t0 t1) (Srt x0)); intros.
inversion_clear H1.
apply inv_cumul_hn with t (Srt x0); auto with arith pts.
right; red in |- *; intros.
cut (cumul_hn_inv e (Prod t0 t1) (Srt x0)); intros.
inversion_clear H1.
apply inv_cumul_hn with t (Srt x0); auto with arith pts.
Qed.

Lemma cumul_least_prod :
forall (e : env) (t : term),
wf_type cts_pts_functor e t -> red_to_wf_prod_dec cts_pts_functor e t.