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
Dan Frumin
iris-coq
Commits
74dc65a4
Commit
74dc65a4
authored
Feb 17, 2016
by
Ralf Jung
Browse files
work on newchan_spec
parent
4dacd90f
Changes
1
Hide whitespace changes
Inline
Side-by-side
barrier/barrier.v
View file @
74dc65a4
...
...
@@ -94,7 +94,7 @@ Import barrier_proto.
(
**
Now
we
come
to
the
Iris
part
of
the
proof
.
*
)
Section
proof
.
Context
{
Σ
:
iFunctorG
}
(
N
:
namespace
).
Context
`
{
heapG
Σ
}
(
H
eapN
:
namespace
).
Context
`
{
heapG
Σ
}
(
h
eapN
:
namespace
).
Context
`
{
stsG
heap_lang
Σ
sts
}
.
Context
`
{
savedPropG
heap_lang
Σ
}
.
...
...
@@ -115,7 +115,7 @@ Section proof.
)
%
I
.
Definition
barrier_ctx
(
γ
:
gname
)
(
l
:
loc
)
(
P
:
iProp
)
:
iProp
:=
(
heap_ctx
H
eapN
★
sts_ctx
γ
N
(
barrier_inv
l
P
))
%
I
.
(
heap_ctx
h
eapN
★
sts_ctx
γ
N
(
barrier_inv
l
P
))
%
I
.
Definition
send
(
l
:
loc
)
(
P
:
iProp
)
:
iProp
:=
(
∃
γ
,
barrier_ctx
γ
l
P
★
sts_ownS
γ
low_states
{
[
Send
]
}
)
%
I
.
...
...
@@ -125,12 +125,41 @@ Section proof.
saved_prop_own
i
Q
★
▷
(
Q
-
★
R
))
%
I
.
Lemma
newchan_spec
(
P
:
iProp
)
(
Q
:
val
→
iProp
)
:
(
∀
l
,
recv
l
P
★
send
l
P
-
★
Q
(
LocV
l
))
⊑
wp
⊤
(
newchan
'
())
Q
.
(
heap_ctx
heapN
★
∀
l
,
recv
l
P
★
send
l
P
-
★
Q
(
LocV
l
))
⊑
wp
⊤
(
newchan
'
())
Q
.
Proof
.
rewrite
/
newchan
.
wp_rec
.
(
*
TODO
:
wp_seq
.
*
)
rewrite
-
wp_pvs
.
eapply
wp_alloc
;
eauto
with
I
ndisj
.
rewrite
-
later_intro
.
apply
forall_intro
=>
l
.
rewrite
(
forall_elim
l
).
apply
wand_intro_l
.
rewrite
!
assoc
.
apply
pvs_wand_r
.
(
*
The
core
of
this
proof
:
Allocating
the
STS
and
the
saved
prop
.
*
)
eapply
sep_elim_True_r
.
{
by
eapply
(
saved_prop_alloc
_
P
).
}
rewrite
pvs_frame_l
.
apply
pvs_strip_pvs
.
rewrite
sep_exist_l
.
apply
exist_elim
=>
i
.
transitivity
(
pvs
⊤
⊤
(
heap_ctx
heapN
★
▷
(
barrier_inv
l
P
(
State
Low
{
[
i
]
}
))
★
saved_prop_own
i
P
)).
-
rewrite
-
pvs_intro
.
rewrite
[(
_
★
heap_ctx
_
)
%
I
]
comm
-!
assoc
.
apply
sep_mono_r
.
rewrite
{
1
}
[
saved_prop_own
_
_
]
always_sep_dup
!
assoc
.
apply
sep_mono_l
.
rewrite
/
barrier_inv
/
waiting
-
later_intro
.
apply
sep_mono_r
.
rewrite
-
(
exist_intro
(
const
P
))
/=
.
rewrite
-
[
saved_prop_own
_
_
](
left_id
True
%
I
(
★
)
%
I
).
apply
sep_mono
.
+
rewrite
-
later_intro
.
apply
wand_intro_l
.
rewrite
right_id
.
admit
.
(
*
TODO
:
singleton
set
bigop
.
*
)
+
admit
.
(
*
TODO
:
singleton
set
bigop
.
*
)
-
rewrite
(
sts_alloc
(
barrier_inv
l
P
)
⊤
N
);
last
by
eauto
.
rewrite
!
pvs_frame_r
!
pvs_frame_l
.
rewrite
pvs_trans
'
.
apply
pvs_mono
.
rewrite
sep_exist_r
sep_exist_l
.
apply
exist_elim
=>
γ
.
(
*
TODO
:
The
record
notation
is
rather
annoying
here
*
)
rewrite
/
recv
/
send
.
rewrite
-
(
exist_intro
γ
)
-
(
exist_intro
P
).
rewrite
-
(
exist_intro
P
)
-
(
exist_intro
i
)
-
(
exist_intro
γ
).
(
*
This
is
even
more
annoying
than
usually
,
since
rewrite
sometimes
unfolds
stuff
...
*
)
rewrite
[
barrier_ctx
_
_
_
]
lock
!
assoc
[(
_
★
locked
_
)
%
I
]
comm
!
assoc
-
lock
.
rewrite
-
always_sep_dup
.
rewrite
[(
_
★
sts_ownS
_
_
_
)
%
I
]
comm
!
assoc
[(
_
★
sts_ownS
_
_
_
)
%
I
]
comm
!
assoc
.
(
*
TODO
:
need
sts_op
.
*
)
Abort
.
Lemma
signal_spec
l
P
(
Q
:
val
→
iProp
)
:
H
eapN
⊥
N
→
(
send
l
P
★
P
★
Q
'
())
⊑
wp
⊤
(
signal
(
LocV
l
))
Q
.
h
eapN
⊥
N
→
(
send
l
P
★
P
★
Q
'
())
⊑
wp
⊤
(
signal
(
LocV
l
))
Q
.
Proof
.
intros
Hdisj
.
rewrite
/
signal
/
send
/
barrier_ctx
.
rewrite
sep_exist_r
.
apply
exist_elim
=>
γ
.
wp_rec
.
(
*
FIXME
wp_let
*
)
...
...
@@ -152,14 +181,14 @@ Section proof.
rewrite
!
assoc
[(
_
★
P
)
%
I
]
comm
!
assoc
-
2
!
assoc
.
apply
sep_mono
;
last
first
.
{
apply
wand_intro_l
.
eauto
with
I
.
}
(
*
Now
we
come
to
the
core
piece
of
the
proof
:
Updating
from
waiting
to
ress
.
*
)
(
*
Now
we
come
to
the
core
of
the
proof
:
Updating
from
waiting
to
ress
.
*
)
rewrite
/
waiting
/
ress
sep_exist_l
.
apply
exist_elim
=>{
Q
}
Q
.
rewrite
later_wand
{
1
}
(
later_intro
P
)
!
assoc
wand_elim_r
.
(
*
TODO
:
Now
we
need
stuff
about
Π★
{
set
I
}
*
)
Abort
.
Lemma
wait_spec
l
P
(
Q
:
val
→
iProp
)
:
H
eapN
⊥
N
→
(
recv
l
P
★
(
P
-
★
Q
'
()))
⊑
wp
⊤
(
wait
(
LocV
l
))
Q
.
h
eapN
⊥
N
→
(
recv
l
P
★
(
P
-
★
Q
'
()))
⊑
wp
⊤
(
wait
(
LocV
l
))
Q
.
Proof
.
Abort
.
...
...
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