Modify the relational interpretation to account for masks/invariants

F_mu_ref_conc/examples/counter.v

 From iris.proofmode Require Import tactics.
 From iris.algebra Require Import auth.
 From iris_logrel.F_mu_ref_conc Require Export examples.lock.
-From iris_logrel.F_mu_ref_conc Require Import tactics soundness_binary.
+From iris_logrel.F_mu_ref_conc Require Import tactics soundness_binary relational_properties.
 From iris.program_logic Require Import adequacy.
 
 Definition CG_increment (x : expr) : expr :=
@@ -123,6 +123,24 @@ Section CG_Counter.
     Unshelve. all: trivial.
   Qed.
 
+  
+  Lemma bin_log_related_CG_locked_increment Γ K E1 E2 t τ x n l :
+    nclose specN ⊆ E1 →
+    (x ↦ₛ (#nv n) -∗ l ↦ₛ (#♭v false) -∗
+    (x ↦ₛ (#nv S n) -∗ l ↦ₛ (#♭v false) -∗
+      ({E1,E2;Γ} ⊨ t ≤log≤ fill K Unit : τ)) -∗
+    {E1,E2;Γ} ⊨ t ≤log≤ fill K (App (CG_locked_increment (Loc x) (Loc l)) Unit) : τ)%I.
+  Proof. 
+    iIntros (?) "Hx Hl Hlog".
+    unfold CG_locked_increment.
+    change Unit with (of_val UnitV).
+    iApply (bin_log_related_with_lock_r Γ K E1 E2 (x ↦ₛ (#nv n))%I (x ↦ₛ (#nv S n)) (CG_increment (Loc x)) UnitV UnitV l t τ with "[Hx] [Hl] [Hlog]"); auto.
+    - iIntros (ρ j K') "#Hspec Hx Hj /=".
+      tp_apply j steps_CG_increment with "Hx" as "Hx". iModIntro.
+      iFrame.
+    - iIntros "Hl Hx". iApply ("Hlog" with "Hx Hl").
+  Qed.
+ 
   Global Opaque CG_locked_increment.
 
   Lemma counter_read_to_val x : to_val (counter_read x) = Some (counter_readV x).
@@ -242,103 +260,236 @@ Section CG_Counter.
 
   Definition counterN : namespace := nroot .@ "counter".
 
+  (* TODO: those should be accompaied by lemmas; preferably so that 
+     [change] does not change too much *)
+  Ltac rel_bind_l efoc :=
+    lazymatch goal with
+    | [ |- (_ ⊢ bin_log_related _ _ _ ?e _ _ ) ] =>
+      reshape_expr e ltac:(fun K e' =>
+       unify e' efoc; change e with (fill K e'))
+    end.
+  Ltac rel_bind_r efoc :=
+    lazymatch goal with
+    | [ |- (_ ⊢ bin_log_related _ _ _ _ ?e _ ) ] =>
+      reshape_expr e ltac:(fun K e' =>
+       unify e' efoc; change e with (fill K e'))
+    end.
+
+  Lemma bin_log_related_arrow Γ (e e' : expr) τ τ'
+   (Hclosed : ∀ f, e.[upn 2 f] = e)
+   (Hclosed' : ∀ f, e'.[upn 2 f] = e') :
+    □(∀ Δ vv, ⟦ τ ⟧ Δ vv -∗
+      [] ⊨ App (Rec e) (of_val (vv.1)) ≤log≤ App (Rec e') (of_val (vv.2)) : τ') -∗
+    Γ ⊨ (Rec e) ≤log≤ (Rec e') : TArrow τ τ'.
+  Proof.
+    iIntros "#H".
+    iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj /=".
+    iModIntro. iApply wp_value; auto.
+    iModIntro. iExists (RecV e'). 
+    rewrite Hclosed Hclosed'. simpl.
+    iFrame "Hj". iAlways. iIntros (vv) "Hvv".
+    iSpecialize ("H" $! Δ vv with "Hvv").
+    iSpecialize ("H" $! Δ with "* Hs []").
+    { iAlways. iApply interp_env_nil. }
+    rewrite ?fmap_nil. rewrite ?empty_env_subst.
+    done.
+  Qed.
+
   Lemma FG_CG_counter_refinement :
     [] ⊨ FG_counter ≤log≤ CG_counter : TProd (TArrow TUnit TUnit) (TArrow TUnit TNat).
   Proof.
-    iIntros (Δ [|??] ρ) "#Hspec #HΓ"; iIntros (j K) "Hj"; last first.
-    { iDestruct (interp_env_length with "HΓ") as %[=]. }
-    iClear "HΓ". cbn -[FG_counter CG_counter].
-    rewrite ?empty_env_subst /CG_counter /FG_counter.
-    iApply fupd_wp.
-    tp_bind j newlock.
-    tp_apply j steps_newlock.
-    iDestruct "Hj" as (l) "[Hj Hl]".
-    tp_rec j.
-    asimpl. rewrite CG_locked_increment_subst /=.
+    unfold FG_counter, CG_counter.
+    iApply (bin_log_related_alloc_l [] _ _ [AppRCtx (RecV (FG_counter_body (Var 1)))]); auto; simpl. iModIntro.
+    iIntros (cnt) "Hcnt".    
+    rel_bind_r newlock.
+    iApply (bin_log_related_newlock_r); auto; simpl.
+    iIntros (l) "Hl".
+    iApply (bin_log_related_rec_r [] []); auto. asimpl.
+    rewrite CG_locked_increment_subst /=.
     rewrite counter_read_subst /=.
-    tp_alloc j as cnt' "Hcnt'". tp_normalise j.
-    tp_rec j. tp_normalise j.
-    asimpl. rewrite CG_locked_increment_subst /=.
-    rewrite counter_read_subst /=.
-    iModIntro. wp_bind (Alloc _).
-    iApply wp_alloc; eauto. iNext.
-    iIntros (cnt) "Hcnt /=".
+    rel_bind_r (Alloc (#n 0)).
+    iApply (bin_log_related_alloc_r); auto.
+    iIntros (cnt') "Hcnt' /=".
     (* establishing the invariant *)
     iAssert ((∃ n, l ↦ₛ (#♭v false) ∗ cnt ↦ᵢ (#nv n) ∗ cnt' ↦ₛ (#nv n) )%I)
       with "[Hl Hcnt Hcnt']" as "Hinv".
     { iExists _. by iFrame. }
-    iApply fupd_wp.
     iMod (inv_alloc counterN with "[Hinv]") as "#Hinv"; trivial.
     { iNext; iExact "Hinv". }
-    (* splitting increment and read *)
-    iApply wp_rec; trivial. iNext. asimpl.
+    iApply (bin_log_related_rec_l [] []); auto.
+    iNext. asimpl.
     rewrite counter_read_subst /=.
-    iApply wp_value; simpl.
-    { by rewrite counter_read_to_val. }
-    iExists (PairV (CG_locked_incrementV _ _) (counter_readV _)); simpl.
-    rewrite CG_locked_increment_of_val counter_read_of_val.
-    iFrame "Hj".
-    iExists (_, _), (_, _); simpl; repeat iSplit; trivial.
-    - (* refinement of increment *)
-      iAlways. clear j K. iIntros (v) "#Heq". iIntros (j K) "Hj".
-      rewrite CG_locked_increment_of_val /=.
-      destruct v; iDestruct "Heq" as "[% %]"; simplify_eq/=.
-      iLöb as "Hlat".
-      iApply wp_rec; trivial. asimpl. iNext.
-      (* fine-grained reads the counter *)
-      wp_bind (Load _).
-      iApply wp_atomic; eauto.
-      iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose".
-      iApply (wp_load with "[Hcnt]"); [iNext; by iFrame|]. 
-      iNext. iIntros "Hcnt".
-      iMod ("Hclose" with "[Hl Hcnt Hcnt']").
-      { iNext. iExists _. iFrame "Hl Hcnt Hcnt'". }
-      iApply wp_rec; trivial. asimpl. iNext.
-      (* fine-grained performs increment *)
-      wp_bind (BinOp Add _ _).
-      iApply wp_nat_binop; simpl.
-      iNext. iModIntro.
-      wp_bind (CAS _ _ _).
-      iApply wp_atomic; eauto.
-      iInv counterN as (n') ">[Hl [Hcnt Hcnt']]" "Hclose".
-      (* performing CAS *)
-      destruct (decide (n = n')) as [|Hneq]; subst.
-      + (* CAS succeeds *)
-        (* In this case, we perform increment in the coarse-grained one *)
-        tp_apply j steps_CG_locked_increment with "Hcnt' Hl"
-            as "[Hcnt' Hl]".             
-        iApply (wp_cas_suc with "[Hcnt]"); auto.
-        iNext. iIntros "Hcnt".
-        iMod ("Hclose" with "[Hl Hcnt Hcnt']").
-        { iNext. iExists _. iFrame "Hl Hcnt Hcnt'"; trivial. }
-        simpl. 
-        iApply wp_if_true. iNext. iApply wp_value; trivial.
-        iExists UnitV; iFrame; auto.
-      + (* CAS fails *)
-        (* In this case, we perform a recursive call *)
-        iApply (wp_cas_fail _ _ _ (#nv n') with "[Hcnt]"); auto;
-        [inversion 1; subst; auto | ]. 
-        iNext. iIntros "Hcnt".
-        iMod ("Hclose" with "[Hl Hcnt Hcnt']").
-        { iNext. iExists _; iFrame "Hl Hcnt Hcnt'". }
-        iApply wp_if_false. iNext. by iApply "Hlat".
-    - (* refinement of read *)
-      iAlways. clear j K. iIntros (v) "#Heq". iIntros (j K) "Hj".
-      rewrite ?counter_read_of_val.
-      iDestruct "Heq" as "[% %]"; destruct v; simplify_eq/=.
-      Transparent counter_read.
-      unfold counter_read at 2.
-      iApply wp_rec; trivial. simpl.
-      iNext. 
-      iApply wp_atomic; eauto.
-      iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose".
-      tp_apply j steps_counter_read with "Hcnt'" as "Hcnt'".
-      iApply (wp_load with "[Hcnt]"); eauto. 
-      iNext. iIntros "Hcnt".
+    
+    iApply (bin_log_related_rec_r [] []); auto. simpl.
+    rewrite CG_locked_increment_subst /=.
+    rewrite counter_read_subst /=.
+    
+    iApply (bin_log_related_pair [] with "[]"); last first.
+    - Transparent counter_read.
+      unfold counter_read.
+      iApply (bin_log_related_rec); auto. iAlways. asimpl.
+      rel_bind_l (Load (Loc cnt)).
+      iApply (bin_log_related_load_l).
+        iInv counterN as (n) "[>Hl [Hcnt >Hcnt']]" "Hclose". 
+        iModIntro. 
+        iExists (#nv n). iFrame "Hcnt". iSplit; eauto.
+        iIntros "Hcnt". simpl.
+      iApply (bin_log_related_load_r _ [] with "[Hcnt']"); auto.
+        { solve_ndisj. } { by compute. }
+      iIntros "Hcnt'".
+      iApply fupd_logrel.
       iMod ("Hclose" with "[Hl Hcnt Hcnt']").
-      { iNext. iExists _; iFrame "Hl Hcnt Hcnt'". }
-      iExists (#nv _); eauto.
+      { iNext. iExists _. by iFrame. }
+      simpl. iModIntro.
+      iPoseProof (bin_log_related_nat [TArrow TUnit TNat; TUnit] ⊤ n) as "H". iFrame "H". (* TODO: iApply does not work in this case *)
+   - Transparent CG_locked_increment.
+     unfold CG_locked_increment.
+     Transparent with_lock.
+     unfold with_lock.
+     iApply (bin_log_related_arrow); auto.
+     iAlways. iIntros (Δ [v v']) "[% %]"; simpl in *; subst. clear Δ.
+     (* fold this stuff back *)
+     change (Rec
+             (App
+                (Rec
+                   (App (Rec (App (Rec (Var 3)) (App release (Loc l))))
+                      (App (CG_increment (Loc cnt')).[ren (+4)] (Var 3))))
+                (App acquire (Loc l))))
+     with (CG_locked_increment (Loc cnt') (Loc l)).
+     iLöb as "Hlat".
+     iApply (bin_log_related_rec_l _ []); auto. iNext. asimpl.
+     rel_bind_l (Load (Loc cnt)).
+     iApply (bin_log_related_load_l).
+     iInv counterN as (n) "[>Hl [Hcnt >Hcnt']]" "Hclose". iModIntro.
+     iExists (#nv n). iSplit; eauto. iFrame "Hcnt".
+     iIntros "Hcnt". simpl.
+     iApply fupd_logrel.
+     iMod ("Hclose" with "[Hl Hcnt Hcnt']").
+     { iNext. iExists _. iFrame "Hl Hcnt Hcnt'". }
+     iApply (bin_log_related_rec_l _ []); auto. iNext. asimpl.
+     rel_bind_l (BinOp Add (#n 1) (#n n)).
+     iApply (bin_log_related_binop_l). iNext. simpl.
+     rel_bind_l (CAS (Loc cnt) (#n n) (#n (S n))).
+     iApply (bin_log_related_cas_l); auto. 
+     iInv counterN as (m) "[>Hl [Hcnt >Hcnt']]" "Hclose". 
+     iModIntro. 
+     iExists (#nv m). iFrame "Hcnt".
+     destruct (decide (n = m)).
+     + (* CAS succeeds *) subst. iSplitR; eauto.
+       { iDestruct 1 as %Hfoo. by exfalso. }
+       iIntros "_ Hcnt". simpl.
+       iApply (bin_log_related_CG_locked_increment _ [] with "Hcnt' Hl");
+         auto. solve_ndisj.
+       iIntros "Hcnt' Hl". 
+       iApply fupd_logrel.
+       iMod ("Hclose" with "[Hl Hcnt Hcnt']").
+       { iNext. iExists (S m). iFrame. }
+       iApply (bin_log_related_if_true_l _ []); auto.
+       iNext. simpl. iPoseProof (bin_log_related_unit [] ⊤) as "H".
+       iExact "H". (* TODO iApply does not work *)
+     + (* CAS fails *)
+       iSplitL; eauto; last first.
+       { iDestruct 1 as %Hfoo. injection Hfoo. intro. by exfalso. }
+       iIntros "_ Hcnt". simpl.
+       iApply fupd_logrel.
+       iMod ("Hclose" with "[Hl Hcnt Hcnt']").
+       { iNext. iExists m. iFrame. }
+       iApply (bin_log_related_if_false_l [] []); auto.
   Qed.
+
+    (* iIntros (Δ [|??] ρ) "#Hspec #HΓ"; iIntros (j K) "Hj"; last first. *)
+    (* { iDestruct (interp_env_length with "HΓ") as %[=]. } *)
+    (* iClear "HΓ". cbn -[FG_counter CG_counter]. *)
+    (* rewrite ?empty_env_subst /CG_counter /FG_counter. *)
+    (* iApply fupd_wp. *)
+    (* tp_bind j newlock. *)
+    (* tp_apply j steps_newlock. *)
+    (* iDestruct "Hj" as (l) "[Hj Hl]". *)
+    (* tp_rec j. *)
+    (* asimpl. rewrite CG_locked_increment_subst /=. *)
+    (* rewrite counter_read_subst /=. *)
+    (* tp_alloc j as cnt' "Hcnt'". tp_normalise j. *)
+    (* tp_rec j. tp_normalise j. *)
+    (* asimpl. rewrite CG_locked_increment_subst /=. *)
+    (* rewrite counter_read_subst /=. *)
+    (* iModIntro. wp_bind (Alloc _). *)
+    (* iApply wp_alloc; eauto. iNext. *)
+    (* iIntros (cnt) "Hcnt /=". *)
+    (* (* establishing the invariant *) *)
+    (* iAssert ((∃ n, l ↦ₛ (#♭v false) ∗ cnt ↦ᵢ (#nv n) ∗ cnt' ↦ₛ (#nv n) )%I) *)
+    (*   with "[Hl Hcnt Hcnt']" as "Hinv". *)
+    (* { iExists _. by iFrame. } *)
+    (* iApply fupd_wp. *)
+    (* iMod (inv_alloc counterN with "[Hinv]") as "#Hinv"; trivial. *)
+    (* { iNext; iExact "Hinv". } *)
+    (* (* splitting increment and read *) *)
+    (* iApply wp_rec; trivial. iNext. asimpl. *)
+    (* rewrite counter_read_subst /=. *)
+    (* iApply wp_value; simpl. *)
+    (* { by rewrite counter_read_to_val. } *)
+    (* iExists (PairV (CG_locked_incrementV _ _) (counter_readV _)); simpl. *)
+    (* rewrite CG_locked_increment_of_val counter_read_of_val. *)
+    (* iFrame "Hj". *)
+    (* iExists (_, _), (_, _); simpl; repeat iSplit; trivial. *)
+    (* - (* refinement of increment *) *)
+    (*   iAlways. clear j K. iIntros (v) "#Heq". iIntros (j K) "Hj". *)
+    (*   rewrite CG_locked_increment_of_val /=. *)
+    (*   destruct v; iDestruct "Heq" as "[% %]"; simplify_eq/=. *)
+    (*   iLöb as "Hlat". *)
+    (*   iApply wp_rec; trivial. asimpl. iNext. *)
+    (*   (* fine-grained reads the counter *) *)
+    (*   wp_bind (Load _). *)
+    (*   iApply wp_atomic; eauto. *)
+    (*   iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose". *)
+    (*   iApply (wp_load with "[Hcnt]"); [iNext; by iFrame|].  *)
+    (*   iNext. iIntros "Hcnt". *)
+    (*   iMod ("Hclose" with "[Hl Hcnt Hcnt']"). *)
+    (*   { iNext. iExists _. iFrame "Hl Hcnt Hcnt'". } *)
+    (*   iApply wp_rec; trivial. asimpl. iNext. *)
+    (*   (* fine-grained performs increment *) *)
+    (*   wp_bind (BinOp Add _ _). *)
+    (*   iApply wp_nat_binop; simpl. *)
+    (*   iNext. iModIntro. *)
+    (*   wp_bind (CAS _ _ _). *)
+    (*   iApply wp_atomic; eauto. *)
+    (*   iInv counterN as (n') ">[Hl [Hcnt Hcnt']]" "Hclose". *)
+    (*   (* performing CAS *) *)
+    (*   destruct (decide (n = n')) as [|Hneq]; subst. *)
+    (*   + (* CAS succeeds *) *)
+    (*     (* In this case, we perform increment in the coarse-grained one *) *)
+    (*     tp_apply j steps_CG_locked_increment with "Hcnt' Hl" *)
+    (*         as "[Hcnt' Hl]".              *)
+    (*     iApply (wp_cas_suc with "[Hcnt]"); auto. *)
+    (*     iNext. iIntros "Hcnt". *)
+    (*     iMod ("Hclose" with "[Hl Hcnt Hcnt']"). *)
+    (*     { iNext. iExists _. iFrame "Hl Hcnt Hcnt'"; trivial. } *)
+    (*     simpl.  *)
+    (*     iApply wp_if_true. iNext. iApply wp_value; trivial. *)
+    (*     iExists UnitV; iFrame; auto. *)
+    (*   + (* CAS fails *) *)
+    (*     (* In this case, we perform a recursive call *) *)
+    (*     iApply (wp_cas_fail _ _ _ (#nv n') with "[Hcnt]"); auto; *)
+    (*     [inversion 1; subst; auto | ].  *)
+    (*     iNext. iIntros "Hcnt". *)
+    (*     iMod ("Hclose" with "[Hl Hcnt Hcnt']"). *)
+    (*     { iNext. iExists _; iFrame "Hl Hcnt Hcnt'". } *)
+    (*     iApply wp_if_false. iNext. by iApply "Hlat". *)
+    (* - (* refinement of read *) *)
+    (*   iAlways. clear j K. iIntros (v) "#Heq". iIntros (j K) "Hj". *)
+    (*   rewrite ?counter_read_of_val. *)
+    (*   iDestruct "Heq" as "[% %]"; destruct v; simplify_eq/=. *)
+    (*   Transparent counter_read. *)
+    (*   unfold counter_read at 2. *)
+    (*   iApply wp_rec; trivial. simpl. *)
+    (*   iNext.  *)
+    (*   iApply wp_atomic; eauto. *)
+    (*   iInv counterN as (n) ">[Hl [Hcnt Hcnt']]" "Hclose". *)
+    (*   tp_apply j steps_counter_read with "Hcnt'" as "Hcnt'". *)
+    (*   iApply (wp_load with "[Hcnt]"); eauto.  *)
+    (*   iNext. iIntros "Hcnt". *)
+    (*   iMod ("Hclose" with "[Hl Hcnt Hcnt']"). *)
+    (*   { iNext. iExists _; iFrame "Hl Hcnt Hcnt'". } *)
+    (*   iExists (#nv _); eauto. *)
 End CG_Counter.
 
 Theorem counter_ctx_refinement :

F_mu_ref_conc/examples/lock.v

 From iris.proofmode Require Import tactics.
 From iris_logrel.F_mu_ref_conc Require Import tactics.
-From iris_logrel.F_mu_ref_conc Require Export rules_binary typing fundamental_binary.
+From iris_logrel.F_mu_ref_conc Require Export rules_binary typing fundamental_binary relational_properties.
 From iris.base_logic Require Import namespaces.
 
 (** [newlock = alloc false] *)
@@ -206,18 +206,19 @@ Section proof.
     by iFrame.
   Qed.
 
-  Lemma bin_log_related_with_lock_r Γ K P Q e v w l t τ :
+  Lemma bin_log_related_with_lock_r Γ K E1 E2 P Q e v w l t τ :
+    (nclose specN ⊆ E1) →
     (∀ f, e.[f] = e) (* e is a closed term *) →
     (∀ f, (of_val v).[f] = of_val v) (* v is a closed term *) →
     (∀ f, (of_val w).[f] = of_val w) (* w is a closed term *) →
     (∀ ρ j K', spec_ctx ρ -∗ P -∗ j ⤇ fill K' (App e (of_val w))
-            ={⊤}=∗ j ⤇ fill K' (of_val v) ∗ Q) →
+            ={E1}=∗ j ⤇ fill K' (of_val v) ∗ Q) →
     P -∗
     l ↦ₛ (#♭v false) -∗
-    (l ↦ₛ (#♭v false) -∗ Q -∗ Γ ⊨ t ≤log≤ fill K (of_val v) : τ)%I
-    -∗ Γ ⊨ t ≤log≤ fill K (App (with_lock e (Loc l)) (of_val w)) : τ.
+    (l ↦ₛ (#♭v false) -∗ Q -∗ {E1,E2;Γ} ⊨ t ≤log≤ fill K (of_val v) : τ)%I
+    -∗ {E1,E2;Γ} ⊨ t ≤log≤ fill K (App (with_lock e (Loc l)) (of_val w)) : τ.
   Proof.
-    iIntros (????) "HP Hl Hlog".
+    iIntros (?????) "HP Hl Hlog".
     pose (Φ := (fun (w: val) => ⌜w = v⌝ ∗ Q ∗ l ↦ₛ (#♭v false))%I).
     iApply (bin_log_related_step_r Φ with "[HP Hl]").
     { intros. 

F_mu_ref_conc/examples/stack/refinement.v

@@ -92,8 +92,9 @@ Section Stack_refinement.
       tp_bind j (App (of_val f2) _).
       iSpecialize ("Hff" $! (y1, y2) with "[Hy]"); first by iFrame.
       iSpecialize ("Hff" $! j (K ++ _) with "Hj"). simpl.
+      iApply fupd_wp. iMod "Hff". iModIntro.
       iApply (wp_wand with "Hff").
-      iIntros (v). iDestruct 1 as (v2) "[Hj [% %]]".
+      iIntros (v). iMod 1 as (v2) "[Hj [% %]]".
       tp_normalise j. asimpl.
       iApply fupd_wp. tp_rec j; auto using to_of_val.
       asimpl.
@@ -161,7 +162,8 @@ Section Stack_refinement.
       congruence. iNext. iIntros "Hst".
       close_sinv "Hclose" "[HLK Hst Hoe Hl Hst' Histk']".
       iApply wp_if_false. iNext.
-      iApply "IH". iFrame.
+      iMod ("IH" with "Hj") as "IH'".
+      iApply "IH'". 
   Qed.
 
   Lemma FG_CG_pop_refinement ρ st st' (τi : D) l Δ {τP : ∀ ww, PersistentP (τi ww)} {SH : stackG Σ}:
@@ -198,7 +200,7 @@ Section Stack_refinement.
       iApply wp_case_inl; auto. iNext.
       iApply wp_value; auto. 
       iExists (InjLV ())%V. iFrame "Hj".
-      iLeft. iExists (_,_). iSplit; auto.
+      iLeft. iExists (_,_). iModIntro. iSplit; auto.
     + close_sinv "Hclose" "[Hoe Hst' Hst Hl]".
       wp_bind (Unfold _). iApply wp_fold; first auto. iNext.
       iApply wp_rec; first auto. iNext. asimpl.
@@ -250,14 +252,14 @@ Section Stack_refinement.
         iModIntro.
         iApply wp_value; try by rewrite /= ?to_of_val /=.
         iExists (InjRV zn1). iFrame "Hj".
-        iRight. iExists (_,_). simpl. iSplit; auto.
+        iRight. iExists (_,_). simpl. iModIntro. iSplit; auto.
       * (* CAS fails *)
         iApply (wp_cas_fail with "Hst"); try by (rewrite /= ?to_of_val /=).
         congruence.        
         iNext. iIntros "Hst".
         close_sinv "Hclose" "[-Hj]".
         iApply wp_if_false. iNext. 
-        by iApply "IH".
+        by iMod ("IH" with "Hj").
   Qed.
     
   (* ∀ α. (α → Unit) * (Unit → Unit + α) * ((α → Unit) → Unit) *)
@@ -278,7 +280,7 @@ Section Stack_refinement.
            (TArrow (TVar 0) TUnit)
            (TArrow TUnit (TSum TUnit (TVar 0))))
            (TArrow (TArrow (TVar 0) TUnit) TUnit))).
-    clear j K. iAlways. iIntros (τi) "%". 
+    clear j K. iModIntro. iAlways. iIntros (τi) "%". 
     iIntros (j K) "Hj /=".
     iApply fupd_wp.
     tp_tlam j.
@@ -324,7 +326,7 @@ Section Stack_refinement.
     iApply wp_value; first by eauto. 
     iExists (PairV (PairV (CG_locked_pushV _ _) (CG_locked_popV _ _)) (RecV _)).
     simpl. rewrite CG_locked_push_of_val CG_locked_pop_of_val. iFrame "Hj".   
-    iExists (_, _), (_, _); iSplit; eauto.
+    iExists (_, _), (_, _); iModIntro; iSplit; eauto.
     iSplit.
     (* refinement of push and pop *)
     - iExists (_, _), (_, _); iSplit; eauto. iSplit.
@@ -332,7 +334,7 @@ Section Stack_refinement.
         (* TODO: fold (interp (...)) does not work here *)
         change (□ (∀ vv : prodC valC valC,
      □ τi vv
-     → interp_expr interp_unit (τi :: Δ)
+     → interp_expr ⊤ ⊤ interp_unit (τi :: Δ)
          ((rec: (rec: if: CAS #stk (Var 1)
                             (Fold (ref InjR (Var 3, Var 1)))
                       then () else (Var 2) (Var 3)) 

F_mu_ref_conc/logrel_binary.v

@@ -32,13 +32,13 @@ Section logrel.
   Implicit Types Δ : listC D.
   Implicit Types interp : listC D → D.
 
-  Definition interp_expr (τi : listC D -n> D) (Δ : listC D)
+  Definition interp_expr (E1 E2 : coPset) (τi : listC D -n> D) (Δ : listC D)
       (ee : expr * expr) : iProp Σ := (∀ j K,
     j ⤇ fill K (ee.2) -∗
-    WP ee.1 {{ v, ∃ v', j ⤇ fill K (of_val v') ∗ τi Δ (v, v') }})%I.
-  Global Instance interp_expr_ne n :
-    Proper (dist n ==> dist n ==> (=) ==> dist n) interp_expr.
-  Proof. solve_proper. Qed.
+    |={E1,E2}=> WP ee.1 @ E2 {{ v, |={E2}=> ∃ v', j ⤇ fill K (of_val v') ∗ τi Δ (v, v') }})%I.
+  Global Instance interp_expr_ne n E1 E2:
+    Proper (dist n ==> dist n ==> (=) ==> dist n) (interp_expr E1 E2).
+  Proof. solve_proper. Qed.       
 
   Program Definition ctx_lookup (x : var) : listC D -n> D := λne Δ ww,
     (□ from_option id (cconst True)%I (Δ !! x) ww)%I.
@@ -71,7 +71,7 @@ Section logrel.
           (interp1 interp2 : listC D -n> D) : listC D -n> D :=
     λne Δ ww,
     (□ ∀ vv, interp1 Δ vv →
-             interp_expr
+             interp_expr ⊤ ⊤
                interp2 Δ (App (of_val (ww.1)) (of_val (vv.1)),
                           App (of_val (ww.2)) (of_val (vv.2))))%I.
   Solve Obligations with solve_proper. 
@@ -80,7 +80,7 @@ Section logrel.
       (interp : listC D -n> D) : listC D -n> D := λne Δ ww,
     (□ ∀ τi,
           ⌜∀ ww, PersistentP (τi ww)⌝ →
-          interp_expr
+          interp_expr ⊤ ⊤
             interp (τi :: Δ) (TApp (of_val (ww.1)), TApp (of_val (ww.2))))%I.
   Solve Obligations with solve_proper.
 
@@ -245,5 +245,5 @@ End logrel.
 
 Typeclasses Opaque interp_env.
 Notation "⟦ τ ⟧" := (interp τ).
-Notation "⟦ τ ⟧ₑ" := (interp_expr (interp τ)).
+Notation "⟦ τ ⟧ₑ" := (interp_expr ⊤ ⊤ (interp τ)).
 Notation "⟦ Γ ⟧*" := (interp_env Γ).

F_mu_ref_conc/soundness_binary.v

@@ -25,15 +25,20 @@ Proof.
   { iNext. iExists [e'], ∅. rewrite /to_gen_heap fin_maps.map_fmap_empty. auto. }
   set (HeapΣ := (HeapIG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
   iExists (λ σ, own γ (● to_gen_heap σ)); iFrame.
-  iApply wp_fupd. iApply wp_wand_r.
+  iApply wp_fupd.
+  iApply wp_wand_r.
   iSplitL.
   iPoseProof (Hlog _ _) as "Hrel". 
   iSpecialize ("Hrel" $! [] [] with "* [$Hcfg] []").
   { iAlways. iApply logrel_binary.interp_env_nil.  }
   simpl.
-  rewrite empty_env_subst empty_env_subst. iApply ("Hrel" $! 0 []).
+  rewrite empty_env_subst empty_env_subst. 
+  iSpecialize ("Hrel" $! 0 []).
+  iAssert (0 ⤇ e')%I with "[Hcfg2]" as "H0".
   { rewrite tpool_mapsto_eq /tpool_mapsto_def. asimpl. iFrame. }
-  iIntros (v1); iDestruct 1 as (v2) "[Hj #Hinterp]".
+  iApply fupd_wp. iApply "Hrel"; auto.
+  iIntros (v1).
+  iMod 1 as (v2) "[Hj #Hinterp]". 
   iInv specN as (tp σ) ">[Hown Hsteps]" "Hclose"; iDestruct "Hsteps" as %Hsteps'.
   rewrite tpool_mapsto_eq /tpool_mapsto_def /=.
   iDestruct (own_valid_2 with "Hown Hj") as %Hvalid.

F_mu_ref_conc/weakestpre.v

@@ -14,8 +14,8 @@ Implicit Types v : val.
 Implicit Types e : expr.
 
 (* Inverse bind lemma *)
-Lemma wp_bind_inv K  e Φ :
-  WP fill K e {{ Φ }} ⊢ WP e {{ v, WP fill K (of_val v)  {{ Φ }} }}.
+Lemma wp_bind_inv K E e Φ :
+  WP fill K e @ E {{ Φ }} ⊢ WP e @ E {{ v, WP fill K (of_val v) @ E {{ Φ }} }}.
 Proof.
   iIntros "H". iLöb as "IH" forall (e Φ). rewrite wp_unfold /wp_pre.
   iDestruct "H" as "[Hv|[% H]]".
@@ -33,7 +33,7 @@ Proof.
   destruct eval.
   - iApply wp_value. symmetry. eauto.
     replace e with (of_val v) in H; last first.
-    { by rewrite (of_to_val e). }
+    { by rewrite (of_to_val e). } 
     rewrite wp_unfold /wp_pre; iRight; iSplit; eauto.
     iIntros (σ1) "Hσ". iMod ("H" $! _ with "Hσ") as "[% H]".
     iModIntro; iSplit.

Makefile

-# Makefile originally taken from coq-club
-all: Makefile.coq
-	+make -f Makefile.coq all
+#############################################################################
+##  v      #                   The Coq Proof Assistant                     ##
+## <O___,, #                INRIA - CNRS - LIX - LRI - PPS                 ##
+##   \VV/  #                                                               ##
+##    //   #  Makefile automagically generated by coq_makefile V8.6        ##
+#############################################################################
 
-clean: Makefile.coq
-	+make -f Makefile.coq clean
-	rm -f Makefile.coq