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).
intros. autosubst.
Lemma upn_ren:
forall i xi,
ren (iterate upren i xi) = upn i (ren xi).
induction i; intros.
{ reflexivity. }
{ rewrite <- fold_up_upn. rewrite <- IHi. asimpl. reflexivity. }
Lemma plus_upn: (* close to [up_liftn] *)
forall i sigma,
(+i) >>> upn i sigma = sigma >> ren (+i).
induction i; intros.
{ rewrite iterate_0. autosubst. }
{ rewrite iterate_S. asimpl. rewrite IHi. autosubst. }
Lemma up_sigma_up_ren:
forall t i sigma,
t.[up sigma].[up (ren (+i))] = t.[up (ren (+i))].[upn (1 + i) sigma].
intros. asimpl. rewrite plus_upn. asimpl. reflexivity.
Lemma upn_k_sigma_x:
forall k sigma x,
x < k ->
upn k sigma x = ids x.
induction k; intros; asimpl.
{ omega. }
{ destruct x; asimpl.
{ eauto. }
{ rewrite IHk by omega. autosubst. }
Lemma push_substitution_last:
forall t v i,
t.[v .: ren (+i)] = t.[up (ren (+i))].[v/].
intros. autosubst.
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)].
intros. autosubst.
Lemma lift_lift:
forall i j t,
lift i (lift j t) = lift (i + j) t.
intros. autosubst.
Lemma lift_upn:
forall t i sigma,
(lift i t).[upn i sigma] = lift i t.[sigma].
intros. asimpl.
erewrite plus_upn.
Lemma lift_up:
forall t sigma,
(lift 1 t).[up sigma] = lift 1 t.[sigma].
intros. change up with (upn 1). eapply lift_upn.
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.
intros. f_ext. intros [|x]; asimpl; eauto.
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.
induction i; intros.
{ reflexivity. }
{ do 2 rewrite <- fold_up_upn. rewrite IHi. erewrite up_sigma_f by eauto. reflexivity. }
Lemma upn_theta_sigma_ids:
forall theta sigma i,
theta >> sigma = ids ->
upn i theta >> upn i sigma = ids.
intros theta sigma i Hid.
rewrite up_comp_n.
rewrite Hid.
rewrite up_id_n.
Lemma up_theta_sigma_ids:
forall theta sigma,
theta >> sigma = ids ->
up theta >> up sigma = ids.
change up with (upn 1). eauto using upn_theta_sigma_ids.
Lemma scons_scomp:
forall (T : A) Gamma theta,
T.[theta] .: (Gamma >> theta) = (T .: Gamma) >> theta.
intros. autosubst.
(* BUG: the two sides of this equation are distinct, yet they are
printed identically. *)
forall v f,
v .: (ids >>> f) = (v .: ids) >>> f.
Fail reflexivity.
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.
(* 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.
{ assumption. }
{ intros x' Heqx'. eapply Hinj. congruence. }
destruct Hxi as [ xi ? ].
exists xi.
f_ext; intros x. eauto.
(* Applying [up] or [upn i] to a renaming produces a renaming. *)
Lemma up_is_ren:
forall sigma,
is_ren sigma ->
is_ren (up sigma).
intros ? [ xi ? ]. subst. exists (upren xi).
erewrite <- up_ren by eauto with typeclass_instances. reflexivity.
Lemma upn_is_ren:
forall sigma i,
is_ren sigma ->
is_ren (upn i sigma).
intros ? ? [ xi ? ]. subst. exists (iterate upren i xi).
erewrite <- upn_ren by eauto with typeclass_instances. reflexivity.
(* Composing two renamings yields a renaming. *)
Lemma comp_is_ren:
forall sigma1 sigma2,
is_ren sigma1 ->
is_ren sigma2 ->
is_ren (sigma1 >> sigma2).
intros ? ? [ xi1 ? ] [ xi2 ? ]. subst. exists (xi1 >>> xi2). autosubst.
Lemma is_ren_ids:
is_ren ids.
exists id. autosubst.
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.
Require Import List.
Require Import MyTactics.
Require Import Sequences.
Require Import LambdaCalculusSyntax.
Require Import LambdaCalculusFreeVars.
Require Import LambdaCalculusValues.
Require Import LambdaCalculusReduction.
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* A big-step call-by-value semantics. *)
Inductive bigcbv : term -> term -> Prop :=
| BigcbvValue:
forall v,
is_value v ->
bigcbv v v
| BigcbvApp:
forall t1 t2 u1 v2 v,
bigcbv t1 (Lam u1) ->
bigcbv t2 v2 ->
bigcbv u1.[v2/] v ->
bigcbv (App t1 t2) v
| BigcbvLet:
forall t1 t2 v1 v,
bigcbv t1 v1 ->
bigcbv t2.[v1/] v ->
bigcbv (Let t1 t2) v
Hint Constructors bigcbv : bigcbv.
(* The tactic [invert_bigcbv] looks for a hypothesis of the form [bigcbv t v]
and inverts it. *)
Ltac invert_bigcbv :=
pick bigcbv invert;
try solve [ false; eauto 3 with obvious ].
(* -------------------------------------------------------------------------- *)
(* If [bigcbv t v] holds, then [v] must be a value. *)
Lemma bigcbv_is_value:
forall t v,
bigcbv t v ->
is_value v.
induction 1; eauto.
Hint Resolve bigcbv_is_value : is_value obvious.
(* -------------------------------------------------------------------------- *)
(* If [t] evaluates to [v] according to the big-step semantics,
then [t] reduces to [v] according to the small-step semantics. *)
Lemma bigcbv_star_cbv:
forall t v,
bigcbv t v ->
star cbv t v.
(* A detailed proof: *)
induction 1.
(* BigcbvValue *)
{ eapply star_refl. }
(* BigcbvApp *)
{ eapply star_trans. obvious.
eapply star_trans. obvious.
eapply star_step. obvious.
eauto. }
(* BigcbvLet *)
{ eapply star_trans. obvious.
eapply star_step. obvious.
eauto. }
(* A much shorter proof: *)
induction 1; eauto 6 with sequences obvious.
(* Conversely, if [t] reduces to [v] in the small-step semantics,
then [t] evaluates to [v] in the big-step semantics. *)
Lemma cbv_bigcbv_bigcbv:
forall t1 t2,
cbv t1 t2 ->
forall v,
bigcbv t2 v ->
bigcbv t1 v.
(* A detailed proof: *)
induction 1; intros; subst; try solve [ false; tauto ].
(* BetaV *)
{ econstructor; eauto with bigcbv. }
(* LetV *)
{ econstructor; eauto with bigcbv. }
(* AppL *)
{ invert_bigcbv. eauto with bigcbv. }
(* AppR *)
{ invert_bigcbv. eauto with bigcbv. }
(* LetL *)
{ invert_bigcbv. eauto with bigcbv. }
(* A shorter proof: *)
induction 1; intros; subst; try solve [ false; tauto
| econstructor; eauto with bigcbv
| invert_bigcbv; eauto with bigcbv
Lemma star_cbv_bigcbv:
forall t v,
star cbv t v ->
is_value v ->
bigcbv t v.
induction 1; eauto using cbv_bigcbv_bigcbv with bigcbv.
(* In conclusion, we have the following equivalence: *)
Theorem star_cbv_bigcbv_eq:
forall t v,
(star cbv t v /\ is_value v) <-> bigcbv t v.
split; intros; unpack;
eauto using star_cbv_bigcbv, bigcbv_star_cbv with is_value.
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* A big-step call-by-value semantics with explicit environments. *)
(* A closure is a pair of a term and an environment. A cvalue [cv] must be a
closure, as we have no other forms of values. An environment [e] is a list
of cvalues. *)
(* We break the mutual induction between [cvalue] and [cenv] by inlining the
definition of [cenv] into the definition of [cvalue]. *)
(* CVALUE *)
Inductive cvalue :=
| Clo: {bind term} -> list cvalue -> cvalue.
Definition cenv :=
list cvalue.
(* CVALUE *)
(* This dummy cvalue is passed below as an argument to [nth], but is really
irrelevant, as the condition [x < length e] ensures that the dummy cvalue
is never used. *)
Definition dummy_cvalue : cvalue :=
Clo (Var 0) nil.
(* The judgement [ebigcbv e t cv] means that, under the environment [e], the
term [t] evaluates to [cv]. *)
Inductive ebigcbv : cenv -> term -> cvalue -> Prop :=
| EBigcbvVar:
forall e x cv,
(* The variable [x] must be in the domain of [e]. *)
x < length e ->
(* This allows us to safely look up [e] at [x]. *)
cv = nth x e dummy_cvalue ->
ebigcbv e (Var x) cv
| EBigcbvLam:
forall e t,
(* The free variables of [t] must be less than or equal to [length e]. *)
(forall cv, fv (length (cv :: e)) t) ->
(* This allows us to build a closure that is indeed closed. *)
ebigcbv e (Lam t) (Clo t e)
| EBigcbvApp:
forall e e' t1 t2 u1 cv2 cv,
(* Evaluate [t1] to a closure, *)
ebigcbv e t1 (Clo u1 e') ->
(* evaluate [t2] to a value, *)
ebigcbv e t2 cv2 ->
(* and evaluate the function body, in a suitable environment. *)
ebigcbv (cv2 :: e') u1 cv ->
ebigcbv e (App t1 t2) cv
| EBigcbvLet:
forall e t1 t2 cv1 cv,
(* Evaluate [t1] to a value, *)
ebigcbv e t1 cv1 ->
(* and evaluate [t2] under a suitable environment. *)
ebigcbv (cv1 :: e) t2 cv ->
ebigcbv e (Let t1 t2) cv
Hint Constructors ebigcbv : ebigcbv.
(* -------------------------------------------------------------------------- *)
(* To explain what the above semantics means, and to prove that it is
equivalent to the big-step semantics, we first define a function that
decodes a cvalue into a value. *)
(* Ideally, the function [decode] should be defined by the equation:
decode (Clo t e) = (Lam t).[decode_cenv e]
where the auxiliary function [decode_cenv] maps [decode] over the
environment [e], and converts the result to a substitution, that
is, a function of type [term -> term]:
decode_cenv e = fun x => nth x (map decode e) (decode dummy_cvalue)
The definitions below are a bit more awkward (as Coq does not support
mutual induction very well), but mean the same thing. *)
Definition dummy_value : term :=
Lam (Var 0).
Fixpoint decode (cv : cvalue) : term :=
match cv with
| Clo t e =>
(Lam t).[fun x => nth x (map decode e) dummy_value]
(* I am not even sure why this definition is accepted by Coq? *)
Definition decode_cenv e :=
fun x => nth x (map decode e) (decode dummy_cvalue).
(* The first equation in the above comment is satisfied, as shown by
the following lemma. The second equation in the above comment is
satisfied too, by definition. *)
Lemma decode_eq:
forall t e,
decode (Clo t e) = (Lam t).[decode_cenv e].
(* This equation is useful, too. *)
Lemma decode_cenv_Var_eq:
forall x e,
(Var x).[decode_cenv e] = decode (nth x e dummy_cvalue).
intros. asimpl. unfold decode_cenv. rewrite map_nth. eauto.
(* The tactic [decode] rewrites using the above two equations. *)
Hint Rewrite decode_eq decode_cenv_Var_eq : decode.
Ltac decode := autorewrite with decode in *.
(* We make [decode] opaque, so its definition is not unfolded by Coq. *)
Opaque decode.
(* [decode cv] is always a value. *)
Lemma is_value_decode:
forall cv,
is_value (decode cv).
intros. destruct cv. decode. asimpl. tauto.
Lemma is_value_decode_cenv:
forall x e,
is_value (Var x).[decode_cenv e].
intros. decode. eauto using is_value_decode.
Local Hint Resolve is_value_decode is_value_decode_cenv : is_value obvious.
(* A composition of two substitutions is the same thing as one substitution. *)
Lemma decode_cenv_cons:
forall t e cv,
t.[up (decode_cenv e)].[decode cv/] = t.[decode_cenv (cv :: e)].
intros. autosubst. (* wonderful *)
(* The tactic [nonvalue_eq_decode] closes a subgoal when there is a hypothesis
of the form [_ = decode_cenv e x], where the left-hand side of the equation
clearly is not a value. This is a contradiction. *)
Ltac nonvalue_eq_decode :=
match goal with
| heq: _ = decode_cenv ?e ?x |- _ =>
assert (hv: is_value (decode_cenv e x)); [
solve [ obvious ]
| rewrite <- heq in hv; false; is_value ]
(* -------------------------------------------------------------------------- *)
(* If [t] evaluates to [cv] under environment [e],
then, in the big-step semantics,
the term [t.[decode_cenv e]] evaluates to the value [decode cv]. *)
Lemma ebigcbv_bigcbv:
forall e t cv,
ebigcbv e t cv ->
bigcbv t.[decode_cenv e] (decode cv).
induction 1; intros; subst.
(* EBigcbvVar *)
{ decode. econstructor. obvious. }
(* EBigcbvLam *)
{ econstructor. obvious. }
(* EBigcbvApp *)
{ decode.
asimpl. econstructor; eauto.
asimpl. eauto. }
(* EBigcbvLet *)
{ asimpl. econstructor; eauto.
asimpl. eauto. }
(* A simplified corollary, where [t] is closed and is therefore evaluated
under the empty environment. *)
Lemma ebigcbv_bigcbv_nil:
forall t cv,
ebigcbv nil t cv ->
closed t ->
bigcbv t (decode cv).
replace t with t.[decode_cenv nil] by eauto using closed_unaffected.
eauto using ebigcbv_bigcbv.
(* -------------------------------------------------------------------------- *)
(* The converse statement: if in the big-step semantics, the term
[t.[decode_cenv e]] evaluates to the value [decode cv], then [t] evaluates
to [cv] under environment [e]. *)
(* This proof does not work (and, in fact, the statement is wrong). A failed
proof attempt reveals two problems... *)