Commit 34d9d94b authored by Ralf Jung's avatar Ralf Jung

strengthen cinc spec: flag can be any GC'ed location

parent 787080a0
Pipeline #17805 passed with stage
in 18 minutes and 55 seconds
From stdpp Require Import namespaces.
From iris.heap_lang Require Export lifting notation.
From iris.program_logic Require Export atomic.
From iris_examples.logatom.lib Require Export gc.
Set Default Proof Using "Type".
(** A general logically atomic interface for conditional increment. *)
Record atomic_cinc {Σ} `{!heapG Σ} := AtomicCinc {
Record atomic_cinc {Σ} `{!heapG Σ, !gcG Σ} := AtomicCinc {
(* -- operations -- *)
new_counter : val;
cinc : val;
set_flag : val;
get : val;
(* -- other data -- *)
name : Type;
......@@ -16,34 +16,31 @@ Record atomic_cinc {Σ} `{!heapG Σ} := AtomicCinc {
name_countable : Countable name;
(* -- predicates -- *)
is_counter (N : namespace) (γs : name) (v : val) : iProp Σ;
counter_content (γs : name) (flag : bool) (c : Z) : iProp Σ;
counter_content (γs : name) (c : Z) : iProp Σ;
(* -- predicate properties -- *)
is_counter_persistent N γs v : Persistent (is_counter N γs v);
counter_content_timeless γs f c : Timeless (counter_content γs f c);
counter_content_exclusive γs f1 c1 f2 c2 :
counter_content γs f1 c1 - counter_content γs f2 c2 - False;
counter_content_timeless γs c : Timeless (counter_content γs c);
counter_content_exclusive γs c1 c2 :
counter_content γs c1 - counter_content γs c2 - False;
(* -- operation specs -- *)
new_counter_spec N :
N ## gcN
gc_inv -
{{{ True }}}
new_counter #()
{{{ ctr γs, RET ctr ; is_counter N γs ctr counter_content γs true 0 }}};
cinc_spec N γs v :
{{{ ctr γs, RET ctr ; is_counter N γs ctr counter_content γs 0 }}};
cinc_spec N γs v (f : loc) :
is_counter N γs v -
<<< (b : bool) (n : Z), counter_content γs b n >>>
cinc v @⊤∖↑N
<<< counter_content γs b (if b then n + 1 else n), RET #() >>>;
set_flag_spec N γs v (new_b: bool) :
is_counter N γs v -
<<< (b : bool) (n : Z), counter_content γs b n >>>
set_flag v #new_b @⊤∖↑N
<<< counter_content γs new_b n, RET #() >>>;
<<< (b : bool) (n : Z), counter_content γs n gc_mapsto f #b >>>
cinc v #f @⊤∖↑N∖↑gcN
<<< counter_content γs (if b then n + 1 else n) gc_mapsto f #b, RET #() >>>;
get_spec N γs v:
is_counter N γs v -
<<< (b : bool) (n : Z), counter_content γs b n >>>
get v @⊤∖↑N
<<< counter_content γs b n, RET #n >>>;
<<< (n : Z), counter_content γs n >>>
get v @⊤∖↑N∖↑gcN
<<< counter_content γs n, RET #n >>>;
}.
Arguments atomic_cinc _ {_}.
Arguments atomic_cinc _ {_ _}.
Existing Instances
is_counter_persistent counter_content_timeless
......
......@@ -7,7 +7,7 @@ Import uPred.
Definition gcN: namespace := nroot .@ "gc".
Definition gc_mapUR : ucmraT := gmapUR loc $ optionR $ exclR $ valC.
Definition gc_mapUR : ucmraT := gmapUR loc $ optionR $ exclR $ valO.
Definition to_gc_map (gcm: gmap loc val) : gc_mapUR := (λ v : val, Excl' v) <$> gcm.
......@@ -112,7 +112,9 @@ Section to_gc_map.
End to_gc_map.
Section gc.
Context `{!invG Σ, !heapG Σ, gG: gcG Σ}.
Context `{!invG Σ, !heapG Σ, !gcG Σ}.
(* FIXME: still needs a constructor. *)
Global Instance is_gc_loc_persistent (l: loc): Persistent (is_gc_loc l).
Proof. rewrite /is_gc_loc. apply _. Qed.
......@@ -158,7 +160,7 @@ Section gc.
iFrame.
Qed.
Lemma is_gc_lookup_Some l gcm: is_gc_loc l - own (gc_name gG) ( to_gc_map gcm) - ⌜∃ v, gcm !! l = Some v.
Lemma is_gc_lookup_Some l gcm: is_gc_loc l - own (gc_name _) ( to_gc_map gcm) - ⌜∃ v, gcm !! l = Some v.
iIntros "Hgc_l H◯".
iCombine "H◯ Hgc_l" as "Hcomb".
iDestruct (own_valid with "Hcomb") as %Hvalid.
......@@ -170,7 +172,7 @@ Section gc.
by apply leibniz_equiv_iff in Hsome.
Qed.
Lemma gc_mapsto_lookup_Some l v gcm: gc_mapsto l v - own (gc_name gG) ( to_gc_map gcm) - gcm !! l = Some v .
Lemma gc_mapsto_lookup_Some l v gcm: gc_mapsto l v - own (gc_name _) ( to_gc_map gcm) - gcm !! l = Some v .
Proof.
iIntros "Hgc_l H●".
iCombine "H● Hgc_l" as "Hcomb".
......@@ -180,12 +182,17 @@ Section gc.
by apply gc_map_singleton_included.
Qed.
Lemma gc_access l v E:
gcN E gc_inv - gc_mapsto l v ={E, E gcN}= (l v ( w, l w ={E gcN, E}= gc_mapsto l w)).
(** An accessor to make use of [gc_mapsto].
This opens the invariant *before* consuming [gc_mapsto] so that you can use
this before opening an atomic update that provides [gc_mapsto]!. *)
Lemma gc_access E:
gcN E
gc_inv ={E, E gcN}= l v, gc_mapsto l v -
(l v ( w, l w == gc_mapsto l w |={E gcN, E}=> True)).
Proof.
iIntros (HN) "#Hinv Hgc_l".
iIntros (HN) "#Hinv".
iMod (inv_open_timeless _ gcN _ with "Hinv") as "[P Hclose]"=>//.
iModIntro.
iIntros "!>" (l v) "Hgc_l".
iDestruct "P" as (gcm) "[H● HsepM]".
iDestruct (gc_mapsto_lookup_Some with "Hgc_l H●") as %Hsome.
iDestruct (big_sepM_delete with "HsepM") as "[Hl HsepM]"=>//.
......@@ -199,6 +206,7 @@ Section gc.
iDestruct (big_sepM_insert with "[Hl HsepM]") as "HsepM"; [ | iFrame | ].
{ apply lookup_delete. }
rewrite insert_delete. rewrite <- to_gc_map_insert.
iModIntro. iFrame.
iMod ("Hclose" with "[H● HsepM]"); [ iExists _; by iFrame | by iModIntro].
Qed.
......
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