(** 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.
(* ********************************************************************** *)
(** ** Type substitution preserves subtyping (10) *)
Proof with
simpl_env;
eauto 4 using wf_typ_subst_tb, wf_env_subst_tb, wf_typ_weaken_head.
intros Q E F Z S T P SsubT PsubQ.
remember (F ++ Z ~ bind_sub Q ++ E) as G.
generalize dependent F.
induction SsubT; intros G EQ; subst; simpl subst_tt...
Case "sub_top".
apply sub_top...
Case "sub_refl_tvar".
destruct (X == Z); subst.
SCase "X = Z".
apply sub_reflexivity...
SCase "X <> Z".
apply sub_reflexivity...
inversion H0; subst.
analyze_binds H3...
apply (wf_typ_var (subst_tt Z P U))...
Case "sub_trans_tvar".
destruct (X == Z); subst.
SCase "X = Z".
apply (sub_transitivity Q).
SSCase "left branch".
rewrite_env (empty ++ map (subst_tb Z P) G ++ E).
apply sub_weakening...
SSCase "right branch".
rewrite (subst_tt_fresh Z P Q).
analyze_binds_uniq H.
inversion BindsTacVal; subst...
apply (notin_fv_wf E); eauto using fresh_mid_tail.
SCase "X <> Z".
apply (sub_trans_tvar (subst_tt Z P U))...
rewrite (map_subst_tb_id E Z P);
[ | auto | eapply fresh_mid_tail; eauto ].
analyze_binds H...
Case "sub_all".
pick fresh X and apply sub_all...
rewrite subst_tt_open_tt_var...
rewrite subst_tt_open_tt_var...
rewrite_env (map (subst_tb Z P) (X ~ bind_sub T1 ++ G) ++ E).
apply H0...
Qed.
(* ********************************************************************** *)
(** * #<a name="typing"></a># Properties of typing *)
(* ********************************************************************** *)
(** ** Weakening (5) *)
Proof with simpl_env;
eauto using wf_typ_weakening,
wf_typ_from_wf_env_typ,
wf_typ_from_wf_env_sub,
sub_weakening.
intros E F G e T Typ.
remember (G ++ E) as H.
generalize dependent G.
induction Typ; intros G EQ Ok; subst...
Case "typing_abs".
pick fresh x and apply typing_abs.
lapply (H x); [intros K | auto].
rewrite <- app_assoc.
apply (H0 x)...
Case "typing_tabs".
pick fresh X and apply typing_tabs.
lapply (H X); [intros K | auto].
rewrite <- app_assoc.
apply (H0 X)...
Case "typing_let".
pick fresh x and apply typing_let...
lapply (H0 x); [intros K | auto].
rewrite <- app_assoc.
apply H0...
Case "typing_case".
pick fresh x and apply typing_case...
SCase "inl branch".
lapply (H0 x); [intros K | auto].
rewrite <- app_assoc.
apply H0...
assert (J : wf_typ (G ++ F ++ E) (typ_sum T1 T2))...
inversion J...
SCase "inr branch".
lapply (H2 x); [intros K | auto].
rewrite <- app_assoc.
apply H2...
assert (J : wf_typ (G ++ F ++ E) (typ_sum T1 T2))...
inversion J...
Qed.
(* ********************************************************************** *)
(** ** Strengthening (6) *)
Proof with eauto using wf_typ_strengthening, wf_env_strengthening.
intros x U E F S T SsubT.
remember (F ++ x ~ bind_typ U ++ E) as E'.
generalize dependent F.
induction SsubT; intros F EQ; subst...
Case "sub_trans_tvar".
apply (sub_trans_tvar U0)...
analyze_binds H...
Case "sub_all".
pick fresh X and apply sub_all...
rewrite <- app_assoc.
apply H0...
Qed.
(************************************************************************ *)
(** ** Narrowing for typing (7) *)

Lemma typing_narrowing : forall Q E F X P e T,
sub E P Q ->
typing (F ++ X ~ bind_sub Q ++ E) e T ->
typing (F ++ X ~ bind_sub P ++ E) e T.