Commit de0c6689 authored by Hai Dang's avatar Hai Dang

Merge branch 'master' into hai/auth_frac

parents b8172744 3e8fcd4c
*.v gitlab-language=coq
......@@ -30,7 +30,6 @@ build-coq.8.8.2:
<<: *template
variables:
OPAM_PINS: "coq version 8.8.2"
TIMING_PROJECT: "iris-examples"
TIMING_CONF: "coq-8.8.2"
tags:
- fp-timing
......
......@@ -8,7 +8,7 @@ all: Makefile.coq
clean: Makefile.coq
+@make -f Makefile.coq clean
find theories $$(test -d tests && echo tests) \( -name "*.d" -o -name "*.vo" -o -name "*.aux" -o -name "*.cache" -o -name "*.glob" -o -name "*.vio" \) -print -delete
find theories tests \( -name "*.d" -o -name "*.vo" -o -name "*.aux" -o -name "*.cache" -o -name "*.glob" -o -name "*.vio" \) -print -delete || true
rm -f Makefile.coq
.PHONY: clean
......
......@@ -23,11 +23,11 @@ theories/spanning_tree/mon.v
theories/spanning_tree/spanning.v
theories/spanning_tree/proof.v
theories/concurrent_stacks/specs.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/spec.v
theories/concurrent_stacks/concurrent_stack4.v
theories/logrel/prelude/base.v
theories/logrel/stlc/lang.v
......@@ -87,6 +87,7 @@ theories/hocap/concurrent_runners.v
theories/hocap/parfib.v
theories/logatom/treiber.v
theories/logatom/treiber2.v
theories/logatom/elimination_stack/hocap_spec.v
theories/logatom/elimination_stack/stack.v
theories/logatom/elimination_stack/spec.v
......
......@@ -9,6 +9,6 @@ build: [make "-j%{jobs}%"]
install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris_examples"]
depends: [
"coq-iris" { (= "dev.2019-01-27.0.9896799d") | (= "dev") }
"coq-iris" { (= "dev.2019-04-17.0.60d28bbb") | (= "dev") }
"coq-autosubst" { = "dev.coq86" }
]
......@@ -41,8 +41,8 @@ Section client.
Proof.
iIntros ""; rewrite /client. wp_alloc y as "Hy". wp_let.
wp_apply (newbarrier_spec N (y_inv 1 y) with "[//]").
iIntros (l) "[Hr Hs]". wp_let.
iApply (wp_par (λ _, True%I) (λ _, True%I) with "[Hy Hs] [Hr]"); last auto.
iIntros (l) "[Hr Hs]".
wp_apply (wp_par (λ _, True%I) (λ _, True%I) with "[Hy Hs] [Hr]"); last auto.
- (* The original thread, the sender. *)
wp_store. iApply (signal_spec with "[-]"); last by iNext; auto.
iSplitR "Hy"; first by eauto.
......@@ -51,7 +51,7 @@ Section client.
iDestruct (recv_weaken with "[] Hr") as "Hr".
{ iIntros "Hy". by iApply (y_inv_split with "Hy"). }
iMod (recv_split with "Hr") as "[H1 H2]"; first done.
iApply (wp_par (λ _, True%I) (λ _, True%I) with "[H1] [H2]"); last auto.
wp_apply (wp_par (λ _, True%I) (λ _, True%I) with "[H1] [H2]"); last auto.
+ by iApply worker_safe.
+ by iApply worker_safe.
Qed.
......
......@@ -122,7 +122,7 @@ Proof.
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
destruct p; [|done]. wp_store.
iSpecialize ("HΦ" with "[#]") => //. iFrame "HΦ".
iMod ("Hclose" $! (State High I) ( : set token) with "[-]"); last done.
iMod ("Hclose" $! (State High I) ( : propset token) with "[-]"); last done.
iSplit; [iPureIntro; by eauto using signal_step|].
rewrite /barrier_inv /ress /=. iNext. iFrame "Hl".
iDestruct "Hr" as (Ψ) "[Hr Hsp]"; iExists Ψ; iFrame "Hsp".
......@@ -165,8 +165,8 @@ Proof.
iIntros (?). iDestruct 1 as (γ P Q i) "(#Hsts & Hγ & #HQ & HQR)".
iMod (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]")
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
iMod (saved_prop_alloc_strong I) as (i1) "[% #Hi1]".
iMod (saved_prop_alloc_strong (I {[i1]}))
iMod (saved_prop_alloc_cofinite I) as (i1) "[% #Hi1]".
iMod (saved_prop_alloc_cofinite (I {[i1]}))
as (i2) "[Hi2' #Hi2]"; iDestruct "Hi2'" as %Hi2.
rewrite ->not_elem_of_union, elem_of_singleton in Hi2; destruct Hi2.
iMod ("Hclose" $! (State p ({[i1; i2]} I {[i]}))
......
......@@ -19,7 +19,7 @@ Inductive prim_step : relation state :=
| ChangeI p I2 I1 : prim_step (State p I1) (State p I2)
| ChangePhase I : prim_step (State Low I) (State High I).
Definition tok (s : state) : set token :=
Definition tok (s : state) : propset token :=
{[ t | i, t = Change i i state_I s ]}
(if state_phase s is High then {[ Send ]} else ).
Global Arguments tok !_ /.
......@@ -27,10 +27,10 @@ Global Arguments tok !_ /.
Canonical Structure sts := sts.Sts prim_step tok.
(* The set of states containing some particular i *)
Definition i_states (i : gname) : set state := {[ s | i state_I s ]}.
Definition i_states (i : gname) : propset state := {[ s | i state_I s ]}.
(* The set of low states *)
Definition low_states : set state := {[ s | state_phase s = Low ]}.
Definition low_states : propset state := {[ s | state_phase s = Low ]}.
Lemma i_states_closed i : sts.closed (i_states i) {[ Change i ]}.
Proof.
......@@ -77,7 +77,7 @@ Proof.
- destruct p; set_solver.
- apply elem_of_equiv=> /= -[j|]; last set_solver.
set_unfold; rewrite !(inj_iff Change).
assert (Change j match p with Low => : set token | High => {[Send]} end False)
assert (Change j match p with Low => : propset token | High => {[Send]} end False)
as -> by (destruct p; set_solver).
destruct (decide (i1 = j)) as [->|]; first naive_solver.
destruct (decide (i2 = j)) as [->|]; first naive_solver.
......
From stdpp Require Import namespaces.
From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export proofmode notation.
(** General (HoCAP-style) spec for a concurrent bag ("per-elemt spec") *)
Record concurrent_bag {Σ} `{!heapG Σ} := ConcurrentBag {
mk_bag : val;
mk_bag_spec (N : namespace) (P : val iProp Σ) :
{{{ True }}}
mk_bag #()
{{{ (f f : val), RET (f, f);
( WP f #() {{ v, ( (v' : val), v SOMEV v' P v') v NONEV }})
( (v : val), (P v - WP f v {{ v, True }}))
}}}
}.
Arguments concurrent_bag _ {_}.
(** General (HoCAP-style) spec for a concurrent stack *)
Record concurrent_stack {Σ} `{!heapG Σ} := ConcurrentStack {
mk_stack : val;
mk_stack_spec (N : namespace) (P : list val iProp Σ)
(Q : val iProp Σ) (Q' Q'' : iProp Σ) :
{{{ P [] }}}
mk_stack #()
{{{ (f f : val), RET (f, f);
( ( ( v vs, P (v :: vs) ={ N}= Q v P vs)
(P [] ={ N}= Q' P []) -
WP f #() {{ v, ( (v' : val), v SOMEV v' Q v') (v NONEV Q')}}))
( (v : val),
(( vs, P vs ={ N}= P (v :: vs) Q'') - WP f v {{ v, Q'' }}))
}}}
}.
Arguments concurrent_stack _ {_}.
From stdpp Require Import namespaces.
From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export proofmode notation.
(** General (HoCAP-style) spec for a concurrent bag ("per-elemt spec") *)
Record concurrent_bag {Σ} `{!heapG Σ} := ConcurrentBag {
is_bag (P : val iProp Σ) (s : val) : iProp Σ;
bag_pers (P : val iProp Σ) (s : val) : Persistent (is_bag P s);
new_bag : val;
bag_push : val;
bag_pop : val;
mk_bag_spec (P : val iProp Σ) :
{{{ True }}}
new_bag #()
{{{ s, RET s; is_bag P s }}};
bag_push_spec (P : val iProp Σ) s v :
{{{ is_bag P s P v }}} bag_push s v {{{ RET #(); True }}};
bag_pop_spec (P : val iProp Σ) s :
{{{ is_bag P s }}} bag_pop s {{{ ov, RET ov; ov = NONEV v, ov = SOMEV v P v }}}
}.
Arguments concurrent_bag _ {_}.
(** General (CAP-style) spec for a concurrent stack *)
Record concurrent_stack {Σ} `{!heapG Σ} := ConcurrentStack {
is_stack (N : namespace) (P : list val iProp Σ) (s : val) : iProp Σ;
stack_pers (N : namespace) (P : list val iProp Σ) (s : val) : Persistent (is_stack N P s);
new_stack : val;
stack_push : val;
stack_pop : val;
new_stack_spec (N : namespace) (P : list val iProp Σ) :
{{{ P [] }}} new_stack #() {{{ v, RET v; is_stack N P v }}};
stack_push_spec (N : namespace) (P : list val iProp Σ) (Ψ : val iProp Σ) s v :
{{{ is_stack N P s xs, P xs ={ N}= P (v :: xs) Ψ #()}}}
stack_push s v
{{{ RET #(); Ψ #() }}};
stack_pop_spec (N : namespace) (P : list val iProp Σ) Ψ s :
{{{ is_stack N P s
( v xs, P (v :: xs) ={ N}= P xs Ψ (SOMEV v))
(P [] ={ N}= P [] Ψ NONEV) }}}
stack_pop s
{{{ v, RET v; Ψ v }}};
}.
Arguments concurrent_stack _ {_}.
......@@ -31,13 +31,13 @@ Structure bag Σ `{!heapG Σ} := Bag {
{{{ True }}} newBag #() {{{ x γ, RET x; is_bag N γ x bag_contents γ }}};
pushBag_spec N P Q γ b v :
( (X : gmultiset val), bag_contents γ X P
={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
{{{ is_bag N γ b P }}}
pushBag b (of_val v)
{{{ RET #(); Q }}};
popBag_spec N P Q γ b :
( (X : gmultiset val) (y : val),
bag_contents γ ({[y]} X) P
bag_contents γ ({[y]} X) P
={∖↑N}= (bag_contents γ X Q (SOMEV y))) -
(bag_contents γ P ={∖↑N}= (bag_contents γ Q NONEV)) -
{{{ is_bag N γ b P }}}
......
......@@ -52,7 +52,7 @@ Section proof.
Fixpoint bag_of_val (ls : val) : gmultiset val :=
match ls with
| NONEV =>
| SOMEV (v1, t) => {[v1]} bag_of_val t
| SOMEV (v1, t) => {[v1]} bag_of_val t
| _ =>
end.
Fixpoint val_of_list (ls : list val) : val :=
......@@ -62,7 +62,7 @@ Section proof.
end.
Definition bag_inv (γb : gname) (b : loc) : iProp Σ :=
( ls : list val, b (val_of_list ls) own γb ((1/2)%Qp, to_agree (of_list ls)))%I.
( ls : list val, b (val_of_list ls) own γb ((1/2)%Qp, to_agree (list_to_set_disj ls)))%I.
Definition is_bag (γb : gname) (x : val) :=
( (lk : val) (b : loc) (γ : gname),
......@@ -116,7 +116,7 @@ Section proof.
Local Opaque acquire release. (* so that wp_pure doesn't stumble *)
Lemma pushBag_spec (P Q : iProp Σ) γ (x v : val) :
( (X : gmultiset val), bag_contents γ X P
={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
{{{ is_bag γ x P }}}
pushBag x (of_val v)
{{{ RET #(); Q }}}.
......@@ -141,7 +141,7 @@ Section proof.
Lemma popBag_spec (P : iProp Σ) (Q : val iProp Σ) γ x :
( (X : gmultiset val) (y : val),
bag_contents γ ({[y]} X) P
bag_contents γ ({[y]} X) P
={∖↑N}= (bag_contents γ X Q (SOMEV y))) -
(bag_contents γ P ={∖↑N}= (bag_contents γ Q NONEV)) -
{{{ is_bag γ x P }}}
......
......@@ -23,19 +23,19 @@ Section proof.
(own γ (!{q} X))%I.
Lemma bagPart_compose (γ: gname) (q1 q2: Qp) (X Y : gmultiset val) :
bagPart γ q1 X - bagPart γ q2 Y - bagPart γ (q1+q2) (X Y).
bagPart γ q1 X - bagPart γ q2 Y - bagPart γ (q1+q2) (X Y).
Proof.
iIntros "Hp1 Hp2".
rewrite /bagPart -gmultiset_op_union -frac_op'.
rewrite /bagPart -gmultiset_op_disj_union -frac_op'.
rewrite frac_auth_frag_op own_op. iFrame.
Qed.
Lemma bagPart_decompose (γ: gname) (q: Qp) (X Y : gmultiset val) :
bagPart γ q (X Y) - bagPart γ (q/2) X bagPart γ (q/2) Y.
bagPart γ q (X Y) - bagPart γ (q/2) X bagPart γ (q/2) Y.
Proof.
iIntros "Hp".
assert (q = (q/2)+(q/2))%Qp as Hq by (by rewrite Qp_div_2).
rewrite /bagPart {1}Hq.
rewrite -gmultiset_op_union -frac_op'.
rewrite -gmultiset_op_disj_union -frac_op'.
rewrite frac_auth_frag_op own_op. iFrame.
Qed.
......@@ -59,17 +59,17 @@ Section proof.
Lemma pushBag_spec γb γ x v q Y :
{{{ bagM γb γ x bagPart γ q Y }}}
pushBag b x (of_val v)
{{{ RET #(); bagPart γ q ({[v]} Y) }}}.
{{{ RET #(); bagPart γ q ({[v]} Y) }}}.
Proof.
iIntros (Φ) "[#[Hbag Hinv] HP] HΦ". rewrite /bagM_inv.
iApply (pushBag_spec b NB (bagPart γ q Y)%I (bagPart γ q ({[v]} Y))%I with "[] [Hbag HP]"); eauto.
iApply (pushBag_spec b NB (bagPart γ q Y)%I (bagPart γ q ({[v]} Y))%I with "[] [Hbag HP]"); eauto.
iAlways. iIntros (X) "[Hb1 HP]".
iInv NI as (X') "[>Hb2 >Hown]" "Hcl".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
iMod (bag_contents_update b ({[v]} X) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
iMod (bag_contents_update b ({[v]} X) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
rewrite /bagPart.
iMod (own_update_2 with "Hown HP") as "[Hown HP]".
{ apply (frac_auth_update _ _ _ ({[v]} X) ({[v]} Y)).
{ apply (frac_auth_update _ _ _ ({[v]} X) ({[v]} Y)).
do 2 rewrite (comm _ {[v]}).
apply gmultiset_local_update_alloc. }
iFrame. iApply "Hcl".
......@@ -78,7 +78,7 @@ Section proof.
Local Ltac multiset_solver :=
intro;
repeat (rewrite multiplicity_difference || rewrite multiplicity_union);
repeat (rewrite multiplicity_difference || rewrite multiplicity_disj_union);
(lia || naive_solver).
Lemma popBag_spec γb γ x X :
......@@ -97,20 +97,20 @@ Section proof.
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
iMod (bag_contents_update b Y with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
rewrite /bagPart.
iAssert (X = ({[y]} Y))%I with "[Hpart HPs]" as %->.
iAssert (X = ({[y]} Y))%I with "[Hpart HPs]" as %->.
{ iDestruct (own_valid_2 with "HPs Hpart") as %Hfoo.
apply frac_auth_agree in Hfoo. by unfold_leibniz. }
iMod (own_update_2 with "HPs Hpart") as "Hown".
{ apply (frac_auth_update _ _ _ (({[y]} Y) {[y]}) (({[y]} Y) {[y]})).
{ apply (frac_auth_update _ _ _ (({[y]} Y) {[y]}) (({[y]} Y) {[y]})).
apply gmultiset_local_update_dealloc; multiset_solver. }
iDestruct "Hown" as "[HPs Hpart]".
iMod ("Hcl" with "[-Hpart Hb1]") as "_".
{ iNext. iExists _; iFrame.
assert (Y = (({[y]} Y) {[y]})) as <-
assert (Y = (({[y]} Y) {[y]})) as <-
by (unfold_leibniz; multiset_solver).
iFrame. }
iModIntro. iNext. iFrame. iRight. iExists y; repeat iSplit; eauto.
iPureIntro. by apply elem_of_union_l, elem_of_singleton. }
iPureIntro. apply gmultiset_elem_of_disj_union. left. by apply elem_of_singleton. }
{ iAlways. iIntros "[Hb1 Hpart]".
iInv NI as (X') "[>Hb2 >HPs]" "Hcl".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
......
......@@ -33,14 +33,14 @@ Section proof.
Lemma pushBag_spec γ x X v :
{{{ bagE γ x X }}}
pushBag b x (of_val v)
{{{ RET #(); bagE γ x ({[v]} X) }}}.
{{{ RET #(); bagE γ x ({[v]} X) }}}.
Proof.
iIntros (Φ) "Hbag HΦ".
iApply (pushBag_spec b N (bagE γ x X)%I (bagE γ x ({[v]} X))%I with "[] [Hbag]"); eauto.
iApply (pushBag_spec b N (bagE γ x X)%I (bagE γ x ({[v]} X))%I with "[] [Hbag]"); eauto.
{ iAlways. iIntros (Y) "[Hb1 Hb2]".
iDestruct "Hb2" as "[#Hbag Hb2]".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
iMod (bag_contents_update b ({[v]} Y) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
iMod (bag_contents_update b ({[v]} Y) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
by iFrame. }
{ iDestruct "Hbag" as "[#Hbag Hb]". iFrame "Hbag". eauto. }
Qed.
......@@ -49,11 +49,11 @@ Section proof.
{{{ bagE γ x X }}}
popBag b x
{{{ v, RET v; (X = ∅⌝ v = NONEV bagE γ x )
( Y y, X = {[y]} Y v = SOMEV y bagE γ x Y)}}}.
( Y y, X = {[y]} Y v = SOMEV y bagE γ x Y)}}}.
Proof.
iIntros (Φ) "Hbag HΦ".
iApply (popBag_spec b N (bagE γ x X)%I (fun v => (X = ∅⌝ v = NONEV bagE γ x )
( Y y, X = {[y]} Y v = SOMEV y bagE γ x Y))%I γ with "[] [] [Hbag]"); eauto.
( Y y, X = {[y]} Y v = SOMEV y bagE γ x Y))%I γ with "[] [] [Hbag]"); eauto.
{ iAlways. iIntros (Y y) "[Hb1 Hb2]".
iDestruct "Hb2" as "[#Hbag Hb2]".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
......
......@@ -87,11 +87,11 @@ Section proof.
iDestruct (mapsto_agree l' q q' (PairV x tl) (PairV y tl')
with "Hro Hro'") as %?. simplify_eq/=.
iDestruct ("IH" with "Hls Hls'") as %->. done.
Qed.
Qed.
Definition bag_inv (γb : gname) (b : loc) : iProp Σ :=
( (hd : val) (ls : list val),
b hd is_list hd ls own γb ((1/2)%Qp, to_agree (of_list ls)))%I.
b hd is_list hd ls own γb ((1/2)%Qp, to_agree (list_to_set_disj ls)))%I.
Definition is_bag (γb : gname) (x : val) :=
( (b : loc), x = #b inv N (bag_inv γb b))%I.
Definition bag_contents (γb : gname) (X : gmultiset val) : iProp Σ :=
......@@ -142,7 +142,7 @@ Section proof.
Lemma pushBag_spec (P Q : iProp Σ) γ (x v : val) :
( (X : gmultiset val), bag_contents γ X P
={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
={∖↑N}= (bag_contents γ ({[v]} X) Q)) -
{{{ is_bag γ x P }}}
pushBag x (of_val v)
{{{ RET #(); Q }}}.
......@@ -179,7 +179,7 @@ Section proof.
Lemma popBag_spec (P : iProp Σ) (Q : val iProp Σ) γ x :
( (X : gmultiset val) (y : val),
bag_contents γ ({[y]} X) P
bag_contents γ ({[y]} X) P
={∖↑N}= (bag_contents γ X Q (SOMEV y))) -
(bag_contents γ P ={∖↑N}= (bag_contents γ Q NONEV)) -
{{{ is_bag γ x P }}}
......
......@@ -52,7 +52,7 @@ Section proof.
{ iAlways. iIntros (Y) "[Hb1 HP]".
iInv NI as (X) "[>Hb2 HPs]" "Hcl".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
iMod (bag_contents_update b ({[v]} Y) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
iMod (bag_contents_update b ({[v]} Y) with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
iFrame. iApply "Hcl".
iNext. iExists _; iFrame.
rewrite big_sepMS_singleton. iFrame. }
......@@ -70,7 +70,7 @@ Section proof.
iInv NI as (X) "[>Hb2 HPs]" "Hcl".
iDestruct (bag_contents_agree with "Hb1 Hb2") as %<-.
iMod (bag_contents_update b Y with "[$Hb1 $Hb2]") as "[Hb1 Hb2]".
rewrite big_sepMS_union bi.later_sep big_sepMS_singleton.
rewrite big_sepMS_disj_union bi.later_sep big_sepMS_singleton.
iDestruct "HPs" as "[HP HPs]".
iMod ("Hcl" with "[-HP Hb1]") as "_".
{ iNext. iExists _; iFrame. }
......
......@@ -140,7 +140,7 @@ Section proof.
called wp_par. The two arguments are the conclusions of the two
parallel threads. Here they are simply True, as in the paper proof when
we used the ht-par rule. *)
iApply (wp_par (λ _ , True)%I (λ _ , True)%I).
wp_apply (wp_par (λ _ , True)%I (λ _ , True)%I).
(* We now have three subgoals. The first two are proofs that each thread
does the correct thing, and the final goal is to show that the combined
conclusion of the two threads implies the desired conclusion. This last
......
......@@ -280,7 +280,7 @@ Section example_1.
wp_let.
wp_bind (_ ||| _)%E.
let tac := iApply ("HIncr" with "[$HInc]"); iNext; by iIntros (?) "_" in
iApply (wp_par (λ _, True%I) (λ _, True%I)); [tac | tac | ].
wp_apply (wp_par (λ _, True%I) (λ _, True%I)); [tac | tac | ].
{ iIntros (v1 v2) "_ !>".
wp_seq.
wp_apply (read_spec _ _ _ True%I (λ _, True%I)); auto.
......
......@@ -365,10 +365,10 @@ Section atomic_snapshot.
wp_load. eauto.
Qed.
Definition val_to_bool (v : option val) : bool :=
Definition val_list_to_bool (v : list val) : bool :=
match v with
| Some (LitV (LitBool b)) => b
| _ => false
| LitV (LitBool b) :: _ => b
| _ => false
end.
Lemma readPair_spec γ p :
......@@ -413,7 +413,7 @@ Section atomic_snapshot.
iMod "AU" as (xv yv) "[Hpair Hclose]".
rewrite /pair_content.
iDestruct (excl_sync with "Hp⚫ Hpair") as %[= -> ->].
destruct (val_to_bool proph_val) eqn:Hproph.
destruct (val_list_to_bool proph_val) eqn:Hproph.
- (* prophecy value is predicting that timestamp has not changed, so we commit *)
(* committing AU *)
iMod ("Hclose" with "Hpair") as "HΦ".
......@@ -443,7 +443,7 @@ Section atomic_snapshot.
}
wp_load. wp_let. wp_proj. wp_let. wp_proj. wp_op.
case_bool_decide; wp_let; wp_apply (wp_resolve_proph with "Hpr");
iIntros (->); wp_seq; wp_if.
iIntros (vs') "[Eq _]"; iDestruct "Eq" as %->; wp_seq; wp_if.
+ inversion H; subst; clear H. wp_pures.
assert (v_x2 = v_y) as ->. {
assert (v_x2 <= v_y) as vneq. {
......@@ -479,7 +479,7 @@ Section atomic_snapshot.
}
wp_load. repeat (wp_let; wp_proj). wp_op. wp_let.
wp_apply (wp_resolve_proph with "Hpr").
iIntros (Heq). subst.
iIntros (vs') "[Heq _]"; iDestruct "Heq" as %->.
case_bool_decide.
+ inversion H; subst; clear H. inversion Hproph.
+ wp_seq. wp_if. iApply "IH"; rewrite /is_pair; eauto.
......
......@@ -9,7 +9,7 @@ Definition new_stack: val := λ: <>, ref (ref NONE).
Definition push: val :=
rec: "push" "s" "x" :=
let: "hd" := !"s" in
let: "s'" := ref SOME ("x", "hd") in
let: "s'" := ref (SOME ("x", "hd")) in
if: CAS "s" "hd" "s'"
then #()
else "push" "s" "x".
......
This diff is collapsed.
......@@ -67,9 +67,6 @@ Section ltyped_symbol_adt.
Definition symbol_inv (γ : gname) (l : loc) : iProp Σ :=
( n : nat, l #n counter γ n)%I.
Definition symbol_ctx (γ : gname) (l : loc) : iProp Σ :=
inv symbol_adtN (symbol_inv γ l).
Definition lty_symbol (γ : gname) : lty Σ := Lty (λ w,
n : nat, w = #n symbol γ n)%I.
......
......@@ -98,8 +98,7 @@ Notation "'ref' A" := (lty_ref A) : lty_scope.
(* The semantic typing judgment *)
Definition env_ltyped `{heapG Σ} (Γ : gmap string (lty Σ))
(vs : gmap string val) : iProp Σ :=
( x, is_Some (Γ !! x) is_Some (vs !! x)
[ map] i Av map_zip Γ vs, lty_car Av.1 Av.2)%I.
([ map] i A;v Γ; vs, lty_car A v)%I.
Definition ltyped `{heapG Σ}
(Γ : gmap string (lty Σ)) (e : expr) (A : lty Σ) : iProp Σ :=
( vs, env_ltyped Γ vs - WP subst_map vs e {{ A }})%I.
......@@ -139,19 +138,15 @@ Section types_properties.
Γ !! x = Some A
env_ltyped Γ vs - v, vs !! x = Some v A v.
Proof.
iIntros (HΓx) "[Hlookup HΓ]". iDestruct "Hlookup" as %Hlookup.
destruct (proj1 (Hlookup x)) as [v Hx]; eauto.
iExists v. iSplit; first done. iApply (big_sepM_lookup _ _ x (A,v) with "HΓ").
by rewrite map_lookup_zip_with HΓx /= Hx.
iIntros (HΓx) "HΓ".
iDestruct (big_sepM2_lookup_1 with "HΓ") as (v ?) "H"; eauto.
Qed.
Lemma env_ltyped_insert Γ vs x A v :
A v - env_ltyped Γ vs -
env_ltyped (binder_insert x A Γ) (binder_insert x v vs).
Proof.
destruct x as [|x]=> /=; first by auto.
iIntros "#HA [Hlookup #HΓ]". iDestruct "Hlookup" as %Hlookup. iSplit.
- iPureIntro=> y. rewrite !lookup_insert_is_Some'. naive_solver.
- rewrite -map_insert_zip_with. by iApply big_sepM_insert_2.
iIntros "#HA #HΓ". by iApply (big_sepM2_insert_2 with "[] HΓ").
Qed.
(* Unboxed types *)
......
......@@ -9,9 +9,6 @@ Lemma ltyped_safety `{heapPreG Σ} e σ es σ' e' :
Proof.
intros Hty. apply (heap_adequacy Σ NotStuck e σ (λ _, True))=> // ?.
destruct (Hty _) as [A He]. iStartProof. iDestruct (He $! ) as "#He".
iSpecialize <