Commit 3a99baa4 authored by Simon Friis Vindum's avatar Simon Friis Vindum

Refactor proof and cleanup things

parent 33247d9f
......@@ -165,34 +165,25 @@ Section CG_queue.
(App (Fst (Var 0)) Unit)
).
(* Lemma CG_queue_test : WP program {{ v, ⌜v = #nv 3⌝ }}%I. *)
(* Proof. *)
(* rewrite /program. *)
(* iApply (wp_bind (fill [LetInCtx _])). *)
(* iApply wp_pure_step_later; auto. iNext. *)
(* Abort. *)
(* Representation predicate for the course grained queue. *)
Fixpoint isCGQueue_go (xs : list val) : val :=
Fixpoint isCGQueue (xs : list val) : val :=
match xs with
| nil => FoldV noneV
| x :: xs' => FoldV (InjRV (PairV x (isCGQueue_go xs')))
| x :: xs' => FoldV (InjRV (PairV x (isCGQueue xs')))
end.
Definition isCGQueue ( : loc) (xs : list val) : iProp Σ :=
↦ₛ (isCGQueue_go xs).
Definition cgQueueInv ( : loc) (xs : list val) lock : iProp Σ :=
↦ₛ (isCGQueue xs) lock ↦ₛ (#v false).
Lemma steps_CG_dequeue_cons E j K x xs lock :
nclose specN E
spec_ctx j fill K (App (CG_dequeue (Loc ) (Loc lock)) Unit)
isCGQueue (x :: xs)
lock ↦ₛ (#v false)
cgQueueInv (x :: xs) lock
|={E}=> j fill K (InjR (of_val x))
isCGQueue (xs)
lock ↦ₛ (#v false).
cgQueueInv xs lock.
Proof.
iIntros (HNE) "(#spec & Hj & isQueue & lofal)".
rewrite /isCGQueue /CG_dequeue. simpl.
rewrite /cgQueueInv /CG_dequeue. simpl.
iMod (steps_with_lock _ _ _ _ _ ( ↦ₛ FoldV (InjRV (PairV x _)))%I
_ (InjRV x) UnitV
with "[$Hj $isQueue $lofal]") as "Hj"; eauto.
......@@ -218,14 +209,12 @@ Section CG_queue.
Lemma steps_CG_dequeue_nil E j K lock :
nclose specN E
spec_ctx j fill K (App (CG_dequeue (Loc ) (Loc lock)) Unit)
isCGQueue []
lock ↦ₛ (#v false)
cgQueueInv [] lock
|={E}=> j fill K (none)
isCGQueue []
lock ↦ₛ (#v false).
cgQueueInv [] lock.
Proof.
iIntros (HNE) "(#spec & Hj & isQueue & lofal)".
rewrite /isCGQueue /CG_dequeue. simpl.
rewrite /cgQueueInv /CG_dequeue. simpl.
iMod (steps_with_lock _ _ _ _ _ ( ↦ₛ FoldV (noneV))%I
_ (noneV) UnitV
with "[$Hj $isQueue $lofal]") as "Hj"; eauto.
......@@ -251,12 +240,12 @@ Section CG_queue.
(InjR
(Pair (Fst (ids 0))
(App (ids 1) (Unfold (Snd (ids 0)))))))))
(Unfold (of_val (isCGQueue_go xs)))).
(Unfold (of_val (isCGQueue xs)))).
Lemma steps_CG_enqueue_body E j K x xs :
nclose specN E
spec_ctx j fill K (inner x xs)
|={E}=> j fill K (of_val (isCGQueue_go (xs ++ [x]))).
|={E}=> j fill K (of_val (isCGQueue (xs ++ [x]))).
Proof.
iIntros (HNE) "(#spec & Hj)".
iInduction xs as [|x' xs'] "IH" forall (K).
......@@ -281,19 +270,17 @@ Section CG_queue.
Lemma steps_CG_enqueue E j K x xs lock :
nclose specN E
spec_ctx j fill K (App (CG_enqueue (Loc ) (Loc lock)) (of_val x))
isCGQueue (xs)
lock ↦ₛ (#v false)
cgQueueInv (xs) lock
|={E}=> j fill K (Unit)
isCGQueue (xs ++ [x])
lock ↦ₛ (#v false).
cgQueueInv (xs ++ [x]) lock.
Proof.
iIntros (HNE) "(#spec & Hj & isQueue & lofal)".
iMod (steps_with_lock _ _ _ _ _ (isCGQueue _ _)
iMod (steps_with_lock _ _ _ _ _ ( ↦ₛ (isCGQueue xs))%I
_ UnitV x
with "[$Hj $isQueue $lofal]") as "Hj"; eauto.
iIntros (K') "(#Hspec & isQueue & Hj)".
iMod (do_step_pure with "[$Hj]") as "Hj"; eauto. iAsimpl.
rewrite /isCGQueue.
rewrite /cgQueueInv.
iMod (step_load _ _ (UnfoldCtx :: AppRCtx (RecV _) :: StoreRCtx (LocV _) :: K') with "[Hj $isQueue]")
as "[Hj isQueue]"; eauto.
simpl.
......
......@@ -67,8 +67,7 @@ Definition MS_dequeue :=
tail <- n ;;
()
else try ()
Right c' =>
try (snd c')
Right c' => try ()
)
()
*)
......
(* This module contains definitions and lemmas that are used in the refinement
proofs of both variants of the MS-queue. *)
From Coq.Lists Require Import List.
From iris.algebra Require Import csum excl auth list gmap.
From iris.program_logic Require Import adequacy ectxi_language.
......@@ -15,15 +18,55 @@ Ltac iExistsFrame :=
(done || (iLeft; iExistsFrame) || (iRight; iExistsFrame) || fail "Could not solve goal").
Notation "◓ v" := ((1/2)%Qp, to_agree v) (at level 20).
Notation "◔ v" := ((1/4)%Qp, to_agree v) (at level 20).
Section common.
Definition noneV := InjLV UnitV.
Definition someV v := InjRV v.
Definition locO := leibnizO loc.
Definition fracAgreeR : cmraT := prodR fracR (agreeR locO).
Definition nodeStateR : cmraT := authUR mnatUR.
Context `{heapIG Σ, cfgSG Σ, inG Σ fracAgreeR, inG Σ exlTokR, inG Σ nodeUR, inG Σ nodeStateR}.
(* Lemmas and definitions for the state of a node in relation to the sentinel
position. *)
Definition nodeLive := 0 : mnat.
Definition nodeSentinel := 1 : mnat.
Definition nodeDead := 2 : mnat.
Lemma node_update ι (x y : mnat) : x y own ι ( x) == own ι ( y).
Proof.
iIntros. iApply (own_update with "[$]"). by eapply auth_update_auth, mnat_local_update.
Qed.
Lemma update_sentinel_dead ι : own ι ( nodeSentinel) == own ι ( nodeDead).
Proof. iApply node_update. unfold nodeSentinel, nodeDead. lia. Qed.
Lemma update_live_sentinel ι : own ι ( nodeLive) == own ι ( nodeSentinel).
Proof. iApply node_update. unfold nodeLive, nodeSentinel. lia. Qed.
Lemma state_agree ι q p s1 s2 : own ι ({q} s1) - own ι ({p} s2) - s1 = s2.
Proof.
iIntros. by iDestruct (own_valid_2 with "[$] [$]") as %E%auth_auth_frac_op_invL.
Qed.
Lemma state_leq ι q (s1 s2 : mnat) : own ι ({q} s1) - own ι ( s2) - s2 s1.
Proof.
iIntros. by iDestruct (own_valid_2 with "[$] [$]") as %[_ [a%mnat_included _]]%auth_both_frac_valid.
Qed.
(* Lemmas related to nodes. *)
(* Expresses that ℓ points to a non-nil node. *)
Definition pointsToSome : iProp Σ :=
n x next, ↦ᵢ{-} (LocV n) n ↦ᵢ{-} FoldV (someV (PairV x next)).
(* Lemmas regarding fractional agreement. *)
Lemma fracAgree_agree γ (q1 q2 : Qp) v1 v2 :
own γ (q1, to_agree v1) - own γ (q2, to_agree v2) - v1 = v2.
Proof.
......@@ -58,6 +101,8 @@ Section common.
iIntros. iApply (own_update with "[$]"). by apply cmra_update_exclusive.
Qed.
(* Auxillary lemmas. *)
Lemma mapsto_full_to_frac l v : l ↦ᵢ v - l ↦ᵢ{-} v.
Proof. iIntros. by iExists _. Qed.
......@@ -97,4 +142,26 @@ Section common.
iDestruct (mapsto_valid_2 with "Hl1 Hl2") as %[]%Qp_not_plus_q_ge_1.
Qed.
End common.
\ No newline at end of file
End common.
Section node_map.
Definition nmapUR (A : Type) : ucmraT := gmapUR loc (agreeR (leibnizO A)).
Definition nnodeUR (A : Type) : ucmraT := authUR (nmapUR A).
Context `{A : Type}.
Context `{heapIG Σ, cfgSG Σ, inG Σ fracAgreeR, inG Σ exlTokR, inG Σ (nodeUR A), inG Σ nodeStateR}.
Lemma mapUR_alloc (m : nmapUR A) (i : loc) v :
m !! i = None m ~~> (<[i := to_agree v]> m) {[ i := to_agree v ]}.
Proof. intros. by apply auth_update_alloc, alloc_singleton_local_update. Qed.
Lemma map_singleton_included (m : gmap loc A) (l : loc) v :
({[l := to_agree v]} : nmapUR A) ((to_agree <$> m) : nmapUR A) m !! l = Some v.
Proof.
move /singleton_included_l=> -[y].
rewrite lookup_fmap fmap_Some_equiv => -[[x [-> ->]]].
by move /Some_included_total /to_agree_included /leibniz_equiv_iff ->.
Qed.
End node_map.
\ No newline at end of file
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