Record PTS_sub_spec : Type :=
{pts_axiom : relation sort;
pts_rules : sort -> sort -> sort -> Prop;
pts_le_type : Subtyping_rule}.
Load "PTS_spec".
Inductive wf : env -> Prop :=
| wf_nil : wf nil
| wf_var :
forall (e : env) (T : term) (s : sort),
typ e T (Srt s) -> wf (Ax T :: e)
| wf_cst :
forall (e : env) (t T : term) (s : sort),
typ e t T -> typ e T (Srt s) -> wf (Def t T :: e)
with typ : env -> term -> term -> Prop :=
| type_ax :
forall (e : env) (s1 s2 : sort),
wf e -> axiom s1 s2 -> typ e (Srt s1) (Srt s2)
| type_var :
forall (e : env) (v : nat) (t : term),
wf e -> item_lift t e v -> typ e (Ref v) t
| type_abs :
forall (e : env) (T U M : term) (s : sort),
typ e (Prod T U) (Srt s) ->
typ (Ax T :: e) M U -> typ e (Abs T M) (Prod T U)
| type_app :
forall (e : env) (u v V Ur : term),
typ e v V -> typ e u (Prod V Ur) -> typ e (App u v) (subst v Ur)
| type_prod :
forall (e : env) (T U : term) (s1 s2 s3 : sort),
typ e T (Srt s1) ->
typ (Ax T :: e) U (Srt s2) ->
rule s1 s2 s3 -> typ e (Prod T U) (Srt s3)
| type_conv :
forall (e : env) (t U V : term) (s : sort),
typ e t U ->
le_type e U V ->
typ e V (Srt s) ->
typ e t V
(* sert uniquement quand il y a des sortes non typees: *)
| type_conv_srt :
forall (e : env) (t U : term) (s : sort),
typ e t U -> le_type e U (Srt s) -> typ e t (Srt s).
Hint Resolve wf_nil type_ax type_var: pts.
Definition rule_sat (s1 s2 s3 : sort) : Prop :=
exists2 x1, le_sort s1 x1 & exists2 x2, le_sort s2 x2 & rule x1 x2 s3.
intros.
inversion_clear H1.
inversion_clear H3.
apply type_prod with x x0; trivial with arith pts.
apply type_conv_srt with (Srt s1); auto with arith pts.
apply type_conv_srt with (Srt s2); auto with arith pts.
Qed.
simple induction 1; auto with arith pts.
Qed.
intros.
inversion_clear H.
apply typ_wf with T (Srt s); auto with arith pts.
apply typ_wf with T (Srt s); auto with arith pts.
Qed.
intros.
inversion_clear H; exists s; auto with arith pts.
Qed.
Inductive wf_type (e : env) : term -> Prop :=
| wft_typed :
forall (T : term) (s : sort), typ e T (Srt s) -> wf_type e T
| wft_top : forall s : sort, wf_type e (Srt s).
Hint Resolve wft_top: pts.
Definition le_type_wf : red_rule :=
fun e => clos_refl_trans _ (fun x y => le_type e x y /\ wf_type e y).
(* Lemma le_type_wf_le: (e:env)(x,y:term)(le_type_wf e x y)->(le_type e x y). *)
Definition inv_typ (e : env) (t T : term) (P : Prop) : Prop :=
match t with
| Srt s1 => forall s2 : sort, axiom s1 s2 -> le_type e (Srt s2) T -> P
| Ref n =>
forall x : decl,
item x e n -> le_type e (lift (S n) (typ_of_decl x)) T -> P
| Abs A M =>
forall (s : sort) (U : term),
typ (Ax A :: e) M U ->
typ e (Prod A U) (Srt s) -> le_type e (Prod A U) T -> P
| App u v =>
forall Ur V : term,
typ e v V -> typ e u (Prod V Ur) -> le_type e (subst v Ur) T -> P
| Prod A B =>
forall s1 s2 s3 : sort,
rule s1 s2 s3 ->
typ e A (Srt s1) ->
typ (Ax A :: e) B (Srt s2) -> le_type e (Srt s3) T -> P
end.
do 5 intro.
cut (forall x : term, le_type e x U -> le_type e x V).
case t; simpl in |- *; intros.
apply H1 with s2; auto with arith pts.
apply H1 with x; auto with arith pts.
apply H1 with s U0; auto with arith pts.
apply H1 with Ur V0; auto with arith pts.
apply H1 with s1 s2 s3; auto with arith pts.
intros.
apply le_type_trans with U; auto with arith pts.
Qed.
intros e t T P inv_P j.
generalize P inv_P; clear inv_P P.
elim j; simpl in |- *; intros.
apply inv_P with s2; trivial with arith pts.
inversion_clear H0.
apply inv_P with x; trivial with arith pts.
elim H1; trivial with arith pts.
apply inv_P with s U; auto with arith pts.
apply inv_P with Ur V; auto with arith pts.
apply inv_P with s1 s2 s3; auto with arith pts.
apply H0.
apply inv_typ_conv with V; auto with arith pts.
apply H0.
apply inv_typ_conv with (Srt s); auto with arith pts.
Qed.
Ltac Inversion_typ T :=
let INVTYP := fresh "INVTYP" in
(generalize T; intro INVTYP; inversion INVTYP using inversion_lemma;
unfold inv_typ in |- *; clear INVTYP; intros).
simple destruct 1; try constructor; intros.
apply typ_free_db with (1 := H0).
Qed.
Hint Resolve wft_free_db: pts.
simple induction 1; simpl in |- *; intros; auto with arith pts.
elim (le_gt_dec n v); intros; apply type_var; auto with arith pts.
elim H1; intros.
rewrite H4.
unfold lift in |- *.
rewrite simpl_lift_rec; simpl in |- *; auto with arith pts.
exists x; auto with arith pts.
apply ins_item_ge with (1 := H2); auto with arith pts.
apply ins_item_lift_lt with (1 := H2); auto with arith pts.
cut (wf (Ax (lift_rec 1 T0 n) :: f)).
intro.
apply type_abs with s; auto with arith pts.
fold (lift_decl 1 (Ax T0) n) in |- *; auto with arith pts.
Inversion_typ (H1 _ _ H4 H5).
apply wf_var with s1; auto with arith pts.
rewrite distr_lift_subst.
apply type_app with (lift_rec 1 V n); auto with arith pts.
cut (wf (Ax (lift_rec 1 T0 n) :: f)).
intro.
apply type_prod with s1 s2; auto with arith pts.
fold (lift_decl 1 (Ax T0) n) in |- *; auto with arith pts.
apply wf_var with s1; auto with arith pts.
apply type_conv with (lift_rec 1 U n) s; auto with arith pts.
apply le_type_lift with (2 := H5); trivial with arith pts.
apply type_conv_srt with (lift_rec 1 U n); auto with arith pts.
fold (lift_rec 1 (Srt s) n) in |- *.
apply le_type_lift with (2 := H3); auto with arith pts.
Qed.

Theorem thinning :
forall (e : env) (t T : term) (d : decl),
typ e t T -> wf (d :: e) -> typ (d :: e) (lift 1 t) (lift 1 T).