Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Contribute to GitLab
Sign in
Toggle navigation
C
cpdt
Project
Project
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
research
cpdt
Commits
b87eea7b
Commit
b87eea7b
authored
Nov 11, 2009
by
Adam Chlipala
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Port DataStruct
parent
971c8851
Changes
4
Show whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
116 additions
and
111 deletions
+116
-111
Makefile
Makefile
+2
-4
DataStruct.v
src/DataStruct.v
+109
-102
DepList.v
src/DepList.v
+4
-4
Generic.v
src/Generic.v
+1
-1
No files found.
Makefile
View file @
b87eea7b
...
@@ -7,7 +7,6 @@ MODULES_DOC := $(MODULES_PROSE) $(MODULES_CODE)
...
@@ -7,7 +7,6 @@ MODULES_DOC := $(MODULES_PROSE) $(MODULES_CODE)
MODULES
:=
$(MODULES_NODOC)
$(MODULES_DOC)
MODULES
:=
$(MODULES_NODOC)
$(MODULES_DOC)
VS
:=
$
(
MODULES:%
=
src/%.v
)
VS
:=
$
(
MODULES:%
=
src/%.v
)
VS_DOC
:=
$
(
MODULES_DOC:%
=
%.v
)
VS_DOC
:=
$
(
MODULES_DOC:%
=
%.v
)
GLOBALS
:=
.coq_globals
TEMPLATES
:=
$
(
MODULES_CODE:%
=
templates/%.v
)
TEMPLATES
:=
$
(
MODULES_CODE:%
=
templates/%.v
)
.PHONY
:
coq clean doc dvi html templates install cpdt.tgz
.PHONY
:
coq clean doc dvi html templates install cpdt.tgz
...
@@ -17,13 +16,13 @@ coq: Makefile.coq
...
@@ -17,13 +16,13 @@ coq: Makefile.coq
Makefile.coq
:
Makefile $(VS)
Makefile.coq
:
Makefile $(VS)
coq_makefile
$(VS)
\
coq_makefile
$(VS)
\
COQC
=
"coqc -I src
-dump-glob
$(GLOBALS)
"
\
COQC
=
"coqc -I src"
\
COQDEP
=
"coqdep -I src"
\
COQDEP
=
"coqdep -I src"
\
-o
Makefile.coq
-o
Makefile.coq
clean
::
Makefile.coq
clean
::
Makefile.coq
make
-f
Makefile.coq clean
make
-f
Makefile.coq clean
rm
-f
Makefile.coq .depend
$(GLOBALS)
cpdt.tgz
\
rm
-f
Makefile.coq .depend cpdt.tgz
\
latex/
*
.sty latex/cpdt.
*
templates/
*
.v
latex/
*
.sty latex/cpdt.
*
templates/
*
.v
rm
-f
*
.aux
*
.dvi
*
.log
rm
-f
*
.aux
*
.dvi
*
.log
...
@@ -51,7 +50,6 @@ latex/%.pdf: latex/%.dvi
...
@@ -51,7 +50,6 @@ latex/%.pdf: latex/%.dvi
html
:
Makefile $(VS) src/toc.html
html
:
Makefile $(VS) src/toc.html
mkdir
-p
html
mkdir
-p
html
cd
src
;
coqdoc
--interpolate
$(VS_DOC)
\
cd
src
;
coqdoc
--interpolate
$(VS_DOC)
\
--glob-from
../
$(GLOBALS)
\
-d
../html
-d
../html
cp
src/toc.html html/
cp
src/toc.html html/
...
...
src/DataStruct.v
View file @
b87eea7b
(
*
Copyright
(
c
)
2008
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
2009
,
Adam
Chlipala
*
*
*
This
work
is
licensed
under
a
*
This
work
is
licensed
under
a
*
Creative
Commons
Attribution
-
Noncommercial
-
No
Derivative
Works
3.0
*
Creative
Commons
Attribution
-
Noncommercial
-
No
Derivative
Works
3.0
...
@@ -32,22 +32,22 @@ Section ilist.
...
@@ -32,22 +32,22 @@ Section ilist.
|
Nil
:
ilist
O
|
Nil
:
ilist
O
|
Cons
:
forall
n
,
A
->
ilist
n
->
ilist
(
S
n
)
.
|
Cons
:
forall
n
,
A
->
ilist
n
->
ilist
(
S
n
)
.
(
**
We
might
like
to
have
a
certified
function
for
selecting
an
element
of
an
[
ilist
]
by
position
.
We
could
do
this
using
subset
types
and
explicit
manipulation
of
proofs
,
but
dependent
types
let
us
do
it
more
directly
.
It
is
helpful
to
define
a
type
family
[
index
]
,
where
[
index
n
]
is
isomorphic
to
[
{
m
:
nat
|
m
<
n
}
]
.
Such
a
type
family
is
also
often
called
[
Fin
]
or
similar
,
standing
for
"finite."
*
)
(
**
We
might
like
to
have
a
certified
function
for
selecting
an
element
of
an
[
ilist
]
by
position
.
We
could
do
this
using
subset
types
and
explicit
manipulation
of
proofs
,
but
dependent
types
let
us
do
it
more
directly
.
It
is
helpful
to
define
a
type
family
[
fin
]
,
where
[
fin
n
]
is
isomorphic
to
[
{
m
:
nat
|
m
<
n
}
]
.
The
type
family
names
stands
for
"finite."
*
)
(
*
EX
:
Define
a
function
[
get
]
for
extracting
an
[
ilist
]
element
by
position
.
*
)
(
*
EX
:
Define
a
function
[
get
]
for
extracting
an
[
ilist
]
element
by
position
.
*
)
(
*
begin
thide
*
)
(
*
begin
thide
*
)
Inductive
index
:
nat
->
Set
:=
Inductive
fin
:
nat
->
Set
:=
|
First
:
forall
n
,
index
(
S
n
)
|
First
:
forall
n
,
fin
(
S
n
)
|
Next
:
forall
n
,
index
n
->
index
(
S
n
)
.
|
Next
:
forall
n
,
fin
n
->
fin
(
S
n
)
.
(
**
[
index
]
essentially
makes
a
more
richly
-
typed
copy
of
the
natural
numbers
.
Every
element
is
a
[
First
]
iterated
through
applying
[
Next
]
a
number
of
times
that
indicates
which
number
is
being
selected
.
(
**
[
fin
]
essentially
makes
a
more
richly
-
typed
copy
of
the
natural
numbers
.
Every
element
is
a
[
First
]
iterated
through
applying
[
Next
]
a
number
of
times
that
indicates
which
number
is
being
selected
.
Now
it
is
easy
to
pick
a
[
Prop
]
-
free
type
for
a
selection
function
.
As
usual
,
our
first
implementation
attempt
will
not
convince
the
type
checker
,
and
we
will
attack
the
deficiencies
one
at
a
time
.
Now
it
is
easy
to
pick
a
[
Prop
]
-
free
type
for
a
selection
function
.
As
usual
,
our
first
implementation
attempt
will
not
convince
the
type
checker
,
and
we
will
attack
the
deficiencies
one
at
a
time
.
[[
[[
Fixpoint
get
n
(
ls
:
ilist
n
)
{
struct
ls
}
:
index
n
->
A
:=
Fixpoint
get
n
(
ls
:
ilist
n
)
:
fin
n
->
A
:=
match
ls
in
ilist
n
return
index
n
->
A
with
match
ls
with
|
Nil
=>
fun
idx
=>
?
|
Nil
=>
fun
idx
=>
?
|
Cons
_
x
ls
'
=>
fun
idx
=>
|
Cons
_
x
ls
'
=>
fun
idx
=>
match
idx
with
match
idx
with
...
@@ -58,13 +58,13 @@ Section ilist.
...
@@ -58,13 +58,13 @@ Section ilist.
]]
]]
We
apply
the
usual
wisdom
of
delaying
arguments
in
[
Fixpoint
]
s
so
that
they
may
be
included
in
[
return
]
clauses
.
This
still
leaves
us
with
a
quandary
in
each
of
the
[
match
]
cases
.
First
,
we
need
to
figure
out
how
to
take
advantage
of
the
contradiction
in
the
[
Nil
]
case
.
Every
[
index
]
has
a
type
of
the
form
[
S
n
]
,
which
cannot
unify
with
the
[
O
]
value
that
we
learn
for
[
n
]
in
the
[
Nil
]
case
.
The
solution
we
adopt
is
another
case
of
[
match
]
-
within
-
[
return
]
.
We
apply
the
usual
wisdom
of
delaying
arguments
in
[
Fixpoint
]
s
so
that
they
may
be
included
in
[
return
]
clauses
.
This
still
leaves
us
with
a
quandary
in
each
of
the
[
match
]
cases
.
First
,
we
need
to
figure
out
how
to
take
advantage
of
the
contradiction
in
the
[
Nil
]
case
.
Every
[
fin
]
has
a
type
of
the
form
[
S
n
]
,
which
cannot
unify
with
the
[
O
]
value
that
we
learn
for
[
n
]
in
the
[
Nil
]
case
.
The
solution
we
adopt
is
another
case
of
[
match
]
-
within
-
[
return
]
.
[[
[[
Fixpoint
get
n
(
ls
:
ilist
n
)
{
struct
ls
}
:
index
n
->
A
:=
Fixpoint
get
n
(
ls
:
ilist
n
)
:
fin
n
->
A
:=
match
ls
in
ilist
n
return
index
n
->
A
with
match
ls
with
|
Nil
=>
fun
idx
=>
|
Nil
=>
fun
idx
=>
match
idx
in
index
n
'
return
(
match
n
'
with
match
idx
in
fin
n
'
return
(
match
n
'
with
|
O
=>
A
|
O
=>
A
|
S
_
=>
unit
|
S
_
=>
unit
end
)
with
end
)
with
...
@@ -80,13 +80,13 @@ Section ilist.
...
@@ -80,13 +80,13 @@ Section ilist.
]]
]]
Now
the
first
[
match
]
case
type
-
checks
,
and
we
see
that
the
problem
with
the
[
Cons
]
case
is
that
the
pattern
-
bound
variable
[
idx
'
]
does
not
have
an
apparent
type
compatible
with
[
ls
'
]
.
We
need
to
use
[
match
]
annotations
to
make
the
relationship
explicit
.
Unfortunately
,
the
usual
trick
of
postponing
argument
binding
will
not
help
us
here
.
We
need
to
match
on
both
[
ls
]
and
[
idx
]
;
one
or
the
other
must
be
matched
first
.
To
get
around
this
,
we
apply
a
trick
that
we
will
call
"the convoy pattern,"
introducing
a
new
function
and
applying
it
immediately
,
to
satisfy
the
type
checker
.
Now
the
first
[
match
]
case
type
-
checks
,
and
we
see
that
the
problem
with
the
[
Cons
]
case
is
that
the
pattern
-
bound
variable
[
idx
'
]
does
not
have
an
apparent
type
compatible
with
[
ls
'
]
.
We
need
to
use
[
match
]
annotations
to
make
the
relationship
explicit
.
Unfortunately
,
the
usual
trick
of
postponing
argument
binding
will
not
help
us
here
.
We
need
to
match
on
both
[
ls
]
and
[
idx
]
;
one
or
the
other
must
be
matched
first
.
To
get
around
this
,
we
apply
the
convoy
pattern
that
we
met
last
chapter
.
This
application
is
a
little
more
clever
than
those
we
saw
before
;
we
use
the
natural
number
predecessor
function
[
pred
]
to
express
the
relationship
between
the
types
of
these
variables
.
[[
[[
Fixpoint
get
n
(
ls
:
ilist
n
)
{
struct
ls
}
:
index
n
->
A
:=
Fixpoint
get
n
(
ls
:
ilist
n
)
:
fin
n
->
A
:=
match
ls
in
ilist
n
return
index
n
->
A
with
match
ls
with
|
Nil
=>
fun
idx
=>
|
Nil
=>
fun
idx
=>
match
idx
in
index
n
'
return
(
match
n
'
with
match
idx
in
fin
n
'
return
(
match
n
'
with
|
O
=>
A
|
O
=>
A
|
S
_
=>
unit
|
S
_
=>
unit
end
)
with
end
)
with
...
@@ -94,7 +94,7 @@ Section ilist.
...
@@ -94,7 +94,7 @@ Section ilist.
|
Next
_
_
=>
tt
|
Next
_
_
=>
tt
end
end
|
Cons
_
x
ls
'
=>
fun
idx
=>
|
Cons
_
x
ls
'
=>
fun
idx
=>
match
idx
in
index
n
'
return
ilist
(
pred
n
'
)
->
A
with
match
idx
in
fin
n
'
return
ilist
(
pred
n
'
)
->
A
with
|
First
_
=>
fun
_
=>
x
|
First
_
=>
fun
_
=>
x
|
Next
_
idx
'
=>
fun
ls
'
=>
get
ls
'
idx
'
|
Next
_
idx
'
=>
fun
ls
'
=>
get
ls
'
idx
'
end
ls
'
end
ls
'
...
@@ -104,10 +104,10 @@ Section ilist.
...
@@ -104,10 +104,10 @@ Section ilist.
There
is
just
one
problem
left
with
this
implementation
.
Though
we
know
that
the
local
[
ls
'
]
in
the
[
Next
]
case
is
equal
to
the
original
[
ls
'
]
,
the
type
-
checker
is
not
satisfied
that
the
recursive
call
to
[
get
]
does
not
introduce
non
-
termination
.
We
solve
the
problem
by
convoy
-
binding
the
partial
application
of
[
get
]
to
[
ls
'
]
,
rather
than
[
ls
'
]
by
itself
.
*
)
There
is
just
one
problem
left
with
this
implementation
.
Though
we
know
that
the
local
[
ls
'
]
in
the
[
Next
]
case
is
equal
to
the
original
[
ls
'
]
,
the
type
-
checker
is
not
satisfied
that
the
recursive
call
to
[
get
]
does
not
introduce
non
-
termination
.
We
solve
the
problem
by
convoy
-
binding
the
partial
application
of
[
get
]
to
[
ls
'
]
,
rather
than
[
ls
'
]
by
itself
.
*
)
Fixpoint
get
n
(
ls
:
ilist
n
)
{
struct
ls
}
:
index
n
->
A
:=
Fixpoint
get
n
(
ls
:
ilist
n
)
:
fin
n
->
A
:=
match
ls
in
ilist
n
return
index
n
->
A
with
match
ls
with
|
Nil
=>
fun
idx
=>
|
Nil
=>
fun
idx
=>
match
idx
in
index
n
'
return
(
match
n
'
with
match
idx
in
fin
n
'
return
(
match
n
'
with
|
O
=>
A
|
O
=>
A
|
S
_
=>
unit
|
S
_
=>
unit
end
)
with
end
)
with
...
@@ -115,7 +115,7 @@ Section ilist.
...
@@ -115,7 +115,7 @@ Section ilist.
|
Next
_
_
=>
tt
|
Next
_
_
=>
tt
end
end
|
Cons
_
x
ls
'
=>
fun
idx
=>
|
Cons
_
x
ls
'
=>
fun
idx
=>
match
idx
in
index
n
'
return
(
index
(
pred
n
'
)
->
A
)
->
A
with
match
idx
in
fin
n
'
return
(
fin
(
pred
n
'
)
->
A
)
->
A
with
|
First
_
=>
fun
_
=>
x
|
First
_
=>
fun
_
=>
x
|
Next
_
idx
'
=>
fun
get_ls
'
=>
get_ls
'
idx
'
|
Next
_
idx
'
=>
fun
get_ls
'
=>
get_ls
'
idx
'
end
(
get
ls
'
)
end
(
get
ls
'
)
...
@@ -131,27 +131,26 @@ Implicit Arguments First [n].
...
@@ -131,27 +131,26 @@ Implicit Arguments First [n].
(
**
A
few
examples
show
how
to
make
use
of
these
definitions
.
*
)
(
**
A
few
examples
show
how
to
make
use
of
these
definitions
.
*
)
Check
Cons
0
(
Cons
1
(
Cons
2
Nil
))
.
Check
Cons
0
(
Cons
1
(
Cons
2
Nil
))
.
(
**
[[
(
**
%
\
vspace
{-
.15
in
}%
[[
Cons
0
(
Cons
1
(
Cons
2
Nil
))
Cons
0
(
Cons
1
(
Cons
2
Nil
))
:
ilist
nat
3
:
ilist
nat
3
]]
*
)
]]
*
)
(
*
begin
thide
*
)
(
*
begin
thide
*
)
Eval
simpl
in
get
(
Cons
0
(
Cons
1
(
Cons
2
Nil
)))
First
.
Eval
simpl
in
get
(
Cons
0
(
Cons
1
(
Cons
2
Nil
)))
First
.
(
**
[[
(
**
%
\
vspace
{-
.15
in
}%
[[
=
0
=
0
:
nat
:
nat
]]
*
)
]]
*
)
Eval
simpl
in
get
(
Cons
0
(
Cons
1
(
Cons
2
Nil
)))
(
Next
First
)
.
(
**
[[
Eval
simpl
in
get
(
Cons
0
(
Cons
1
(
Cons
2
Nil
)))
(
Next
First
)
.
(
**
%
\
vspace
{-
.15
in
}%
[[
=
1
=
1
:
nat
:
nat
]]
*
)
]]
*
)
Eval
simpl
in
get
(
Cons
0
(
Cons
1
(
Cons
2
Nil
)))
(
Next
(
Next
First
))
.
(
**
[[
Eval
simpl
in
get
(
Cons
0
(
Cons
1
(
Cons
2
Nil
)))
(
Next
(
Next
First
))
.
(
**
%
\
vspace
{-
.15
in
}%
[[
=
2
=
2
:
nat
:
nat
]]
*
)
]]
*
)
...
@@ -163,15 +162,15 @@ Section ilist_map.
...
@@ -163,15 +162,15 @@ Section ilist_map.
Variables
A
B
:
Set
.
Variables
A
B
:
Set
.
Variable
f
:
A
->
B
.
Variable
f
:
A
->
B
.
Fixpoint
imap
n
(
ls
:
ilist
A
n
)
{
struct
ls
}
:
ilist
B
n
:=
Fixpoint
imap
n
(
ls
:
ilist
A
n
)
:
ilist
B
n
:=
match
ls
in
ilist
_
n
return
ilist
B
n
with
match
ls
with
|
Nil
=>
Nil
|
Nil
=>
Nil
|
Cons
_
x
ls
'
=>
Cons
(
f
x
)
(
imap
ls
'
)
|
Cons
_
x
ls
'
=>
Cons
(
f
x
)
(
imap
ls
'
)
end
.
end
.
(
**
It
is
easy
to
prove
that
[
get
]
"distributes over"
[
imap
]
calls
.
The
only
tricky
bit
is
remembering
to
use
the
[
dep_destruct
]
tactic
in
place
of
plain
[
destruct
]
when
faced
with
a
baffling
tactic
error
message
.
*
)
(
**
It
is
easy
to
prove
that
[
get
]
"distributes over"
[
imap
]
calls
.
The
only
tricky
bit
is
remembering
to
use
the
[
dep_destruct
]
tactic
in
place
of
plain
[
destruct
]
when
faced
with
a
baffling
tactic
error
message
.
*
)
Theorem
get_imap
:
forall
n
(
idx
:
index
n
)
(
ls
:
ilist
A
n
)
,
Theorem
get_imap
:
forall
n
(
idx
:
fin
n
)
(
ls
:
ilist
A
n
)
,
get
(
imap
ls
)
idx
=
f
(
get
ls
idx
)
.
get
(
imap
ls
)
idx
=
f
(
get
ls
idx
)
.
(
*
begin
thide
*
)
(
*
begin
thide
*
)
induction
ls
;
dep_destruct
idx
;
crush
.
induction
ls
;
dep_destruct
idx
;
crush
.
...
@@ -182,7 +181,7 @@ End ilist_map.
...
@@ -182,7 +181,7 @@ End ilist_map.
(
**
*
Heterogeneous
Lists
*
)
(
**
*
Heterogeneous
Lists
*
)
(
**
Programmers
who
move
to
statically
-
typed
functional
languages
from
"scripting languages"
often
complain
about
the
requirement
that
every
element
of
a
list
have
the
same
type
.
With
fancy
type
systems
,
we
can
partially
lift
this
requirement
.
We
can
index
a
list
type
with
a
"type-level"
list
that
explains
what
type
each
element
of
the
list
should
have
.
This
has
been
done
in
a
variety
of
ways
in
Haskell
using
type
classes
,
and
it
we
can
do
it
much
more
cleanly
and
directly
in
Coq
.
*
)
(
**
Programmers
who
move
to
statically
-
typed
functional
languages
from
"scripting languages"
often
complain
about
the
requirement
that
every
element
of
a
list
have
the
same
type
.
With
fancy
type
systems
,
we
can
partially
lift
this
requirement
.
We
can
index
a
list
type
with
a
"type-level"
list
that
explains
what
type
each
element
of
the
list
should
have
.
This
has
been
done
in
a
variety
of
ways
in
Haskell
using
type
classes
,
and
we
can
do
it
much
more
cleanly
and
directly
in
Coq
.
*
)
Section
hlist
.
Section
hlist
.
Variable
A
:
Type
.
Variable
A
:
Type
.
...
@@ -213,8 +212,8 @@ Section hlist.
...
@@ -213,8 +212,8 @@ Section hlist.
We
can
use
[
member
]
to
adapt
our
definition
of
[
get
]
to
[
hlists
]
.
The
same
basic
[
match
]
tricks
apply
.
In
the
[
MCons
]
case
,
we
form
a
two
-
element
convoy
,
passing
both
the
data
element
[
x
]
and
the
recursor
for
the
sublist
[
mls
'
]
to
the
result
of
the
inner
[
match
]
.
We
did
not
need
to
do
that
in
[
get
]
'
s
definition
because
the
types
of
list
elements
were
not
dependent
there
.
*
)
We
can
use
[
member
]
to
adapt
our
definition
of
[
get
]
to
[
hlists
]
.
The
same
basic
[
match
]
tricks
apply
.
In
the
[
MCons
]
case
,
we
form
a
two
-
element
convoy
,
passing
both
the
data
element
[
x
]
and
the
recursor
for
the
sublist
[
mls
'
]
to
the
result
of
the
inner
[
match
]
.
We
did
not
need
to
do
that
in
[
get
]
'
s
definition
because
the
types
of
list
elements
were
not
dependent
there
.
*
)
Fixpoint
hget
ls
(
mls
:
hlist
ls
)
{
struct
mls
}
:
member
ls
->
B
elm
:=
Fixpoint
hget
ls
(
mls
:
hlist
ls
)
:
member
ls
->
B
elm
:=
match
mls
in
hlist
ls
return
member
ls
->
B
elm
with
match
mls
with
|
MNil
=>
fun
mem
=>
|
MNil
=>
fun
mem
=>
match
mem
in
member
ls
'
return
(
match
ls
'
with
match
mem
in
member
ls
'
return
(
match
ls
'
with
|
nil
=>
B
elm
|
nil
=>
B
elm
...
@@ -254,14 +253,13 @@ Example someValues : hlist (fun T : Set => T) someTypes :=
...
@@ -254,14 +253,13 @@ Example someValues : hlist (fun T : Set => T) someTypes :=
MCons
5
(
MCons
true
MNil
)
.
MCons
5
(
MCons
true
MNil
)
.
Eval
simpl
in
hget
someValues
MFirst
.
Eval
simpl
in
hget
someValues
MFirst
.
(
**
[[
(
**
%
\
vspace
{-
.15
in
}%
[[
=
5
=
5
:
(
fun
T
:
Set
=>
T
)
nat
:
(
fun
T
:
Set
=>
T
)
nat
]]
*
)
]]
*
)
Eval
simpl
in
hget
someValues
(
MNext
MFirst
)
.
(
**
[[
Eval
simpl
in
hget
someValues
(
MNext
MFirst
)
.
(
**
%
\
vspace
{-
.15
in
}%
[[
=
true
=
true
:
(
fun
T
:
Set
=>
T
)
bool
:
(
fun
T
:
Set
=>
T
)
bool
]]
*
)
]]
*
)
...
@@ -288,7 +286,6 @@ Inductive type : Set :=
...
@@ -288,7 +286,6 @@ Inductive type : Set :=
Inductive
exp
:
list
type
->
type
->
Set
:=
Inductive
exp
:
list
type
->
type
->
Set
:=
|
Const
:
forall
ts
,
exp
ts
Unit
|
Const
:
forall
ts
,
exp
ts
Unit
(
*
begin
thide
*
)
(
*
begin
thide
*
)
|
Var
:
forall
ts
t
,
member
t
ts
->
exp
ts
t
|
Var
:
forall
ts
t
,
member
t
ts
->
exp
ts
t
|
App
:
forall
ts
dom
ran
,
exp
ts
(
Arrow
dom
ran
)
->
exp
ts
dom
->
exp
ts
ran
|
App
:
forall
ts
dom
ran
,
exp
ts
(
Arrow
dom
ran
)
->
exp
ts
dom
->
exp
ts
ran
...
@@ -310,8 +307,8 @@ Fixpoint typeDenote (t : type) : Set :=
...
@@ -310,8 +307,8 @@ Fixpoint typeDenote (t : type) : Set :=
(
*
EX
:
Define
an
interpreter
for
[
exp
]
s
.
*
)
(
*
EX
:
Define
an
interpreter
for
[
exp
]
s
.
*
)
(
*
begin
thide
*
)
(
*
begin
thide
*
)
Fixpoint
expDenote
ts
t
(
e
:
exp
ts
t
)
{
struct
e
}
:
hlist
typeDenote
ts
->
typeDenote
t
:=
Fixpoint
expDenote
ts
t
(
e
:
exp
ts
t
)
:
hlist
typeDenote
ts
->
typeDenote
t
:=
match
e
in
exp
ts
t
return
hlist
typeDenote
ts
->
typeDenote
t
with
match
e
with
|
Const
_
=>
fun
_
=>
tt
|
Const
_
=>
fun
_
=>
tt
|
Var
_
_
mem
=>
fun
s
=>
hget
s
mem
|
Var
_
_
mem
=>
fun
s
=>
hget
s
mem
...
@@ -322,33 +319,32 @@ Fixpoint expDenote ts t (e : exp ts t) {struct e} : hlist typeDenote ts -> typeD
...
@@ -322,33 +319,32 @@ Fixpoint expDenote ts t (e : exp ts t) {struct e} : hlist typeDenote ts -> typeD
(
**
Like
for
previous
examples
,
our
interpreter
is
easy
to
run
with
[
simpl
]
.
*
)
(
**
Like
for
previous
examples
,
our
interpreter
is
easy
to
run
with
[
simpl
]
.
*
)
Eval
simpl
in
expDenote
Const
MNil
.
Eval
simpl
in
expDenote
Const
MNil
.
(
**
[[
(
**
%
\
vspace
{-
.15
in
}%
[[
=
tt
=
tt
:
typeDenote
Unit
:
typeDenote
Unit
]]
*
)
]]
*
)
Eval
simpl
in
expDenote
(
Abs
(
dom
:=
Unit
)
(
Var
MFirst
))
MNil
.
(
**
[[
Eval
simpl
in
expDenote
(
Abs
(
dom
:=
Unit
)
(
Var
MFirst
))
MNil
.
(
**
%
\
vspace
{-
.15
in
}%
[[
=
fun
x
:
unit
=>
x
=
fun
x
:
unit
=>
x
:
typeDenote
(
Arrow
Unit
Unit
)
:
typeDenote
(
Arrow
Unit
Unit
)
]]
*
)
]]
*
)
Eval
simpl
in
expDenote
(
Abs
(
dom
:=
Unit
)
Eval
simpl
in
expDenote
(
Abs
(
dom
:=
Unit
)
(
Abs
(
dom
:=
Unit
)
(
Var
(
MNext
MFirst
))))
MNil
.
(
Abs
(
dom
:=
Unit
)
(
Var
(
MNext
MFirst
))))
MNil
.
(
**
[[
(
**
%
\
vspace
{-
.15
in
}%
[[
=
fun
x
_
:
unit
=>
x
=
fun
x
_
:
unit
=>
x
:
typeDenote
(
Arrow
Unit
(
Arrow
Unit
Unit
))
:
typeDenote
(
Arrow
Unit
(
Arrow
Unit
Unit
))
]]
*
)
]]
*
)
Eval
simpl
in
expDenote
(
Abs
(
dom
:=
Unit
)
(
Abs
(
dom
:=
Unit
)
(
Var
MFirst
)))
MNil
.
(
**
[[
Eval
simpl
in
expDenote
(
Abs
(
dom
:=
Unit
)
(
Abs
(
dom
:=
Unit
)
(
Var
MFirst
)))
MNil
.
(
**
%
\
vspace
{-
.15
in
}%
[[
=
fun
_
x0
:
unit
=>
x0
=
fun
_
x0
:
unit
=>
x0
:
typeDenote
(
Arrow
Unit
(
Arrow
Unit
Unit
))
:
typeDenote
(
Arrow
Unit
(
Arrow
Unit
Unit
))
]]
*
)
]]
*
)
Eval
simpl
in
expDenote
(
App
(
Abs
(
Var
MFirst
))
Const
)
MNil
.
(
**
[[
Eval
simpl
in
expDenote
(
App
(
Abs
(
Var
MFirst
))
Const
)
MNil
.
(
**
%
\
vspace
{-
.15
in
}%
[[
=
tt
=
tt
:
typeDenote
Unit
:
typeDenote
Unit
]]
*
)
]]
*
)
...
@@ -376,16 +372,16 @@ Section filist.
...
@@ -376,16 +372,16 @@ Section filist.
(
**
We
say
that
a
list
of
length
0
has
no
contents
,
and
a
list
of
length
[
S
n
'
]
is
a
pair
of
a
data
value
and
a
list
of
length
[
n
'
]
.
*
)
(
**
We
say
that
a
list
of
length
0
has
no
contents
,
and
a
list
of
length
[
S
n
'
]
is
a
pair
of
a
data
value
and
a
list
of
length
[
n
'
]
.
*
)
Fixpoint
f
index
(
n
:
nat
)
:
Set
:=
Fixpoint
f
fin
(
n
:
nat
)
:
Set
:=
match
n
with
match
n
with
|
O
=>
Empty_set
|
O
=>
Empty_set
|
S
n
'
=>
option
(
f
index
n
'
)
|
S
n
'
=>
option
(
f
fin
n
'
)
end
.
end
.
(
**
We
express
that
there
are
no
index
values
when
[
n
=
O
]
,
by
defining
such
indices
as
type
[
Empty_set
]
;
and
we
express
that
,
at
[
n
=
S
n
'
]
,
there
is
a
choice
between
picking
the
first
element
of
the
list
(
represented
as
[
None
])
or
choosing
a
later
element
(
represented
by
[
Some
idx
]
,
where
[
idx
]
is
an
index
into
the
list
tail
)
.
*
)
(
**
We
express
that
there
are
no
index
values
when
[
n
=
O
]
,
by
defining
such
indices
as
type
[
Empty_set
]
;
and
we
express
that
,
at
[
n
=
S
n
'
]
,
there
is
a
choice
between
picking
the
first
element
of
the
list
(
represented
as
[
None
])
or
choosing
a
later
element
(
represented
by
[
Some
idx
]
,
where
[
idx
]
is
an
index
into
the
list
tail
)
.
*
)
Fixpoint
fget
(
n
:
nat
)
:
filist
n
->
f
index
n
->
A
:=
Fixpoint
fget
(
n
:
nat
)
:
filist
n
->
f
fin
n
->
A
:=
match
n
return
filist
n
->
findex
n
->
A
with
match
n
with
|
O
=>
fun
_
idx
=>
match
idx
with
end
|
O
=>
fun
_
idx
=>
match
idx
with
end
|
S
n
'
=>
fun
ls
idx
=>
|
S
n
'
=>
fun
ls
idx
=>
match
idx
with
match
idx
with
...
@@ -394,8 +390,9 @@ Section filist.
...
@@ -394,8 +390,9 @@ Section filist.
end
end
end
.
end
.
(
**
Our
new
[
get
]
implementation
needs
only
one
dependent
[
match
]
,
which
just
copies
the
stated
return
type
of
the
function
.
Our
choices
of
data
structure
implementations
lead
to
just
the
right
typing
behavior
for
this
new
definition
to
work
out
.
*
)
(
**
Our
new
[
get
]
implementation
needs
only
one
dependent
[
match
]
,
and
its
annotation
is
inferred
for
us
.
Our
choices
of
data
structure
implementations
lead
to
just
the
right
typing
behavior
for
this
new
definition
to
work
out
.
*
)
(
*
end
thide
*
)
(
*
end
thide
*
)
End
filist
.
End
filist
.
(
**
Heterogeneous
lists
are
a
little
trickier
to
define
with
recursion
,
but
we
then
reap
similar
benefits
in
simplicity
of
use
.
*
)
(
**
Heterogeneous
lists
are
a
little
trickier
to
define
with
recursion
,
but
we
then
reap
similar
benefits
in
simplicity
of
use
.
*
)
...
@@ -423,14 +420,13 @@ Section fhlist.
...
@@ -423,14 +420,13 @@ Section fhlist.
|
x
::
ls
'
=>
(
x
=
elm
)
+
fmember
ls
'
|
x
::
ls
'
=>
(
x
=
elm
)
+
fmember
ls
'
end
%
type
.
end
%
type
.
(
**
The
definition
of
[
fmember
]
follows
the
definition
of
[
f
index
]
.
Empty
lists
have
no
members
,
and
member
types
for
nonempty
lists
are
built
by
adding
one
new
option
to
the
type
of
members
of
the
list
tail
.
While
for
[
index
]
we
needed
no
new
information
associated
with
the
option
that
we
add
,
here
we
need
to
know
that
the
head
of
the
list
equals
the
element
we
are
searching
for
.
We
express
that
with
a
sum
type
whose
left
branch
is
the
appropriate
equality
proposition
.
Since
we
define
[
fmember
]
to
live
in
[
Type
]
,
we
can
insert
[
Prop
]
types
as
needed
,
because
[
Prop
]
is
a
subtype
of
[
Type
]
.
(
**
The
definition
of
[
fmember
]
follows
the
definition
of
[
f
fin
]
.
Empty
lists
have
no
members
,
and
member
types
for
nonempty
lists
are
built
by
adding
one
new
option
to
the
type
of
members
of
the
list
tail
.
While
for
[
index
]
we
needed
no
new
information
associated
with
the
option
that
we
add
,
here
we
need
to
know
that
the
head
of
the
list
equals
the
element
we
are
searching
for
.
We
express
that
with
a
sum
type
whose
left
branch
is
the
appropriate
equality
proposition
.
Since
we
define
[
fmember
]
to
live
in
[
Type
]
,
we
can
insert
[
Prop
]
types
as
needed
,
because
[
Prop
]
is
a
subtype
of
[
Type
]
.
We
know
all
of
the
tricks
needed
to
write
a
first
attempt
at
a
[
get
]
function
for
[
fhlist
]
s
.
We
know
all
of
the
tricks
needed
to
write
a
first
attempt
at
a
[
get
]
function
for
[
fhlist
]
s
.
[[
[[
Fixpoint
fhget
(
ls
:
list
A
)
:
fhlist
ls
->
fmember
ls
->
B
elm
:=
Fixpoint
fhget
(
ls
:
list
A
)
:
fhlist
ls
->
fmember
ls
->
B
elm
:=
match
ls
return
fhlist
ls
->
fmember
ls
->
B
elm
with
match
ls
with
|
nil
=>
fun
_
idx
=>
match
idx
with
end
|
nil
=>
fun
_
idx
=>
match
idx
with
end
|
_
::
ls
'
=>
fun
mls
idx
=>
|
_
::
ls
'
=>
fun
mls
idx
=>
match
idx
with
match
idx
with
...
@@ -444,7 +440,7 @@ Section fhlist.
...
@@ -444,7 +440,7 @@ Section fhlist.
Only
one
problem
remains
.
The
expression
[
fst
mls
]
is
not
known
to
have
the
proper
type
.
To
demonstrate
that
it
does
,
we
need
to
use
the
proof
available
in
the
[
inl
]
case
of
the
inner
[
match
]
.
*
)
Only
one
problem
remains
.
The
expression
[
fst
mls
]
is
not
known
to
have
the
proper
type
.
To
demonstrate
that
it
does
,
we
need
to
use
the
proof
available
in
the
[
inl
]
case
of
the
inner
[
match
]
.
*
)
Fixpoint
fhget
(
ls
:
list
A
)
:
fhlist
ls
->
fmember
ls
->
B
elm
:=
Fixpoint
fhget
(
ls
:
list
A
)
:
fhlist
ls
->
fmember
ls
->
B
elm
:=
match
ls
return
fhlist
ls
->
fmember
ls
->
B
elm
with
match
ls
with
|
nil
=>
fun
_
idx
=>
match
idx
with
end
|
nil
=>
fun
_
idx
=>
match
idx
with
end
|
_
::
ls
'
=>
fun
mls
idx
=>
|
_
::
ls
'
=>
fun
mls
idx
=>
match
idx
with
match
idx
with
...
@@ -458,13 +454,14 @@ Section fhlist.
...
@@ -458,13 +454,14 @@ Section fhlist.
(
**
By
pattern
-
matching
on
the
equality
proof
[
pf
]
,
we
make
that
equality
known
to
the
type
-
checker
.
Exactly
why
this
works
can
be
seen
by
studying
the
definition
of
equality
.
*
)
(
**
By
pattern
-
matching
on
the
equality
proof
[
pf
]
,
we
make
that
equality
known
to
the
type
-
checker
.
Exactly
why
this
works
can
be
seen
by
studying
the
definition
of
equality
.
*
)
Print
eq
.
Print
eq
.
(
**
[[
(
**
%
\
vspace
{-
.15
in
}%
[[
Inductive
eq
(
A
:
Type
)
(
x
:
A
)
:
A
->
Prop
:=
refl_equal
:
x
=
x
Inductive
eq
(
A
:
Type
)
(
x
:
A
)
:
A
->
Prop
:=
refl_equal
:
x
=
x
]]
]]
In
a
proposition
[
x
=
y
]
,
we
see
that
[
x
]
is
a
parameter
and
[
y
]
is
a
regular
argument
.
The
type
of
the
constructor
[
refl_equal
]
shows
that
[
y
]
can
only
ever
be
instantiated
to
[
x
]
.
Thus
,
within
a
pattern
-
match
with
[
refl_equal
]
,
occurrences
of
[
y
]
can
be
replaced
with
occurrences
of
[
x
]
for
typing
purposes
.
All
examples
of
similar
dependent
pattern
matching
that
we
have
seen
before
require
explicit
annotations
,
but
Coq
implements
a
special
case
of
annotation
inference
for
matches
on
equality
proofs
.
*
)
In
a
proposition
[
x
=
y
]
,
we
see
that
[
x
]
is
a
parameter
and
[
y
]
is
a
regular
argument
.
The
type
of
the
constructor
[
refl_equal
]
shows
that
[
y
]
can
only
ever
be
instantiated
to
[
x
]
.
Thus
,
within
a
pattern
-
match
with
[
refl_equal
]
,
occurrences
of
[
y
]
can
be
replaced
with
occurrences
of
[
x
]
for
typing
purposes
.
*
)
(
*
end
thide
*
)
(
*
end
thide
*
)
End
fhlist
.
End
fhlist
.
Implicit
Arguments
fhget
[
A
B
elm
ls
]
.
Implicit
Arguments
fhget
[
A
B
elm
ls
]
.
...
@@ -489,7 +486,7 @@ Section ifoldr.
...
@@ -489,7 +486,7 @@ Section ifoldr.
Variable
f
:
A
->
B
->
B
.
Variable
f
:
A
->
B
->
B
.
Variable
i
:
B
.
Variable
i
:
B
.
Fixpoint
ifoldr
n
(
ls
:
ilist
A
n
)
{
struct
ls
}
:
B
:=
Fixpoint
ifoldr
n
(
ls
:
ilist
A
n
)
:
B
:=
match
ls
with
match
ls
with
|
Nil
=>
i
|
Nil
=>
i
|
Cons
_
x
ls
'
=>
f
x
(
ifoldr
ls
'
)
|
Cons
_
x
ls
'
=>
f
x
(
ifoldr
ls
'
)
...
@@ -520,21 +517,23 @@ Theorem sum_inc : forall t, sum (inc t) >= sum t.
...
@@ -520,21 +517,23 @@ Theorem sum_inc : forall t, sum (inc t) >= sum t.
============================
============================
ifoldr
(
fun
(
t
'
:
tree
nat
)
(
n0
:
nat
)
=>
sum
t
'
+
n0
)
0
(
imap
inc
i
)
>=
ifoldr
(
fun
(
t
'
:
tree
nat
)
(
n0
:
nat
)
=>
sum
t
'
+
n0
)
0
(
imap
inc
i
)
>=
ifoldr
(
fun
(
t
'
:
tree
nat
)
(
n0
:
nat
)
=>
sum
t
'
+
n0
)
0
i
ifoldr
(
fun
(
t
'
:
tree
nat
)
(
n0
:
nat
)
=>
sum
t
'
+
n0
)
0
i
]]
]]
We
are
left
with
a
single
subgoal
which
does
not
seem
provable
directly
.
This
is
the
same
problem
that
we
met
in
Chapter
3
with
other
nested
inductive
types
.
*
)
We
are
left
with
a
single
subgoal
which
does
not
seem
provable
directly
.
This
is
the
same
problem
that
we
met
in
Chapter
3
with
other
nested
inductive
types
.
*
)
Check
tree_ind
.
Check
tree_ind
.
(
**
[[
(
**
%
\
vspace
{-
.15
in
}%
[[
tree_ind
tree_ind
:
forall
(
A
:
Set
)
(
P
:
tree
A
->
Prop
)
,
:
forall
(
A
:
Set
)
(
P
:
tree
A
->
Prop
)
,
(
forall
a
:
A
,
P
(
Leaf
a
))
->
(
forall
a
:
A
,
P
(
Leaf
a
))
->
(
forall
(
n
:
nat
)
(
i
:
ilist
(
tree
A
)
n
)
,
P
(
Node
i
))
->
(
forall
(
n
:
nat
)
(
i
:
ilist
(
tree
A
)
n
)
,
P
(
Node
i
))
->
forall
t
:
tree
A
,
P
t
forall
t
:
tree
A
,
P
t
]]
]]
The
automatically
-
generated
induction
principle
is
too
weak
.
For
the
[
Node
]
case
,
it
gives
us
no
inductive
hypothesis
.
We
could
write
our
own
induction
principle
,
as
we
did
in
Chapter
3
,
but
there
is
an
easier
way
,
if
we
are
willing
to
alter
the
definition
of
[
tree
]
.
*
)
The
automatically
-
generated
induction
principle
is
too
weak
.
For
the
[
Node
]
case
,
it
gives
us
no
inductive
hypothesis
.
We
could
write
our
own
induction
principle
,
as
we
did
in
Chapter
3
,
but
there
is
an
easier
way
,
if
we
are
willing
to
alter
the
definition
of
[
tree
]
.
*
)
Abort
.
Abort
.
Reset
tree
.
Reset
tree
.
...
@@ -544,42 +543,39 @@ Reset tree.
...
@@ -544,42 +543,39 @@ Reset tree.
Section
tree
.
Section
tree
.
Variable
A
:
Set
.
Variable
A
:
Set
.
(
**
[[
(
**
%
\
vspace
{-
.15
in
}%
[[
Inductive
tree
:
Set
:=
Inductive
tree
:
Set
:=
|
Leaf
:
A
->
tree
|
Leaf
:
A
->
tree
|
Node
:
forall
n
,
filist
tree
n
->
tree
.
|
Node
:
forall
n
,
filist
tree
n
->
tree
.
]]
[[
Error:
Non
strictly
positive
occurrence
of
"tree"
in
Error:
Non
strictly
positive
occurrence
of
"tree"
in
"forall n : nat, filist tree n -> tree"
"forall n : nat, filist tree n -> tree"
]]
]]
The
special
-
case
rule
for
nested
datatypes
only
works
with
nested
uses
of
other
inductive
types
,
which
could
be
replaced
with
uses
of
new
mutually
-
inductive
types
.
We
defined
[
filist
]
recursively
,
so
it
may
not
be
used
for
nested
recursion
.
The
special
-
case
rule
for
nested
datatypes
only
works
with
nested
uses
of
other
inductive
types
,
which
could
be
replaced
with
uses
of
new
mutually
-
inductive
types
.
We
defined
[
filist
]
recursively
,
so
it
may
not
be
used
for
nested
recursion
.
Our
final
solution
uses
yet
another
of
the
inductive
definition
techniques
introduced
in
Chapter
3
,
reflexive
types
.
Instead
of
merely
using
[
index
]
to
get
elements
out
of
[
ilist
]
,
we
can
%
\
textit
{%
#
<
i
>
#
define
#
</
i
>
#
%}%
[
ilist
]
in
terms
of
[
index
]
.
For
the
reasons
outlined
above
,
it
turns
out
to
be
easier
to
work
with
[
findex
]
in
place
of
[
index
]
.
*
)
Our
final
solution
uses
yet
another
of
the
inductive
definition
techniques
introduced
in
Chapter
3
,
reflexive
types
.
Instead
of
merely
using
[
fin
]
to
get
elements
out
of
[
ilist
]
,
we
can
%
\
textit
{%
#
<
i
>
#
define
#
</
i
>
#
%}%
[
ilist
]
in
terms
of
[
fin
]
.
For
the
reasons
outlined
above
,
it
turns
out
to
be
easier
to
work
with
[
ffin
]
in
place
of
[
fin
]
.
*
)
Inductive
tree
:
Set
:=
Inductive
tree
:
Set
:=
|
Leaf
:
A
->
tree
|
Leaf
:
A
->
tree
|
Node
:
forall
n
,
(
findex
n
->
tree
)
->
tree
.
|
Node
:
forall
n
,
(
ffin
n
->
tree
)
->
tree
.
(
**
A
[
Node
]
is
indexed
by
a
natural
number
[
n
]
,
and
the
node
'
s
[
n
]
children
are
represented
as
a
function
from
[
ffin
n
]
to
trees
,
which
is
isomorphic
to
the
[
ilist
]
-
based
representation
that
we
used
above
.
*
)
(
**
A
[
Node
]
is
indexed
by
a
natural
number
[
n
]
,
and
the
node
'
s
[
n
]
children
are
represented
as
a
function
from
[
findex
n
]
to
trees
,
which
is
isomorphic
to
the
[
ilist
]
-
based
representation
that
we
used
above
.
*
)
End
tree
.
End
tree
.
Implicit
Arguments
Node
[
A
n
]
.
Implicit
Arguments
Node
[
A
n
]
.
(
**
We
can
redefine
[
sum
]
and
[
inc
]
for
our
new
[
tree
]
type
.
Again
,
it
is
useful
to
define
a
generic
fold
function
first
.
This
time
,
it
takes
in
a
function
whose
range
is
some
[
f
index
]
type
,
and
it
folds
another
function
over
the
results
of
calling
the
first
function
at
every
possible
[
findex
]
value
.
*
)
(
**
We
can
redefine
[
sum
]
and
[
inc
]
for
our
new
[
tree
]
type
.
Again
,
it
is
useful
to
define
a
generic
fold
function
first
.
This
time
,
it
takes
in
a
function
whose
range
is
some
[
f
fin
]
type
,
and
it
folds
another
function
over
the
results
of
calling
the
first
function
at
every
possible
[
ffin
]
value
.
*
)
Section
rifoldr
.
Section
rifoldr
.
Variables
A
B
:
Set
.
Variables
A
B
:
Set
.
Variable
f
:
A
->
B
->
B
.
Variable
f
:
A
->
B
->
B
.
Variable
i
:
B
.
Variable
i
:
B
.
Fixpoint
rifoldr
(
n
:
nat
)
:
(
f
index
n
->
A
)
->
B
:=
Fixpoint
rifoldr
(
n
:
nat
)
:
(
f
fin
n
->
A
)
->
B
:=
match
n
return
(
findex
n
->
A
)
->
B
with
match
n
with
|
O
=>
fun
_
=>
i
|
O
=>
fun
_
=>
i
|
S
n
'
=>
fun
get
=>
f
(
get
None
)
(
rifoldr
n
'
(
fun
idx
=>
get
(
Some
idx
)))
|
S
n
'
=>
fun
get
=>
f
(
get
None
)
(
rifoldr
n
'
(
fun
idx
=>
get
(
Some
idx
)))
end
.
end
.
...
@@ -608,7 +604,7 @@ Lemma plus_ge : forall x1 y1 x2 y2,
...
@@ -608,7 +604,7 @@ Lemma plus_ge : forall x1 y1 x2 y2,
crush
.
crush
.
Qed
.
Qed
.
Lemma
sum_inc
'
:
forall
n
(
f1
f2
:
f
index
n
->
nat
)
,
Lemma
sum_inc
'
:
forall
n
(
f1
f2
:
f
fin
n
->
nat
)
,
(
forall
idx
,
f1
idx
>=
f2
idx
)
(
forall
idx
,
f1
idx
>=
f2
idx
)
->
rifoldr
plus
0
f1
>=
rifoldr
plus
0
f2
.
->
rifoldr
plus
0
f1
>=
rifoldr
plus
0
f2
.
Hint
Resolve
plus_ge
.
Hint
Resolve
plus_ge
.
...
@@ -639,11 +635,11 @@ Inductive exp' : type' -> Type :=
...
@@ -639,11 +635,11 @@ Inductive exp' : type' -> Type :=
|
BConst
:
bool
->
exp
'
Bool
|
BConst
:
bool
->
exp
'
Bool
(
*
begin
thide
*
)
(
*
begin
thide
*
)
|
Cond
:
forall
n
t
,
(
f
index
n
->
exp
'
Bool
)
|
Cond
:
forall
n
t
,
(
f
fin
n
->
exp
'
Bool
)
->
(
f
index
n
->
exp
'
t
)
->
exp
'
t
->
exp
'
t
.
->
(
f
fin
n
->
exp
'
t
)
->
exp
'
t
->
exp
'
t
.
(
*
end
thide
*
)
(
*
end
thide
*
)
(
**
A
[
Cond
]
is
parameterized
by
a
natural
[
n
]
,
which
tells
us
how
many
cases
this
conditional
has
.
The
test
expressions
are
represented
with
a
function
of
type
[
f
index
n
->
exp
'
Bool
]
,
and
the
bodies
are
represented
with
a
function
of
type
[
findex
n
->
exp
'
t
]
,
where
[
t
]
is
the
overall
type
.
The
final
[
exp
'
t
]
argument
is
the
default
case
.
(
**
A
[
Cond
]
is
parameterized
by
a
natural
[
n
]
,
which
tells
us
how
many
cases
this
conditional
has
.
The
test
expressions
are
represented
with
a
function
of
type
[
f
fin
n
->
exp
'
Bool
]
,
and
the
bodies
are
represented
with
a
function
of
type
[
ffin
n
->
exp
'
t
]
,
where
[
t
]
is
the
overall
type
.
The
final
[
exp
'
t
]
argument
is
the
default
case
.
We
start
implementing
our
interpreter
with
a
standard
type
denotation
function
.
*
)
We
start
implementing
our
interpreter
with
a
standard
type
denotation
function
.
*
)
...
@@ -660,8 +656,8 @@ Section cond.
...
@@ -660,8 +656,8 @@ Section cond.
Variable
A
:
Set
.
Variable
A
:
Set
.
Variable
default
:
A
.
Variable
default
:
A
.
Fixpoint
cond
(
n
:
nat
)
:
(
f
index
n
->
bool
)
->
(
findex
n
->
A
)
->
A
:=
Fixpoint
cond
(
n
:
nat
)
:
(
f
fin
n
->
bool
)
->
(
ffin
n
->
A
)
->
A
:=
match
n
return
(
findex
n
->
bool
)
->
(
findex
n
->
A
)
->
A
with
match
n
with
|
O
=>
fun
_
_
=>
default
|
O
=>
fun
_
_
=>
default
|
S
n
'
=>
fun
tests
bodies
=>
|
S
n
'
=>
fun
tests
bodies
=>
if
tests
None
if
tests
None
...
@@ -677,17 +673,14 @@ Implicit Arguments cond [A n].
...
@@ -677,17 +673,14 @@ Implicit Arguments cond [A n].
(
**
Now
the
expression
interpreter
is
straightforward
to
write
.
*
)
(
**
Now
the
expression
interpreter
is
straightforward
to
write
.
*
)
Fixpoint
exp
'
Denote
t
(
e
:
exp
'
t
)
{
struct
e
}
:
type
'
Denote
t
:=
Fixpoint
exp
'
Denote
t
(
e
:
exp
'
t
)
:
type
'
Denote
t
:=
match
e
in
exp
'
t
return
type
'
Denote
t
with
match
e
with
|
NConst
n
=>
|
NConst
n
=>
n
n
|
Plus
e1
e2
=>
exp
'
Denote
e1
+
exp
'
Denote
e2
|
Plus
e1
e2
=>
exp
'
Denote
e1
+
exp
'
Denote
e2
|
Eq
e1
e2
=>
|
Eq
e1
e2
=>
if
eq_nat_dec
(
exp
'
Denote
e1
)
(
exp
'
Denote
e2
)
then
true
else
false
if
eq_nat_dec
(
exp
'
Denote
e1
)
(
exp
'
Denote
e2
)
then
true
else
false
|
BConst
b
=>
|
BConst
b
=>
b
b
|
Cond
_
_
tests
bodies
default
=>
|
Cond
_
_
tests
bodies
default
=>
(
*
begin
thide
*
)
(
*
begin
thide
*
)
cond
cond
...
@@ -705,8 +698,8 @@ Section cfoldCond.
...
@@ -705,8 +698,8 @@ Section cfoldCond.
Variable
default
:
exp
'
t
.
Variable
default
:
exp
'
t
.
Fixpoint
cfoldCond
(
n
:
nat
)
Fixpoint
cfoldCond
(
n
:
nat
)
:
(
f
index
n
->
exp
'
Bool
)
->
(
findex
n
->
exp
'
t
)
->
exp
'
t
:=
:
(
f
fin
n
->
exp
'
Bool
)
->
(
ffin
n
->
exp
'
t
)
->
exp
'
t
:=
match
n
return
(
findex
n
->
exp
'
Bool
)
->
(
findex
n
->
exp
'
t
)
->
exp
'
t
with
match
n
with
|
O
=>
fun
_
_
=>
default
|
O
=>
fun
_
_
=>
default
|
S
n
'
=>
fun
tests
bodies
=>
|
S
n
'
=>
fun
tests
bodies
=>
match
tests
None
return
_
with
match
tests
None
return
_
with
...
@@ -747,8 +740,8 @@ Implicit Arguments cfoldCond [t n].
...
@@ -747,8 +740,8 @@ Implicit Arguments cfoldCond [t n].
(
**
Like
for
the
interpreters
,
most
of
the
action
was
in
this
helper
function
,
and
[
cfold
]
itself
is
easy
to
write
.
*
)
(
**
Like
for
the
interpreters
,
most
of
the
action
was
in
this
helper
function
,
and
[
cfold
]
itself
is
easy
to
write
.
*
)
Fixpoint
cfold
t
(
e
:
exp
'
t
)
{
struct
e
}
:
exp
'
t
:=
Fixpoint
cfold
t
(
e
:
exp
'
t
)
:
exp
'
t
:=
match
e
in
exp
'
t
return
exp
'
t
with
match
e
with
|
NConst
n
=>
NConst
n
|
NConst
n
=>
NConst
n
|
Plus
e1
e2
=>
|
Plus
e1
e2
=>
let
e1
'
:=
cfold
e1
in
let
e1
'
:=
cfold
e1
in
...
@@ -779,7 +772,7 @@ Fixpoint cfold t (e : exp' t) {struct e} : exp' t :=
...
@@ -779,7 +772,7 @@ Fixpoint cfold t (e : exp' t) {struct e} : exp' t :=
(
**
To
prove
our
final
correctness
theorem
,
it
is
useful
to
know
that
[
cfoldCond
]
preserves
expression
meanings
.
This
lemma
formalizes
that
property
.
The
proof
is
a
standard
mostly
-
automated
one
,
with
the
only
wrinkle
being
a
guided
instantation
of
the
quantifiers
in
the
induction
hypothesis
.
*
)
(
**
To
prove
our
final
correctness
theorem
,
it
is
useful
to
know
that
[
cfoldCond
]
preserves
expression
meanings
.
This
lemma
formalizes
that
property
.
The
proof
is
a
standard
mostly
-
automated
one
,
with
the
only
wrinkle
being
a
guided
instantation
of
the
quantifiers
in
the
induction
hypothesis
.
*
)
Lemma
cfoldCond_correct
:
forall
t
(
default
:
exp
'
t
)
Lemma
cfoldCond_correct
:
forall
t
(
default
:
exp
'
t
)
n
(
tests
:
f
index
n
->
exp
'
Bool
)
(
bodies
:
findex
n
->
exp
'
t
)
,
n
(
tests
:
f
fin
n
->
exp
'
Bool
)
(
bodies
:
ffin
n
->
exp
'
t
)
,
exp
'
Denote
(
cfoldCond
default
tests
bodies
)
exp
'
Denote
(
cfoldCond
default
tests
bodies
)
=
exp
'
Denote
(
Cond
n
tests
bodies
default
)
.
=
exp
'
Denote
(
Cond
n
tests
bodies
default
)
.
induction
n
;
crush
;
induction
n
;
crush
;
...
@@ -802,8 +795,8 @@ Qed.
...
@@ -802,8 +795,8 @@ Qed.
(
**
It
is
also
useful
to
know
that
the
result
of
a
call
to
[
cond
]
is
not
changed
by
substituting
new
tests
and
bodies
functions
,
so
long
as
the
new
functions
have
the
same
input
-
output
behavior
as
the
old
.
It
turns
out
that
,
in
Coq
,
it
is
not
possible
to
prove
in
general
that
functions
related
in
this
way
are
equal
.
We
treat
this
issue
with
our
discussion
of
axioms
in
a
later
chapter
.
For
now
,
it
suffices
to
prove
that
the
particular
function
[
cond
]
is
%
\
textit
{%
#
<
i
>
#
extensional
#
</
i
>
#
%}%;
that
is
,
it
is
unaffected
by
substitution
of
functions
with
input
-
output
equivalents
.
*
)
(
**
It
is
also
useful
to
know
that
the
result
of
a
call
to
[
cond
]
is
not
changed
by
substituting
new
tests
and
bodies
functions
,
so
long
as
the
new
functions
have
the
same
input
-
output
behavior
as
the
old
.
It
turns
out
that
,
in
Coq
,
it
is
not
possible
to
prove
in
general
that
functions
related
in
this
way
are
equal
.
We
treat
this
issue
with
our
discussion
of
axioms
in
a
later
chapter
.
For
now
,
it
suffices
to
prove
that
the
particular
function
[
cond
]
is
%
\
textit
{%
#
<
i
>
#
extensional
#
</
i
>
#
%}%;
that
is
,
it
is
unaffected
by
substitution
of
functions
with
input
-
output
equivalents
.
*
)
Lemma
cond_ext
:
forall
(
A
:
Set
)
(
default
:
A
)
n
(
tests
tests
'
:
f
index
n
->
bool
)
Lemma
cond_ext
:
forall
(
A
:
Set
)
(
default
:
A
)
n
(
tests
tests
'
:
f
fin
n
->
bool
)
(
bodies
bodies
'
:
f
index
n
->
A
)
,
(
bodies
bodies
'
:
f
fin
n
->
A
)
,
(
forall
idx
,
tests
idx
=
tests
'
idx
)
(
forall
idx
,
tests
idx
=
tests
'
idx
)
->
(
forall
idx
,
bodies
idx
=
bodies
'
idx
)
->
(
forall
idx
,
bodies
idx
=
bodies
'
idx
)
->
cond
default
tests
bodies
->
cond
default
tests
bodies
...
@@ -831,6 +824,19 @@ Qed.
...
@@ -831,6 +824,19 @@ Qed.
(
*
end
thide
*
)
(
*
end
thide
*
)
(
**
*
Choosing
Between
Representations
*
)
(
**
It
is
not
always
clear
which
of
these
representation
techniques
to
apply
in
a
particular
situation
,
but
I
will
try
to
summarize
the
pros
and
cons
of
each
.
Inductive
types
are
often
the
most
pleasant
to
work
with
,
after
someone
has
spent
the
time
implementing
some
basic
library
functions
for
them
,
using
fancy
[
match
]
annotations
.
Many
aspects
of
Coq
'
s
logic
and
tactic
support
are
specialized
to
deal
with
inductive
types
,
and
you
may
miss
out
if
you
use
alternate
encodings
.
Recursive
types
usually
involve
much
less
initial
effort
,
but
they
can
be
less
convenient
to
use
with
proof
automation
.
For
instance
,
the
[
simpl
]
tactic
(
which
is
among
the
ingredients
in
[
crush
])
will
sometimes
be
overzealous
in
simplifying
uses
of
functions
over
recursive
types
.
Consider
a
function
[
replace
]
of
type
[
forall
A
,
filist
A
n
->
fin
n
->
A
->
filist
A
n
]
,
such
that
[
replace
l
f
x
]
should
substitute
[
x
]
for
the
element
in
position
[
f
]
of
[
l
]
.
A
call
to
[
replace
]
on
a
variable
[
l
]
of
type
[
filist
A
(
S
n
)]
would
probably
be
simplified
to
an
explicit
pair
,
even
though
we
know
nothing
about
the
structure
of
[
l
]
beyond
its
type
.
In
a
proof
involving
many
recursive
types
,
this
kind
of
unhelpful
"simplification"
can
lead
to
rapid
bloat
in
the
sizes
of
subgoals
.
Another
disadvantage
of
recursive
types
is
that
they
only
apply
to
type
families
whose
indices
determine
their
"skeletons."
This
is
not
true
for
all
data
structures
;
a
good
counterexample
comes
from
the
richly
-
typed
programming
language
syntax
types
we
have
used
several
times
so
far
.
The
fact
that
a
piece
of
syntax
has
type
[
Nat
]
tells
us
nothing
about
the
tree
structure
of
that
syntax
.
Reflexive
encodings
of
data
types
are
seen
relatively
rarely
.
As
our
examples
demonstrated
,
manipulating
index
values
manually
can
lead
to
hard
-
to
-
read
code
.
A
normal
inductive
type
is
generally
easier
to
work
with
,
once
someone
has
gone
through
the
trouble
of
implementing
an
induction
principle
manually
with
the
techniques
we
studied
in
Chapter
3.
For
small
developments
,
avoiding
that
kind
of
coding
can
justify
the
use
of
reflexive
data
structures
.
*
)
(
**
*
Exercises
*
)
(
**
*
Exercises
*
)
(
**
remove
printing
*
*
)
(
**
remove
printing
*
*
)
...
@@ -849,6 +855,7 @@ Qed.
...
@@ -849,6 +855,7 @@ Qed.
t
::=
bool
|
t
+
t
t
::=
bool
|
t
+
t
p
::=
x
|
b
|
inl
p
|
inr
p
p
::=
x
|
b
|
inl
p
|
inr
p
e
::=
x
|
b
|
inl
e
|
inr
e
|
case
e
of
[
p
=>
e
]
*
|
_
=>
e
e
::=
x
|
b
|
inl
e
|
inr
e
|
case
e
of
[
p
=>
e
]
*
|
_
=>
e
]]
]]
[
x
]
stands
for
a
variable
,
and
[
b
]
stands
for
a
boolean
constant
.
The
production
for
[
case
]
expressions
means
that
a
pattern
-
match
includes
zero
or
more
pairs
of
patterns
and
expressions
,
along
with
a
default
case
.
[
x
]
stands
for
a
variable
,
and
[
b
]
stands
for
a
boolean
constant
.
The
production
for
[
case
]
expressions
means
that
a
pattern
-
match
includes
zero
or
more
pairs
of
patterns
and
expressions
,
along
with
a
default
case
.
...
...
src/DepList.v
View file @
b87eea7b
...
@@ -31,14 +31,14 @@ Section ilist.
...
@@ -31,14 +31,14 @@ Section ilist.
Implicit
Arguments
icons
[
n
]
.
Implicit
Arguments
icons
[
n
]
.
Fixpoint
index
(
n
:
nat
)
:
Type
:=
Fixpoint
fin
(
n
:
nat
)
:
Type
:=
match
n
with
match
n
with
|
O
=>
Empty_set
|
O
=>
Empty_set
|
S
n
'
=>
option
(
index
n
'
)
|
S
n
'
=>
option
(
fin
n
'
)
end
.
end
.
Fixpoint
get
(
n
:
nat
)
:
ilist
n
->
index
n
->
A
:=
Fixpoint
get
(
n
:
nat
)
:
ilist
n
->
fin
n
->
A
:=
match
n
return
ilist
n
->
index
n
->
A
with
match
n
return
ilist
n
->
fin
n
->
A
with
|
O
=>
fun
_
idx
=>
match
idx
with
end
|
O
=>
fun
_
idx
=>
match
idx
with
end
|
S
n
'
=>
fun
ls
idx
=>
|
S
n
'
=>
fun
ls
idx
=>
match
idx
with
match
idx
with
...
...
src/Generic.v
View file @
b87eea7b
...
@@ -217,7 +217,7 @@ Section ok.
...
@@ -217,7 +217,7 @@ Section ok.
Definition
datatypeDenoteOk
:=
Definition
datatypeDenoteOk
:=
forall
P
:
T
->
Prop
,
forall
P
:
T
->
Prop
,
(
forall
c
(
m
:
member
c
dt
)
(
x
:
nonrecursive
c
)
(
r
:
ilist
T
(
recursive
c
))
,
(
forall
c
(
m
:
member
c
dt
)
(
x
:
nonrecursive
c
)
(
r
:
ilist
T
(
recursive
c
))
,
(
forall
i
:
index
(
recursive
c
)
,
P
(
get
r
i
))
(
forall
i
:
fin
(
recursive
c
)
,
P
(
get
r
i
))
->
P
((
hget
dd
m
)
x
r
))
->
P
((
hget
dd
m
)
x
r
))
->
forall
v
,
P
v
.
->
forall
v
,
P
v
.
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a 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