Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
Iris
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Terraform modules
Monitor
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Simcha van Collem
Iris
Commits
b3c3d734
Commit
b3c3d734
authored
9 years ago
by
Robbert Krebbers
Browse files
Options
Downloads
Patches
Plain Diff
Let set_solver handle mkSet.
parent
a1407723
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
algebra/sts.v
+7
-12
7 additions, 12 deletions
algebra/sts.v
barrier/proof.v
+3
-3
3 additions, 3 deletions
barrier/proof.v
barrier/protocol.v
+5
-9
5 additions, 9 deletions
barrier/protocol.v
prelude/collections.v
+8
-0
8 additions, 0 deletions
prelude/collections.v
prelude/sets.v
+5
-3
5 additions, 3 deletions
prelude/sets.v
with
28 additions
and
27 deletions
algebra/sts.v
+
7
−
12
View file @
b3c3d734
...
@@ -40,7 +40,7 @@ Record closed (S : states sts) (T : tokens sts) : Prop := Closed {
...
@@ -40,7 +40,7 @@ Record closed (S : states sts) (T : tokens sts) : Prop := Closed {
closed_step
s1
s2
:
s1
∈
S
→
frame_step
T
s1
s2
→
s2
∈
S
closed_step
s1
s2
:
s1
∈
S
→
frame_step
T
s1
s2
→
s2
∈
S
}
.
}
.
Definition
up
(
s
:
state
sts
)
(
T
:
tokens
sts
)
:
states
sts
:=
Definition
up
(
s
:
state
sts
)
(
T
:
tokens
sts
)
:
states
sts
:=
mkSet
(
rtc
(
frame_step
T
)
s
)
.
{[
s'
|
rtc
(
frame_step
T
)
s
s'
]}
.
Definition
up_set
(
S
:
states
sts
)
(
T
:
tokens
sts
)
:
states
sts
:=
Definition
up_set
(
S
:
states
sts
)
(
T
:
tokens
sts
)
:
states
sts
:=
S
≫=
λ
s
,
up
s
T
.
S
≫=
λ
s
,
up
s
T
.
...
@@ -70,7 +70,7 @@ Global Instance up_preserving : Proper ((=) ==> flip (⊆) ==> (⊆)) up.
...
@@ -70,7 +70,7 @@ Global Instance up_preserving : Proper ((=) ==> flip (⊆) ==> (⊆)) up.
Proof
.
Proof
.
intros
s
?
<-
T
T'
HT
;
apply
elem_of_subseteq
.
intros
s
?
<-
T
T'
HT
;
apply
elem_of_subseteq
.
induction
1
as
[|
s1
s2
s3
[
T1
T2
]];
[
constructor
|]
.
induction
1
as
[|
s1
s2
s3
[
T1
T2
]];
[
constructor
|]
.
eapply
rtc_l
;
[
eapply
Frame_step
with
T1
T2
|];
eauto
with
sts
.
eapply
elem_of_mkSet
,
rtc_l
;
[
eapply
Frame_step
with
T1
T2
|];
eauto
with
sts
.
Qed
.
Qed
.
Global
Instance
up_proper
:
Proper
((
=
)
==>
(
≡
)
==>
(
≡
))
up
.
Global
Instance
up_proper
:
Proper
((
=
)
==>
(
≡
)
==>
(
≡
))
up
.
Proof
.
by
intros
???
??
[??];
split
;
apply
up_preserving
.
Qed
.
Proof
.
by
intros
???
??
[??];
split
;
apply
up_preserving
.
Qed
.
...
@@ -128,7 +128,7 @@ Proof.
...
@@ -128,7 +128,7 @@ Proof.
specialize
(
HS
s'
Hs'
);
clear
Hs'
S
.
specialize
(
HS
s'
Hs'
);
clear
Hs'
S
.
induction
Hstep
as
[
s
|
s1
s2
s3
[
T1
T2
?
Hstep
]
?
IH
];
first
done
.
induction
Hstep
as
[
s
|
s1
s2
s3
[
T1
T2
?
Hstep
]
?
IH
];
first
done
.
inversion_clear
Hstep
;
apply
IH
;
clear
IH
;
auto
with
sts
.
inversion_clear
Hstep
;
apply
IH
;
clear
IH
;
auto
with
sts
.
-
intros
s1
s2
;
rewrite
!
elem_of_bin
d
;
intros
(
s
&
?
&
?)
?;
exists
s
.
-
intros
s1
s2
;
rewrite
/
up
;
set_unfol
d
;
intros
(
s
&
?
&
?)
?;
exists
s
.
split
;
[
eapply
rtc_r
|];
eauto
.
split
;
[
eapply
rtc_r
|];
eauto
.
Qed
.
Qed
.
Lemma
closed_up
s
T
:
tok
s
∩
T
≡
∅
→
closed
(
up
s
T
)
T
.
Lemma
closed_up
s
T
:
tok
s
∩
T
≡
∅
→
closed
(
up
s
T
)
T
.
...
@@ -359,9 +359,7 @@ Lemma sts_op_auth_frag_up s T :
...
@@ -359,9 +359,7 @@ Lemma sts_op_auth_frag_up s T :
sts_auth
s
∅
⋅
sts_frag_up
s
T
≡
sts_auth
s
T
.
sts_auth
s
∅
⋅
sts_frag_up
s
T
≡
sts_auth
s
T
.
Proof
.
Proof
.
intros
;
split
;
[
split
|
constructor
;
set_solver
];
simpl
.
intros
;
split
;
[
split
|
constructor
;
set_solver
];
simpl
.
-
intros
(?
&
?
&
?)
.
destruct_conjs
.
-
intros
(?
&
[??]
&
?)
.
by
apply
closed_disjoint
with
(
up
s
T
),
elem_of_up
.
apply
closed_disjoint
with
(
up
s
T
);
first
done
.
apply
elem_of_up
.
-
intros
;
split_and
?
.
-
intros
;
split_and
?
.
+
set_solver
+.
+
set_solver
+.
+
by
apply
closed_up
.
+
by
apply
closed_up
.
...
@@ -411,12 +409,9 @@ Lemma up_set_intersection S1 Sf Tf :
...
@@ -411,12 +409,9 @@ Lemma up_set_intersection S1 Sf Tf :
S1
∩
Sf
≡
S1
∩
up_set
(
S1
∩
Sf
)
Tf
.
S1
∩
Sf
≡
S1
∩
up_set
(
S1
∩
Sf
)
Tf
.
Proof
.
Proof
.
intros
Hclf
.
apply
(
anti_symm
(
⊆
))
.
intros
Hclf
.
apply
(
anti_symm
(
⊆
))
.
+
move
=>
s
[
HS1
HSf
]
.
split
;
first
by
apply
HS1
.
+
move
=>
s
[
HS1
HSf
]
.
split
.
by
apply
HS1
.
by
apply
subseteq_up_set
.
by
apply
subseteq_up_set
.
+
move
=>
s
[
HS1
[
s'
[
/
elem_of_mkSet
Hsup
Hs'
]]]
.
split
;
first
done
.
+
move
=>
s
[
HS1
Hscl
]
.
split
;
first
done
.
eapply
closed_steps
,
Hsup
;
first
done
.
set_solver
+
Hs'
.
destruct
Hscl
as
[
s'
[
Hsup
Hs'
]]
.
eapply
closed_steps
;
last
(
hnf
in
Hsup
;
eexact
Hsup
);
first
done
.
set_solver
+
Hs'
.
Qed
.
Qed
.
(** Inclusion *)
(** Inclusion *)
...
...
This diff is collapsed.
Click to expand it.
barrier/proof.v
+
3
−
3
View file @
b3c3d734
...
@@ -164,7 +164,7 @@ Proof.
...
@@ -164,7 +164,7 @@ Proof.
rewrite
-
sts_ownS_op
;
eauto
using
i_states_closed
,
low_states_closed
.
rewrite
-
sts_ownS_op
;
eauto
using
i_states_closed
,
low_states_closed
.
set_solver
.
set_solver
.
+
move
=>
/=
t
.
rewrite
!
elem_of_mkSet
;
intros
[
<-|<-
];
set_solver
.
+
move
=>
/=
t
.
rewrite
!
elem_of_mkSet
;
intros
[
<-|<-
];
set_solver
.
+
rewrite
!
elem_of_mkSet
;
set_solver
.
+
rewrite
/=
/
i_states
.
set_solver
.
+
auto
using
sts
.
closed_op
,
i_states_closed
,
low_states_closed
.
+
auto
using
sts
.
closed_op
,
i_states_closed
,
low_states_closed
.
Qed
.
Qed
.
...
@@ -293,7 +293,7 @@ Proof.
...
@@ -293,7 +293,7 @@ Proof.
apply
sep_mono
.
apply
sep_mono
.
*
rewrite
-
sts_ownS_op
;
eauto
using
i_states_closed
.
*
rewrite
-
sts_ownS_op
;
eauto
using
i_states_closed
.
+
apply
sts_own_weaken
;
eauto
using
sts
.
closed_op
,
i_states_closed
.
+
apply
sts_own_weaken
;
eauto
using
sts
.
closed_op
,
i_states_closed
.
rewrite
!
elem_of_mkSet
;
set_solver
.
rewrite
/
i_states
.
set_solver
.
+
set_solver
.
+
set_solver
.
*
rewrite
const_equiv
//
!
left_id
.
*
rewrite
const_equiv
//
!
left_id
.
rewrite
{
1
}[
heap_ctx
_]
always_sep_dup
{
1
}[
sts_ctx
_
_
_]
always_sep_dup
.
rewrite
{
1
}[
heap_ctx
_]
always_sep_dup
{
1
}[
sts_ctx
_
_
_]
always_sep_dup
.
...
@@ -319,7 +319,7 @@ Proof.
...
@@ -319,7 +319,7 @@ Proof.
apply
sep_mono
.
apply
sep_mono
.
*
rewrite
-
sts_ownS_op
;
eauto
using
i_states_closed
.
*
rewrite
-
sts_ownS_op
;
eauto
using
i_states_closed
.
+
apply
sts_own_weaken
;
eauto
using
sts
.
closed_op
,
i_states_closed
.
+
apply
sts_own_weaken
;
eauto
using
sts
.
closed_op
,
i_states_closed
.
rewrite
!
elem_of_mkSet
;
set_solver
.
rewrite
/
i_states
.
set_solver
.
+
set_solver
.
+
set_solver
.
*
rewrite
const_equiv
//
!
left_id
.
*
rewrite
const_equiv
//
!
left_id
.
rewrite
{
1
}[
heap_ctx
_]
always_sep_dup
{
1
}[
sts_ctx
_
_
_]
always_sep_dup
.
rewrite
{
1
}[
heap_ctx
_]
always_sep_dup
{
1
}[
sts_ctx
_
_
_]
always_sep_dup
.
...
...
This diff is collapsed.
Click to expand it.
barrier/protocol.v
+
5
−
9
View file @
b3c3d734
...
@@ -36,14 +36,12 @@ Definition low_states : set state := {[ s | state_phase s = Low ]}.
...
@@ -36,14 +36,12 @@ Definition low_states : set state := {[ s | state_phase s = Low ]}.
Lemma
i_states_closed
i
:
sts
.
closed
(
i_states
i
)
{[
Change
i
]}
.
Lemma
i_states_closed
i
:
sts
.
closed
(
i_states
i
)
{[
Change
i
]}
.
Proof
.
Proof
.
split
.
split
.
-
move
=>[
p
I
]
.
rewrite
/=
!
elem_of_mkSet
/=
=>
HI
.
-
intros
[
p
I
]
.
rewrite
/=
/
i_states
/
change_tok
.
destruct
p
;
set_solver
.
destruct
p
;
set_solver
by
eauto
.
-
(* If we do the destruct of the states early, and then inversion
-
(* 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
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
the equalities we need. So we destruct the states late, because this
means we can use "destruct" instead of "inversion". *)
means we can use "destruct" instead of "inversion". *)
move
=>
s1
s2
.
rewrite
!
elem_of_mkSet
.
intros
s1
s2
Hs1
[
T1
T2
Hdisj
Hstep'
]
.
intros
Hs1
[
T1
T2
Hdisj
Hstep'
]
.
inversion_clear
Hstep'
as
[?
?
?
?
Htrans
_
_
Htok
]
.
inversion_clear
Hstep'
as
[?
?
?
?
Htrans
_
_
Htok
]
.
destruct
Htrans
;
simpl
in
*
;
last
done
.
destruct
Htrans
;
simpl
in
*
;
last
done
.
move
:
Hs1
Hdisj
Htok
.
rewrite
elem_of_equiv_empty
elem_of_equiv
.
move
:
Hs1
Hdisj
Htok
.
rewrite
elem_of_equiv_empty
elem_of_equiv
.
...
@@ -56,10 +54,8 @@ Qed.
...
@@ -56,10 +54,8 @@ Qed.
Lemma
low_states_closed
:
sts
.
closed
low_states
{[
Send
]}
.
Lemma
low_states_closed
:
sts
.
closed
low_states
{[
Send
]}
.
Proof
.
Proof
.
split
.
split
.
-
move
=>[
p
I
]
.
rewrite
/=
/
tok
!
elem_of_mkSet
/=
=>
HI
.
-
intros
[
p
I
]
.
rewrite
/
low_states
.
set_solver
.
destruct
p
;
set_solver
.
-
intros
s1
s2
Hs1
[
T1
T2
Hdisj
Hstep'
]
.
-
move
=>
s1
s2
.
rewrite
!
elem_of_mkSet
.
intros
Hs1
[
T1
T2
Hdisj
Hstep'
]
.
inversion_clear
Hstep'
as
[?
?
?
?
Htrans
_
_
Htok
]
.
inversion_clear
Hstep'
as
[?
?
?
?
Htrans
_
_
Htok
]
.
destruct
Htrans
;
simpl
in
*
;
first
by
destruct
p
.
destruct
Htrans
;
simpl
in
*
;
first
by
destruct
p
.
exfalso
;
set_solver
.
exfalso
;
set_solver
.
...
@@ -74,7 +70,7 @@ Lemma wait_step i I :
...
@@ -74,7 +70,7 @@ Lemma wait_step i I :
sts
.
steps
(
State
High
I
,
{[
Change
i
]})
(
State
High
(
I
∖
{[
i
]}),
∅
)
.
sts
.
steps
(
State
High
I
,
{[
Change
i
]})
(
State
High
(
I
∖
{[
i
]}),
∅
)
.
Proof
.
Proof
.
intros
.
apply
rtc_once
.
intros
.
apply
rtc_once
.
constructor
;
first
constructor
;
simpl
;
[
set_solver
by
eauto
..|]
.
constructor
;
first
constructor
;
rewrite
/=
/
change_tok
;
[
set_solver
by
eauto
..|]
.
(* TODO this proof is rather annoying. *)
(* TODO this proof is rather annoying. *)
apply
elem_of_equiv
=>
t
.
rewrite
!
elem_of_union
.
apply
elem_of_equiv
=>
t
.
rewrite
!
elem_of_union
.
rewrite
!
elem_of_mkSet
/
change_tok
/=.
rewrite
!
elem_of_mkSet
/
change_tok
/=.
...
...
This diff is collapsed.
Click to expand it.
prelude/collections.v
+
8
−
0
View file @
b3c3d734
...
@@ -4,6 +4,7 @@
...
@@ -4,6 +4,7 @@
importantly, it implements some tactics to automatically solve goals involving
importantly, it implements some tactics to automatically solve goals involving
collections. *)
collections. *)
From
prelude
Require
Export
base
tactics
orders
.
From
prelude
Require
Export
base
tactics
orders
.
From
prelude
Require
Import
sets
.
Instance
collection_subseteq
`{
ElemOf
A
C
}
:
SubsetEq
C
:=
λ
X
Y
,
Instance
collection_subseteq
`{
ElemOf
A
C
}
:
SubsetEq
C
:=
λ
X
Y
,
∀
x
,
x
∈
X
→
x
∈
Y
.
∀
x
,
x
∈
X
→
x
∈
Y
.
...
@@ -153,6 +154,9 @@ Tactic Notation "decompose_elem_of" hyp(H) :=
...
@@ -153,6 +154,9 @@ Tactic Notation "decompose_elem_of" hyp(H) :=
let
rec
go
H
:=
let
rec
go
H
:=
lazymatch
type
of
H
with
lazymatch
type
of
H
with
|
_
∈
∅
=>
apply
elem_of_empty
in
H
;
destruct
H
|
_
∈
∅
=>
apply
elem_of_empty
in
H
;
destruct
H
|
_
∈
⊤
=>
clear
H
|
_
∈
{[
_
|
_
]}
=>
rewrite
elem_of_mkSet
in
H
|
¬
_
∈
{[
_
|
_
]}
=>
rewrite
not_elem_of_mkSet
in
H
|
?x
∈
{[
?y
]}
=>
|
?x
∈
{[
?y
]}
=>
apply
elem_of_singleton
in
H
;
try
first
[
subst
y
|
subst
x
]
apply
elem_of_singleton
in
H
;
try
first
[
subst
y
|
subst
x
]
|
?x
∉
{[
?y
]}
=>
|
?x
∉
{[
?y
]}
=>
...
@@ -217,7 +221,9 @@ Ltac set_unfold :=
...
@@ -217,7 +221,9 @@ Ltac set_unfold :=
|
context
[
_
=
∅
]
=>
setoid_rewrite
elem_of_equiv_empty_L
in
H
|
context
[
_
=
∅
]
=>
setoid_rewrite
elem_of_equiv_empty_L
in
H
|
context
[
_
=
_
]
=>
setoid_rewrite
elem_of_equiv_alt_L
in
H
|
context
[
_
=
_
]
=>
setoid_rewrite
elem_of_equiv_alt_L
in
H
|
context
[
_
∈
∅
]
=>
setoid_rewrite
elem_of_empty
in
H
|
context
[
_
∈
∅
]
=>
setoid_rewrite
elem_of_empty
in
H
|
context
[
_
∈
⊤
]
=>
setoid_rewrite
elem_of_all
in
H
|
context
[
_
∈
{[
_
]}
]
=>
setoid_rewrite
elem_of_singleton
in
H
|
context
[
_
∈
{[
_
]}
]
=>
setoid_rewrite
elem_of_singleton
in
H
|
context
[
_
∈
{[_|
_
]}
]
=>
setoid_rewrite
elem_of_mkSet
in
H
;
simpl
in
H
|
context
[
_
∈
_
∪
_
]
=>
setoid_rewrite
elem_of_union
in
H
|
context
[
_
∈
_
∪
_
]
=>
setoid_rewrite
elem_of_union
in
H
|
context
[
_
∈
_
∩
_
]
=>
setoid_rewrite
elem_of_intersection
in
H
|
context
[
_
∈
_
∩
_
]
=>
setoid_rewrite
elem_of_intersection
in
H
|
context
[
_
∈
_
∖
_
]
=>
setoid_rewrite
elem_of_difference
in
H
|
context
[
_
∈
_
∖
_
]
=>
setoid_rewrite
elem_of_difference
in
H
...
@@ -237,7 +243,9 @@ Ltac set_unfold :=
...
@@ -237,7 +243,9 @@ Ltac set_unfold :=
|
|
-
context
[
_
=
∅
]
=>
setoid_rewrite
elem_of_equiv_empty_L
|
|
-
context
[
_
=
∅
]
=>
setoid_rewrite
elem_of_equiv_empty_L
|
|
-
context
[
_
=
_
]
=>
setoid_rewrite
elem_of_equiv_alt_L
|
|
-
context
[
_
=
_
]
=>
setoid_rewrite
elem_of_equiv_alt_L
|
|
-
context
[
_
∈
∅
]
=>
setoid_rewrite
elem_of_empty
|
|
-
context
[
_
∈
∅
]
=>
setoid_rewrite
elem_of_empty
|
|
-
context
[
_
∈
⊤
]
=>
setoid_rewrite
elem_of_all
|
|
-
context
[
_
∈
{[
_
]}
]
=>
setoid_rewrite
elem_of_singleton
|
|
-
context
[
_
∈
{[
_
]}
]
=>
setoid_rewrite
elem_of_singleton
|
|
-
context
[
_
∈
{[
_
|
_
]}
]
=>
setoid_rewrite
elem_of_mkSet
;
simpl
|
|
-
context
[
_
∈
_
∪
_
]
=>
setoid_rewrite
elem_of_union
|
|
-
context
[
_
∈
_
∪
_
]
=>
setoid_rewrite
elem_of_union
|
|
-
context
[
_
∈
_
∩
_
]
=>
setoid_rewrite
elem_of_intersection
|
|
-
context
[
_
∈
_
∩
_
]
=>
setoid_rewrite
elem_of_intersection
|
|
-
context
[
_
∈
_
∖
_
]
=>
setoid_rewrite
elem_of_difference
|
|
-
context
[
_
∈
_
∖
_
]
=>
setoid_rewrite
elem_of_difference
...
...
This diff is collapsed.
Click to expand it.
prelude/sets.v
+
5
−
3
View file @
b3c3d734
...
@@ -23,9 +23,11 @@ Instance set_difference {A} : Difference (set A) := λ X1 X2,
...
@@ -23,9 +23,11 @@ Instance set_difference {A} : Difference (set A) := λ X1 X2,
Instance
set_collection
:
Collection
A
(
set
A
)
.
Instance
set_collection
:
Collection
A
(
set
A
)
.
Proof
.
split
;
[
split
|
|];
by
repeat
intro
.
Qed
.
Proof
.
split
;
[
split
|
|];
by
repeat
intro
.
Qed
.
Lemma
elem_of_
mkSet
{
A
}
(
P
:
A
→
Prop
)
x
:
(
x
∈
{[
x
|
P
x
]})
=
P
x
.
Lemma
elem_of_
all
{
A
}
(
x
:
A
)
:
x
∈
⊤
↔
True
.
Proof
.
done
.
Qed
.
Proof
.
done
.
Qed
.
Lemma
not_elem_of_mkSet
{
A
}
(
P
:
A
→
Prop
)
x
:
(
x
∉
{[
x
|
P
x
]})
=
(
¬
P
x
)
.
Lemma
elem_of_mkSet
{
A
}
(
P
:
A
→
Prop
)
x
:
x
∈
{[
x
|
P
x
]}
↔
P
x
.
Proof
.
done
.
Qed
.
Lemma
not_elem_of_mkSet
{
A
}
(
P
:
A
→
Prop
)
x
:
x
∉
{[
x
|
P
x
]}
↔
¬
P
x
.
Proof
.
done
.
Qed
.
Proof
.
done
.
Qed
.
Instance
set_ret
:
MRet
set
:=
λ
A
(
x
:
A
),
{[
x
]}
.
Instance
set_ret
:
MRet
set
:=
λ
A
(
x
:
A
),
{[
x
]}
.
...
@@ -38,4 +40,4 @@ Instance set_join : MJoin set := λ A (XX : set (set A)),
...
@@ -38,4 +40,4 @@ Instance set_join : MJoin set := λ A (XX : set (set A)),
Instance
set_collection_monad
:
CollectionMonad
set
.
Instance
set_collection_monad
:
CollectionMonad
set
.
Proof
.
by
split
;
try
apply
_
.
Qed
.
Proof
.
by
split
;
try
apply
_
.
Qed
.
Global
Opaque
set_union
set_intersection
set_difference
.
Global
Opaque
set_elem_of
set_union
set_intersection
set_difference
.
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
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!
Save comment
Cancel
Please
register
or
sign in
to comment