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