Commit 5fc8c715 authored by Aleš Bizjak's avatar Aleš Bizjak

Add concurrent stacks with helping case study by Danny.

Fix #5.
parent 85d365c5
Pipeline #6308 passed with stage
in 6 minutes and 20 seconds
......@@ -53,6 +53,8 @@ This repository contains the following case studies:
concurrent stack implementations
* [spanning-tree](theories/spanning_tree): Proof of a concurrent spanning tree
algorithm.
* [concurrent-stacks](theories/concurrent_stacks): Proof of an implementation of
concurrent stacks with helping, as described in the [report](http://iris-project.org/pdfs/2017-case-study-concurrent-stacks-with-helping.pdf).
* [lecture-notes](theories/lecture_notes): Coq examples for the
[Iris lecture notes](http://iris-project.org/tutorial-material.html).
......
From iris.base_logic Require Import base_logic.
From iris.proofmode Require Import tactics.
From iris.base_logic.lib Require Import invariants.
From iris.program_logic Require Export weakestpre hoare.
From iris.heap_lang Require Export lang.
From iris.algebra Require Import agree list.
From iris.heap_lang Require Import assert proofmode notation.
Set Default Proof Using "Type".
Definition mk_stack : val :=
λ: "_",
let: "r" := ref NONEV in
(rec: "pop" "n" :=
match: !"r" with
NONE => #-1
| SOME "hd" =>
if: CAS "r" (SOME "hd") (Snd "hd")
then Fst "hd"
else "pop" "n"
end,
rec: "push" "n" :=
let: "r'" := !"r" in
let: "r''" := SOME ("n", "r'") in
if: CAS "r" "r'" "r''"
then #()
else "push" "n").
Section stacks.
Context `{!heapG Σ}.
Implicit Types l : loc.
Definition is_stack_pre (P : val iProp Σ) (F : val -c> iProp Σ) :
val -c> iProp Σ := λ v,
(v NONEV (h t : val), v SOMEV (h, t)%V P h F t)%I.
Local Instance is_stack_contr (P : val iProp Σ): Contractive (is_stack_pre P).
Proof.
rewrite /is_stack_pre => n f f' Hf v.
repeat (f_contractive || f_equiv).
apply Hf.
Qed.
Definition is_stack_def (P : val -> iProp Σ) := fixpoint (is_stack_pre P).
Definition is_stack_aux P : seal (@is_stack_def P). by eexists. Qed.
Definition is_stack P := unseal (is_stack_aux P).
Definition is_stack_eq P : @is_stack P = @is_stack_def P := seal_eq (is_stack_aux P).
Definition stack_inv P v :=
( l v', v = #l l v' is_stack P v')%I.
Lemma is_stack_unfold (P : val iProp Σ) v :
is_stack P v ⊣⊢ is_stack_pre P (is_stack P) v.
Proof.
rewrite is_stack_eq. apply (fixpoint_unfold (is_stack_pre P)).
Qed.
Lemma is_stack_disj (P : val iProp Σ) v :
is_stack P v - is_stack P v (v NONEV (h t : val), v SOMEV (h, t)%V).
Proof.
iIntros "Hstack".
iDestruct (is_stack_unfold with "Hstack") as "[#Hstack|Hstack]".
- iSplit; try iApply is_stack_unfold; iLeft; auto.
- iDestruct "Hstack" as (h t) "[#Heq rest]".
iSplitL; try iApply is_stack_unfold; iRight; auto.
Qed.
Theorem stack_works P Φ :
( (f f : val),
( (v : val), WP f #() {{ v, P v v #-1 }})
- ( (v : val), (P v - WP f v {{ v, True }}))
- Φ (f, f)%V)%I
- WP mk_stack #() {{ Φ }}.
Proof.
iIntros "HΦ".
wp_lam.
wp_alloc l as "Hl".
pose proof (nroot .@ "N") as N.
rewrite -wp_fupd.
iMod (inv_alloc N _ (stack_inv P #l) with "[Hl]") as "#Hisstack".
iExists l, NONEV; iSplit; iFrame; auto.
{ iApply is_stack_unfold. iLeft; auto. }
wp_let.
iModIntro.
iApply "HΦ".
- iIntros (v) "!#".
iLöb as "IH".
wp_rec.
wp_bind (! #l)%E.
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l' v') "[>% [Hl' Hstack]]".
injection H; intros; subst.
wp_load.
iDestruct (is_stack_disj with "Hstack") as "[Hstack #Heq]".
iMod ("Hclose" with "[Hl' Hstack]").
iExists l', v'; iFrame; auto.
iModIntro.
iDestruct "Heq" as "[H | H]".
+ iRewrite "H".
wp_match.
iRight; auto.
+ iDestruct "H" as (h t) "H".
iRewrite "H".
assert (to_val (h, t)%V = Some (h, t)%V) by apply to_of_val.
assert (is_Some (to_val (h, t)%V)) by (exists (h, t)%V; auto).
wp_match. fold of_val.
unfold subst; simpl; fold subst.
wp_bind (CAS _ _ _).
wp_proj.
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l'' v'') "[>% [Hl'' Hstack]]".
injection H2; intros; subst.
assert (Decision (v'' = InjRV (h, t)%V)) as Heq by apply val_eq_dec.
destruct Heq.
* wp_cas_suc.
iDestruct (is_stack_unfold with "Hstack") as "[Hstack | Hstack]".
subst.
iDestruct "Hstack" as "%"; discriminate.
iDestruct "Hstack" as (h' t') "[% [HP Hstack]]".
subst.
injection H3.
intros.
subst.
iMod ("Hclose" with "[Hl'' Hstack]").
iExists l'', t'; iFrame; auto.
iModIntro.
wp_if.
wp_proj.
iLeft; auto.
* wp_cas_fail.
iMod ("Hclose" with "[Hl'' Hstack]").
iExists l'', v''; iFrame; auto.
iModIntro.
wp_if.
iApply "IH".
- iIntros (v) "!# HP".
iLöb as "IH".
wp_rec.
wp_bind (! _)%E.
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l' v') "[>% [Hl' Hstack]]".
injection H; intros; subst.
wp_load.
iMod ("Hclose" with "[Hl' Hstack]").
by (iExists l', v'; iFrame).
iModIntro.
wp_let.
wp_let.
wp_bind (CAS _ _ _).
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l'' v'') "[>% [Hl'' Hstack]]".
injection H0; intros; subst.
assert (Decision (v'' = v'%V)) as Heq by apply val_eq_dec.
destruct Heq.
+ wp_cas_suc.
iMod ("Hclose" with "[Hl'' HP Hstack]").
iExists l'', (InjRV (v, v')%V).
iFrame; auto.
iSplit; auto.
iApply is_stack_unfold.
iRight.
iExists v, v'.
iSplit; auto.
subst; iFrame.
iModIntro.
wp_if.
done.
+ wp_cas_fail.
iMod ("Hclose" with "[Hl'' Hstack]").
iExists l'', v''; iFrame; auto.
iModIntro.
wp_if.
iApply "IH".
done.
Qed.
End stacks.
This diff is collapsed.
From iris.program_logic Require Export weakestpre hoare.
From iris.heap_lang Require Export lang proofmode notation.
From iris.algebra Require Import excl.
Set Default Proof Using "Type".
Definition mk_stack : val :=
λ: "_",
let: "r" := ref NONEV in
(rec: "pop" "n" :=
(match: !"r" with
NONE => NONE
| SOME "hd" =>
if: CAS "r" (SOME "hd") (Snd "hd")
then SOME (Fst "hd")
else "pop" "n"
end),
rec: "push" "n" :=
let: "r'" := !"r" in
let: "r''" := SOME ("n", "r'") in
if: CAS "r" "r'" "r''"
then #()
else "push" "n").
Section stack_works.
Context `{!heapG Σ}.
Implicit Types l : loc.
Fixpoint is_stack xs v : iProp Σ :=
(match xs with
| [] => v = NONEV
| x :: xs => (t : val), v = SOMEV (x, t)%V is_stack xs t
end)%I.
Definition stack_inv P v :=
( l v' xs, v = #l l v' is_stack xs v' P xs)%I.
Lemma is_stack_disj xs v :
is_stack xs v - is_stack xs v (v = NONEV (h t : val), v = SOMEV (h, t)%V).
Proof.
iIntros "Hstack".
destruct xs.
- iSplit; try iLeft; auto.
- iSplit; auto; iRight; iDestruct "Hstack" as (t) "[% Hstack]";
iExists v0, t; auto.
Qed.
Lemma is_stack_uniq : xs ys v,
is_stack xs v is_stack ys v - xs = ys.
Proof.
induction xs, ys; iIntros (v') "[Hstack1 Hstack2]"; auto.
- iDestruct "Hstack1" as "%".
iDestruct "Hstack2" as (t) "[% Hstack2]".
subst.
discriminate.
- iDestruct "Hstack2" as "%".
iDestruct "Hstack1" as (t) "[% Hstack1]".
subst.
discriminate.
- iDestruct "Hstack1" as (t) "[% Hstack1]".
iDestruct "Hstack2" as (t') "[% Hstack2]".
subst; injection H0; intros; subst.
iDestruct (IHxs with "[Hstack1 Hstack2]") as "%".
by iSplitL "Hstack1".
subst; auto.
Qed.
Lemma is_stack_empty : xs,
is_stack xs (InjLV #()) - xs = [].
Proof.
iIntros (xs) "Hstack".
destruct xs; auto.
iDestruct "Hstack" as (t) "[% rest]".
discriminate.
Qed.
Lemma is_stack_cons : xs h t,
is_stack xs (InjRV (h, t)%V) -
is_stack xs (InjRV (h, t)%V) ys, xs = h :: ys.
Proof.
destruct xs; iIntros (h t) "Hstack".
- iDestruct "Hstack" as "%"; discriminate.
- iSplit; [auto | iExists xs].
iDestruct "Hstack" as (t') "[% Hstack]".
injection H; intros; subst; auto.
Qed.
Theorem stack_works P Q Q' Q'' Φ :
( (f f : val) ι,
((( v vs, P (v :: vs) ={⊤∖↑ι}= Q v P vs) -
(P [] ={⊤∖↑ι}= Q' P []) -
WP f #() {{ v, ( (v' : val), v SOMEV v' Q v') (v NONEV Q')}}))
- ( (v : val),
(( vs, P vs ={⊤∖↑ι}= P (v :: vs) Q'') -
WP f v {{ v, Q'' }}))
- Φ (f, f)%V)%I
- P []
- WP mk_stack #() {{ Φ }}.
Proof.
iIntros "HΦ HP".
pose proof (nroot .@ "N") as N.
wp_let.
wp_alloc l as "Hl".
iMod (inv_alloc N _ (stack_inv P #l) with "[Hl HP]") as "#Istack".
{ iNext; iExists l, (InjLV #()), []; iSplit; iFrame; auto. }
wp_let.
iApply "HΦ".
- iIntros "!# Hsucc Hfail".
iLöb as "IH".
wp_rec.
wp_bind (! _)%E.
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l' v' xs) "[>% [Hl' [Hstack HP]]]".
injection H; intros; subst.
wp_load.
iDestruct (is_stack_disj with "[Hstack]") as "[Hstack H]"; auto.
iDestruct "H" as "[% | H]".
* subst.
iDestruct (is_stack_empty with "Hstack") as "%".
subst.
iMod ("Hfail" with "HP") as "[HQ' HP]".
iMod ("Hclose" with "[Hl' Hstack HP]").
{ iExists l', (InjLV #()), []; iSplit; iFrame; auto. }
iModIntro.
wp_match.
iRight; auto.
* iDestruct "H" as (h t) "%".
subst.
iMod ("Hclose" with "[Hl' Hstack HP]").
{ iExists l', (InjRV (h, t)), xs; iSplit; iFrame; auto. }
iModIntro.
assert (to_val (h, t)%V = Some (h, t)%V) by apply to_of_val.
assert (is_Some (to_val (h, t)%V)) by (exists (h, t)%V; auto).
wp_match.
unfold subst; simpl; fold of_val.
wp_proj.
wp_bind (CAS _ _ _).
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l'' v' ys) "[>% [Hl'' [Hstack HP]]]".
injection H2; intros; subst.
assert (Decision (v' = InjRV (h, t)%V)) as Heq by apply val_eq_dec.
destruct Heq.
+ wp_cas_suc.
subst.
iDestruct (is_stack_cons with "Hstack") as "[Hstack H]".
iDestruct "H" as (ys') "%"; subst.
iDestruct "Hstack" as (t') "[% Hstack]".
injection H3; intros; subst.
iDestruct ("Hsucc" with "[HP]") as "> [HQ HP]"; auto.
iMod ("Hclose" with "[Hl'' Hstack HP]").
{ iExists l'', t', ys'; iSplit; iFrame; auto. }
iModIntro.
wp_if.
wp_proj.
iLeft; iExists h; auto.
+ wp_cas_fail.
iMod ("Hclose" with "[Hl'' Hstack HP]").
{ iExists l'', v', ys; iSplit; iFrame; auto. }
iModIntro.
wp_if.
iApply ("IH" with "Hsucc Hfail").
- iIntros (v) "!# Hpush".
iLöb as "IH".
wp_rec.
wp_bind (! _)%E.
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l' v' ys) "[>% [Hl' [Hstack HP]]]".
injection H; intros; subst.
wp_load.
iMod ("Hclose" with "[Hl' Hstack HP]").
{ iExists l', v', ys; iSplit; iFrame; auto. }
iModIntro.
wp_let.
wp_let.
wp_bind (CAS _ _ _).
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l'' v'' xs) "[>% [Hl'' [Hstack HP]]]".
injection H0; intros; subst.
assert (Decision (v' = v''%V)) as Heq by apply val_eq_dec.
destruct Heq.
+ wp_cas_suc.
iDestruct ("Hpush" with "[HP]") as "> [HP HQ]"; auto.
iMod ("Hclose" with "[Hl'' Hstack HP]").
{ iExists l'', (InjRV (v, v')), (v :: xs); iSplit; iFrame; auto.
iExists v'; iSplit; subst; auto. }
iModIntro.
wp_if.
done.
+ wp_cas_fail.
iMod ("Hclose" with "[Hl'' Hstack HP]").
{ iExists l'', v'', xs; iSplit; iFrame; auto. }
iModIntro.
wp_if.
iApply ("IH" with "Hpush").
Qed.
End stack_works.
This diff is collapsed.
  • Could we have some documentation (like, comments in the code -- which this is generally lacking) for why there are 4 stacks?

  • I believe the report which is linked in the README makes the 4 versions clear.

    With regards to comments I would agree, but I do not have the time to write them. In any case, other files in this repository have the same amount of comments, so I don't see why this one should be an exception.

  • That report was indeed very helpful, sorry for not looking at it before asking. I added a few comments concerning the basic structure of the files, and some remarks based on meditating over the specs a little.

    I may have some more questions, but I think that's easier done via email.

  • Also, I just noticed you forget to add these files to _CoqProject, so they were not actually built (e.g. by the CI). The files are still compatible with current Iris though :)

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