Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Paolo G. Giarrusso
examples
Commits
c18dc76f
Commit
c18dc76f
authored
Oct 31, 2018
by
Jacques-Henri Jourdan
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Update coq-iris : R2L evaluation, curry functions, Val constructor.
parent
288dbd0c
Changes
24
Hide whitespace changes
Inline
Side-by-side
Showing
24 changed files
with
275 additions
and
307 deletions
+275
-307
opam
opam
+1
-1
theories/barrier/example_client.v
theories/barrier/example_client.v
+1
-1
theories/barrier/example_joining_existentials.v
theories/barrier/example_joining_existentials.v
+18
-17
theories/barrier/proof.v
theories/barrier/proof.v
+2
-2
theories/concurrent_stacks/concurrent_stack1.v
theories/concurrent_stacks/concurrent_stack1.v
+5
-6
theories/concurrent_stacks/concurrent_stack3.v
theories/concurrent_stacks/concurrent_stack3.v
+6
-7
theories/hocap/cg_bag.v
theories/hocap/cg_bag.v
+3
-4
theories/hocap/concurrent_runners.v
theories/hocap/concurrent_runners.v
+24
-27
theories/hocap/fg_bag.v
theories/hocap/fg_bag.v
+4
-5
theories/hocap/parfib.v
theories/hocap/parfib.v
+3
-3
theories/lecture_notes/ccounter.v
theories/lecture_notes/ccounter.v
+11
-11
theories/lecture_notes/coq_intro_example_1.v
theories/lecture_notes/coq_intro_example_1.v
+4
-6
theories/lecture_notes/coq_intro_example_2.v
theories/lecture_notes/coq_intro_example_2.v
+16
-16
theories/lecture_notes/lists.v
theories/lecture_notes/lists.v
+55
-62
theories/lecture_notes/lock_unary_spec.v
theories/lecture_notes/lock_unary_spec.v
+26
-26
theories/lecture_notes/modular_incr.v
theories/lecture_notes/modular_incr.v
+20
-20
theories/lecture_notes/recursion_through_the_store.v
theories/lecture_notes/recursion_through_the_store.v
+15
-16
theories/lecture_notes/stack.v
theories/lecture_notes/stack.v
+23
-24
theories/logatom_stack/hocap_spec.v
theories/logatom_stack/hocap_spec.v
+8
-11
theories/logatom_stack/spec.v
theories/logatom_stack/spec.v
+2
-3
theories/logatom_stack/stack.v
theories/logatom_stack/stack.v
+14
-20
theories/spanning_tree/mon.v
theories/spanning_tree/mon.v
+0
-5
theories/spanning_tree/proof.v
theories/spanning_tree/proof.v
+2
-2
theories/spanning_tree/spanning.v
theories/spanning_tree/spanning.v
+12
-12
No files found.
opam
View file @
c18dc76f
...
...
@@ -9,6 +9,6 @@ build: [make "-j%{jobs}%"]
install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris_examples"]
depends: [
"coq-iris" { (= "dev.2018-10-
22.3.4842a060
") | (= "dev") }
"coq-iris" { (= "dev.2018-10-
31.0.6356ef03
") | (= "dev") }
"coq-autosubst" { = "dev.coq86" }
]
theories/barrier/example_client.v
View file @
c18dc76f
...
...
@@ -46,7 +46,7 @@ Section client.
-
(* The original thread, the sender. *)
wp_store
.
iApply
(
signal_spec
with
"[-]"
)
;
last
by
iNext
;
auto
.
iSplitR
"Hy"
;
first
by
eauto
.
iExists
_;
iSplitL
;
[
done
|].
iIntros
"!#"
(
n
).
wp_let
.
by
wp_
o
p
.
iExists
_;
iSplitL
;
[
done
|].
iIntros
"!#"
(
n
).
by
wp_p
ures
.
-
(* The two spawned threads, the waiters. *)
iDestruct
(
recv_weaken
with
"[] Hr"
)
as
"Hr"
.
{
iIntros
"Hy"
.
by
iApply
(
y_inv_split
with
"Hy"
).
}
...
...
theories/barrier/example_joining_existentials.v
View file @
c18dc76f
...
...
@@ -19,9 +19,10 @@ Definition oneShotΣ (F : cFunctor) : gFunctors :=
Instance
subG_oneShot
Σ
{
Σ
F
}
:
subG
(
oneShot
Σ
F
)
Σ
→
oneShotG
Σ
F
.
Proof
.
solve_inG
.
Qed
.
Definition
client
eM
eW1
eW2
:
expr
:
=
Definition
client
:
val
:
=
λ
:
"fM"
"fW1"
"fW2"
,
let
:
"b"
:
=
newbarrier
#()
in
(
eM
;;
signal
"b"
)
|||
((
wait
"b"
;;
eW1
)
|||
(
wait
"b"
;;
eW2
)).
(
"fM"
#()
;;
signal
"b"
)
|||
((
wait
"b"
;;
"fW1"
#()
)
|||
(
wait
"b"
;;
"fW2"
#()
)).
Section
proof
.
Local
Set
Default
Proof
Using
"Type*"
.
...
...
@@ -32,7 +33,7 @@ Local Notation X := (F (iProp Σ)).
Definition
barrier_res
γ
(
Φ
:
X
→
iProp
Σ
)
:
iProp
Σ
:
=
(
∃
x
,
own
γ
(
Shot
x
)
∗
Φ
x
)%
I
.
Lemma
worker_spec
e
γ
l
(
Φ
Ψ
:
X
→
iProp
Σ
)
`
{!
Closed
[]
e
}
:
Lemma
worker_spec
e
γ
l
(
Φ
Ψ
:
X
→
iProp
Σ
)
:
recv
N
l
(
barrier_res
γ
Φ
)
-
∗
(
∀
x
,
{{
Φ
x
}}
e
{{
_
,
Ψ
x
}})
-
∗
WP
wait
#
l
;;
e
{{
_
,
barrier_res
γ
Ψ
}}.
Proof
.
...
...
@@ -68,31 +69,31 @@ Proof.
iExists
x
;
iFrame
"Hγ"
.
iApply
(
Ψ
_join
with
"Hx Hx'"
).
Qed
.
Lemma
client_spec_new
e
M
e
W1
e
W2
`
{!
Closed
[]
eM
,
!
Closed
[]
eW1
,
!
Closed
[]
eW2
}
:
Lemma
client_spec_new
(
f
M
f
W1
f
W2
:
val
)
:
P
-
∗
{{
P
}}
eM
{{
_
,
∃
x
,
Φ
x
}}
-
∗
(
∀
x
,
{{
Φ
1
x
}}
e
W1
{{
_
,
Ψ
1
x
}})
-
∗
(
∀
x
,
{{
Φ
2
x
}}
e
W2
{{
_
,
Ψ
2
x
}})
-
∗
WP
client
e
M
e
W1
e
W2
{{
_
,
∃
γ
,
barrier_res
γ
Ψ
}}.
{{
P
}}
fM
#()
{{
_
,
∃
x
,
Φ
x
}}
-
∗
(
∀
x
,
{{
Φ
1
x
}}
f
W1
#()
{{
_
,
Ψ
1
x
}})
-
∗
(
∀
x
,
{{
Φ
2
x
}}
f
W2
#()
{{
_
,
Ψ
2
x
}})
-
∗
WP
client
f
M
f
W1
f
W2
{{
_
,
∃
γ
,
barrier_res
γ
Ψ
}}.
Proof
using
All
.
iIntros
"/= HP #H
e
#H
e
1 #H
e
2"
;
rewrite
/
client
.
iIntros
"/= HP #H
f
#H
f
1 #H
f
2"
;
rewrite
/
client
.
iMod
(
own_alloc
(
Pending
:
one_shotR
Σ
F
))
as
(
γ
)
"Hγ"
;
first
done
.
wp_apply
(
newbarrier_spec
N
(
barrier_res
γ
Φ
))
;
auto
.
wp_lam
.
wp_apply
(
newbarrier_spec
N
(
barrier_res
γ
Φ
))
;
auto
.
iIntros
(
l
)
"[Hr Hs]"
.
set
(
workers_post
(
v
:
val
)
:
=
(
barrier_res
γ
Ψ
1
∗
barrier_res
γ
Ψ
2
)%
I
).
wp_
let
.
wp_apply
(
wp_par
(
λ
_
,
True
)%
I
workers_post
with
"[HP Hs Hγ] [Hr]"
).
-
wp_
bind
eM
.
iApply
(
wp_wand
with
"[HP]"
)
;
[
by
iApply
"H
e
"
|].
iIntros
(
v
)
"HP"
;
iDestruct
"HP"
as
(
x
)
"HP"
.
wp_
let
.
wp_
apply
(
par_spec
(
λ
_
,
True
)%
I
workers_post
with
"[HP Hs Hγ] [Hr]"
).
-
wp_
lam
.
wp_bind
(
fM
#())
.
iApply
(
wp_wand
with
"[HP]"
)
;
[
by
iApply
"H
f
"
|].
iIntros
(
v
)
"HP"
;
iDestruct
"HP"
as
(
x
)
"HP"
.
wp_
seq
.
iMod
(
own_update
with
"Hγ"
)
as
"Hx"
.
{
by
apply
(
cmra_update_exclusive
(
Shot
x
)).
}
iApply
(
signal_spec
with
"[- $Hs]"
)
;
last
auto
.
iExists
x
;
auto
.
-
iDestruct
(
recv_weaken
with
"[] Hr"
)
as
"Hr"
;
first
by
iApply
P_res_split
.
iMod
(
recv_split
with
"Hr"
)
as
"[H1 H2]"
;
first
done
.
wp_apply
(
wp_
par
(
λ
_
,
barrier_res
γ
Ψ
1
)%
I
(
λ
_
,
barrier_res
γ
Ψ
2
)%
I
with
"[H1] [H2]"
).
+
iA
pply
(
worker_spec
with
"H1"
)
;
auto
.
+
iA
pply
(
worker_spec
with
"H2"
)
;
auto
.
wp_apply
(
par
_spec
(
λ
_
,
barrier_res
γ
Ψ
1
)%
I
(
λ
_
,
barrier_res
γ
Ψ
2
)%
I
with
"[H1] [H2]"
).
+
wp_a
pply
(
worker_spec
with
"H1"
)
;
auto
.
+
wp_a
pply
(
worker_spec
with
"H2"
)
;
auto
.
+
auto
.
-
iIntros
(
_
v
)
"[_ [H1 H2]]"
.
iDestruct
(
Q_res_join
with
"H1 H2"
)
as
"?"
.
auto
.
Qed
.
...
...
theories/barrier/proof.v
View file @
c18dc76f
...
...
@@ -92,7 +92,7 @@ Lemma newbarrier_spec (P : iProp Σ) :
{{{
True
}}}
newbarrier
#()
{{{
l
,
RET
#
l
;
recv
l
P
∗
send
l
P
}}}.
Proof
.
iIntros
(
Φ
)
"_ HΦ"
.
rewrite
-
wp_fupd
/
newbarrier
/=.
wp_
seq
.
wp_alloc
l
as
"Hl"
.
rewrite
-
wp_fupd
/
newbarrier
/=.
wp_
lam
.
wp_alloc
l
as
"Hl"
.
iApply
(
"HΦ"
with
"[> -]"
).
iMod
(
saved_prop_alloc
P
)
as
(
γ
)
"#?"
.
iMod
(
sts_alloc
(
barrier_inv
l
P
)
_
N
(
State
Low
{[
γ
]})
with
"[-]"
)
...
...
@@ -117,7 +117,7 @@ Lemma signal_spec l P :
{{{
send
l
P
∗
P
}}}
signal
#
l
{{{
RET
#()
;
True
}}}.
Proof
.
rewrite
/
signal
/=.
iIntros
(
Φ
)
"[Hs HP] HΦ"
.
iDestruct
"Hs"
as
(
γ
)
"[#Hsts Hγ]"
.
wp_l
et
.
iIntros
(
Φ
)
"[Hs HP] HΦ"
.
iDestruct
"Hs"
as
(
γ
)
"[#Hsts Hγ]"
.
wp_l
am
.
iMod
(
sts_openS
(
barrier_inv
l
P
)
_
_
γ
with
"[Hγ]"
)
as
([
p
I
])
"(% & [Hl Hr] & Hclose)"
;
eauto
.
destruct
p
;
[|
done
].
wp_store
.
...
...
theories/concurrent_stacks/concurrent_stack1.v
View file @
c18dc76f
...
...
@@ -98,7 +98,7 @@ Section stacks.
iMod
(
inv_alloc
N
_
(
stack_inv
P
l
)
with
"[Hl]"
)
as
"#Hisstack"
.
{
iExists
None
;
iFrame
;
auto
.
iApply
is_stack_unfold
.
auto
.
}
wp_
let
.
wp_
pures
.
iModIntro
.
iApply
"HΦ"
.
-
iIntros
"!#"
.
...
...
@@ -111,13 +111,13 @@ Section stacks.
destruct
v'
as
[
l'
|]
;
simpl
;
last
first
.
+
iMod
(
"Hclose"
with
"[Hl' Hstack]"
)
as
"_"
.
{
rewrite
/
stack_inv
.
eauto
with
iFrame
.
}
iModIntro
.
wp_match
.
by
iRight
.
iModIntro
.
wp_match
.
wp_pures
.
by
iRight
.
+
iDestruct
(
is_stack_copy
with
"Hstack"
)
as
"[Hstack Hmy]"
.
iDestruct
"Hmy"
as
(
q
h
t
)
"Hl"
.
iMod
(
"Hclose"
with
"[Hl' Hstack]"
)
as
"_"
.
{
rewrite
/
stack_inv
.
eauto
with
iFrame
.
}
iModIntro
.
wp_match
.
wp_load
.
wp_p
roj
.
wp_load
.
wp_p
ures
.
wp_bind
(
CAS
_
_
_
).
iInv
N
as
"Hstack"
"Hclose"
.
iDestruct
"Hstack"
as
(
v''
)
"[Hl'' Hstack]"
.
...
...
@@ -131,7 +131,7 @@ Section stacks.
iModIntro
.
wp_if
.
wp_load
.
wp_p
roj
.
wp_p
ures
.
eauto
.
*
simpl
in
Hne
.
wp_cas_fail
.
iMod
(
"Hclose"
with
"[Hl'' Hstack]"
).
...
...
@@ -151,8 +151,7 @@ Section stacks.
iModIntro
.
wp_let
.
wp_alloc
r''
as
"Hr''"
.
wp_let
.
wp_bind
(
CAS
_
_
_
).
wp_pures
.
wp_bind
(
CAS
_
_
_
).
iInv
N
as
"Hstack"
"Hclose"
.
iDestruct
"Hstack"
as
(
v''
)
"[Hl'' Hstack]"
.
wp_cas
as
->%
oloc_to_val_inj
|
_
.
...
...
theories/concurrent_stacks/concurrent_stack3.v
View file @
c18dc76f
...
...
@@ -113,11 +113,11 @@ Section stack_works.
Proof
.
iIntros
"HΦ HP"
.
rename
ι
into
N
.
wp_
let
.
wp_
rec
.
wp_alloc
l
as
"Hl"
.
iMod
(
inv_alloc
N
_
(
stack_inv
P
#
l
)
with
"[Hl HP]"
)
as
"#Istack"
.
{
iNext
;
iExists
l
,
(
InjLV
#()),
[]
;
iSplit
;
iFrame
;
auto
.
}
wp_
let
.
wp_
pures
.
iApply
"HΦ"
.
-
iIntros
"!# Hcont"
.
iL
ö
b
as
"IH"
.
...
...
@@ -137,7 +137,7 @@ Section stack_works.
iMod
(
"Hclose"
with
"[Hl' Hstack HP]"
).
{
iExists
l'
,
(
InjLV
#()),
[]
;
iSplit
;
iFrame
;
auto
.
}
iModIntro
.
wp_
match
.
wp_
pures
.
iRight
;
auto
.
*
iDestruct
"H"
as
(
q
l
h
t
)
"[% Hl]"
.
subst
.
...
...
@@ -148,10 +148,9 @@ Section stack_works.
assert
(
to_val
(
h
,
t
)%
V
=
Some
(
h
,
t
)%
V
)
by
apply
to_of_val
.
assert
(
is_Some
(
to_val
(
h
,
t
)%
V
))
by
(
exists
(
h
,
t
)%
V
;
auto
).
wp_match
.
unfold
subst
;
simpl
;
fold
of_val
.
wp_load
.
wp_p
roj
.
wp_p
ures
.
wp_bind
(
CAS
_
_
_
).
iInv
N
as
"Hstack"
"Hclose"
.
iDestruct
"Hstack"
as
(
l''
v'
ys
)
"[>% [Hl'' [Hstack HP]]]"
.
...
...
@@ -171,7 +170,7 @@ Section stack_works.
iModIntro
.
wp_if
.
wp_load
.
wp_p
roj
.
wp_p
ures
.
iLeft
;
iExists
_;
auto
.
+
wp_cas_fail
.
iMod
(
"Hclose"
with
"[Hl'' Hstack HP]"
).
...
...
@@ -192,7 +191,7 @@ Section stack_works.
iModIntro
.
wp_let
.
wp_alloc
lp
as
"Hlp"
.
wp_
let
.
wp_
pures
.
wp_bind
(
CAS
_
_
_
).
iInv
N
as
"Hstack"
"Hclose"
.
iDestruct
"Hstack"
as
(
l''
v''
xs
)
"[>% [Hl'' [Hstack HP]]]"
.
...
...
theories/hocap/cg_bag.v
View file @
c18dc76f
...
...
@@ -108,7 +108,7 @@ Section proof.
iMod
(
own_alloc
(
1
%
Qp
,
to_agree
∅
))
as
(
γ
b
)
"[Ha Hf]"
;
first
done
.
wp_apply
(
newlock_spec
N
(
bag_inv
γ
b
r
)
with
"[Hr Ha]"
).
{
iExists
[].
iFrame
.
}
iIntros
(
lk
γ
)
"#Hlk"
.
wp_
let
.
iApply
"HΦ"
.
iIntros
(
lk
γ
)
"#Hlk"
.
wp_
pures
.
iApply
"HΦ"
.
rewrite
/
is_bag
/
bag_contents
.
iFrame
.
iExists
_
,
_
,
_
.
by
iFrame
"Hlk"
.
Qed
.
...
...
@@ -123,7 +123,7 @@ Section proof.
Proof
.
iIntros
"#Hvs"
.
iIntros
(
Φ
).
iAlways
.
iIntros
"[#Hbag HP] HΦ"
.
unfold
pushBag
.
do
2
wp_rec
.
unfold
pushBag
.
wp_rec
.
wp_let
.
rewrite
/
is_bag
/
bag_inv
.
iDestruct
"Hbag"
as
(
lk
b
γ
l
)
"[% #Hlk]"
;
simplify_eq
/=.
repeat
wp_pure
_
.
...
...
@@ -133,7 +133,7 @@ Section proof.
wp_bind
(
_
<-
_
)%
E
.
iApply
(
wp_mask_mono
_
(
⊤
∖↑
N
))
;
first
done
.
iMod
(
"Hvs"
with
"[$Ha $HP]"
)
as
"[Hbc HQ]"
.
wp_store
.
wp_
let
.
wp_store
.
wp_
seq
.
wp_apply
(
release_spec
with
"[$Hlk $Htok Hbc Hb]"
).
{
iExists
(
v
::
ls
)
;
iFrame
.
}
iIntros
"_"
.
by
iApply
"HΦ"
.
...
...
@@ -184,4 +184,3 @@ Canonical Structure cg_bag `{!heapG Σ, !bagG Σ} : bag Σ :=
abstract_bag
.
newBag_spec
:
=
newBag_spec
;
abstract_bag
.
pushBag_spec
:
=
pushBag_spec
;
abstract_bag
.
popBag_spec
:
=
popBag_spec
|}.
theories/hocap/concurrent_runners.v
View file @
c18dc76f
...
...
@@ -220,28 +220,27 @@ Section contents.
{{{
γ
γ
'
t
,
RET
t
;
isTask
r
γ
γ
'
t
P
Q
∗
task
γ
γ
'
t
a
P
Q
}}}.
Proof
.
iIntros
(
Φ
)
"[#Hrunner HP] HΦ"
.
unfold
newTask
.
do
2
wp_re
c
.
iApply
wp_fupd
.
wp_rec
.
wp_
pu
re
s
.
iApply
wp_fupd
.
wp_alloc
res
as
"Hres"
.
wp_alloc
status
as
"Hstatus"
.
iMod
(
new_pending
)
as
(
γ
)
"[Htoken Htask]"
.
iMod
(
new_INIT
)
as
(
γ
'
)
"[Hinit Hinit']"
.
iMod
(
inv_alloc
(
N
.@
"task"
)
_
(
task_inv
γ
γ
'
status
res
(
Q
a
))%
I
with
"[-HP HΦ Htask Hinit]"
)
as
"#Hinv"
.
{
iNext
.
iLeft
.
iFrame
.
}
iModIntro
.
iApply
"HΦ"
.
wp_pures
.
iModIntro
.
iApply
"HΦ"
.
iFrame
.
iSplitL
;
iExists
_
,
_
,
_;
iFrame
"Hinv"
;
eauto
.
Qed
.
Lemma
task_Join_spec
γ
b
γ
γ
'
(
te
:
expr
)
(
r
t
a
:
val
)
P
Q
:
IntoVal
te
t
→
Lemma
task_Join_spec
γ
b
γ
γ
'
(
r
t
a
:
val
)
P
Q
:
{{{
runner
γ
b
P
Q
r
∗
task
γ
γ
'
t
a
P
Q
}}}
task_Join
t
e
task_Join
t
{{{
res
,
RET
res
;
Q
a
res
}}}.
Proof
.
iIntros
(
<-
Φ
)
"[#Hrunner Htask] HΦ"
.
iIntros
(
Φ
)
"[#Hrunner Htask] HΦ"
.
iL
ö
b
as
"IH"
.
rewrite
{
2
}/
task_Join
.
iDestruct
"Htask"
as
(
r'
state
res
)
"(% & Htoken & #Htask)"
.
simplify_eq
.
repeat
wp_pure
_
.
wp_rec
.
wp_pure
s
.
wp_bind
(!
#
state
)%
E
.
iInv
(
N
.@
"task"
)
as
"Hstatus"
"Hcl"
.
rewrite
{
2
}/
task_inv
.
iDestruct
"Hstatus"
as
"[>(Hstate & Hres)|[Hstatus|Hstatus]]"
.
...
...
@@ -294,7 +293,7 @@ Section contents.
iDestruct
"Hrunner"
as
(
body
bag
)
"(% & #Hbag & #Hbody)"
.
iDestruct
"Htask"
as
(
arg
state
res
)
"(% & HP & HINIT & #Htask)"
.
simplify_eq
.
rewrite
/
task_Run
.
repeat
wp_pure
_
.
wp_rec
.
wp_pure
s
.
wp_bind
(
body
_
arg
).
iDestruct
(
"Hbody"
$!
(
PairV
body
bag
)
arg
)
as
"Hbody'"
.
iSpecialize
(
"Hbody'"
with
"[HP]"
).
...
...
@@ -302,7 +301,7 @@ Section contents.
iExists
_
,
_;
iSplitR
;
eauto
.
}
iApply
(
wp_wand
with
"Hbody'"
).
iIntros
(
v
)
"HQ"
.
wp_let
.
wp_bind
(#
res
<-
SOME
v
)%
E
.
wp_bind
(#
res
<-
SOME
v
)%
E
.
wp_inj
.
iInv
(
N
.@
"task"
)
as
"[>(Hstate & Hres & Hpending & HINIT')|[Hstatus|Hstatus]]"
"Hcl"
.
-
wp_store
.
iMod
(
INIT_SET_RES
v
γ
'
with
"[HINIT HINIT']"
)
as
"[HSETRES HSETRES']"
.
...
...
@@ -311,7 +310,7 @@ Section contents.
apply
_
.
}
iMod
(
"Hcl"
with
"[HSETRES Hstate Hres Hpending]"
)
as
"_"
.
{
iNext
.
iRight
.
iLeft
.
iExists
_;
iFrame
.
}
iModIntro
.
wp_
let
.
iModIntro
.
wp_
seq
.
iInv
(
N
.@
"task"
)
as
"[>(Hstate & Hres & Hpending & HINIT')|[Hstatus|Hstatus]]"
"Hcl"
.
{
iExFalso
.
iApply
(
INIT_not_SET_RES
with
"HINIT' HSETRES'"
).
}
+
iDestruct
"Hstatus"
as
(
v'
)
"(Hstate & Hres & Hpending & HSETRES)"
.
...
...
@@ -340,7 +339,7 @@ Section contents.
iIntros
(
Φ
)
"#Hrunner HΦ"
.
rewrite
runner_unfold
/
runner_runTask
.
iDestruct
"Hrunner"
as
(
body
bag
)
"(% & #Hbag & #Hbody)"
;
simplify_eq
.
repeat
wp_pure
_
.
wp_rec
.
wp_pure
s
.
wp_bind
(
popBag
b
_
).
iApply
(
popBag_spec
with
"Hbag"
).
iNext
.
iIntros
(
t'
)
"[_ [%|Ht]]"
;
simplify_eq
.
...
...
@@ -362,15 +361,15 @@ Section contents.
iL
ö
b
as
"IH"
.
rewrite
/
runner_runTasks
.
wp_rec
.
wp_bind
(
runner_runTask
r
).
iApply
runner_runTask_spec
;
eauto
.
iNext
.
iIntros
"_"
.
wp_
rec
.
by
iApply
"IH"
.
iNext
.
iIntros
"_"
.
wp_
seq
.
by
iApply
"IH"
.
Qed
.
Lemma
loop_spec
(
n
i
:
nat
)
P
Q
γ
b
r
:
{{{
runner
γ
b
P
Q
r
}}}
(
r
ec
:
"loop"
"i"
:
=
(
R
ec
V
"loop"
"i"
(
if
:
"i"
<
#
n
then
Fork
(
runner_runTasks
r
)
;;
"loop"
(
"i"
+
#
1
)
else
r
)
#
i
else
r
)
)
#
i
{{{
r
,
RET
r
;
runner
γ
b
P
Q
r
}}}.
Proof
.
iIntros
(
Φ
)
"#Hrunner HΦ"
.
...
...
@@ -379,50 +378,48 @@ Section contents.
{
by
iApply
"HΦ"
.
}
wp_bind
(
Fork
_
).
iApply
(
wp_fork
with
"[]"
).
-
iNext
.
by
iApply
runner_runTasks_spec
.
-
iNext
.
wp_
rec
.
wp_op
.
-
iNext
.
wp_
seq
.
wp_op
.
(* Set Printing Coercions. *)
assert
((
Z
.
of_nat
i
+
1
)
=
Z
.
of_nat
(
i
+
1
))
as
->
by
lia
.
iApply
(
"IH"
with
"HΦ"
).
Qed
.
Lemma
newRunner_spec
P
Q
(
fe
ne
:
expr
)
(
f
:
val
)
(
n
:
nat
)
:
IntoVal
fe
f
→
IntoVal
ne
(#
n
)
→
Lemma
newRunner_spec
P
Q
(
f
:
val
)
(
n
:
nat
)
:
{{{
∀
(
γ
:
name
Σ
b
)
(
r
:
val
),
□
∀
a
:
val
,
(
runner
γ
P
Q
r
∗
P
a
-
∗
WP
f
r
a
{{
v
,
Q
a
v
}})
}}}
newRunner
f
e
ne
newRunner
f
#
n
{{{
γ
b
r
,
RET
r
;
runner
γ
b
P
Q
r
}}}.
Proof
.
iIntros
(
<-
<-
Φ
)
"#Hf HΦ"
.
iIntros
(
Φ
)
"#Hf HΦ"
.
unfold
newRunner
.
iApply
wp_fupd
.
repeat
wp_pure
_
.
wp_lam
.
wp_pure
s
.
wp_bind
(
newBag
b
#()).
iApply
(
newBag_spec
b
(
N
.@
"bag"
)
(
λ
x
y
,
∃
γ
γ
'
,
isTask
(
f
,
x
)
γ
γ
'
y
P
Q
)%
I
)
;
auto
.
iNext
.
iIntros
(
bag
).
iDestruct
1
as
(
γ
b
)
"#Hbag"
.
do
3
wp_let
.
wp_let
.
wp_pair
.
wp_let
.
wp_closure
.
wp_let
.
iAssert
(
runner
γ
b
P
Q
(
PairV
f
bag
))%
I
with
"[]"
as
"#Hrunner"
.
{
rewrite
runner_unfold
.
iExists
_
,
_
.
iSplit
;
eauto
.
}
iApply
(
loop_spec
n
0
with
"Hrunner [HΦ]"
)
;
eauto
.
iNext
.
iIntros
(
r
)
"Hr"
.
by
iApply
"HΦ"
.
Qed
.
Lemma
runner_Fork_spec
γ
b
(
re
ae
:
expr
)
(
r
a
:
val
)
P
Q
:
IntoVal
re
r
→
IntoVal
ae
a
→
Lemma
runner_Fork_spec
γ
b
(
r
a
:
val
)
P
Q
:
{{{
runner
γ
b
P
Q
r
∗
P
a
}}}
runner_Fork
r
e
a
e
runner_Fork
r
a
{{{
γ
γ
'
t
,
RET
t
;
task
γ
γ
'
t
a
P
Q
}}}.
Proof
.
iIntros
(
<-
<-
Φ
)
"[#Hrunner HP] HΦ"
.
iIntros
(
Φ
)
"[#Hrunner HP] HΦ"
.
rewrite
/
runner_Fork
runner_unfold
.
iDestruct
"Hrunner"
as
(
body
bag
)
"(% & #Hbag & #Hbody)"
.
simplify_eq
.
Local
Opaque
newTask
.
repeat
wp_pure
_
.
wp_bind
(
newTask
_
_
).
wp_lam
.
wp_pure
s
.
wp_bind
(
newTask
_
_
).
iApply
(
newTask_spec
γ
b
(
body
,
bag
)
a
P
Q
with
"[Hbag Hbody HP]"
).
{
iFrame
"HP"
.
rewrite
runner_unfold
.
iExists
_
,
_;
iSplit
;
eauto
.
}
iNext
.
iIntros
(
γ
γ
'
t
)
"[Htask Htask']"
.
wp_let
.
wp_bind
(
pushBag
_
_
_
).
iApply
(
pushBag_spec
with
"[$Hbag Htask]"
)
;
eauto
.
iNext
.
iIntros
"_"
.
wp_
rec
.
by
iApply
"HΦ"
.
iNext
.
iIntros
"_"
.
wp_
seq
.
by
iApply
"HΦ"
.
Qed
.
End
contents
.
...
...
theories/hocap/fg_bag.v
View file @
c18dc76f
...
...
@@ -150,18 +150,17 @@ Section proof.
iIntros
"#Hvs"
.
iIntros
(
Φ
).
iAlways
.
iIntros
"[#Hbag HP] HΦ"
.
unfold
pushBag
.
iL
ö
b
as
"IH"
.
do
2
wp_re
c
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_
pu
re
s
.
rewrite
/
is_bag
.
iDestruct
"Hbag"
as
(
b
)
"[% #Hinv]"
;
simplify_eq
/=.
repeat
wp_pure
_
.
wp_bind
(!
#
b
)%
E
.
iInv
N
as
(
o
ls
)
"[Ho [Hls >Hb]]"
"Hcl"
.
wp_load
.
iMod
(
"Hcl"
with
"[Ho Hls Hb]"
)
as
"_"
.
{
iNext
.
iExists
_
,
_
.
iFrame
.
}
clear
ls
.
iModIntro
.
repeat
wp_pure
_
.
iModIntro
.
wp_alloc
n
as
"Hn"
.
wp_bind
(
CAS
_
_
_
).
wp_pures
.
wp_bind
(
CAS
_
_
_
).
iInv
N
as
(
o'
ls
)
"[Ho [Hls >Hb]]"
"Hcl"
.
iPoseProof
(
is_list_unboxed
with
"Hls"
)
as
"#>%"
.
destruct
(
decide
(
o
=
o'
))
as
[->|?].
...
...
@@ -227,7 +226,7 @@ Section proof.
iMod
(
"Hvs1"
with
"[$Hb $HP]"
)
as
"[Hb HQ]"
.
iMod
(
"Hcl"
with
"[Ho Htl Hb]"
)
as
"_"
.
{
iNext
.
iExists
_
,
ls
.
by
iFrame
"Ho Hb"
.
}
iModIntro
.
wp_
if_true
.
by
iApply
"HΦ"
.
iModIntro
.
wp_
pures
.
by
iApply
"HΦ"
.
+
wp_cas_fail
.
iMod
(
"Hcl"
with
"[Ho Hls Hb]"
)
as
"_"
.
{
iNext
.
iExists
_
,
ls'
.
by
iFrame
"Ho Hb"
.
}
...
...
theories/hocap/parfib.v
View file @
c18dc76f
...
...
@@ -39,7 +39,7 @@ Section contents.
{{{
True
}}}
seqFib
#
n
{{{
(
m
:
nat
),
RET
#
m
;
⌜
fib
n
=
m
⌝
}}}.
Proof
.
iIntros
(
Φ
)
"_ HΦ"
.
iL
ö
b
as
"IH"
forall
(
n
Φ
).
iL
ö
b
as
"IH"
forall
(
n
Φ
).
wp_rec
.
simpl
.
wp_op
.
case_bool_decide
;
simplify_eq
;
wp_if
.
{
assert
(
n
=
O
)
as
->
by
lia
.
by
iApply
(
"HΦ"
$!
1
%
nat
).
}
...
...
@@ -77,7 +77,7 @@ Section contents.
Proof
.
iIntros
(
Φ
)
"[#Hrunner HP] HΦ"
.
iDestruct
"HP"
as
(
n
)
"%"
;
simplify_eq
.
do
2
wp_rec
.
simpl
.
wp_op
.
case_bool_decide
;
wp_if
.
wp_lam
.
wp_let
.
wp_op
.
case_bool_decide
;
wp_if
.
-
iApply
seqFib_spec
;
eauto
.
iNext
.
iIntros
(?
<-).
iApply
"HΦ"
.
iExists
n
;
done
.
...
...
@@ -107,7 +107,7 @@ Section contents.
{{{
True
}}}
fibRunner
#
n
#
a
{{{
(
m
:
nat
),
RET
#
m
;
⌜
fib
a
=
m
⌝
}}}.
Proof
.
iIntros
(
Φ
)
"_ HΦ"
.
unfold
fibRunner
.
do
2
wp_
rec
.
wp_bind
(
newRunner
_
_
_
).
unfold
fibRunner
.
wp_lam
.
wp_
let
.
wp_bind
(
newRunner
_
_
_
).
iApply
(
newRunner_spec
b
N
P
Q
).
-
iIntros
(
γ
b
r
).
iAlways
.
iIntros
(
a'
)
"[#Hrunner HP]"
.
iApply
(
parFib_spec
with
"[$HP]"
)
;
eauto
.
...
...
theories/lecture_notes/ccounter.v
View file @
c18dc76f
...
...
@@ -26,7 +26,7 @@ Section ccounter.
Lemma
ccounterRA_valid_full
(
m
n
:
natR
)
:
✓
(
●
!
m
⋅
◯
!
n
)
→
(
n
=
m
)%
nat
.
Proof
.
by
intros
?%
frac_auth_agree
.
Qed
.
Qed
.
Lemma
ccounterRA_update
(
m
n
:
natR
)
(
q
:
frac
)
:
(
●
!
m
⋅
◯
!{
q
}
n
)
~~>
(
●
!
(
S
m
)
⋅
◯
!{
q
}
(
S
n
)).
Proof
.
...
...
@@ -51,7 +51,7 @@ Section ccounter.
Qed
.
Lemma
newcounter_contrib_spec
(
R
:
iProp
Σ
)
m
:
{{{
True
}}}
{{{
True
}}}
newcounter
#
m
{{{
γ₁
γ₂
ℓ
,
RET
#
ℓ
;
is_ccounter
γ₁
γ₂
ℓ
1
m
%
nat
}}}.
Proof
.
...
...
@@ -66,21 +66,21 @@ Section ccounter.
Lemma
incr_contrib_spec
γ₁
γ₂
ℓ
q
n
:
{{{
is_ccounter
γ₁
γ₂
ℓ
q
n
}}}
incr
#
ℓ
incr
#
ℓ
{{{
(
y
:
Z
),
RET
#
y
;
is_ccounter
γ₁
γ₂
ℓ
q
(
S
n
)
}}}.
Proof
.
iIntros
(
Φ
)
"[Hown #[Hinv HCnt]] HΦ"
.
iIntros
(
Φ
)
"[Hown #[Hinv HCnt]] HΦ"
.
iApply
(
incr_spec
N
γ₂
_
(
own
γ₁
(
◯
!{
q
}
n
))%
I
(
λ
_
,
(
own
γ₁
(
◯
!{
q
}
(
S
n
))))%
I
with
"[] [Hown]"
)
;
first
set_solver
.
-
iIntros
(
m
)
"!# [HOwnElem HP]"
.
-
iIntros
(
m
)
"!# [HOwnElem HP]"
.
iInv
(
N
.@
"counter"
)
as
(
k
)
"[>H1 >H2]"
"HClose"
.
iDestruct
(
makeElem_eq
with
"HOwnElem H2"
)
as
%->.
iDestruct
(
makeElem_eq
with
"HOwnElem H2"
)
as
%->.
iMod
(
makeElem_update
_
_
_
(
k
+
1
)
with
"HOwnElem H2"
)
as
"[HOwnElem H2]"
.
iMod
(
own_update_2
with
"H1 HP"
)
as
"[H1 HP]"
.
{
apply
ccounterRA_update
.
}
{
apply
ccounterRA_update
.
}
iMod
(
"HClose"
with
"[H1 H2]"
)
as
"_"
.
{
iNext
;
iExists
(
S
k
)
;
iFrame
.
rewrite
Nat2Z
.
inj_succ
Z
.
add_1_r
//.
}
}
by
iFrame
.
-
by
iFrame
.
-
iNext
.
...
...
@@ -89,7 +89,7 @@ Section ccounter.
Qed
.
Lemma
read_contrib_spec
γ₁
γ₂
ℓ
q
n
:
{{{
is_ccounter
γ₁
γ₂
ℓ
q
n
}}}
{{{
is_ccounter
γ₁
γ₂
ℓ
q
n
}}}
read
#
ℓ
{{{
(
c
:
Z
),
RET
#
c
;
⌜
Z
.
of_nat
n
≤
c
⌝
∧
is_ccounter
γ₁
γ₂
ℓ
q
n
}}}.
Proof
.
...
...
@@ -97,7 +97,7 @@ Section ccounter.
wp_apply
(
read_spec
N
γ₂
_
(
own
γ₁
(
◯
!{
q
}
n
))%
I
(
λ
m
,
⌜
n
≤
m
⌝
∗
(
own
γ₁
(
◯
!{
q
}
n
)))%
I
with
"[] [Hown]"
)
;
first
set_solver
.
-
iIntros
(
m
)
"!# [HownE HOwnfrag]"
.
iInv
(
N
.@
"counter"
)
as
(
k
)
"[>H1 >H2]"
"HClose"
.
iDestruct
(
makeElem_eq
with
"HownE H2"
)
as
%->.
iDestruct
(
makeElem_eq
with
"HownE H2"
)
as
%->.
iDestruct
(
own_valid_2
with
"H1 HOwnfrag"
)
as
%
Hleq
%
ccounterRA_valid
.
iMod
(
"HClose"
with
"[H1 H2]"
)
as
"_"
.
{
iExists
_;
by
iFrame
.
}
...
...
@@ -118,7 +118,7 @@ Section ccounter.
wp_apply
(
read_spec
N
γ₂
_
(
own
γ₁
(
◯
!
n
))%
I
(
λ
m
,
⌜
Z
.
of_nat
n
=
m
⌝
∗
(
own
γ₁
(
◯
!
n
)))%
I
with
"[] [Hown]"
)
;
first
set_solver
.
-
iIntros
(
m
)
"!# [HownE HOwnfrag]"
.
iInv
(
N
.@
"counter"
)
as
(
k
)
"[>H1 >H2]"
"HClose"
.
iDestruct
(
makeElem_eq
with
"HownE H2"
)
as
%->.
iDestruct
(
makeElem_eq
with
"HownE H2"
)
as
%->.
iDestruct
(
own_valid_2
with
"H1 HOwnfrag"
)
as
%
Hleq
%
ccounterRA_valid_full
;
simplify_eq
.
iMod
(
"HClose"
with
"[H1 H2]"
)
as
"_"
.
{
iExists
_;
by
iFrame
.
}
...
...
theories/lecture_notes/coq_intro_example_1.v
View file @
c18dc76f
...
...
@@ -139,10 +139,8 @@ Section proof.
proved in the par library we have imported above. The rule/lemma is
called wp_par. The two arguments are the conclusions of the two
parallel threads. Here they are simply True, as in the paper proof when
we used the ht-par rule. The first two subgoals are bookkeeping
subgoals about closedness (absence of free variables) of expression
incr ℓ and incr ℓ. They are easily dispatched by the done tactic. *)
iApply
(
wp_par
(
λ
_
,
⌜
True
⌝
)%
I
(
λ
_
,
⌜
True
⌝
)%
I
)
;
[
done
|
done
|
..].
we used the ht-par rule. *)
iApply
(
wp_par
(
λ
_
,
⌜
True
⌝
)%
I
(
λ
_
,
⌜
True
⌝
)%
I
).
(* We now have three subgoals. The first two are proofs that each thread
does the correct thing, and the final goal is to show that the combined
conclusion of the two threads implies the desired conclusion. This last
...
...
@@ -236,9 +234,9 @@ Section proof.
..., thus we first remove the later modality using the later
introduction rule, implemented by the iNext tactic. After that we
have to deal with the application of a function with a dummy argument,
i.e., sequencing. The wp_
lam
tactic handles it. *)
i.e., sequencing. The wp_
seq
tactic handles it. *)
iNext
.
wp_
lam
.
wp_
seq
.
(* The last interesting part of the proof is before us. We do exactly as
we did on paper. We open the invariant, and read the value. And the
invariant will tell us that the value is at least n. We can then apply
...
...
theories/lecture_notes/coq_intro_example_2.v
View file @
c18dc76f
...
...
@@ -315,7 +315,7 @@ Section monotone_counter.