Commit 9ff91ebf authored by Jonas Kastberg Hinrichsen's avatar Jonas Kastberg Hinrichsen
Browse files

Stored backups; moved new CMRA's to lib, proved half of proc CMRA

parent 38cc4832
Pipeline #7811 failed with stages
in 0 seconds
......@@ -51,6 +51,8 @@ theories/base_logic/lib/cancelable_invariants.v
theories/base_logic/lib/counter_examples.v
theories/base_logic/lib/fractional.v
theories/base_logic/lib/gen_heap.v
theories/base_logic/lib/gen_proc.v
theories/base_logic/lib/gen_dist.v
theories/base_logic/lib/core.v
theories/base_logic/lib/fancy_updates_from_vs.v
theories/program_logic/adequacy.v
......
From iris.algebra Require Import auth gmap frac agree.
From iris.base_logic Require Export gen_heap.
From iris.base_logic.lib Require Export own.
From iris.base_logic.lib Require Import fractional.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Import uPred.
(* Channel state *)
Definition gen_chanUR (L V : Type) `{Countable L} : ucmraT :=
gmapUR L ((* agreeR *) exclR (leibnizC (list V * list V))).
Definition to_gen_chan {L V} `{Countable L} (σ : gmap L (list V * list V)) : gen_chanUR L V :=
fmap (λ v, to_excl (v : leibnizC (list V * list V))) σ.
Class gen_chanG (L V : Type) (Σ :gFunctors) `{Countable L} := Gen_ChanG {
gen_chan_inG :> inG Σ (authR (gen_chanUR L V)); (* Why authR? *)
gen_chan_name : gname
}.
Arguments gen_chan_name {_ _ _ _ _} _ : assert.
Section chan_definitions.
Context `{cG : gen_chanG L V Σ}.
Definition gen_chan_ctx (σ : gmap L (list V * list V)) : iProp Σ :=
own (gen_chan_name cG) ( (to_gen_chan σ)) (* ∗ gen_heap_ctx (snd σ) *).
Definition chan_mapsto_def (l : L) (b : list V * list V) : iProp Σ :=
own (gen_chan_name cG) ( {[ l := to_excl (b : leibnizC (list V * list V)) ]}).
Definition chan_mapsto_aux : seal (@chan_mapsto_def). by eexists. Qed.
Definition chan_mapsto := unseal chan_mapsto_aux.
Definition chan_mapsto_eq : @chan_mapsto = @chan_mapsto_def := seal_eq chan_mapsto_aux.
End chan_definitions.
Local Notation "l c↦ [ a , b ]" :=
(chan_mapsto l (a,b)) (at level 20).
Local Notation "l c↦ -" :=
( l r, l c [l,r])%I (at level 20) : uPred_scope.
(* Dist state *)
Definition gen_distUR (L V : Type) `{Countable L} : ucmraT :=
prodUR
((gen_procUR L V))
((gen_chanUR L V)).
Definition to_gen_dist {L V} `{Countable L} (σ : ((gmap L (gmap L V)) * (gmap L (list V * list V)))) : gen_distUR L V :=
((to_gen_proc σ.1), (to_gen_chan σ.2)).
Class gen_distG (L V : Type) (Σ :gFunctors) `{Countable L} := Gen_DistG {
gen_dist_inG :> inG Σ (authR (gen_distUR L V)); (* Why authR? *)
gen_dist_name : gname
}.
Arguments gen_dist_name {_ _ _ _ _} _ : assert.
Section definitions.
Context `{dG : gen_distG L V Σ}.
Definition points_to (l:L) (v:V) : L * V := (l,v).
Inductive proc_mapping : Type :=
| p_init : L -> proc_mapping
| p_map : L -> L -> Qp -> V -> proc_mapping
| c_map : L -> list V * list V -> proc_mapping.
Definition gen_dist_ctx (σ : (gmap L (gmap L V)) * (gmap L (list V * list V))) : iProp Σ :=
own (gen_dist_name dG) ( (to_gen_dist σ)).
Definition dist_match (pm : proc_mapping) :
gen_distUR L V :=
match pm with
| p_init p => ({[ p := ]}, )
| p_map p l q v => ({[ p := {[ l := (q, to_agree (v : leibnizC V))]} ]}, )
| c_map c b => (, {[ c := to_excl (b : leibnizC (list V * list V)) ]})
end.
(* Definition dist_match (proc : (L + (L * L * Qp * V)) + (L * (list V * list V))) : *)
(* gen_distUR L V := *)
(* match proc with *)
(* | inl (p) => (match p with *)
(* | inl (p) => {[ p := ∅ ]} *)
(* | inr (p, l, q, v) => {[ p := {[ l := (q, to_agree (v : leibnizC V))]} ]} *)
(* end, ∅) *)
(* | inr (c, b) => (∅, *)
(* {[ c := to_excl (b : leibnizC (list V * list V)) ]}) *)
(* end. *)
Definition dist_mapsto_def (pm : proc_mapping) : iProp Σ :=
(own (gen_dist_name dG) ( (dist_match pm))).
(* Definition dist_mapsto_def (proc : (L + (L * L * Qp * V)) + (L * (list V * list V))) : iProp Σ := *)
(* (own (gen_dist_name dG) (◯ (dist_match proc))). *)
Definition dist_mapsto_aux : seal (@dist_mapsto_def). by eexists. Qed.
Definition dist_mapsto := unseal dist_mapsto_aux.
Definition dist_mapsto_eq : @dist_mapsto = @dist_mapsto_def := seal_eq dist_mapsto_aux.
End definitions.
Local Notation "l p↦{ p }{ q } v" :=
(dist_mapsto (p_map p l q v)) (at level 20).
(* Local Notation "l p↦{ p }{ q } v" := *)
(* (dist_mapsto (inl (p, l, q, v))) (at level 20). *)
Local Notation "l p↦{ p } v" :=
(l p{p}{1} v)%I (at level 20).
Local Notation "l p↦{ p }{ q } -" :=
( v, l p{p}{q} v)%I (at level 20) : uPred_scope.
Local Notation "l p↦{ p } -" :=
( v, l p{p} v)%I (at level 20) : uPred_scope.
Local Notation "< p >" :=
(dist_mapsto (p_init p)) (at level 20).
Local Notation "l c↦ [ a , b ]" :=
(dist_mapsto (c_map l (a,b))) (at level 20).
(* Local Notation "l c↦ [ a , b ]" := *)
(* (dist_mapsto (inr (l, (a,b)))) (at level 20). *)
Local Notation "l c↦ -" :=
( l r, l c [l,r])%I (at level 20) : uPred_scope.
(* Section definitions. *)
(* Context `{dG : gen_distG L V Σ}. *)
(* Definition points_to (l:L) (v:V) : L * V := (l,v). *)
(* Definition gen_dist_ctx (σ : (gmap L (gmap L V)) * (gmap L (list V * list V))) : iProp Σ := *)
(* own (gen_dist_name dG) (● (to_gen_dist σ)). *)
(* Definition dist_match (proc : (L * gmap L V) + (L * (list V * list V))) : *)
(* gen_distUR L V := *)
(* match proc with *)
(* | inl (p, h) => ({[ p := to_gen_heap h ]}, *)
(* ∅) *)
(* | inr (c, b) => (∅, *)
(* {[ c := to_excl (b : leibnizC (list V * list V)) ]}) *)
(* end. *)
(* Definition dist_mapsto_def (proc : (L * gmap L V) + (L * (list V * list V))) : iProp Σ := *)
(* (own (gen_dist_name dG) (◯ (dist_match proc))). *)
(* Definition dist_mapsto_aux : seal (@dist_mapsto_def). by eexists. Qed. *)
(* Definition dist_mapsto := unseal dist_mapsto_aux. *)
(* Definition dist_mapsto_eq : @dist_mapsto = @dist_mapsto_def := seal_eq dist_mapsto_aux. *)
(* (* Double check this *) *)
(* Definition tmp p h : iProp Σ := dist_mapsto (inl (p, h)). *)
(* Definition tmp2 c b : iProp Σ := dist_mapsto (inr (c, b)). *)
(* End definitions. *)
(* Local Notation "{ x , .. , y }" := *)
(* (cons x .. (cons y nil) ..). *)
(* Check {5, 7}. *)
(* (* Local Notation "{ x , .. , y }{ p }" := *) *)
(* (* (dist_mapsto (inl (p, foldr (fun lv m => <[lv.1 := lv.2]>m) ∅ ((cons x .. (cons y nil) ..))))). *) *)
(* Local Notation "{ x , .. , y }{ p }" := *)
(* (p, foldr (fun lv m => <[lv.1 := lv.2]>m) (∅:gmap nat nat) ((cons x .. (cons y nil) ..))). *)
(* Check foldr. *)
(* Check {(5,6), (1,2)}{3}. *)
(* Check {3 ↦ 5, 1 ↦ 2}{3}. *)
(* Local Notation "l p↦{ p }{ q } v" := *)
(* (dist_mapsto (inl (p, l, q, v))) (at level 20). *)
(* Local Notation "l p↦{ p } v" := *)
(* (l p↦{p}{1} v)%I (at level 20). *)
(* Local Notation "l p↦{ p }{ q } -" := *)
(* (∃ v, l p↦{p}{q} v)%I (at level 20) : uPred_scope. *)
(* Local Notation "l p↦{ p } -" := *)
(* (∃ v, l p↦{p} v)%I (at level 20) : uPred_scope. *)
(* Local Notation "{ x , .. , y }{ p }" := *)
(* (dist_mapsto (inl (p, foldr (fun lv m => <[lv.1 := lv.2]>m) (∅) ((cons x .. (cons y nil) ..))))). *)
(* Local Notation "{ }{ p }" := *)
(* (dist_mapsto (inl (p, ∅))). *)
(* Local Notation "l ↦ v" := *)
(* (points_to l v) (at level 20). *)
(* Local Notation "l ↦ -" := *)
(* (∃ v, (l,v)) (at level 20). *)
(* Local Notation "l c↦ [ a , b ]" := *)
(* (dist_mapsto (inr (l, (a,b)))) (at level 20). *)
(* Local Notation "l c↦ -" := *)
(* (∃ l r, l c↦ [l,r])%I (at level 20) : uPred_scope. *)
(* Section definitions. *)
(* Context `{dG : gen_distG L V Σ}. *)
(* Definition gen_dist_ctx (σ : (gmap L (gmap L V)) * (gmap L (list V * list V))) : iProp Σ := *)
(* own (gen_dist_name dG) (● (to_gen_dist σ)). *)
(* Definition dist_match (proc : (L * L * Qp * V) + (L * (list V * list V))) : *)
(* gen_distUR L V := *)
(* match proc with *)
(* | inl (p, l, q, v) => (to_auth {[ p := {[ l := (q, to_agree (v : leibnizC V))]} ]}, *)
(* to_auth ∅) *)
(* | inr (c, b) => (to_auth ∅, *)
(* to_auth {[ c := to_excl (b : leibnizC (list V * list V)) ]}) *)
(* end. *)
(* Definition dist_mapsto_def (proc : (L * L * Qp * V) + (L * (list V * list V))) : iProp Σ := *)
(* (own (gen_dist_name dG) (◯ (dist_match proc))). *)
(* Definition dist_mapsto_aux : seal (@dist_mapsto_def). by eexists. Qed. *)
(* Definition dist_mapsto := unseal dist_mapsto_aux. *)
(* Definition dist_mapsto_eq : @dist_mapsto = @dist_mapsto_def := seal_eq dist_mapsto_aux. *)
(* (* Double check this *) *)
(* Definition tmp p l q v : iProp Σ := dist_mapsto (inl (p, l, q, v)). *)
(* Definition tmp2 c b : iProp Σ := dist_mapsto (inr (c, b)). *)
(* End definitions. *)
(* Local Notation "l p↦{ p }{ q } v" := *)
(* (dist_mapsto (inl (p, l, q, v))) (at level 20). *)
(* Local Notation "l p↦{ p } v" := *)
(* (l p↦{p}{1} v)%I (at level 20). *)
(* Local Notation "l p↦{ p }{ q } -" := *)
(* (∃ v, l p↦{p}{q} v)%I (at level 20) : uPred_scope. *)
(* Local Notation "l p↦{ p } -" := *)
(* (∃ v, l p↦{p} v)%I (at level 20) : uPred_scope. *)
(* Local Notation "l c↦ [ a , b ]" := *)
(* (dist_mapsto (inr (l, (a,b)))) (at level 20). *)
(* Local Notation "l c↦ -" := *)
(* (∃ l r, l c↦ [l,r])%I (at level 20) : uPred_scope. *)
Section to_gen_dist.
Context (L V : Type) `{Countable L}.
Implicit Types σh : gmap L V.
Implicit Types σc : gmap L (list V * list V).
Implicit Types σ : gmap L (gmap L V) * gmap L (list V * list V).
(* TODO: Ensure AuthR not needed. *)
(** Conversion to heaps and back *)
Lemma to_gen_dist_valid σ : to_gen_dist σ.
Proof. destruct σ. split.
- simpl. intros l. rewrite lookup_fmap. case (g !! l); try reflexivity. intro g'. intros l'. rewrite lookup_fmap. by case (g' !! l').
- simpl. intros l. rewrite lookup_fmap. by case (g0 !! l).
Qed.
Lemma lookup_to_gen_proc_None σ l : σ.1 !! l = None (to_gen_dist σ).1 !! l = None.
Proof. by rewrite /to_gen_dist lookup_fmap=> ->. Qed.
Lemma gen_proc_singleton_included σ (p:L) (h : gmap L V) :
{[p := to_gen_heap h]} (to_gen_dist σ).1 σ.1 !! p = Some h.
Proof.
destruct σ. simpl.
rewrite singleton_included=> -[[q' av] []].
intro. rewrite Some_included_total.
unfold to_gen_heap.
rewrite singleton_included=> -[[q' av] []].
rewrite singleton_included=> -[[q' av] []].
rewrite /to_gen_proc lookup_fmap fmap_Some_equiv => -[Hl [/= -> ->]].
unfold to_gen_heap. unfold to_gen_proc.
rewrite singleton_included=> -[[q' av] []].
rewrite /to_gen_proc lookup_fmap fmap_Some_equiv => -[Hl [/= -> ->]].
rewrite /to_gen_heap.
move=> /Some_included_total -> //.
move=> /Some_included_total [_] /to_agree_included /leibniz_equiv_iff -> //.
rewrite singleton_included=> -[[q' av] []].
rewrite /to_gen_proc lookup_fmap fmap_Some_equiv => -[v' [Hl [/= -> ->]]].
move=> /Some_pair_included_total_2 [_] /to_agree_included /leibniz_equiv_iff -> //.
Qed.
Lemma to_gen_heap_insert l v σ :
to_gen_heap (<[l:=v]> σ) = <[l:=(1%Qp, to_agree (v:leibnizC V))]> (to_gen_heap σ).
Proof. by rewrite /to_gen_heap fmap_insert. Qed.
Lemma to_gen_heap_delete l σ :
to_gen_heap (delete l σ) = delete l (to_gen_heap σ).
Proof. by rewrite /to_gen_heap fmap_delete. Qed.
Lemma lookup_to_gen_chan_None σ l : σ.2 !! l = None (to_gen_dist σ).2 !! l = None.
Proof. by rewrite /to_gen_dist lookup_fmap=> ->. Qed.
End to_gen_heap.
\ No newline at end of file
From iris.algebra Require Import auth gmap frac agree.
From iris.base_logic Require Export gen_heap.
From iris.base_logic.lib Require Export own.
From iris.base_logic.lib Require Import fractional.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Import uPred.
Definition to_auth {A} (a : A) : auth A :=
{| authoritative := Excl' a; auth_own := a |}.
Definition to_excl {A} (a : A) : excl A := Excl a.
(* Process state *)
Definition gen_procUR (L V : Type) `{Countable L} : ucmraT :=
gmapUR L (gen_heapUR L V).
Definition to_gen_proc {L V} `{Countable L} (σ : (gmap L (gmap L V))) : gen_procUR L V :=
(* fmap (λ h, (fmap (λ v, (1%Qp, to_agree (v : leibnizC V))) h)) σ. *)
fmap (λ h, to_gen_heap h) σ.
(** The CMRA we need. *)
Class gen_procG (L V : Type) (Σ :gFunctors) `{Countable L} := GenProcG {
gen_proc_inG :> inG Σ (authR (gen_procUR L V)); (* Why authR? *)
gen_proc_name : gname
}.
Arguments gen_proc_name {_ _ _ _ _} _ : assert.
Class gen_procPreG (L V : Type) (Σ : gFunctors) `{Countable L} :=
{ gen_proc_preG_inG :> inG Σ (authR (gen_procUR L V)) }.
Definition gen_procΣ (L V : Type) `{Countable L} : gFunctors :=
#[GFunctor (authR (gen_procUR L V))].
Instance subG_gen_procPreG {Σ L V} `{Countable L} :
subG (gen_procΣ L V) Σ gen_procPreG L V Σ.
Proof. solve_inG. Qed.
Section proc_definitions.
Context `{pG : gen_procG L V Σ}.
Definition gen_proc_ctx (σ : gmap L (gmap L V)) : iProp Σ :=
own (gen_proc_name pG) ( (to_gen_proc σ)) (* ∗ gen_heap_ctx (snd σ) *).
Inductive proc_mapping : Type :=
| pinit : L -> proc_mapping
| pmap : L -> L -> Qp -> V -> proc_mapping
.
Definition proc_match (pm : proc_mapping) :
gen_procUR L V :=
match pm with
| pinit p => {[ p := ]}
| pmap p l q v => {[ p := {[ l := (q, to_agree (v : leibnizC V))]} ]}
end.
Definition proc_mapsto_def (pm : proc_mapping) : iProp Σ :=
own (gen_proc_name pG) ( (proc_match pm) ).
(* Definition proc_mapsto_def (p : L) (l : L) (q:Qp) (v : V) : iProp Σ := *)
(* own (gen_proc_name pG) (◯ {[ p := {[ l := (q, to_agree (v : leibnizC V)) ]} ]}). *)
(* Definition proc_mapsto_def (pid : L) (h : gmap L V) : iProp Σ := *)
(* own (gen_proc_name pG) (◯ {[ pid := to_gen_heap h ]}). *)
Definition proc_mapsto_aux : seal (@proc_mapsto_def). by eexists. Qed.
Definition proc_mapsto := unseal proc_mapsto_aux.
Definition proc_mapsto_eq : @proc_mapsto = @proc_mapsto_def := seal_eq proc_mapsto_aux.
End proc_definitions.
Local Notation "l p↦{ p }{ q } v" :=
(proc_mapsto (pmap p l q v)) (at level 20).
Local Notation "l p↦{ p } v" :=
(l p{p}{1} v)%I (at level 20).
Local Notation "l p↦{ p }{ q } -" :=
( v, l p{p}{q} v)%I (at level 20) : uPred_scope.
Local Notation "l p↦{ p } -" :=
( v, l p{p} v)%I (at level 20) : uPred_scope.
Local Notation "< p >" :=
(proc_mapsto (pinit p)) (at level 20).
Section to_gen_proc.
Context (L V : Type) `{Countable L}.
Implicit Types σ : gmap L (gmap L V).
(** Conversion to heaps and back *)
Lemma to_gen_proc_valid σ : to_gen_proc σ.
Proof.
simpl. intros l. rewrite lookup_fmap. case (σ !! l); try reflexivity. intro g'. intros l'. rewrite lookup_fmap. by case (g' !! l').
Qed.
Lemma lookup_to_gen_proc_None σ l : σ !! l = None (to_gen_proc σ) !! l = None.
Proof. by rewrite /to_gen_proc lookup_fmap=> ->. Qed.
Lemma gen_proc_singleton_included σ (p:L) (l:L) (q:Qp) (v:V):
{[p := {[l := (q, to_agree v)]}]} (to_gen_proc σ) match (σ !! p) with None => None | Some(h) => h !! l end = Some v.
Proof.
rewrite singleton_included=> -[ah].
rewrite /to_gen_proc lookup_fmap fmap_Some_equiv => -[h'].
move=> /Some_included_total. destruct h'. destruct H0. rewrite H1.
intro.
rewrite H0.
revert H2.
apply gen_heap_singleton_included.
Qed.
Lemma to_gen_proc_insert (p:L) (l:L) (v:V) (σ : gmap L (gmap L V)) :
to_gen_proc (<[ p := match (σ !! p) with None => <[l:=v]> | Some(h) => <[l:=v]>h end]>σ) = <[ p := match (σ !! p) with None => <[l:=(1%Qp, to_agree (v:leibnizC V))]>(to_gen_heap ) | Some(h) => <[l:=(1%Qp, to_agree (v:leibnizC V))]>(to_gen_heap h) end]> (to_gen_proc σ).
Proof. destruct (σ !! p).
- rewrite /to_gen_proc fmap_insert.
assert (to_gen_heap (<[l:=v]>g) = <[l:=(1%Qp, to_agree v)]> (to_gen_heap g)).
apply to_gen_heap_insert.
rewrite H0. reflexivity.
- rewrite /to_gen_proc fmap_insert.
assert ((to_gen_heap ((<[l := v]>):(gmap L V))) = ((<[l := (1%Qp, to_agree v)]>(to_gen_heap )):(gen_heapUR L V))). by rewrite /to_gen_heap fmap_insert. rewrite H0. reflexivity. Qed.
Lemma to_gen_proc_delete p l σ :
to_gen_proc (match σ !! p with None => σ | Some(h) => <[p := delete l h]>σ end) =
match σ !! p with None => (to_gen_proc σ) | Some(h) => <[p := delete l (to_gen_heap h)]>(to_gen_proc σ) end.
Proof.
destruct (σ !! p); try eauto.
- rewrite /to_gen_proc fmap_insert.
assert (to_gen_heap (delete l g) = delete l (to_gen_heap g)). apply to_gen_heap_delete. rewrite H0. reflexivity.
Qed.
End to_gen_proc.
Lemma gen_proc_init `{gen_procPreG L V Σ} σ :
(|==> _ : gen_procG L V Σ, gen_proc_ctx σ)%I.
Proof.
iMod (own_alloc ( to_gen_proc σ)) as (γ) "Hh".
{ apply: auth_auth_valid. exact: to_gen_proc_valid. }
iModIntro. by iExists (GenProcG L V Σ _ _ _ γ).
Qed.
(* Construction beyond this point! *)
Section gen_heap.
Context `{gen_heapG L V Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : V iProp Σ.
Implicit Types σ : gmap L V.
Implicit Types h g : gen_heapUR L V.
Implicit Types l : L.
Implicit Types v : V.
(** General properties of mapsto *)
Global Instance mapsto_timeless l q v : Timeless (l {q} v).
Proof. rewrite mapsto_eq /mapsto_def. apply _. Qed.
Global Instance mapsto_fractional l v : Fractional (λ q, l {q} v)%I.
Proof.
intros p q. by rewrite mapsto_eq -own_op -auth_frag_op
op_singleton pair_op agree_idemp.
Qed.
Global Instance mapsto_as_fractional l q v :
AsFractional (l {q} v) (λ q, l {q} v)%I q.
Proof. split. done. apply _. Qed.
Lemma mapsto_agree l q1 q2 v1 v2 : l {q1} v1 - l {q2} v2 - v1 = v2.
Proof.
apply wand_intro_r.
rewrite mapsto_eq -own_op -auth_frag_op own_valid discrete_valid.
f_equiv=> /auth_own_valid /=. rewrite op_singleton singleton_valid pair_op.
by intros [_ ?%agree_op_invL'].
Qed.
Global Instance ex_mapsto_fractional l : Fractional (λ q, l {q} -)%I.
Proof.
intros p q. iSplit.
- iDestruct 1 as (v) "[H1 H2]". iSplitL "H1"; eauto.
- iIntros "[H1 H2]". iDestruct "H1" as (v1) "H1". iDestruct "H2" as (v2) "H2".
iDestruct (mapsto_agree with "H1 H2") as %->. iExists v2. by iFrame.
Qed.
Global Instance ex_mapsto_as_fractional l q :
AsFractional (l {q} -) (λ q, l {q} -)%I q.
Proof. split. done. apply _. Qed.
Lemma mapsto_valid l q v : l {q} v - q.
Proof.
rewrite mapsto_eq /mapsto_def own_valid !discrete_valid.
by apply pure_mono=> /auth_own_valid /singleton_valid [??].
Qed.
Lemma mapsto_valid_2 l q1 q2 v1 v2 : l {q1} v1 - l {q2} v2 - (q1 + q2)%Qp.
Proof.
iIntros "H1 H2". iDestruct (mapsto_agree with "H1 H2") as %->.
iApply (mapsto_valid l _ v2). by iFrame.
Qed.
Lemma gen_heap_alloc σ l v :
σ !! l = None gen_heap_ctx σ == gen_heap_ctx (<[l:=v]>σ) l v.
Proof.
iIntros (?) "Hσ". rewrite /gen_heap_ctx mapsto_eq /mapsto_def.
iMod (own_update with "Hσ") as "[Hσ Hl]".
{ eapply auth_update_alloc,
(alloc_singleton_local_update _ _ (1%Qp, to_agree (v:leibnizC _)))=> //.
by apply lookup_to_gen_heap_None. }
iModIntro. rewrite to_gen_heap_insert. iFrame.
Qed.
Lemma gen_heap_dealloc σ l v :
gen_heap_ctx σ - l v == gen_heap_ctx (delete l σ).
Proof.
iIntros "Hσ Hl". rewrite /gen_heap_ctx mapsto_eq /mapsto_def.
rewrite to_gen_heap_delete. iApply (own_update_2 with "Hσ Hl").
eapply auth_update_dealloc, (delete_singleton_local_update _ _ _).
Qed.
Lemma gen_heap_valid σ l q v : gen_heap_ctx σ - l {q} v - ⌜σ !! l = Some v.
Proof.
iIntros "Hσ Hl". rewrite /gen_heap_ctx mapsto_eq /mapsto_def.
iDestruct (own_valid_2 with "Hσ Hl")
as %[Hl%gen_heap_singleton_included _]%auth_valid_discrete_2; auto.
Qed.
Lemma gen_heap_update σ l v1 v2 :
gen_heap_ctx σ - l v1 == gen_heap_ctx (<[l:=v2]>σ) l v2.
Proof.
iIntros "Hσ Hl". rewrite /gen_heap_ctx mapsto_eq /mapsto_def.
iDestruct (own_valid_2 with "Hσ Hl")
as %[Hl%gen_heap_singleton_included _]%auth_valid_discrete_2.
iMod (own_update_2 with "Hσ Hl") as "[Hσ Hl]".
{ eapply auth_update, singleton_local_update,
(exclusive_local_update _ (1%Qp, to_agree (v2:leibnizC _)))=> //.
by rewrite /to_gen_heap lookup_fmap Hl. }
iModIntro. rewrite to_gen_heap_insert. iFrame.
Qed.
End gen_heap.
\ No newline at end of file
......@@ -465,37 +465,39 @@ Definition buffer := prod (list val) (list val).
Definition channels := gmap chan_id buffer.
Definition state' := prod heap channels.
Canonical Structure state'C := leibnizC state'.
Inductive head_step' : expr state' expr state' list (expr) Prop :=
| ExprS e σs σc e' σs' es :
head_step e σs e' σs' es
head_step' e (σs,σc) e' (σs',σc) es
| SendLS σs σc l l' r' e v:
| ExprS e σh σc e' σh' es :
head_step e σh e' σh' es
head_step' e (σh,σc) e' (σh',σc) es
| SendLS σh σc l l' r' e v:
σc !! l = Some $ (l',r')
to_val e = Some $ v
head_step' (Send (Lit $ LitChan l Left) e) (σs, σc) (Lit $ LitUnit) (σs, <[l:=((l' ++ [v]),r')]>σc) []
| SendRS σs σc l l' r' e v:
head_step' (Send (Lit $ LitChan l Left) e) (σh, σc) (Lit $ LitUnit) (σh, <[l:=((l' ++ [v]),r')]>σc) []
| SendRS σh σc l l' r' e v:
σc !! l = Some $ (l',r')
to_val e = Some $ v
head_step' (Send (Lit $ LitChan l Right) e) (σs, σc) (Lit $ LitUnit) (σs, <[l:=(l',(r' ++ [v]))]>σc) []
| RecvLSucS l l' r' rv σs σc :
head_step' (Send (Lit $ LitChan l Right) e) (σh, σc) (Lit $ LitUnit) (σh, <[l:=(l',(r' ++ [v]))]>σc) []
| RecvLSucS l l' r' rv σh σc :
σc !! l = Some $ (l',(rv::r'))
head_step' (Recv (Lit $ LitChan l Left)) (σs, σc) (of_val rv) (σs, <[l:= (l',r')]>σc) []
| RecvRSucS l l' r' lv σs σc :