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
Marianna Rapoport
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