Library Top.typesafety
Require Import Metalib.Metatheory.
Require Import Program.Equality.
Require Export subtyping.
Lemma wf_typ_from_wf_env_typ : ∀ x T E,
wf_env (x ¬ bind_typ T ++ E) →
WFS E T.
Proof.
intros x T E H. inversion H; auto.
Qed.
Lemma wf_typ_from_binds_typ : ∀ x U E,
wf_env E →
binds x (bind_typ U) E →
WFS E U.
Proof with auto.
induction 1; intros J; analyze_binds J...
apply IHwf_env in BindsTac.
rewrite_alist (nil ++ [(X, bind_sub)] ++ E).
apply wfs_weakening...
injection BindsTacVal; intros; subst...
rewrite_alist (nil ++ [(x0, bind_typ T)] ++ E).
apply wfs_weakening...
rewrite_alist (nil ++ [(x0, bind_typ T)] ++ E).
apply wfs_weakening...
Qed.
Lemma wf_typ_strengthening : ∀ E F x U T,
WFS (F ++ x ¬ bind_typ U ++ E) T →
WFS (F ++ E) T.
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...
analyze_binds H...
apply WFS_rec with (L:=L).
intros.
rewrite_alist (([(X, bind_sub)] ++ F) ++ E).
apply H0...
Qed.
Lemma wf_env_strengthening : ∀ x T E F,
wf_env (F ++ x ¬ bind_typ T ++ E) →
wf_env (F ++ E).
Proof with eauto using wf_typ_strengthening.
induction F; intros Wf_env; inversion Wf_env; subst; simpl_env in ×...
Qed.
Lemma wfs_open_type2: ∀ A G,
WFS G (typ_mu A) → WFS G (open_tt A (typ_mu A)).
Proof with auto.
intros.
dependent destruction H.
pick fresh X.
rewrite subst_tt_intro with (X:=X)...
rewrite_alist (nil ++ E).
apply subst_tt_wfs2...
simpl.
apply WFS_rec with (L:=L)...
simpl...
specialize (H 0 X).
unfold unfoldT in H.
rewrite_alist ([(X, bind_sub)] ++ E)...
Qed.
Lemma typing_regular : ∀ E e T,
typing E e T →
wf_env E ∧ expr e ∧ WFS E T.
Proof with auto.
intros.
induction H...
-
repeat split...
apply wf_typ_from_binds_typ with (x:=x)...
-
pick fresh Y.
assert (Y \notin L) by auto.
apply H0 in H1.
destruct H1.
split.
dependent destruction H1...
destruct H2.
split...
apply lc_abs with (L:=L)...
intros.
apply H0...
dependent destruction H1...
apply wfs_type in H2...
constructor...
dependent destruction H1...
rewrite_alist (nil ++ G).
apply wf_typ_strengthening with (x:=Y) (U:=T1)...
-
destruct IHtyping1...
destruct H2.
dependent destruction H3.
destruct IHtyping2.
destruct H4.
repeat split...
-
destruct IHtyping.
destruct H2.
split...
split...
apply lc_fold...
apply wfs_type with (E:=G)...
-
destruct IHtyping.
destruct H1.
split...
split...
apply lc_unfold...
apply wfs_type with (E:=G)...
apply wfs_open_type2...
-
destruct IHtyping.
destruct H2.
apply sub_regular in H0.
repeat split...
apply H0...
Qed.
Lemma typing_weakening: ∀ E1 E2 E3 e T,
typing (E1 ++ E3) e T →
wf_env (E1 ++ E2 ++ E3) →
typing (E1 ++ E2 ++ E3) e T.
Proof with simpl_env; eauto using wf_typ_from_wf_env_typ.
intros.
remember (E1 ++ E3) as Ht.
generalize dependent E1.
induction H;intros;subst...
-
apply typing_abs with (L:=L \u dom E1 \u dom E2 \u dom E3).
intros.
rewrite_alist (([(x, bind_typ T1)] ++ E1) ++ E2 ++ E3).
apply H0...
rewrite_alist ([(x, bind_typ T1)] ++ E1 ++ E2 ++ E3).
constructor...
assert (x \notin L) by auto.
apply H in H3.
apply typing_regular in H3.
destruct H3.
dependent destruction H3.
apply wfs_weakening...
-
apply typing_fold...
apply wfs_weakening...
-
apply typing_sub with (S:=S).
apply IHtyping...
apply Sub_weakening...
Qed.
Lemma uniq_from_wf_env : ∀ E,
wf_env E →
uniq E.
Proof.
intros E H; induction H; auto.
Qed.
Lemma strengthening_wfs_typ: ∀ E1 E2 S X T,
WFS (E1 ++ X ¬ bind_typ S ++ E2) T→
WFS (E1 ++ E2) T.
Proof with auto.
intros.
dependent induction H...
-
analyze_binds H...
-
constructor...
apply IHWFS1 with (X0:=X) (S0:=S)...
apply IHWFS2 with (X0:=X) (S0:=S)...
-
apply WFS_rec with (L:=L \u {{X}}).
intros.
rewrite_alist (([(X0, bind_sub)] ++ E1) ++ E2).
apply H0 with (X1:=X) (S0:=S)...
Qed.
Lemma strengthening_sub_typ: ∀ E1 E2 A B X T,
Sub (E1 ++ X ¬ bind_typ T ++ E2) A B →
wf_env (E1 ++ E2 ) →
Sub (E1 ++ E2) A B.
Proof with auto.
intros.
dependent induction H...
-
constructor...
analyze_binds H0...
-
constructor...
apply strengthening_wfs_typ with (X:=X) (S:=T) ...
-
constructor...
apply IHSub1 with (X0:=X) (T0:=T)...
apply IHSub2 with (X0:=X) (T0:=T)...
-
apply SA_rec with (L:=L \u {{X}} \u dom (E1 ++ E2)).
intros.
rewrite_alist (([(X0, bind_sub)] ++ E1) ++ E2).
apply H0 with (X1:=X) (T0:=T)...
constructor...
Qed.
Require Import Program.Equality.
Require Export subtyping.
Lemma wf_typ_from_wf_env_typ : ∀ x T E,
wf_env (x ¬ bind_typ T ++ E) →
WFS E T.
Proof.
intros x T E H. inversion H; auto.
Qed.
Lemma wf_typ_from_binds_typ : ∀ x U E,
wf_env E →
binds x (bind_typ U) E →
WFS E U.
Proof with auto.
induction 1; intros J; analyze_binds J...
apply IHwf_env in BindsTac.
rewrite_alist (nil ++ [(X, bind_sub)] ++ E).
apply wfs_weakening...
injection BindsTacVal; intros; subst...
rewrite_alist (nil ++ [(x0, bind_typ T)] ++ E).
apply wfs_weakening...
rewrite_alist (nil ++ [(x0, bind_typ T)] ++ E).
apply wfs_weakening...
Qed.
Lemma wf_typ_strengthening : ∀ E F x U T,
WFS (F ++ x ¬ bind_typ U ++ E) T →
WFS (F ++ E) T.
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...
analyze_binds H...
apply WFS_rec with (L:=L).
intros.
rewrite_alist (([(X, bind_sub)] ++ F) ++ E).
apply H0...
Qed.
Lemma wf_env_strengthening : ∀ x T E F,
wf_env (F ++ x ¬ bind_typ T ++ E) →
wf_env (F ++ E).
Proof with eauto using wf_typ_strengthening.
induction F; intros Wf_env; inversion Wf_env; subst; simpl_env in ×...
Qed.
Lemma wfs_open_type2: ∀ A G,
WFS G (typ_mu A) → WFS G (open_tt A (typ_mu A)).
Proof with auto.
intros.
dependent destruction H.
pick fresh X.
rewrite subst_tt_intro with (X:=X)...
rewrite_alist (nil ++ E).
apply subst_tt_wfs2...
simpl.
apply WFS_rec with (L:=L)...
simpl...
specialize (H 0 X).
unfold unfoldT in H.
rewrite_alist ([(X, bind_sub)] ++ E)...
Qed.
Lemma typing_regular : ∀ E e T,
typing E e T →
wf_env E ∧ expr e ∧ WFS E T.
Proof with auto.
intros.
induction H...
-
repeat split...
apply wf_typ_from_binds_typ with (x:=x)...
-
pick fresh Y.
assert (Y \notin L) by auto.
apply H0 in H1.
destruct H1.
split.
dependent destruction H1...
destruct H2.
split...
apply lc_abs with (L:=L)...
intros.
apply H0...
dependent destruction H1...
apply wfs_type in H2...
constructor...
dependent destruction H1...
rewrite_alist (nil ++ G).
apply wf_typ_strengthening with (x:=Y) (U:=T1)...
-
destruct IHtyping1...
destruct H2.
dependent destruction H3.
destruct IHtyping2.
destruct H4.
repeat split...
-
destruct IHtyping.
destruct H2.
split...
split...
apply lc_fold...
apply wfs_type with (E:=G)...
-
destruct IHtyping.
destruct H1.
split...
split...
apply lc_unfold...
apply wfs_type with (E:=G)...
apply wfs_open_type2...
-
destruct IHtyping.
destruct H2.
apply sub_regular in H0.
repeat split...
apply H0...
Qed.
Lemma typing_weakening: ∀ E1 E2 E3 e T,
typing (E1 ++ E3) e T →
wf_env (E1 ++ E2 ++ E3) →
typing (E1 ++ E2 ++ E3) e T.
Proof with simpl_env; eauto using wf_typ_from_wf_env_typ.
intros.
remember (E1 ++ E3) as Ht.
generalize dependent E1.
induction H;intros;subst...
-
apply typing_abs with (L:=L \u dom E1 \u dom E2 \u dom E3).
intros.
rewrite_alist (([(x, bind_typ T1)] ++ E1) ++ E2 ++ E3).
apply H0...
rewrite_alist ([(x, bind_typ T1)] ++ E1 ++ E2 ++ E3).
constructor...
assert (x \notin L) by auto.
apply H in H3.
apply typing_regular in H3.
destruct H3.
dependent destruction H3.
apply wfs_weakening...
-
apply typing_fold...
apply wfs_weakening...
-
apply typing_sub with (S:=S).
apply IHtyping...
apply Sub_weakening...
Qed.
Lemma uniq_from_wf_env : ∀ E,
wf_env E →
uniq E.
Proof.
intros E H; induction H; auto.
Qed.
Lemma strengthening_wfs_typ: ∀ E1 E2 S X T,
WFS (E1 ++ X ¬ bind_typ S ++ E2) T→
WFS (E1 ++ E2) T.
Proof with auto.
intros.
dependent induction H...
-
analyze_binds H...
-
constructor...
apply IHWFS1 with (X0:=X) (S0:=S)...
apply IHWFS2 with (X0:=X) (S0:=S)...
-
apply WFS_rec with (L:=L \u {{X}}).
intros.
rewrite_alist (([(X0, bind_sub)] ++ E1) ++ E2).
apply H0 with (X1:=X) (S0:=S)...
Qed.
Lemma strengthening_sub_typ: ∀ E1 E2 A B X T,
Sub (E1 ++ X ¬ bind_typ T ++ E2) A B →
wf_env (E1 ++ E2 ) →
Sub (E1 ++ E2) A B.
Proof with auto.
intros.
dependent induction H...
-
constructor...
analyze_binds H0...
-
constructor...
apply strengthening_wfs_typ with (X:=X) (S:=T) ...
-
constructor...
apply IHSub1 with (X0:=X) (T0:=T)...
apply IHSub2 with (X0:=X) (T0:=T)...
-
apply SA_rec with (L:=L \u {{X}} \u dom (E1 ++ E2)).
intros.
rewrite_alist (([(X0, bind_sub)] ++ E1) ++ E2).
apply H0 with (X1:=X) (T0:=T)...
constructor...
Qed.
Lemma 9
Lemma typing_through_subst_ee : ∀ F U E x T e u,
typing (F ++ x ¬ bind_typ U ++ E) e T →
typing E u U →
typing (F ++ E) (subst_ee x u e) T.
Proof with eauto.
intros.
remember (F ++ x ¬ bind_typ U ++ E) as E'.
generalize dependent F.
induction H;intros;subst;simpl in ×...
-
constructor...
apply wf_env_strengthening in H...
-
destruct (x0==x)...
subst...
analyze_binds_uniq H1...
apply uniq_from_wf_env...
injection BindsTacVal; intros; subst.
rewrite_alist (nil ++ F ++ E).
apply typing_weakening...
simpl.
apply wf_env_strengthening in H...
analyze_binds H1...
constructor...
apply wf_env_strengthening in H...
constructor...
apply wf_env_strengthening in H...
-
apply typing_abs with (L:=L \u {{x}})...
intros.
rewrite subst_ee_open_ee_var...
rewrite_alist (([(x0, bind_typ T1)] ++ F) ++ E).
apply H1...
apply typing_regular in H0...
apply H0.
-
apply typing_fold...
rewrite_alist (WFS (F ++ (x ¬ bind_typ U) ++ E) (typ_mu A)) in H1.
apply wf_typ_strengthening in H1...
-
apply typing_sub with (S:=S)...
rewrite_alist (F ++ (x ¬ bind_typ U) ++ E) in H1.
apply typing_regular in H.
destruct H.
apply strengthening_sub_typ in H1...
apply wf_env_strengthening with (x:=x) (T:=U)...
Qed.
Lemma typing_inv_abs : ∀ E S1 e1 T,
typing E (exp_abs S1 e1) T →
∀ U1 U2, Sub E T (typ_arrow U1 U2) →
Sub E U1 S1
∧ ∃ S2, ∃ L, ∀ x, x `notin` L →
typing (x ¬ bind_typ S1 ++ E) (open_ee e1 x) S2 ∧ Sub E S2 U2.
Proof with auto.
intros E S1 e1 T Typ.
remember (exp_abs S1 e1) as e.
generalize dependent e1.
generalize dependent S1.
induction Typ; intros S1 b1 EQ U1 U2 Sub; inversion EQ; subst.
-
inversion Sub; subst.
split...
∃ T2. ∃ L...
-
assert (definition.Sub G S (typ_arrow U1 U2)).
apply Transitivity with (B:=T)...
assert (typing G (exp_abs S1 b1) (typ_arrow U1 U2)).
apply typing_sub with (S:=S)...
dependent destruction H2...
Qed.
Lemma typing_inv_fold: ∀ S G T v,
typing G (exp_fold T v) S →
∀ U, Sub G S (typ_mu U) →
(∃ T', typing G v (open_tt T' (typ_mu T')) ∧ Sub G (open_tt T' (typ_mu T')) (open_tt U (typ_mu U))).
Proof with auto.
intros.
generalize dependent U.
dependent induction H;intros...
-
∃ A...
split...
apply unfolding_lemma...
-
specialize (IHtyping T v).
assert (exp_fold T v = exp_fold T v) by auto.
apply IHtyping with (U:=U) in H2...
apply Transitivity with (B:=T0)...
Qed.
typing (F ++ x ¬ bind_typ U ++ E) e T →
typing E u U →
typing (F ++ E) (subst_ee x u e) T.
Proof with eauto.
intros.
remember (F ++ x ¬ bind_typ U ++ E) as E'.
generalize dependent F.
induction H;intros;subst;simpl in ×...
-
constructor...
apply wf_env_strengthening in H...
-
destruct (x0==x)...
subst...
analyze_binds_uniq H1...
apply uniq_from_wf_env...
injection BindsTacVal; intros; subst.
rewrite_alist (nil ++ F ++ E).
apply typing_weakening...
simpl.
apply wf_env_strengthening in H...
analyze_binds H1...
constructor...
apply wf_env_strengthening in H...
constructor...
apply wf_env_strengthening in H...
-
apply typing_abs with (L:=L \u {{x}})...
intros.
rewrite subst_ee_open_ee_var...
rewrite_alist (([(x0, bind_typ T1)] ++ F) ++ E).
apply H1...
apply typing_regular in H0...
apply H0.
-
apply typing_fold...
rewrite_alist (WFS (F ++ (x ¬ bind_typ U) ++ E) (typ_mu A)) in H1.
apply wf_typ_strengthening in H1...
-
apply typing_sub with (S:=S)...
rewrite_alist (F ++ (x ¬ bind_typ U) ++ E) in H1.
apply typing_regular in H.
destruct H.
apply strengthening_sub_typ in H1...
apply wf_env_strengthening with (x:=x) (T:=U)...
Qed.
Lemma typing_inv_abs : ∀ E S1 e1 T,
typing E (exp_abs S1 e1) T →
∀ U1 U2, Sub E T (typ_arrow U1 U2) →
Sub E U1 S1
∧ ∃ S2, ∃ L, ∀ x, x `notin` L →
typing (x ¬ bind_typ S1 ++ E) (open_ee e1 x) S2 ∧ Sub E S2 U2.
Proof with auto.
intros E S1 e1 T Typ.
remember (exp_abs S1 e1) as e.
generalize dependent e1.
generalize dependent S1.
induction Typ; intros S1 b1 EQ U1 U2 Sub; inversion EQ; subst.
-
inversion Sub; subst.
split...
∃ T2. ∃ L...
-
assert (definition.Sub G S (typ_arrow U1 U2)).
apply Transitivity with (B:=T)...
assert (typing G (exp_abs S1 b1) (typ_arrow U1 U2)).
apply typing_sub with (S:=S)...
dependent destruction H2...
Qed.
Lemma typing_inv_fold: ∀ S G T v,
typing G (exp_fold T v) S →
∀ U, Sub G S (typ_mu U) →
(∃ T', typing G v (open_tt T' (typ_mu T')) ∧ Sub G (open_tt T' (typ_mu T')) (open_tt U (typ_mu U))).
Proof with auto.
intros.
generalize dependent U.
dependent induction H;intros...
-
∃ A...
split...
apply unfolding_lemma...
-
specialize (IHtyping T v).
assert (exp_fold T v = exp_fold T v) by auto.
apply IHtyping with (U:=U) in H2...
apply Transitivity with (B:=T0)...
Qed.
Theorem 10 (Preservation)
Lemma preservation : ∀ E e e' T,
typing E e T →
step e e' →
typing E e' T.
Proof with auto.
intros.
generalize dependent e'.
dependent induction H;intros;try solve [dependent destruction H1;auto|inversion H0]...
-
dependent destruction H1...
+
dependent destruction H.
pick fresh Y.
rewrite subst_ee_intro with (x:=Y)...
rewrite_alist (nil ++ G).
apply typing_through_subst_ee with (U:=T1)...
apply H...
apply typing_inv_abs with (U1:=T1) (U2:=T2) in H...
destruct H.
destruct H4.
destruct H4.
pick fresh Y.
rewrite subst_ee_intro with (x:=Y)...
rewrite_alist (nil ++ G).
apply typing_through_subst_ee with (U:=T)...
specialize (H4 Y).
assert (Y \notin x0) by auto.
apply H4 in H5.
destruct H5.
apply typing_sub with (S:=x)...
apply Sub_weakening...
apply typing_regular in H5.
destruct H5...
apply typing_sub with (S:=T1)...
+
apply typing_app with (T1:=T1)...
+
apply typing_app with (T1:=T1)...
-
dependent destruction H0...
dependent destruction H...
apply typing_inv_fold with (U:=T) in H...
destruct H...
destruct H.
apply typing_sub with (S:=open_tt x (typ_mu x))...
-
apply typing_sub with (S:=S)...
Qed.
Lemma canonical_form_abs : ∀ e U1 U2,
value e →
typing empty e (typ_arrow U1 U2) →
∃ V, ∃ e1, e = exp_abs V e1.
Proof.
intros e U1 U2 Val Typ.
remember empty as E.
remember (typ_arrow U1 U2) as T.
revert U1 U2 HeqT HeqE.
induction Typ; intros U1 U2 EQT EQE; subst;
try solve [ inversion Val | inversion EQT | eauto ].
inversion H; subst; eauto.
Qed.
Lemma canonical_form_fold : ∀ e U,
value e →
typing empty e (typ_mu U) →
∃ V, ∃ e1, (Sub empty (typ_mu V) (typ_mu U) ∧ value e1 ∧ e = exp_fold (typ_mu V) e1).
Proof with auto.
intros e U Val Typ.
remember empty as E.
remember (typ_mu U) as T.
assert (WFS E T).
apply typing_regular in Typ.
destruct Typ.
destruct H0...
revert U HeqT HeqE.
induction Typ; intros U EQT EQE; subst;
try solve [ inversion Val | inversion EQT | eauto ].
-
dependent destruction Val.
∃ A...
∃ e...
repeat split...
apply refl...
-
inversion H; subst; eauto.
dependent destruction H0.
apply IHTyp with (U:=A1) in Val...
destruct Val.
destruct H1.
∃ x.
∃ x0.
destruct H1.
destruct H2.
repeat split...
apply Transitivity with (B:=typ_mu A1)...
apply SA_rec with (L:=L)...
apply typing_regular in Typ.
apply Typ.
Qed.
typing E e T →
step e e' →
typing E e' T.
Proof with auto.
intros.
generalize dependent e'.
dependent induction H;intros;try solve [dependent destruction H1;auto|inversion H0]...
-
dependent destruction H1...
+
dependent destruction H.
pick fresh Y.
rewrite subst_ee_intro with (x:=Y)...
rewrite_alist (nil ++ G).
apply typing_through_subst_ee with (U:=T1)...
apply H...
apply typing_inv_abs with (U1:=T1) (U2:=T2) in H...
destruct H.
destruct H4.
destruct H4.
pick fresh Y.
rewrite subst_ee_intro with (x:=Y)...
rewrite_alist (nil ++ G).
apply typing_through_subst_ee with (U:=T)...
specialize (H4 Y).
assert (Y \notin x0) by auto.
apply H4 in H5.
destruct H5.
apply typing_sub with (S:=x)...
apply Sub_weakening...
apply typing_regular in H5.
destruct H5...
apply typing_sub with (S:=T1)...
+
apply typing_app with (T1:=T1)...
+
apply typing_app with (T1:=T1)...
-
dependent destruction H0...
dependent destruction H...
apply typing_inv_fold with (U:=T) in H...
destruct H...
destruct H.
apply typing_sub with (S:=open_tt x (typ_mu x))...
-
apply typing_sub with (S:=S)...
Qed.
Lemma canonical_form_abs : ∀ e U1 U2,
value e →
typing empty e (typ_arrow U1 U2) →
∃ V, ∃ e1, e = exp_abs V e1.
Proof.
intros e U1 U2 Val Typ.
remember empty as E.
remember (typ_arrow U1 U2) as T.
revert U1 U2 HeqT HeqE.
induction Typ; intros U1 U2 EQT EQE; subst;
try solve [ inversion Val | inversion EQT | eauto ].
inversion H; subst; eauto.
Qed.
Lemma canonical_form_fold : ∀ e U,
value e →
typing empty e (typ_mu U) →
∃ V, ∃ e1, (Sub empty (typ_mu V) (typ_mu U) ∧ value e1 ∧ e = exp_fold (typ_mu V) e1).
Proof with auto.
intros e U Val Typ.
remember empty as E.
remember (typ_mu U) as T.
assert (WFS E T).
apply typing_regular in Typ.
destruct Typ.
destruct H0...
revert U HeqT HeqE.
induction Typ; intros U EQT EQE; subst;
try solve [ inversion Val | inversion EQT | eauto ].
-
dependent destruction Val.
∃ A...
∃ e...
repeat split...
apply refl...
-
inversion H; subst; eauto.
dependent destruction H0.
apply IHTyp with (U:=A1) in Val...
destruct Val.
destruct H1.
∃ x.
∃ x0.
destruct H1.
destruct H2.
repeat split...
apply Transitivity with (B:=typ_mu A1)...
apply SA_rec with (L:=L)...
apply typing_regular in Typ.
apply Typ.
Qed.
Theorem 11 (Progress)
Lemma progress : ∀ e T,
typing empty e T →
value e ∨ ∃ e', step e e'.
Proof with eauto.
intros.
dependent induction H...
-
inversion H0...
-
left.
constructor.
pick fresh Y.
assert (Y \notin L) by auto.
apply H in H1...
apply typing_regular in H1.
destruct H1.
destruct H2.
apply lc_abs with (L:=L).
intros.
apply H in H4.
apply typing_regular in H4.
apply H4.
apply wf_typ_from_wf_env_typ in H1.
apply wfs_type with (E:=empty)...
-
right.
assert (empty ~= empty) by auto.
apply IHtyping1 in H1.
destruct H1...
assert (empty ~= empty) by auto.
apply IHtyping2 in H2...
destruct H2...
apply canonical_form_abs with (U1:=T1) (U2:=T2) in H1...
destruct H1.
destruct H1.
∃ (open_ee x0 e2).
subst.
apply step_beta...
apply typing_regular in H.
apply H.
destruct H2.
∃ (exp_app e1 x).
apply step_app2...
destruct H1.
∃ (exp_app x e2).
apply step_app1...
apply typing_regular in H0.
apply H0.
-
assert (empty ~= empty) by auto.
apply IHtyping in H1.
destruct H1.
left.
constructor...
apply wfs_type in H0...
right.
destruct H1.
∃ (exp_fold (typ_mu A) x).
constructor...
apply typing_regular in H.
destruct H.
destruct H2.
apply wfs_type in H0...
-
assert (empty ~= empty) by auto.
apply IHtyping in H0.
right.
destruct H0...
+
apply canonical_form_fold with (U:=T) in H0...
destruct H0.
destruct H0.
destruct H0.
destruct H1.
∃ x0...
rewrite H2.
apply step_fld...
apply sub_regular in H0.
apply wfs_type with (E:=empty)...
apply H0.
apply typing_regular in H.
apply wfs_type with (E:=empty)...
apply H.
+
destruct H0.
∃ (exp_unfold (typ_mu T) x).
apply step_unfold...
apply typing_regular in H...
apply wfs_type with (E:=empty)...
apply H.
Qed.
typing empty e T →
value e ∨ ∃ e', step e e'.
Proof with eauto.
intros.
dependent induction H...
-
inversion H0...
-
left.
constructor.
pick fresh Y.
assert (Y \notin L) by auto.
apply H in H1...
apply typing_regular in H1.
destruct H1.
destruct H2.
apply lc_abs with (L:=L).
intros.
apply H in H4.
apply typing_regular in H4.
apply H4.
apply wf_typ_from_wf_env_typ in H1.
apply wfs_type with (E:=empty)...
-
right.
assert (empty ~= empty) by auto.
apply IHtyping1 in H1.
destruct H1...
assert (empty ~= empty) by auto.
apply IHtyping2 in H2...
destruct H2...
apply canonical_form_abs with (U1:=T1) (U2:=T2) in H1...
destruct H1.
destruct H1.
∃ (open_ee x0 e2).
subst.
apply step_beta...
apply typing_regular in H.
apply H.
destruct H2.
∃ (exp_app e1 x).
apply step_app2...
destruct H1.
∃ (exp_app x e2).
apply step_app1...
apply typing_regular in H0.
apply H0.
-
assert (empty ~= empty) by auto.
apply IHtyping in H1.
destruct H1.
left.
constructor...
apply wfs_type in H0...
right.
destruct H1.
∃ (exp_fold (typ_mu A) x).
constructor...
apply typing_regular in H.
destruct H.
destruct H2.
apply wfs_type in H0...
-
assert (empty ~= empty) by auto.
apply IHtyping in H0.
right.
destruct H0...
+
apply canonical_form_fold with (U:=T) in H0...
destruct H0.
destruct H0.
destruct H0.
destruct H1.
∃ x0...
rewrite H2.
apply step_fld...
apply sub_regular in H0.
apply wfs_type with (E:=empty)...
apply H0.
apply typing_regular in H.
apply wfs_type with (E:=empty)...
apply H.
+
destruct H0.
∃ (exp_unfold (typ_mu T) x).
apply step_unfold...
apply typing_regular in H...
apply wfs_type with (E:=empty)...
apply H.
Qed.