Michael Sippel
05c137c489
taken from 'https://www.cis.upenn.edu/~plclub/popl08-tutorial/code/index.html'
399 lines
12 KiB
Coq
399 lines
12 KiB
Coq
(** Administrative lemmas for Fsub.
|
|
|
|
Authors: Brian Aydemir and Arthur Charguéraud, 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_Infrastructure.
|
|
|
|
|
|
(* ********************************************************************** *)
|
|
(** * #<a name="wft"></a># Properties of [wf_typ] *)
|
|
|
|
(** If a type is well-formed in an environment, then it is locally
|
|
closed. *)
|
|
|
|
Lemma type_from_wf_typ : forall E T,
|
|
wf_typ E T -> type T.
|
|
Proof.
|
|
intros E T H; induction H; eauto.
|
|
Qed.
|
|
|
|
(** The remaining properties are analogous to the properties that we
|
|
need to show for the subtyping and typing relations. *)
|
|
|
|
Lemma wf_typ_weakening : forall T E F G,
|
|
wf_typ (G ++ E) T ->
|
|
ok (G ++ F ++ E) ->
|
|
wf_typ (G ++ F ++ E) T.
|
|
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 <- concat_assoc.
|
|
apply H0...
|
|
Qed.
|
|
|
|
Lemma wf_typ_weaken_head : forall T E F,
|
|
wf_typ E T ->
|
|
ok (F ++ E) ->
|
|
wf_typ (F ++ E) T.
|
|
Proof.
|
|
intros.
|
|
rewrite_env (empty ++ F++ E).
|
|
auto using wf_typ_weakening.
|
|
Qed.
|
|
|
|
Lemma wf_typ_narrowing : forall V U T E F X,
|
|
wf_typ (F ++ [(X, bind_sub V)] ++ E) T ->
|
|
ok (F ++ [(X, bind_sub U)] ++ E) ->
|
|
wf_typ (F ++ [(X, bind_sub U)] ++ E) T.
|
|
Proof with simpl_env; eauto.
|
|
intros V U T E F X Hwf_typ Hok.
|
|
remember (F ++ [(X, bind_sub V)] ++ E) as G.
|
|
generalize dependent F.
|
|
induction Hwf_typ; intros F Hok Heq; subst...
|
|
Case "wf_typ_var".
|
|
binds_cases H...
|
|
Case "typ_all".
|
|
pick fresh Y and apply wf_typ_all...
|
|
rewrite <- concat_assoc.
|
|
apply H0...
|
|
Qed.
|
|
|
|
Lemma wf_typ_strengthening : forall E F x U T,
|
|
wf_typ (F ++ [(x, bind_typ U)] ++ E) T ->
|
|
wf_typ (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...
|
|
Case "wf_typ_var".
|
|
binds_cases H...
|
|
Case "wf_typ_all".
|
|
pick fresh Y and apply wf_typ_all...
|
|
rewrite <- concat_assoc.
|
|
apply H1...
|
|
Qed.
|
|
|
|
Lemma wf_typ_subst_tb : forall F Q E Z P T,
|
|
wf_typ (F ++ [(Z, bind_sub Q)] ++ E) T ->
|
|
wf_typ E P ->
|
|
ok (map (subst_tb Z P) F ++ E) ->
|
|
wf_typ (map (subst_tb Z P) F ++ E) (subst_tt Z P T).
|
|
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".
|
|
binds_cases 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.
|
|
|
|
Lemma wf_typ_open : forall E U T1 T2,
|
|
ok E ->
|
|
wf_typ E (typ_all T1 T2) ->
|
|
wf_typ E U ->
|
|
wf_typ E (open_tt T2 U).
|
|
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] *)
|
|
|
|
Lemma ok_from_wf_env : forall E,
|
|
wf_env E ->
|
|
ok E.
|
|
Proof.
|
|
intros E H; induction H; auto.
|
|
Qed.
|
|
|
|
(** We add [ok_from_wf_env] as a hint here since it helps blur the
|
|
distinction between [wf_env] and [ok] in proofs. The lemmas in
|
|
the [Environment] library use [ok], whereas here we naturally have
|
|
(or can easily show) the stronger [wf_env]. Thus,
|
|
[ok_from_wf_env] serves as a bridge that allows us to use the
|
|
environments library. *)
|
|
|
|
Hint Resolve ok_from_wf_env.
|
|
|
|
Lemma wf_typ_from_binds_typ : forall x U E,
|
|
wf_env E ->
|
|
binds x (bind_typ U) E ->
|
|
wf_typ E U.
|
|
Proof with auto using wf_typ_weaken_head.
|
|
induction 1; intros J; binds_cases J...
|
|
inversion H4; subst...
|
|
Qed.
|
|
|
|
Lemma wf_typ_from_wf_env_typ : forall x T E,
|
|
wf_env ([(x, bind_typ T)] ++ E) ->
|
|
wf_typ E T.
|
|
Proof.
|
|
intros x T E H. inversion H; auto.
|
|
Qed.
|
|
|
|
Lemma wf_typ_from_wf_env_sub : forall x T E,
|
|
wf_env ([(x, bind_sub T)] ++ E) ->
|
|
wf_typ E T.
|
|
Proof.
|
|
intros x T E H. inversion H; auto.
|
|
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. *)
|
|
|
|
Lemma wf_env_narrowing : forall V E F U X,
|
|
wf_env (F ++ [(X, bind_sub V)] ++ E) ->
|
|
wf_typ E U ->
|
|
wf_env (F ++ [(X, bind_sub U)] ++ E).
|
|
Proof with eauto 6 using wf_typ_narrowing.
|
|
induction F; intros U X Wf_env Wf;
|
|
inversion Wf_env; subst; simpl_env in *...
|
|
Qed.
|
|
|
|
Lemma wf_env_strengthening : forall 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 wf_env_subst_tb : forall Q Z P E F,
|
|
wf_env (F ++ [(Z, bind_sub Q)] ++ E) ->
|
|
wf_typ E P ->
|
|
wf_env (map (subst_tb Z P) F ++ E).
|
|
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 *)
|
|
|
|
Lemma notin_fv_tt_open : forall (Y X : atom) T,
|
|
X `notin` fv_tt (open_tt T Y) ->
|
|
X `notin` fv_tt T.
|
|
Proof.
|
|
intros Y X T. unfold open_tt.
|
|
generalize 0.
|
|
induction T; simpl; intros k Fr; notin_simpl; try apply notin_union; eauto.
|
|
Qed.
|
|
|
|
Lemma notin_fv_wf : forall E (X : atom) T,
|
|
wf_typ E T ->
|
|
X `notin` dom E ->
|
|
X `notin` fv_tt T.
|
|
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.
|
|
Case "wf_typ_all".
|
|
apply notin_union...
|
|
pick fresh Y.
|
|
apply (notin_fv_tt_open Y)...
|
|
Qed.
|
|
|
|
Lemma map_subst_tb_id : forall G Z P,
|
|
wf_env G ->
|
|
Z `notin` dom G ->
|
|
G = map (subst_tb Z P) G.
|
|
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 *)
|
|
|
|
Lemma sub_regular : forall E S T,
|
|
sub E S T ->
|
|
wf_env E /\ wf_typ E S /\ wf_typ E T.
|
|
Proof with simpl_env; auto*.
|
|
intros E S T H.
|
|
induction H...
|
|
Case "sub_trans_tvar".
|
|
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.
|
|
|
|
Lemma typing_regular : forall E e T,
|
|
typing E e T ->
|
|
wf_env E /\ expr e /\ wf_typ E T.
|
|
Proof with simpl_env; 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)...
|
|
Qed.
|
|
|
|
Lemma value_regular : forall e,
|
|
value e ->
|
|
expr e.
|
|
Proof.
|
|
intros e H. induction H; auto.
|
|
Qed.
|
|
|
|
Lemma red_regular : forall e e',
|
|
red e e' ->
|
|
expr e /\ expr e'.
|
|
Proof with auto*.
|
|
intros e e' H.
|
|
induction H; assert(J := value_regular); split...
|
|
Case "red_abs".
|
|
inversion H. pick fresh y. rewrite (subst_ee_intro y)...
|
|
Case "red_tabs".
|
|
inversion H. pick fresh Y. rewrite (subst_te_intro Y)...
|
|
Qed.
|
|
|
|
|
|
(* *********************************************************************** *)
|
|
(** * #<a name="auto"></a># Automation *)
|
|
|
|
(** The lemma [ok_from_wf_env] was already added above as a hint since it
|
|
helps blur the distinction between [wf_env] and [ok] in proofs.
|
|
|
|
As currently stated, the regularity lemmas are ill-suited to be
|
|
used with [auto] and [eauto] since they end in conjunctions. Even
|
|
if we were, for example, to split [sub_regularity] into three
|
|
separate lemmas, the resulting lemmas would be usable only by
|
|
[eauto] and there is no guarantee that [eauto] would be able to
|
|
find proofs effectively. Thus, the hints below apply the
|
|
regularity lemmas and [type_from_wf_typ] to discharge goals about
|
|
local closure and well-formedness, but in such a way as to
|
|
minimize proof search.
|
|
|
|
The first hint introduces an [wf_env] fact into the context. It
|
|
works well when combined with the lemmas relating [wf_env] and
|
|
[wf_typ]. We choose to use those lemmas explicitly via [(auto
|
|
using ...)] tactics rather than add them as hints. When used this
|
|
way, the explicitness makes the proof more informative rather than
|
|
more cluttered (with useless details).
|
|
|
|
The other three hints try outright to solve their respective
|
|
goals. *)
|
|
|
|
Hint Extern 1 (wf_env ?E) =>
|
|
match goal with
|
|
| H: sub _ _ _ |- _ => apply (proj1 (sub_regular _ _ _ H))
|
|
| H: typing _ _ _ |- _ => apply (proj1 (typing_regular _ _ _ H))
|
|
end.
|
|
|
|
Hint Extern 1 (wf_typ ?E ?T) =>
|
|
match goal with
|
|
| H: typing E _ T |- _ => apply (proj2 (proj2 (typing_regular _ _ _ H)))
|
|
| H: sub E T _ |- _ => apply (proj1 (proj2 (sub_regular _ _ _ H)))
|
|
| H: sub E _ T |- _ => apply (proj2 (proj2 (sub_regular _ _ _ H)))
|
|
end.
|
|
|
|
Hint Extern 1 (type ?T) =>
|
|
let go E := apply (type_from_wf_typ E); auto in
|
|
match goal with
|
|
| H: typing ?E _ T |- _ => go E
|
|
| H: sub ?E T _ |- _ => go E
|
|
| H: sub ?E _ T |- _ => go E
|
|
end.
|
|
|
|
Hint Extern 1 (expr ?e) =>
|
|
match goal with
|
|
| H: typing _ ?e _ |- _ => apply (proj1 (proj2 (typing_regular _ _ _ H)))
|
|
| H: red ?e _ |- _ => apply (proj1 (red_regular _ _ H))
|
|
| H: red _ ?e |- _ => apply (proj2 (red_regular _ _ H))
|
|
end.
|