Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Iris
examples
Commits
bc082bf8
Commit
bc082bf8
authored
Apr 04, 2018
by
Dan Frumin
Browse files
isRunner -> runner
parent
6c2c6343
Changes
2
Hide whitespace changes
Inline
Side-by-side
theories/hocap/concurrent_runners.v
View file @
bc082bf8
...
...
@@ -188,34 +188,34 @@ Section contents.
Ltac
solve_proper
::
=
solve_proper_core
ltac
:
(
fun
_
=>
simpl
;
auto_equiv
).
Program
Definition
isR
unner
1
(
γ
:
name
Σ
b
)
(
P
:
val
→
iProp
Σ
)
(
Q
:
val
→
val
→
iProp
Σ
)
:
Program
Definition
pre_r
unner
(
γ
:
name
Σ
b
)
(
P
:
val
→
iProp
Σ
)
(
Q
:
val
→
val
→
iProp
Σ
)
:
(
valC
-
n
>
iProp
Σ
)
-
n
>
(
valC
-
n
>
iProp
Σ
)
:
=
λ
ne
R
r
,
(
∃
(
body
bag
:
val
),
⌜
r
=
(
body
,
bag
)%
V
⌝
∗
bagS
b
(
N
.@
"bag"
)
(
λ
x
y
,
∃
γ
γ
'
,
isTask
(
body
,
x
)
γ
γ
'
y
P
Q
)
γ
bag
∗
▷
∀
r
a
:
val
,
□
(
R
r
∗
P
a
-
∗
WP
body
r
a
{{
v
,
Q
a
v
}}))%
I
.
Solve
Obligations
with
solve_proper
.
Global
Instance
isR
unner
1
_contractive
(
γ
:
name
Σ
b
)
P
Q
:
Contractive
(
isR
unner
1
γ
P
Q
).
Proof
.
unfold
isR
unner
1
.
solve_contractive
.
Qed
.
Global
Instance
pre_r
unner_contractive
(
γ
:
name
Σ
b
)
P
Q
:
Contractive
(
pre_r
unner
γ
P
Q
).
Proof
.
unfold
pre_r
unner
.
solve_contractive
.
Qed
.
Definition
isR
unner
(
γ
:
name
Σ
b
)
(
P
:
val
→
iProp
Σ
)
(
Q
:
val
→
val
→
iProp
Σ
)
:
Definition
r
unner
(
γ
:
name
Σ
b
)
(
P
:
val
→
iProp
Σ
)
(
Q
:
val
→
val
→
iProp
Σ
)
:
valC
-
n
>
iProp
Σ
:
=
(
fixpoint
(
isR
unner
1
γ
P
Q
))%
I
.
(
fixpoint
(
pre_r
unner
γ
P
Q
))%
I
.
Lemma
isR
unner_unfold
γ
r
P
Q
:
isR
unner
γ
P
Q
r
≡
Lemma
r
unner_unfold
γ
r
P
Q
:
r
unner
γ
P
Q
r
≡
(
∃
(
body
bag
:
val
),
⌜
r
=
(
body
,
bag
)%
V
⌝
∗
bagS
b
(
N
.@
"bag"
)
(
λ
x
y
,
∃
γ
γ
'
,
isTask
(
body
,
x
)
γ
γ
'
y
P
Q
)
γ
bag
∗
▷
∀
r
a
:
val
,
□
(
isR
unner
γ
P
Q
r
∗
P
a
-
∗
WP
body
r
a
{{
v
,
Q
a
v
}}))%
I
.
Proof
.
rewrite
/
isR
unner
.
by
rewrite
{
1
}
fixpoint_unfold
.
Qed
.
∗
▷
∀
r
a
:
val
,
□
(
r
unner
γ
P
Q
r
∗
P
a
-
∗
WP
body
r
a
{{
v
,
Q
a
v
}}))%
I
.
Proof
.
rewrite
/
r
unner
.
by
rewrite
{
1
}
fixpoint_unfold
.
Qed
.
Global
Instance
isR
unner_persistent
γ
r
P
Q
:
Persistent
(
isR
unner
γ
P
Q
r
).
Proof
.
rewrite
/
isR
unner
fixpoint_unfold
.
apply
_
.
Qed
.
Global
Instance
r
unner_persistent
γ
r
P
Q
:
Persistent
(
r
unner
γ
P
Q
r
).
Proof
.
rewrite
/
r
unner
fixpoint_unfold
.
apply
_
.
Qed
.
Lemma
newTask_spec
γ
b
(
r
a
:
val
)
P
(
Q
:
val
→
val
→
iProp
Σ
)
:
{{{
isR
unner
γ
b
P
Q
r
∗
P
a
}}}
{{{
r
unner
γ
b
P
Q
r
∗
P
a
}}}
newTask
r
a
{{{
γ
γ
'
t
,
RET
t
;
isTask
r
γ
γ
'
t
P
Q
∗
task
γ
γ
'
t
a
P
Q
}}}.
Proof
.
...
...
@@ -233,7 +233,7 @@ Section contents.
Lemma
task_Join_spec
γ
b
γ
γ
'
(
te
:
expr
)
(
r
t
a
:
val
)
P
Q
`
{!
IntoVal
te
t
}
:
{{{
isR
unner
γ
b
P
Q
r
∗
task
γ
γ
'
t
a
P
Q
}}}
{{{
r
unner
γ
b
P
Q
r
∗
task
γ
γ
'
t
a
P
Q
}}}
task_Join
te
{{{
res
,
RET
res
;
Q
a
res
}}}.
Proof
.
...
...
@@ -286,12 +286,12 @@ Section contents.
Qed
.
Lemma
task_Run_spec
γ
b
γ
γ
'
r
t
P
Q
:
{{{
isR
unner
γ
b
P
Q
r
∗
isTask
r
γ
γ
'
t
P
Q
}}}
{{{
r
unner
γ
b
P
Q
r
∗
isTask
r
γ
γ
'
t
P
Q
}}}
task_Run
t
{{{
RET
#()
;
True
}}}.
Proof
.
iIntros
(
Φ
)
"[#Hrunner Htask] HΦ"
.
rewrite
isR
unner_unfold
.
rewrite
r
unner_unfold
.
iDestruct
"Hrunner"
as
(
body
bag
)
"(% & #Hbag & #Hbody)"
.
iDestruct
"Htask"
as
(
arg
state
res
)
"(% & HP & HINIT & #Htask)"
.
simplify_eq
.
rewrite
/
task_Run
.
...
...
@@ -299,7 +299,7 @@ Section contents.
wp_bind
(
body
_
arg
).
iDestruct
(
"Hbody"
$!
(
PairV
body
bag
)
arg
)
as
"Hbody'"
.
iSpecialize
(
"Hbody'"
with
"[HP]"
).
{
iFrame
.
rewrite
isR
unner_unfold
.
{
iFrame
.
rewrite
r
unner_unfold
.
iExists
_
,
_;
iSplitR
;
eauto
.
}
iApply
(
wp_wand
with
"Hbody'"
).
iIntros
(
v
)
"HQ"
.
wp_let
.
...
...
@@ -334,12 +334,12 @@ Section contents.
Qed
.
Lemma
runner_runTask_spec
γ
b
P
Q
r
:
{{{
isR
unner
γ
b
P
Q
r
}}}
{{{
r
unner
γ
b
P
Q
r
}}}
runner_runTask
r
{{{
RET
#()
;
True
}}}.
Proof
.
iIntros
(
Φ
)
"#Hrunner HΦ"
.
rewrite
isR
unner_unfold
/
runner_runTask
.
rewrite
r
unner_unfold
/
runner_runTask
.
iDestruct
"Hrunner"
as
(
body
bag
)
"(% & #Hbag & #Hbody)"
;
simplify_eq
.
repeat
wp_pure
_
.
wp_bind
(
popBag
b
_
).
...
...
@@ -350,12 +350,12 @@ Section contents.
iDestruct
"Ht"
as
(
γ
γ
'
)
"Htask"
.
simplify_eq
.
wp_match
.
iApply
(
task_Run_spec
with
"[Hbag Hbody Htask]"
)
;
last
done
.
iFrame
"Htask"
.
rewrite
isR
unner_unfold
.
iFrame
"Htask"
.
rewrite
r
unner_unfold
.
iExists
_
,
_;
iSplit
;
eauto
.
Qed
.
Lemma
runner_runTasks_spec
γ
b
P
Q
r
:
{{{
isR
unner
γ
b
P
Q
r
}}}
{{{
r
unner
γ
b
P
Q
r
}}}
runner_runTasks
r
{{{
RET
#()
;
False
}}}.
Proof
.
...
...
@@ -367,12 +367,12 @@ Section contents.
Qed
.
Lemma
loop_spec
(
n
i
:
nat
)
P
Q
γ
b
r
:
{{{
isR
unner
γ
b
P
Q
r
}}}
{{{
r
unner
γ
b
P
Q
r
}}}
(
rec
:
"loop"
"i"
:
=
if
:
"i"
<
#
n
then
Fork
(
runner_runTasks
r
)
;;
"loop"
(
"i"
+
#
1
)
else
r
)
#
i
{{{
r
,
RET
r
;
isR
unner
γ
b
P
Q
r
}}}.
{{{
r
,
RET
r
;
r
unner
γ
b
P
Q
r
}}}.
Proof
.
iIntros
(
Φ
)
"#Hrunner HΦ"
.
iL
ö
b
as
"IH"
forall
(
i
).
...
...
@@ -389,9 +389,9 @@ Section contents.
Lemma
newRunner_spec
P
Q
(
fe
ne
:
expr
)
(
f
:
val
)
(
n
:
nat
)
`
{!
IntoVal
fe
f
}
`
{!
IntoVal
ne
(#
n
)}
:
{{{
∀
(
γ
:
name
Σ
b
)
(
r
:
val
),
□
∀
a
:
val
,
(
isR
unner
γ
P
Q
r
∗
P
a
-
∗
WP
f
r
a
{{
v
,
Q
a
v
}})
}}}
□
∀
a
:
val
,
(
r
unner
γ
P
Q
r
∗
P
a
-
∗
WP
f
r
a
{{
v
,
Q
a
v
}})
}}}
newRunner
fe
ne
{{{
γ
b
r
,
RET
r
;
isR
unner
γ
b
P
Q
r
}}}.
{{{
γ
b
r
,
RET
r
;
r
unner
γ
b
P
Q
r
}}}.
Proof
.
iIntros
(
Φ
)
"#Hf HΦ"
.
rewrite
-(
of_to_val
fe
f
into_val
).
...
...
@@ -402,27 +402,27 @@ Section contents.
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
.
iAssert
(
isR
unner
γ
b
P
Q
(
PairV
f
bag
))%
I
with
"[]"
as
"#Hrunner"
.
{
rewrite
isR
unner_unfold
.
iExists
_
,
_
.
iSplit
;
eauto
.
}
iAssert
(
r
unner
γ
b
P
Q
(
PairV
f
bag
))%
I
with
"[]"
as
"#Hrunner"
.
{
rewrite
r
unner_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
}
:
{{{
isR
unner
γ
b
P
Q
r
∗
P
a
}}}
{{{
r
unner
γ
b
P
Q
r
∗
P
a
}}}
runner_Fork
re
ae
{{{
γ
γ
'
t
,
RET
t
;
task
γ
γ
'
t
a
P
Q
}}}.
Proof
.
iIntros
(
Φ
)
"[#Hrunner HP] HΦ"
.
rewrite
-(
of_to_val
re
r
into_val
).
rewrite
-(
of_to_val
ae
a
into_val
).
rewrite
/
runner_Fork
isR
unner_unfold
.
rewrite
/
runner_Fork
r
unner_unfold
.
iDestruct
"Hrunner"
as
(
body
bag
)
"(% & #Hbag & #Hbody)"
.
simplify_eq
.
Local
Opaque
newTask
.
repeat
wp_pure
_
.
wp_bind
(
newTask
_
_
).
iApply
(
newTask_spec
γ
b
(
body
,
bag
)
a
P
Q
with
"[Hbag Hbody HP]"
).
{
iFrame
"HP"
.
rewrite
isR
unner_unfold
.
{
iFrame
"HP"
.
rewrite
r
unner_unfold
.
iExists
_
,
_;
iSplit
;
eauto
.
}
iNext
.
iIntros
(
γ
γ
'
t
)
"[Htask Htask']"
.
wp_let
.
wp_bind
(
pushBag
_
_
_
).
...
...
@@ -431,4 +431,4 @@ Section contents.
Qed
.
End
contents
.
Opaque
isR
unner
task
newRunner
runner_Fork
task_Join
.
Opaque
r
unner
task
newRunner
runner_Fork
task_Join
.
theories/hocap/parfib.v
View file @
bc082bf8
...
...
@@ -78,7 +78,7 @@ Section contents.
Definition
P
(
v
:
val
)
:
iProp
Σ
:
=
(
∃
n
:
nat
,
⌜
v
=
#
n
⌝
)%
I
.
Definition
Q
(
a
v
:
val
)
:
iProp
Σ
:
=
(
∃
n
:
nat
,
⌜
a
=
#
n
⌝
∧
⌜
v
=
#(
fib
n
)
⌝
)%
I
.
Lemma
parFib_spec
r
γ
b
a
:
{{{
isR
unner
b
N
γ
b
P
Q
r
∗
P
a
}}}
{{{
r
unner
b
N
γ
b
P
Q
r
∗
P
a
}}}
parFib
r
a
{{{
v
,
RET
v
;
Q
a
v
}}}.
Proof
.
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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