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
Simon Spies
Iris
Commits
a1407723
Commit
a1407723
authored
Feb 24, 2016
by
Robbert Krebbers
Browse files
Nice notation for mkSet.
parent
0ef28164
Changes
3
Hide whitespace changes
Inline
Side-by-side
barrier/proof.v
View file @
a1407723
...
...
@@ -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 @
a1407723
...
...
@@ -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 @
a1407723
(* 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