(** Infrastructure lemmas and tactic definitions 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 definitions, tactics, and lemmas that are based only on the syntax of the language at hand.  While the exact statements of everything here would change for a different language, the general structure of this file (i.e., the sequence of definitions, tactics, and lemmas) would remain the same.  Table of contents: - #<a href="##fv">Free variables</a># - #<a href="##subst">Substitution</a># - #<a href="##gather_atoms">The "gather_atoms" tactic</a># - #<a href="##properties">Properties of opening and substitution</a># - #<a href="##lc">Local closure is preserved under substitution</a># - #<a href="##auto">Automation</a># - #<a href="##body">Properties of body_e</a># *)
Require Export Fsub.Fsub_LetSum_Definitions.
(* ********************************************************************** *)
(** * #<a name="fv"></a># Free variables *)
(** In this section, we define free variable functions.  The functions [fv_tt] and [fv_te] calculate the set of atoms used as free type variables in a type or expression, respectively.  The function [fv_ee] calculates the set of atoms used as free expression variables in an expression.  Cases involving binders are straightforward since bound variables are indices, not names, in locally nameless representation. *)
Fixpoint fv_tt (T : typ) {struct T} : atoms :=
match T with
| typ_top => {}
| typ_bvar J => {}
| typ_fvar X => {{ X }}
| typ_arrow T1 T2 => (fv_tt T1) `union` (fv_tt T2)
| typ_all T1 T2 => (fv_tt T1) `union` (fv_tt T2)
| typ_sum T1 T2 => (fv_tt T1) `union` (fv_tt T2)
end.
Fixpoint fv_te (e : exp) {struct e} : atoms :=
match e with
| exp_bvar i => {}
| exp_fvar x => {}
| exp_abs V e1  => (fv_tt V) `union` (fv_te e1)
| exp_app e1 e2 => (fv_te e1) `union` (fv_te e2)
| exp_tabs V e1 => (fv_tt V) `union` (fv_te e1)
| exp_tapp e1 V => (fv_tt V) `union` (fv_te e1)
| exp_let e1 e2 => (fv_te e1) `union` (fv_te e2)
| exp_inl e1 => (fv_te e1)
| exp_inr e1 => (fv_te e1)
| exp_case e1 e2 e3 => (fv_te e1) `union` (fv_te e2) `union` (fv_te e3)
end.
Fixpoint fv_ee (e : exp) {struct e} : atoms :=
match e with
| exp_bvar i => {}
| exp_fvar x => {{ x }}
| exp_abs V e1 => (fv_ee e1)
| exp_app e1 e2 => (fv_ee e1) `union` (fv_ee e2)
| exp_tabs V e1 => (fv_ee e1)
| exp_tapp e1 V => (fv_ee e1)
| exp_let e1 e2 => (fv_ee e1) `union` (fv_ee e2)
| exp_inl e1 => (fv_ee e1)
| exp_inr e1 => (fv_ee e1)
| exp_case e1 e2 e3 => (fv_ee e1) `union` (fv_ee e2) `union` (fv_ee e3)
end.
(* ********************************************************************** *)
(** * #<a name="subst"></a># Substitution *)
(** In this section, we define substitution for expression and type variables appearing in types, expressions, and environments. Substitution differs from opening because opening replaces indices whereas substitution replaces free variables.  The definitions below are relatively simple for two reasons. - We are using locally nameless representation, where bound variables are represented using indices.  Thus, there is no need to rename variables to avoid capture. - The definitions below assume that the term being substituted in, i.e., the second argument to each function, is locally closed.  Thus, there is no need to shift indices when passing under a binder. *)
Fixpoint subst_tt (Z : atom) (U : typ) (T : typ) {struct T} : typ :=
match T with
| typ_top => typ_top
| typ_bvar J => typ_bvar J
| typ_fvar X => if X == Z then U else T
| typ_arrow T1 T2 => typ_arrow (subst_tt Z U T1) (subst_tt Z U T2)
| typ_all T1 T2 => typ_all (subst_tt Z U T1) (subst_tt Z U T2)
| typ_sum T1 T2 => typ_sum (subst_tt Z U T1) (subst_tt Z U T2)
end.
Fixpoint subst_te (Z : atom) (U : typ) (e : exp) {struct e} : exp :=
match e with
| exp_bvar i => exp_bvar i
| exp_fvar x => exp_fvar x
| exp_abs V e1 => exp_abs  (subst_tt Z U V)  (subst_te Z U e1)
| exp_app e1 e2 => exp_app  (subst_te Z U e1) (subst_te Z U e2)
| exp_tabs V e1 => exp_tabs (subst_tt Z U V)  (subst_te Z U e1)
| exp_tapp e1 V => exp_tapp (subst_te Z U e1) (subst_tt Z U V)
| exp_let e1 e2 => exp_let (subst_te Z U e1) (subst_te Z U e2)
| exp_inl e1 => exp_inl (subst_te Z U e1)
| exp_inr e1 => exp_inr (subst_te Z U e1)
| exp_case e1 e2 e3 => exp_case (subst_te Z U e1)
(subst_te Z U e2) (subst_te Z U e3)
end.
Fixpoint subst_ee (z : atom) (u : exp) (e : exp) {struct e} : exp :=
match e with
| exp_bvar i => exp_bvar i
| exp_fvar x => if x == z then u else e
| exp_abs V e1 => exp_abs V (subst_ee z u e1)
| exp_app e1 e2 => exp_app (subst_ee z u e1) (subst_ee z u e2)
| exp_tabs V e1 => exp_tabs V (subst_ee z u e1)
| exp_tapp e1 V => exp_tapp (subst_ee z u e1) V
| exp_let e1 e2 => exp_let (subst_ee z u e1) (subst_ee z u e2)
| exp_inl e1 => exp_inl (subst_ee z u e1)
| exp_inr e1 => exp_inr (subst_ee z u e1)
| exp_case e1 e2 e3 => exp_case (subst_ee z u e1)
(subst_ee z u e2) (subst_ee z u e3)
end.
Definition subst_tb (Z : atom) (P : typ) (b : binding) : binding :=
match b with
| bind_sub T => bind_sub (subst_tt Z P T)
| bind_typ T => bind_typ (subst_tt Z P T)
end.
(* ********************************************************************** *)
(** * #<a name="gather_atoms"></a># The "[gather_atoms]" tactic *)
(** The Metatheory and MetatheoryAtom libraries define a number of tactics for working with cofinite quantification and for picking fresh atoms.  To specialize those tactics to this language, we only need to redefine the [gather_atoms] tactic, which returns the set of all atoms in the current context.  The definition of [gather_atoms] follows a pattern based on repeated calls to [gather_atoms_with].  The one argument to this tactic is a function that takes an object of some particular type and returns a set of atoms that appear in that argument.  It is not necessary to understand exactly how [gather_atoms_with] works. If we add a new inductive datatype, say for kinds, to our language, then we would need to modify [gather_atoms].  On the other hand, if we merely add a new type, say products, then there is no need to modify [gather_atoms]; the required changes would be made in [fv_tt]. *)
Ltac gather_atoms ::=
let A := gather_atoms_with (fun x : atoms => x) in
let B := gather_atoms_with (fun x : atom => singleton x) in
let C := gather_atoms_with (fun x : exp => fv_te x) in
let D := gather_atoms_with (fun x : exp => fv_ee x) in
let E := gather_atoms_with (fun x : typ => fv_tt x) in
let F := gather_atoms_with (fun x : env => dom x) in
constr:(A `union` B `union` C `union` D `union` E `union` F).
(* ********************************************************************** *)
(** * #<a name="properties"></a># Properties of opening and substitution *)
(** The following lemmas provide useful structural properties of substitution and opening.  While the exact statements are language specific, we have found that similar properties are needed in a wide range of languages.  Below, we indicate which lemmas depend on which other lemmas. Since [te] functions depend on their [tt] counterparts, a similar dependency can be found in the lemmas.  The lemmas are split into three sections, one each for the [tt], [te], and [ee] functions.  The most important lemmas are the following: - Substitution and opening commute with each other, e.g., [subst_tt_open_tt_var]. - Opening a term is equivalent to opening the term with a fresh name and then substituting for that name, e.g., [subst_tt_intro].  We keep the sections as uniform in structure as possible.  In particular, we state explicitly strengthened induction hypotheses even when there are more concise ways of proving the lemmas of interest. *)
(* ********************************************************************** *)
(** ** Properties of type substitution in types *)
(** The next lemma is the strengthened induction hypothesis for the lemma that follows, which states that opening a locally closed term is the identity.  This lemma is not otherwise independently useful. *)
Proof with congruence || eauto.
induction T; intros j V i U Neq H; simpl in *; inversion H; f_equal...
Case "typ_bvar".
destruct (j === n)... destruct (i === n)...
Qed.
(** Opening a locally closed term is the identity.  This lemma depends on the immediately preceding lemma. *)
Proof with auto.
intros T U k Htyp. revert k.
induction Htyp; intros k; simpl; f_equal...
Case "typ_all".
unfold open_tt in *.
pick fresh X.
apply (open_tt_rec_type_aux T2 0 (typ_fvar X))...
Qed.
(** If a name is fresh for a term, then substituting for it is the identity. *)
Proof with auto.
induction T; simpl; intro H; f_equal...
Case "typ_fvar".
destruct (a == Z)...
contradict H; fsetdec.
Qed.
(** Substitution commutes with opening under certain conditions.  This lemma depends on the fact that opening a locally closed term is the identity. *)
Proof with auto.
intros T1 T2 X P k WP. revert k.
induction T1; intros k; simpl; f_equal...
Case "typ_bvar".
destruct (k === n); subst...
Case "typ_fvar".
destruct (a == X); subst... apply open_tt_rec_type...
Qed.
(** The next lemma is a direct corollary of the immediately preceding lemma---the index is specialized to zero. *)
Proof with auto.
intros.
unfold open_tt.
apply subst_tt_open_tt_rec...
Qed.
(** The next lemma is a direct corollary of the immediately preceding lemma---here, we're opening the term with a variable.  In practice, this lemma seems to be needed as a left-to-right rewrite rule, when stated in its current form. *)
Proof with congruence || auto.
intros X Y P T Neq Wu.
unfold open_tt.
rewrite subst_tt_open_tt_rec...
simpl.
destruct (Y == X)...
Qed.
(** The next lemma states that opening a term is equivalent to first opening the term with a fresh name and then substituting for the name.  This is actually the strengthened induction hypothesis for the version we use in practice. *)
Proof with congruence || auto.
induction T2; intros U k Fr; simpl in *; f_equal...
Case "typ_bvar".
destruct (k === n)... simpl. destruct (X == X)...
Case "typ_fvar".
destruct (a == X)... contradict Fr; fsetdec.
Qed.
(** The next lemma is a direct corollary of the immediately preceding lemma---the index is specialized to zero.  *)
Proof with auto.
intros.
unfold open_tt.
apply subst_tt_intro_rec...
Qed.
(* ********************************************************************** *)
(** ** Properties of type substitution in expressions *)
(** This section follows the structure of the previous section.  The one notable difference is that we require two auxiliary lemmas to show that substituting a type in a locally-closed expression is the identity. *)
Proof with congruence || eauto.
induction e; intros j u i P H; simpl in *; inversion H; f_equal...
Qed.
Proof with auto.
intros.
unfold open_te.
apply subst_te_open_te_rec...
Qed.
Proof with congruence || auto.
intros X Y U e Neq WU.
unfold open_te.
rewrite subst_te_open_te_rec...
simpl.
destruct (Y == X)...
Qed.
Proof with auto.
intros.
unfold open_te.
apply subst_te_intro_rec...
Qed.
(* ********************************************************************** *)
(** ** Properties of expression substitution in expressions *)
(** This section follows the structure of the previous two sections. *)
Proof with congruence || eauto.
induction e; intros j v u i Neq H; simpl in *; inversion H; f_equal...
Case "exp_bvar".
destruct (j===n)... destruct (i===n)...
Qed.
Proof with auto.
intros u e k Hexpr. revert k.
induction Hexpr; intro k; simpl; f_equal; auto*;
try solve [
unfold open_ee in *;
pick fresh x;
eapply open_ee_rec_expr_aux with (j := 0) (v := exp_fvar x);
auto
| unfold open_te in *;
pick fresh X;
eapply open_ee_rec_type_aux with (j := 0) (V := typ_fvar X);
auto
].
Qed.
Proof with auto.
intros x u e; induction e; simpl; intro H; f_equal...
Case "exp_fvar".
destruct (a==x)...
contradict H; fsetdec.
Qed.
Proof with auto.
intros e1 e2 x u k WP. revert k.
induction e1; intros k; simpl; f_equal...
Case "exp_bvar".
destruct (k === n); subst...
Case "exp_fvar".
destruct (a == x); subst... apply open_ee_rec_expr...
Qed.
Proof with auto.
intros.
unfold open_ee.
apply subst_ee_open_ee_rec...
Qed.

Lemma subst_ee_open_ee_var : forall (x y:atom) u e,
y <> x ->
expr u ->
open_ee (subst_ee x u e) y = subst_ee x u (open_ee e y).