Commit 07aac180 authored by Robbert Krebbers's avatar Robbert Krebbers

Finish porting to Iris 3.0.

parent e2c29658
......@@ -15,13 +15,12 @@ Section fundamental.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) :=
iApply (wp_bind [ctx]);
iApply wp_wand_l;
iSplitL; [|iApply Hp; trivial]; cbn;
iApply (wp_wand with "[-]"); [iApply Hp; trivial|]; cbn;
iIntros (v) Hv.
Local Ltac value_case := iApply wp_value; cbn; rewrite ?to_of_val; trivial.
Theorem fundamental Γ e τ : Γ ⊢ₜ e : τ log_typed Γ e τ.
Theorem fundamental Γ e τ : Γ ⊢ₜ e : τ Γ e : τ.
Proof.
induction 1; iIntros (Δ vs HΔ) "#HΓ"; cbn.
- (* var *)
......
......@@ -3,18 +3,16 @@ From iris.proofmode Require Import tactics.
From iris.program_logic Require Import adequacy.
Theorem soundness Σ `{invPreG Σ} e τ e' thp σ σ' :
( `{irisG lang Σ}, log_typed [] e τ)
( `{irisG lang Σ}, [] e : τ)
rtc step ([e], σ) (thp, σ') e' thp
is_Some (to_val e') reducible e' σ'.
Proof.
intros Hlog ??. cut (adequate e σ (λ _, True)); first (intros [_ ?]; eauto).
eapply (wp_adequacy Σ); eauto.
iIntros (Hinv).
iModIntro. iExists (λ _, True%I). iSplitR;eauto.
iIntros (Hinv). iModIntro. iExists (λ _, True%I). iSplit=> //.
rewrite -(empty_env_subst e).
set (HΣ := IrisG () _ Hinv (fun _ => True)%I).
iApply wp_wand_l; iSplitR; [|iApply Hlog]; eauto.
by iApply interp_env_nil.
set (HΣ := IrisG _ _ Hinv (λ _, True)%I).
iApply (wp_wand with "[]"). iApply Hlog; eauto. by iApply interp_env_nil. auto.
Qed.
Corollary type_soundness e τ e' thp σ σ' :
......
......@@ -14,8 +14,8 @@ Section fundamental.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) :=
iApply (wp_bind [ctx]);
iApply wp_wand_l;
iSplitR; [|iApply Hp; trivial]; iIntros (v) Hv; cbn.
iApply (wp_wand with "[-]"); [iApply Hp; trivial|]; cbn;
iIntros (v) Hv; cbn.
Local Ltac value_case := iApply wp_value; [cbn; rewrite ?to_of_val; trivial|].
......
......@@ -4,8 +4,7 @@ From iris_logrel.F_mu_ref Require Import rules_binary.
From iris.base_logic Require Export big_op.
Section bin_log_def.
Context `{cfgSG Σ}.
Context `{!heapG Σ}.
Context `{heapG Σ,cfgSG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Definition bin_log_related (Γ : list type) (e e' : expr) (τ : type) := Δ vvs (ρ : cfg lang),
......@@ -17,8 +16,7 @@ Notation "Γ ⊨ e '≤log≤' e' : τ" :=
(bin_log_related Γ e e' τ) (at level 74, e, e', τ at next level).
Section fundamental.
Context `{cfgSG Σ}.
Context `{!heapG Σ}.
Context `{heapG Σ,cfgSG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Implicit Types e : expr.
Implicit Types Δ : listC D.
......@@ -27,10 +25,9 @@ Section fundamental.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) ident(w)
constr(Hv) uconstr(Hp) :=
iApply (wp_bind [ctx]);
iApply wp_wand_l; iSplitR;
[|iApply Hp; rewrite ?fill_app /=; iFrame "#"; trivial];
let Htmp := iFresh in
iIntros (v) Htmp; iDestruct Htmp as (w) Hv;
iApply (wp_wand with "[-]");
[iApply Hp; rewrite ?fill_app /=; iFrame "#"; trivial|];
iIntros (v); iDestruct 1 as (w) Hv;
rewrite fill_app; simpl.
Local Ltac value_case := iApply wp_value; eauto using to_of_val.
......
From iris.program_logic Require Export weakestpre ectx_lifting.
From iris.program_logic Require Export weakestpre.
From iris.program_logic Require Import ectx_lifting.
From iris.base_logic Require Export invariants big_op.
From iris.algebra Require Import frac agree gmap.
From iris.base_logic.lib Require Import auth.
From iris.algebra Require Import auth frac agree gmap.
From iris_logrel.F_mu_ref Require Export lang.
From iris.proofmode Require Import tactics.
From iris.base_logic Require Export gen_heap.
......
From iris.program_logic Require Import lifting.
From iris.algebra Require Import frac agree gmap list.
From iris.base_logic Require Import big_op auth.
From iris.algebra Require Import auth frac agree gmap list.
From iris.base_logic Require Import big_op.
From iris_logrel.F_mu_ref Require Export rules.
From iris.proofmode Require Import tactics.
Import uPred.
......@@ -11,11 +11,7 @@ Definition specN := nroot .@ "spec".
Definition cfgUR := prodUR (optionUR (exclR exprC)) (gen_heapUR loc val).
(** The CMRA for the thread pool. *)
Class cfgSG Σ :=
CFGSG {
cfg_inG :> inG Σ (authR cfgUR);
cfg_name : gname
}.
Class cfgSG Σ := CFGSG { cfg_inG :> inG Σ (authR cfgUR); cfg_name : gname }.
Definition spec_ctx `{cfgSG Σ} (ρ : cfg lang) : iProp Σ :=
( e, σ, own cfg_name ( (Excl' e, to_gen_heap σ))
......@@ -26,14 +22,13 @@ Definition spec_inv `{cfgSG Σ} `{invG Σ} (ρ : cfg lang) : iProp Σ :=
Section definitionsS.
Context `{cfgSG Σ}.
Definition heapS_mapsto (l : loc) (q : Qp) (v: val) : iProp Σ :=
own cfg_name ( (, {[ l := (q, to_agree v) ]})).
Definition tpool_mapsto (e: expr) : iProp Σ :=
own cfg_name ( (Excl' e, )).
Global Instance heapS_mapsto_timeless l q v : TimelessP (heapS_mapsto l q v).
Proof. apply _. Qed.
End definitionsS.
......@@ -65,20 +60,16 @@ Section cfg.
nclose specN E
spec_inv ρ fill K e ={E}= fill K e'.
Proof.
iIntros (??) "[Hinv Hj]". rewrite /spec_ctx /auth_inv /tpool_mapsto.
iIntros (??) "[Hinv Hj]". rewrite /spec_ctx /tpool_mapsto.
iInv specN as ">Hspec" "Hclose".
iDestruct "Hspec" as (e'' σ) "[Hown %]".
iDestruct (((@own_valid_2 Σ _ _ cfg_name ( (Excl' e'', to_gen_heap σ))) ( (Excl' (fill K e), ))) with "Hown Hj")
as %[[?%Excl_included%leibniz_equiv _]%prod_included Hvalid]%auth_valid_discrete_2.
subst.
iDestruct (@own_valid_2 with "Hown Hj")
as %[[?%Excl_included%leibniz_equiv _]%prod_included Hvalid]%auth_valid_discrete_2; subst.
iMod (own_update_2 with "Hown Hj") as "[Hown Hj]".
{ eapply auth_update, prod_local_update_1, option_local_update,
(exclusive_local_update _ (Excl (fill K e'))).
by inversion Hvalid.
}
iFrame "Hj".
iApply "Hclose". iNext. iExists (fill K e'). iExists σ.
iFrame.
{ by eapply auth_update, prod_local_update_1, option_local_update,
(exclusive_local_update _ (Excl (fill K e'))). }
iFrame "Hj".
iApply "Hclose". iNext. iExists (fill K e'). iExists σ. iFrame.
iPureIntro. eapply rtc_r, step_insert_no_fork; eauto.
Qed.
......@@ -191,5 +182,4 @@ Section cfg.
spec_inv ρ fill K (Case (InjR e0) e1 e2)
={E}= fill K (e2.[e0/]).
Proof. intros H1; apply step_pure => σ; econstructor; eauto. Qed.
End cfg.
......@@ -9,7 +9,7 @@ Class heapPreG Σ := HeapPreG {
}.
Theorem soundness Σ `{heapPreG Σ} e τ e' thp σ σ' :
( `{heapG Σ}, log_typed [] e τ)
( `{heapG Σ}, [] e : τ)
rtc step ([e], σ) (thp, σ') e' thp
is_Some (to_val e') reducible e' σ'.
Proof.
......@@ -17,14 +17,13 @@ Proof.
eapply (wp_adequacy Σ _); eauto.
iIntros (Hinv).
iMod (own_alloc ( to_gen_heap σ)) as (γ) "Hh".
- apply (auth_auth_valid _ (to_gen_heap_valid _ _ σ)).
- iModIntro. iExists (λ σ, own γ ( to_gen_heap σ)); iFrame.
set (HΣ := IrisG _ _ Hinv (λ σ, own γ ( to_gen_heap σ))%I).
iApply wp_wand_r.
iSplitR. rewrite -(empty_env_subst e).
set (HeapΣ := (HeapG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
{ apply (auth_auth_valid _ (to_gen_heap_valid _ _ σ)). }
iModIntro. iExists (λ σ, own γ ( to_gen_heap σ)); iFrame.
set (HeapΣ := (HeapG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
iApply (wp_wand with "[]").
- rewrite -(empty_env_subst e).
iApply (Hlog HeapΣ [] []). iApply (@interp_env_nil _ HeapΣ).
eauto.
- auto.
Qed.
Corollary type_soundness e τ e' thp σ σ' :
......@@ -34,7 +33,7 @@ Corollary type_soundness e τ e' thp σ σ' :
Proof.
intros ??. set (Σ := #[invΣ ; gen_heapΣ loc val]).
set (HG := HeapPreG Σ _ _).
eapply (soundness Σ).
eapply (soundness Σ).
- intros ?. by apply fundamental.
- eauto.
Qed.
From iris_logrel.F_mu_ref Require Export context_refinement.
From iris.algebra Require Import frac agree.
From iris.base_logic Require Import big_op auth.
From iris.algebra Require Import auth frac agree.
From iris.base_logic Require Import big_op.
From iris.proofmode Require Import tactics.
From iris.program_logic Require Import adequacy.
From iris_logrel.F_mu_ref Require Import soundness.
Lemma basic_soundness Σ `{heapPreG Σ, authG Σ cfgUR}
Lemma basic_soundness Σ `{heapPreG Σ, inG Σ (authR cfgUR)}
e e' τ v thp hp :
( `{cfgSG Σ} `{!heapG Σ}, [] e log e' : τ)
( `{heapG Σ, cfgSG Σ}, [] e log e' : τ)
rtc step ([e], ) (of_val v :: thp, hp)
( thp' hp' v', rtc step ([e'], ) (of_val v' :: thp', hp')).
Proof.
intros Hlog Hsteps.
cut (adequate e (λ _, thp' h v, rtc step ([e'], ) (of_val v :: thp', h))).
{ destruct 1; naive_solver. }
eapply (wp_adequacy Σ); first by apply _.
eapply (wp_adequacy Σ); first by apply _.
iIntros (Hinv).
iMod (own_alloc ( to_gen_heap )) as (γ) "Hh".
{ apply (auth_auth_valid _ (to_gen_heap_valid _ _ )). }
......@@ -26,37 +26,30 @@ Proof.
{ iNext. iExists e', . iSplit; eauto.
rewrite /to_gen_heap fin_maps.map_fmap_empty.
iFrame. }
set (HΣ := IrisG _ _ Hinv (λ σ, own γ ( to_gen_heap σ))%I).
set (HeapΣ := (HeapG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
set (HeapΣ := HeapG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ)).
iExists (λ σ, own γ ( to_gen_heap σ)); iFrame.
iApply wp_fupd. iApply wp_wand_r.
iSplitL.
iPoseProof ((Hlog Hcfg HeapΣ) with "[Hcfg]") as "Hrel".
{
iFrame "Hcfg".
iApply (@logrel_binary.interp_env_nil Σ HeapΣ).
}
rewrite (empty_env_subst e). iApply ("Hrel" $! []).
{
iApply wp_fupd. iApply (wp_wand with "[-]").
- iPoseProof (Hlog _ _ with "[$Hcfg]") as "Hrel".
{ iApply (@logrel_binary.interp_env_nil Σ HeapΣ). }
rewrite (empty_env_subst e). iApply ("Hrel" $! []).
rewrite /tpool_mapsto (empty_env_subst e'). asimpl. iFrame.
}
iIntros (v'). iDestruct 1 as (v2) "[Hj #Hinterp]".
iInv specN as ">Hinv" "Hclose".
iDestruct "Hinv" as (e'' σ) "[Hown %]".
rewrite /tpool_mapsto /auth.auth_own /=.
iDestruct (own_valid_2 with "Hown Hj") as %Hvalid.
move: Hvalid=> /auth_valid_discrete_2
[/prod_included [Hv2 _] _]. apply Excl_included, leibniz_equiv in Hv2. subst.
iMod ("Hclose" with "[-]") as "_".
- iExists (#v2), σ. auto.
- iIntros "!> !%". eauto.
Qed.
- iIntros (v'). iDestruct 1 as (v2) "[Hj #Hinterp]".
iInv specN as ">Hinv" "Hclose".
iDestruct "Hinv" as (e'' σ) "[Hown %]".
rewrite /tpool_mapsto /=.
iDestruct (own_valid_2 with "Hown Hj") as %Hvalid.
move: Hvalid=> /auth_valid_discrete_2
[/prod_included [Hv2 _] _]. apply Excl_included, leibniz_equiv in Hv2. subst.
iMod ("Hclose" with "[-]") as "_".
+ iExists (#v2), σ. auto.
+ iIntros "!> !%". eauto.
Qed.
Lemma binary_soundness Σ `{heapPreG Σ, authG Σ cfgUR}
Lemma binary_soundness Σ `{heapPreG Σ, inG Σ (authR cfgUR)}
Γ e e' τ :
( f, e.[upn (length Γ) f] = e)
( f, e'.[upn (length Γ) f] = e')
( `{cfgSG Σ} `{!heapG Σ}, Γ e log e' : τ)
( `{heapG Σ, cfgSG Σ}, Γ e log e' : τ)
Γ e ctx e' : τ.
Proof.
intros He He' Hlog K thp σ v ?. eapply (basic_soundness Σ)=> ??.
......
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 soundness_binary.
From iris.program_logic Require Import adequacy.
......@@ -36,9 +37,8 @@ Definition FG_counter : expr :=
App (Rec (FG_counter_body (Var 1))) (Alloc (#n 0)).
Section CG_Counter.
Context `{cfgSG Σ}.
Context `{heapIG Σ}.
Context `{heapIG Σ, cfgSG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Implicit Types Δ : listC D.
......@@ -124,7 +124,7 @@ Section CG_Counter.
nclose specN E
spec_ctx ρ x ↦ₛ (#nv n) l ↦ₛ (#v false)
j fill K (App (CG_locked_increment (Loc x) (Loc l)) Unit)
|={E}=> j fill K Unit x ↦ₛ (#nv S n) l ↦ₛ (#v false).
={E}= j fill K Unit x ↦ₛ (#nv S n) l ↦ₛ (#v false).
Proof.
iIntros (HNE) "[#Hspec [Hx [Hl Hj]]]".
iMod (steps_with_lock
......@@ -164,7 +164,7 @@ Section CG_Counter.
nclose specN E
spec_ctx ρ x ↦ₛ (#nv n)
j fill K (App (counter_read (Loc x)) Unit)
|={E}=> j fill K (#n n) x ↦ₛ (#nv n).
={E}= j fill K (#n n) x ↦ₛ (#nv n).
Proof.
intros HNE. iIntros "[#Hspec [Hx Hj]]". unfold counter_read.
iMod (step_rec _ _ j K _ Unit with "[Hj]") as "Hj"; eauto.
......@@ -372,7 +372,7 @@ 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 (Σ := #[invΣ ; gen_heapΣ loc val ; GFunctor (authR cfgUR) ]).
set (HG := soundness_unary.HeapPreIG Σ _ _).
eapply (binary_soundness Σ _); auto.
intros. apply FG_CG_counter_refinement.
......
......@@ -58,7 +58,7 @@ Definition CG_stack : expr :=
(Alloc (Fold (InjL Unit))))) newlock).
Section CG_Stack.
Context `{cfgSG Σ}.
Context `{heapIG Σ, cfgSG Σ}.
Lemma CG_push_type st Γ τ :
typed Γ st (Tref (CG_StackType τ))
......
This diff is collapsed.
This diff is collapsed.
......@@ -4,8 +4,7 @@ From iris_logrel.F_mu_ref_conc Require Import rules_binary.
From iris.base_logic Require Export big_op.
Section bin_log_def.
Context `{cfgSG Σ}.
Context `{heapIG Σ}.
Context `{heapIG Σ, cfgSG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Definition bin_log_related (Γ : list type) (e e' : expr) (τ : type) := Δ vvs ρ,
......@@ -18,8 +17,7 @@ Notation "Γ ⊨ e '≤log≤' e' : τ" :=
(bin_log_related Γ e e' τ) (at level 74, e, e', τ at next level).
Section fundamental.
Context `{cfgSG Σ}.
Context `{heapIG Σ}.
Context `{heapIG Σ, cfgSG Σ}.
Notation D := (prodC valC valC -n> iProp Σ).
Implicit Types e : expr.
Implicit Types Δ : listC D.
......@@ -28,10 +26,9 @@ Section fundamental.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) ident(w)
constr(Hv) uconstr(Hp) :=
iApply (wp_bind [ctx]);
iApply wp_wand_l; iSplitR;
[|iApply Hp; rewrite ?fill_app /=; repeat iSplitR; trivial];
let Htmp := iFresh in
iIntros (v) Htmp; iDestruct Htmp as (w) Hv;
iApply (wp_wand with "[-]");
[iApply Hp; rewrite ?fill_app /=; iFrame "#"; trivial|];
iIntros (v); iDestruct 1 as (w) Hv;
rewrite fill_app; simpl.
Local Ltac value_case := iApply wp_value; [cbn; rewrite ?to_of_val; trivial|].
......
......@@ -14,8 +14,8 @@ Section typed_interp.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) :=
iApply (wp_bind [ctx]);
iApply wp_wand_l;
iSplitR; [|iApply Hp; trivial]; iIntros (v) Hv; cbn.
iApply (wp_wand with "[-]"); [iApply Hp; trivial|]; cbn;
iIntros (v) Hv.
Local Ltac value_case := iApply wp_value; [cbn; rewrite ?to_of_val; trivial|].
......
From iris.program_logic Require Export weakestpre.
From iris.program_logic Require Import ectx_lifting.
From iris.algebra Require Import frac agree gmap.
From iris.base_logic Require Import big_op auth.
From iris.base_logic Require Export invariants big_op.
From iris.algebra Require Import auth frac agree gmap.
From iris_logrel.F_mu_ref_conc Require Export lang.
From iris.proofmode Require Import tactics.
From iris.base_logic Require Export gen_heap.
......@@ -10,7 +10,7 @@ Import uPred.
(** The CMRA for the heap of the implementation. This is linked to the
physical heap. *)
Class heapIG Σ := HeapIG {
heapI_invG :> invG Σ;
heapI_invG : invG Σ;
heapI_gen_heapG :> gen_heapG loc val Σ;
}.
......@@ -30,7 +30,6 @@ Section lang_rules.
Implicit Types Φ : val iProp Σ.
Implicit Types σ : state.
Ltac inv_head_step :=
repeat match goal with
| _ => progress simplify_map_eq/= (* simplify memory stuff *)
......
From iris.program_logic Require Import lifting.
From iris.algebra Require Import frac agree gmap list.
From iris.base_logic Require Import big_op auth.
From iris.algebra Require Import auth frac agree gmap list.
From iris.base_logic Require Import big_op.
From iris_logrel.F_mu_ref_conc Require Export rules.
From iris.proofmode Require Import tactics.
Import uPred.
......@@ -19,15 +19,11 @@ 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 :> authG Σ cfgUR;
cfg_name : gname
}.
Class cfgSG Σ := CFGSG { cfg_inG :> inG Σ (authR cfgUR); cfg_name : gname }.
Section definitionsS.
Context `{cfgSG Σ}.
Context `{invG Σ}.
Context `{cfgSG Σ, invG Σ}.
Definition heapS_mapsto (l : loc) (q : Qp) (v: val) : iProp Σ :=
own cfg_name ( (, {[ l := (q, to_agree v) ]})).
......@@ -115,8 +111,7 @@ Section conversions.
End conversions.
Section cfg.
Context `{cfgSG Σ}.
Context `{!heapIG Σ}.
Context `{heapIG Σ, cfgSG Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val iProp Σ.
Implicit Types σ : state.
......@@ -128,7 +123,7 @@ Section cfg.
Local Hint Resolve to_tpool_insert.
Local Hint Resolve to_tpool_insert'.
Local Hint Resolve tpool_singleton_included.
Lemma step_insert K tp j e σ e' σ' efs :
tp !! j = Some (fill K e) head_step e σ e' σ' efs
step (tp, σ) (<[j:=fill K e']> tp ++ efs, σ').
......
From iris_logrel.F_mu_ref_conc Require Export context_refinement.
From iris.algebra Require Import frac agree.
From iris.algebra Require Import auth frac agree.
From iris.base_logic Require Import big_op.
From iris.base_logic Require Export auth.
From iris.proofmode Require Import tactics.
From iris.program_logic Require Import adequacy.
From iris_logrel.F_mu_ref_conc Require Import soundness_unary.
Lemma basic_soundness Σ `{heapPreIG Σ, authG Σ cfgUR}
Lemma basic_soundness Σ `{heapPreIG Σ, inG Σ (authR cfgUR)}
e e' τ v thp hp :
( `{cfgSG Σ} `{heapIG Σ}, [] e log e' : τ)
( `{heapIG Σ, cfgSG Σ}, [] e log e' : τ)
rtc step ([e], ) (of_val v :: thp, hp)
( thp' hp' v', rtc step ([e'], ) (of_val v' :: thp', hp')).
Proof.
......@@ -24,7 +23,6 @@ Proof.
set (Hcfg := CFGSG _ _ γ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 (HΣ := IrisG _ _ Hinv (λ σ, own γ ( to_gen_heap σ))%I).
set (HeapΣ := (HeapIG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
iExists (λ σ, own γ ( to_gen_heap σ)); iFrame.
iApply wp_fupd. iApply wp_wand_r.
......@@ -36,7 +34,7 @@ Proof.
{ rewrite /tpool_mapsto. asimpl. iFrame. }
iIntros (v1); iDestruct 1 as (v2) "[Hj #Hinterp]".
iInv specN as (tp σ) ">[Hown Hsteps]" "Hclose"; iDestruct "Hsteps" as %Hsteps'.
rewrite /tpool_mapsto /auth.auth_own /=.
rewrite /tpool_mapsto /=.
iDestruct (own_valid_2 with "Hown Hj") as %Hvalid.
move: Hvalid=> /auth_valid_discrete_2
[/prod_included [/tpool_singleton_included Hv2 _] _].
......@@ -45,11 +43,11 @@ Proof.
iIntros "!> !%"; eauto.
Qed.
Lemma binary_soundness Σ `{heapPreIG Σ, authG Σ cfgUR}
Lemma binary_soundness Σ `{heapPreIG Σ, inG Σ (authR cfgUR)}
Γ e e' τ :
( f, e.[upn (length Γ) f] = e)
( f, e'.[upn (length Γ) f] = e')
( `{cfgSG Σ} `{heapIG Σ}, Γ e log e' : τ)
( `{heapIG Σ, cfgSG Σ}, Γ e log e' : τ)
Γ e ctx e' : τ.
Proof.
intros He He' Hlog K thp σ v ?. eapply (basic_soundness Σ _)=> ??.
......
......@@ -9,22 +9,20 @@ Class heapPreIG Σ := HeapPreIG {
}.
Theorem soundness Σ `{heapPreIG Σ} e τ e' thp σ σ' :
( `{heapIG Σ}, log_typed [] e τ)
( `{heapIG Σ}, [] e : τ)
rtc step ([e], σ) (thp, σ') e' thp
is_Some (to_val e') reducible e' σ'.
Proof.
intros Hlog ??. cut (adequate e σ (λ _, True)); first (intros [_ ?]; eauto).
eapply (wp_adequacy Σ _).
iIntros (Hinv).
eapply (wp_adequacy Σ _). iIntros (Hinv).
iMod (own_alloc ( to_gen_heap σ)) as (γ) "Hh".
- apply (auth_auth_valid _ (to_gen_heap_valid _ _ σ)).
- iModIntro. iExists (λ σ, own γ ( to_gen_heap σ)); iFrame.
set (HΣ := IrisG _ _ Hinv (λ σ, own γ ( to_gen_heap σ))%I).
iApply wp_wand_r.
iSplitR. rewrite -(empty_env_subst e).
set (HeapΣ := (HeapIG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
{ apply (auth_auth_valid _ (to_gen_heap_valid _ _ σ)). }
iModIntro. iExists (λ σ, own γ ( to_gen_heap σ)); iFrame.
set (HeapΣ := (HeapIG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
iApply (wp_wand with "[]").
- rewrite -(empty_env_subst e).
iApply (Hlog HeapΣ [] []). iApply (@interp_env_nil _ HeapΣ).
eauto.
- eauto.
Qed.
Corollary type_soundness e τ e' thp σ σ' :
......
......@@ -2,7 +2,7 @@
This version is known to compile with:
- Coq 8.5pl2
- Coq 8.6
- Ssreflect 1.6
- Autosubst 1.5
- Iris version https://gitlab.mpi-sws.org/FP/iris-coq/commit/a7e9167
\ No newline at end of file
- Autosubst coq86-devel
- Iris 3.0 version https://gitlab.mpi-sws.org/FP/iris-coq/commit/783e8a10
......@@ -8,8 +8,7 @@ Section typed_interp.
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) constr(Hp) :=
iApply (wp_bind [ctx]);
iApply wp_wand_l;
iSplitL; [|iApply Hp; trivial]; cbn;
iApply (wp_wand with "[-]"); [iApply Hp; trivial|]; cbn;
iIntros (v) Hv.
Local Ltac value_case := iApply wp_value; cbn; rewrite ?to_of_val; trivial.
......
......@@ -2,26 +2,20 @@ From iris_logrel.stlc Require Export fundamental.
From iris.proofmode Require Import tactics.
From iris.program_logic Require Import adequacy.
Lemma wp_soundness `{irisG lang Σ} e τ :
[] ⊢ₜ e : τ (True : iProp Σ) WP e {{ τ }}.
Lemma wp_soundness `{irisG lang Σ} e τ : [] ⊢ₜ e : τ (WP e {{ τ }})%I.
Proof.
iIntros (?) "". rewrite -(empty_env_subst e). iApply fundamental; eauto.
iIntros (?). rewrite -(empty_env_subst e). iApply fundamental; eauto.
Qed.
Definition Σ := invΣ.
Theorem soundness e τ e' thp :
[] ⊢ₜ e : τ rtc step ([e], ()) (thp, ()) e' thp
is_Some (to_val e') reducible e' ().
Proof.
intros.
set (Σ := invΣ). intros.
cut (adequate e () (λ _, True)); first (intros [_ Hsafe]; eauto).
eapply (wp_adequacy Σ _). iIntros (Hinv).
iModIntro.
iExists (fun _ => True%I).
iSplitR; eauto.
set (HΣ := IrisG () _ Hinv (fun _ => True)%I).
iApply wp_wand_l.
iSplitR; [|by iApply wp_soundness]; eauto.
iModIntro. iExists (λ _, True%I). iSplit=>//.
set (HΣ := IrisG _ _ Hinv (λ _, True)%I).
iApply (wp_wand with "[]"). by iApply wp_soundness. eauto.
Qed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!