Commit 21326463 authored by POTTIER Francois's avatar POTTIER Francois

Expose more Coq files.

parent 3e3eabe5
Require Import Omega.
Require Import Autosubst.Autosubst.
(* -------------------------------------------------------------------------- *)
(* A more recognizable notation for lifting. *)
Notation lift i t := (t.[ren(+i)]).
(* -------------------------------------------------------------------------- *)
Section Extras.
Context A `{Ids A, Rename A, Subst A, SubstLemmas A}.
Lemma up_ren:
forall xi,
ren (upren xi) = up (ren xi).
Proof.
intros. autosubst.
Qed.
Lemma upn_ren:
forall i xi,
ren (iterate upren i xi) = upn i (ren xi).
Proof.
induction i; intros.
{ reflexivity. }
{ rewrite <- fold_up_upn. rewrite <- IHi. asimpl. reflexivity. }
Qed.
Lemma plus_upn: (* close to [up_liftn] *)
forall i sigma,
(+i) >>> upn i sigma = sigma >> ren (+i).
Proof.
induction i; intros.
{ rewrite iterate_0. autosubst. }
{ rewrite iterate_S. asimpl. rewrite IHi. autosubst. }
Qed.
Lemma up_sigma_up_ren:
forall t i sigma,
t.[up sigma].[up (ren (+i))] = t.[up (ren (+i))].[upn (1 + i) sigma].
Proof.
intros. asimpl. rewrite plus_upn. asimpl. reflexivity.
Qed.
Lemma upn_k_sigma_x:
forall k sigma x,
x < k ->
upn k sigma x = ids x.
Proof.
induction k; intros; asimpl.
{ omega. }
{ destruct x; asimpl.
{ eauto. }
{ rewrite IHk by omega. autosubst. }
}
Qed.
Lemma push_substitution_last:
forall t v i,
t.[v .: ren (+i)] = t.[up (ren (+i))].[v/].
Proof.
intros. autosubst.
Qed.
Lemma push_substitution_last_up_hoist:
forall t v i j,
t.[up (v .: ren (+i))].[up (ren (+j))] =
t.[up (up (ren (+j + i)))].[up (lift j v .: ids)].
Proof.
intros. autosubst.
Qed.
Lemma lift_lift:
forall i j t,
lift i (lift j t) = lift (i + j) t.
Proof.
intros. autosubst.
Qed.
Lemma lift_upn:
forall t i sigma,
(lift i t).[upn i sigma] = lift i t.[sigma].
Proof.
intros. asimpl.
erewrite plus_upn.
reflexivity.
Qed.
Lemma lift_up:
forall t sigma,
(lift 1 t).[up sigma] = lift 1 t.[sigma].
Proof.
intros. change up with (upn 1). eapply lift_upn.
Qed.
Lemma up_sigma_f:
forall (sigma : var -> A) (f : A -> A),
f (ids 0) = ids 0 ->
(forall i t, lift i (f t) = f (lift i t)) ->
up (sigma >>> f) = up sigma >>> f.
Proof.
intros. f_ext. intros [|x]; asimpl; eauto.
Qed.
Lemma upn_sigma_f:
forall (sigma : var -> A) (f : A -> A),
f (ids 0) = ids 0 ->
(forall i t, lift i (f t) = f (lift i t)) ->
forall i,
upn i (sigma >>> f) = upn i sigma >>> f.
Proof.
induction i; intros.
{ reflexivity. }
{ do 2 rewrite <- fold_up_upn. rewrite IHi. erewrite up_sigma_f by eauto. reflexivity. }
Qed.
Lemma upn_theta_sigma_ids:
forall theta sigma i,
theta >> sigma = ids ->
upn i theta >> upn i sigma = ids.
Proof.
intros theta sigma i Hid.
rewrite up_comp_n.
rewrite Hid.
rewrite up_id_n.
reflexivity.
Qed.
Lemma up_theta_sigma_ids:
forall theta sigma,
theta >> sigma = ids ->
up theta >> up sigma = ids.
Proof.
change up with (upn 1). eauto using upn_theta_sigma_ids.
Qed.
Lemma scons_scomp:
forall (T : A) Gamma theta,
T.[theta] .: (Gamma >> theta) = (T .: Gamma) >> theta.
Proof.
intros. autosubst.
Qed.
(* BUG: the two sides of this equation are distinct, yet they are
printed identically. *)
Goal
forall v f,
v .: (ids >>> f) = (v .: ids) >>> f.
Proof.
intros.
Fail reflexivity.
Abort.
End Extras.
(* This incantation means that [eauto with autosubst] can use the tactic
[autosubst] to prove an equality. *)
Hint Extern 1 (_ = _) => autosubst : autosubst.
(* This incantation means that [eauto with autosubst] can use the lemmas
whose names are listed here. This is useful when an equality involves
metavariables, so the tactic [autosubst] fails. *)
Hint Resolve scons_scomp : autosubst.
Require Import Coq.Logic.ClassicalUniqueChoice.
Require Import Autosubst.Autosubst.
Require Import AutosubstExtra.
Section Lemmas.
Context {A} `{Ids A, Rename A, Subst A, SubstLemmas A}.
(* The predicate [is_ren sigma] means that the substitution [sigma] is in fact
a renaming [ren xi]. *)
(* When stating a lemma that involves a renaming, it is preferable to use a
substitution [sigma], together with a hypothesis [is_ren sigma], rather
than request that [sigma] be of the form [ren xi]. This allows us to use
[obvious] to check that [sigma] is a renaming, whereas we would otherwise
have to manually rewrite [sigma] to the form [ren xi]. *)
Definition is_ren sigma :=
exists xi, sigma = ren xi.
(* One way of proving that [sigma] is a renaming is to prove that [sigma] maps
every variable [x] to a variable [y]. *)
Lemma prove_is_ren:
forall sigma,
(forall x y, ids x = ids y -> x = y) ->
(forall x, exists y, sigma x = ids y) ->
is_ren sigma.
Proof.
(* This proof uses the axiom of unique choice. If one is willing to use
the stronger axiom of choice, then one can remove the hypothesis that
[ids] is injective. *)
intros ? Hinj Hxy.
assert (Hxi: exists xi : var -> var, forall x, sigma x = ids (xi x)).
{ eapply unique_choice with (R := fun x y => sigma x = ids y).
intros x. destruct (Hxy x) as [ y Heqy ]. exists y.
split.
{ assumption. }
{ intros x' Heqx'. eapply Hinj. congruence. }
}
destruct Hxi as [ xi ? ].
exists xi.
f_ext; intros x. eauto.
Qed.
(* Applying [up] or [upn i] to a renaming produces a renaming. *)
Lemma up_is_ren:
forall sigma,
is_ren sigma ->
is_ren (up sigma).
Proof.
intros ? [ xi ? ]. subst. exists (upren xi).
erewrite <- up_ren by eauto with typeclass_instances. reflexivity.
Qed.
Lemma upn_is_ren:
forall sigma i,
is_ren sigma ->
is_ren (upn i sigma).
Proof.
intros ? ? [ xi ? ]. subst. exists (iterate upren i xi).
erewrite <- upn_ren by eauto with typeclass_instances. reflexivity.
Qed.
(* Composing two renamings yields a renaming. *)
Lemma comp_is_ren:
forall sigma1 sigma2,
is_ren sigma1 ->
is_ren sigma2 ->
is_ren (sigma1 >> sigma2).
Proof.
intros ? ? [ xi1 ? ] [ xi2 ? ]. subst. exists (xi1 >>> xi2). autosubst.
Qed.
Lemma is_ren_ids:
is_ren ids.
Proof.
exists id. autosubst.
Qed.
End Lemmas.
Hint Unfold is_ren : is_ren obvious.
Hint Resolve up_is_ren upn_is_ren comp_is_ren is_ren_ids : is_ren obvious.
This diff is collapsed.
Require Import MyTactics.
Require Import LambdaCalculusSyntax.
(* This technical lemma states that the renaming [lift 1] is injective. *)
Lemma lift_inj_Var:
forall t x,
lift 1 t = Var (S x) <-> t = Var x.
Proof.
split; intros.
{ eauto using lift_inj. }
{ subst. eauto. }
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 [fv] is characterized by the following lemmas. *)
Lemma fv_Var_eq:
forall k x,
fv k (Var x) <-> x < k.
Proof.
unfold fv. asimpl. induction k; intros.
(* Base case. *)
{ asimpl. split; intros; false.
{ unfold ids, Ids_term in *. injections. omega. }
{ omega. }
}
(* Step. *)
{ destruct x; asimpl.
{ split; intros. { omega. } { reflexivity. } }
rewrite lift_inj_Var. rewrite IHk. omega. }
Qed.
Lemma fv_Lam_eq:
forall k t,
fv k (Lam t) <-> fv (S k) t.
Proof.
unfold fv. intros. asimpl. split; intros.
{ injections. eauto. }
{ unpack. congruence. }
Qed.
Lemma fv_App_eq:
forall k t1 t2,
fv k (App t1 t2) <-> fv k t1 /\ fv k t2.
Proof.
unfold fv. intros. asimpl. split; intros.
{ injections. eauto. }
{ unpack. congruence. }
Qed.
Lemma fv_Let_eq:
forall k t1 t2,
fv k (Let t1 t2) <-> fv k t1 /\ fv (S k) t2.
Proof.
unfold fv. intros. asimpl. split; intros.
{ injections. eauto. }
{ unpack. congruence. }
Qed.
Hint Rewrite fv_Var_eq fv_Lam_eq fv_App_eq fv_Let_eq : fv.
(* The tactic [fv] uses the above lemmas as rewriting rules. *)
Ltac fv :=
autorewrite with fv in *.
(* -------------------------------------------------------------------------- *)
(* The predicate [closed t] means that the term [t] is closed, that is, [t]
has no free variables. *)
Definition closed :=
fv 0.
(* [closed t] is equivalent to [lift 1 t = t]. *)
Lemma closed_eq:
forall t,
closed t <-> lift 1 t = t.
Proof.
unfold closed, fv. asimpl. tauto.
Qed.
(* The following lemmas allow decomposing a closedness hypothesis.
Because [closed] is not an inductive notion, there is no lemma
for [Lam] and for the right-hand side of [Let]. *)
Lemma closed_Var:
forall x,
~ closed (Var x).
Proof.
unfold closed; intros; fv. omega.
Qed.
Lemma closed_AppL:
forall t1 t2,
closed (App t1 t2) ->
closed t1.
Proof.
unfold closed; intros; fv. tauto.
Qed.
Lemma closed_AppR:
forall t1 t2,
closed (App t1 t2) ->
closed t2.
Proof.
unfold closed; intros; fv. tauto.
Qed.
Lemma closed_LetL:
forall t1 t2,
closed (Let t1 t2) ->
closed t1.
Proof.
unfold closed; intros; fv. tauto.
Qed.
Hint Resolve closed_Var closed_AppL closed_AppR closed_LetL : closed.
(* -------------------------------------------------------------------------- *)
(* If the free variables of the term [t] are below [k], then [t] is unaffected
by a substitution of the form [upn k sigma]. *)
Lemma fv_unaffected:
forall t k sigma,
fv k t ->
t.[upn k sigma] = t.
Proof.
induction t; intros; fv; unpack; asimpl;
try solve [ eauto using upn_k_sigma_x with typeclass_instances
| f_equal; eauto ].
Qed.
(* If the term [t] is closed, then [t] is unaffected by any substitution. *)
Lemma closed_unaffected:
forall t sigma,
closed t ->
t.[sigma] = t.
Proof.
intros. eapply fv_unaffected with (k := 0). eauto.
Qed.
Require Import Option.
Require Import List.
Require Import MyTactics.
Require Import LambdaCalculusSyntax.
Require Import LambdaCalculusFreeVars.
Require Import LambdaCalculusBigStep.
(* We now wish to define an interpreter for the lambda-calculus. In other
words, whereas [ebigcbv] is a relation, we now wish to define a function
[interpret] whose graph is the relation [ebigcbv]. *)
(* At the moment, our lambda-calculus is pure (every value is a function)
so the interpreter cannot encounter a runtime error. *)
(* -------------------------------------------------------------------------- *)
(* We might naively wish to write the following code, which Coq rejects,
because this function is not obviously terminating. (Exercise: which
recursive call is the culprit?) Indeed, an interpreter for the untyped
lambda-calculus does not always terminate: there are lambda-terms whose
evaluation diverges. (Exercise: exhibit a term that reduces to itself
in one or more reduction steps. Prove in Coq that this is the case.) *)
(* FAILINTERPRET *)
Fail Fixpoint interpret (e : cenv) (t : term) : cvalue :=
match t with
| Var x =>
nth x e dummy_cvalue
(* dummy is used when x is out of range *)
| Lam t =>
Clo t e
| App t1 t2 =>
let cv1 := interpret e t1 in
let cv2 := interpret e t2 in
match cv1 with Clo u1 e' =>
interpret (cv2 :: e') u1
end
(* FAILINTERPRET *)
| Let t1 t2 =>
let cv1 := interpret e t1 in
interpret (cv1 :: e) t2
(* FAILINTERPRET *)
end.
(* FAILINTERPRET *)
(* -------------------------------------------------------------------------- *)
(* There are several potential solutions to the above problem. One solution
would be to write code in (some implementation of) the partiality monad.
(See Dagand's lectures.) The solution proposed here is to parameterize
the function [interpret] with a natural integer [n], which serves as an
amount of "fuel" (or "effort") that we are willing to invest before we
give up. Thus, termination becomes obvious. The downside is that the
interpreter can now fail (which means "not enough fuel"). Fortunately,
given enough fuel, every terminating term can be evaluated. *)
(* For Coq to accept the following definition, the fuel [n] must decrease at
every recursive call. We might wish to be more precise and somehow explain
that [n] needs to decrease only at the third recursive call in the case of
[App]lications. That would require defining a lexicographic ordering on the
pair [n, t], arguing that this ordering is well-founded, and defining
[interpret] by well-founded recursion. This can be done in Coq but is more
complicated, so (here) not worth the trouble. *)
(* FIXINTERPRET *)
Fixpoint interpret (n : nat) e t : option cvalue :=
match n with
| 0 => None (* not enough fuel *)
| S n =>
match t with
| Var x => Some (nth x e dummy_cvalue)
| Lam t => Some (Clo t e)
| App t1 t2 =>
interpret n e t1 >>= fun cv1 =>
interpret n e t2 >>= fun cv2 =>
match cv1 with Clo u1 e' =>
interpret n (cv2 :: e') u1
end
(* FIXINTERPRET *)
| Let t1 t2 =>
interpret n e t1 >>= fun cv1 =>
interpret n (cv1 :: e) t2
(* FIXINTERPRET *)
end end.
(* FIXINTERPRET *)
(* -------------------------------------------------------------------------- *)
(* The interpreter is correct with respect to the big-step semantics. *)
Lemma interpret_ebigcbv:
forall n e t cv,
interpret n e t = Some cv ->
fv (length e) t ->
wf_cenv e ->
ebigcbv e t cv.
Proof.
(* The definition of [interpret] is by induction on [n], so this proof
must be by induction on [n] as well. *)
induction n; destruct t; simpl; intros;
fv; unpack; injections; subst;
try solve [ congruence ].
(* Var *)
{ econstructor; eauto. }
(* Lam *)
{ econstructor; eauto. }
(* App *)
{ repeat invert_bind_Some.
(* Every cvalue is a closure. Name the components of the closure
obtained by interpreting [t1]. *)
match goal with h: interpret _ _ t1 = Some ?cv |- _ =>
destruct cv as [ t' e' ]
end.
(* The goal follows. *)
econstructor; eauto 11 with wf_cvalue. }
(* Let *)
{ invert_bind_Some.
econstructor; eauto with wf_cvalue. }
Qed.
(* A simplified corollary, where [t] is closed and is therefore evaluated
under the empty environment, and where we conclude with a [bigcbv]
judgement. *)
Lemma interpret_bigcbv_nil:
forall n t cv,
interpret n nil t = Some cv ->
closed t ->
bigcbv t (decode cv).
Proof.
eauto using ebigcbv_bigcbv_nil, interpret_ebigcbv with wf_cvalue.
Qed.
(* -------------------------------------------------------------------------- *)
(* The interpreter is monotonic with respect to the amount of fuel that is
provided: the more fuel, the better (that is, the more defined the result). *)
Lemma interpret_monotonic:
forall n1 n2 e t,
n1 <= n2 ->
less_defined (interpret n1 e t) (interpret n2 e t).
Proof.
(* This series of tactics get rid of the easy cases: *)
induction n1; destruct t; simpl; intros;
(* [less_defined None _] is always true. *)
eauto with less_defined;
(* If [S n1 <= n2], then [n2] must be a successor. *)
(destruct n2; [ omega |]); simpl;
(* [less_defined] is reflexive. *)
eauto with less_defined.
(* Two more complex cases remain, namely [App] and [Let]. Probably
the proof could be further automated, but I did not try. *)
(* App *)
{ eapply prove_less_defined_bind.
{ eauto using le_S_n. }
{ intros _ [ t' e' ]. (* destruct the closure produced by [t1] *)
eapply prove_less_defined_bind; eauto using le_S_n. }
}
(* Let *)
{ eauto 6 using le_S_n with less_defined. }
Qed.
(* A reformulation. *)
Lemma interpret_monotonic_corollary:
forall n1 n2 e t cv,
interpret n1 e t = Some cv ->
n1 <= n2 ->
interpret n2 e t = Some cv.
Proof.
generalize interpret_monotonic. unfold less_defined. eauto.
Qed.
(* -------------------------------------------------------------------------- *)
(* The interpreter is complete with respect to the big-step semantics
[ebigcbv]. That is, given enough fuel, and given a term whose value is
[cv], it will compute [cv]. *)
Lemma ebigcbv_interpret:
forall e t cv,
ebigcbv e t cv ->
exists n,
interpret n e t = Some cv.
Proof.
(* We can see, in the proof, that the necessary amount of fuel, [n], is
the height of the derivation of the judgement [ebigcbv e t cv].
Indeed, at every [App] or [Let] node, we count 1 plus the maximum
amount of fuel required by our children. *)
induction 1; intros; subst.
(* EBigcbvVar *)
{ exists 1. eauto. }
(* EBigcbvLam *)
{ exists 1. eauto. }
(* EBigcbvApp *)
{ destruct IHebigcbv1 as [ n1 ? ].
destruct IHebigcbv2 as [ n2 ? ].
destruct IHebigcbv3 as [ n3 ? ].
eexists (S (max (max n1 n2) n3)). simpl.
eauto 6 using prove_bind_Some, interpret_monotonic_corollary with omega. }
(* EBigcbvLet *)
{ destruct IHebigcbv1 as [ n1 ? ].
destruct IHebigcbv2 as [ n2 ? ].
eexists (S (max n1 n2)). simpl.
eauto using prove_bind_Some, interpret_monotonic_corollary with omega. }
Qed.
(* The interpreter is complete with respect to the big-step semantics
[bigcbv]. That is, given enough fuel, and given a term [t] whose value is
[v], it will compute a cvalue [cv] which decodes to [v]. We state this in
the case where [t] is closed and is therefore evaluated under the empty
environment. *)
Lemma bigcbv_interpret_nil:
forall t v,
bigcbv t v ->
closed t ->
exists n cv,
interpret n nil t = Some cv /\ decode cv = v.
Proof.
intros.
edestruct bigcbv_ebigcbv_nil; eauto. unpack.
edestruct ebigcbv_interpret; eauto.
Qed.
This diff is collapsed.
Require Import Coq.Wellfounded.Inverse_Image.
Require Import MyTactics.
Require Export Autosubst.Autosubst.
Require Export AutosubstExtra.
Require Export Autosubst_IsRen.
(* The syntax of the lambda-calculus. *)
Inductive term :=
| Var (x : var)
| Lam (t : {bind term})
| App (t1 t2 : term)
| Let (t1 : term) (t2 : {bind term})
.
Instance Ids_term : Ids term. derive. Defined.
Instance Rename_term : Rename term. derive. Defined.
Instance Subst_term : Subst term. derive. Defined.
Instance SubstLemmas_term : SubstLemmas term. derive. Qed.
(* If the image of [t] through a substitution is a variable, then [t] must
itself be a variable. *)
Lemma subst_is_var:
forall t sigma x,
t.[sigma] = ids x ->
exists y,
t = ids y.
Proof.
intros ? ? ? Heq. destruct t; compute in Heq; solve [ eauto | congruence ].
Qed.
(* The identity substitution [ids] is injective. *)
Lemma inj_ids:
forall x y,
ids x = ids y ->
x = y.
Proof.
intros ? ? Heq. compute in Heq. congruence.
Qed.
(* If the composition of two substitutions [sigma1] and [sigma2] is the
identity substitution, then [sigma1] must be a renaming. *)
Lemma ids_implies_is_ren:
forall sigma1 sigma2,
sigma1 >> sigma2 = ids ->
is_ren sigma1.
Proof.
intros ? ? Hid.
eapply prove_is_ren; [ eapply inj_ids | intros x ].
eapply subst_is_var with (sigma := sigma2) (x := x).
rewrite <- Hid. reflexivity.
Qed.
Hint Resolve ids_implies_is_ren : is_ren obvious.
(* The size of a term. *)
Fixpoint size (t : term) : nat :=
match t with
| Var _ => 0
| Lam t => 1 + size t
| App t1 t2