314 lines
9.5 KiB
Coq
314 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.
|