(** Administrative lemmas for Fsub.  Authors: Brian Aydemir and Arthur Chargu\'eraud, with help from Aaron Bohannon, Jeffrey Vaughan, and Dimitrios Vytiniotis.  This file contains a number of administrative lemmas that we require for proving type-safety.  The lemmas mainly concern the relations [wf_typ] and [wf_env].  This file also contains regularity lemmas, which show that various relations hold only for locally closed terms.  In addition to being necessary to complete the proof of type-safety, these lemmas help demonstrate that our definitions are correct; they would be worth proving even if they are unneeded for any "real" proofs.  Table of contents: - #<a href="##wft">Properties of wf_typ</a># - #<a href="##oktwft">Properties of wf_env and wf_typ</a># - #<a href="##okt">Properties of wf_env</a># - #<a href="##subst">Properties of substitution</a># - #<a href="##regularity">Regularity lemmas</a># - #<a href="##auto">Automation</a># *)
Require Export Fsub.Fsub_LetSum_Infrastructure.
(* ********************************************************************** *)
(** * #<a name="wft"></a># Properties of [wf_typ] *)
(** If a type is well-formed in an environment, then it is locally closed. *)
(** The remaining properties are analogous to the properties that we need to show for the subtyping and typing relations. *)
Proof with simpl_env; eauto.
intros T E F G Hwf_typ Hk.
remember (G ++ E) as F'.
generalize dependent G.
induction Hwf_typ; intros G Hok Heq; subst...
Case "type_all".
pick fresh Y and apply wf_typ_all...
rewrite <- app_assoc.
apply H0...
Qed.
Proof with simpl_env; eauto.
intros V U T E F X Hwf_typ.
remember (F ++ X ~ bind_sub V ++ E) as G.
generalize dependent F.
induction Hwf_typ; intros F Heq; subst...
Case "wf_typ_var".
analyze_binds H...
Case "typ_all".
pick fresh Y and apply wf_typ_all...
rewrite <- app_assoc.
apply H0...
Qed.
Proof with simpl_env; eauto.
intros E F x U T H.
remember (F ++ x ~ bind_typ U ++ E) as G.
generalize dependent F.
induction H; intros F Heq; subst...
Case "wf_typ_var".
analyze_binds H...
Case "wf_typ_all".
pick fresh Y and apply wf_typ_all...
rewrite <- app_assoc.
apply H1...
Qed.
Proof with simpl_env; eauto using wf_typ_weaken_head, type_from_wf_typ.
intros F Q E Z P T WT WP.
remember (F ++ Z ~ bind_sub Q ++ E) as G.
generalize dependent F.
induction WT; intros F EQ Ok; subst; simpl subst_tt...
Case "wf_typ_var".
destruct (X == Z); subst...
SCase "X <> Z".
analyze_binds H...
apply (wf_typ_var (subst_tt Z P U))...
Case "wf_typ_all".
pick fresh Y and apply wf_typ_all...
rewrite subst_tt_open_tt_var...
rewrite_env (map (subst_tb Z P) (Y ~ bind_sub T1 ++ F) ++ E).
apply H0...
Qed.
Proof with simpl_env; eauto.
intros E U T1 T2 Ok WA WU.
inversion WA; subst.
pick fresh X.
rewrite (subst_tt_intro X)...
rewrite_env (map (subst_tb X U) empty ++ E).
eapply wf_typ_subst_tb...
Qed.
(* ********************************************************************** *)
(** * #<a name="oktwft"></a># Properties of [wf_env] and [wf_typ] *)
(** We add [uniq_from_wf_env] as a hint here since it helps blur the distinction between [wf_env] and [uniq] in proofs.  The lemmas in the MetatheoryEnv library use [uniq], whereas here we naturally have (or can easily show) the stronger [wf_env].  Thus, [uniq_from_wf_env] serves as a bridge that allows us to use the environments library. *)
Hint Resolve uniq_from_wf_env : core.
Proof with auto using wf_typ_weaken_head.
induction 1; intros J; analyze_binds J...
injection BindsTacVal; intros; subst...
Qed.
(* ********************************************************************** *)
(** * #<a name="okt"></a># Properties of [wf_env] *)
(** These properties are analogous to the properties that we need to show for the subtyping and typing relations. *)
Proof with eauto using wf_typ_narrowing.
induction F; intros U X Wf_env Wf;
inversion Wf_env; subst; simpl_env in *...
Qed.
Proof with eauto using wf_typ_strengthening.
induction F; intros Wf_env; inversion Wf_env; subst; simpl_env in *...
Qed.
Proof with eauto 6 using wf_typ_subst_tb.
induction F; intros Wf_env WP; simpl_env;
inversion Wf_env; simpl_env in *; simpl subst_tb...
Qed.
(* ********************************************************************** *)
(** * #<a name="subst"></a># Environment is unchanged by substitution for a fresh name *)
Proof with auto.
intros E X T Wf_typ.
induction Wf_typ; intros Fr; simpl...
Case "wf_typ_var".
assert (X0 `in` (dom E))...
eapply binds_In; eauto.
assert (X <> X0) by fsetdec. fsetdec.
Case "wf_typ_all".
apply notin_union...
pick fresh Y.
apply (notin_fv_tt_open Y)...
Qed.
Proof with auto.
intros G Z P H.
induction H; simpl; intros Fr; simpl_env...
rewrite <- IHwf_env...
rewrite <- subst_tt_fresh... eapply notin_fv_wf; eauto.
rewrite <- IHwf_env...
rewrite <- subst_tt_fresh... eapply notin_fv_wf; eauto.
Qed.
(* ********************************************************************** *)
(** * #<a name="regularity"></a># Regularity of relations *)
Proof with simpl_env; try solve [auto | intuition auto].
intros E S T H.
induction H...
Case "sub_trans_tvar".
intuition eauto.
Case "sub_all".
repeat split...
SCase "Second of original three conjuncts".
pick fresh Y and apply wf_typ_all...
destruct (H1 Y)...
rewrite_env (empty ++ Y ~ bind_sub S1 ++ E).
apply (wf_typ_narrowing T1)...
SCase "Third of original three conjuncts".
pick fresh Y and apply wf_typ_all...
destruct (H1 Y)...
Qed.
Proof with simpl_env; try solve [auto | intuition auto].
intros E e T H; induction H...
Case "typing_var".
repeat split...
eauto using wf_typ_from_binds_typ.
Case "typing_abs".
pick fresh y.
destruct (H0 y) as [Hok [J K]]...
repeat split. inversion Hok...
SCase "Second of original three conjuncts".
pick fresh x and apply expr_abs.
eauto using type_from_wf_typ, wf_typ_from_wf_env_typ.
destruct (H0 x)...
SCase "Third of original three conjuncts".
apply wf_typ_arrow; eauto using wf_typ_from_wf_env_typ.
rewrite_env (empty ++ E).
eapply wf_typ_strengthening; simpl_env; eauto.
Case "typing_app".
repeat split...
destruct IHtyping1 as [_ [_ K]].
inversion K...
Case "typing_tabs".
pick fresh Y.
destruct (H0 Y) as [Hok [J K]]...
inversion Hok; subst.
repeat split...
SCase "Second of original three conjuncts".
pick fresh X and apply expr_tabs.
eauto using type_from_wf_typ, wf_typ_from_wf_env_sub...
destruct (H0 X)...
SCase "Third of original three conjuncts".
pick fresh Z and apply wf_typ_all...
destruct (H0 Z)...
Case "typing_tapp".
destruct (sub_regular _ _ _ H0) as [R1 [R2 R3]].
repeat split...
SCase "Second of original three conjuncts".
apply expr_tapp...
eauto using type_from_wf_typ.
SCase "Third of original three conjuncts".
destruct IHtyping as [R1' [R2' R3']].
eapply wf_typ_open; eauto.
Case "typing_sub".
repeat split...
destruct (sub_regular _ _ _ H0)...
Case "typing_let".
repeat split...
SCase "Second of original three conjuncts".
pick fresh y and apply expr_let...
destruct (H1 y) as [K1 [K2 K3]]...
SCase "Third of original three conjuncts".
pick fresh y.
destruct (H1 y) as [K1 [K2 K3]]...
rewrite_env (empty ++ E).
eapply wf_typ_strengthening; simpl_env; eauto.
Case "typing_case".
repeat split...
SCase "Second of original three conjuncts".
pick fresh x and apply expr_case...
destruct (H1 x) as [? [? ?]]...
destruct (H3 x) as [? [? ?]]...
SCase "Third of original three conjuncts".
pick fresh y.
destruct (H1 y) as [K1 [K2 K3]]...
rewrite_env (empty ++ E).
eapply wf_typ_strengthening; simpl_env; eauto.
Qed.

Lemma red_regular : forall e e',
red e e' ->
expr e /\ expr e'.