Commit f6a33278 authored by Ike Mulder's avatar Ike Mulder
Browse files

Fixed slower examples.

parent 4fb1664c
Pipeline #62137 passed with stage
in 6 minutes and 34 seconds
...@@ -104,6 +104,8 @@ Section proof. ...@@ -104,6 +104,8 @@ Section proof.
Program Instance p1p2fupd_atom : AtomAndConnective true (P1 1 ={∖↑N}= P2 1). Program Instance p1p2fupd_atom : AtomAndConnective true (P1 1 ={∖↑N}= P2 1).
Program Instance p2p1fupd_atom : AtomAndConnective true (P2 1 ={∖↑N}= P1 1). Program Instance p2p1fupd_atom : AtomAndConnective true (P2 1 ={∖↑N}= P1 1).
Ltac connective_as_atom_shortcut ::= biabd_step_atom_shortcut.
Instance newbarrier_spec (threads : positive) : Instance newbarrier_spec (threads : positive) :
SPEC {{ P1 1 (P1 1 ={∖↑N}= P2 1) (P2 1 ={∖↑N}= P1 1) }} SPEC {{ P1 1 (P1 1 ={∖↑N}= P2 1) (P2 1 ={∖↑N}= P1 1) }}
make_barrier #() make_barrier #()
...@@ -113,7 +115,7 @@ Section proof. ...@@ -113,7 +115,7 @@ Section proof.
iLeft; iLeft. iLeft; iLeft.
erewrite (right_id ); last iSolveTC. erewrite (right_id ); last iSolveTC.
iStepsS. iStepsS.
Qed. Qed.
Program Instance peek_spec threads γp1 γp2 γt γb (v : val) : Program Instance peek_spec threads γp1 γp2 γt γb (v : val) :
SPEC {{ is_barrier threads γp1 γp2 γt γb v }} SPEC {{ is_barrier threads γp1 γp2 γt γb v }}
...@@ -127,7 +129,7 @@ Section proof. ...@@ -127,7 +129,7 @@ Section proof.
Proof. Proof.
iStepsS. iLöb as "IH". iStepsS. iLöb as "IH".
wp_lam. iStepsS; try iSmash. (* iSmash deals with failing CAS's *) wp_lam. iStepsS; try iSmash. (* iSmash deals with failing CAS's *)
- destruct (decide (x1 + 1 = Z.pos threads)%Z) as [Heq|Hneq]; iSmash. - destruct (decide (x0 + 1 = Z.pos threads)%Z) as [Heq|Hneq]; iSmash.
- destruct (decide (threads = xH)) as [Heq|Hneq]; iSmash. - destruct (decide (threads = xH)) as [Heq|Hneq]; iSmash.
Qed. Qed.
...@@ -138,7 +140,7 @@ Section proof. ...@@ -138,7 +140,7 @@ Section proof.
Proof. Proof.
iStepsS. iLöb as "IH". iStepsS. iLöb as "IH".
wp_lam. iStepsS; try iSmash. wp_lam. iStepsS; try iSmash.
- destruct (decide (z = x3)) as [-> | Hneq]; iSmash. - destruct (decide (z = x2)) as [-> | Hneq]; iSmash.
- iRevert "H4"; iSmash. - iRevert "H4"; iSmash.
Qed. Qed.
(* we need reverts in some places to detect extra inequalities: at some places we have 3 tickets and mergablepersist does not get all currently *) (* we need reverts in some places to detect extra inequalities: at some places we have 3 tickets and mergablepersist does not get all currently *)
...@@ -155,8 +157,8 @@ Section proof. ...@@ -155,8 +157,8 @@ Section proof.
Proof. Proof.
iStepsS. iLöb as "IH". iStepsS. iLöb as "IH".
wp_lam. iStepsS; try iSmash. (* iSmash deals with failing CAS's *) wp_lam. iStepsS; try iSmash. (* iSmash deals with failing CAS's *)
- destruct (decide (x1 - 1 = Z.neg threads)%Z) as [Heq|Hneq]; iSmash. - destruct (decide (x0 - 1 = Z.neg threads)%Z) as [Heq|Hneq]; iSmash.
- destruct (decide (x1 - 1 = Z.neg threads)%Z) as [Heq|Hneq]; iSmash. - destruct (decide (x0 - 1 = Z.neg threads)%Z) as [Heq|Hneq]; iSmash.
Qed. Qed.
Instance sync_down_exit_spec threads γp1 γp2 γb γt (z : Z) (v : val) : Instance sync_down_exit_spec threads γp1 γp2 γb γt (z : Z) (v : val) :
...@@ -166,7 +168,7 @@ Section proof. ...@@ -166,7 +168,7 @@ Section proof.
Proof. Proof.
iStepsS. iLöb as "IH". iStepsS. iLöb as "IH".
wp_lam. iStepsS; try iSmash. wp_lam. iStepsS; try iSmash.
- destruct (decide (Z.opp z = x3)) as [<- | Hneq]; iSmash. - destruct (decide (Z.opp z = x2)) as [<- | Hneq]; iSmash.
- iRevert "H4"; iSmash. - iRevert "H4"; iSmash.
Qed. Qed.
...@@ -190,12 +192,12 @@ Section barrier_specs2. (* this is currently necessary since otherwise TC search ...@@ -190,12 +192,12 @@ Section barrier_specs2. (* this is currently necessary since otherwise TC search
SPEC HP1 HP2, {{ is_barrier P1 P2 (Fractional0 := HP1) (Fractional1 := HP2) threads γp1 γp2 γt γb v token P1 γp1 }} SPEC HP1 HP2, {{ is_barrier P1 P2 (Fractional0 := HP1) (Fractional1 := HP2) threads γp1 γp2 γt γb v token P1 γp1 }}
sync_up threads v sync_up threads v
{{ RET #(); token P2 γp2 }}. {{ RET #(); token P2 γp2 }}.
Proof. do 5 iStepS. assert (H1 := sync_up_spec P1 P2). iStepsS. Qed. Proof. do 3 iStepS. assert (H1 := sync_up_spec P1 P2). iStepsS. Qed.
Global Instance sync_down_spec_frac_reuse threads γp1 γp2 γt γb (v : val) : Global Instance sync_down_spec_frac_reuse threads γp1 γp2 γt γb (v : val) :
SPEC HP1 HP2, {{ is_barrier P1 P2 (Fractional0 := HP1) (Fractional1 := HP2) threads γp1 γp2 γt γb v token P2 γp2 }} SPEC HP1 HP2, {{ is_barrier P1 P2 (Fractional0 := HP1) (Fractional1 := HP2) threads γp1 γp2 γt γb v token P2 γp2 }}
sync_down threads v sync_down threads v
{{ RET #(); token P1 γp1 }}. {{ RET #(); token P1 γp1 }}.
Proof. do 5 iStepS. assert (H1 := sync_down_spec P1 P2). iStepsS. Qed. Proof. do 3 iStepS. assert (H1 := sync_down_spec P1 P2). iStepsS. Qed.
End barrier_specs2. End barrier_specs2.
...@@ -105,17 +105,13 @@ Section proof. ...@@ -105,17 +105,13 @@ Section proof.
increment #l increment #l
{{ RET #(); P1 γc q }}. {{ RET #(); P1 γc q }}.
Global Instance has_right_id {A : ucmra} (a : A) :
HasRightId a.
Proof. exists ε. rewrite right_id //. Qed.
Instance check_rising_spec γc (l : loc) : Instance check_rising_spec γc (l : loc) :
SPEC q, {{ P1 γc q inv N (counter_inv γc l) }} SPEC q, {{ P1 γc q inv N (counter_inv γc l) }}
check_rising #l check_rising #l
{{ RET #(); P1 γc q }}. {{ RET #(); P1 γc q }}.
Proof. Proof.
iStepsS. iStepsS.
assert (x8 = x8 `max` x1) as Hx8 by lia. rewrite {2}Hx8. assert (x5 = x5 `max` x0) as Hx8 by lia. rewrite {2}Hx8.
iLeft. iStepS. rewrite -Hx8. iSmash. iLeft. iStepS. rewrite -Hx8. iSmash.
Qed. Qed.
...@@ -130,12 +126,10 @@ Section proof. ...@@ -130,12 +126,10 @@ Section proof.
{{ RET #(); P2 γc q }}. {{ RET #(); P2 γc q }}.
Proof. Proof.
iStepsS. iStepsS.
assert (x9 = x9 `max` x1) as Hx9 by lia. rewrite {3}Hx9. assert (x6 = x6 `max` x0) as Hx9 by lia. rewrite {3}Hx9.
iRight. iStepS. rewrite -Hx9. iSmash. iRight. iStepS. rewrite -Hx9. iSmash.
Qed. Qed.
Opaque P1 P2.
Program Instance client_thread_spec threads γp1 γp2 γt γb (v : val) γc (l : loc) : Program Instance client_thread_spec threads γp1 γp2 γt γb (v : val) γc (l : loc) :
SPEC {{ is_counter_barrier threads γp1 γp2 γt γb v γc token (P1 γc) γp1 inv N (counter_inv γc l) }} SPEC {{ is_counter_barrier threads γp1 γp2 γt γb v γc token (P1 γc) γp1 inv N (counter_inv γc l) }}
client_thread threads #l v client_thread threads #l v
...@@ -156,28 +150,24 @@ Section proof. ...@@ -156,28 +150,24 @@ Section proof.
iStepsS. iStepsS.
Qed. Qed.
Transparent P1 P2.
(* currently needed because of bug in repeated applications of into_texist; notypeclasses refine works, simple eapply does not.
problem occurs for biabd_exist lemma, and for TeleSummarize typeclass *)
Global Instance client_spec threads : Global Instance client_spec threads :
SPEC {{ True }} SPEC {{ True }}
client threads #() client threads #()
{{ RET #(); True }}. {{ RET #(); True }}.
Proof. Proof.
iStepsS. iStepsS.
iAssert (|={}=> γc, inv N (counter_inv γc x0) P1 γc 1)%I with "[H2]" as ">[%γc [#HI [%n1 [%n2 HPn]]]]". iAssert (|={}=> γc, inv N (counter_inv γc x) P1 γc 1)%I with "[H1]" as ">[%γc [#HI [%n1 [%n2 HPn]]]]".
{ iSmash. } { iSmash. }
assert (H' := newbarrier_spec (P1 γc) (P2 γc) threads). assert (H' := newbarrier_spec (P1 γc) (P2 γc) threads).
iStepS. iStepS.
iStepS. iStepS.
unseal_diaframe => /=. unseal_diaframe => /=.
iSplitR; [ | iSplitR; iIntros "!>"; [ | iStepsS]]. iSplitR; [ | iSplitR; iIntros "!>"; [ | iStepsS]].
- iIntros "!> !>". iStepS. - iStepS. iStepS.
iInv N as "HN". iRevert "HN". iInv N as "HN". iRevert "HN".
iStepsS; case: H0 => /= H1 /to_agree_equiv H2; simplify_eq. iStepsS; case: H0 => /= H1 /to_agree_equiv H2; simplify_eq.
iRight. iStepsS. iRight. iStepsS.
- iIntros "!> !>". iStepS. - iStepS. iStepS.
iInv N as "HN". iRevert "HN". iInv N as "HN". iRevert "HN".
iStepsS; case: H0 => /= H1 /to_agree_equiv H2; simplify_eq. iStepsS; case: H0 => /= H1 /to_agree_equiv H2; simplify_eq.
iSmash. iSmash.
......
...@@ -109,7 +109,7 @@ Section spec. ...@@ -109,7 +109,7 @@ Section spec.
{{ RET #(); waitl {#1/2} #true own γR ( (Some $ Cinl $ Excl ())) R }}. {{ RET #(); waitl {#1/2} #true own γR ( (Some $ Cinl $ Excl ())) R }}.
Proof. Proof.
iStepsS. iLöb as "IH". iStepsS. iLöb as "IH".
wp_lam. do 6 iStepS. wp_lam. do 4 iStepS.
iExpr (! _)%E has post ({{ (b : bool), RET #b; waitl {#1 / 2} #true iExpr (! _)%E has post ({{ (b : bool), RET #b; waitl {#1 / 2} #true
(b = true own γl ( Some (Cinr (Excl ()))) b = false own γR ( Some (Cinl (Excl ()))) R) }})%I with ["H2"; "H3"]; (b = true own γl ( Some (Cinr (Excl ()))) b = false own γR ( Some (Cinl (Excl ()))) R) }})%I with ["H2"; "H3"];
last iStepsS. last iStepsS.
...@@ -122,7 +122,7 @@ Section spec. ...@@ -122,7 +122,7 @@ Section spec.
acquire_l p acquire_l p
{{ RET #(); left_acquired γl γr γR p R }}. {{ RET #(); left_acquired γl γr γR p R }}.
Proof. Proof.
do 37 iStepS. do 25 iStepS.
iExpr (_ <- _)%E has post ({{ RET #(); x3 {#1/2} # true own γl ( (Some (Cinl (Excl ())))) }})%I with ["H2"; "H3"]; iExpr (_ <- _)%E has post ({{ RET #(); x3 {#1/2} # true own γl ( (Some (Cinl (Excl ())))) }})%I with ["H2"; "H3"];
iSmash. iSmash.
Qed. Qed.
...@@ -141,7 +141,7 @@ Section spec. ...@@ -141,7 +141,7 @@ Section spec.
{{ RET #(); waitr {#1/2} #true own γR ( (Some $ Cinr $ Excl ())) R }} | 50. {{ RET #(); waitr {#1/2} #true own γR ( (Some $ Cinr $ Excl ())) R }} | 50.
Proof. Proof.
iStepsS. iLöb as "IH". iStepsS. iLöb as "IH".
wp_lam. do 6 iStepS. wp_lam. do 4 iStepS.
iExpr (! _)%E has post ({{ (b : bool), RET #b; waitr {#1 / 2} #true iExpr (! _)%E has post ({{ (b : bool), RET #b; waitr {#1 / 2} #true
(b = true own γr ( Some (Cinr (Excl ()))) b = false own γR ( Some (Cinr (Excl ()))) R) }})%I with ["H2"; "H3"]; (b = true own γr ( Some (Cinr (Excl ()))) b = false own γR ( Some (Cinr (Excl ()))) R) }})%I with ["H2"; "H3"];
last iStepsS. last iStepsS.
...@@ -154,7 +154,7 @@ Section spec. ...@@ -154,7 +154,7 @@ Section spec.
acquire_r p acquire_r p
{{ RET #(); right_acquired γl γr γR p R }}. {{ RET #(); right_acquired γl γr γR p R }}.
Proof. Proof.
do 37 iStepS. do 25 iStepS.
iExpr (_ <- _)%E has post ({{ RET #(); x4 {#1/2} # true own γr ( Some (Cinl $ Excl ())) }})%I with ["H2"; "H3"]; iExpr (_ <- _)%E has post ({{ RET #(); x4 {#1/2} # true own γr ( Some (Cinl $ Excl ())) }})%I with ["H2"; "H3"];
iSmash. iSmash.
Qed. Qed.
......
...@@ -151,6 +151,7 @@ Section glp_lemmas. ...@@ -151,6 +151,7 @@ Section glp_lemmas.
(* This should be able to be improved, to require less proof steps: just put only the non-Laterable things in the argument P. (* This should be able to be improved, to require less proof steps: just put only the non-Laterable things in the argument P.
However, my initial attempts failed. This is because the order matters in which things are put into the goal, However, my initial attempts failed. This is because the order matters in which things are put into the goal,
< order matters because we don't make progress on (∀ a, H) ⊢ (∀ a, H) ∗ R >
and the current approach keeps the order currently found in the environment, which seems to be okay. and the current approach keeps the order currently found in the environment, which seems to be okay.
Maybe we need a MakeSep which determines heuristically which goals should be put on the RHS? *) Maybe we need a MakeSep which determines heuristically which goals should be put on the RHS? *)
Global Instance intuitionistically_introducable Δ F P : Global Instance intuitionistically_introducable Δ F P :
......
Supports Markdown
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