Introduce a single typeclass for logical state for logical relations

F_mu_ref_conc/adequacy.v

+From iris.program_logic Require Export weakestpre adequacy.
+From iris_logrel.F_mu_ref_conc Require Export rules.
+From iris.algebra Require Import auth.
+From iris.proofmode Require Import tactics.
+Set Default Proof Using "Type".
+
+Class heapPreG Σ := HeapPreG {
+  heap_preG_iris :> invPreG Σ;
+  heap_preG_heap :> gen_heapPreG loc val Σ
+}.
+
+Definition heapΣ : gFunctors := #[invΣ; gen_heapΣ loc val].
+Instance subG_heapPreG {Σ} : subG heapΣ Σ → heapPreG Σ.
+Proof. solve_inG. Qed.
+
+Definition heap_adequacy Σ `{heapPreG Σ} e σ φ :
+  (∀ `{heapG Σ}, True ⊢ WP e {{ v, ⌜φ v⌝ }}) →
+  adequate e σ φ.
+Proof.
+  intros Hwp; eapply (wp_adequacy _ _); iIntros (?) "".
+  iMod (own_alloc (● to_gen_heap σ)) as (γ) "Hh".
+  { apply: auth_auth_valid. exact: to_gen_heap_valid. }
+  iModIntro. iExists (λ σ, own γ (● to_gen_heap σ)); iFrame.
+  set (Hheap := GenHeapG loc val Σ _ _ _ γ).
+  iApply (Hwp (HeapG _ _ _)).
+Qed.

F_mu_ref_conc/context_refinement.v

@@ -228,7 +228,7 @@ Ltac fold_interp :=
   end.
 
 Section bin_log_related_under_typed_ctx.
-  Context `{heapIG Σ, cfgSG Σ}.
+  Context `{logrelG Σ}.
 
   Ltac fundamental :=
     try (solve_ndisj);

F_mu_ref_conc/examples/counter.v

@@ -29,7 +29,7 @@ Definition FG_counter : expr :=
   (FG_increment "x", counter_read "x").
 
 Section CG_Counter.
-  Context `{heapIG Σ, cfgSG Σ}.
+  Context `{logrelG Σ}.
   
   (* Coarse-grained increment *)  
   Lemma CG_increment_type Γ :
@@ -314,12 +314,6 @@ Theorem counter_ctx_refinement :
   ∅ ⊨ FG_counter ≤ctx≤ CG_counter :
          TProd (TArrow TUnit TUnit) (TArrow TUnit TNat).
 Proof.
-  set (Σ := #[invΣ ; gen_heapΣ loc val ; authΣ cfgUR ]).
-  set (HG := HeapPreIG Σ _ _).
-  eapply (logrel_ctxequiv Σ _).
-  (* TODO: how to get rid of this bullshit with closed conditions? *)
-  rewrite /FG_counter /CG_counter; try solve_closed.
-  rewrite /FG_counter /CG_counter; try solve_closed.
-  Transparent newlock. unfold newlock. solve_closed.
-  intros. apply FG_CG_counter_refinement.
+  eapply (logrel_ctxequiv logrelΣ); [solve_closed.. | intros ].
+  apply FG_CG_counter_refinement.
 Qed.

F_mu_ref_conc/examples/lateearlychoice.v

@@ -17,7 +17,7 @@ Definition earlyChoice : val := λ: "x",
   let: "r" := rand #() in "x" <- #n 0;; "r".
 
 Section Refinement.
-  Context `{heapIG Σ, cfgSG Σ}.
+  Context `{logrelG Σ}.
 
   Definition choiceN : namespace := nroot .@ "choice".
 

F_mu_ref_conc/examples/lock.v

@@ -52,8 +52,7 @@ Qed.
 Hint Resolve with_lock_type : typeable.
 
 Section proof.
-  Context `{cfgSG Σ}.
-  Context `{heapIG Σ}.
+  Context `{logrelG Σ}.
   Variable (E1 E2 : coPset).
 
   Lemma steps_newlock ρ j K

F_mu_ref_conc/examples/par.v

@@ -29,7 +29,7 @@ Qed.
 Hint Resolve par_type : typeable.
 
 Section compatibility.
-  Context `{heapIG Σ, cfgSG Σ}.
+  Context `{logrelG Σ}.
 
   Lemma bin_log_related_par Γ E e1 e2 e1' e2' τ1 τ2 :
     ↑specN ⊆ E →

F_mu_ref_conc/fundamental_binary.v

@@ -5,7 +5,7 @@ From iris.base_logic Require Export big_op.
 From iris.program_logic Require Import ectx_lifting.
 
 Section fundamental.
-Context `{heapIG Σ, cfgSG Σ}.
+Context `{logrelG Σ}.
 Notation D := (prodC valC valC -n> iProp Σ).
 Implicit Types e : expr.
 Implicit Types Δ : listC D.

F_mu_ref_conc/hax.v

@@ -25,7 +25,7 @@ Ltac inv_head_step :=
   end.
 
 Section hax.
-  Context `{heapIG Σ, cfgSG Σ}.
+  Context `{logrelG Σ}.
   Notation D := (prodC valC valC -n> iProp Σ).
   Implicit Types Δ : listC D.
 

F_mu_ref_conc/logrel_binary.v

@@ -38,7 +38,7 @@ Definition logN : namespace := nroot .@ "logN".
 
 (** interp : is a unary logical relation. *)
 Section logrel.
-  Context `{heapIG Σ, cfgSG Σ}.
+  Context `{logrelG Σ}.
   Notation D := (prodC valC valC -n> iProp Σ).
   Implicit Types τi : D.
   Implicit Types Δ : listC D.
@@ -372,7 +372,7 @@ Notation "⟦ τ ⟧ₑ" := (interp_expr ⊤ ⊤ ⟦ τ ⟧).
 Notation "⟦ Γ ⟧*" := (interp_env Γ).
 
 Section bin_log_def.
-  Context `{heapIG Σ, cfgSG Σ}.
+  Context `{logrelG Σ}.
   Notation D := (prodC valC valC -n> iProp Σ).
 
   Definition bin_log_related_def (E1 E2 : coPset) (Γ : stringmap type) (e e' : expr) (τ : type) : iProp Σ := (∀ Δ (vvs : stringmap (val * val)) ρ,  

F_mu_ref_conc/relational_properties.v

@@ -5,7 +5,7 @@ From iris.program_logic Require Import ectx_lifting.
 
 (** * Properties of the relational interpretation *)
 Section properties.
-  Context `{heapIG Σ, cfgSG Σ}.
+  Context `{logrelG Σ}.
   Notation D := (prodC valC valC -n> iProp Σ).
   Implicit Types e : expr.
   Implicit Types Δ : listC D.

F_mu_ref_conc/rules.v

@@ -9,13 +9,13 @@ Import uPred.
 
 (** The CMRA for the heap of the implementation. This is linked to the
     physical heap. *)
-Class heapIG Σ := HeapIG {
-  heapI_invG : invG Σ;
-  heapI_gen_heapG :> gen_heapG loc val Σ;
+Class heapG Σ := HeapG {
+  heapG_invG : invG Σ;
+  heapG_gen_heapG :> gen_heapG loc val Σ;
 }.
 
-Instance heapIG_irisG `{heapIG Σ} : irisG lang Σ := {
-  iris_invG := heapI_invG;
+Instance heapG_irisG `{heapG Σ} : irisG lang Σ := {
+  iris_invG := heapG_invG;
   state_interp := gen_heap_ctx
 }.
 Global Opaque iris_invG.
@@ -25,7 +25,7 @@ Notation "l ↦ᵢ{ q } v" := (mapsto (L:=loc) (V:=val) l q v)
 Notation "l ↦ᵢ v" := (mapsto (L:=loc) (V:=val) l 1 v) (at level 20) : uPred_scope.
 
 Section lang_rules.
-  Context `{heapIG Σ}.
+  Context `{heapG Σ}.
   Implicit Types P Q : iProp Σ.
   Implicit Types Φ : val → iProp Σ.
   Implicit Types σ : state.

F_mu_ref_conc/rules_binary.v

@@ -19,10 +19,14 @@ Fixpoint to_tpool_go (i : nat) (tp : list expr) : tpoolUR :=
 Definition to_tpool : list expr → tpoolUR := to_tpool_go 0.
 
 (** The CMRA for the thread pool. *)
-Class cfgSG Σ := CFGSG { cfg_inG :> inG Σ (authR cfgUR); cfg_name : gname }.
+Class logrelG Σ := LogrelG {
+  heap_inG :> heapG Σ;
+  cfg_inG :> inG Σ (authR cfgUR);
+  cfg_name : gname
+}.
 
 Section definitionsS.
-  Context `{cfgSG Σ, invG Σ}.
+  Context `{logrelG Σ}.
 
   Definition heapS_mapsto_def (l : loc) (q : Qp) (v: val) : iProp Σ :=
     own cfg_name (◯ (∅, {[ l := (q, to_agree v) ]})).
@@ -51,7 +55,7 @@ Notation "l ↦ₛ v" := (heapS_mapsto l 1 v) (at level 20) : uPred_scope.
 Notation "j ⤇ e" := (tpool_mapsto j e) (at level 20) : uPred_scope.
 
 Section conversions.
-  Context `{cfgSG Σ}.
+  Context `{logrelG Σ}.
 
   (** Conversion to tpools and back *)
   Lemma to_tpool_valid es : ✓ to_tpool es.
@@ -112,7 +116,7 @@ Section conversions.
 End conversions.
 
 Section cfg.
-  Context `{heapIG Σ, cfgSG Σ}.
+  Context `{logrelG Σ}.
   Implicit Types P Q : iProp Σ.
   Implicit Types Φ : val → iProp Σ.
   Implicit Types σ : state.

F_mu_ref_conc/soundness_binary.v

-From iris_logrel.F_mu_ref_conc Require Export context_refinement.
+From iris_logrel.F_mu_ref_conc Require Export context_refinement adequacy.
 From iris.algebra Require Import auth frac agree.
-From iris.base_logic Require Import big_op.
+From iris.base_logic Require Import big_op lib.auth.
 From iris.proofmode Require Import tactics.
-From iris.program_logic Require Import adequacy.
 
-Class heapPreIG Σ := HeapPreIG {
-  heap_preG_iris :> invPreG Σ;
-  heap_preG_heap :> gen_heapPreG loc val Σ
+Class logrelPreG Σ := LogrelPreG {
+  logrel_preG_heap :> heapPreG Σ;
+  logrel_preG_cfg  :> inG Σ (authR cfgUR)
 }.
 
-Lemma logrel_adequate Σ `{heapPreIG Σ, inG Σ (authR cfgUR)}
+Definition logrelΣ : gFunctors := #[heapΣ; authΣ cfgUR].
+Instance subG_heapPreG {Σ} : subG logrelΣ Σ → logrelPreG Σ.
+Proof. solve_inG. Qed.
+
+Lemma logrel_adequate Σ `{logrelPreG Σ}
     e e' τ σ :
-  (∀ `{heapIG Σ, cfgSG Σ}, ∅ ⊨ e ≤log≤ e' : τ) →
+  (∀ `{logrelG Σ}, ∅ ⊨ e ≤log≤ e' : τ) →
   adequate e σ (λ v, ∃ thp' h v', rtc step ([e'], ∅) (of_val v' :: thp', h) 
     ∧ (ObsType τ → v = v')).
 Proof.
   intros Hlog.
-  eapply (wp_adequacy Σ _); iIntros (Hinv).
-  iMod (own_alloc (● to_gen_heap σ)) as (γ) "Hh".
-  { apply (auth_auth_valid _ (to_gen_heap_valid _ _ σ)). }
+  eapply (heap_adequacy Σ _); iIntros (Hinv).
   iMod (own_alloc (● (to_tpool [e'], ∅)
     ⋅ ◯ ((to_tpool [e'] : tpoolUR, ∅) : cfgUR))) as (γc) "[Hcfg1 Hcfg2]".
   { apply auth_valid_discrete_2. split=>//. split=>//. apply to_tpool_valid. }
-  set (Hcfg := CFGSG _ _ γc).
+  set (Hcfg := LogrelG _ _ _ γc).
   iMod (inv_alloc specN _ (spec_inv ([e'], ∅)) with "[Hcfg1]") as "#Hcfg".
   { 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.
   iSplitL.
-  - iPoseProof (Hlog _ _) as "Hrel".
+  - iPoseProof (Hlog _) as "Hrel".
     rewrite bin_log_related_eq /bin_log_related_def.
     iSpecialize ("Hrel" $! [] with "[$Hcfg] []").
-    { iAlways. iApply logrel_binary.interp_env_nil. }
+    { iApply logrel_binary.interp_env_nil. }
     rewrite /env_subst !fmap_empty !subst_p_empty. 
+    iApply fupd_wp.
     iApply ("Hrel" $! 0 []). simpl.
     rewrite tpool_mapsto_eq /tpool_mapsto_def. iFrame.
-  - iModIntro. iIntros (v1).
+  - iIntros (v1).
     iDestruct 1 as (v2) "[Hj #Hinterp]". 
     iInv specN as (tp σ') ">[Hown Hsteps]" "Hclose"; iDestruct "Hsteps" as %Hsteps'.
     rewrite tpool_mapsto_eq /tpool_mapsto_def /=.
@@ -52,8 +52,8 @@ Proof.
 Qed.
 
 
-Theorem logrel_typesafety Σ `{heapPreIG Σ, inG Σ (authR cfgUR)} e τ e' thp σ σ' :
-  (∀ `{heapIG Σ, cfgSG Σ}, ∅ ⊨ e ≤log≤ e : τ) →
+Theorem logrel_typesafety Σ `{logrelPreG Σ} e τ e' thp σ σ' :
+  (∀ `{logrelG Σ}, ∅ ⊨ e ≤log≤ e : τ) →
   rtc step ([e], σ) (thp, σ') → e' ∈ thp →
   is_Some (to_val e') ∨ reducible e' σ'.
 Proof.
@@ -62,9 +62,9 @@ Proof.
   eapply logrel_adequate; eauto.
 Qed.
 
-Lemma logrel_simul Σ `{heapPreIG Σ, inG Σ (authR cfgUR)}
+Lemma logrel_simul Σ `{logrelPreG Σ}
     e e' τ v thp hp :
-  (∀ `{heapIG Σ, cfgSG Σ}, ∅ ⊨ e ≤log≤ e' : τ) →
+  (∀ `{logrelG Σ}, ∅ ⊨ e ≤log≤ e' : τ) →
   rtc step ([e], ∅) (of_val v :: thp, hp) →
   (∃ thp' hp' v', rtc step ([e'], ∅) (of_val v' :: thp', hp') ∧ (ObsType τ → v = v')).
 Proof.
@@ -74,18 +74,17 @@ Proof.
   eapply logrel_adequate; eauto.
 Qed.
 
-Lemma logrel_ctxequiv Σ `{heapPreIG Σ, inG Σ (authR cfgUR)}
-    Γ e e' τ :
-  (Closed (dom _ Γ) e) →
-  (Closed (dom _ Γ) e') →
-  (∀ `{heapIG Σ, cfgSG Σ}, Γ ⊨ e ≤log≤ e' : τ) →
+Lemma logrel_ctxequiv Σ `{logrelPreG Σ} Γ e e' τ :
+  Closed (dom _ Γ) e →
+  Closed (dom _ Γ) e' →
+  (∀ `{logrelG Σ}, Γ ⊨ e ≤log≤ e' : τ) →
   Γ ⊨ e ≤ctx≤ e' : τ.
 Proof.
   intros He He' Hlog K thp σ ? τ' ? ? Hstep.
   cut (∃ thp' hp' v', rtc step ([fill_ctx K e'], ∅) (of_val v' :: thp', hp') ∧ (ObsType τ'  → v = v')).
   { naive_solver. }
   eapply (logrel_simul Σ _); last by apply Hstep.
-  intros ??.
+  intros ?.
   iApply (bin_log_related_under_typed_ctx _ _ _ _ ∅); eauto.
-  iPoseProof (Hlog _ _) as "Hrel". auto.
+  iPoseProof (Hlog _) as "Hrel". auto.
 Qed.

_CoqProject

@@ -17,6 +17,7 @@ F_mu_ref_conc/logrel_binary.v
 F_mu_ref_conc/fundamental_binary.v
 # F_mu_ref_conc/soundness_unary.v
 F_mu_ref_conc/context_refinement.v
+F_mu_ref_conc/adequacy.v
 F_mu_ref_conc/soundness_binary.v
 F_mu_ref_conc/tactics.v
 F_mu_ref_conc/rel_tactics.v