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

313 lines
9.5 KiB
Coq

Require Import List.
Require Import MyList.
Require Import MyTactics.
Require Import Sequences.
Require Import MetalSyntax.
Require Import Autosubst_Env.
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* A big-step call-by-value semantics with explicit environments. *)
(* Because every lambda-abstraction is closed, no closures are involved:
a lambda-abstraction evaluates to itself. Thus, an mvalue [mv] must be
either a (closed) lambda-abstraction or a pair of mvalues. *)
Inductive mvalue :=
| MVLam : {bind metal} -> mvalue
| MVPair : mvalue -> mvalue -> mvalue.
Definition dummy_mvalue : mvalue :=
MVLam (MVar 0).
(* An environment [e] is a list of mvalues. *)
Definition menv :=
list mvalue.
(* The judgement [mbigcbv e t mv] means that, under the environment [e], the
term [t] evaluates to [mv]. *)
Inductive mbigcbv : menv -> metal -> mvalue -> Prop :=
| MBigcbvVar:
forall e x mv,
(* The variable [x] must be in the domain of [e]. *)
x < length e ->
(* This allows us to safely look up [e] at [x]. *)
mv = nth x e dummy_mvalue ->
mbigcbv e (MVar x) mv
| MBigcbvLam:
forall e t,
(* The lambda-abstraction must have no free variables. *)
closed (MLam t) ->
mbigcbv e (MLam t) (MVLam t)
| MBigcbvApp:
forall e t1 t2 u1 mv2 mv,
(* Evaluate [t1] to a lambda-abstraction, *)
mbigcbv e t1 (MVLam u1) ->
(* evaluate [t2] to a value, *)
mbigcbv e t2 mv2 ->
(* and evaluate the function body in a singleton environment. *)
mbigcbv (mv2 :: nil) u1 mv ->
mbigcbv e (MApp t1 t2) mv
| MBigcbvLet:
forall e t1 t2 mv1 mv,
(* Evaluate [t1] to a value, *)
mbigcbv e t1 mv1 ->
(* and evaluate [t2] under a suitable environment. *)
mbigcbv (mv1 :: e) t2 mv ->
mbigcbv e (MLet t1 t2) mv
| MBigcbvPair:
forall e t1 t2 mv1 mv2,
(* Evaluate each component to a value, *)
mbigcbv e t1 mv1 ->
mbigcbv e t2 mv2 ->
(* and construct a pair. *)
mbigcbv e (MPair t1 t2) (MVPair mv1 mv2)
| MBigcbvPi:
forall e i t mv1 mv2 mv,
(* Evaluate [t] to a pair value, *)
mbigcbv e t (MVPair mv1 mv2) ->
(* and project out the desired component. *)
mv = match i with 0 => mv1 | _ => mv2 end ->
mbigcbv e (MPi i t) mv
.
Hint Constructors mbigcbv : mbigcbv.
(* -------------------------------------------------------------------------- *)
(* A reformulation of the evaluation rule for variables. *)
Lemma MBigcbvVarExact:
forall e1 mv e2 x,
x = length e1 ->
mbigcbv (e1 ++ mv :: e2) (MVar x) mv.
Proof.
intros. econstructor.
{ length. }
{ rewrite app_nth by eauto. reflexivity. }
Qed.
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* We now examine how the big-step semantics interacts with renamings.
We prove that if (roughly) the equation [e = xi >>> e'] holds then
evaluating [t.[xi]] under [e'] is the same as evaluating [t] under
[e]. *)
Lemma mbigcbv_ren:
forall e t mv,
mbigcbv e t mv ->
forall e' xi,
env_ren_comp e xi e' ->
mbigcbv e' t.[ren xi] mv.
Proof.
induction 1; intros;
try solve [ asimpl; eauto with env_ren_comp mbigcbv ].
(* MVar *)
{ pick @env_ren_comp invert.
econstructor; eauto. }
(* MLam *)
{ rewrite closed_unaffected by eauto.
eauto with mbigcbv. }
Qed.
(* As a special case, evaluating [eos x t] under an environment of the form
[e1 ++ mv :: e2], where length of [e1] is [x] (so [x] is mapped to [mv])
is the same as evaluating [t] under [e1 ++ e2]. The operational effect
of the end-of-scope mark [eos x _] is to delete the value stored at index
[x] in the evaluation environment. *)
Lemma mbigcbv_eos:
forall e1 e2 x t mv mw,
mbigcbv (e1 ++ e2) t mw ->
x = length e1 ->
mbigcbv (e1 ++ mv :: e2) (eos x t) mw.
Proof.
intros. eapply mbigcbv_ren; eauto with env_ren_comp.
Qed.
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* Evaluation rules for (simulated) tuples. *)
Fixpoint MVTuple mvs :=
match mvs with
| nil =>
MVLam (MVar 0)
| mv :: mvs =>
MVPair mv (MVTuple mvs)
end.
Lemma MBigcbvTuple:
forall e ts mvs,
(* Evaluate every component to a value, *)
Forall2 (mbigcbv e) ts mvs ->
(* and construct a tuple. *)
mbigcbv e (MTuple ts) (MVTuple mvs).
Proof.
induction 1; simpl; econstructor; eauto.
{ unfold closed. fv. }
Qed.
Lemma MBigcbvProj:
forall i e t mvs mv,
i < length mvs ->
(* Evaluate [t] to a tuple value, *)
mbigcbv e t (MVTuple mvs) ->
(* and project out the desired component. *)
mv = nth i mvs dummy_mvalue ->
mbigcbv e (MProj i t) mv.
Proof.
(* By induction on [i]. In either case, [mvs] cannot be an empty list. *)
induction i; intros; (destruct mvs as [| mv0 mvs ]; [ false; simpl in *; omega |]).
(* Base case. *)
{ econstructor; eauto. }
(* Step case. *)
{ assert (i < length mvs). { length. }
simpl. eauto with mbigcbv. }
Qed.
Lemma MBigcbvLetPair:
forall e t u mv mv1 mv2,
mbigcbv e t (MVPair mv1 mv2) ->
mbigcbv (mv2 :: mv1 :: e) u mv ->
mbigcbv e (MLetPair t u) mv.
Proof.
unfold MLetPair. eauto 6 using mbigcbv_ren, env_ren_comp_plus1 with mbigcbv.
Qed.
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* Evaluation rules for [MMultiLet]. *)
Local Lemma Forall2_mbigcbv_plus1:
forall ts mvs e i mv,
Forall2 (mbigcbv e) (map (fun t : metal => lift i t) ts) mvs ->
Forall2 (mbigcbv (mv :: e)) (map (fun t : metal => lift (i + 1) t) ts) mvs.
Proof.
induction ts as [| t ts]; simpl; intros;
pick Forall2 invert; econstructor; eauto.
replace (lift (i + 1) t) with (lift 1 (lift i t)) by autosubst.
eauto using mbigcbv_ren, env_ren_comp_plus1.
Qed.
Lemma MBigcbvMultiLet:
forall ts e i u mvs mv,
Forall2 (mbigcbv e) (map (fun t => lift i t) ts) mvs ->
mbigcbv (rev mvs ++ e) u mv ->
mbigcbv e (MMultiLet i ts u) mv.
Proof.
induction ts; simpl; intros; pick Forall2 invert.
{ eauto. }
{ pick mbigcbv ltac:(fun h => rewrite rev_cons_app in h).
econstructor; eauto using Forall2_mbigcbv_plus1. }
Qed.
Lemma MBigcbvMultiLet_0:
forall ts e u mvs mv,
Forall2 (mbigcbv e) ts mvs ->
mbigcbv (rev mvs ++ e) u mv ->
mbigcbv e (MMultiLet 0 ts u) mv.
Proof.
intros. eapply MBigcbvMultiLet.
{ asimpl. rewrite map_id. eauto. }
{ eauto. }
Qed.
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* An evaluation rule for [MVars]. *)
Lemma MBigcbvVars_preliminary:
forall e2 e1 e x n,
e = e1 ++ e2 ->
x = length e1 ->
n = length e2 ->
Forall2 (mbigcbv e) (map MVar (seq x n)) e2.
Proof.
induction e2 as [| mv e2 ]; intros; subst; econstructor.
{ eauto using MBigcbvVarExact. }
{ eapply IHe2 with (e1 := e1 ++ mv :: nil).
{ rewrite <- app_assoc. reflexivity. }
{ length. }
{ eauto. }
}
Qed.
Lemma MBigcbvVars:
forall e,
Forall2 (mbigcbv e) (MVars (length e)) e.
Proof.
unfold MVars, nats. intros.
eapply MBigcbvVars_preliminary with (e1 := nil); eauto.
Qed.
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* An evaluation rule for [MProjs]. If the term [t] evaluates to a tuple whose
components numbered 1, ..., n are collected in the list [mvs1], then the
family of terms [MProjs n t] evaluates to the family of values [rev mvs1]. *)
Lemma MBigcbvProjs:
forall n e t mv mvs1 mvs2,
mbigcbv e t (MVTuple (mv :: mvs1 ++ mvs2)) ->
length mvs1 = n ->
Forall2 (mbigcbv e) (MProjs n t) (rev mvs1).
Proof.
(* This result is "obvious" but requires some low-level work. *)
unfold MProjs. induction n; intros.
(* Case: [n] is zero. Then, [mvs1] must be [nil]. The result follows. *)
{ destruct mvs1; [| false; simpl in *; omega ].
econstructor. }
(* Case: [n] is nonzero. Then, the list [mvs1] must be nonempty. *)
assert (hmvs1: mvs1 <> nil).
{ intro. subst. simpl in *. omega. }
(* So, this list has one element at the end. Let us write this list in the
form [mvs1 ++ mv1]. *)
destruct (exists_last hmvs1) as (hd&mv1&?). subst mvs1. clear hmvs1.
generalize dependent hd; intro mvs1; intros.
(* Simplify. *)
rewrite rev_unit.
rewrite <- app_assoc in *.
rewrite app_length in *.
assert (length mvs1 = n). { length. }
simpl map.
econstructor.
(* The list heads. *)
{ eapply MBigcbvProj; eauto.
{ length. }
{ replace (n + 1) with (S n) by omega. simpl.
rewrite app_nth by omega.
reflexivity. }
}
(* The list tails. *)
{ eauto. }
Qed.
(* -------------------------------------------------------------------------- *)
(* An evaluation rule for the combination of [MMultiLet] and [MProjs]. If the
term [t] evaluates to a tuple whose components are [mv :: mvs], and if [n]
is the length of [mvs], then evaluating [MMultiLet 0 (MProjs n t) u] in an
environment [e] leads to evaluating [u] in environment [mvs ++ e]. *)
Lemma MBigcbvMultiLetProjs:
forall e t mvs u mv mw n,
mbigcbv e t (MVTuple (mv :: mvs)) ->
length mvs = n ->
mbigcbv (mvs ++ e) u mw ->
mbigcbv e (MMultiLet 0 (MProjs n t) u) mw.
Proof.
intros.
eapply MBigcbvMultiLet_0.
{ eapply MBigcbvProjs with (mvs2 := nil); [ rewrite app_nil_r |]; eauto. }
{ rewrite rev_involutive. eauto. }
Qed.