Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
S
stdpp
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
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
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
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
.
(* The reflexive 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 theorems 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
:
=

rtc_refl
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
trs
.
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
ars
.
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
(* Copyright (c) 2012, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
(** This file collects type class interfaces, notations, and general theorems
that are used throughout the whole development. Most importantly it contains
abstract interfaces for ordered structures, collections, and various other data
structures. *)
Global
Generalizable
All
Variables
.
Global
Set
Automatic
Coercions
Import
.
Require
Export
Morphisms
RelationClasses
List
Bool
Utf8
Program
Setoid
NArith
.
(** * General *)
(** The following coercion allows us to use Booleans as propositions. *)
Coercion
Is_true
:
bool
>>
Sortclass
.
(** Ensure that [simpl] unfolds [id] and [compose] when fully applied. *)
Arguments
id
_
_
/.
Arguments
compose
_
_
_
_
_
_
/.
(* Change True and False into notations so we can overload them *)
(** Change [True] and [False] into notations in order to enable overloading.
We will use this in the file [assertions] to give [True] and [False] a
different interpretation in [assert_scope] used for assertions of our axiomatic
semantics. *)
Notation
"'True'"
:
=
True
:
type_scope
.
Notation
"'False'"
:
=
False
:
type_scope
.
Arguments
existT
{
_
_
}
_
_
.
(* Common notations *)
(** Throughout this development we use [C_scope] for all general purpose
notations that do not belong to a more specific scope. *)
Delimit
Scope
C_scope
with
C
.
Global
Open
Scope
C_scope
.
(** Introduce some Haskell style like notations. *)
Notation
"(=)"
:
=
eq
(
only
parsing
)
:
C_scope
.
Notation
"( x =)"
:
=
(
eq
x
)
(
only
parsing
)
:
C_scope
.
Notation
"(= x )"
:
=
(
λ
y
,
eq
y
x
)
(
only
parsing
)
:
C_scope
.
...
...
@@ 33,17 +47,39 @@ Infix "∘" := compose : C_scope.
Notation
"(∘)"
:
=
compose
(
only
parsing
)
:
C_scope
.
Notation
"( f ∘)"
:
=
(
compose
f
)
(
only
parsing
)
:
C_scope
.
Notation
"(∘ f )"
:
=
(
λ
g
,
compose
g
f
)
(
only
parsing
)
:
C_scope
.
(** Set convenient implicit arguments for [existT] and introduce notations. *)
Arguments
existT
{
_
_
}
_
_
.
Notation
"x ↾ p"
:
=
(
exist
_
x
p
)
(
at
level
20
)
:
C_scope
.
Notation
"` x"
:
=
(
proj1_sig
x
)
:
C_scope
.
(* Provable propositions *)
(** * Type classes *)
(** ** Provable propositions *)
(** This type class collects provable propositions. It is useful to constraint
type classes by arbitrary propositions. *)
Class
PropHolds
(
P
:
Prop
)
:
=
prop_holds
:
P
.
(* Decidable propositions *)
Hint
Extern
0
(
PropHolds
_
)
=>
assumption
:
typeclass_instances
.
Instance
:
Proper
(
iff
==>
iff
)
PropHolds
.
Proof
.
now
repeat
intro
.
Qed
.
Ltac
solve_propholds
:
=
match
goal
with

[

PropHolds
(
?P
)
]
=>
apply
_

[

?P
]
=>
change
(
PropHolds
P
)
;
apply
_
end
.
(** ** Decidable propositions *)
(** This type class by (Spitters/van der Weegen, 2011) collects decidable
propositions. For example to declare a parameter expressing decidable equality
on a type [A] we write [`{∀ x y : A, Decision (x = y)}] and use it by writing
[decide (x = y)]. *)
Class
Decision
(
P
:
Prop
)
:
=
decide
:
{
P
}
+
{
¬
P
}.
Arguments
decide
_
{
_
}.
(* Common relations & operations *)
(** ** Setoid equality *)
(** We define an operational type class for setoid equality. This is based on
(Spitters/van der Weegen, 2011). *)
Class
Equiv
A
:
=
equiv
:
relation
A
.
Infix
"≡"
:
=
equiv
(
at
level
70
,
no
associativity
)
:
C_scope
.
Notation
"(≡)"
:
=
equiv
(
only
parsing
)
:
C_scope
.
...
...
@@ 54,31 +90,54 @@ Notation "x ≢ y":= (¬x ≡ y) (at level 70, no associativity) : C_scope.
Notation
"( x ≢)"
:
=
(
λ
y
,
x
≢
y
)
(
only
parsing
)
:
C_scope
.
Notation
"(≢ x )"
:
=
(
λ
y
,
y
≢
x
)
(
only
parsing
)
:
C_scope
.
(** A [Params f n] instance forces the setoid rewriting mechanism not to
rewrite in the first [n] arguments of the function [f]. We will declare such
instances for all operational type classes in this development. *)
Instance
:
Params
(@
equiv
)
2
.
(** The following instance forces [setoid_replace] to use setoid equality
(for types that have an [Equiv] instance) rather than the standard Leibniz
equality. *)
Instance
equiv_default_relation
`
{
Equiv
A
}
:
DefaultRelation
(
≡
)

3
.
Hint
Extern
0
(
?x
≡
?x
)
=>
reflexivity
.
(** ** Operations on collections *)
(** We define operational type classes for the standard operations and
relations on collections: the empty collection [∅], the union [(∪)],
intersection [(∩)], difference [(∖)], and the singleton [{[_]}]
operation, and the subset [(⊆)] and element of [(∈)] relation. *)
Class
Empty
A
:
=
empty
:
A
.
Notation
"∅"
:
=
empty
:
C_scope
.
Class
Union
A
:
=
union
:
A
→
A
→
A
.
Instance
:
Params
(@
union
)
2
.
Infix
"∪"
:
=
union
(
at
level
50
,
left
associativity
)
:
C_scope
.
Notation
"(∪)"
:
=
union
(
only
parsing
)
:
C_scope
.
Notation
"( x ∪)"
:
=
(
union
x
)
(
only
parsing
)
:
C_scope
.
Notation
"(∪ x )"
:
=
(
λ
y
,
union
y
x
)
(
only
parsing
)
:
C_scope
.
Class
Intersection
A
:
=
intersection
:
A
→
A
→
A
.
Instance
:
Params
(@
intersection
)
2
.
Infix
"∩"
:
=
intersection
(
at
level
40
)
:
C_scope
.
Notation
"(∩)"
:
=
intersection
(
only
parsing
)
:
C_scope
.
Notation
"( x ∩)"
:
=
(
intersection
x
)
(
only
parsing
)
:
C_scope
.
Notation
"(∩ x )"
:
=
(
λ
y
,
intersection
y
x
)
(
only
parsing
)
:
C_scope
.
Class
Difference
A
:
=
difference
:
A
→
A
→
A
.
Instance
:
Params
(@
difference
)
2
.
Infix
"∖"
:
=
difference
(
at
level
40
)
:
C_scope
.
Notation
"(∖)"
:
=
difference
(
only
parsing
)
:
C_scope
.
Notation
"( x ∖)"
:
=
(
difference
x
)
(
only
parsing
)
:
C_scope
.
Notation
"(∖ x )"
:
=
(
λ
y
,
difference
y
x
)
(
only
parsing
)
:
C_scope
.
Class
Singleton
A
B
:
=
singleton
:
A
→
B
.
Instance
:
Params
(@
singleton
)
3
.
Notation
"{[ x ]}"
:
=
(
singleton
x
)
:
C_scope
.
Notation
"{[ x ; y ; .. ; z ]}"
:
=
(
union
..
(
union
(
singleton
x
)
(
singleton
y
))
..
(
singleton
z
))
:
C_scope
.
Class
SubsetEq
A
:
=
subseteq
:
A
→
A
→
Prop
.
Instance
:
Params
(@
subseteq
)
2
.
Infix
"⊆"
:
=
subseteq
(
at
level
70
)
:
C_scope
.
Notation
"(⊆)"
:
=
subseteq
(
only
parsing
)
:
C_scope
.
Notation
"( X ⊆ )"
:
=
(
subseteq
X
)
(
only
parsing
)
:
C_scope
.
...
...
@@ 90,12 +149,8 @@ Notation "( ⊈ X )" := (λ Y, Y ⊈ X) (only parsing) : C_scope.
Hint
Extern
0
(
?x
⊆
?x
)
=>
reflexivity
.
Class
Singleton
A
B
:
=
singleton
:
A
→
B
.
Notation
"{[ x ]}"
:
=
(
singleton
x
)
:
C_scope
.
Notation
"{[ x ; y ; .. ; z ]}"
:
=
(
union
..
(
union
(
singleton
x
)
(
singleton
y
))
..
(
singleton
z
))
:
C_scope
.
Class
ElemOf
A
B
:
=
elem_of
:
A
→
B
→
Prop
.
Instance
:
Params
(@
elem_of
)
3
.
Infix
"∈"
:
=
elem_of
(
at
level
70
)
:
C_scope
.
Notation
"(∈)"
:
=
elem_of
(
only
parsing
)
:
C_scope
.
Notation
"( x ∈)"
:
=
(
elem_of
x
)
(
only
parsing
)
:
C_scope
.
...
...
@@ 105,14 +160,87 @@ Notation "(∉)" := (λ x X, x ∉ X) (only parsing) : C_scope.
Notation
"( x ∉)"
:
=
(
λ
X
,
x
∉
X
)
(
only
parsing
)
:
C_scope
.
Notation
"(∉ X )"
:
=
(
λ
x
,
x
∉
X
)
(
only
parsing
)
:
C_scope
.
(** ** Operations on maps *)
(** In this file we will only define operational type classes for the
operations on maps. In the file [fin_maps] we will axiomatize finite maps.
The function lookup [m !! k] should yield the element at key [k] in [m]. *)
Class
Lookup
K
M
:
=
lookup
:
∀
{
A
},
K
→
M
A
→
option
A
.
Instance
:
Params
(@
lookup
)
4
.
Notation
"m !! i"
:
=
(
lookup
i
m
)
(
at
level
20
)
:
C_scope
.
Notation
"(!!)"
:
=
lookup
(
only
parsing
)
:
C_scope
.
Notation
"( m !!)"
:
=
(
λ
i
,
lookup
i
m
)
(
only
parsing
)
:
C_scope
.
Notation
"(!! i )"
:
=
(
lookup
i
)
(
only
parsing
)
:
C_scope
.
(** The function insert [<[k:=a]>m] should update the element at key [k] with
value [a] in [m]. *)
Class
Insert
K
M
:
=
insert
:
∀
{
A
},
K
→
A
→
M
A
→
M
A
.
Instance
:
Params
(@
insert
)
4
.
Notation
"<[ k := a ]>"
:
=
(
insert
k
a
)
(
at
level
5
,
right
associativity
,
format
"<[ k := a ]>"
)
:
C_scope
.
(** The function delete [delete k m] should deletes the value at key [k] in
[m]. *)
Class
Delete
K
M
:
=
delete
:
K
→
M
→
M
.
Instance
:
Params
(@
delete
)
3
.
(** The function [alter f k m] should update the value at key [k] using the
function [f], which is called with the original value at key [k]. When [k] is
not a member of [m], the original map should be returned. *)
Class
Alter
K
M
:
=
alter
:
∀
{
A
},
(
A
→
A
)
→
K
→
M
A
→
M
A
.
Instance
:
Params
(@
alter
)
4
.
(** The function [alter f k m] should update the value at key [k] using the
function [f], which is called with the original value at key [k] or [None] if
[k] is not a member of [m]. The value at [k] should be deleted if [f] yields
[None]. *)
Class
PartialAlter
K
M
:
=
partial_alter
:
∀
{
A
},
(
option
A
→
option
A
)
→
K
→
M
A
→
M
A
.
Instance
:
Params
(@
partial_alter
)
4
.
(** The function [dom C m] should yield the domain of [m]. That is a finite
collection of type [C] that contains the keys that are a member of [m]. *)
Class
Dom
K
M
:
=
dom
:
∀
C
`
{
Empty
C
}
`
{
Union
C
}
`
{
Singleton
K
C
},
M
→
C
.
Instance
:
Params
(@
dom
)
7
.
(** The function [merge f m1 m2] should merge the maps [m1] and [m2] by
constructing a new map whose value at key [k] is [f (m1 !! k) (m2 !! k)]
provided that [k] is a member of either [m1] or [m2].*)
Class
Merge
M
:
=
merge
:
∀
{
A
},
(
option
A
→
option
A
→
option
A
)
→
M
A
→
M
A
→
M
A
.
Instance
:
Params
(@
merge
)
3
.
(** We lift the insert and delete operation to lists of elements. *)
Definition
insert_list
`
{
Insert
K
M
}
{
A
}
(
l
:
list
(
K
*
A
))
(
m
:
M
A
)
:
M
A
:
=
fold_right
(
λ
p
,
<[
fst
p
:
=
snd
p
]>)
m
l
.
Instance
:
Params
(@
insert_list
)
4
.
Definition
delete_list
`
{
Delete
K
M
}
(
l
:
list
K
)
(
m
:
M
)
:
M
:
=
fold_right
delete
m
l
.
Instance
:
Params
(@
delete_list
)
3
.
(** The function [union_with f m1 m2] should yield the union of [m1] and [m2]
using the function [f] to combine values of members that are in both [m1] and
[m2]. *)
Class
UnionWith
M
:
=
union_with
:
∀
{
A
},
(
A
→
A
→
A
)
→
M
A
→
M
A
→
M
A
.
Instance
:
Params
(@
union_with
)
3
.
(** Similarly for the intersection and difference. *)
Class
IntersectionWith
M
:
=
intersection_with
:
∀
{
A
},
(
A
→
A
→
A
)
→
M
A
→
M
A
→
M
A
.
Instance
:
Params
(@
intersection_with
)
3
.
Class
DifferenceWith
M
:
=
difference_with
:
∀
{
A
},
(
A
→
A
→
option
A
)
→
M
A
→
M
A
→
M
A
.
Instance
:
Params
(@
difference_with
)
3
.
(* Common properties *)
(** ** Common properties *)
(** These operational type classes allow us to refer to common mathematical
properties in a generic way. For example, for injectivity of [(k ++)] it
allows us to write [injective (k ++)] instead of [app_inv_head k]. *)
Class
Injective
{
A
B
}
R
S
(
f
:
A
→
B
)
:
=
injective
:
∀
x
y
:
A
,
S
(
f
x
)
(
f
y
)
→
R
x
y
.
Class
Idempotent
{
A
}
R
(
f
:
A
→
A
→
A
)
:
=
...
...
@@ 133,7 +261,9 @@ Arguments left_id {_ _} _ _ {_} _.
Arguments
right_id
{
_
_
}
_
_
{
_
}
_
.
Arguments
associative
{
_
_
}
_
{
_
}
_
_
_
.
(* Using idempotent_eq we can force Coq to not use the setoid mechanism *)
(** The following lemmas are more specific versions of the projections of the
above type classes. These lemmas allow us to enforce Coq not to use the setoid
rewriting mechanism. *)
Lemma
idempotent_eq
{
A
}
(
f
:
A
→
A
→
A
)
`
{!
Idempotent
(=)
f
}
x
:
f
x
x
=
x
.
Proof
.
auto
.
Qed
.
...
...
@@ 150,7 +280,10 @@ Lemma associative_eq {A} (f : A → A → A) `{!Associative (=) f} x y z :
f
x
(
f
y
z
)
=
f
(
f
x
y
)
z
.
Proof
.
auto
.
Qed
.
(* Monadic operations *)
(** ** Monadic operations *)
(** We do use the operation type classes for monads merely for convenient
overloading of notations and do not formalize any theory on monads (we do not
define a class with the monad laws). *)
Section
monad_ops
.
Context
(
M
:
Type
→
Type
).
...
...
@@ 160,9 +293,13 @@ Section monad_ops.
Class
FMap
:
=
fmap
:
∀
{
A
B
},
(
A
→
B
)
→
M
A
→
M
B
.
End
monad_ops
.
Instance
:
Params
(@
mret
)
3
.
Arguments
mret
{
M
MRet
A
}
_
.
Instance
:
Params
(@
mbind
)
4
.
Arguments
mbind
{
M
MBind
A
B
}
_
_
.
Instance
:
Params
(@
mjoin
)
3
.
Arguments
mjoin
{
M
MJoin
A
}
_
.
Instance
:
Params
(@
fmap
)
4
.
Arguments
fmap
{
M
FMap
A
B
}
_
_
.
Notation
"m ≫= f"
:
=
(
mbind
f
m
)
(
at
level
60
,
right
associativity
)
:
C_scope
.
...
...
@@ 170,14 +307,17 @@ Notation "x ← y ; z" := (y ≫= (λ x : _, z))
(
at
level
65
,
next
at
level
35
,
right
associativity
)
:
C_scope
.
Infix
"<$>"
:
=
fmap
(
at
level
65
,
right
associativity
,
only
parsing
)
:
C_scope
.
(* Ordered structures *)
(** ** Axiomatization of ordered structures *)
(** A preorder equiped with a smallest element. *)
Class
BoundedPreOrder
A
`
{
Empty
A
}
`
{
SubsetEq
A
}
:
=
{
bounded_preorder
:
>>
PreOrder
(
⊆
)
;
subseteq_empty
x
:
∅
⊆
x
}.
(* Note: no equality to avoid the need for setoids. We define setoid
equality in a generic way. *)
(** We do not include equality in the following interfaces so as to avoid the
need for proofs that the relations and operations respect setoid equality.
Instead, we will define setoid equality in a generic way as
[λ X Y, X ⊆ Y ∧ Y ⊆ X]. *)
Class
BoundedJoinSemiLattice
A
`
{
Empty
A
}
`
{
SubsetEq
A
}
`
{
Union
A
}
:
=
{
jsl_preorder
:
>>
BoundedPreOrder
A
;
subseteq_union_l
x
y
:
x
⊆
x
∪
y
;
...
...
@@ 191,13 +331,15 @@ Class MeetSemiLattice A `{Empty A} `{SubsetEq A} `{Intersection A} := {
intersection_greatest
x
y
z
:
z
⊆
x
→
z
⊆
y
→
z
⊆
x
∩
y
}.
(* Containers *)
Class
Size
C
:
=
size
:
C
→
nat
.
(** ** Axiomatization of collections *)
(** The class [Collection A C] axiomatizes a collection of type [C] with
elements of type [A]. Since [C] is not dependent on [A], we use the monomorphic
[Map] type class instead of the polymorphic [FMap]. *)
Class
Map
A
C
:
=
map
:
(
A
→
A
)
→
(
C
→
C
).
Class
Collection
A
C
`
{
ElemOf
A
C
}
`
{
Empty
C
}
`
{
Union
C
}
Instance
:
Params
(@
map
)
3
.
Class
Collection
A
C
`
{
ElemOf
A
C
}
`
{
Empty
C
}
`
{
Union
C
}
`
{
Intersection
C
}
`
{
Difference
C
}
`
{
Singleton
A
C
}
`
{
Map
A
C
}
:
=
{
elem_of_empty
(
x
:
A
)
:
x
∉
∅
;
not_
elem_of_empty
(
x
:
A
)
:
x
∉
∅
;
elem_of_singleton
(
x
y
:
A
)
:
x
∈
{[
y
]}
↔
x
=
y
;
elem_of_union
X
Y
(
x
:
A
)
:
x
∈
X
∪
Y
↔
x
∈
X
∨
x
∈
Y
;
elem_of_intersection
X
Y
(
x
:
A
)
:
x
∈
X
∩
Y
↔
x
∈
X
∧
x
∈
Y
;
...
...
@@ 205,52 +347,42 @@ Class Collection A C `{ElemOf A C} `{Empty C} `{Union C}
elem_of_map
f
X
(
x
:
A
)
:
x
∈
map
f
X
↔
∃
y
,
x
=
f
y
∧
y
∈
X
}.
(** We axiomative a finite collection as a collection whose elements can be
enumerated as a list. These elements, given by the [elements] function, may be
in any order and should not contain duplicates. *)
Class
Elements
A
C
:
=
elements
:
C
→
list
A
.
Class
FinCollection
A
C
`
{
Empty
C
}
`
{
Union
C
}
`
{
Intersection
C
}
`
{
Difference
C
}
Instance
:
Params
(@
elements
)
3
.
Class
FinCollection
A
C
`
{
Empty
C
}
`
{
Union
C
}
`
{
Intersection
C
}
`
{
Difference
C
}
`
{
Singleton
A
C
}
`
{
ElemOf
A
C
}
`
{
Map
A
C
}
`
{
Elements
A
C
}
:
=
{
fin_collection
:
>>
Collection
A
C
;
elements_spec
X
x
:
x
∈
X
↔
In
x
(
elements
X
)
;
elements_nodup
X
:
NoDup
(
elements
X
)
}.
}.
Class
Size
C
:
=
size
:
C
→
nat
.
Instance
:
Params
(@
size
)
2
.
(** The function [fresh X] yields an element that is not contained in [X]. We
will later prove that [fresh] is [Proper] with respect to the induced setoid
equality on collections. *)
Class
Fresh
A
C
:
=
fresh
:
C
→
A
.
Instance
:
Params
(@
fresh
)
3
.
Class
FreshSpec
A
C
`
{!
Fresh
A
C
}
`
{!
ElemOf
A
C
}
:
=
{
fresh_proper
X
Y
:
(
∀
x
,
x
∈
X
↔
x
∈
Y
)
→
fresh
X
=
fresh
Y
;
fresh_proper
_alt
X
Y
:
(
∀
x
,
x
∈
X
↔
x
∈
Y
)
→
fresh
X
=
fresh
Y
;
is_fresh
(
X
:
C
)
:
fresh
X
∉
X
}.
(* Maps *)
Class
Lookup
K
M
:
=
lookup
:
∀
{
A
},
K
→
M
A
→
option
A
.
Notation
"m !! i"
:
=
(
lookup
i
m
)
(
at
level
20
)
:
C_scope
.
Notation
"(!!)"
:
=
lookup
(
only
parsing
)
:
C_scope
.
Notation
"( m !!)"
:
=
(
λ
i
,
lookup
i
m
)
(
only
parsing
)
:
C_scope
.
Notation
"(!! i )"
:
=
(
lookup
i
)
(
only
parsing
)
:
C_scope
.
(** * Miscellaneous *)
Lemma
proj1_sig_inj
{
A
}
(
P
:
A
→
Prop
)
x
(
Px
:
P
x
)
y
(
Py
:
P
y
)
:
x
↾
Px
=
y
↾
Py
→
x
=
y
.
Proof
.
now
injection
1
.
Qed
.
Class
PartialAlter
K
M
:
=
partial_alter
:
∀
{
A
},
(
option
A
→
option
A
)
→
K
→
M
A
→
M
A
.
Class
Alter
K
M
:
=
alter
:
∀
{
A
},
(
A
→
A
)
→
K
→
M
A
→
M
A
.
Class
Dom
K
M
:
=
dom
:
∀
C
`
{
Empty
C
}
`
{
Union
C
}
`
{
Singleton
K
C
},
M
→
C
.
Class
Merge
M
:
=
merge
:
∀
{
A
},
(
option
A
→
option
A
→
option
A
)
→
M
A
→
M
A
→
M
A
.
Class
Insert
K
M
:
=
insert
:
∀
{
A
},
K
→
A
→
M
A
→
M
A
.
Notation
"<[ k := a ]>"
:
=
(
insert
k
a
)