Commit 77a45515 authored by Ralf Jung's avatar Ralf Jung

bump Iris: update to stronger CAS requirements

parent 2645095c
Pipeline #10491 passed with stage
in 13 minutes and 48 seconds
......@@ -24,9 +24,9 @@ theories/spanning_tree/spanning.v
theories/spanning_tree/proof.v
theories/concurrent_stacks/concurrent_stack1.v
theories/concurrent_stacks/concurrent_stack2.v
#theories/concurrent_stacks/concurrent_stack2.v
theories/concurrent_stacks/concurrent_stack3.v
theories/concurrent_stacks/concurrent_stack4.v
#theories/concurrent_stacks/concurrent_stack4.v
theories/concurrent_stacks/spec.v
theories/logrel/prelude/base.v
......
......@@ -9,6 +9,6 @@ build: [make "-j%{jobs}%"]
install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris_examples"]
depends: [
"coq-iris" { (= "branch.gen_proofmode.2018-06-26.1.46cb853d") | (= "dev") }
"coq-iris" { (= "branch.gen_proofmode.2018-07-03.0.4c3f5b17") | (= "dev") }
"coq-autosubst" { = "dev.coq86" }
]
......@@ -16,13 +16,13 @@ Definition mk_stack : val :=
match: !"r" with
NONE => #-1
| SOME "hd" =>
if: CAS "r" (SOME "hd") (Snd "hd")
then Fst "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
let: "r''" := SOME (Alloc ("n", "r'")) in
if: CAS "r" "r'" "r''"
then #()
else "push" "n").
......@@ -31,9 +31,20 @@ 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.
Definition oloc_to_val (h : option loc) : val :=
match h with
| None => NONEV
| Some l => SOMEV #l
end.
Local Instance oloc_to_val_inj : Inj (=) (=) oloc_to_val.
Proof. rewrite /Inj /oloc_to_val=>??. repeat case_match; congruence. Qed.
Definition is_stack_pre (P : val iProp Σ) (F : option loc -c> iProp Σ) :
option loc -c> iProp Σ := λ v,
(match v with
| None => True
| Some l => q h t, l {q} (h, oloc_to_val t) P h F t
end)%I.
Local Instance is_stack_contr (P : val iProp Σ): Contractive (is_stack_pre P).
Proof.
......@@ -47,8 +58,8 @@ Section stacks.
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.
Definition stack_inv P l :=
( ol, l oloc_to_val ol is_stack P ol)%I.
Lemma is_stack_unfold (P : val iProp Σ) v :
......@@ -57,14 +68,15 @@ Section stacks.
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).
Lemma is_stack_copy (P : val iProp Σ) ol :
is_stack P ol - is_stack P ol
(match ol with None => True | Some l => q h t, l {q} (h, oloc_to_val t) end).
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.
iDestruct (is_stack_unfold with "Hstack") as "Hstack". destruct ol; last first.
- iSplitL; try iApply is_stack_unfold; auto.
- iDestruct "Hstack" as (q h t) "[[Hl1 Hl2] [HP Hrest]]".
iSplitR "Hl2"; try iApply is_stack_unfold; simpl; eauto 10 with iFrame.
Qed.
(* Per-element invariant (i.e., bag spec). *)
......@@ -80,9 +92,9 @@ Section stacks.
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. }
iMod (inv_alloc N _ (stack_inv P l) with "[Hl]") as "#Hisstack".
{ iExists None; iFrame; auto.
iApply is_stack_unfold. auto. }
wp_let.
iModIntro.
iApply "HΦ".
......@@ -91,48 +103,36 @@ Section stacks.
wp_rec.
wp_bind (! #l)%E.
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l' v') "[>% [Hl' Hstack]]".
injection H; intros; subst.
iDestruct "Hstack" as (v') "[Hl' Hstack]".
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.
destruct v' as [l'|]; simpl; last first.
+ iMod ("Hclose" with "[Hl' Hstack]") as "_".
{ rewrite /stack_inv. eauto with iFrame. }
iModIntro. wp_match. by iRight.
+ iDestruct (is_stack_copy with "Hstack") as "[Hstack Hmy]".
iDestruct "Hmy" as (q h t) "Hl".
iMod ("Hclose" with "[Hl' Hstack]") as "_".
{ rewrite /stack_inv. eauto with iFrame. }
iModIntro. wp_match.
wp_load. wp_proj.
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.
iDestruct "Hstack" as (v'') "[Hl'' Hstack]".
destruct (decide (oloc_to_val v'' = oloc_to_val (Some l'))) as [->%oloc_to_val_inj|Hne].
* simpl. wp_cas_suc.
iDestruct (is_stack_unfold with "Hstack") as "Hstack".
iDestruct "Hstack" as (q' h' t') "[Hl' [HP Hstack]]".
iDestruct (mapsto_agree with "Hl Hl'") as %[= <- <-%oloc_to_val_inj].
iMod ("Hclose" with "[Hl'' Hstack]").
iExists l'', t'; iFrame; auto.
{ iExists _. auto with iFrame. }
iModIntro.
wp_if.
wp_load.
wp_proj.
iLeft; auto.
* wp_cas_fail.
* simpl in Hne. wp_cas_fail.
iMod ("Hclose" with "[Hl'' Hstack]").
iExists l'', v''; iFrame; auto.
{ iExists v''; iFrame; auto. }
iModIntro.
wp_if.
iApply "IH".
......@@ -141,36 +141,31 @@ Section stacks.
wp_rec.
wp_bind (! _)%E.
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l' v') "[>% [Hl' Hstack]]".
injection H; intros; subst.
iDestruct "Hstack" as (v') "[Hl' Hstack]".
wp_load.
iMod ("Hclose" with "[Hl' Hstack]").
by (iExists l', v'; iFrame).
{ iExists v'. iFrame. }
iModIntro.
wp_let.
wp_alloc r'' as "Hr''".
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).
iDestruct "Hstack" as (v'') "[Hl'' Hstack]".
wp_cas as ->%oloc_to_val_inj|_.
+ destruct v'; by right.
+ iMod ("Hclose" with "[Hl'' Hr'' HP Hstack]").
iExists (Some r'').
iFrame; auto.
iSplit; auto.
iNext.
iApply is_stack_unfold.
iRight.
iExists v, v'.
iSplit; auto.
subst; iFrame.
simpl.
iExists _, _, v'. iFrame.
iModIntro.
wp_if.
done.
+ wp_cas_fail.
iMod ("Hclose" with "[Hl'' Hstack]").
iExists l'', v''; iFrame; auto.
+ iMod ("Hclose" with "[Hl'' Hstack]").
iExists v''; iFrame; auto.
iModIntro.
wp_if.
iApply "IH".
......
(** THIS FILE CURRENTLY DOES NOT COMPILE because it has not been ported to the
stricter CAS requirements yet. *)
From iris.program_logic Require Export weakestpre hoare.
From iris.heap_lang Require Export lang proofmode notation.
From iris.algebra Require Import excl.
......
......@@ -14,13 +14,13 @@ Definition mk_stack : val :=
(match: !"r" with
NONE => NONE
| SOME "hd" =>
if: CAS "r" (SOME "hd") (Snd "hd")
then SOME (Fst "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
let: "r''" := SOME (Alloc ("n", "r'")) in
if: CAS "r" "r'" "r''"
then #()
else "push" "n").
......@@ -32,20 +32,27 @@ Section stack_works.
Fixpoint is_stack xs v : iProp Σ :=
(match xs with
| [] => v = NONEV
| x :: xs => (t : val), v = SOMEV (x, t)%V is_stack xs t
| x :: xs => q (l : loc) (t : val), v = SOMEV #l l {q} (x, t) 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).
is_stack xs v - is_stack xs v (v = NONEV q (l : loc) (h t : val), v = SOMEV #l l {q} (h, t)).
Proof.
iIntros "Hstack".
destruct xs.
- iSplit; try iLeft; auto.
- iSplit; auto; iRight; iDestruct "Hstack" as (t) "[% Hstack]";
iExists v0, t; auto.
- simpl. iDestruct "Hstack" as (q l t) "[-> [[Hl Hl'] Hstack]]".
iSplitR "Hl"; eauto 10 with iFrame.
Qed.
Lemma is_stack_unboxed xs v :
is_stack xs v - val_is_unboxed v.
Proof.
iIntros "Hstack". iDestruct (is_stack_disj with "Hstack") as "[_ [->|Hdisj]]".
- done.
- iDestruct "Hdisj" as (???? ->) "_". done.
Qed.
Lemma is_stack_uniq : xs ys v,
......@@ -53,38 +60,38 @@ Section stack_works.
Proof.
induction xs, ys; iIntros (v') "[Hstack1 Hstack2]"; auto.
- iDestruct "Hstack1" as "%".
iDestruct "Hstack2" as (t) "[% Hstack2]".
iDestruct "Hstack2" as (???) "[% _]".
subst.
discriminate.
- iDestruct "Hstack2" as "%".
iDestruct "Hstack1" as (t) "[% Hstack1]".
iDestruct "Hstack1" as (???) "[% _]".
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".
- simpl. iDestruct "Hstack1" as (q1 l1 t) "[% [Hl1 Hstack1]]".
iDestruct "Hstack2" as (q2 l2 t') "[% [Hl2 Hstack2]]".
subst; injection H0; intros; subst; clear H0.
iDestruct (mapsto_agree with "Hl1 Hl2") as %[= -> ->].
iDestruct (IHxs with "[Hstack1 Hstack2]") as "%". by iFrame.
subst; auto.
Qed.
Lemma is_stack_empty : xs,
is_stack xs (InjLV #()) - xs = [].
is_stack xs NONEV - xs = [].
Proof.
iIntros (xs) "Hstack".
destruct xs; auto.
iDestruct "Hstack" as (t) "[% rest]".
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.
Lemma is_stack_cons : xs l,
is_stack xs (SOMEV #l) -
is_stack xs (SOMEV #l) q h t ys, xs = h :: ys l {q} (h, t).
Proof.
destruct xs; iIntros (h t) "Hstack".
iIntros ([|x xs] l) "Hstack".
- iDestruct "Hstack" as "%"; discriminate.
- iSplit; [auto | iExists xs].
iDestruct "Hstack" as (t') "[% Hstack]".
injection H; intros; subst; auto.
- simpl. iDestruct "Hstack" as (q l' t') "[% [[Hl Hl'] Hstack]]".
injection H; intros; subst; clear H.
iSplitR "Hl'"; eauto 10 with iFrame.
Qed.
(* Whole-stack invariant (P). However:
......@@ -117,7 +124,7 @@ Section stack_works.
wp_bind (! _)%E.
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l' v' xs) "[>% [Hl' [Hstack HP]]]".
injection H; intros; subst.
injection H; intros; subst; clear H.
wp_load.
iDestruct (is_stack_disj with "[Hstack]") as "[Hstack H]"; auto.
iDestruct "H" as "[% | H]".
......@@ -131,10 +138,10 @@ Section stack_works.
iModIntro.
wp_match.
iRight; auto.
* iDestruct "H" as (h t) "%".
* iDestruct "H" as (q l h t) "[% Hl]".
subst.
iMod ("Hclose" with "[Hl' Hstack HP]").
{ iExists l', (InjRV (h, t)), xs; iSplit; iFrame; auto. }
{ iExists l', _, xs; iSplit; iFrame; auto. }
iModIntro.
assert (to_val (h, t)%V = Some (h, t)%V) by apply to_of_val.
......@@ -142,27 +149,29 @@ Section stack_works.
wp_match.
unfold subst; simpl; fold of_val.
wp_load.
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.
injection H1; intros; subst; clear H1.
assert (Decision (v' = InjRV #l%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.
+ subst.
wp_cas_suc. destruct ys as [|y ys]; simpl.
{ iDestruct "Hstack" as %?. done. }
iDestruct "Hstack" as (q'' l' t'') "[% [Hl' Hstack]]".
injection H1; intros; subst; clear H1.
iDestruct "Hcont" as "[Hsucc _]".
iDestruct ("Hsucc" with "[HP]") as "> [HQ HP]"; auto.
iMod ("Hclose" with "[Hl'' Hstack HP]").
{ iExists l'', t', ys'; iSplit; iFrame; auto. }
iDestruct (mapsto_agree with "Hl Hl'") as %[= -> ->].
iMod ("Hclose" with "[Hl'' Hl' Hstack HP]").
{ iExists l''. eauto 10 with iFrame. }
iModIntro.
wp_if.
wp_load.
wp_proj.
iLeft; iExists h; auto.
iLeft; iExists _; auto.
+ wp_cas_fail.
iMod ("Hclose" with "[Hl'' Hstack HP]").
{ iExists l'', v', ys; iSplit; iFrame; auto. }
......@@ -175,24 +184,25 @@ Section stack_works.
wp_bind (! _)%E.
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l' v' ys) "[>% [Hl' [Hstack HP]]]".
injection H; intros; subst.
injection H; intros; subst; clear H.
wp_load.
iMod ("Hclose" with "[Hl' Hstack HP]").
{ iExists l', v', ys; iSplit; iFrame; auto. }
iModIntro.
wp_let.
wp_alloc lp as "Hlp".
wp_let.
wp_bind (CAS _ _ _).
iInv N as "Hstack" "Hclose".
iDestruct "Hstack" as (l'' v'' xs) "[>% [Hl'' [Hstack HP]]]".
injection H0; intros; subst.
injection H; intros; subst; clear H.
iDestruct (is_stack_unboxed with "Hstack") as "#>%".
assert (Decision (v' = v''%V)) as Heq by apply val_eq_dec.
destruct Heq.
+ wp_cas_suc.
+ subst. 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. }
iMod ("Hclose" with "[Hl'' Hlp Hstack HP]").
{ iExists l'', _, _. iFrame. simpl. eauto 10 with iFrame. }
iModIntro.
wp_if.
done.
......
(** THIS FILE CURRENTLY DOES NOT COMPILE because it has not been ported to the
stricter CAS requirements yet. *)
From iris.program_logic Require Export weakestpre hoare.
From iris.heap_lang Require Export lang proofmode notation.
From iris.algebra Require Import excl.
......
......@@ -56,6 +56,14 @@ Section proof.
hd = SOMEV #l rown l (x, tl) is_list tl xs)%I
end.
Lemma is_list_unboxed hd xs :
is_list hd xs - val_is_unboxed hd.
Proof.
destruct xs.
- iIntros (->). done.
- iIntros "Hl". iDestruct "Hl" as (?? ->) "_". done.
Qed.
Lemma is_list_duplicate hd xs : is_list hd xs - is_list hd xs is_list hd xs.
Proof.
iInduction xs as [ | x xs ] "IH" forall (hd); simpl; eauto.
......@@ -155,6 +163,7 @@ Section proof.
wp_alloc n as "Hn".
wp_bind (CAS _ _ _).
iInv N as (o' ls) "[Ho [Hls >Hb]]" "Hcl".
iPoseProof (is_list_unboxed with "Hls") as "#>%".
destruct (decide (o = o')) as [->|?].
- wp_cas_suc.
iMod ("Hvs" with "[$Hb $HP]") as "[Hb HQ]".
......
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