Commit 088704eb authored by Dan Frumin's avatar Dan Frumin

Prove more compatibility lemmas without unfolding the definition

parent df22adc1
From iris_logrel.F_mu_ref_conc Require Export fundamental_binary.
From iris.proofmode Require Import tactics classes.
From Autosubst Require Import Autosubst_Classes. (* for [subst] *)
Inductive ctx_item :=
(* λ-rec *)
......
This diff is collapsed.
......@@ -155,6 +155,7 @@ Section logrel.
| Tref τ' => interp_ref (interp E1 E2 τ')
end.
Notation "⟦ τ ⟧" := (interp τ).
Notation "⟦ τ ⟧ₑ" := (interp_expr τ ).
Definition interp_env (Γ : stringmap type) (E1 E2 : coPset)
(Δ : listC D) (vvs : stringmap (val * val)) : iProp Σ :=
......@@ -218,9 +219,17 @@ Section logrel.
Qed.
Lemma interp_subst Δ2 τ τ' :
interp τ ((interp τ' Δ2) :: Δ2) interp (τ.[τ'/]) Δ2.
τ (( τ' Δ2) :: Δ2) τ.[τ'/] Δ2.
Proof. apply (interp_subst_up []). Qed.
Lemma interp_expr_subst Δ2 τ τ' ww :
τ ⟧ₑ (( τ' Δ2) :: Δ2) ww τ.[τ'/] ⟧ₑ Δ2 ww.
Proof.
unfold interp_expr.
properness; auto.
apply interp_subst.
Qed.
Lemma interp_env_dom Δ Γ E1 E2 vvs : interp_env Γ E1 E2 Δ vvs dom _ Γ = dom _ vvs.
Proof. by iIntros "[% ?]". Qed.
......@@ -398,16 +407,19 @@ Notation "Γ ⊨ e '≤log≤' e' : τ" :=
Section monadic.
Context `{logrelG Σ}.
Lemma related_ret τ Δ e1 e2 Γ `{Closed e1} `{Closed e2} E :
interp_expr E E τ Δ (e1,e2) - {E,E;Δ;Γ} e1 log e2 : τ%I.
Lemma related_ret E1 E2 Δ Γ e1 e2 τ `{Closed e1} `{Closed e2} :
interp_expr E1 E1 τ Δ (e1,e2) - {E2,E2;Δ;Γ} e1 log e2 : τ%I.
Proof.
iIntros "Hτ".
rewrite bin_log_related_eq /bin_log_related_def.
iIntros (vvs ρ) "#Hs #HΓ".
by rewrite /env_subst !Closed_subst_p_id.
rewrite /env_subst !Closed_subst_p_id.
iIntros (j K) "Hj /=". iModIntro.
iApply fupd_wp. iApply (fupd_mask_mono E1); auto.
by iMod ("Hτ" with "Hj") as "Hτ".
Qed.
Lemma interp_ret τ Δ e1 e2 v1 v2 E :
Lemma interp_ret E τ Δ e1 e2 v1 v2 :
to_val e1 = Some v1
to_val e2 = Some v2
τ Δ (v1,v2) - interp_expr E E τ Δ (e1,e2).
......@@ -419,7 +431,7 @@ Section monadic.
iApply wp_value; eauto.
Qed.
Lemma related_bind Δ Γ (e1 e2 : expr) (τ τ' : type) (K K' : list ectx_item) E :
Lemma related_bind E Δ Γ (e1 e2 : expr) (τ τ' : type) (K K' : list ectx_item) :
({E,E;Δ;Γ} e1 log e2 : τ) -
( vv, τ Δ vv - {E,E;Δ;Γ} fill K (of_val (vv.1)) log fill K' (of_val (vv.2)) : τ') -
({E,E;Δ;Γ} fill K e1 log fill K' e2 : τ').
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment