(** Type-safety proofs for Fsub.  Authors: Brian Aydemir and Arthur Chargu\'eraud, with help from Aaron Bohannon, Jeffrey Vaughan, and Dimitrios Vytiniotis.  In parentheses are given the label of the corresponding lemma in the appendix (informal proofs) of the POPLmark Challenge.  Table of contents: - #<a href="##subtyping">Properties of subtyping</a># - #<a href="##typing">Properties of typing</a># - #<a href="##preservation">Preservation</a># - #<a href="##progress">Progress</a># *)
Require Export Fsub.Fsub_LetSum_Lemmas.
(* ********************************************************************** *)
(** * #<a name="subtyping"></a># Properties of subtyping *)
(* ********************************************************************** *)
(** ** Reflexivity (1) *)
Proof with eauto.
intros E T Ok Wf.
induction Wf...
pick fresh Y and apply sub_all...
Qed.
(* ********************************************************************** *)
(** ** Weakening (2) *)
Proof with simpl_env; auto using wf_typ_weakening.
intros E F G S T Sub Ok.
remember (G ++ E) as H.
generalize dependent G.
induction Sub; intros G Ok EQ; subst...
Case "sub_trans_tvar".
apply (sub_trans_tvar U)...
Case "sub_all".
pick fresh Y and apply sub_all...
rewrite <- app_assoc.
apply H0...
Qed.
(* ********************************************************************** *)
(** ** Narrowing and transitivity (3) *)
Definition transitivity_on Q := forall E S T,
sub E S Q -> sub E Q T -> sub E S T.
Proof with simpl_env; eauto using wf_typ_narrowing, wf_env_narrowing.
intros Q F E Z P S T TransQ SsubT PsubQ.
remember (F ++ Z ~ bind_sub Q ++ E) as G. generalize dependent F.
induction SsubT; intros F EQ; subst...
Case "sub_trans_tvar".
destruct (X == Z); subst.
SCase "X = Z".
apply (sub_trans_tvar P); [ eauto using fresh_mid_head | ].
apply TransQ.
SSCase "P <: Q".
rewrite_env (empty ++ (F ++ Z ~ bind_sub P) ++ E).
apply sub_weakening...
SSCase "Q <: T".
analyze_binds_uniq H.
injection BindsTacVal; intros; subst...
SCase "X <> Z".
apply (sub_trans_tvar U)...
Case "sub_all".
pick fresh Y and apply sub_all...
rewrite <- app_assoc.
apply H0...
Qed.
Proof with simpl_env; auto.
unfold transitivity_on.
intros Q E S T SsubQ QsubT.
assert (W : type Q) by auto.
generalize dependent T.
generalize dependent S.
generalize dependent E.
remember Q as Q' in |- *.
generalize dependent Q'.
induction W;
intros Q' EQ E S SsubQ;
induction SsubQ; try discriminate; inversion EQ; subst;
intros T' QsubT;
inversion QsubT; subst; eauto 4 using sub_trans_tvar.
Case "sub_all / sub_top".
assert (sub E (typ_all S1 S2) (typ_all T1 T2)).
SCase "proof of assertion".
pick fresh y and apply sub_all...
auto.
Case "sub_all / sub_all".
pick fresh Y and apply sub_all.
SCase "bounds".
eauto.
SCase "bodies".
lapply (H0 Y); [ intros K | auto ].
apply (K (open_tt T2 Y))...
rewrite_env (empty ++ Y ~ bind_sub T0 ++ E).
apply (sub_narrowing_aux T1)...
unfold transitivity_on.
auto using (IHW T1).
Qed.

Lemma sub_narrowing : forall Q E F Z P S T,
sub E P Q ->
sub (F ++ Z ~ bind_sub Q ++ E) S T ->
sub (F ++ Z ~ bind_sub P ++ E) S T.