Commit 55f1dc10 authored by Dan Frumin's avatar Dan Frumin

Assorted modifications to the stack example

- Still does not compile
parent 9dc07689
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
From iris.proofmode Require Import tactics.
From iris_logrel.F_mu_ref_conc Require Import logrel_binary.
From iris.algebra Require Import auth gmap.
From iris.algebra Require Import gmap agree.
From iris.base_logic.lib Require Import auth.
Import uPred.
From iris.algebra Require deprecated.
Import deprecated.dec_agree.
Definition stackUR : ucmraT := gmapUR loc (dec_agreeR val).
Definition stackUR : ucmraT := gmapUR loc (agreeR valC).
Class stackG Σ :=
StackG { stack_inG :> inG Σ (authR stackUR); stack_name : gname }.
StackG { stack_inG :> authG Σ stackUR; stack_name : gname }.
Definition stack_mapsto `{stackG Σ} (l : loc) (v : val) : iProp Σ :=
own stack_name ( {[ l := DecAgree v ]}).
own stack_name ( {[ l := to_agree v ]}).
Notation "l ↦ˢᵗᵏ v" := (stack_mapsto l v) (at level 20) : uPred_scope.
......@@ -21,13 +21,24 @@ Section Rules.
Global Instance stack_mapsto_persistent l v : PersistentP (l ↦ˢᵗᵏ v).
Proof. apply _. Qed.
Lemma stack_mapstos_agree l v w : l ↦ˢᵗᵏ v l ↦ˢᵗᵏ w v = w.
(* TODO:this is bad*)
Lemma stack_mapstos_agree_uncurried l v w : l ↦ˢᵗᵏ v l ↦ˢᵗᵏ w v = w.
Proof.
rewrite -own_op -auth_frag_op op_singleton own_valid.
by iIntros ([=]%auth_own_valid%singleton_valid%dec_agree_op_inv).
rewrite -own_op -auth_frag_op op_singleton.
change (own stack_name ( {[l := to_agree v to_agree w]}))
with (auth_own stack_name {[l := to_agree v to_agree w]}).
rewrite auth_own_valid. iIntros "Hvalid". iDestruct "Hvalid" as %Hvalid.
rewrite singleton_valid in Hvalid *.
intros Hagree. by rewrite (agree_op_inv' v w Hagree).
Qed.
Lemma stack_mapstos_agree l v w : l ↦ˢᵗᵏ v - l ↦ˢᵗᵏ w - v = w.
Proof.
iIntros "??".
iApply stack_mapstos_agree_uncurried. by iFrame.
Qed.
(* stacklink Q := {((Loc l), nil) l ↦ˢᵗᵏ (InjL #()) }
{((Loc l), cons y2 z2) y1 z1, l ↦ˢᵗᵏ (y1, z1)
(y1, y2) Q
......@@ -70,31 +81,31 @@ Section Rules.
Qed.
Lemma stackR_alloc (h : stackUR) (i : loc) (v : val) :
h !! i = None h ~~> (<[i := DecAgree v]> h) {[i := DecAgree v]}.
h !! i = None h ~~> (<[i := to_agree v]> h) {[i := to_agree v]}.
Proof. intros. by apply auth_update_alloc, alloc_singleton_local_update. Qed.
Context `{heapIG Σ}.
Definition stack_owns (h : stackUR) :=
Definition stack_owns (h : stackUR) : iProp Σ :=
(own stack_name ( h)
[ map] l v h, match v with
| DecAgree v' => l ↦ᵢ v'
[ map] l v h, match agree_car v with
| v'::_ => l ↦ᵢ v'
| _ => False
end)%I.
Lemma stack_owns_alloc h l v :
stack_owns h l ↦ᵢ v == stack_owns (<[l := DecAgree v]> h) l ↦ˢᵗᵏ v.
stack_owns h l ↦ᵢ v == stack_owns (<[l := to_agree v]> h) l ↦ˢᵗᵏ v.
Proof.
iIntros "[[Hown Hall] Hl]".
iDestruct (own_valid with "Hown") as %Hvalid.
destruct (h !! l) as [av|] eqn:?.
{ iDestruct (big_sepM_lookup with "Hall") as "Hl'"; first done.
destruct av as [v'|]; last by iExFalso.
by iDestruct (@mapsto_valid_2 loc val with "[$Hl $Hl']") as %[]. }
destruct av as [[|v' av] Hav]; simpl; first by iExFalso.
by iDestruct (@mapsto_valid_2 loc val with "Hl Hl'") as %[]. }
iMod (own_update with "Hown") as "[Hown Hl']".
{ by eapply auth_update_alloc,
(alloc_singleton_local_update _ l (DecAgree v)). }
iModIntro. rewrite /stack_owns. iFrame "Hl' Hown".
(alloc_singleton_local_update _ l (to_agree v)). }
iModIntro. rewrite /stack_owns. iFrame "Hown Hl'".
iApply big_sepM_insert; simpl; try iFrame; auto.
Qed.
......@@ -102,15 +113,18 @@ Section Rules.
stack_owns h - l ↦ˢᵗᵏ v - l ↦ᵢ v (l ↦ᵢ v - stack_owns h).
Proof.
iIntros "[Howns Hls] Hl".
iDestruct (own_valid_2 with "Howns Hl")
as %[(av'&?%leibniz_equiv&Hincl)%singleton_included ?]%auth_valid_discrete_2.
iDestruct (own_valid_2 with "Howns Hl")
as %[[av' [Hl Hav']]%singleton_included ?]%auth_valid_discrete_2.
eapply leibniz_equiv in Hl.
iDestruct (big_sepM_lookup_acc with "Hls") as "[Hl' Hclose]"; first done.
destruct av' as [v'|]; last by iExFalso.
destruct av' as [[|v' av'] ?]; first by iExFalso. simpl.
assert (v = v') as <-.
{ apply Some_included in Hincl
as [[=->]%leibniz_equiv|?%DecAgree_included]; auto. }
{ apply Some_included in Hav'.
destruct Hav' as [Hav' | Hav'%agree_included]; eapply leibniz_equiv in Hav'.
- by inversion Hav'.
- by inversion Hav'. }
iIntros "{$Hl'} Hl'". rewrite /stack_owns. iFrame "Howns". by iApply "Hclose".
Qed.
Admitted.
Lemma stack_owns_later_open_close h l v :
stack_owns h - l ↦ˢᵗᵏ v - (l ↦ᵢ v (l ↦ᵢ v - stack_owns h)).
......
......@@ -3,13 +3,13 @@ From iris_logrel.F_mu_ref_conc Require Import rules.
From iris.base_logic Require Export big_op invariants.
From iris.proofmode Require Import tactics.
Definition log_typed `{heapIG Σ} (Γ : list type) (e : expr) (τ : type) := Δ vs,
Definition log_typed `{heapG Σ} (Γ : list type) (e : expr) (τ : type) := Δ vs,
env_PersistentP Δ
Γ * Δ vs τ ⟧ₑ Δ e.[env_subst vs].
Notation "Γ ⊨ e : τ" := (log_typed Γ e τ) (at level 74, e, τ at next level).
Section typed_interp.
Context `{heapIG Σ}.
Context `{heapG Σ}.
Notation D := (valC -n> iProp Σ).
Local Tactic Notation "smart_wp_bind" uconstr(ctx) ident(v) constr(Hv) uconstr(Hp) :=
......
......@@ -9,7 +9,7 @@ Definition logN : namespace := nroot .@ "logN".
(** interp : is a unary logical relation. *)
Section logrel.
Context `{heapIG Σ}.
Context `{heapG Σ}.
Notation D := (valC -n> iProp Σ).
Implicit Types τi : D.
Implicit Types Δ : listC D.
......
......@@ -9,7 +9,7 @@ Class heapPreIG Σ := HeapPreIG {
}.
Theorem soundness Σ `{heapPreIG Σ} e τ e' thp σ σ' :
( `{heapIG Σ}, [] e : τ)
( `{heapG Σ}, [] e : τ)
rtc step ([e], σ) (thp, σ') e' thp
is_Some (to_val e') reducible e' σ'.
Proof.
......
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