Commit 08817aea authored by Dan Frumin's avatar Dan Frumin

Use `bin_log_FG_increment_logatomic` in the refinement proof

Using the lambdasubst hack-- instead of formulating
lemmas for (App e1 v), formulate them for (e1[x:=v]).
parent b18b2448
This diff is collapsed.
(* the contents of this file sould belong elsewhere *)
From iris.proofmode Require Import tactics.
From iris_logrel.F_mu_ref_conc Require Import lang subst tactics rules rules_binary logrel_binary.
Definition lamsubst (e : expr) (v : val) : expr :=
match e with
| Rec (BNamed f) x e' => lang.subst f e (subst' x (of_val v) e')
| Rec BAnon x e' => subst' x (of_val v) e'
| _ => e
end.
Ltac inv_head_step :=
repeat match goal with
| _ => progress simplify_map_eq/= (* simplify memory stuff *)
| H : to_val _ = Some _ |- _ => apply of_to_val in H
| H : _ = of_val ?v |- _ =>
is_var v; destruct v; first[discriminate H|injection H as H]
| H : head_step ?e _ _ _ _ |- _ =>
try (is_var e; fail 1); (* inversion yields many goals if [e] is a variable
and can thus better be avoided. *)
inversion H; subst; clear H
end.
Section hax.
Context `{heapIG Σ, cfgSG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Implicit Types Δ : listC D.
Lemma bin_log_related_arrow Γ (f x f' x' : binder) (e e' : expr) (τ τ' : type)
(Hclosed : Closed (rec: f x := e)%E )
(Hclosed' : Closed (rec: f' x' := e')%E) :
( Δ vv, τ Δ vv -
App (Rec f x e) (of_val (vv.1)) log App (Rec f' x' e') (of_val (vv.2)) : τ') -
Γ (Rec f x e) log (Rec f' x' e') : TArrow τ τ'.
Proof.
iIntros "#H".
iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj".
cbn-[subst_p]. rewrite /env_subst !Closed_subst_p_id.
iModIntro. iApply wp_value; auto.
{ simpl. erewrite decide_left. done. }
iExists (RecV f' x' e'). simpl.
iFrame "Hj". iAlways. iIntros (vv) "Hvv".
iSpecialize ("H" $! Δ vv with "Hvv").
iSpecialize ("H" $! Δ with "Hs []").
{ iAlways. iApply interp_env_nil. }
rewrite !fmap_empty /env_subst !subst_p_empty. done.
Unshelve. all: rewrite /Closed /= in Hclosed Hclosed'; eauto.
Qed.
Lemma weird_bind e Q :
WP App e #() {{ Q }} WP e {{ v, WP (App v #()) {{ Q }} }}.
Proof.
(* ugh, turns out this is just the inverse bind:
Check (wp_bind_inv (fun v => App v #())). *)
iLöb as "IH" forall (e).
iIntros "wp".
rewrite (wp_unfold _ e) /wp_pre /=.
remember (to_val e) as eval. destruct eval.
- symmetry in Heqeval. rewrite -(of_to_val _ _ Heqeval). eauto.
- iIntros (σ1) "Hσ1".
rewrite wp_unfold /wp_pre /=.
iMod ("wp" $! σ1 with "Hσ1") as "[r wp]". iModIntro.
iDestruct "r" as %er.
assert (reducible e σ1).
{ symmetry in Heqeval.
unfold reducible in er.
destruct er as (e2 & σ2 & efs & Hpst).
inversion Hpst; simpl in *; subst; clear Hpst.
admit. }
iSplitR; eauto.
iNext.
iIntros (e2 σ2 efs) "Hpst". iDestruct "Hpst" as %Hpst.
iSpecialize ("wp" $! (App e2 #()) σ2 efs).
iAssert (prim_step (e #()%E) σ1 (e2 #()%E) σ2 efs)%I as "Hprim'".
{ iPureIntro.
inversion Hpst; simpl in *; subst; clear Hpst.
eapply (Ectx_step _ σ1 _ σ2 efs (K++[AppLCtx (#())%E])); simpl; eauto.
by rewrite fill_app.
by rewrite fill_app. }
iMod ("wp" with "Hprim'") as "[$ [wp $]]". iModIntro.
by iApply "IH".
Admitted.
(* Lemma wp_step_back Γ (e t : expr) (x : string) (v ev : val) τ : *)
(* Closed (Lam x e) *)
(* to_val (lang.subst x (of_val v) e) = Some ev *)
(* Γ (App (Lam x e) v) log t : τ *)
(* Γ (lang.subst x (of_val v) e) log t : τ. *)
(* Proof. *)
(* iIntros (??) "Hr". *)
(* Transparent bin_log_related. *)
(* iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj". *)
(* cbn-[subst_p]. *)
(* (* assert (Closed (lang.subst x v e)). *) *)
(* (* { eapply is_closed_subst_preserve; eauto. solve_closed. } *) *)
(* rewrite /env_subst !Closed_subst_p_id. *)
(* iSpecialize ("Hr" with "Hs []"). *)
(* { iAlways. by iFrame. } *)
(* rewrite /env_subst. erewrite (Closed_subst_p_id (fst <$> vvs)); last first. *)
(* { rewrite /Closed. simpl. *)
(* rewrite /Closed /= in H1. split_and; eauto; try solve_closed. } *)
(* iMod ("Hr" with "Hj") as "Hr". *)
(* iModIntro. simpl. *)
(* rewrite {1}wp_unfold /wp_pre /=. *)
(* iApply wp_value; eauto. *)
(* iApply (wp_bind_inv in "Hr". *)
End hax.
......@@ -5,6 +5,7 @@ prelude/base.v
F_mu_ref_conc/binder.v
F_mu_ref_conc/lang.v
F_mu_ref_conc/subst.v
F_mu_ref_conc/hax.v
F_mu_ref_conc/reflection.v
F_mu_ref_conc/rules.v
F_mu_ref_conc/typing.v
......
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