346 lines
8.5 KiB
Coq
346 lines
8.5 KiB
Coq
|
Require Import Omega.
|
||
|
|
Require Import Autosubst.Autosubst.
|
||
|
|
Require Import AutosubstExtra.
|
||
|
|
Require Import Autosubst_EOS.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
Class IdsLemmas (term : Type) {Ids_term : Ids term} := {
|
||
|
|
(* The identity substitution is injective. *)
|
||
|
|
ids_inj:
|
||
|
|
forall x y,
|
||
|
|
ids x = ids y ->
|
||
|
|
x = y
|
||
|
|
}.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
Section FreeVars.
|
||
|
|
|
||
|
|
Context
|
||
|
|
{A : Type}
|
||
|
|
{Ids_A : Ids A}
|
||
|
|
{Rename_A : Rename A}
|
||
|
|
{Subst_A : Subst A}
|
||
|
|
{IdsLemmas_A : IdsLemmas A}
|
||
|
|
{SubstLemmas_A : SubstLemmas A}.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* A reformulation of [ids_inj]. *)
|
||
|
|
|
||
|
|
Lemma ids_inj_False:
|
||
|
|
forall x y,
|
||
|
|
ids x = ids y ->
|
||
|
|
x <> y ->
|
||
|
|
False.
|
||
|
|
Proof.
|
||
|
|
intros.
|
||
|
|
assert (x = y). { eauto using ids_inj. }
|
||
|
|
unfold var in *.
|
||
|
|
omega.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* The predicate [fv k t] means that the free variables of the term [t] are
|
||
|
|
contained in the semi-open interval [0..k). *)
|
||
|
|
|
||
|
|
Definition fv k t :=
|
||
|
|
t.[upn k (ren (+1))] = t.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* The predicate [closed t] means that the term [t] is closed, that is, [t]
|
||
|
|
has no free variables. *)
|
||
|
|
|
||
|
|
Definition closed :=
|
||
|
|
fv 0.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* This technical lemma states that the renaming [+1] is injective. *)
|
||
|
|
|
||
|
|
Lemma lift_inj_ids:
|
||
|
|
forall t x,
|
||
|
|
t.[ren (+1)] = ids (S x) <-> t = ids x.
|
||
|
|
Proof.
|
||
|
|
split; intros.
|
||
|
|
{ eapply lift_inj. autosubst. }
|
||
|
|
{ subst. autosubst. }
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* This lemma characterizes the meaning of [fv k] when applied to a variable. *)
|
||
|
|
|
||
|
|
Lemma fv_ids_eq:
|
||
|
|
forall k x,
|
||
|
|
fv k (ids x) <-> x < k.
|
||
|
|
Proof.
|
||
|
|
unfold fv. induction k; intros.
|
||
|
|
(* Base case. *)
|
||
|
|
{ asimpl. split; intros; elimtype False.
|
||
|
|
{ eauto using ids_inj_False. }
|
||
|
|
{ omega. }
|
||
|
|
}
|
||
|
|
(* Step. *)
|
||
|
|
{ destruct x; asimpl.
|
||
|
|
{ split; intros. { omega. } { reflexivity. } }
|
||
|
|
{ rewrite lift_inj_ids.
|
||
|
|
rewrite <- id_subst.
|
||
|
|
rewrite IHk. omega. }
|
||
|
|
}
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* A simplification lemma. *)
|
||
|
|
|
||
|
|
Lemma fv_lift:
|
||
|
|
forall k i t,
|
||
|
|
fv (k + i) t.[ren (+i)] <-> fv k t.
|
||
|
|
Proof.
|
||
|
|
unfold fv. intros. asimpl.
|
||
|
|
rewrite Nat.add_comm.
|
||
|
|
rewrite <- upn_upn.
|
||
|
|
erewrite plus_upn by eauto.
|
||
|
|
rewrite <- subst_comp.
|
||
|
|
split; intros.
|
||
|
|
{ eauto using lift_injn. }
|
||
|
|
{ f_equal. eauto. }
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* If [t] has at most [n - 1] free variables,
|
||
|
|
and if [x] is inserted among them,
|
||
|
|
then we get [eos x t],
|
||
|
|
which has at most [n] free variables. *)
|
||
|
|
|
||
|
|
Lemma fv_eos:
|
||
|
|
forall x n t,
|
||
|
|
x < n ->
|
||
|
|
fv (n - 1) t ->
|
||
|
|
fv n (eos x t).
|
||
|
|
Proof.
|
||
|
|
unfold fv. intros x n t ? ht.
|
||
|
|
rewrite eos_eq in ht.
|
||
|
|
rewrite eos_eq.
|
||
|
|
rewrite eos_eos_reversed by omega. (* nice! *)
|
||
|
|
rewrite ht.
|
||
|
|
reflexivity.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
Lemma fv_eos_eq:
|
||
|
|
forall x n t,
|
||
|
|
x < n ->
|
||
|
|
fv n (eos x t) <->
|
||
|
|
fv (n - 1) t.
|
||
|
|
Proof.
|
||
|
|
unfold fv. intros x n t ?.
|
||
|
|
rewrite eos_eq.
|
||
|
|
rewrite eos_eq.
|
||
|
|
rewrite eos_eos_reversed by omega. (* nice! *)
|
||
|
|
split; intros h.
|
||
|
|
{ eauto using eos_injective. }
|
||
|
|
{ rewrite h. reflexivity. }
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* A substitution [sigma] is regular if and only if, for some [j], for
|
||
|
|
sufficiently large [x], [sigma x] is [x + j]. *)
|
||
|
|
|
||
|
|
Definition regular (sigma : var -> A) :=
|
||
|
|
exists i j,
|
||
|
|
ren (+i) >> sigma = ren (+j).
|
||
|
|
|
||
|
|
Lemma regular_ids:
|
||
|
|
regular ids.
|
||
|
|
Proof.
|
||
|
|
exists 0. exists 0. autosubst.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
Lemma regular_plus:
|
||
|
|
forall i,
|
||
|
|
regular (ren (+i)).
|
||
|
|
Proof.
|
||
|
|
intros. exists 0. exists i. autosubst.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
Lemma regular_upn:
|
||
|
|
forall n sigma,
|
||
|
|
regular sigma ->
|
||
|
|
regular (upn n sigma).
|
||
|
|
Proof.
|
||
|
|
intros ? ? (i&j&hsigma).
|
||
|
|
exists (n + i). eexists (n + j).
|
||
|
|
replace (ren (+(n + i))) with (ren (+i) >> ren (+n)) by autosubst.
|
||
|
|
rewrite <- scompA.
|
||
|
|
rewrite up_liftn.
|
||
|
|
rewrite scompA.
|
||
|
|
rewrite hsigma.
|
||
|
|
autosubst.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* If the free variables of the term [t] are below [k], then [t] is unaffected
|
||
|
|
by a substitution of the form [upn k sigma]. *)
|
||
|
|
|
||
|
|
(* Unfortunately, in this file, where the definition of type [A] is unknown, I
|
||
|
|
am unable to establish this result for arbitrary substitutions [sigma]. I
|
||
|
|
am able to establish it for *regular* substitutions, where The proof is somewhat interesting, so it is given here, even
|
||
|
|
though, once the definition of the type [A] is known, a more direct proof,
|
||
|
|
without a regularity hypothesis, can usually be given. *)
|
||
|
|
|
||
|
|
(* An intermediate result states that, since [upn k (ren (+1))] does not
|
||
|
|
affect [t], then (by iteration) neither does [upn k (ren (+j))]. *)
|
||
|
|
|
||
|
|
Lemma fv_unaffected_lift:
|
||
|
|
forall j t k,
|
||
|
|
fv k t ->
|
||
|
|
t.[upn k (ren (+j))] = t.
|
||
|
|
Proof.
|
||
|
|
induction j as [| j ]; intros t k ht.
|
||
|
|
{ asimpl. rewrite up_id_n. autosubst. }
|
||
|
|
{ replace (ren (+S j)) with (ren (+1) >> ren (+j)) by autosubst.
|
||
|
|
rewrite <- up_comp_n.
|
||
|
|
replace (t.[upn k (ren (+1)) >> upn k (ren (+j))])
|
||
|
|
with (t.[upn k (ren (+1))].[upn k (ren (+j))]) by autosubst.
|
||
|
|
rewrite ht.
|
||
|
|
rewrite IHj by eauto.
|
||
|
|
eauto. }
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* There follows that a substitution of the form [upn k sigma], where [sigma]
|
||
|
|
is regular, does not affect [t]. The proof is slightly subtle but very
|
||
|
|
short. The previous lemma is used twice. *)
|
||
|
|
|
||
|
|
Lemma fv_unaffected_regular:
|
||
|
|
forall k t sigma,
|
||
|
|
fv k t ->
|
||
|
|
regular sigma ->
|
||
|
|
t.[upn k sigma] = t.
|
||
|
|
Proof.
|
||
|
|
intros k t sigma ? (i&j&hsigma).
|
||
|
|
rewrite <- (fv_unaffected_lift i t k) at 1 by eauto.
|
||
|
|
asimpl. rewrite up_comp_n.
|
||
|
|
rewrite hsigma.
|
||
|
|
rewrite fv_unaffected_lift by eauto.
|
||
|
|
reflexivity.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* A corollary. *)
|
||
|
|
|
||
|
|
Lemma closed_unaffected_regular:
|
||
|
|
forall t sigma,
|
||
|
|
closed t ->
|
||
|
|
regular sigma ->
|
||
|
|
t.[sigma] = t.
|
||
|
|
Proof.
|
||
|
|
unfold closed. intros.
|
||
|
|
rewrite <- (upn0 sigma).
|
||
|
|
eauto using fv_unaffected_regular.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(*One might also wish to prove a result along the following lines:
|
||
|
|
|
||
|
|
Goal
|
||
|
|
forall t k sigma1 sigma2,
|
||
|
|
fv k t ->
|
||
|
|
(forall x, x < k -> sigma1 x = sigma2 x) ->
|
||
|
|
t.[sigma1] = t.[sigma2].
|
||
|
|
|
||
|
|
I have not yet investigated how this could be proved. *)
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* If some term [t] has free variables under [j], then it also has free
|
||
|
|
variables under [k], where [j <= k]. *)
|
||
|
|
|
||
|
|
Lemma fv_monotonic:
|
||
|
|
forall j k t,
|
||
|
|
fv j t ->
|
||
|
|
j <= k ->
|
||
|
|
fv k t.
|
||
|
|
Proof.
|
||
|
|
intros. unfold fv.
|
||
|
|
replace k with (j + (k - j)) by omega.
|
||
|
|
rewrite <- upn_upn.
|
||
|
|
eauto using fv_unaffected_regular, regular_upn, regular_plus.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* These little lemmas may be occasionally useful. *)
|
||
|
|
|
||
|
|
Lemma use_fv_length_cons:
|
||
|
|
forall A (x : A) (xs : list A) n t,
|
||
|
|
(forall x, fv (length (x :: xs)) t) ->
|
||
|
|
n = length xs ->
|
||
|
|
fv (n + 1) t.
|
||
|
|
Proof.
|
||
|
|
intros. subst.
|
||
|
|
replace (length xs + 1) with (length (x :: xs)) by (simpl; omega).
|
||
|
|
eauto.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
Lemma prove_fv_length_cons:
|
||
|
|
forall A (x : A) (xs : list A) n t,
|
||
|
|
n = length xs ->
|
||
|
|
fv (n + 1) t ->
|
||
|
|
fv (length (x :: xs)) t.
|
||
|
|
Proof.
|
||
|
|
intros. subst.
|
||
|
|
replace (length (x :: xs)) with (length xs + 1) by (simpl; omega).
|
||
|
|
eauto.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* [closed t] is equivalent to [t.[ren (+1)] = t]. *)
|
||
|
|
|
||
|
|
Lemma closed_eq:
|
||
|
|
forall t,
|
||
|
|
closed t <-> t.[ren (+1)] = t.
|
||
|
|
Proof.
|
||
|
|
unfold closed, fv. asimpl. tauto.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* A variable is not closed. *)
|
||
|
|
|
||
|
|
Lemma closed_ids:
|
||
|
|
forall x,
|
||
|
|
~ closed (ids x).
|
||
|
|
Proof.
|
||
|
|
unfold closed, fv. intros. asimpl. intro.
|
||
|
|
eauto using ids_inj_False.
|
||
|
|
Qed.
|
||
|
|
|
||
|
|
End FreeVars.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* The tactic [fv] is intended to use a number of lemmas as rewriting rules.
|
||
|
|
The hint database [fv] can be extended with language-specific lemmas. *)
|
||
|
|
|
||
|
|
Hint Rewrite @fv_ids_eq @fv_lift @fv_eos_eq : fv.
|
||
|
|
|
||
|
|
Ltac fv :=
|
||
|
|
autorewrite with fv in *;
|
||
|
|
eauto with typeclass_instances.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
(* A hint database to prove goals of the form [~ (closed _)] or [closed _]. *)
|
||
|
|
|
||
|
|
Hint Resolve closed_ids : closed.
|
||
|
|
|
||
|
|
(* -------------------------------------------------------------------------- *)
|
||
|
|
|
||
|
|
Hint Resolve regular_ids regular_plus regular_upn : regular.
|