Commit 67d0a0ab by Dan Frumin

### Introduce a single typeclass for logical state for logical relations

parent c61b7c2a
 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.
 ... ... @@ -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); ... ...
 ... ... @@ -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.
 ... ... @@ -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". ... ...
 ... ... @@ -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 ... ...
 ... ... @@ -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 → ... ...
 ... ... @@ -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. ... ...
 ... ... @@ -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. ... ...
 ... ... @@ -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)) ρ, ... ...
This diff is collapsed.
 ... ... @@ -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. ... ...
 ... ... @@ -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. ... ...
 ... ... @@ -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. ... ...
 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.
This diff is collapsed.
 ... ... @@ -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 ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!