Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Simon Spies
stdpp
Commits
e79e91f7
Commit
e79e91f7
authored
Aug 29, 2012
by
Robbert Krebbers
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add documentation, add license, simplify build process, some reorganization,
improve some definitions, simplify some proofs.
parent
fb763df2
Changes
17
Expand all
Hide whitespace changes
Inline
Sidebyside
Showing
17 changed files
with
1190 additions
and
545 deletions
+1190
545
theories/ars.v
theories/ars.v
+159
0
theories/base.v
theories/base.v
+187
130
theories/collections.v
theories/collections.v
+119
96
theories/decidable.v
theories/decidable.v
+75
42
theories/fin_collections.v
theories/fin_collections.v
+57
37
theories/fin_maps.v
theories/fin_maps.v
+100
53
theories/list.v
theories/list.v
+112
52
theories/listset.v
theories/listset.v
+30
13
theories/monads.v
theories/monads.v
+0
20
theories/nmap.v
theories/nmap.v
+8
2
theories/numbers.v
theories/numbers.v
+24
3
theories/option.v
theories/option.v
+81
76
theories/orders.v
theories/orders.v
+11
0
theories/pmap.v
theories/pmap.v
+42
16
theories/prelude.v
theories/prelude.v
+8
4
theories/subset.v
theories/subset.v
+6
1
theories/tactics.v
theories/tactics.v
+171
0
No files found.
theories/
t
rs.v
→
theories/
a
rs.v
View file @
e79e91f7
Require
Export
base
.
Definition
red
`
(
R
:
relation
A
)
(
x
:
A
)
:
=
∃
y
,
R
x
y
.
Definition
nf
`
(
R
:
relation
A
)
(
x
:
A
)
:
=
¬
red
R
x
.
(* T
he
re
flexive transitive closure
*)
Inductive
rtc
`
(
R
:
relation
A
)
:
relation
A
:
=

rtc_refl
x
:
rtc
R
x
x

rtc_l
x
y
z
:
R
x
y
→
rtc
R
y
z
→
rtc
R
x
z
.
(* A reduction of exactly n steps *)
Inductive
nsteps
`
(
R
:
relation
A
)
:
nat
→
relation
A
:
=

nsteps_O
x
:
nsteps
R
0
x
x

nsteps_l
n
x
y
z
:
R
x
y
→
nsteps
R
n
y
z
→
nsteps
R
(
S
n
)
x
z
.
(* A reduction whose length is bounded by n *)
Inductive
bsteps
`
(
R
:
relation
A
)
:
nat
→
relation
A
:
=

bsteps_refl
n
x
:
bsteps
R
n
x
x

bsteps_l
n
x
y
z
:
R
x
y
→
bsteps
R
n
y
z
→
bsteps
R
(
S
n
)
x
z
.
(* The transitive closure *)
Inductive
tc
`
(
R
:
relation
A
)
:
relation
A
:
=

tc_once
x
y
:
R
x
y
→
tc
R
x
y

tc_l
x
y
z
:
R
x
y
→
tc
R
y
z
→
tc
R
x
z
.
Hint
Constructors
rtc
nsteps
bsteps
tc
:
trs
.
Arguments
rtc_l
{
_
_
_
_
_
}
_
_
.
Arguments
nsteps_l
{
_
_
_
_
_
_
}
_
_
.
Arguments
bsteps_refl
{
_
_
}
_
_
.
Arguments
bsteps_l
{
_
_
_
_
_
_
}
_
_
.
Arguments
tc_once
{
_
_
_
}
_
_
.
Arguments
tc_l
{
_
_
_
_
_
}
_
_
.
Ltac
generalize_rtc
H
:
=
match
type
of
H
with

rtc
?R
?x
?y
=>
let
Hx
:
=
fresh
in
let
Hy
:
=
fresh
in
let
Heqx
:
=
fresh
in
let
Heqy
:
=
fresh
in
remember
x
as
(
Hx
,
Heqx
)
;
remember
y
as
(
Hy
,
Heqy
)
;
revert
Heqx
Heqy
;
repeat
match
x
with

context
[
?z
]
=>
revert
z
end
;
repeat
match
y
with

context
[
?z
]
=>
revert
z
end
end
.
(* Copyright (c) 2012, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
(** This file collects definitions and theorems on abstract rewriting systems
.
These are particularly useful as we define the operational semantics as a
small step semantics. This file defines a hint database [ars] containing
some t
he
o
re
ms on abstract rewriting systems.
*)
Require
Export
tactics
base
.
(** * Definitions *)
Section
definitions
.
Context
`
(
R
:
relation
A
)
.
(** An element is reducible if a step is possible. *)
Definition
red
(
x
:
A
)
:
=
∃
y
,
R
x
y
.
(** An element is in normal form if no further steps are possible. *)
Definition
nf
(
x
:
A
)
:
=
¬
red
x
.
(** The reflexive transitive closure. *)
Inductive
rtc
:
relation
A
:
=

r
tc_
ref
l
x
:
rtc
x
x

rtc_l
x
y
z
:
R
x
y
→
rtc
y
z
→
rtc
x
z
.
(** Reductions of exactly [n] steps. *)
Inductive
nsteps
:
nat
→
relation
A
:
=

nsteps_O
x
:
nsteps
0
x
x

nsteps_l
n
x
y
z
:
R
x
y
→
nsteps
n
y
z
→
nsteps
(
S
n
)
x
z
.
(** Reduction of at most [n] steps. *)
Inductive
bsteps
:
nat
→
relation
A
:
=

bsteps_refl
n
x
:
bsteps
n
x
x

bsteps_l
n
x
y
z
:
R
x
y
→
bsteps
n
y
z
→
bsteps
(
S
n
)
x
z
.
(** The transitive closure. *)
Inductive
tc
:
relation
A
:
=

tc_once
x
y
:
R
x
y
→
tc
x
y

tc_l
x
y
z
:
R
x
y
→
tc
y
z
→
tc
x
z
.
(** An element [x] is looping if all paths starting at [x] are infinite. *)
CoInductive
looping
:
A
→
Prop
:
=

looping_do_step
x
:
red
x
→
(
∀
y
,
R
x
y
→
looping
y
)
→
looping
x
.
End
definitions
.
Hint
Constructors
rtc
nsteps
bsteps
tc
:
ars
.
(** * General theorems *)
Section
rtc
.
Context
`
{
R
:
relation
A
}.
Global
Instance
:
Reflexive
(
rtc
R
).
Proof
rtc_refl
R
.
Global
Instance
rtc_trans
:
Transitive
(
rtc
R
).
Proof
.
red
;
induction
1
;
eauto
with
t
rs
.
Qed
.
Lemma
rtc_once
{
x
y
}
:
R
x
y
→
rtc
R
x
y
.
Proof
.
eauto
with
t
rs
.
Qed
.
Proof
.
red
;
induction
1
;
eauto
with
a
rs
.
Qed
.
Lemma
rtc_once
x
y
:
R
x
y
→
rtc
R
x
y
.
Proof
.
eauto
with
a
rs
.
Qed
.
Global
Instance
:
subrelation
R
(
rtc
R
).
Proof
.
exact
@
rtc_once
.
Qed
.
Lemma
rtc_r
{
x
y
z
}
:
rtc
R
x
y
→
R
y
z
→
rtc
R
x
z
.
Proof
.
intros
.
etransitivity
;
eauto
with
t
rs
.
Qed
.
Lemma
rtc_r
x
y
z
:
rtc
R
x
y
→
R
y
z
→
rtc
R
x
z
.
Proof
.
intros
.
etransitivity
;
eauto
with
a
rs
.
Qed
.
Lemma
rtc_inv
{
x
z
}
:
rtc
R
x
z
→
x
=
z
∨
∃
y
,
R
x
y
∧
rtc
R
y
z
.
Lemma
rtc_inv
x
z
:
rtc
R
x
z
→
x
=
z
∨
∃
y
,
R
x
y
∧
rtc
R
y
z
.
Proof
.
inversion_clear
1
;
eauto
.
Qed
.
Lemma
rtc_ind_r
(
P
:
A
→
A
→
Prop
)
Lemma
rtc_ind_r
(
P
:
A
→
A
→
Prop
)
(
Prefl
:
∀
x
,
P
x
x
)
(
Pstep
:
∀
x
y
z
,
rtc
R
x
y
→
R
y
z
→
P
x
y
→
P
x
z
)
:
∀
y
z
,
rtc
R
y
z
→
P
y
z
.
Proof
.
...
...
@@ 70,58 +70,76 @@ Section rtc.
induction
1
;
eauto
using
rtc_r
.
Qed
.
Lemma
rtc_inv_r
{
x
z
}
:
rtc
R
x
z
→
x
=
z
∨
∃
y
,
rtc
R
x
y
∧
R
y
z
.
Lemma
rtc_inv_r
x
z
:
rtc
R
x
z
→
x
=
z
∨
∃
y
,
rtc
R
x
y
∧
R
y
z
.
Proof
.
revert
x
z
.
apply
rtc_ind_r
;
eauto
.
Qed
.
Lemma
nsteps_once
{
x
y
}
:
R
x
y
→
nsteps
R
1
x
y
.
Proof
.
eauto
with
t
rs
.
Qed
.
Lemma
nsteps_trans
{
n
m
x
y
z
}
:
Lemma
nsteps_once
x
y
:
R
x
y
→
nsteps
R
1
x
y
.
Proof
.
eauto
with
a
rs
.
Qed
.
Lemma
nsteps_trans
n
m
x
y
z
:
nsteps
R
n
x
y
→
nsteps
R
m
y
z
→
nsteps
R
(
n
+
m
)
x
z
.
Proof
.
induction
1
;
simpl
;
eauto
with
t
rs
.
Qed
.
Lemma
nsteps_r
{
n
x
y
z
}
:
nsteps
R
n
x
y
→
R
y
z
→
nsteps
R
(
S
n
)
x
z
.
Proof
.
induction
1
;
eauto
with
t
rs
.
Qed
.
Lemma
nsteps_rtc
{
n
x
y
}
:
nsteps
R
n
x
y
→
rtc
R
x
y
.
Proof
.
induction
1
;
eauto
with
t
rs
.
Qed
.
Lemma
rtc_nsteps
{
x
y
}
:
rtc
R
x
y
→
∃
n
,
nsteps
R
n
x
y
.
Proof
.
induction
1
;
firstorder
eauto
with
t
rs
.
Qed
.
Lemma
bsteps_once
{
n
x
y
}
:
R
x
y
→
bsteps
R
(
S
n
)
x
y
.
Proof
.
eauto
with
t
rs
.
Qed
.
Lemma
bsteps_plus_r
{
n
m
x
y
}
:
Proof
.
induction
1
;
simpl
;
eauto
with
a
rs
.
Qed
.
Lemma
nsteps_r
n
x
y
z
:
nsteps
R
n
x
y
→
R
y
z
→
nsteps
R
(
S
n
)
x
z
.
Proof
.
induction
1
;
eauto
with
a
rs
.
Qed
.
Lemma
nsteps_rtc
n
x
y
:
nsteps
R
n
x
y
→
rtc
R
x
y
.
Proof
.
induction
1
;
eauto
with
a
rs
.
Qed
.
Lemma
rtc_nsteps
x
y
:
rtc
R
x
y
→
∃
n
,
nsteps
R
n
x
y
.
Proof
.
induction
1
;
firstorder
eauto
with
a
rs
.
Qed
.
Lemma
bsteps_once
n
x
y
:
R
x
y
→
bsteps
R
(
S
n
)
x
y
.
Proof
.
eauto
with
a
rs
.
Qed
.
Lemma
bsteps_plus_r
n
m
x
y
:
bsteps
R
n
x
y
→
bsteps
R
(
n
+
m
)
x
y
.
Proof
.
induction
1
;
simpl
;
eauto
with
t
rs
.
Qed
.
Lemma
bsteps_weaken
{
n
m
x
y
}
:
Proof
.
induction
1
;
simpl
;
eauto
with
a
rs
.
Qed
.
Lemma
bsteps_weaken
n
m
x
y
:
n
≤
m
→
bsteps
R
n
x
y
→
bsteps
R
m
x
y
.
Proof
.
intros
.
rewrite
(
Minus
.
le_plus_minus
n
m
)
;
auto
using
bsteps_plus_r
.
Qed
.
Lemma
bsteps_plus_l
{
n
m
x
y
}
:
Lemma
bsteps_plus_l
n
m
x
y
:
bsteps
R
n
x
y
→
bsteps
R
(
m
+
n
)
x
y
.
Proof
.
apply
bsteps_weaken
.
auto
with
arith
.
Qed
.
Lemma
bsteps_S
{
n
x
y
}
:
bsteps
R
n
x
y
→
bsteps
R
(
S
n
)
x
y
.
Lemma
bsteps_S
n
x
y
:
bsteps
R
n
x
y
→
bsteps
R
(
S
n
)
x
y
.
Proof
.
apply
bsteps_weaken
.
auto
with
arith
.
Qed
.
Lemma
bsteps_trans
{
n
m
x
y
z
}
:
Lemma
bsteps_trans
n
m
x
y
z
:
bsteps
R
n
x
y
→
bsteps
R
m
y
z
→
bsteps
R
(
n
+
m
)
x
z
.
Proof
.
induction
1
;
simpl
;
eauto
using
bsteps_plus_l
with
t
rs
.
Qed
.
Lemma
bsteps_r
{
n
x
y
z
}
:
bsteps
R
n
x
y
→
R
y
z
→
bsteps
R
(
S
n
)
x
z
.
Proof
.
induction
1
;
eauto
with
t
rs
.
Qed
.
Lemma
bsteps_rtc
{
n
x
y
}
:
bsteps
R
n
x
y
→
rtc
R
x
y
.
Proof
.
induction
1
;
eauto
with
t
rs
.
Qed
.
Lemma
rtc_bsteps
{
x
y
}
:
rtc
R
x
y
→
∃
n
,
bsteps
R
n
x
y
.
Proof
.
induction
1
.
exists
0
.
auto
with
t
rs
.
firstorder
eauto
with
t
rs
.
Qed
.
Proof
.
induction
1
;
simpl
;
eauto
using
bsteps_plus_l
with
a
rs
.
Qed
.
Lemma
bsteps_r
n
x
y
z
:
bsteps
R
n
x
y
→
R
y
z
→
bsteps
R
(
S
n
)
x
z
.
Proof
.
induction
1
;
eauto
with
a
rs
.
Qed
.
Lemma
bsteps_rtc
n
x
y
:
bsteps
R
n
x
y
→
rtc
R
x
y
.
Proof
.
induction
1
;
eauto
with
a
rs
.
Qed
.
Lemma
rtc_bsteps
x
y
:
rtc
R
x
y
→
∃
n
,
bsteps
R
n
x
y
.
Proof
.
induction
1
.
exists
0
.
auto
with
a
rs
.
firstorder
eauto
with
a
rs
.
Qed
.
Global
Instance
tc_trans
:
Transitive
(
tc
R
).
Proof
.
red
;
induction
1
;
eauto
with
t
rs
.
Qed
.
Lemma
tc_r
{
x
y
z
}
:
tc
R
x
y
→
R
y
z
→
tc
R
x
z
.
Proof
.
intros
.
etransitivity
;
eauto
with
t
rs
.
Qed
.
Lemma
tc_rtc
{
x
y
}
:
tc
R
x
y
→
rtc
R
x
y
.
Proof
.
induction
1
;
eauto
with
t
rs
.
Qed
.
Proof
.
red
;
induction
1
;
eauto
with
a
rs
.
Qed
.
Lemma
tc_r
x
y
z
:
tc
R
x
y
→
R
y
z
→
tc
R
x
z
.
Proof
.
intros
.
etransitivity
;
eauto
with
a
rs
.
Qed
.
Lemma
tc_rtc
x
y
:
tc
R
x
y
→
rtc
R
x
y
.
Proof
.
induction
1
;
eauto
with
a
rs
.
Qed
.
Global
Instance
:
subrelation
(
tc
R
)
(
rtc
R
).
Proof
.
exact
@
tc_rtc
.
Qed
.
Lemma
looping_red
x
:
looping
R
x
→
red
R
x
.
Proof
.
destruct
1
;
auto
.
Qed
.
Lemma
looping_step
x
y
:
looping
R
x
→
R
x
y
→
looping
R
y
.
Proof
.
destruct
1
;
auto
.
Qed
.
Lemma
looping_rtc
x
y
:
looping
R
x
→
rtc
R
x
y
→
looping
R
y
.
Proof
.
induction
2
;
eauto
using
looping_step
.
Qed
.
Lemma
looping_alt
x
:
looping
R
x
↔
∀
y
,
rtc
R
x
y
→
red
R
y
.
Proof
.
split
.
*
eauto
using
looping_red
,
looping_rtc
.
*
intros
H
.
cut
(
∀
z
,
rtc
R
x
z
→
looping
R
z
).
{
eauto
with
ars
.
}
cofix
FIX
.
constructor
;
eauto
using
rtc_r
with
ars
.
Qed
.
End
rtc
.
Hint
Resolve
rtc_once
rtc_r
tc_r
:
t
rs
.
Hint
Resolve
rtc_once
rtc_r
tc_r
:
a
rs
.
(** * Theorems on sub relations *)
Section
subrel
.
Context
{
A
}
(
R1
R2
:
relation
A
)
(
Hsub
:
subrelation
R1
R2
).
...
...
theories/base.v
View file @
e79e91f7
This diff is collapsed.
Click to expand it.
theories/collections.v
View file @
e79e91f7
Require
Export
base
orders
.
(* Copyright (c) 2012, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
(** This file collects definitions and theorems on collections. Most
importantly, it implements some tactics to automatically solve goals involving
collections. *)
Require
Export
base
tactics
orders
.
(** * Theorems *)
Section
collection
.
Context
`
{
Collection
A
B
}.
Lemma
elem_of_empty_iff
x
:
x
∈
∅
↔
False
.
Proof
.
split
.
apply
elem_of_empty
.
easy
.
Qed
.
Lemma
elem_of_empty
x
:
x
∈
∅
↔
False
.
Proof
.
split
.
apply
not_elem_of_empty
.
easy
.
Qed
.
Lemma
elem_of_union_l
x
X
Y
:
x
∈
X
→
x
∈
X
∪
Y
.
Proof
.
intros
.
apply
elem_of_union
.
auto
.
Qed
.
Lemma
elem_of_union_r
x
X
Y
:
x
∈
Y
→
x
∈
X
∪
Y
.
Proof
.
intros
.
apply
elem_of_union
.
auto
.
Qed
.
Lemma
not_elem_of_singleton
x
y
:
x
∉
{[
y
]}
↔
x
≠
y
.
Proof
.
now
rewrite
elem_of_singleton
.
Qed
.
Lemma
not_elem_of_union
x
X
Y
:
x
∉
X
∪
Y
↔
x
∉
X
∧
x
∉
Y
.
Proof
.
rewrite
elem_of_union
.
tauto
.
Qed
.
Global
Instance
collection_subseteq
:
SubsetEq
B
:
=
λ
X
Y
,
∀
x
,
x
∈
X
→
x
∈
Y
.
Global
Instance
collection_subseteq
:
SubsetEq
B
:
=
λ
X
Y
,
∀
x
,
x
∈
X
→
x
∈
Y
.
Global
Instance
:
BoundedJoinSemiLattice
B
.
Proof
.
firstorder
.
Qed
.
Global
Instance
:
MeetSemiLattice
B
.
...
...
@@ 25,17 +35,20 @@ Section collection.
X
≡
Y
↔
(
∀
x
,
x
∈
X
→
x
∈
Y
)
∧
(
∀
x
,
x
∈
Y
→
x
∈
X
).
Proof
.
firstorder
.
Qed
.
Global
Instance
:
Proper
((=)
==>
(
≡
)
==>
iff
)
(
∈
).
Global
Instance
singleton_proper
:
Proper
((=)
==>
(
≡
))
singleton
.
Proof
.
repeat
intro
.
now
subst
.
Qed
.
Global
Instance
elem_of_proper
:
Proper
((=)
==>
(
≡
)
==>
iff
)
(
∈
).
Proof
.
intros
???.
subst
.
firstorder
.
Qed
.
Lemma
empty_ne_singleton
x
:
∅
≢
{[
x
]}.
Lemma
empty_ne_singleton
x
:
∅
≢
{[
x
]}.
Proof
.
intros
[
_
E
].
destruct
(
elem_of_empty
x
).
intros
[
_
E
].
apply
(
elem_of_empty
x
).
apply
E
.
now
apply
elem_of_singleton
.
Qed
.
Qed
.
End
collection
.
Section
cmap
.
(** * Theorems about map *)
Section
map
.
Context
`
{
Collection
A
C
}.
Lemma
elem_of_map_1
(
f
:
A
→
A
)
(
X
:
C
)
(
x
:
A
)
:
...
...
@@ 47,19 +60,18 @@ Section cmap.
Lemma
elem_of_map_2
(
f
:
A
→
A
)
(
X
:
C
)
(
x
:
A
)
:
x
∈
map
f
X
→
∃
y
,
x
=
f
y
∧
y
∈
X
.
Proof
.
intros
.
now
apply
(
elem_of_map
_
).
Qed
.
End
cmap
.
Definition
fresh_sig
`
{
FreshSpec
A
C
}
(
X
:
C
)
:
{
x
:
A

x
∉
X
}
:
=
exist
(
∉
X
)
(
fresh
X
)
(
is_fresh
X
).
Lemma
elem_of_fresh_iff
`
{
FreshSpec
A
C
}
(
X
:
C
)
:
fresh
X
∈
X
↔
False
.
Proof
.
split
.
apply
is_fresh
.
easy
.
Qed
.
Ltac
split_elem_ofs
:
=
repeat
End
map
.
(** * Tactics *)
(** The first pass consists of eliminating all occurrences of [(∪)], [(∩)],
[(∖)], [map], [∅], [{[_]}], [(≡)], and [(⊆)], by rewriting these into
logically equivalent propositions. For example we rewrite [A → x ∈ X ∪ ∅] into
[A → x ∈ X ∨ False]. *)
Ltac
unfold_elem_of
:
=
repeat
match
goal
with

H
:
context
[
_
⊆
_
]

_
=>
setoid_rewrite
elem_of_subseteq
in
H

H
:
context
[
_
≡
_
]

_
=>
setoid_rewrite
elem_of_equiv_alt
in
H

H
:
context
[
_
∈
∅
]

_
=>
setoid_rewrite
elem_of_empty
_iff
in
H

H
:
context
[
_
∈
∅
]

_
=>
setoid_rewrite
elem_of_empty
in
H

H
:
context
[
_
∈
{[
_
]}
]

_
=>
setoid_rewrite
elem_of_singleton
in
H

H
:
context
[
_
∈
_
∪
_
]

_
=>
setoid_rewrite
elem_of_union
in
H

H
:
context
[
_
∈
_
∩
_
]

_
=>
setoid_rewrite
elem_of_intersection
in
H
...
...
@@ 67,7 +79,7 @@ Ltac split_elem_ofs := repeat

H
:
context
[
_
∈
map
_
_
]

_
=>
setoid_rewrite
elem_of_map
in
H


context
[
_
⊆
_
]
=>
setoid_rewrite
elem_of_subseteq


context
[
_
≡
_
]
=>
setoid_rewrite
elem_of_equiv_alt


context
[
_
∈
∅
]
=>
setoid_rewrite
elem_of_empty
_iff


context
[
_
∈
∅
]
=>
setoid_rewrite
elem_of_empty


context
[
_
∈
{[
_
]}
]
=>
setoid_rewrite
elem_of_singleton


context
[
_
∈
_
∪
_
]
=>
setoid_rewrite
elem_of_union


context
[
_
∈
_
∩
_
]
=>
setoid_rewrite
elem_of_intersection
...
...
@@ 75,56 +87,49 @@ Ltac split_elem_ofs := repeat


context
[
_
∈
map
_
_
]
=>
setoid_rewrite
elem_of_map
end
.
Ltac
destruct_elem_ofs
:
=
repeat
match
goal
with

H
:
context
[
@
elem_of
(
_
*
_
)
_
_
?x
_
]

_
=>
is_var
x
;
destruct
x

H
:
context
[
@
elem_of
(
_
+
_
)
_
_
?x
_
]

_
=>
is_var
x
;
destruct
x
end
.
Tactic
Notation
"simplify_elem_of"
tactic
(
t
)
:
=
intros
;
(* due to bug #2790 *)
(** The tactic [solve_elem_of tac] composes the above tactic with [intuition].
For goals that do not involve [≡], [⊆], [map], or quantifiers this tactic is
generally powerful enough. This tactic either fails or proves the goal. *)
Tactic
Notation
"solve_elem_of"
tactic
(
tac
)
:
=
simpl
in
*
;
split_elem_ofs
;
destruct_elem_ofs
;
intuition
(
simplify_eqs
;
t
).
Tactic
Notation
"simplify_elem_of"
:
=
simplify_elem_of
auto
.
Ltac
naive_firstorder
t
:
=
match
goal
with
(* intros *)


∀
_
,
_
=>
intro
;
naive_firstorder
t
(* destructs without information loss *)

H
:
False

_
=>
destruct
H

H
:
?X
,
Hneg
:
¬
?X

_
=>
now
destruct
Hneg

H
:
_
∧
_

_
=>
destruct
H
;
naive_firstorder
t

H
:
∃
_
,
_

_
=>
destruct
H
;
naive_firstorder
t
(* simplification *)


_
=>
progress
(
simplify_eqs
;
simpl
in
*)
;
naive_firstorder
t
(* constructs *)


_
∧
_
=>
split
;
naive_firstorder
t
(* solve *)


_
=>
solve
[
t
]
(* dirty destructs *)

H
:
context
[
∃
_
,
_
]

_
=>
edestruct
H
;
clear
H
;
naive_firstorder
t

clear
H
;
naive_firstorder
t

H
:
context
[
_
∧
_
]

_
=>
destruct
H
;
clear
H
;
naive_firstorder
t

clear
H
;
naive_firstorder
t

H
:
context
[
_
∨
_
]

_
=>
edestruct
H
;
clear
H
;
naive_firstorder
t

clear
H
;
naive_firstorder
t
(* dirty constructs *)


∃
x
,
_
=>
eexists
;
naive_firstorder
t


_
∨
_
=>
left
;
naive_firstorder
t

right
;
naive_firstorder
t

H
:
_
→
False

_
=>
destruct
H
;
naive_firstorder
t
end
.
Tactic
Notation
"naive_firstorder"
tactic
(
t
)
:
=
unfold
iff
,
not
in
*
;
naive_firstorder
t
.
Tactic
Notation
"esimplify_elem_of"
tactic
(
t
)
:
=
(
simplify_elem_of
t
)
;
try
naive_firstorder
t
.
Tactic
Notation
"esimplify_elem_of"
:
=
esimplify_elem_of
(
eauto
5
).
unfold_elem_of
;
solve
[
intuition
(
simplify_equality
;
tac
)].
Tactic
Notation
"solve_elem_of"
:
=
solve_elem_of
auto
.
(** For goals with quantifiers we could use the above tactic but with
[firstorder] instead of [intuition] as finishing tactic. However, [firstorder]
fails or loops on very small goals generated by [solve_elem_of] already. We
use the [naive_solver] tactic as a substitute. This tactic either fails or
proves the goal. *)
Tactic
Notation
"esolve_elem_of"
tactic
(
tac
)
:
=
simpl
in
*
;
unfold_elem_of
;
naive_solver
tac
.
Tactic
Notation
"esolve_elem_of"
:
=
esolve_elem_of
eauto
.
(** Given an assumption [H : _ ∈ _], the tactic [destruct_elem_of H] will
recursively split [H] for [(∪)], [(∩)], [(∖)], [map], [∅], [{[_]}]. *)
Tactic
Notation
"destruct_elem_of"
hyp
(
H
)
:
=
let
rec
go
H
:
=
lazymatch
type
of
H
with

_
∈
∅
=>
apply
elem_of_empty
in
H
;
destruct
H

_
∈
{[
?l'
]}
=>
apply
elem_of_singleton
in
H
;
subst
l'

_
∈
_
∪
_
=>
let
H1
:
=
fresh
in
let
H2
:
=
fresh
in
apply
elem_of_union
in
H
;
destruct
H
as
[
H1

H2
]
;
[
go
H1

go
H2
]

_
∈
_
∩
_
=>
let
H1
:
=
fresh
in
let
H2
:
=
fresh
in
apply
elem_of_intersection
in
H
;
destruct
H
as
[
H1
H2
]
;
go
H1
;
go
H2

_
∈
_
∖
_
=>
let
H1
:
=
fresh
in
let
H2
:
=
fresh
in
apply
elem_of_difference
in
H
;
destruct
H
as
[
H1
H2
]
;
go
H1
;
go
H2

_
∈
map
_
_
=>
let
H1
:
=
fresh
in
apply
elem_of_map
in
H
;
destruct
H
as
[?[?
H1
]]
;
go
H1

_
=>
idtac
end
in
go
H
.
(** * Sets without duplicates up to an equivalence *)
Section
no_dup
.
Context
`
{
Collection
A
B
}
(
R
:
relation
A
)
`
{!
Equivalence
R
}.
...
...
@@ 143,33 +148,34 @@ Section no_dup.
Proof
.
firstorder
.
Qed
.
Lemma
elem_of_upto_elem_of
x
X
:
x
∈
X
→
elem_of_upto
x
X
.
Proof
.
unfold
elem_of_upto
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
elem_of_upto
.
es
olve
_elem_of
.
Qed
.
Lemma
elem_of_upto_empty
x
:
¬
elem_of_upto
x
∅
.
Proof
.
unfold
elem_of_upto
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
elem_of_upto
.
es
olve
_elem_of
.
Qed
.
Lemma
elem_of_upto_singleton
x
y
:
elem_of_upto
x
{[
y
]}
↔
R
x
y
.
Proof
.
unfold
elem_of_upto
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
elem_of_upto
.
es
olve
_elem_of
.
Qed
.
Lemma
elem_of_upto_union
X
Y
x
:
elem_of_upto
x
(
X
∪
Y
)
↔
elem_of_upto
x
X
∨
elem_of_upto
x
Y
.
Proof
.
unfold
elem_of_upto
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
elem_of_upto
.
es
olve
_elem_of
.
Qed
.
Lemma
not_elem_of_upto
x
X
:
¬
elem_of_upto
x
X
→
∀
y
,
y
∈
X
→
¬
R
x
y
.
Proof
.
unfold
elem_of_upto
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
elem_of_upto
.
es
olve
_elem_of
.
Qed
.
Lemma
no_dup_empty
:
no_dup
∅
.
Proof
.
unfold
no_dup
.
s
implify
_elem_of
.
Qed
.
Proof
.
unfold
no_dup
.
s
olve
_elem_of
.
Qed
.
Lemma
no_dup_add
x
X
:
¬
elem_of_upto
x
X
→
no_dup
X
→
no_dup
({[
x
]}
∪
X
).
Proof
.
unfold
no_dup
,
elem_of_upto
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
no_dup
,
elem_of_upto
.
es
olve
_elem_of
.
Qed
.
Lemma
no_dup_inv_add
x
X
:
x
∉
X
→
no_dup
({[
x
]}
∪
X
)
→
¬
elem_of_upto
x
X
.
Proof
.
intros
Hin
Hnodup
[
y
[??]].
rewrite
(
Hnodup
x
y
)
in
Hin
;
s
implify
_elem_of
.
rewrite
(
Hnodup
x
y
)
in
Hin
;
s
olve
_elem_of
.
Qed
.
Lemma
no_dup_inv_union_l
X
Y
:
no_dup
(
X
∪
Y
)
→
no_dup
X
.
Proof
.
unfold
no_dup
.
s
implify
_elem_of
.
Qed
.
Proof
.
unfold
no_dup
.
s
olve
_elem_of
.
Qed
.
Lemma
no_dup_inv_union_r
X
Y
:
no_dup
(
X
∪
Y
)
→
no_dup
Y
.
Proof
.
unfold
no_dup
.
s
implify
_elem_of
.
Qed
.
Proof
.
unfold
no_dup
.
s
olve
_elem_of
.
Qed
.
End
no_dup
.
(** * Quantifiers *)
Section
quantifiers
.
Context
`
{
Collection
A
B
}
(
P
:
A
→
Prop
).
...
...
@@ 177,48 +183,65 @@ Section quantifiers.
Definition
cexists
X
:
=
∃
x
,
x
∈
X
∧
P
x
.
Lemma
cforall_empty
:
cforall
∅
.
Proof
.
unfold
cforall
.
s
implify
_elem_of
.
Qed
.
Proof
.
unfold
cforall
.
s
olve
_elem_of
.
Qed
.
Lemma
cforall_singleton
x
:
cforall
{[
x
]}
↔
P
x
.
Proof
.
unfold
cforall
.
s
implify
_elem_of
.
Qed
.
Proof
.
unfold
cforall
.
s
olve
_elem_of
.
Qed
.
Lemma
cforall_union
X
Y
:
cforall
X
→
cforall
Y
→
cforall
(
X
∪
Y
).
Proof
.
unfold
cforall
.
s
implify
_elem_of
.
Qed
.
Proof
.
unfold
cforall
.
s
olve
_elem_of
.
Qed
.
Lemma
cforall_union_inv_1
X
Y
:
cforall
(
X
∪
Y
)
→
cforall
X
.
Proof
.
unfold
cforall
.
s
implify
_elem_of
.
Qed
.
Proof
.
unfold
cforall
.
s
olve
_elem_of
.
Qed
.
Lemma
cforall_union_inv_2
X
Y
:
cforall
(
X
∪
Y
)
→
cforall
Y
.
Proof
.
unfold
cforall
.
s
implify
_elem_of
.
Qed
.
Proof
.
unfold
cforall
.
s
olve
_elem_of
.
Qed
.
Lemma
cexists_empty
:
¬
cexists
∅
.
Proof
.
unfold
cexists
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
cexists
.
es
olve
_elem_of
.
Qed
.
Lemma
cexists_singleton
x
:
cexists
{[
x
]}
↔
P
x
.
Proof
.
unfold
cexists
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
cexists
.
es
olve
_elem_of
.
Qed
.
Lemma
cexists_union_1
X
Y
:
cexists
X
→
cexists
(
X
∪
Y
).
Proof
.
unfold
cexists
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
cexists
.
es
olve
_elem_of
.
Qed
.
Lemma
cexists_union_2
X
Y
:
cexists
Y
→
cexists
(
X
∪
Y
).
Proof
.
unfold
cexists
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
cexists
.
es
olve
_elem_of
.
Qed
.
Lemma
cexists_union_inv
X
Y
:
cexists
(
X
∪
Y
)
→
cexists
X
∨
cexists
Y
.
Proof
.
unfold
cexists
.
es
implify
_elem_of
.
Qed
.
Proof
.
unfold
cexists
.
es
olve
_elem_of
.
Qed
.
End
quantifiers
.
Section
more_quantifiers
.
Context
`
{
Collection
A
B
}.