Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Iris
Actris
Commits
547f4934
Commit
547f4934
authored
Jun 25, 2019
by
Robbert Krebbers
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
More tweaking.
parent
5a50b219
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
68 additions
and
19 deletions
+68
-19
theories/channel/proto_channel.v
theories/channel/proto_channel.v
+58
-10
theories/channel/proto_model.v
theories/channel/proto_model.v
+9
-7
theories/examples/list_sort.v
theories/examples/list_sort.v
+1
-2
No files found.
theories/channel/proto_channel.v
View file @
547f4934
...
...
@@ -5,6 +5,7 @@ From iris.heap_lang Require Import proofmode notation.
From
iris
.
algebra
Require
Import
auth
excl
.
From
osiris
.
utils
Require
Import
auth_excl
.
Set
Default
Proof
Using
"Type*"
.
Export
action
.
(** Camera setup *)
Class
proto_chanG
Σ
:
=
{
...
...
@@ -45,6 +46,21 @@ Definition iProto_message_eq : @iProto_message = @iProto_message_def := iProto_m
Arguments
iProto_message
{
_
_
}
_
_
%
proto
.
Instance
:
Params
(@
iProto_message
)
3
.
Notation
"< a > x1 .. xn , 'MSG' v {{ P }}; p"
:
=
(
iProto_message
(
TT
:
=
TeleS
(
λ
x1
,
..
(
TeleS
(
λ
xn
,
TeleO
))
..
))
a
(
tele_app
(
TT
:
=
TeleS
(
λ
x1
,
..
(
TeleS
(
λ
xn
,
TeleO
))
..
))
$
λ
x1
,
..
(
λ
xn
,
(
v
%
V
,
P
%
I
,
p
%
proto
))
..))
(
at
level
20
,
a
at
level
10
,
x1
binder
,
xn
binder
,
v
at
level
20
,
P
,
p
at
level
200
)
:
proto_scope
.
Notation
"< a > x1 .. xn , 'MSG' v ; p"
:
=
(
iProto_message
(
TT
:
=
TeleS
(
λ
x1
,
..
(
TeleS
(
λ
xn
,
TeleO
))
..
))
a
(
tele_app
(
TT
:
=
TeleS
(
λ
x1
,
..
(
TeleS
(
λ
xn
,
TeleO
))
..
))
$
λ
x1
,
..
(
λ
xn
,
(
v
%
V
,
True
%
I
,
p
%
proto
))
..))
(
at
level
20
,
a
at
level
10
,
x1
binder
,
xn
binder
,
v
at
level
20
,
p
at
level
200
)
:
proto_scope
.
Notation
"<!> x1 .. xn , 'MSG' v {{ P }}; p"
:
=
(
iProto_message
(
TT
:
=
TeleS
(
λ
x1
,
..
(
TeleS
(
λ
xn
,
TeleO
))
..
))
...
...
@@ -89,8 +105,7 @@ Instance: Params (@iProto_dual_if) 2.
(** Branching *)
Definition
iProto_branch
{
Σ
}
(
a
:
action
)
(
p1
p2
:
iProto
Σ
)
:
iProto
Σ
:
=
iProto_message
a
(
tele_app
(
TT
:
=
TeleS
(
λ
_:
bool
,
TeleO
))
(
λ
b
,
(#
b
,
True
%
I
,
if
b
then
p1
else
p2
))).
(<
a
>
(
b
:
bool
),
MSG
#
b
;
if
b
then
p1
else
p2
)%
proto
.
Typeclasses
Opaque
iProto_branch
.
Arguments
iProto_branch
{
_
}
_
_
%
proto
_
%
proto
.
Instance
:
Params
(@
iProto_branch
)
2
.
...
...
@@ -286,6 +301,13 @@ Section proto.
Global
Instance
iProto_app_assoc
:
Assoc
(
≡
)
(@
iProto_app
Σ
).
Proof
.
intros
p1
p2
p3
.
by
rewrite
/
iProto_app
proto_app_assoc
.
Qed
.
Lemma
iProto_app_branch
a
p1
p2
q
:
(
iProto_branch
a
p1
p2
<++>
q
)%
proto
≡
(
iProto_branch
a
(
p1
<++>
q
)
(
p2
<++>
q
))%
proto
.
Proof
.
rewrite
/
iProto_branch
iProto_app_message
.
by
apply
iProto_message_proper
=>
/=
-[].
Qed
.
Lemma
iProto_dual_app
p1
p2
:
iProto_dual
(
p1
<++>
p2
)
≡
(
iProto_dual
p1
<++>
iProto_dual
p2
)%
proto
.
Proof
.
by
rewrite
/
iProto_dual
/
iProto_app
proto_map_app
.
Qed
.
...
...
@@ -296,6 +318,9 @@ Section proto.
Global
Instance
proto_normalize_done_dual
p
:
ProtoNormalize
true
p
[]
(
iProto_dual
p
)
|
0
.
Proof
.
by
rewrite
/
ProtoNormalize
/=
right_id
.
Qed
.
Global
Instance
proto_normalize_done_dual_end
:
ProtoNormalize
(
Σ
:
=
Σ
)
true
END
[]
END
|
0
.
Proof
.
by
rewrite
/
ProtoNormalize
/=
right_id
iProto_dual_end
.
Qed
.
Global
Instance
proto_normalize_dual
d
p
pas
q
:
ProtoNormalize
(
negb
d
)
p
pas
q
→
...
...
@@ -358,6 +383,16 @@ Section proto.
apply
iProto_message_proper
;
apply
tforall_forall
=>
x
/=
;
apply
H
.
Qed
.
Global
Instance
proto_normalize_branch
d
a1
a2
p1
p2
q1
q2
pas
:
ActionDualIf
d
a1
a2
→
ProtoNormalize
d
p1
pas
q1
→
ProtoNormalize
d
p2
pas
q2
→
ProtoNormalize
d
(
iProto_branch
a1
p1
p2
)
pas
(
iProto_branch
a2
q1
q2
).
Proof
.
rewrite
/
ActionDualIf
/
ProtoNormalize
=>
->
->
->.
destruct
d
;
by
rewrite
/=
-
?iProto_app_branch
-
?iProto_dual_branch
.
Qed
.
(** Auxiliary definitions and invariants *)
Global
Instance
proto_eval_ne
:
NonExpansive2
(
proto_eval
vs
).
Proof
.
induction
vs
;
solve_proper
.
Qed
.
...
...
@@ -438,6 +473,23 @@ Section proto.
Arguments
proto_eval
:
simpl
never
.
(** Automatically perform normalization of protocols in the proof mode *)
Global
Instance
mapsto_proto_from_assumption
q
c
p1
p2
:
ProtoNormalize
false
p1
[]
p2
→
FromAssumption
q
(
c
↣
p1
@
N
)
(
c
↣
p2
@
N
).
Proof
.
rewrite
/
FromAssumption
/
ProtoNormalize
=>
->.
by
rewrite
/=
right_id
bi
.
intuitionistically_if_elim
.
Qed
.
Global
Instance
mapsto_proto_from_frame
q
c
p1
p2
:
ProtoNormalize
false
p1
[]
p2
→
Frame
q
(
c
↣
p1
@
N
)
(
c
↣
p2
@
N
)
True
.
Proof
.
rewrite
/
Frame
/
ProtoNormalize
=>
->.
by
rewrite
/=
!
right_id
bi
.
intuitionistically_if_elim
.
Qed
.
(** The actual specs *)
Lemma
proto_init
E
c
γ
c1
c2
p
:
is_chan
N
c
γ
c1
c2
-
∗
chan_own
c
γ
Left
[]
-
∗
chan_own
c
γ
Right
[]
={
E
}=
∗
...
...
@@ -616,14 +668,12 @@ Section proto.
iMod
(
"H"
$!
x
with
"Hf Hvs"
)
;
auto
.
Qed
.
Lemma
send_proto_spec
{
TT
}
Ψ
c
v
p
(
pc
:
TT
→
val
*
iProp
Σ
*
iProto
Σ
)
:
ProtoNormalize
false
p
[]
(
iProto_message
Send
pc
)
→
c
↣
p
@
N
-
∗
Lemma
send_proto_spec
{
TT
}
Ψ
c
v
(
pc
:
TT
→
val
*
iProp
Σ
*
iProto
Σ
)
:
c
↣
iProto_message
Send
pc
@
N
-
∗
(
∃
..
x
:
TT
,
⌜
v
=
(
pc
x
).
1
.
1
⌝
∗
(
pc
x
).
1
.
2
∗
▷
(
c
↣
(
pc
x
).
2
@
N
-
∗
Ψ
#()))
-
∗
WP
send
c
v
{{
Ψ
}}.
Proof
.
rewrite
/
ProtoNormalize
/=
right_id
=>
<-.
iIntros
"Hc H"
.
iDestruct
(
bi_texist_exist
with
"H"
)
as
(
x
->)
"[HP HΨ]"
.
by
iApply
(
send_proto_spec_packed
with
"[$]"
).
Qed
.
...
...
@@ -658,13 +708,11 @@ Section proto.
iDestruct
"H"
as
(
x
->)
"H"
.
by
iApply
"HΨ"
.
Qed
.
Lemma
recv_proto_spec
{
TT
}
Ψ
p
c
(
pc
:
TT
→
val
*
iProp
Σ
*
iProto
Σ
)
:
ProtoNormalize
false
p
[]
(
iProto_message
Receive
pc
)
→
c
↣
p
@
N
-
∗
Lemma
recv_proto_spec
{
TT
}
Ψ
c
(
pc
:
TT
→
val
*
iProp
Σ
*
iProto
Σ
)
:
c
↣
iProto_message
Receive
pc
@
N
-
∗
▷
(
∀
..
x
:
TT
,
c
↣
(
pc
x
).
2
@
N
-
∗
(
pc
x
).
1
.
2
-
∗
Ψ
(
pc
x
).
1
.
1
)
-
∗
WP
recv
c
{{
Ψ
}}.
Proof
.
rewrite
/
ProtoNormalize
/=
right_id
=>
<-.
iIntros
"Hc H"
.
iApply
(
recv_proto_spec_packed
with
"[$]"
).
iIntros
"!>"
(
x
)
"[Hc HP]"
.
iDestruct
(
bi_tforall_forall
with
"H"
)
as
"H"
.
iApply
(
"H"
with
"[$] [$]"
).
...
...
theories/channel/proto_model.v
View file @
547f4934
...
...
@@ -3,13 +3,15 @@ From iris.proofmode Require Import tactics.
From
iris
.
algebra
Require
Import
cofe_solver
.
Set
Default
Proof
Using
"Type"
.
Inductive
action
:
=
Send
|
Receive
.
Instance
action_inhabited
:
Inhabited
action
:
=
populate
Send
.
Definition
action_dual
(
a
:
action
)
:
action
:
=
match
a
with
Send
=>
Receive
|
Receive
=>
Send
end
.
Instance
action_dual_involutive
:
Involutive
(=)
action_dual
.
Proof
.
by
intros
[].
Qed
.
Canonical
Structure
actionO
:
=
leibnizO
action
.
Module
Export
action
.
Inductive
action
:
=
Send
|
Receive
.
Instance
action_inhabited
:
Inhabited
action
:
=
populate
Send
.
Definition
action_dual
(
a
:
action
)
:
action
:
=
match
a
with
Send
=>
Receive
|
Receive
=>
Send
end
.
Instance
action_dual_involutive
:
Involutive
(=)
action_dual
.
Proof
.
by
intros
[].
Qed
.
Canonical
Structure
actionO
:
=
leibnizO
action
.
End
action
.
Definition
protoOF_helper
(
V
:
Type
)
(
PROPn
PROP
:
ofeT
)
:
oFunctor
:
=
optionOF
(
actionO
*
(
V
-
d
>
(
▶
∙
-
n
>
PROPn
)
-
n
>
PROP
)).
...
...
theories/examples/list_sort.v
View file @
547f4934
...
...
@@ -179,8 +179,7 @@ Section list_sort.
{{{
RET
#()
;
c
↣
END
@
N
}}}.
Proof
.
iIntros
(
Ψ
)
"Hc HΨ"
.
iL
ö
b
as
"IH"
forall
(
c
Ψ
).
wp_rec
.
rewrite
{
2
}
loop_sort_protocol_unfold
/
loop_sort_protocol_aux
.
rewrite
!
iProto_dual_branch
iProto_dual_app
iProto_dual_end
/=.
wp_rec
.
rewrite
{
2
}
loop_sort_protocol_unfold
.
wp_apply
(
branch_spec
with
"Hc"
)
;
iIntros
([])
"/= Hc"
;
wp_if
.
{
wp_apply
(
list_sort_service_spec
with
"Hc"
)
;
iIntros
"Hc"
.
by
wp_apply
(
"IH"
with
"Hc"
).
}
...
...
Write
Preview
Markdown
is supported
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