mpri-funcprog-project/coq/Autosubst_EOS.v
2017-10-05 17:57:33 +02:00

329 lines
9.7 KiB
Coq

Require Import Omega.
Require Import Autosubst.Autosubst.
Require Import AutosubstExtra. (* just for [upn_ren] *)
Require Import MyTactics. (* TEMPORARY *)
(* This file defines the construction [eos x t], which can be understood as
an end-of-scope mark for [x] in the term [t]. *)
(* It also defines the single-variable substitution t.[u // x], which is the
substitution of [u] for [x] in [t]. *)
(* -------------------------------------------------------------------------- *)
Section EOS.
Context {A} `{Ids A, Rename A, Subst A, SubstLemmas A}.
(* The substitution [Var 0 .: Var 1 .: ... .: Var (x-1) .: Var (x+1) .: ...]
does not have [Var x] in its codomain. Thus, applying this substitution
to a term [t] can be understood as an end-of-scope construct: it means
``end the scope of [x] in [t]''. We write [eos x t] for this construct.
It is also known as [adbmal]: see Hendriks and van Oostrom,
https://doi.org/10.1007/978-3-540-45085-6_11 *)
(* There are at least two ways of defining the above substitution. One way
is to define it in terms of AutoSubst combinators: *)
Definition eos_var x : var -> var :=
(iterate upren x (+1)).
Definition eos x t :=
t.[ren (eos_var x)].
Lemma eos_eq:
forall x t,
t.[upn x (ren (+1))] = eos x t.
Proof.
intros. unfold eos, eos_var. erewrite upn_ren by tc. reflexivity.
Qed.
(* Another way is to define directly as a function of type [var -> var]. *)
Definition lift_var x : var -> var :=
fun y => if le_gt_dec x y then 1 + y else y.
(* The two definitions coincide: *)
Lemma upren_lift_var:
forall x,
upren (lift_var x) = lift_var (S x).
Proof.
intros. f_ext; intros [|y].
{ reflexivity. }
{ simpl. unfold lift_var, var. dblib_by_cases; omega. }
Qed.
Lemma eos_var_eq_lift_var:
eos_var = lift_var.
Proof.
(* An uninteresting proof. *)
f_ext; intros x.
unfold eos_var.
induction x.
{ reflexivity. }
{ rewrite iterate_S.
rewrite IHx.
rewrite upren_lift_var.
reflexivity. }
Qed.
(* -------------------------------------------------------------------------- *)
(* [eos] enjoys certain commutation laws. *)
(* Ending the scope of variable [k], then the scope of variable [s], is the
same as first ending the scope of variable [1 + s], then ending the scope
of variable [k]. This holds provided [k <= s] is true, i.e., [k] is the
most recently-introduced variable.*)
Lemma lift_var_lift_var:
forall k s,
k <= s ->
lift_var s >>> lift_var k = lift_var k >>> lift_var (S s).
Proof.
(* By case analysis. *)
intros. f_ext; intros x. asimpl.
unfold lift_var, var. dblib_by_cases; omega.
Qed.
Lemma eos_eos:
forall k s t,
k <= s ->
eos k (eos s t) = eos (1 + s) (eos k t).
Proof.
intros. unfold eos. asimpl.
rewrite eos_var_eq_lift_var.
rewrite lift_var_lift_var by eauto.
reflexivity.
Qed.
(* What about the case where [k] is the least recently-introduced variable?
It is obtained by symmetry, of course. *)
Lemma eos_eos_reversed:
forall k s t,
k >= s + 1 ->
eos k (eos s t) = eos s (eos (k - 1) t).
Proof.
intros.
replace k with (1 + (k - 1)) by omega.
rewrite <- eos_eos by omega.
replace (1 + (k - 1) - 1) with (k - 1) by omega.
reflexivity.
Qed.
(* -------------------------------------------------------------------------- *)
(* Single-variable substitutions. *)
(* [subst_var u x] is the substitution of [u] for [x]. *)
(* We give a direct definition of it as a function of type [var -> term],
defined by cases. I don't know if it could also be nicely defined in
terms of the basic combinators of de Bruijn algebra. Note that the
candidate definition [upn x (t .: ids)] is WRONG when [x > 0]. *)
Definition subst_var (u : A) (x y : var) : A :=
match lt_eq_lt_dec y x with
| inleft (left _) => ids y
| inleft (right _) => u
| inright _ => ids (y - 1)
end.
(* A nice notation: [t.[u // x]] is the substitution of [u] for [x] in [t]. *)
Notation "t .[ u // x ]" := (subst (subst_var u x) t)
(at level 2, u at level 200, left associativity,
format "t .[ u // x ]") : subst_scope.
(* The following laws serve as sanity checks: we got the definition right. *)
Lemma subst_var_miss_1:
forall x y u,
y < x ->
(ids y).[u // x] = ids y.
Proof.
intros. asimpl. unfold subst_var. dblib_by_cases. reflexivity.
Qed.
Lemma subst_var_match:
forall x u,
(ids x).[ u // x ] = u.
Proof.
intros. asimpl. unfold subst_var. dblib_by_cases. reflexivity.
Qed.
Lemma subst_var_miss_2:
forall x y u,
x < y ->
(ids y).[u // x] = ids (y - 1).
Proof.
intros. asimpl. unfold subst_var. dblib_by_cases. reflexivity.
Qed.
(* In the special case where [x] is 0, the substitution [t // 0] can also
be written [t/], which is an AutoSubst notation for [t .: ids]. *)
Lemma subst_var_0:
forall t u,
t.[u // 0] = t.[u/].
Proof.
intros. f_equal. clear t.
f_ext. intros [|x].
{ reflexivity. }
{ unfold subst_var. simpl. f_equal. omega. }
Qed.
(* -------------------------------------------------------------------------- *)
(* A cancellation law: substituting for a variable [x] that does not occur in
[t] yields just [t]. In other words, a substitution for [x] vanishes when
it reaches [eos x _]. *)
(* In informal syntax, this lemma would be written:
t[u/x] = t
under the hypothesis that x does not occur free in t.
In de Bruijn style, the statement is just as short, and does not have a
side condition. Instead, it requires an explicit [eos x _] to appear at the
root of the term to which the substitution is applied; this may require
rewriting before this lemma can be applied. *)
Lemma subst_eos:
forall x t u,
(eos x t).[u // x] = t.
Proof.
intros.
(* Again, let's simplify this first. *)
unfold eos. asimpl.
(* Aha! We can forget about [t], and focus on proving that two
substitutions are equal. To do so, it is sufficient that
their actions on a variable [y] are the same. *)
rewrite <- subst_id.
f_equal. clear t.
f_ext. intro y.
(* The proof is easy if we replace [eos_var] with [lift_var]. *)
rewrite eos_var_eq_lift_var. simpl.
unfold subst_var, lift_var. dblib_by_cases; f_equal; omega.
Qed.
(* The above property allows us to prove that [eos x _] is injective.
Indeed, it has an inverse, namely [u // x], where [u] is arbitrary. *)
Lemma eos_injective:
forall x t1 t2,
eos x t1 = eos x t2 ->
t1 = t2.
Proof.
intros.
pose (u := t1). (* dummy *)
erewrite <- (subst_eos x t1 u).
erewrite <- (subst_eos x t2 u).
congruence.
Qed.
(* -------------------------------------------------------------------------- *)
(* More commutation laws. *)
Lemma eos_subst_1:
forall k s t u,
k <= s ->
eos k (t.[u // s]) = (eos k t).[eos k u // s + 1].
Proof.
intros. unfold eos. asimpl. f_equal. clear t.
rewrite eos_var_eq_lift_var.
f_ext. intros y.
asimpl.
unfold subst_var, lift_var.
dblib_by_cases; asimpl; dblib_by_cases; solve [ eauto | f_equal; omega ].
Qed.
Lemma eos_subst_2:
forall k s t u,
s <= k ->
eos k (t.[u // s]) = (eos (k + 1) t).[eos k u // s].
Proof.
intros. unfold eos. asimpl. f_equal. clear t.
rewrite eos_var_eq_lift_var.
f_ext. intros y.
asimpl.
unfold subst_var, lift_var.
dblib_by_cases; asimpl; dblib_by_cases; solve [ eauto | f_equal; omega ].
Qed.
Lemma subst_subst:
forall t k v s w,
k <= s ->
t.[w // k].[v // s] =
t.[eos k v // 1 + s].[w.[v // s] // k].
Proof.
(* First, get rid of [t]. It is sufficient to consider the action of
these substitutions at a variable [y]. *)
intros. asimpl. f_equal. clear t. f_ext. intros y.
(* Replace [eos_var] with [lift_var], whose definition is more direct. *)
unfold eos. rewrite eos_var_eq_lift_var.
(* Then, use brute force (case analysis) to prove that the goal holds. *)
unfold subst_var. simpl.
dblib_by_cases; asimpl; dblib_by_cases;
(* This case analysis yields 5 cases, of which 4 are trivial... *)
eauto.
(* ... thus, one case remains. *)
(* Now get rid of [v]. It is again sufficient to consider the action
of these substitutions at a variable [z]. *)
replace v with v.[ids] at 1 by autosubst.
f_equal. f_ext. intros z. simpl.
(* Again, use brute force. *)
unfold lift_var. dblib_by_cases; f_equal. unfold var. omega.
(* Not really proud of this proof. *)
Qed.
Lemma pun_1:
forall t x,
(eos x t).[ ids x // x + 1 ] = t.
Proof.
(* First, get rid of [t]. It is sufficient to consider the action of
these substitutions at a variable [y]. *)
intros. unfold eos. asimpl.
replace t with t.[ids] at 2 by autosubst.
f_equal. clear t. f_ext. intros y.
(* Replace [eos_var] with [lift_var], whose definition is more direct. *)
rewrite eos_var_eq_lift_var.
(* Then, use brute force (case analysis) to prove that the goal holds. *)
simpl. unfold subst_var, lift_var. dblib_by_cases; f_equal; unfold var; omega.
Qed.
Lemma pun_2:
forall t x,
(eos (x + 1) t).[ ids x // x ] = t.
Proof.
(* First, get rid of [t]. It is sufficient to consider the action of
these substitutions at a variable [y]. *)
intros. unfold eos. asimpl.
replace t with t.[ids] at 2 by autosubst.
f_equal. clear t. f_ext. intros y.
(* Replace [eos_var] with [lift_var], whose definition is more direct. *)
rewrite eos_var_eq_lift_var.
(* Then, use brute force (case analysis) to prove that the goal holds. *)
simpl. unfold subst_var, lift_var. dblib_by_cases; f_equal; unfold var; omega.
Qed.
End EOS.
(* Any notations defined in the above section must now be repeated. *)
Notation "t .[ u // x ]" := (subst (subst_var u x) t)
(at level 2, u at level 200, left associativity,
format "t .[ u // x ]") : subst_scope.
(* The tactic [subst_var] attempts to simplify applications of [subst_var]. *)
Ltac subst_var :=
first [
rewrite subst_var_miss_1 by omega
| rewrite subst_var_match by omega
| rewrite subst_var_miss_2 by omega
].