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
Fairis
Commits
3207ffe1
Commit
3207ffe1
authored
Feb 24, 2016
by
Ralf Jung
Browse files
Merge branch 'master' of gitlab.mpi-sws.org:FP/iris-coq
parents
1b172b22
a1407723
Changes
3
Hide whitespace changes
Inline
Side-by-side
barrier/proof.v
View file @
3207ffe1
...
...
@@ -163,8 +163,8 @@ Proof.
+
apply
pvs_mono
.
rewrite
-
sts_ownS_op
;
eauto
using
i_states_closed
,
low_states_closed
.
set_solver
.
+
move
=>
/=
t
.
rewrite
!
mkSet_
elem_of
;
intros
[
<-|<-
];
set_solver
.
+
rewrite
!
mkSet_
elem_of
;
set_solver
.
+
move
=>
/=
t
.
rewrite
!
elem_of
_mkSet
;
intros
[
<-|<-
];
set_solver
.
+
rewrite
!
elem_of
_mkSet
;
set_solver
.
+
auto
using
sts
.
closed_op
,
i_states_closed
,
low_states_closed
.
Qed
.
...
...
@@ -293,7 +293,7 @@ Proof.
apply
sep_mono
.
*
rewrite
-
sts_ownS_op
;
eauto
using
i_states_closed
.
+
apply
sts_own_weaken
;
eauto
using
sts
.
closed_op
,
i_states_closed
.
rewrite
!
mkSet_
elem_of
;
set_solver
.
rewrite
!
elem_of
_mkSet
;
set_solver
.
+
set_solver
.
*
rewrite
const_equiv
// !left_id.
rewrite
{
1
}
[
heap_ctx
_
]
always_sep_dup
{
1
}
[
sts_ctx
_
_
_
]
always_sep_dup
.
...
...
@@ -319,7 +319,7 @@ Proof.
apply
sep_mono
.
*
rewrite
-
sts_ownS_op
;
eauto
using
i_states_closed
.
+
apply
sts_own_weaken
;
eauto
using
sts
.
closed_op
,
i_states_closed
.
rewrite
!
mkSet_
elem_of
;
set_solver
.
rewrite
!
elem_of
_mkSet
;
set_solver
.
+
set_solver
.
*
rewrite
const_equiv
// !left_id.
rewrite
{
1
}
[
heap_ctx
_
]
always_sep_dup
{
1
}
[
sts_ctx
_
_
_
]
always_sep_dup
.
...
...
barrier/protocol.v
View file @
3207ffe1
...
...
@@ -18,7 +18,7 @@ Inductive prim_step : relation state :=
|
ChangePhase
I
:
prim_step
(
State
Low
I
)
(
State
High
I
).
Definition
change_tok
(
I
:
gset
gname
)
:
set
token
:=
mkSet
(
λ
t
,
match
t
with
Change
i
=>
i
∉
I
|
Send
=>
False
end
)
.
{
[
t
|
match
t
with
Change
i
=>
i
∉
I
|
Send
=>
False
end
]
}
.
Definition
send_tok
(
p
:
phase
)
:
set
token
:=
match
p
with
Low
=>
∅
|
High
=>
{
[
Send
]
}
end
.
Definition
tok
(
s
:
state
)
:
set
token
:=
...
...
@@ -28,29 +28,27 @@ Global Arguments tok !_ /.
Canonical
Structure
sts
:=
sts
.
STS
prim_step
tok
.
(
*
The
set
of
states
containing
some
particular
i
*
)
Definition
i_states
(
i
:
gname
)
:
set
state
:=
mkSet
(
λ
s
,
i
∈
state_I
s
).
Definition
i_states
(
i
:
gname
)
:
set
state
:=
{
[
s
|
i
∈
state_I
s
]
}
.
(
*
The
set
of
low
states
*
)
Definition
low_states
:
set
state
:=
mkSet
(
λ
s
,
if
state_phase
s
is
Low
then
True
else
False
).
Definition
low_states
:
set
state
:=
{
[
s
|
state_phase
s
=
Low
]
}
.
Lemma
i_states_closed
i
:
sts
.
closed
(
i_states
i
)
{
[
Change
i
]
}
.
Proof
.
split
.
-
move
=>
[
p
I
].
rewrite
/=
!
mkSet_
elem_of
/=
=>
HI
.
-
move
=>
[
p
I
].
rewrite
/=
!
elem_of
_mkSet
/=
=>
HI
.
destruct
p
;
set_solver
by
eauto
.
-
(
*
If
we
do
the
destruct
of
the
states
early
,
and
then
inversion
on
the
proof
of
a
transition
,
it
doesn
'
t
work
-
we
do
not
obtain
the
equalities
we
need
.
So
we
destruct
the
states
late
,
because
this
means
we
can
use
"destruct"
instead
of
"inversion"
.
*
)
move
=>
s1
s2
.
rewrite
!
mkSet_
elem_of
.
move
=>
s1
s2
.
rewrite
!
elem_of
_mkSet
.
intros
Hs1
[
T1
T2
Hdisj
Hstep
'
].
inversion_clear
Hstep
'
as
[
?
?
?
?
Htrans
_
_
Htok
].
destruct
Htrans
;
simpl
in
*
;
last
done
.
move:
Hs1
Hdisj
Htok
.
rewrite
elem_of_equiv_empty
elem_of_equiv
.
move
=>
?
/
(
_
(
Change
i
))
Hdisj
/
(
_
(
Change
i
));
move
:
Hdisj
.
rewrite
elem_of_intersection
elem_of_union
!
mkSet_
elem_of
.
rewrite
elem_of_intersection
elem_of_union
!
elem_of
_mkSet
.
intros
;
apply
dec_stable
.
destruct
p
;
set_solver
.
Qed
.
...
...
@@ -58,13 +56,13 @@ Qed.
Lemma
low_states_closed
:
sts
.
closed
low_states
{
[
Send
]
}
.
Proof
.
split
.
-
move
=>
[
p
I
].
rewrite
/=
/
tok
!
mkSet_
elem_of
/=
=>
HI
.
-
move
=>
[
p
I
].
rewrite
/=
/
tok
!
elem_of
_mkSet
/=
=>
HI
.
destruct
p
;
set_solver
.
-
move
=>
s1
s2
.
rewrite
!
mkSet_
elem_of
.
-
move
=>
s1
s2
.
rewrite
!
elem_of
_mkSet
.
intros
Hs1
[
T1
T2
Hdisj
Hstep
'
].
inversion_clear
Hstep
'
as
[
?
?
?
?
Htrans
_
_
Htok
].
destruct
Htrans
;
simpl
in
*
;
first
by
destruct
p
.
set_solver
.
exfalso
;
set_solver
.
Qed
.
(
*
Proof
that
we
can
take
the
steps
we
need
.
*
)
...
...
@@ -79,7 +77,7 @@ Proof.
constructor
;
first
constructor
;
simpl
;
[
set_solver
by
eauto
..
|
].
(
*
TODO
this
proof
is
rather
annoying
.
*
)
apply
elem_of_equiv
=>
t
.
rewrite
!
elem_of_union
.
rewrite
!
mkSet_
elem_of
/
change_tok
/=
.
rewrite
!
elem_of
_mkSet
/
change_tok
/=
.
destruct
t
as
[
j
|
];
last
set_solver
.
rewrite
elem_of_difference
elem_of_singleton
.
destruct
(
decide
(
i
=
j
));
set_solver
.
...
...
@@ -96,11 +94,11 @@ Proof.
-
destruct
p
;
set_solver
.
(
*
This
gets
annoying
...
and
I
think
I
can
see
a
pattern
with
all
these
proofs
.
Automatable
?
*
)
-
apply
elem_of_equiv
=>
t
.
destruct
t
;
last
set_solver
.
rewrite
!
mkSet_
elem_of
!
not_elem_of_union
!
not_elem_of_singleton
rewrite
!
elem_of
_mkSet
!
not_elem_of_union
!
not_elem_of_singleton
not_elem_of_difference
elem_of_singleton
!
(
inj_iff
Change
).
destruct
p
;
naive_solver
.
-
apply
elem_of_equiv
=>
t
.
destruct
t
as
[
j
|
];
last
set_solver
.
rewrite
!
mkSet_
elem_of
!
not_elem_of_union
!
not_elem_of_singleton
rewrite
!
elem_of
_mkSet
!
not_elem_of_union
!
not_elem_of_singleton
not_elem_of_difference
elem_of_singleton
!
(
inj_iff
Change
).
destruct
(
decide
(
i1
=
j
))
as
[
->|
];
first
tauto
.
destruct
(
decide
(
i2
=
j
))
as
[
->|
];
intuition
.
...
...
prelude/sets.v
View file @
3207ffe1
(
*
Copyright
(
c
)
2012
-
2015
,
Robbert
Krebbers
.
*
)
(
*
This
file
is
distributed
under
the
terms
of
the
BSD
license
.
*
)
(
**
This
file
implements
sets
as
functions
into
Prop
.
*
)
From
prelude
Require
Export
prelude
.
From
prelude
Require
Export
tactics
.
Record
set
(
A
:
Type
)
:
Type
:=
mkSet
{
set_car
:
A
→
Prop
}
.
Add
Printing
Constructor
set
.
Arguments
mkSet
{
_
}
_.
Arguments
set_car
{
_
}
_
_.
Instance
set_all
{
A
}
:
Top
(
set
A
)
:=
mkSet
(
λ
_
,
True
).
Instance
set_empty
{
A
}
:
Empty
(
set
A
)
:=
mkSet
(
λ
_
,
False
)
.
Instance
set_singleton
{
A
}
:
Singleton
A
(
set
A
)
:=
λ
x
,
mkSet
(
x
=
).
Notation
"{[ x | P ]}"
:=
(
mkSet
(
λ
x
,
P
))
(
at
level
1
,
format
"{[ x | P ]}"
)
:
C_scope
.
Instance
set_elem_of
{
A
}
:
ElemOf
A
(
set
A
)
:=
λ
x
X
,
set_car
X
x
.
Instance
set_union
{
A
}
:
Union
(
set
A
)
:=
λ
X1
X2
,
mkSet
(
λ
x
,
x
∈
X1
∨
x
∈
X2
).
Instance
set_all
{
A
}
:
Top
(
set
A
)
:=
{
[
_
|
True
]
}
.
Instance
set_empty
{
A
}
:
Empty
(
set
A
)
:=
{
[
_
|
False
]
}
.
Instance
set_singleton
{
A
}
:
Singleton
A
(
set
A
)
:=
λ
y
,
{
[
x
|
y
=
x
]
}
.
Instance
set_union
{
A
}
:
Union
(
set
A
)
:=
λ
X1
X2
,
{
[
x
|
x
∈
X1
∨
x
∈
X2
]
}
.
Instance
set_intersection
{
A
}
:
Intersection
(
set
A
)
:=
λ
X1
X2
,
mkSet
(
λ
x
,
x
∈
X1
∧
x
∈
X2
)
.
{
[
x
|
x
∈
X1
∧
x
∈
X2
]
}
.
Instance
set_difference
{
A
}
:
Difference
(
set
A
)
:=
λ
X1
X2
,
mkSet
(
λ
x
,
x
∈
X1
∧
x
∉
X2
)
.
{
[
x
|
x
∈
X1
∧
x
∉
X2
]
}
.
Instance
set_collection
:
Collection
A
(
set
A
).
Proof
.
by
split
;
[
split
|
|
];
repeat
intro
.
Qed
.
Proof
.
split
;
[
split
|
|
];
by
repeat
intro
.
Qed
.
Lemma
mkSet_
elem_of
{
A
}
(
f
:
A
→
Prop
)
x
:
(
x
∈
mkSet
f
)
=
f
x
.
Lemma
elem_of
_mkSet
{
A
}
(
P
:
A
→
Prop
)
x
:
(
x
∈
{
[
x
|
P
x
]
}
)
=
P
x
.
Proof
.
done
.
Qed
.
Lemma
mkSet_
not_elem_of
{
A
}
(
f
:
A
→
Prop
)
x
:
(
x
∉
mkSet
f
)
=
(
¬
f
x
).
Lemma
not_elem_of
_mkSet
{
A
}
(
P
:
A
→
Prop
)
x
:
(
x
∉
{
[
x
|
P
x
]
}
)
=
(
¬
P
x
).
Proof
.
done
.
Qed
.
Instance
set_ret
:
MRet
set
:=
λ
A
(
x
:
A
),
{
[
x
]
}
.
Instance
set_bind
:
MBind
set
:=
λ
A
B
(
f
:
A
→
set
B
)
(
X
:
set
A
),
mkSet
(
λ
b
,
∃
a
,
b
∈
f
a
∧
a
∈
X
).
Instance
set_fmap
:
FMap
set
:=
λ
A
B
(
f
:
A
→
B
)
(
X
:
set
A
),
mkSet
(
λ
b
,
∃
a
,
b
=
f
a
∧
a
∈
X
)
.
{
[
b
|
∃
a
,
b
=
f
a
∧
a
∈
X
]
}
.
Instance
set_join
:
MJoin
set
:=
λ
A
(
XX
:
set
(
set
A
)),
mkSet
(
λ
a
,
∃
X
,
a
∈
X
∧
X
∈
XX
)
.
{
[
a
|
∃
X
,
a
∈
X
∧
X
∈
XX
]
}
.
Instance
set_collection_monad
:
CollectionMonad
set
.
Proof
.
by
split
;
try
apply
_.
Qed
.
...
...
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