improve directory structure
This commit is contained in:
parent
54b9d4c06d
commit
355d09145d
GPG key ID:
F96CF119C34B64A6
81 changed files with 5366 additions and 0 deletions
share/popl08-tutorial-Fsub
593
share/popl08-tutorial-Fsub/Fsub_Soundness.v.crashcoqide
Normal file
593
share/popl08-tutorial-Fsub/Fsub_Soundness.v.crashcoqide
Normal file
|
|
@ -0,0 +1,593 @@
|
|||
(** Type-safety proofs for Fsub.
|
||||
|
||||
Authors: Brian Aydemir and Arthur Charguéraud, 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_Lemmas.
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** * #<a name="subtyping"></a># Properties of subtyping *)
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** ** Reflexivity (1) *)
|
||||
|
||||
Lemma sub_reflexivity : forall E T,
|
||||
wf_env E ->
|
||||
wf_typ E T ->
|
||||
sub E T T.
|
||||
Proof with eauto.
|
||||
intros E T Ok Wf.
|
||||
induction Wf...
|
||||
pick fresh Y and apply sub_all...
|
||||
Qed.
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** ** Weakening (2) *)
|
||||
|
||||
Lemma sub_weakening : forall E F G S T,
|
||||
sub (G ++ E) S T ->
|
||||
wf_env (G ++ F ++ E) ->
|
||||
sub (G ++ F ++ E) S T.
|
||||
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 <- concat_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.
|
||||
|
||||
Lemma sub_narrowing_aux : forall Q F E Z P S T,
|
||||
transitivity_on Q ->
|
||||
sub (F ++ [(Z, bind_sub Q)] ++ E) S T ->
|
||||
sub E P Q ->
|
||||
sub (F ++ [(Z, bind_sub P)] ++ 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_top".
|
||||
apply sub_top...
|
||||
Case "sub_refl_tvar".
|
||||
apply sub_refl_tvar...
|
||||
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".
|
||||
binds_get H.
|
||||
inversion H1; subst...
|
||||
SCase "X <> Z".
|
||||
apply (sub_trans_tvar U)...
|
||||
binds_cases H...
|
||||
Case "sub_all".
|
||||
pick fresh Y and apply sub_all...
|
||||
rewrite <- concat_assoc.
|
||||
apply H0...
|
||||
Qed.
|
||||
|
||||
Lemma sub_transitivity : forall Q,
|
||||
transitivity_on Q.
|
||||
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.
|
||||
Proof.
|
||||
intros.
|
||||
eapply sub_narrowing_aux; eauto.
|
||||
apply sub_transitivity.
|
||||
Qed.
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** ** Type substitution preserves subtyping (10) *)
|
||||
|
||||
Lemma sub_through_subst_tt : forall Q E F Z S T P,
|
||||
sub (F ++ [(Z, bind_sub Q)] ++ E) S T ->
|
||||
sub E P Q ->
|
||||
sub (map (subst_tb Z P) F ++ E) (subst_tt Z P S) (subst_tt Z P T).
|
||||
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.
|
||||
binds_cases 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).
|
||||
binds_get H.
|
||||
inversion H1; 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 ].
|
||||
binds_cases 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) *)
|
||||
|
||||
Lemma typing_weakening : forall E F G e T,
|
||||
typing (G ++ E) e T ->
|
||||
wf_env (G ++ F ++ E) ->
|
||||
typing (G ++ F ++ E) e T.
|
||||
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 <- concat_assoc.
|
||||
apply (H0 x)...
|
||||
Case "typing_tabs".
|
||||
pick fresh X and apply typing_tabs.
|
||||
lapply (H X); [intros K | auto].
|
||||
rewrite <- concat_assoc.
|
||||
apply (H0 X)...
|
||||
Qed.
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** ** Strengthening (6) *)
|
||||
|
||||
Lemma sub_strengthening : forall x U E F S T,
|
||||
sub (F ++ [(x, bind_typ U)] ++ E) S T ->
|
||||
sub (F ++ E) S T.
|
||||
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)...
|
||||
binds_cases H...
|
||||
Case "sub_all".
|
||||
pick fresh X and apply sub_all...
|
||||
rewrite <- concat_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.
|
||||
Proof with eauto 6 using wf_env_narrowing, wf_typ_narrowing, sub_narrowing.
|
||||
intros Q E F X P e T PsubQ Typ.
|
||||
remember (F ++ [(X, bind_sub Q)] ++ E) as E'.
|
||||
generalize dependent F.
|
||||
induction Typ; intros F EQ; subst...
|
||||
Case "typing_var".
|
||||
binds_cases H0...
|
||||
Case "typing_abs".
|
||||
pick fresh y and apply typing_abs.
|
||||
rewrite <- concat_assoc.
|
||||
apply H0...
|
||||
Case "typing_tabs".
|
||||
pick fresh Y and apply typing_tabs.
|
||||
rewrite <- concat_assoc.
|
||||
apply H0...
|
||||
Qed.
|
||||
|
||||
|
||||
(************************************************************************ *)
|
||||
(** ** Substitution preserves typing (8) *)
|
||||
|
||||
Lemma typing_through_subst_ee : forall U E F 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.
|
||||
(* begin show *)
|
||||
|
||||
(** We provide detailed comments for the following proof, mainly to
|
||||
point out several useful tactics and proof techniques.
|
||||
|
||||
Starting a proof with "Proof with <some tactic>" allows us to
|
||||
specify a default tactic that should be used to solve goals. To
|
||||
invoke this default tactic at the end of a proof step, we signal
|
||||
the end of the step with three periods instead of a single one,
|
||||
e.g., "apply typing_weakening...". *)
|
||||
|
||||
Proof with simpl_env;
|
||||
eauto 4 using wf_typ_strengthening,
|
||||
wf_env_strengthening,
|
||||
sub_strengthening.
|
||||
|
||||
(** The proof proceeds by induction on the given typing derivation
|
||||
for e. We use the remember tactic, along with generalize
|
||||
dependent, to ensure that the goal is properly strengthened
|
||||
before we use induction. *)
|
||||
|
||||
intros U E F x T e u TypT TypU.
|
||||
remember (F ++ [(x, bind_typ U)] ++ E) as E'.
|
||||
generalize dependent F.
|
||||
induction TypT; intros F EQ; subst; simpl subst_ee...
|
||||
|
||||
(** The typing_var case involves a case analysis on whether the
|
||||
variable is the same as the one being substituted for. *)
|
||||
|
||||
Case "typing_var".
|
||||
destruct (x0 == x); subst.
|
||||
|
||||
(** In the case where x0=x, we first observe that hypothesis H0
|
||||
implies that T=U, since x can only be bound once in the
|
||||
environment. The conclusion then follows from hypothesis TypU
|
||||
and weakening. We can use the binds_get tactic, described in
|
||||
the Environment library, with H0 to obtain the fact that
|
||||
T=U. *)
|
||||
|
||||
SCase "x0 = x".
|
||||
binds_get H0.
|
||||
inversion H2; subst.
|
||||
|
||||
(** In order to apply typing_weakening, we need to rewrite the
|
||||
environment so that it has the right shape. (We could
|
||||
also prove a corollary of typing_weakening.) The
|
||||
rewrite_env tactic, described in the Environment library,
|
||||
is one way to perform this rewriting. *)
|
||||
|
||||
rewrite_env (empty ++ F ++ E).
|
||||
apply typing_weakening...
|
||||
|
||||
(** In the case where x0<>x, the result follows by an exhaustive
|
||||
case analysis on exactly where x0 is bound in the environment.
|
||||
We perform this case analysis by using the binds_cases tactic,
|
||||
described in the Environment library. *)
|
||||
|
||||
SCase "x0 <> x".
|
||||
binds_cases H0.
|
||||
eauto using wf_env_strengthening.
|
||||
eauto using wf_env_strengthening.
|
||||
|
||||
(** Informally, the typing_abs case is a straightforward application
|
||||
of the induction hypothesis, which is called H0 here. *)
|
||||
|
||||
Case "typing_abs".
|
||||
|
||||
(** We use the "pick fresh and apply" tactic to apply the rule
|
||||
typing_abs without having to calculate the appropriate finite
|
||||
set of atoms. *)
|
||||
|
||||
pick fresh y and apply typing_abs.
|
||||
|
||||
(** We cannot apply H0 directly here. The first problem is that
|
||||
the induction hypothesis has (subst_ee open_ee), whereas in
|
||||
the goal we have (open_ee subst_ee). The lemma
|
||||
subst_ee_open_ee_var lets us swap the order of these two
|
||||
operations. *)
|
||||
|
||||
rewrite subst_ee_open_ee_var...
|
||||
|
||||
(** The second problem is how the concatenations are associated in
|
||||
the environments. In the goal, we currently have
|
||||
|
||||
<< ([(y, bind_typ V)] ++ F ++ E),
|
||||
>>
|
||||
where concatenation associates to the right. In order to
|
||||
apply the induction hypothesis, we need
|
||||
|
||||
<< (([(y, bind_typ V)] ++ F) ++ E).
|
||||
>>
|
||||
We can use the rewrite_env tactic to perform this rewriting,
|
||||
or we can rewrite directly with an appropriate lemma from the
|
||||
Environment library. *)
|
||||
|
||||
rewrite <- concat_assoc.
|
||||
|
||||
(** Now we can apply the induction hypothesis. *)
|
||||
|
||||
apply H0...
|
||||
|
||||
(** The remaining cases in this proof are straightforward, given
|
||||
everything that we have pointed out above. *)
|
||||
|
||||
Case "typing_tabs".
|
||||
pick fresh Y and apply typing_tabs.
|
||||
rewrite subst_ee_open_te_var...
|
||||
rewrite <- concat_assoc.
|
||||
apply H0...
|
||||
Qed.
|
||||
(* end show *)
|
||||
|
||||
|
||||
(************************************************************************ *)
|
||||
(** ** Type substitution preserves typing (11) *)
|
||||
|
||||
Lemma typing_through_subst_te : forall Q E F Z e T P,
|
||||
typing (F ++ [(Z, bind_sub Q)] ++ E) e T ->
|
||||
sub E P Q ->
|
||||
typing (map (subst_tb Z P) F ++ E) (subst_te Z P e) (subst_tt Z P T).
|
||||
Proof with simpl_env;
|
||||
eauto 6 using wf_env_subst_tb,
|
||||
wf_typ_subst_tb,
|
||||
sub_through_subst_tt.
|
||||
intros Q E F Z e T P Typ PsubQ.
|
||||
remember (F ++ [(Z, bind_sub Q)] ++ E) as G.
|
||||
generalize dependent F.
|
||||
induction Typ; intros F EQ; subst;
|
||||
simpl subst_te in *; simpl subst_tt in *...
|
||||
Case "typing_var".
|
||||
apply typing_var...
|
||||
rewrite (map_subst_tb_id E Z P);
|
||||
[ | auto | eapply fresh_mid_tail; eauto ].
|
||||
binds_cases H0...
|
||||
Case "typing_abs".
|
||||
pick fresh y and apply typing_abs.
|
||||
rewrite subst_te_open_ee_var...
|
||||
rewrite_env (map (subst_tb Z P) ([(y, bind_typ V)] ++ F) ++ E).
|
||||
apply H0...
|
||||
Case "typing_tabs".
|
||||
pick fresh Y and apply typing_tabs.
|
||||
rewrite subst_te_open_te_var...
|
||||
rewrite subst_tt_open_tt_var...
|
||||
rewrite_env (map (subst_tb Z P) ([(Y, bind_sub V)] ++ F) ++ E).
|
||||
apply H0...
|
||||
Case "typing_tapp".
|
||||
rewrite subst_tt_open_tt...
|
||||
Qed.
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** * #<a name="preservation"></a># Preservation *)
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** ** Inversion of typing (13) *)
|
||||
|
||||
Lemma typing_inv_abs : forall E S1 e1 T,
|
||||
typing E (exp_abs S1 e1) T ->
|
||||
forall U1 U2, sub E T (typ_arrow U1 U2) ->
|
||||
sub E U1 S1
|
||||
/\ exists S2, exists L, forall 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.
|
||||
Case "typing_abs".
|
||||
inversion Sub; subst.
|
||||
split...
|
||||
exists T1. exists L...
|
||||
Case "typing_sub".
|
||||
auto using (sub_transitivity T).
|
||||
Qed.
|
||||
|
||||
Lemma typing_inv_tabs : forall E S1 e1 T,
|
||||
typing E (exp_tabs S1 e1) T ->
|
||||
forall U1 U2, sub E T (typ_all U1 U2) ->
|
||||
sub E U1 S1
|
||||
/\ exists S2, exists L, forall X, X `notin` L ->
|
||||
typing ([(X, bind_sub U1)] ++ E) (open_te e1 X) (open_tt S2 X)
|
||||
/\ sub ([(X, bind_sub U1)] ++ E) (open_tt S2 X) (open_tt U2 X).
|
||||
Proof with simpl_env; auto.
|
||||
intros E S1 e1 T Typ.
|
||||
remember (exp_tabs S1 e1) as e.
|
||||
generalize dependent e1.
|
||||
generalize dependent S1.
|
||||
induction Typ; intros S1 e0 EQ U1 U2 Sub; inversion EQ; subst.
|
||||
Case "typing_tabs".
|
||||
inversion Sub; subst.
|
||||
split...
|
||||
exists T1.
|
||||
exists (L0 `union` L).
|
||||
intros Y Fr.
|
||||
split...
|
||||
rewrite_env (empty ++ [(Y, bind_sub U1)] ++ E).
|
||||
apply (typing_narrowing S1)...
|
||||
Case "typing_sub".
|
||||
auto using (sub_transitivity T).
|
||||
Qed.
|
||||
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** ** Preservation (20) *)
|
||||
|
||||
Lemma preservation : forall E e e' T,
|
||||
typing E e T ->
|
||||
red e e' ->
|
||||
typing E e' T.
|
||||
Proof with simpl_env; eauto.
|
||||
intros E e e' T Typ. generalize dependent e'.
|
||||
induction Typ; intros e' Red; try solve [ inversion Red; subst; eauto ].
|
||||
Case "typing_app".
|
||||
inversion Red; subst...
|
||||
SCase "red_abs".
|
||||
destruct (typing_inv_abs _ _ _ _ Typ1 T1 T2) as [P1 [S2 [L P2]]].
|
||||
apply sub_reflexivity...
|
||||
pick fresh x.
|
||||
destruct (P2 x) as [? ?]...
|
||||
rewrite (subst_ee_intro x)...
|
||||
rewrite_env (empty ++ E).
|
||||
apply (typing_through_subst_ee T).
|
||||
apply (typing_sub S2)...
|
||||
rewrite_env (empty ++ [(x, bind_typ T)] ++ E).
|
||||
apply sub_weakening...
|
||||
eauto.
|
||||
Case "typing_tapp".
|
||||
inversion Red; subst...
|
||||
SCase "red_tabs".
|
||||
destruct (typing_inv_tabs _ _ _ _ Typ T1 T2) as [P1 [S2 [L P2]]].
|
||||
apply sub_reflexivity...
|
||||
pick fresh X.
|
||||
destruct (P2 X) as [? ?]...
|
||||
rewrite (subst_te_intro X)...
|
||||
rewrite (subst_tt_intro X)...
|
||||
rewrite_env (map (subst_tb X T) empty ++ E).
|
||||
apply (typing_through_subst_te T1)...
|
||||
Qed.
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** * #<a name="progress"></a># Progress *)
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** ** Canonical forms (14) *)
|
||||
|
||||
Lemma canonical_form_abs : forall e U1 U2,
|
||||
value e ->
|
||||
typing empty e (typ_arrow U1 U2) ->
|
||||
exists V, exists 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 ].
|
||||
Case "typing_sub".
|
||||
inversion H; subst; eauto.
|
||||
inversion H0.
|
||||
Qed.
|
||||
|
||||
Lemma canonical_form_tabs : forall e U1 U2,
|
||||
value e ->
|
||||
typing empty e (typ_all U1 U2) ->
|
||||
exists V, exists e1, e = exp_tabs V e1.
|
||||
Proof.
|
||||
intros e U1 U2 Val Typ.
|
||||
remember empty as E.
|
||||
remember (typ_all U1 U2) as T.
|
||||
revert U1 U2 HeqT HeqT.
|
||||
induction Typ; intros U1 U2 EQT EQE; subst;
|
||||
try solve [ inversion Val | inversion EQT | eauto ].
|
||||
Case "typing_sub".
|
||||
inversion H; subst; eauto.
|
||||
inversion H0.
|
||||
Qed.
|
||||
|
||||
|
||||
|
||||
(* ********************************************************************** *)
|
||||
(** ** Progress (16) *)
|
||||
|
||||
Lemma progress : forall e T,
|
||||
typing empty e T ->
|
||||
value e \/ exists e', red e e'.
|
||||
Proof with eauto.
|
||||
intros e T Typ.
|
||||
remember empty as E. generalize dependent HeqE.
|
||||
assert (Typ' : typing E e T)...
|
||||
induction Typ; intros EQ; subst...
|
||||
Case "typing_var".
|
||||
inversion H0.
|
||||
Case "typing_app".
|
||||
right.
|
||||
destruct IHTyp1 as [Val1 | [e1' Rede1']]...
|
||||
SCase "Val1".
|
||||
destruct IHTyp2 as [Val2 | [e2' Rede2']]...
|
||||
SSCase "Val2".
|
||||
destruct (canonical_form_abs _ _ _ Val1 Typ1) as [S [e3 EQ]].
|
||||
subst.
|
||||
exists (open_ee e3 e2)...
|
||||
Case "typing_tapp".
|
||||
right.
|
||||
destruct IHTyp as [Val1 | [e1' Rede1']]...
|
||||
SCase "Val1".
|
||||
destruct (canonical_form_tabs _ _ _ Val1 Typ) as [S [e3 EQ]].
|
||||
subst.
|
||||
exists (open_te e3 T)...
|
||||
SCase "e1' Rede1'".
|
||||
exists (exp_tapp e1' T)...
|
||||
Qed.
|
||||
Loading…
Add table
Add a link
Reference in a new issue