Commit 9646293e authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan
Browse files

A specific constructor for injecting values in expressions

We add a specific constructor to the type of expressions for injecting
values in expressions.

The advantage are :
- Values can be assumed to be always closed when performing
  substitutions (even though they could contain free variables, but it
  turns out it does not cause any problem in the proofs in
  practice). This means that we no longer need the `Closed` typeclass
  and everything that comes with it (all the reflection-based machinery
  contained in tactics.v is no longer necessary). I have not measured
  anything, but I guess this would have a significant performance
  impact.

- There is only one constructor for values. As a result, the AsVal and
  IntoVal typeclasses are no longer necessary: an expression which is
  a value will always unify with `Val _`, and therefore lemmas can be
  stated using this constructor.

Of course, this means that there are two ways of writing such a thing
as "The pair of integers 1 and 2": Either by using the value
constructor applied to the pair represented as a value, or by using
the expression pair constructor. So we add reduction rules that
transform reduced pair, injection and closure expressions into values.
At first, this seems weird, because of the redundancy. But in fact,
this has some meaning, since the machine migth actually be doing
something to e.g., allocate the pair or the closure.

These additional steps of computation show up in the proofs, and some
additional wp_* tactics need to be called.
parent 1f796221
...@@ -81,6 +81,7 @@ theories/program_logic/total_lifting.v ...@@ -81,6 +81,7 @@ theories/program_logic/total_lifting.v
theories/program_logic/total_ectx_lifting.v theories/program_logic/total_ectx_lifting.v
theories/program_logic/atomic.v theories/program_logic/atomic.v
theories/heap_lang/lang.v theories/heap_lang/lang.v
theories/heap_lang/metatheory.v
theories/heap_lang/tactics.v theories/heap_lang/tactics.v
theories/heap_lang/lifting.v theories/heap_lang/lifting.v
theories/heap_lang/notation.v theories/heap_lang/notation.v
......
...@@ -50,6 +50,18 @@ ...@@ -50,6 +50,18 @@
--------------------------------------∗ --------------------------------------∗
True True
The command has indeed failed with message:
Ltac call to "wp_pure (open_constr)" failed.
Tactic failure: wp_pure: cannot find ?y in (Var "x") or
?y is not a redex.
1 subgoal
Σ : gFunctors
H : heapG Σ
============================
--------------------------------------∗
WP "x" {{ _, True }}
1 subgoal 1 subgoal
Σ : gFunctors Σ : gFunctors
...@@ -104,4 +116,4 @@ ...@@ -104,4 +116,4 @@
: string : string
The command has indeed failed with message: The command has indeed failed with message:
Ltac call to "wp_cas_suc" failed. Ltac call to "wp_cas_suc" failed.
Tactic failure: wp_cas_suc: cannot find 'CAS' in (#())%E. Tactic failure: wp_cas_suc: cannot find 'CAS' in (Val #()).
...@@ -131,6 +131,10 @@ Section tests. ...@@ -131,6 +131,10 @@ Section tests.
WP Alloc #0 {{ _, True }}%I. WP Alloc #0 {{ _, True }}%I.
Proof. wp_alloc l as "_". Show. done. Qed. Proof. wp_alloc l as "_". Show. done. Qed.
Lemma wp_nonclosed_value :
WP let: "x" := #() in (λ: "y", "x")%V #() {{ _, True }}%I.
Proof. wp_let. wp_lam. Fail wp_pure _. Show. Abort.
End tests. End tests.
Section printing_tests. Section printing_tests.
......
...@@ -82,14 +82,14 @@ Section list_reverse. ...@@ -82,14 +82,14 @@ Section list_reverse.
destruct xs as [|x xs]; iSimplifyEq. destruct xs as [|x xs]; iSimplifyEq.
- (* nil *) by wp_match. - (* nil *) by wp_match.
- (* cons *) iDestruct "Hxs" as (l hd') "(% & Hx & Hxs)"; iSimplifyEq. - (* cons *) iDestruct "Hxs" as (l hd') "(% & Hx & Hxs)"; iSimplifyEq.
wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_store. wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_pair. wp_store.
rewrite reverse_cons -assoc. rewrite reverse_cons -assoc.
iApply ("IH" $! hd' (InjRV #l) xs (x :: ys) with "Hxs [Hx Hys]"). iApply ("IH" $! hd' (InjRV #l) xs (x :: ys) with "Hxs [Hx Hys]").
iExists l, acc; by iFrame. iExists l, acc; by iFrame.
Qed. Qed.
Lemma rev_ht hd xs : Lemma rev_ht hd xs :
{{ is_list hd xs }} rev hd NONE {{ w, is_list w (reverse xs) }}. {{ is_list hd xs }} rev hd NONEV {{ w, is_list w (reverse xs) }}.
Proof. Proof.
iIntros "!# Hxs". rewrite -(right_id_L [] (++) (reverse xs)). iIntros "!# Hxs". rewrite -(right_id_L [] (++) (reverse xs)).
iApply (rev_acc_ht hd NONEV with "[Hxs]"); simpl; by iFrame. iApply (rev_acc_ht hd NONEV with "[Hxs]"); simpl; by iFrame.
...@@ -204,7 +204,7 @@ Section counter_proof. ...@@ -204,7 +204,7 @@ Section counter_proof.
Lemma newcounter_spec : Lemma newcounter_spec :
{{ True }} newcounter #() {{ v, l, v = #l C l 0 }}. {{ True }} newcounter #() {{ v, l, v = #l C l 0 }}.
Proof. Proof.
iIntros "!# _ /=". rewrite -wp_fupd /newcounter /=. wp_seq. wp_alloc l as "Hl". iIntros "!# _ /=". rewrite -wp_fupd /newcounter /=. wp_lam. wp_alloc l as "Hl".
iMod (own_alloc (Auth 0)) as (γ) "Hγ"; first done. iMod (own_alloc (Auth 0)) as (γ) "Hγ"; first done.
rewrite (auth_frag_op 0 0) //; iDestruct "Hγ" as "[Hγ Hγf]". rewrite (auth_frag_op 0 0) //; iDestruct "Hγ" as "[Hγ Hγf]".
set (N:= nroot .@ "counter"). set (N:= nroot .@ "counter").
...@@ -242,7 +242,7 @@ Section counter_proof. ...@@ -242,7 +242,7 @@ Section counter_proof.
{{ C l n }} read #l {{ v, m : nat, v = #m n m C l m }}. {{ C l n }} read #l {{ v, m : nat, v = #m n m C l m }}.
Proof. Proof.
iIntros "!# Hl /=". iDestruct "Hl" as (N γ) "[#Hinv Hγf]". iIntros "!# Hl /=". iDestruct "Hl" as (N γ) "[#Hinv Hγf]".
rewrite /read /=. wp_let. Show. iApply wp_inv_open; last iFrame "Hinv"; auto. rewrite /read /=. wp_lam. Show. iApply wp_inv_open; last iFrame "Hinv"; auto.
iDestruct 1 as (c) "[Hl Hγ]". wp_load. Show. iDestruct 1 as (c) "[Hl Hγ]". wp_load. Show.
iDestruct (own_valid γ (Frag n Auth c) with "[-]") as % ?%auth_frag_valid. iDestruct (own_valid γ (Frag n Auth c) with "[-]") as % ?%auth_frag_valid.
{ iApply own_op. by iFrame. } { iApply own_op. by iFrame. }
......
...@@ -23,11 +23,11 @@ ...@@ -23,11 +23,11 @@
"Hys" : is_list acc ys "Hys" : is_list acc ys
"HΦ" : ∀ w : val, is_list w ys -∗ Φ w "HΦ" : ∀ w : val, is_list w ys -∗ Φ w
--------------------------------------∗ --------------------------------------∗
WP match: InjL #() with WP match: InjLV #() with
InjL <> => acc InjL <> => acc
| InjR "l" => | InjR "l" =>
let: "tmp1" := Fst ! "l" in let: "tmp1" := Fst ! "l" in
let: "tmp2" := Snd ! "l" in let: "tmp2" := Snd ! "l" in
"l" <- ("tmp1", acc);; (rev "tmp2") (InjL #()) "l" <- ("tmp1", acc);; (rev "tmp2") (InjLV #())
end [{ v, Φ v }] end [{ v, Φ v }]
...@@ -36,14 +36,14 @@ Proof. ...@@ -36,14 +36,14 @@ Proof.
iSimplifyEq; wp_rec; wp_let. iSimplifyEq; wp_rec; wp_let.
- Show. wp_match. by iApply "HΦ". - Show. wp_match. by iApply "HΦ".
- iDestruct "Hxs" as (l hd' ->) "[Hx Hxs]". - iDestruct "Hxs" as (l hd' ->) "[Hx Hxs]".
wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_store. wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_pair. wp_store.
iApply ("IH" $! hd' (SOMEV #l) (x :: ys) with "Hxs [Hx Hys]"); simpl. iApply ("IH" $! hd' (SOMEV #l) (x :: ys) with "Hxs [Hx Hys]"); simpl.
{ iExists l, acc; by iFrame. } { iExists l, acc; by iFrame. }
iIntros (w). rewrite cons_middle assoc -reverse_cons. iApply "HΦ". iIntros (w). rewrite cons_middle assoc -reverse_cons. iApply "HΦ".
Qed. Qed.
Lemma rev_wp hd xs : Lemma rev_wp hd xs :
[[{ is_list hd xs }]] rev hd NONE [[{ w, RET w; is_list w (reverse xs) }]]. [[{ is_list hd xs }]] rev hd NONEV [[{ w, RET w; is_list w (reverse xs) }]].
Proof. Proof.
iIntros (Φ) "Hxs HΦ". iIntros (Φ) "Hxs HΦ".
iApply (rev_acc_wp hd NONEV xs [] with "[$Hxs //]"). iApply (rev_acc_wp hd NONEV xs [] with "[$Hxs //]").
......
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
"Hγ" : own γ (Shot m') "Hγ" : own γ (Shot m')
--------------------------------------∗ --------------------------------------∗
|={⊤ ∖ ↑N}=> ▷ one_shot_inv γ l |={⊤ ∖ ↑N}=> ▷ one_shot_inv γ l
∗ WP match: InjR #m' with ∗ WP match: InjRV #m' with
InjL <> => assert: #false InjL <> => assert: #false
| InjR "m" => assert: #m = "m" | InjR "m" => assert: #m = "m"
end {{ _, True }} end {{ _, True }}
......
...@@ -43,12 +43,12 @@ Lemma wp_one_shot (Φ : val → iProp Σ) : ...@@ -43,12 +43,12 @@ Lemma wp_one_shot (Φ : val → iProp Σ) :
WP one_shot_example #() {{ Φ }}. WP one_shot_example #() {{ Φ }}.
Proof. Proof.
iIntros "Hf /=". pose proof (nroot .@ "N") as N. iIntros "Hf /=". pose proof (nroot .@ "N") as N.
rewrite -wp_fupd /one_shot_example /=. wp_seq. wp_alloc l as "Hl". wp_let. rewrite -wp_fupd /one_shot_example /=. wp_lam. wp_inj. wp_alloc l as "Hl". wp_let.
iMod (own_alloc Pending) as (γ) "Hγ"; first done. iMod (own_alloc Pending) as (γ) "Hγ"; first done.
iMod (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ]") as "#HN". iMod (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ]") as "#HN".
{ iNext. iLeft. by iSplitL "Hl". } { iNext. iLeft. by iSplitL "Hl". }
iModIntro. iApply "Hf"; iSplit. wp_closure. wp_closure. wp_pair. iModIntro. iApply "Hf"; iSplit.
- iIntros (n) "!#". wp_let. - iIntros (n) "!#". wp_lam. wp_inj. wp_inj.
iInv N as ">[[Hl Hγ]|H]"; last iDestruct "H" as (m) "[Hl Hγ]". iInv N as ">[[Hl Hγ]|H]"; last iDestruct "H" as (m) "[Hl Hγ]".
+ iMod (own_update with "Hγ") as "Hγ". + iMod (own_update with "Hγ") as "Hγ".
{ by apply cmra_update_exclusive with (y:=Shot n). } { by apply cmra_update_exclusive with (y:=Shot n). }
...@@ -56,7 +56,7 @@ Proof. ...@@ -56,7 +56,7 @@ Proof.
iModIntro. iNext; iRight; iExists n; by iFrame. iModIntro. iNext; iRight; iExists n; by iFrame.
+ wp_cas_fail. iSplitL; last eauto. + wp_cas_fail. iSplitL; last eauto.
rewrite /one_shot_inv; eauto 10. rewrite /one_shot_inv; eauto 10.
- iIntros "!# /=". wp_seq. wp_bind (! _)%E. - iIntros "!# /=". wp_lam. wp_bind (! _)%E.
iInv N as ">Hγ". iInv N as ">Hγ".
iAssert ( v, l v ((v = NONEV own γ Pending) iAssert ( v, l v ((v = NONEV own γ Pending)
n : Z, v = SOMEV #n own γ (Shot n)))%I with "[Hγ]" as "Hv". n : Z, v = SOMEV #n own γ (Shot n)))%I with "[Hγ]" as "Hv".
...@@ -70,7 +70,7 @@ Proof. ...@@ -70,7 +70,7 @@ Proof.
+ Show. iSplit. iLeft; by iSplitL "Hl". eauto. + Show. iSplit. iLeft; by iSplitL "Hl". eauto.
+ iSplit. iRight; iExists m; by iSplitL "Hl". eauto. } + iSplit. iRight; iExists m; by iSplitL "Hl". eauto. }
iSplitL "Hinv"; first by eauto. iSplitL "Hinv"; first by eauto.
iModIntro. wp_let. iIntros "!#". wp_seq. iModIntro. wp_let. wp_closure. iIntros "!#". wp_lam.
iDestruct "Hv" as "[%|Hv]"; last iDestruct "Hv" as (m) "[% Hγ']"; subst. iDestruct "Hv" as "[%|Hv]"; last iDestruct "Hv" as (m) "[% Hγ']"; subst.
{ by wp_match. } { by wp_match. }
wp_match. wp_bind (! _)%E. wp_match. wp_bind (! _)%E.
......
...@@ -58,7 +58,7 @@ Lemma sum_wp `{!heapG Σ} v t : ...@@ -58,7 +58,7 @@ Lemma sum_wp `{!heapG Σ} v t :
[[{ is_tree v t }]] sum' v [[{ RET #(sum t); is_tree v t }]]. [[{ is_tree v t }]] sum' v [[{ RET #(sum t); is_tree v t }]].
Proof. Proof.
iIntros (Φ) "Ht HΦ". rewrite /sum' /=. iIntros (Φ) "Ht HΦ". rewrite /sum' /=.
wp_let. wp_alloc l as "Hl". wp_let. wp_lam. wp_alloc l as "Hl". wp_let.
wp_apply (sum_loop_wp with "[$Hl $Ht]"). wp_apply (sum_loop_wp with "[$Hl $Ht]").
rewrite Z.add_0_r. rewrite Z.add_0_r.
iIntros "[Hl Ht]". wp_seq. wp_load. by iApply "HΦ". iIntros "[Hl Ht]". wp_seq. wp_load. by iApply "HΦ".
......
This diff is collapsed.
...@@ -9,16 +9,16 @@ Definition assert : val := ...@@ -9,16 +9,16 @@ Definition assert : val :=
(* just below ;; *) (* just below ;; *)
Notation "'assert:' e" := (assert (λ: <>, e))%E (at level 99) : expr_scope. Notation "'assert:' e" := (assert (λ: <>, e))%E (at level 99) : expr_scope.
Lemma twp_assert `{heapG Σ} E (Φ : val iProp Σ) e `{!Closed [] e} : Lemma twp_assert `{heapG Σ} E (Φ : val iProp Σ) e :
WP e @ E [{ v, v = #true Φ #() }] - WP assert: e @ E [{ Φ }]. WP e @ E [{ v, v = #true Φ #() }] - WP assert: e @ E [{ Φ }].
Proof. Proof.
iIntros "HΦ". rewrite /assert. wp_let. wp_seq. iIntros "HΦ". rewrite /assert. wp_closure. wp_lam. wp_lam.
wp_apply (twp_wand with "HΦ"). iIntros (v) "[% ?]"; subst. by wp_if. wp_apply (twp_wand with "HΦ"). iIntros (v) "[% ?]"; subst. by wp_if.
Qed. Qed.
Lemma wp_assert `{heapG Σ} E (Φ : val iProp Σ) e `{!Closed [] e} : Lemma wp_assert `{heapG Σ} E (Φ : val iProp Σ) e :
WP e @ E {{ v, v = #true Φ #() }} - WP assert: e @ E {{ Φ }}. WP e @ E {{ v, v = #true Φ #() }} - WP assert: e @ E {{ Φ }}.
Proof. Proof.
iIntros "HΦ". rewrite /assert. wp_let. wp_seq. iIntros "HΦ". rewrite /assert. wp_closure. wp_lam. wp_lam.
wp_apply (wp_wand with "HΦ"). iIntros (v) "[% ?]"; subst. by wp_if. wp_apply (wp_wand with "HΦ"). iIntros (v) "[% ?]"; subst. by wp_if.
Qed. Qed.
...@@ -21,21 +21,20 @@ Class atomic_heap {Σ} `{!heapG Σ} := AtomicHeap { ...@@ -21,21 +21,20 @@ Class atomic_heap {Σ} `{!heapG Σ} := AtomicHeap {
AsFractional (mapsto l q v) (λ q, mapsto l q v) q; AsFractional (mapsto l q v) (λ q, mapsto l q v) q;
mapsto_agree l q1 q2 v1 v2 :> mapsto l q1 v1 - mapsto l q2 v2 - v1 = v2; mapsto_agree l q1 q2 v1 v2 :> mapsto l q1 v1 - mapsto l q2 v2 - v1 = v2;
(* -- operation specs -- *) (* -- operation specs -- *)
alloc_spec e v : alloc_spec (v : val) :
IntoVal e v {{{ True }}} alloc e {{{ l, RET #l; mapsto l 1 v }}}; {{{ True }}} alloc v {{{ l, RET #l; mapsto l 1 v }}};
load_spec (l : loc) : load_spec (l : loc) :
<<< (v : val) q, mapsto l q v >>> load #l @ <<< mapsto l q v, RET v >>>; <<< (v : val) q, mapsto l q v >>> load #l @ <<< mapsto l q v, RET v >>>;
store_spec (l : loc) (e : expr) (w : val) : store_spec (l : loc) (w : val) :
IntoVal e w <<< v, mapsto l 1 v >>> store #l w @
<<< v, mapsto l 1 v >>> store #l e @
<<< mapsto l 1 w, RET #() >>>; <<< mapsto l 1 w, RET #() >>>;
(* This spec is slightly weaker than it could be: It is sufficient for [w1] (* This spec is slightly weaker than it could be: It is sufficient for [w1]
*or* [v] to be unboxed. However, by writing it this way the [val_is_unboxed] *or* [v] to be unboxed. However, by writing it this way the [val_is_unboxed]
is outside the atomic triple, which makes it much easier to use -- and the is outside the atomic triple, which makes it much easier to use -- and the
spec is still good enough for all our applications. *) spec is still good enough for all our applications. *)
cas_spec (l : loc) (e1 e2 : expr) (w1 w2 : val) : cas_spec (l : loc) (w1 w2 : val) :
IntoVal e1 w1 IntoVal e2 w2 val_is_unboxed w1 val_is_unboxed w1
<<< v, mapsto l 1 v >>> cas #l e1 e2 @ <<< v, mapsto l 1 v >>> cas #l w1 w2 @
<<< if decide (v = w1) then mapsto l 1 w2 else mapsto l 1 v, <<< if decide (v = w1) then mapsto l 1 w2 else mapsto l 1 v,
RET #(if decide (v = w1) then true else false) >>>; RET #(if decide (v = w1) then true else false) >>>;
}. }.
...@@ -72,39 +71,38 @@ Definition primitive_cas : val := ...@@ -72,39 +71,38 @@ Definition primitive_cas : val :=
Section proof. Section proof.
Context `{!heapG Σ}. Context `{!heapG Σ}.
Lemma primitive_alloc_spec e v : Lemma primitive_alloc_spec (v : val) :
IntoVal e v {{{ True }}} primitive_alloc e {{{ l, RET #l; l v }}}. {{{ True }}} primitive_alloc v {{{ l, RET #l; l v }}}.
Proof. Proof.
iIntros (<- Φ) "_ HΦ". wp_let. wp_alloc l. iApply "HΦ". done. iIntros (Φ) "_ HΦ". wp_lam. wp_alloc l. iApply "HΦ". done.
Qed. Qed.
Lemma primitive_load_spec (l : loc) : Lemma primitive_load_spec (l : loc) :
<<< (v : val) q, l {q} v >>> primitive_load #l @ <<< (v : val) q, l {q} v >>> primitive_load #l @
<<< l {q} v, RET v >>>. <<< l {q} v, RET v >>>.
Proof. Proof.
iIntros (Q Φ) "? AU". wp_let. iIntros (Q Φ) "? AU". wp_lam.
iMod "AU" as (v q) "[H↦ [_ Hclose]]". iMod "AU" as (v q) "[H↦ [_ Hclose]]".
wp_load. iMod ("Hclose" with "H↦") as "HΦ". by iApply "HΦ". wp_load. iMod ("Hclose" with "H↦") as "HΦ". by iApply "HΦ".
Qed. Qed.
Lemma primitive_store_spec (l : loc) (e : expr) (w : val) : Lemma primitive_store_spec (l : loc) (w : val) :
IntoVal e w <<< v, l v >>> primitive_store #l w @
<<< v, l v >>> primitive_store #l e @
<<< l w, RET #() >>>. <<< l w, RET #() >>>.
Proof. Proof.
iIntros (<- Q Φ) "? AU". wp_lam. wp_let. iIntros (Q Φ) "? AU". wp_lam. wp_let.
iMod "AU" as (v) "[H↦ [_ Hclose]]". iMod "AU" as (v) "[H↦ [_ Hclose]]".
wp_store. iMod ("Hclose" with "H↦") as "HΦ". by iApply "HΦ". wp_store. iMod ("Hclose" with "H↦") as "HΦ". by iApply "HΦ".
Qed. Qed.
Lemma primitive_cas_spec (l : loc) e1 e2 (w1 w2 : val) : Lemma primitive_cas_spec (l : loc) (w1 w2 : val) :
IntoVal e1 w1 IntoVal e2 w2 val_is_unboxed w1 val_is_unboxed w1
<<< (v : val), l v >>> <<< (v : val), l v >>>
primitive_cas #l e1 e2 @ primitive_cas #l w1 w2 @
<<< if decide (v = w1) then l w2 else l v, <<< if decide (v = w1) then l w2 else l v,
RET #(if decide (v = w1) then true else false) >>>. RET #(if decide (v = w1) then true else false) >>>.
Proof. Proof.
iIntros (<- <- ? Q Φ) "? AU". wp_lam. wp_let. wp_let. iIntros (? Q Φ) "? AU". wp_lam. wp_let. wp_let.
iMod "AU" as (v) "[H↦ [_ Hclose]]". iMod "AU" as (v) "[H↦ [_ Hclose]]".
destruct (decide (v = w1)) as [<-|Hv]; [wp_cas_suc|wp_cas_fail]; destruct (decide (v = w1)) as [<-|Hv]; [wp_cas_suc|wp_cas_fail];
iMod ("Hclose" with "H↦") as "HΦ"; by iApply "HΦ". iMod ("Hclose" with "H↦") as "HΦ"; by iApply "HΦ".
......
...@@ -36,12 +36,11 @@ Section coinflip. ...@@ -36,12 +36,11 @@ Section coinflip.
Lemma rand_spec : Lemma rand_spec :
{{{ True }}} rand #() {{{ (b : bool), RET #b; True }}}. {{{ True }}} rand #() {{{ (b : bool), RET #b; True }}}.
Proof. Proof.
iIntros (Φ) "_ HP". iIntros (Φ) "_ HP". wp_lam. wp_alloc l as "Hl". wp_let.
wp_lam. wp_alloc l as "Hl". wp_lam.
iMod (inv_alloc N _ ( (b: bool), l #b)%I with "[Hl]") as "#Hinv"; first by eauto. iMod (inv_alloc N _ ( (b: bool), l #b)%I with "[Hl]") as "#Hinv"; first by eauto.
wp_apply wp_fork. wp_apply wp_fork.
- iInv N as (b) ">Hl". wp_store. iModIntro. iSplitL; eauto. - iInv N as (b) ">Hl". wp_store. iModIntro. iSplitL; eauto.
- wp_lam. iInv N as (b) ">Hl". wp_load. iModIntro. iSplitL "Hl"; first by eauto. - wp_seq. iInv N as (b) ">Hl". wp_load. iModIntro. iSplitL "Hl"; first by eauto.
iApply "HP". done. iApply "HP". done.
Qed. Qed.
......
...@@ -35,7 +35,7 @@ Section mono_proof. ...@@ -35,7 +35,7 @@ Section mono_proof.
Lemma newcounter_mono_spec : Lemma newcounter_mono_spec :
{{{ True }}} newcounter #() {{{ l, RET #l; mcounter l 0 }}}. {{{ True }}} newcounter #() {{{ l, RET #l; mcounter l 0 }}}.
Proof. Proof.
iIntros (Φ) "_ HΦ". rewrite -wp_fupd /newcounter /=. wp_seq. wp_alloc l as "Hl". iIntros (Φ) "_ HΦ". rewrite -wp_fupd /newcounter /=. wp_lam. wp_alloc l as "Hl".
iMod (own_alloc ( (O:mnat) (O:mnat))) as (γ) "[Hγ Hγ']"; first done. iMod (own_alloc ( (O:mnat) (O:mnat))) as (γ) "[Hγ Hγ']"; first done.
iMod (inv_alloc N _ (mcounter_inv γ l) with "[Hl Hγ]"). iMod (inv_alloc N _ (mcounter_inv γ l) with "[Hl Hγ]").
{ iNext. iExists 0%nat. by iFrame. } { iNext. iExists 0%nat. by iFrame. }
...@@ -71,7 +71,7 @@ Section mono_proof. ...@@ -71,7 +71,7 @@ Section mono_proof.
{{{ mcounter l j }}} read #l {{{ i, RET #i; j i%nat mcounter l i }}}. {{{ mcounter l j }}} read #l {{{ i, RET #i; j i%nat mcounter l i }}}.
Proof. Proof.
iIntros (ϕ) "Hc HΦ". iDestruct "Hc" as (γ) "[#Hinv Hγf]". iIntros (ϕ) "Hc HΦ". iDestruct "Hc" as (γ) "[#Hinv Hγf]".
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]". rewrite /read /=. wp_lam. iInv N as (c) ">[Hγ Hl]".
wp_load. wp_load.
iDestruct (own_valid_2 with "Hγ Hγf") iDestruct (own_valid_2 with "Hγ Hγf")
as %[?%mnat_included _]%auth_valid_discrete_2. as %[?%mnat_included _]%auth_valid_discrete_2.
...@@ -112,7 +112,7 @@ Section contrib_spec. ...@@ -112,7 +112,7 @@ Section contrib_spec.
{{{ True }}} newcounter #() {{{ True }}} newcounter #()
{{{ γ l, RET #l; ccounter_ctx γ l ccounter γ 1 0 }}}. {{{ γ l, RET #l; ccounter_ctx γ l ccounter γ 1 0 }}}.
Proof. Proof.
iIntros (Φ) "_ HΦ". rewrite -wp_fupd /newcounter /=. wp_seq. wp_alloc l as "Hl". iIntros (Φ) "_ HΦ". rewrite -wp_fupd /newcounter /=. wp_lam. wp_alloc l as "Hl".
iMod (own_alloc (! O%nat ! 0%nat)) as (γ) "[Hγ Hγ']"; first done. iMod (own_alloc (! O%nat ! 0%nat)) as (γ) "[Hγ Hγ']"; first done.
iMod (inv_alloc N _ (ccounter_inv γ l) with "[Hl Hγ]"). iMod (inv_alloc N _ (ccounter_inv γ l) with "[Hl Hγ]").
{ iNext. iExists 0%nat. by iFrame. } { iNext. iExists 0%nat. by iFrame. }
...@@ -144,7 +144,7 @@ Section contrib_spec. ...@@ -144,7 +144,7 @@ Section contrib_spec.
{{{ c, RET #c; n c%nat ccounter γ q n }}}. {{{ c, RET #c; n c%nat ccounter γ q n }}}.
Proof. Proof.
iIntros (Φ) "[#? Hγf] HΦ". iIntros (Φ) "[#? Hγf] HΦ".
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]". wp_load. rewrite /read /=. wp_lam. iInv N as (c) ">[Hγ Hl]". wp_load.
iDestruct (own_valid_2 with "Hγ Hγf") as % ?%frac_auth_included_total%nat_included. iDestruct (own_valid_2 with "Hγ Hγf") as % ?%frac_auth_included_total%nat_included.
iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
iApply ("HΦ" with "[-]"); rewrite /ccounter; eauto 10. iApply ("HΦ" with "[-]"); rewrite /ccounter; eauto 10.
...@@ -155,7 +155,7 @@ Section contrib_spec. ...@@ -155,7 +155,7 @@ Section contrib_spec.
{{{ n, RET #n; ccounter γ 1 n }}}. {{{ n, RET #n; ccounter γ 1 n }}}.
Proof. Proof.
iIntros (Φ) "[#? Hγf] HΦ". iIntros (Φ) "[#? Hγf] HΦ".
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]". wp_load. rewrite /read /=. wp_lam. iInv N as (c) ">[Hγ Hl]". wp_load.
iDestruct (own_valid_2 with "Hγ Hγf") as % <-%frac_auth_agreeL. iDestruct (own_valid_2 with "Hγ Hγf") as % <-%frac_auth_agreeL.
iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
by iApply "HΦ". by iApply "HΦ".
......
...@@ -23,15 +23,14 @@ Section increment. ...@@ -23,15 +23,14 @@ Section increment.
Lemma incr_spec (l: loc) : Lemma incr_spec (l: loc) :
<<< (v : Z), l #v >>> incr #l @ <<< l #(v + 1), RET #v >>>. <<< (v : Z), l #v >>> incr #l @ <<< l #(v + 1), RET #v >>>.
Proof. Proof.
iApply wp_atomic_intro. iIntros (Φ) "AU". iLöb as "IH". wp_let. iApply wp_atomic_intro. iIntros (Φ) "AU". iLöb as "IH". wp_lam.
wp_apply load_spec; first by iAccu. wp_apply load_spec; first by iAccu.
(* Prove the atomic update for load *) (* Prove the atomic update for load *)
iAuIntro. iApply (aacc_aupd_abort with "AU"); first done. iAuIntro. iApply (aacc_aupd_abort with "AU"); first done.
iIntros (x) "H↦". iAaccIntro with "H↦"; first by eauto with iFrame. iIntros (x) "H↦". iAaccIntro with "H↦"; first by eauto with iFrame.
iIntros "$ !> AU !> _". iIntros "$ !> AU !> _".
(* Now go on *) (* Now go on *)
wp_let. wp_op. wp_bind (CAS _ _ _)%I. wp_let. wp_op. wp_apply cas_spec; [done|iAccu|].
wp_apply cas_spec; [done|iAccu|].
(* Prove the atomic update for CAS *) (* Prove the atomic update for CAS *)
iAuIntro. iApply (aacc_aupd with "AU"); first done. iAuIntro. iApply (aacc_aupd with "AU"); first done.
iIntros (x') "H↦". iAaccIntro with "H↦"; first by eauto with iFrame. iIntros (x') "H↦". iAaccIntro with "H↦"; first by eauto with iFrame.
...@@ -57,7 +56,7 @@ Section increment. ...@@ -57,7 +56,7 @@ Section increment.
weak_incr #l @ weak_incr #l @
<<< v = v' l #(v + 1), RET #v >>>. <<< v = v' l #(v + 1), RET #v >>>.
Proof. Proof.
iIntros "Hl". iApply wp_atomic_intro. iIntros (Φ) "AU". wp_let. iIntros "Hl". iApply wp_atomic_intro. iIntros (Φ) "AU". wp_lam.
wp_apply (atomic_wp_seq $! (load_spec _) with "Hl"). wp_apply (atomic_wp_seq $! (load_spec _) with "Hl").
iIntros "Hl". wp_let. wp_op. iIntros "Hl". wp_let. wp_op.
wp_apply store_spec; first by iAccu.