Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Iris
Diaframe
Commits
f6a33278
Commit
f6a33278
authored
Feb 15, 2022
by
Ike Mulder
Browse files
Fixed slower examples.
parent
4fb1664c
Pipeline
#62137
passed with stage
in 6 minutes and 34 seconds
Changes
4
Pipelines
2
Hide whitespace changes
Inline
Side-by-side
theories/examples/comparison/barrier.v
View file @
f6a33278
...
@@ -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
(
x
1
+
1
=
Z
.
pos
threads
)%
Z
)
as
[
Heq
|
Hneq
]
;
iSmash
.
-
destruct
(
decide
(
x
0
+
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
=
x
3
))
as
[->
|
Hneq
]
;
iSmash
.
-
destruct
(
decide
(
z
=
x
2
))
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
(
x
1
-
1
=
Z
.
neg
threads
)%
Z
)
as
[
Heq
|
Hneq
]
;
iSmash
.
-
destruct
(
decide
(
x
0
-
1
=
Z
.
neg
threads
)%
Z
)
as
[
Heq
|
Hneq
]
;
iSmash
.
-
destruct
(
decide
(
x
1
-
1
=
Z
.
neg
threads
)%
Z
)
as
[
Heq
|
Hneq
]
;
iSmash
.
-
destruct
(
decide
(
x
0
-
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
=
x
3
))
as
[<-
|
Hneq
]
;
iSmash
.
-
destruct
(
decide
(
Z
.
opp
z
=
x
2
))
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
.
theories/examples/comparison/barrier_client.v
View file @
f6a33278
...
@@ -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
(
x
8
=
x
8
`
max
`
x
1
)
as
Hx8
by
lia
.
rewrite
{
2
}
Hx8
.
assert
(
x
5
=
x
5
`
max
`
x
0
)
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
(
x
9
=
x
9
`
max
`
x
1
)
as
Hx9
by
lia
.
rewrite
{
3
}
Hx9
.
assert
(
x
6
=
x
6
`
max
`
x
0
)
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
x
0
)
∗
P1
γ
c
1
)%
I
with
"[H
2
]"
as
">[%γc [#HI [%n1 [%n2 HPn]]]]"
.
iAssert
(|={
⊤
}=>
∃
γ
c
,
inv
N
(
counter_inv
γ
c
x
)
∗
P1
γ
c
1
)%
I
with
"[H
1
]"
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
]].
-
i
Intros
"!> !>"
.
iStepS
.
-
i
StepS
.
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
.
-
i
Intros
"!> !>"
.
iStepS
.
-
i
StepS
.
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
.
...
...
theories/examples/comparison/peterson.v
View file @
f6a33278
...
@@ -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
.
...
...
theories/lib/greatest_laterable_fixpoint.v
View file @
f6a33278
...
@@ -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
:
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment