Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
E
examples
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
2
Merge Requests
2
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Iris
examples
Commits
5e9f4d89
Commit
5e9f4d89
authored
Feb 22, 2018
by
Jacques-Henri Jourdan
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'master' of gitlab.mpi-sws.org:FP/iris-examples
parents
6cfb76f6
5cd98a38
Pipeline
#6990
failed with stage
in 8 minutes and 39 seconds
Changes
59
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
59 changed files
with
11244 additions
and
30 deletions
+11244
-30
.gitignore
.gitignore
+1
-0
.gitlab-ci.yml
.gitlab-ci.yml
+23
-14
Makefile
Makefile
+1
-1
Makefile.coq.local
Makefile.coq.local
+18
-0
README.md
README.md
+52
-14
_CoqProject
_CoqProject
+54
-0
build/opam-ci.sh
build/opam-ci.sh
+2
-1
opam
opam
+1
-0
theories/concurrent_stacks/concurrent_stack1.v
theories/concurrent_stacks/concurrent_stack1.v
+179
-0
theories/concurrent_stacks/concurrent_stack2.v
theories/concurrent_stacks/concurrent_stack2.v
+405
-0
theories/concurrent_stacks/concurrent_stack3.v
theories/concurrent_stacks/concurrent_stack3.v
+202
-0
theories/concurrent_stacks/concurrent_stack4.v
theories/concurrent_stacks/concurrent_stack4.v
+595
-0
theories/lecture_notes/coq_intro_example_1.v
theories/lecture_notes/coq_intro_example_1.v
+261
-0
theories/lecture_notes/coq_intro_example_2.v
theories/lecture_notes/coq_intro_example_2.v
+658
-0
theories/logrel/F_mu/fundamental.v
theories/logrel/F_mu/fundamental.v
+88
-0
theories/logrel/F_mu/lang.v
theories/logrel/F_mu/lang.v
+190
-0
theories/logrel/F_mu/logrel.v
theories/logrel/F_mu/logrel.v
+176
-0
theories/logrel/F_mu/rules.v
theories/logrel/F_mu/rules.v
+58
-0
theories/logrel/F_mu/soundness.v
theories/logrel/F_mu/soundness.v
+25
-0
theories/logrel/F_mu/typing.v
theories/logrel/F_mu/typing.v
+65
-0
theories/logrel/F_mu_ref/context_refinement.v
theories/logrel/F_mu_ref/context_refinement.v
+245
-0
theories/logrel/F_mu_ref/fundamental.v
theories/logrel/F_mu_ref/fundamental.v
+107
-0
theories/logrel/F_mu_ref/fundamental_binary.v
theories/logrel/F_mu_ref/fundamental_binary.v
+317
-0
theories/logrel/F_mu_ref/lang.v
theories/logrel/F_mu_ref/lang.v
+264
-0
theories/logrel/F_mu_ref/logrel.v
theories/logrel/F_mu_ref/logrel.v
+191
-0
theories/logrel/F_mu_ref/logrel_binary.v
theories/logrel/F_mu_ref/logrel_binary.v
+227
-0
theories/logrel/F_mu_ref/rules.v
theories/logrel/F_mu_ref/rules.v
+127
-0
theories/logrel/F_mu_ref/rules_binary.v
theories/logrel/F_mu_ref/rules_binary.v
+185
-0
theories/logrel/F_mu_ref/soundness.v
theories/logrel/F_mu_ref/soundness.v
+39
-0
theories/logrel/F_mu_ref/soundness_binary.v
theories/logrel/F_mu_ref/soundness_binary.v
+57
-0
theories/logrel/F_mu_ref/typing.v
theories/logrel/F_mu_ref/typing.v
+167
-0
theories/logrel/F_mu_ref_conc/context_refinement.v
theories/logrel/F_mu_ref_conc/context_refinement.v
+306
-0
theories/logrel/F_mu_ref_conc/examples/counter.v
theories/logrel/F_mu_ref_conc/examples/counter.v
+371
-0
theories/logrel/F_mu_ref_conc/examples/lock.v
theories/logrel/F_mu_ref_conc/examples/lock.v
+163
-0
theories/logrel/F_mu_ref_conc/examples/stack/CG_stack.v
theories/logrel/F_mu_ref_conc/examples/stack/CG_stack.v
+517
-0
theories/logrel/F_mu_ref_conc/examples/stack/FG_stack.v
theories/logrel/F_mu_ref_conc/examples/stack/FG_stack.v
+361
-0
theories/logrel/F_mu_ref_conc/examples/stack/refinement.v
theories/logrel/F_mu_ref_conc/examples/stack/refinement.v
+342
-0
theories/logrel/F_mu_ref_conc/examples/stack/stack_rules.v
theories/logrel/F_mu_ref_conc/examples/stack/stack_rules.v
+112
-0
theories/logrel/F_mu_ref_conc/fundamental_binary.v
theories/logrel/F_mu_ref_conc/fundamental_binary.v
+442
-0
theories/logrel/F_mu_ref_conc/fundamental_unary.v
theories/logrel/F_mu_ref_conc/fundamental_unary.v
+145
-0
theories/logrel/F_mu_ref_conc/lang.v
theories/logrel/F_mu_ref_conc/lang.v
+335
-0
theories/logrel/F_mu_ref_conc/logrel_binary.v
theories/logrel/F_mu_ref_conc/logrel_binary.v
+255
-0
theories/logrel/F_mu_ref_conc/logrel_unary.v
theories/logrel/F_mu_ref_conc/logrel_unary.v
+194
-0
theories/logrel/F_mu_ref_conc/rules.v
theories/logrel/F_mu_ref_conc/rules.v
+170
-0
theories/logrel/F_mu_ref_conc/rules_binary.v
theories/logrel/F_mu_ref_conc/rules_binary.v
+349
-0
theories/logrel/F_mu_ref_conc/soundness_binary.v
theories/logrel/F_mu_ref_conc/soundness_binary.v
+55
-0
theories/logrel/F_mu_ref_conc/soundness_unary.v
theories/logrel/F_mu_ref_conc/soundness_unary.v
+36
-0
theories/logrel/F_mu_ref_conc/typing.v
theories/logrel/F_mu_ref_conc/typing.v
+191
-0
theories/logrel/prelude/base.v
theories/logrel/prelude/base.v
+43
-0
theories/logrel/stlc/fundamental.v
theories/logrel/stlc/fundamental.v
+64
-0
theories/logrel/stlc/lang.v
theories/logrel/stlc/lang.v
+159
-0
theories/logrel/stlc/logrel.v
theories/logrel/stlc/logrel.v
+67
-0
theories/logrel/stlc/rules.v
theories/logrel/stlc/rules.v
+54
-0
theories/logrel/stlc/soundness.v
theories/logrel/stlc/soundness.v
+22
-0
theories/logrel/stlc/typing.v
theories/logrel/stlc/typing.v
+51
-0
theories/spanning_tree/graph.v
theories/spanning_tree/graph.v
+114
-0
theories/spanning_tree/mon.v
theories/spanning_tree/mon.v
+784
-0
theories/spanning_tree/proof.v
theories/spanning_tree/proof.v
+69
-0
theories/spanning_tree/spanning.v
theories/spanning_tree/spanning.v
+493
-0
No files found.
.gitignore
View file @
5e9f4d89
*.vo
*.vio
*.v.d
.coqdeps.d
*.glob
*.cache
*.aux
...
...
.gitlab-ci.yml
View file @
5e9f4d89
image
:
ralfjung/opam-ci:latest
stages
:
-
build
variables
:
CPU_CORES
:
"
9
"
CPU_CORES
:
"
10
"
.template
:
&template
stage
:
build
tags
:
-
fp
-timing
-
fp
script
:
# prepare
-
. build/opam-ci.sh $OPAM_PINS
...
...
@@ -14,7 +18,8 @@ variables:
-
'
time
make
-k
-j$CPU_CORES
TIMED=y
2>&1
|
tee
build-log.txt'
-
'
if
fgrep
Axiom
build-log.txt
>/dev/null;
then
exit
1;
fi'
-
'
cat
build-log.txt
|
egrep
"[a-zA-Z0-9_/-]+
\((real|user):
[0-9]"
|
tee
build-time.txt'
-
'
if
test
-n
"$VALIDATE"
&&
((
RANDOM
%
10
==
0
));
then
make
validate;
fi'
# maybe validate
-
'
if
[[
-n
"$VALIDATE"
]];
then
make
validate;
fi'
cache
:
key
:
"
$CI_JOB_NAME"
paths
:
...
...
@@ -22,29 +27,33 @@ variables:
only
:
-
master
-
/^ci/
build-coq.8.7.0
:
<<
:
*template
variables
:
OPAM_PINS
:
"
coq
version
8.7.0
coq-mathcomp-ssreflect
version
1.6.2"
except
:
-
triggers
-
schedules
build-coq.8.6.1
:
## Build jobs
build-coq.8.7.1
:
<<
:
*template
variables
:
OPAM_PINS
:
"
coq
version
8.6.1
coq-mathcomp-ssreflect
version
1.6.2"
VALIDATE
:
"
1"
OPAM_PINS
:
"
coq
version
8.7.1
coq-mathcomp-ssreflect
version
1.6.4"
tags
:
-
fp-timing
artifacts
:
paths
:
-
build-time.txt
-
build-env.txt
except
:
-
triggers
build-coq.8.6.1
:
<<
:
*template
variables
:
OPAM_PINS
:
"
coq
version
8.6.1
coq-mathcomp-ssreflect
version
1.6.4"
build-iris.dev
:
<<
:
*template
variables
:
OPAM_PINS
:
"
coq
version
8.6.1
coq-mathcomp-ssreflect
version
1.6.2
coq-iris.dev
git
https://gitlab.mpi-sws.org/FP/iris-coq.git#$IRIS_REV"
OPAM_PINS
:
"
coq
version
8.7.1
coq-mathcomp-ssreflect
version
1.6.4
coq-iris.dev
git
https://gitlab.mpi-sws.org/FP/iris-coq.git#$IRIS_REV"
except
:
only
:
-
triggers
-
schedules
Makefile
View file @
5e9f4d89
...
...
@@ -15,7 +15,7 @@ clean: Makefile.coq
# Create Coq Makefile. POSIX awk can't do in-place editing, but coq_makefile wants the real
# filename, so we do some file gymnastics.
Makefile.coq
:
_CoqProject Makefile awk.Makefile
coq_makefile
-f
_CoqProject
-o
Makefile.coq
"
$(COQBIN)
coq_makefile"
-f
_CoqProject
-o
Makefile.coq
mv
Makefile.coq Makefile.coq.tmp
&&
awk
-f
awk.Makefile Makefile.coq.tmp
>
Makefile.coq
&&
rm
Makefile.coq.tmp
# Install build-dependencies
...
...
Makefile.coq.local
0 → 100644
View file @
5e9f4d89
# Per-project targets
include
Makefile.coq.conf
VOFILES
=
$(COQMF_VFILES:.v=.vo)
barrier
:
$(filter theories/barrier/%
,
$(VOFILES))
.PHONY
:
barrier
lecture_notes
:
$(filter theories/barrier/%
,
$(VOFILES))
.PHONY
:
lecture_notes
spanning_tree
:
$(filter theories/spanning_tree/%
,
$(VOFILES))
.PHONY
:
spanning_tree
concurrent_stacks
:
$(filter theories/concurrent_stacks/%
,
$(VOFILES))
.PHONY
:
concurrent_stacks
logrel
:
$(filter theories/logrel/%
,
$(VOFILES))
.PHONY
:
logrel
README.md
View file @
5e9f4d89
...
...
@@ -6,26 +6,64 @@ Some example verification demonstrating the use of Iris.
This version is known to compile with:
-
Coq 8.6.1 / 8.7.
0
-
Ssreflect 1.6.
2
-
Coq 8.6.1 / 8.7.
1
-
Ssreflect 1.6.
4
-
A development version of
[
Iris
](
https://gitlab.mpi-sws.org/FP/iris-coq/
)
-
The coq86-devel branch of
[
Autosubst
](
https://github.com/uds-psl/autosubst
)
The easiest way to install the correct versions of the dependencies is through
opam. Once you got opam set up, just run
`make build-dep`
to install the right
versions of the dependencies. When the dependencies change (e.g., a newer
version of Iris is needed), just run
`make build-dep`
again.
## Building from source
Alternatively, you can manually determine the required Iris commit by consulting
the
`opam.pins`
file.
When building from source, we recommend to use opam (1.2.2 or newer) for
installing the dependencies. This requires the following two repositories:
## Building Instructions
opam repo add coq-released https://coq.inria.fr/opam/released
opam repo add iris-dev https://gitlab.mpi-sws.org/FP/opam-dev.git
Run
`make`
to build the full development.
Once you got opam set up, run
`make build-dep`
to install the right versions
of the dependencies.
Run
`make -jN`
to build the full development, where
`N`
is the number of your
CPU cores.
To update, do
`git pull`
. After an update, the development may fail to compile
because of outdated dependencies. To fix that, please run
`opam update`
followed by
`make build-dep`
.
## Case Studies
This repository contains the following case studies:
*
[
barrier
](
theories/barrier
)
: Implementation and proof of a barrier as
described in
[
"Higher-Order Ghost State"
](
http://doi.acm.org/10.1145/2818638
)
.
*
[
logrel
](
theories/logrel
)
: Logical relations from the
[
IPM paper
](
http://doi.acm.org/10.1145/3093333.3009855
)
:
-
STLC
-
Unary logical relations proving type safety
-
F_mu (System F with recursive types)
-
Unary logical relations proving type safety
-
F_mu_ref (System F with recursive types and references)
-
Unary logical relations proving type safety
-
Binary logical relations for proving contextual refinements
-
F_mu_ref_conc (System F with recursive types, references and concurrency)
-
Unary logical relations proving type safety
-
Binary logical relations for proving contextual refinements
-
Proof of refinement for a pair of fine-grained/coarse-grained
concurrent counter implementations
-
Proof of refinement for a pair of fine-grained/coarse-grained
concurrent stack implementations
*
[
spanning-tree
](
theories/spanning_tree
)
: Proof of a concurrent spanning tree
algorithm.
*
[
concurrent-stacks
](
theories/concurrent_stacks
)
: Proof of an implementation of
concurrent stacks with helping, as described in the
[
report
](
http://iris-project.org/pdfs/2017-case-study-concurrent-stacks-with-helping.pdf
)
.
*
[
lecture-notes
](
theories/lecture_notes
)
: Coq examples for the
[
Iris lecture notes
](
http://iris-project.org/tutorial-material.html
)
.
## For Developers: How to update the Iris dependency
-
Do the change in Iris, push it.
-
In iris-atomic, change opam.pins to point to the new commit.
-
Run "make build-dep" (in iris-example) to install the new version of Iris.
-
You may have to do "make clean" as Coq will likely complain about .vo file
*
Do the change in Iris, push it.
*
Wait for CI to publish a new Iris version on the opam archive, then run
`opam update iris-dev`
.
*
In iris-examples, change the
`opam`
file to depend on the new version.
*
Run
`make build-dep`
(in iris-examples) to install the new version of Iris.
You may have to do
`make clean`
as Coq will likely complain about .vo file
mismatches.
_CoqProject
View file @
5e9f4d89
...
...
@@ -6,3 +6,57 @@ theories/barrier/barrier.v
theories/barrier/protocol.v
theories/barrier/example_client.v
theories/barrier/example_joining_existentials.v
theories/lecture_notes/coq_intro_example_1.v
theories/spanning_tree/graph.v
theories/spanning_tree/mon.v
theories/spanning_tree/spanning.v
theories/spanning_tree/proof.v
theories/concurrent_stacks/concurrent_stack1.v
theories/concurrent_stacks/concurrent_stack2.v
theories/concurrent_stacks/concurrent_stack3.v
theories/concurrent_stacks/concurrent_stack4.v
theories/logrel/prelude/base.v
theories/logrel/stlc/lang.v
theories/logrel/stlc/typing.v
theories/logrel/stlc/rules.v
theories/logrel/stlc/logrel.v
theories/logrel/stlc/fundamental.v
theories/logrel/stlc/soundness.v
theories/logrel/F_mu/lang.v
theories/logrel/F_mu/typing.v
theories/logrel/F_mu/rules.v
theories/logrel/F_mu/logrel.v
theories/logrel/F_mu/fundamental.v
theories/logrel/F_mu/soundness.v
theories/logrel/F_mu_ref/lang.v
theories/logrel/F_mu_ref/typing.v
theories/logrel/F_mu_ref/rules.v
theories/logrel/F_mu_ref/rules_binary.v
theories/logrel/F_mu_ref/logrel.v
theories/logrel/F_mu_ref/logrel_binary.v
theories/logrel/F_mu_ref/fundamental.v
theories/logrel/F_mu_ref/fundamental_binary.v
theories/logrel/F_mu_ref/soundness.v
theories/logrel/F_mu_ref/context_refinement.v
theories/logrel/F_mu_ref/soundness_binary.v
theories/logrel/F_mu_ref_conc/lang.v
theories/logrel/F_mu_ref_conc/rules.v
theories/logrel/F_mu_ref_conc/typing.v
theories/logrel/F_mu_ref_conc/logrel_unary.v
theories/logrel/F_mu_ref_conc/fundamental_unary.v
theories/logrel/F_mu_ref_conc/rules_binary.v
theories/logrel/F_mu_ref_conc/logrel_binary.v
theories/logrel/F_mu_ref_conc/fundamental_binary.v
theories/logrel/F_mu_ref_conc/soundness_unary.v
theories/logrel/F_mu_ref_conc/context_refinement.v
theories/logrel/F_mu_ref_conc/soundness_binary.v
theories/logrel/F_mu_ref_conc/examples/lock.v
theories/logrel/F_mu_ref_conc/examples/counter.v
theories/logrel/F_mu_ref_conc/examples/stack/stack_rules.v
theories/logrel/F_mu_ref_conc/examples/stack/CG_stack.v
theories/logrel/F_mu_ref_conc/examples/stack/FG_stack.v
theories/logrel/F_mu_ref_conc/examples/stack/refinement.v
build/opam-ci.sh
View file @
5e9f4d89
...
...
@@ -55,7 +55,7 @@ done
# Upgrade cached things.
echo
echo
"[opam-ci] Upgrading opam"
opam upgrade
-y
--fixup
opam upgrade
-y
--fixup
&&
opam upgrade
-y
# Install build-dependencies.
echo
...
...
@@ -63,5 +63,6 @@ echo "[opam-ci] Installing build-dependencies"
make build-dep
OPAMFLAGS
=
-y
# done
set
+x
echo
coqc
-v
opam
View file @
5e9f4d89
...
...
@@ -10,4 +10,5 @@ install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris_examples"]
depends: [
"coq-iris" { (= "dev.2018-02-21.1") | (= "dev") }
"coq-autosubst" { = "dev.coq86" }
]
theories/concurrent_stacks/concurrent_stack1.v
0 → 100644
View file @
5e9f4d89
From
iris
.
base_logic
Require
Import
base_logic
.
From
iris
.
proofmode
Require
Import
tactics
.
From
iris
.
base_logic
.
lib
Require
Import
invariants
.
From
iris
.
program_logic
Require
Export
weakestpre
hoare
.
From
iris
.
heap_lang
Require
Export
lang
.
From
iris
.
algebra
Require
Import
agree
list
.
From
iris
.
heap_lang
Require
Import
assert
proofmode
notation
.
Set
Default
Proof
Using
"Type"
.
(** Stack 1: No helping, bag spec. *)
Definition
mk_stack
:
val
:
=
λ
:
"_"
,
let
:
"r"
:
=
ref
NONEV
in
(
rec
:
"pop"
"n"
:
=
match
:
!
"r"
with
NONE
=>
#-
1
|
SOME
"hd"
=>
if
:
CAS
"r"
(
SOME
"hd"
)
(
Snd
"hd"
)
then
Fst
"hd"
else
"pop"
"n"
end
,
rec
:
"push"
"n"
:
=
let
:
"r'"
:
=
!
"r"
in
let
:
"r''"
:
=
SOME
(
"n"
,
"r'"
)
in
if
:
CAS
"r"
"r'"
"r''"
then
#()
else
"push"
"n"
).
Section
stacks
.
Context
`
{!
heapG
Σ
}.
Implicit
Types
l
:
loc
.
Definition
is_stack_pre
(
P
:
val
→
iProp
Σ
)
(
F
:
val
-
c
>
iProp
Σ
)
:
val
-
c
>
iProp
Σ
:
=
λ
v
,
(
v
≡
NONEV
∨
∃
(
h
t
:
val
),
v
≡
SOMEV
(
h
,
t
)%
V
∗
P
h
∗
▷
F
t
)%
I
.
Local
Instance
is_stack_contr
(
P
:
val
→
iProp
Σ
)
:
Contractive
(
is_stack_pre
P
).
Proof
.
rewrite
/
is_stack_pre
=>
n
f
f'
Hf
v
.
repeat
(
f_contractive
||
f_equiv
).
apply
Hf
.
Qed
.
Definition
is_stack_def
(
P
:
val
->
iProp
Σ
)
:
=
fixpoint
(
is_stack_pre
P
).
Definition
is_stack_aux
P
:
seal
(@
is_stack_def
P
).
by
eexists
.
Qed
.
Definition
is_stack
P
:
=
unseal
(
is_stack_aux
P
).
Definition
is_stack_eq
P
:
@
is_stack
P
=
@
is_stack_def
P
:
=
seal_eq
(
is_stack_aux
P
).
Definition
stack_inv
P
v
:
=
(
∃
l
v'
,
⌜
v
=
#
l
⌝
∗
l
↦
v'
∗
is_stack
P
v'
)%
I
.
Lemma
is_stack_unfold
(
P
:
val
→
iProp
Σ
)
v
:
is_stack
P
v
⊣
⊢
is_stack_pre
P
(
is_stack
P
)
v
.
Proof
.
rewrite
is_stack_eq
.
apply
(
fixpoint_unfold
(
is_stack_pre
P
)).
Qed
.
Lemma
is_stack_disj
(
P
:
val
→
iProp
Σ
)
v
:
is_stack
P
v
-
∗
is_stack
P
v
∗
(
v
≡
NONEV
∨
∃
(
h
t
:
val
),
v
≡
SOMEV
(
h
,
t
)%
V
).
Proof
.
iIntros
"Hstack"
.
iDestruct
(
is_stack_unfold
with
"Hstack"
)
as
"[#Hstack|Hstack]"
.
-
iSplit
;
try
iApply
is_stack_unfold
;
iLeft
;
auto
.
-
iDestruct
"Hstack"
as
(
h
t
)
"[#Heq rest]"
.
iSplitL
;
try
iApply
is_stack_unfold
;
iRight
;
auto
.
Qed
.
(* Per-element invariant (i.e., bag spec). *)
Theorem
stack_works
P
Φ
:
(
∀
(
f
₁
f
₂
:
val
),
(
∀
(
v
:
val
),
□
WP
f
₁
#()
{{
v
,
P
v
∨
v
≡
#-
1
}})
-
∗
(
∀
(
v
:
val
),
□
(
P
v
-
∗
WP
f
₂
v
{{
v
,
True
}}))
-
∗
Φ
(
f
₁
,
f
₂
)%
V
)%
I
-
∗
WP
mk_stack
#()
{{
Φ
}}.
Proof
.
iIntros
"HΦ"
.
wp_lam
.
wp_alloc
l
as
"Hl"
.
pose
proof
(
nroot
.@
"N"
)
as
N
.
rewrite
-
wp_fupd
.
iMod
(
inv_alloc
N
_
(
stack_inv
P
#
l
)
with
"[Hl]"
)
as
"#Hisstack"
.
iExists
l
,
NONEV
;
iSplit
;
iFrame
;
auto
.
{
iApply
is_stack_unfold
.
iLeft
;
auto
.
}
wp_let
.
iModIntro
.
iApply
"HΦ"
.
-
iIntros
(
v
)
"!#"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_bind
(!
#
l
)%
E
.
iInv
N
as
"Hstack"
"Hclose"
.
iDestruct
"Hstack"
as
(
l'
v'
)
"[>% [Hl' Hstack]]"
.
injection
H
;
intros
;
subst
.
wp_load
.
iDestruct
(
is_stack_disj
with
"Hstack"
)
as
"[Hstack #Heq]"
.
iMod
(
"Hclose"
with
"[Hl' Hstack]"
).
iExists
l'
,
v'
;
iFrame
;
auto
.
iModIntro
.
iDestruct
"Heq"
as
"[H | H]"
.
+
iRewrite
"H"
.
wp_match
.
iRight
;
auto
.
+
iDestruct
"H"
as
(
h
t
)
"H"
.
iRewrite
"H"
.
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
.
fold
of_val
.
unfold
subst
;
simpl
;
fold
subst
.
wp_bind
(
CAS
_
_
_
).
wp_proj
.
iInv
N
as
"Hstack"
"Hclose"
.
iDestruct
"Hstack"
as
(
l''
v''
)
"[>% [Hl'' Hstack]]"
.
injection
H2
;
intros
;
subst
.
assert
(
Decision
(
v''
=
InjRV
(
h
,
t
)%
V
))
as
Heq
by
apply
val_eq_dec
.
destruct
Heq
.
*
wp_cas_suc
.
iDestruct
(
is_stack_unfold
with
"Hstack"
)
as
"[Hstack | Hstack]"
.
subst
.
iDestruct
"Hstack"
as
"%"
;
discriminate
.
iDestruct
"Hstack"
as
(
h'
t'
)
"[% [HP Hstack]]"
.
subst
.
injection
H3
.
intros
.
subst
.
iMod
(
"Hclose"
with
"[Hl'' Hstack]"
).
iExists
l''
,
t'
;
iFrame
;
auto
.
iModIntro
.
wp_if
.
wp_proj
.
iLeft
;
auto
.
*
wp_cas_fail
.
iMod
(
"Hclose"
with
"[Hl'' Hstack]"
).
iExists
l''
,
v''
;
iFrame
;
auto
.
iModIntro
.
wp_if
.
iApply
"IH"
.
-
iIntros
(
v
)
"!# HP"
.
iL
ö
b
as
"IH"
.
wp_rec
.
wp_bind
(!
_
)%
E
.
iInv
N
as
"Hstack"
"Hclose"
.
iDestruct
"Hstack"
as
(
l'
v'
)
"[>% [Hl' Hstack]]"
.
injection
H
;
intros
;
subst
.
wp_load
.
iMod
(
"Hclose"
with
"[Hl' Hstack]"
).
by
(
iExists
l'
,
v'
;
iFrame
).
iModIntro
.
wp_let
.
wp_let
.
wp_bind
(
CAS
_
_
_
).
iInv
N
as
"Hstack"
"Hclose"
.
iDestruct
"Hstack"
as
(
l''
v''
)
"[>% [Hl'' Hstack]]"
.
injection
H0
;
intros
;
subst
.
assert
(
Decision
(
v''
=
v'
%
V
))
as
Heq
by
apply
val_eq_dec
.
destruct
Heq
.
+
wp_cas_suc
.
iMod
(
"Hclose"
with
"[Hl'' HP Hstack]"
).
iExists
l''
,
(
InjRV
(
v
,
v'
)%
V
).
iFrame
;
auto
.
iSplit
;
auto
.
iApply
is_stack_unfold
.
iRight
.
iExists
v
,
v'
.
iSplit
;
auto
.
subst
;
iFrame
.
iModIntro
.
wp_if
.
done
.
+
wp_cas_fail
.
iMod
(
"Hclose"
with
"[Hl'' Hstack]"
).
iExists
l''
,
v''
;
iFrame
;
auto
.
iModIntro
.
wp_if
.
iApply
"IH"
.
done
.
Qed
.
End
stacks
.
theories/concurrent_stacks/concurrent_stack2.v
0 → 100644
View file @
5e9f4d89
From
iris
.
program_logic
Require
Export
weakestpre
hoare
.
From
iris
.
heap_lang
Require
Export
lang
proofmode
notation
.
From
iris
.
algebra
Require
Import
excl
.
Set
Default
Proof
Using
"Type"
.
(** Stack 2: With helping, bag spec. *)
Definition
mk_offer
:
val
:
=
λ
:
"v"
,
(
"v"
,
ref
#
0
).
Definition
revoke_offer
:
val
:
=
λ
:
"v"
,
if
:
CAS
(
Snd
"v"
)
#
0
#
2
then
SOME
(
Fst
"v"
)
else
NONE
.
Definition
take_offer
:
val
:
=
λ
:
"v"
,
if
:
CAS
(
Snd
"v"
)
#
0
#
1
then
SOME
(
Fst
"v"
)
else
NONE
.
Definition
mailbox
:
val
:
=
λ
:
"_"
,
let
:
"r"
:
=
ref
NONEV
in
(
rec
:
"put"
"v"
:
=
let
:
"off"
:
=
mk_offer
"v"
in
"r"
<-
SOME
"off"
;;
revoke_offer
"off"
,
rec
:
"get"
"n"
:
=
let
:
"offopt"
:
=
!
"r"
in
match
:
"offopt"
with
NONE
=>
NONE
|
SOME
"x"
=>
take_offer
"x"
end
).
Definition
mk_stack
:
val
:
=
λ
:
"_"
,
let
:
"mailbox"
:
=
mailbox
#()
in
let
:
"put"
:
=
Fst
"mailbox"
in
let
:
"get"
:
=
Snd
"mailbox"
in
let
:
"r"
:
=
ref
NONEV
in
(
rec
:
"pop"
"n"
:
=
match
:
"get"
#()
with
NONE
=>
(
match
:
!
"r"
with
NONE
=>
NONE
|
SOME
"hd"
=>
if
:
CAS
"r"
(
SOME
"hd"
)
(
Snd
"hd"
)
then
SOME
(
Fst
"hd"
)
else
"pop"
"n"
end
)
|
SOME
"x"
=>
SOME
"x"
end
,
rec
:
"push"
"n"
:
=
match
:
"put"
"n"
with
NONE
=>
#()
|
SOME
"n"
=>
let
:
"r'"
:
=
!
"r"
in
let
:
"r''"
:
=
SOME
(
"n"
,
"r'"
)
in
if
:
CAS
"r"
"r'"
"r''"
then
#()
else
"push"
"n"
end
).
Definition
channelR
:
=
exclR
unitR
.
Class
channelG
Σ
:
=
{
channel_inG
:
>
inG
Σ
channelR
}.
Definition
channel
Σ
:
gFunctors
:
=
#[
GFunctor
channelR
].
Instance
subG_channel
Σ
{
Σ
}
:
subG
channel
Σ
Σ
→
channelG
Σ
.
Proof
.
solve_inG
.
Qed
.
Section
side_channel
.
Context
`
{!
heapG
Σ
,
!
channelG
Σ
}.
Implicit
Types
l
:
loc
.
Definition
stages
γ
(
P
:
val
→
iProp
Σ
)
l
v
:
=
((
l
↦
#
0
∗
P
v
)
∨
(
l
↦
#
1
)
∨
(
l
↦
#
2
∗
own
γ
(
Excl
())))%
I
.
Definition
is_offer
γ
(
P
:
val
→
iProp
Σ
)
(
v
:
val
)
:
iProp
Σ
:
=
(
∃
v'
l
,
⌜
v
=
(
v'
,
#
l
)%
V
⌝
∗
∃
ι
,
inv
ι
(
stages
γ
P
l
v'
))%
I
.
Definition
mailbox_inv
(
P
:
val
→
iProp
Σ
)
(
v
:
val
)
:
iProp
Σ
:
=
(
∃
l
,
⌜
v
=
#
l
⌝
∗
(
l
↦
NONEV
∨
(
∃
v'
γ
,
l
↦
SOMEV
v'
∗
is_offer
γ
P
v'
)))%
I
.
(* A partial specification for revoke that will be useful later *)
Lemma
revoke_works
N
γ
P
l
v
:
inv
N
(
stages
γ
P
l
v
)
∗
own
γ
(
Excl
())
-
∗
WP
revoke_offer
(
v
,
#
l
)
{{
v'
,
(
∃
v''
:
val
,
⌜
v'
=
InjRV
v''
⌝
∗
P
v''
)
∨
⌜
v'
=
InjLV
#()
⌝
}}.
Proof
.
iIntros
"[#Hinv Hγ]"
.
wp_let
.
wp_proj
.
wp_bind
(
CAS
_
_
_
).
iInv
N
as
"Hstages"
"Hclose"
.
iDestruct
"Hstages"
as
"[H | [H | H]]"
.
-
iDestruct
"H"
as
"[Hl HP]"
.
wp_cas_suc
.
iMod
(
"Hclose"
with
"[Hl Hγ]"
).
iRight
;
iRight
;
iFrame
.
iModIntro
.
wp_if
.
wp_proj
.
iLeft
.
iExists
v
;
iSplit
;
auto
.
-
wp_cas_fail
.
iMod
(
"Hclose"
with
"[H]"
).
iRight
;
iLeft
;
auto
.
iModIntro
.
wp_if
.
iRight
;
auto
.
-
iDestruct
"H"
as
"[Hl H]"
.
wp_cas_fail
.
by
iDestruct
(
own_valid_2
with
"H Hγ"
)
as
%?.
Qed
.
(* A partial specification for take that will be useful later *)
Lemma
take_works
γ
N
P
v
l
:
inv
N
(
stages
γ
P
l
v
)
-
∗
WP
take_offer
(
v
,
LitV
l
)%
V
{{
v'
,
(
∃
v''
:
val
,
⌜
v'
=
InjRV
v''
⌝
∗
P
v''
)
∨
⌜
v'
=
InjLV
#()
⌝
}}.
Proof
.
iIntros
"#Hinv"
.
wp_lam
.
wp_proj
.
wp_bind
(
CAS
_
_
_
).
iInv
N
as
"Hstages"
"Hclose"
.
iDestruct
"Hstages"
as
"[H | [H | H]]"
.
-
iDestruct
"H"
as
"[H HP]"
.
wp_cas_suc
.
iMod
(
"Hclose"
with
"[H]"
).
iRight
;
iLeft
;
done
.
iModIntro
.
wp_if
.
wp_proj
.
iLeft
.
auto
.
-
wp_cas_fail
.
iMod
(
"Hclose"
with
"[H]"
).
iRight
;
iLeft
;
done
.
iModIntro
.
wp_if
.
auto
.
-
iDestruct
"H"
as
"[Hl Hγ]"
.
wp_cas_fail
.