### prettify treiber stack

parent a04b230a
Pipeline #14062 failed with stage
 ... @@ -87,87 +87,81 @@ Section proof. ... @@ -87,87 +87,81 @@ Section proof. Proof. generalize hd. induction xs; apply _. Qed. Proof. generalize hd. induction xs; apply _. Qed. Lemma new_stack_spec: Lemma new_stack_spec: ∀ (Φ: val → iProp Σ), {{{ True }}} new_stack #() {{{ s, RET #s; is_stack s [] }}}. (∀ s, is_stack s [] -∗ Φ #s) ⊢ WP new_stack #() {{ Φ }}. Proof. Proof. iIntros (Φ) "HΦ". wp_lam. iIntros (Φ) "_ HΦ". wp_lam. wp_bind (ref NONE)%E. wp_alloc l as "Hl". wp_bind (ref NONE)%E. wp_alloc l as "Hl". wp_alloc l' as "Hl'". wp_alloc l' as "Hl'". iApply "HΦ". rewrite /is_stack. iExists l. iApply "HΦ". rewrite /is_stack. iExists l. iFrame. by iExists 1%Qp. iFrame. by iExists 1%Qp. Qed. Qed. Definition push_triple (s: loc) (x: val) := <<< ∀ (xs : list val) (hd : loc), s ↦ #hd ∗ is_list hd xs >>> push #s x @ ⊤ <<< ∃ hd' : loc, s ↦ #hd' ∗ hd' ↦ SOMEV (x, #hd) ∗ is_list hd xs, RET #() >>>. Lemma push_atomic_spec (s: loc) (x: val) : Lemma push_atomic_spec (s: loc) (x: val) : push_triple s x. <<< ∀ (xs : list val), is_stack s xs >>> push #s x @ ⊤ <<< is_stack s (x::xs), RET #() >>>. Proof. Proof. rewrite /push_triple. iApply wp_atomic_intro. iApply wp_atomic_intro. unfold is_stack. iIntros (Φ) "HP". iLöb as "IH". wp_rec. iIntros (Φ) "HP". iLöb as "IH". wp_rec. wp_let. wp_bind (! _)%E. wp_let. wp_bind (! _)%E. iMod "HP" as (xs hd) "[[Hs Hhd] [Hvs' _]]". iMod "HP" as (xs) "[Hxs [Hvs' _]]". wp_load. iMod ("Hvs'" with "[Hs Hhd]") as "HP"; first by iFrame. iDestruct "Hxs" as (hd) "[Hs Hhd]". wp_load. iMod ("Hvs'" with "[Hs Hhd]") as "HP"; first by eauto with iFrame. iModIntro. wp_let. wp_alloc l as "Hl". wp_let. iModIntro. wp_let. wp_alloc l as "Hl". wp_let. wp_bind (CAS _ _ _)%E. wp_bind (CAS _ _ _)%E. iMod "HP" as (xs' hd') "[[Hs Hhd'] Hvs']". iMod "HP" as (xs') "[Hxs' Hvs']". iDestruct "Hxs'" as (hd') "[Hs' Hhd']". destruct (decide (hd = hd')) as [->|Hneq]. destruct (decide (hd = hd')) as [->|Hneq]. * wp_cas_suc. iDestruct "Hvs'" as "[_ Hvs']". * wp_cas_suc. iDestruct "Hvs'" as "[_ Hvs']". iMod ("Hvs'" with "[-]") as "HQ". iMod ("Hvs'" with "[-]") as "HQ". { by iFrame. } { by eauto with iFrame. } iModIntro. wp_if. eauto. iModIntro. wp_if. eauto. * wp_cas_fail. * wp_cas_fail. iDestruct "Hvs'" as "[Hvs' _]". iDestruct "Hvs'" as "[Hvs' _]". iMod ("Hvs'" with "[-]") as "HP"; first by iFrame. iMod ("Hvs'" with "[-]") as "HP"; first by eauto with iFrame. iModIntro. wp_if. by iApply "IH". iModIntro. wp_if. by iApply "IH". Qed. Qed. Definition pop_triple (s: loc) := Lemma pop_atomic_spec (s: loc) : <<< ∀ (xs : list val) (hd : loc), s ↦ #hd ∗ is_list hd xs >>> <<< ∀ (xs : list val), is_stack s xs >>> pop #s @ ⊤ pop #s @ ⊤ <<< match xs with [] => s ↦ #hd ∗ is_list hd [] <<< match xs with [] => is_stack s [] | x::xs' => ∃ q (hd': loc), hd ↦{q} SOMEV (x, #hd') ∗ s ↦ #hd' ∗ is_list hd' xs' end, | x::xs' => is_stack s xs' end, RET match xs with [] => NONEV | x :: _ => SOMEV x end >>>. RET match xs with [] => NONEV | x :: _ => SOMEV x end >>>. Lemma pop_atomic_spec (s: loc): pop_triple s. Proof. Proof. rewrite /pop_triple. iApply wp_atomic_intro. iApply wp_atomic_intro. unfold is_stack. iIntros (Φ) "HP". iLöb as "IH". wp_rec. iIntros (Φ) "HP". iLöb as "IH". wp_rec. wp_bind (! _)%E. wp_bind (! _)%E. iMod "HP" as (xs hd) "[[Hs Hhd] Hvs']". iMod "HP" as (xs) "[Hxs Hvs']". iDestruct "Hxs" as (hd) "[Hs Hhd]". destruct xs as [|y' xs']. destruct xs as [|y' xs']. - simpl. wp_load. iDestruct "Hvs'" as "[_ Hvs']". - simpl. wp_load. iDestruct "Hvs'" as "[_ Hvs']". iDestruct "Hhd" as (q) "[Hhd Hhd']". iDestruct "Hhd" as (q) "[Hhd Hhd']". iMod ("Hvs'" with "[-Hhd]") as "HQ". iMod ("Hvs'" with "[-Hhd]") as "HQ". { iFrame. eauto. } { eauto with iFrame. } iModIntro. wp_let. wp_load. wp_pures. iModIntro. wp_let. wp_load. wp_pures. eauto. eauto. - simpl. iDestruct "Hhd" as (hd' q) "([[Hhd1 Hhd2] Hhd'] & Hxs')". - simpl. iDestruct "Hhd" as (hd' q) "([[Hhd1 Hhd2] Hhd'] & Hxs')". iDestruct (dup_is_list with "[Hxs']") as "[Hxs1 Hxs2]"; first by iFrame. iDestruct (dup_is_list with "[Hxs']") as "[Hxs1 Hxs2]"; first by iFrame. wp_load. iDestruct "Hvs'" as "[Hvs' _]". wp_load. iDestruct "Hvs'" as "[Hvs' _]". iMod ("Hvs'" with "[-Hhd1 Hhd2 Hxs1]") as "HP". iMod ("Hvs'" with "[-Hhd1 Hhd2 Hxs1]") as "HP". { iFrame. iExists hd', (q / 2)%Qp. by iFrame. } { eauto with iFrame. } iModIntro. wp_let. wp_load. wp_match. wp_proj. iModIntro. wp_let. wp_load. wp_match. wp_proj. wp_bind (CAS _ _ _). wp_bind (CAS _ _ _). iMod "HP" as (xs hd'') "[[Hs Hhd''] Hvs']". iMod "HP" as (xs'') "[Hxs'' Hvs']". iDestruct "Hxs''" as (hd'') "[Hs'' Hhd'']". destruct (decide (hd = hd'')) as [->|Hneq]. destruct (decide (hd = hd'')) as [->|Hneq]. + wp_cas_suc. iDestruct "Hvs'" as "[_ Hvs']". + wp_cas_suc. iDestruct "Hvs'" as "[_ Hvs']". destruct xs as [|x' xs'']. destruct xs'' as [|x'' xs'']. { simpl. iDestruct "Hhd''" as (?) "H". { simpl. iDestruct "Hhd''" as (?) "H". iExFalso. by iDestruct (@mapsto_agree with "[\$Hhd1] [\$H]") as %?. } iExFalso. by iDestruct (@mapsto_agree with "[\$Hhd1] [\$H]") as %?. } simpl. iDestruct "Hhd''" as (hd''' ?) "(Hhd'' & Hxs'')". simpl. iDestruct "Hhd''" as (hd''' ?) "(Hhd'' & Hxs'')". iDestruct (@mapsto_agree with "[\$Hhd1] [\$Hhd'']") as %[=]. subst. iDestruct (@mapsto_agree with "[\$Hhd1] [\$Hhd'']") as %[=]. subst. iMod ("Hvs'" with "[-]") as "HQ". iMod ("Hvs'" with "[-]") as "HQ". { iExists (q / 2 / 2)%Qp, _. { eauto with iFrame. } iDestruct (uniq_is_list with "[Hxs1 Hxs'']") as "%"; first by iFrame. subst. repeat (iSplitR "Hxs1 Hs"; first done). iFrame. } iModIntro. wp_if. wp_pures. eauto. iModIntro. wp_if. wp_pures. eauto. + wp_cas_fail. iDestruct "Hvs'" as "[Hvs' _]". + wp_cas_fail. iDestruct "Hvs'" as "[Hvs' _]". iMod ("Hvs'" with "[-]") as "HP"; first by iFrame. iMod ("Hvs'" with "[-]") as "HP"; first by eauto with iFrame. iModIntro. wp_if. by iApply "IH". iModIntro. wp_if. by iApply "IH". Qed. Qed. End proof. End proof.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!