Commit 95bdb831 authored by Amin Timany's avatar Amin Timany

Add Lam, Letin, and Seq in F_mu_ref_conc, add factorial example

parent ca2a84e5
...@@ -70,6 +70,7 @@ theories/logrel/F_mu_ref_conc/examples/stack/stack_rules.v ...@@ -70,6 +70,7 @@ theories/logrel/F_mu_ref_conc/examples/stack/stack_rules.v
theories/logrel/F_mu_ref_conc/examples/stack/CG_stack.v theories/logrel/F_mu_ref_conc/examples/stack/CG_stack.v
theories/logrel/F_mu_ref_conc/examples/stack/FG_stack.v theories/logrel/F_mu_ref_conc/examples/stack/FG_stack.v
theories/logrel/F_mu_ref_conc/examples/stack/refinement.v theories/logrel/F_mu_ref_conc/examples/stack/refinement.v
theories/logrel/F_mu_ref_conc/examples/fact.v
theories/hocap/abstract_bag.v theories/hocap/abstract_bag.v
theories/hocap/cg_bag.v theories/hocap/cg_bag.v
......
From iris.proofmode Require Import tactics.
From iris_examples.logrel.F_mu_ref_conc Require Import
soundness_binary rules rules_binary.
From iris.program_logic Require Import adequacy.
Fixpoint mathfact n :=
match n with
| O => 1
| S m => n * (mathfact m)
end.
Definition fact : expr :=
Rec (If (BinOp Eq (Var 1) (#n 0))
(#n 1)
(BinOp Mult (Var 1) (App (Var 0) (BinOp Sub (Var 1) (#n 1))))).
Lemma fact_typed : [] fact : TArrow TNat TNat.
Proof. repeat econstructor. Qed.
Definition fact_acc_body : expr :=
Rec (Lam
(If (BinOp Eq (Var 2) (#n 0))
(Var 0)
(LetIn
(BinOp Mult (Var 2) (Var 0))
(LetIn
(BinOp Sub (Var 3) (#n 1))
(App (App (Var 3) (Var 0)) (Var 1))
)
)
)
).
Lemma fact_acc_body_typed : [] fact_acc_body : TArrow TNat (TArrow TNat TNat).
Proof. repeat econstructor. Qed.
Lemma fact_acc_body_subst f : fact_acc_body.[f] = fact_acc_body.
Proof. by asimpl. Qed.
Hint Rewrite fact_acc_body_subst : autosubst.
Lemma fact_acc_body_unfold :
fact_acc_body =
Rec (Lam
(If (BinOp Eq (Var 2) (#n 0))
(Var 0)
(LetIn
(BinOp Mult (Var 2) (Var 0))
(LetIn
(BinOp Sub (Var 3) (#n 1))
(App (App (Var 3) (Var 0)) (Var 1))
)
)
)
).
Proof. trivial. Qed.
Global Typeclasses Opaque fact_acc_body.
Global Opaque fact_acc_body.
Definition fact_acc : expr :=
Lam (App (App fact_acc_body (Var 0)) (#n 1)).
Lemma fact_acc_typed : [] fact_acc : TArrow TNat TNat.
Proof.
repeat econstructor.
apply (closed_context_weakening [_] []); eauto.
apply fact_acc_body_typed.
Qed.
Section fact_equiv.
Context `{heapIG Σ, cfgSG Σ}.
Lemma fact_fact_acc_refinement :
[] fact log fact_acc : (TArrow TNat TNat).
Proof.
iIntros (? vs ρ _) "[#HE HΔ]".
iDestruct (interp_env_length with "HΔ") as %?; destruct vs; simplify_eq.
rewrite !empty_env_subst.
iClear "HΔ". simpl.
iIntros (j K) "Hj"; simpl.
iApply wp_value; iExists (LamV _); iFrame.
rewrite /= -/fact.
iAlways. iIntros ([? ?] [n [? ?]]); simpl in *; simplify_eq; simpl.
clear j K.
iIntros (j K) "Hj"; simpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
asimpl.
iApply (wp_mono _ _ _ (λ v, j fill K (#n (mathfact n)) v = #nv (mathfact n)))%I.
{ iIntros (?) "[? %]"; iExists (#nv _); iFrame; eauto. }
replace (fill K (#n mathfact n)) with (fill K (#n (1 * mathfact n)))
by by repeat f_equal; lia.
generalize 1 as l => l.
iInduction n as [|n] "IH" forall (l).
- iApply wp_pure_step_later; auto.
iNext; simpl; asimpl.
rewrite fact_acc_body_unfold.
iMod (do_step_pure _ _ _ (AppLCtx _ :: _) with "[$Hj]") as "Hj"; auto.
rewrite -fact_acc_body_unfold.
simpl; asimpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
iApply (wp_bind (fill [IfCtx _ _])).
iApply wp_pure_step_later; auto.
iNext; simpl.
iApply wp_value. simpl.
iMod (do_step_pure _ _ _ (IfCtx _ _ :: _) with "[$Hj]") as "Hj"; auto.
simpl.
iApply wp_pure_step_later; auto.
iNext; simpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
iApply wp_value.
replace (l * 1) with l by lia.
auto.
- iApply wp_pure_step_later; auto.
iNext; simpl; asimpl.
rewrite fact_acc_body_unfold.
iMod (do_step_pure _ _ _ (AppLCtx _ :: _) with "[$Hj]") as "Hj"; auto.
rewrite -fact_acc_body_unfold.
simpl; asimpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
iApply (wp_bind (fill [IfCtx _ _])).
iApply wp_pure_step_later; auto.
iNext; simpl.
iApply wp_value. simpl.
iMod (do_step_pure _ _ _ (IfCtx _ _ :: _) with "[$Hj]") as "Hj"; auto.
simpl.
iApply wp_pure_step_later; auto.
iNext; simpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
asimpl.
iApply (wp_bind (fill [BinOpRCtx _ (#nv _)])).
iApply (wp_bind (fill [AppRCtx (RecV _)])).
iApply wp_pure_step_later; auto.
iNext; simpl; iApply wp_value; simpl.
iMod (do_step_pure _ _ _ (LetInCtx _ :: _) with "[$Hj]") as "Hj"; auto.
simpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
asimpl.
iMod (do_step_pure _ _ _ (LetInCtx _ :: _) with "[$Hj]") as "Hj"; auto.
simpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
asimpl.
replace (n -0) with n by lia.
iApply wp_wand_r; iSplitL; first iApply ("IH" with "[Hj]"); eauto.
iIntros (v) "[H %]"; simplify_eq.
iApply wp_pure_step_later; auto.
iNext; simpl; iApply wp_value.
replace (l * (mathfact n + n * mathfact n)) with ((l + n * l) * mathfact n)
by lia.
iFrame; auto.
Qed.
Lemma fact_acc_fact_refinement :
[] fact_acc log fact : (TArrow TNat TNat).
Proof.
iIntros (? vs ρ _) "[#HE HΔ]".
iDestruct (interp_env_length with "HΔ") as %?; destruct vs; simplify_eq.
rewrite !empty_env_subst.
iClear "HΔ". simpl.
iIntros (j K) "Hj"; simpl.
iApply wp_value; iExists (RecV _); iFrame.
iAlways. iIntros ([? ?] [n [? ?]]); simpl in *; simplify_eq; simpl.
clear j K.
iIntros (j K) "Hj"; simpl.
iApply wp_pure_step_later; auto.
iNext; asimpl.
rewrite -/fact.
iApply (wp_mono _ _ _ (λ v, j fill K (#n (mathfact n)) v = #nv (1 * mathfact n)))%I.
{ replace (1 * mathfact n) with (mathfact n) by lia.
iIntros (?) "[? %]"; iExists (#nv _); iFrame; eauto. }
generalize 1 as l => l.
iInduction n as [|n] "IH" forall (K l).
- rewrite fact_acc_body_unfold.
iApply (wp_bind (fill [AppLCtx _])).
iApply wp_pure_step_later; auto.
rewrite -fact_acc_body_unfold.
iNext; simpl; asimpl.
iApply wp_value; simpl.
iApply wp_pure_step_later; auto.
iNext; simpl; asimpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
simpl; asimpl.
iMod (do_step_pure _ _ _ (IfCtx _ _ :: _) with "[$Hj]") as "Hj"; auto.
iApply (wp_bind (fill [IfCtx _ _])).
iApply wp_pure_step_later; auto.
iNext; simpl.
iApply wp_value. simpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
iApply wp_pure_step_later; auto.
iNext; simpl.
iApply wp_value.
replace (l * 1) with l by lia; auto.
- rewrite {2}fact_acc_body_unfold.
iApply (wp_bind (fill [AppLCtx _])).
iApply wp_pure_step_later; auto.
rewrite -fact_acc_body_unfold.
iNext; simpl; asimpl.
iApply wp_value; simpl.
iApply wp_pure_step_later; auto.
iNext; simpl; asimpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
simpl.
iApply (wp_bind (fill [IfCtx _ _])).
iApply wp_pure_step_later; auto.
iNext; simpl.
iApply wp_value. simpl.
iMod (do_step_pure _ _ _ (IfCtx _ _ :: _) with "[$Hj]") as "Hj"; auto.
simpl.
iApply wp_pure_step_later; auto.
iNext; simpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
iMod (do_step_pure _ _ _ (AppRCtx (RecV _):: BinOpRCtx _ (#nv _) :: _)
with "[$Hj]") as "Hj"; eauto.
simpl.
iApply (wp_bind (fill [LetInCtx _])).
iApply wp_pure_step_later; auto.
iNext; simpl; iApply wp_value; simpl.
iApply wp_pure_step_later; auto.
iNext; simpl. asimpl.
iApply (wp_bind (fill [LetInCtx _])).
iApply wp_pure_step_later; auto.
iNext; simpl; iApply wp_value; simpl.
iApply wp_pure_step_later; auto.
iNext; simpl. asimpl.
replace (n -0) with n by lia.
iApply wp_fupd.
iApply wp_wand_r; iSplitL;
first iApply ("IH" $! (BinOpRCtx _ (#nv _) :: K) with "[$Hj]"); eauto.
iIntros (v) "[Hj %]"; simplify_eq.
simpl.
iMod (do_step_pure with "[$Hj]") as "Hj"; auto.
simpl.
iModIntro. iFrame.
eauto with lia.
Qed.
End fact_equiv.
Theorem fact_ctx_equiv :
[] fact ctx fact_acc : (TArrow TNat TNat)
[] fact_acc ctx fact : (TArrow TNat TNat).
Proof.
set (Σ := #[invΣ ; gen_heapΣ loc val ; GFunctor (auth.authR cfgUR)]).
set (HG := soundness_unary.HeapPreIG Σ _ _).
split.
- eapply (binary_soundness Σ _); auto using fact_acc_typed, fact_typed.
intros; apply fact_fact_acc_refinement.
- eapply (binary_soundness Σ _); auto using fact_acc_typed, fact_typed.
intros; apply fact_acc_fact_refinement.
Qed.
...@@ -220,6 +220,60 @@ Section fundamental. ...@@ -220,6 +220,60 @@ Section fundamental.
rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto. rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto.
Qed. Qed.
Lemma bin_log_related_lam Γ (e e' : expr) τ1 τ2
(Hclosed : f, e.[upn (S (length Γ)) f] = e)
(Hclosed' : f, e'.[upn (S (length Γ)) f] = e')
(IHHtyped : τ1 :: Γ e log e' : τ2) :
Γ Lam e log Lam e' : TArrow τ1 τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
iApply wp_value. iExists (LamV _). iIntros "{$Hj} !#".
iIntros ([v v']) "#Hiv". iIntros (j' K') "Hj".
iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
iApply fupd_wp.
iMod (step_lam _ _ j' K' _ (of_val v') v' with "* [-]") as "Hz"; eauto.
asimpl. iFrame "#". change (Lam ?e) with (of_val (LamV e)).
erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto).
iApply ('`IHHtyped _ ((v,v') :: vvs)); repeat iSplit; eauto.
iModIntro.
rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto.
Qed.
Lemma bin_log_related_letin Γ (e1 e2 e1' e2' : expr) τ1 τ2
(Hclosed2 : f, e2.[upn (S (length Γ)) f] = e2)
(Hclosed2' : f, e2'.[upn (S (length Γ)) f] = e2')
(IHHtyped1 : Γ e1 log e1' : τ1)
(IHHtyped2 : τ1 :: Γ e2 log e2' : τ2) :
Γ LetIn e1 e2 log LetIn e1' e2': τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
iDestruct (interp_env_length with "HΓ") as %?.
smart_wp_bind (LetInCtx _) v v' "[Hv #Hiv]"
('`IHHtyped1 _ _ _ j ((LetInCtx _) :: K)); cbn.
iMod (step_letin _ _ j K with "[-]") as "Hz"; eauto.
iApply wp_pure_step_later; auto. iModIntro.
asimpl.
erewrite !n_closed_subst_head_simpl by (rewrite ?fmap_length; eauto).
iApply ('`IHHtyped2 _ ((v, v') :: vvs)); repeat iSplit; eauto.
rewrite !interp_env_cons; iSplit; try iApply interp_env_cons; auto.
Qed.
Lemma bin_log_related_seq Γ (e1 e2 e1' e2' : expr) τ1 τ2
(IHHtyped1 : Γ e1 log e1' : τ1)
(IHHtyped2 : Γ e2 log e2' : τ2) :
Γ Seq e1 e2 log Seq e1' e2': τ2.
Proof.
iIntros (Δ vvs ρ ?) "#(Hs & HΓ)"; iIntros (j K) "Hj /=".
iDestruct (interp_env_length with "HΓ") as %?.
smart_wp_bind (SeqCtx _) v v' "[Hv #Hiv]"
('`IHHtyped1 _ _ _ j ((SeqCtx _) :: K)); cbn.
iMod (step_seq _ _ j K with "[-]") as "Hz"; eauto.
iApply wp_pure_step_later; auto. iModIntro.
asimpl.
iApply '`IHHtyped2; repeat iSplit; eauto.
Qed.
Lemma bin_log_related_app Γ e1 e2 e1' e2' τ1 τ2 Lemma bin_log_related_app Γ e1 e2 e1' e2' τ1 τ2
(IHHtyped1 : Γ e1 log e1' : TArrow τ1 τ2) (IHHtyped1 : Γ e1 log e1' : TArrow τ1 τ2)
(IHHtyped2 : Γ e2 log e2' : τ1) : (IHHtyped2 : Γ e2 log e2' : τ1) :
...@@ -429,6 +483,11 @@ Section fundamental. ...@@ -429,6 +483,11 @@ Section fundamental.
- eapply bin_log_related_if; eauto. - eapply bin_log_related_if; eauto.
- eapply bin_log_related_rec; eauto; - eapply bin_log_related_rec; eauto;
match goal with H : _ |- _ => eapply (typed_n_closed _ _ _ H) end. match goal with H : _ |- _ => eapply (typed_n_closed _ _ _ H) end.
- eapply bin_log_related_lam; eauto;
match goal with H : _ |- _ => eapply (typed_n_closed _ _ _ H) end.
- eapply bin_log_related_letin; eauto;
match goal with H : _ |- _ => eapply (typed_n_closed _ _ _ H) end.
- eapply bin_log_related_seq; eauto.
- eapply bin_log_related_app; eauto. - eapply bin_log_related_app; eauto.
- eapply bin_log_related_tlam; eauto with typeclass_instances. - eapply bin_log_related_tlam; eauto with typeclass_instances.
- eapply bin_log_related_tapp; eauto. - eapply bin_log_related_tapp; eauto.
......
...@@ -75,6 +75,25 @@ Section typed_interp. ...@@ -75,6 +75,25 @@ Section typed_interp.
erewrite typed_subst_head_simpl_2 by naive_solver. erewrite typed_subst_head_simpl_2 by naive_solver.
iApply (IHtyped Δ (_ :: w :: vs)). iApply (IHtyped Δ (_ :: w :: vs)).
iApply interp_env_cons; iSplit; [|iApply interp_env_cons]; auto. iApply interp_env_cons; iSplit; [|iApply interp_env_cons]; auto.
- (* Lam *)
iApply wp_value. simpl. iAlways. iIntros (w) "#Hw".
iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
asimpl.
erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped Δ (w :: vs)); auto.
iApply interp_env_cons; iSplit; auto.
- (* LetIn *)
smart_wp_bind (LetInCtx _) v "#Hv" IHtyped1; cbn.
iDestruct (interp_env_length with "HΓ") as %?.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
asimpl. erewrite typed_subst_head_simpl by naive_solver.
iApply (IHtyped2 Δ (v :: vs)).
iApply interp_env_cons; iSplit; eauto.
- (* Seq *)
smart_wp_bind (SeqCtx _) v "#Hv" IHtyped1; cbn.
iApply wp_pure_step_later; auto 1 using to_of_val. iNext.
by iApply IHtyped2.
- (* app *) - (* app *)
smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHtyped1. smart_wp_bind (AppLCtx (e2.[env_subst vs])) v "#Hv" IHtyped1.
smart_wp_bind (AppRCtx v) w "#Hw" IHtyped2. smart_wp_bind (AppRCtx v) w "#Hw" IHtyped2.
...@@ -124,7 +143,7 @@ Section typed_interp. ...@@ -124,7 +143,7 @@ Section typed_interp.
iDestruct "Hv" as (l) "[% #Hv]"; subst. iDestruct "Hv" as (l) "[% #Hv]"; subst.
iApply wp_atomic. iApply wp_atomic.
iInv (logN .@ l) as (z) "[Hz1 #Hz2]" "Hclose". iInv (logN .@ l) as (z) "[Hz1 #Hz2]" "Hclose".
iApply (wp_store with "Hz1"); auto using to_of_val. iApply (wp_store with "Hz1"); auto using to_of_val.
iModIntro. iNext. iModIntro. iNext.
iIntros "Hz1". iMod ("Hclose" with "[Hz1 Hz2]"); eauto. iIntros "Hz1". iMod ("Hclose" with "[Hz1 Hz2]"); eauto.
- (* CAS *) - (* CAS *)
......
...@@ -8,7 +8,7 @@ Module F_mu_ref_conc. ...@@ -8,7 +8,7 @@ Module F_mu_ref_conc.
Instance loc_dec_eq (l l' : loc) : Decision (l = l') := _. Instance loc_dec_eq (l l' : loc) : Decision (l = l') := _.
Inductive binop := Add | Sub | Eq | Le | Lt. Inductive binop := Add | Sub | Mult | Eq | Le | Lt.
Instance binop_dec_eq (op op' : binop) : Decision (op = op'). Instance binop_dec_eq (op op' : binop) : Decision (op = op').
Proof. solve_decision. Defined. Proof. solve_decision. Defined.
...@@ -17,6 +17,9 @@ Module F_mu_ref_conc. ...@@ -17,6 +17,9 @@ Module F_mu_ref_conc.
| Var (x : var) | Var (x : var)
| Rec (e : {bind 2 of expr}) | Rec (e : {bind 2 of expr})
| App (e1 e2 : expr) | App (e1 e2 : expr)
| Lam (e : {bind expr})
| LetIn (e1 : expr) (e2 : {bind expr})
| Seq (e1 e2 : expr)
(* Base Types *) (* Base Types *)
| Unit | Unit
| Nat (n : nat) | Nat (n : nat)
...@@ -62,6 +65,7 @@ Module F_mu_ref_conc. ...@@ -62,6 +65,7 @@ Module F_mu_ref_conc.
Inductive val := Inductive val :=
| RecV (e : {bind 1 of expr}) | RecV (e : {bind 1 of expr})
| LamV (e : {bind expr})
| TLamV (e : {bind 1 of expr}) | TLamV (e : {bind 1 of expr})
| UnitV | UnitV
| NatV (n : nat) | NatV (n : nat)
...@@ -80,6 +84,7 @@ Module F_mu_ref_conc. ...@@ -80,6 +84,7 @@ Module F_mu_ref_conc.
match op with match op with
| Add => λ a b, #nv(a + b) | Add => λ a b, #nv(a + b)
| Sub => λ a b, #nv(a - b) | Sub => λ a b, #nv(a - b)
| Mult => λ a b, #nv(a * b)
| Eq => λ a b, if (eq_nat_dec a b) then #v true else #v false | Eq => λ a b, if (eq_nat_dec a b) then #v true else #v false
| Le => λ a b, if (le_dec a b) then #v true else #v false | Le => λ a b, if (le_dec a b) then #v true else #v false
| Lt => λ a b, if (lt_dec a b) then #v true else #v false | Lt => λ a b, if (lt_dec a b) then #v true else #v false
...@@ -93,6 +98,7 @@ Module F_mu_ref_conc. ...@@ -93,6 +98,7 @@ Module F_mu_ref_conc.
Fixpoint of_val (v : val) : expr := Fixpoint of_val (v : val) : expr :=
match v with match v with
| RecV e => Rec e | RecV e => Rec e
| LamV e => Lam e
| TLamV e => TLam e | TLamV e => TLam e
| UnitV => Unit | UnitV => Unit
| NatV v => Nat v | NatV v => Nat v
...@@ -107,6 +113,7 @@ Module F_mu_ref_conc. ...@@ -107,6 +113,7 @@ Module F_mu_ref_conc.
Fixpoint to_val (e : expr) : option val := Fixpoint to_val (e : expr) : option val :=
match e with match e with
| Rec e => Some (RecV e) | Rec e => Some (RecV e)
| Lam e => Some (LamV e)
| TLam e => Some (TLamV e) | TLam e => Some (TLamV e)
| Unit => Some UnitV | Unit => Some UnitV
| Nat n => Some (NatV n) | Nat n => Some (NatV n)
...@@ -123,6 +130,8 @@ Module F_mu_ref_conc. ...@@ -123,6 +130,8 @@ Module F_mu_ref_conc.
Inductive ectx_item := Inductive ectx_item :=
| AppLCtx (e2 : expr) | AppLCtx (e2 : expr)
| AppRCtx (v1 : val) | AppRCtx (v1 : val)
| LetInCtx (e2 : expr)
| SeqCtx (e2 : expr)
| TAppCtx | TAppCtx
| PairLCtx (e2 : expr) | PairLCtx (e2 : expr)
| PairRCtx (v1 : val) | PairRCtx (v1 : val)
...@@ -148,6 +157,8 @@ Module F_mu_ref_conc. ...@@ -148,6 +157,8 @@ Module F_mu_ref_conc.
match Ki with match Ki with
| AppLCtx e2 => App e e2 | AppLCtx e2 => App e e2
| AppRCtx v1 => App (of_val v1) e | AppRCtx v1 => App (of_val v1) e
| LetInCtx e2 => LetIn e e2
| SeqCtx e2 => Seq e e2
| TAppCtx => TApp e | TAppCtx => TApp e
| PairLCtx e2 => Pair e e2 | PairLCtx e2 => Pair e e2
| PairRCtx v1 => Pair (of_val v1) e | PairRCtx v1 => Pair (of_val v1) e
...@@ -177,6 +188,18 @@ Module F_mu_ref_conc. ...@@ -177,6 +188,18 @@ Module F_mu_ref_conc.
| BetaS e1 e2 v2 σ : | BetaS e1 e2 v2 σ :
to_val e2 = Some v2 to_val e2 = Some v2
head_step (App (Rec e1) e2) σ [] e1.[(Rec e1), e2/] σ [] head_step (App (Rec e1) e2) σ [] e1.[(Rec e1), e2/] σ []
(* Lam-β *)
| LamBetaS e1 e2 v2 σ :
to_val e2 = Some v2
head_step (App (Lam e1) e2) σ [] e1.[e2/] σ []
(* LetIn-β *)
| LetInBetaS e1 e2 v2 σ :
to_val e1 = Some v2
head_step (LetIn e1 e2) σ [] e2.[e1/] σ []
(* Seq-β *)
| SeqBetaS e1 e2 v2 σ :
to_val e1 = Some v2
head_step (Seq e1 e2) σ [] e2 σ []
(* Products *) (* Products *)
| FstS e1 v1 e2 v2 σ : | FstS e1 v1 e2 v2 σ :
to_val e1 = Some v1 to_val e2 = Some v2 to_val e1 = Some v1 to_val e2 = Some v2
......
...@@ -133,6 +133,18 @@ Section lang_rules. ...@@ -133,6 +133,18 @@ Section lang_rules.
PureExec True 1 (App (Rec e1) e2) e1.[(Rec e1), e2 /]. PureExec True 1 (App (Rec e1) e2) e1.[(Rec e1), e2 /].
Proof. solve_pure_exec. Qed. Proof. solve_pure_exec. Qed.
Global Instance pure_lam e1 e2 `{!AsVal e2} :
PureExec True 1 (App (Lam e1) e2) e1.[e2 /].
Proof. solve_pure_exec. Qed.
Global Instance pure_LetIn e1 e2 `{!AsVal e1} :
PureExec True 1 (LetIn e1 e2) e2.[e1 /].
Proof. solve_pure_exec. Qed.
Global Instance pure_seq e1 e2 `{!AsVal e1} :
PureExec True 1 (Seq e1 e2) e2.
Proof. solve_pure_exec. Qed.
Global Instance pure_tlam e : PureExec True 1 (TApp (TLam e)) e. Global Instance pure_tlam e : PureExec True 1 (TApp (TLam e)) e.
Proof. solve_pure_exec. Qed. Proof. solve_pure_exec. Qed.
......
From iris.program_logic Require Export language ectx_language ectxi_language.
From iris.program_logic Require Import lifting. From iris.program_logic Require Import lifting.
From iris.algebra Require Import auth frac agree gmap list. From iris.algebra Require Import auth frac agree gmap list.
From iris_examples.logrel.F_mu_ref_conc Require Export rules. From iris_examples.logrel.F_mu_ref_conc Require Export rules.
...@@ -151,23 +152,67 @@ Section cfg. ...@@ -151,23 +152,67 @@ Section cfg.
erased_step (tp, σ) (<[j:=fill K e']> tp, σ'). erased_step (tp, σ) (<[j:=fill K e']> tp, σ').
Proof. rewrite -(right_id_L [] (++) (<[_:=_]>_)). by apply step_insert. Qed. Proof. rewrite -(right_id_L [] (++) (<[_:=_]>_)). by apply step_insert. Qed.