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
1f3d675d
Commit
1f3d675d
authored
Jan 14, 2011
by
Adam Chlipala
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Everything compiles in Coq 8.3pl1
parent
e4004e1a
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
77 additions
and
137 deletions
+77
-137
Makefile
Makefile
+1
-1
Axioms.v
src/Axioms.v
+0
-42
AxiomsImpred.v
src/AxiomsImpred.v
+0
-26
Equality.v
src/Equality.v
+16
-14
Extensional.v
src/Extensional.v
+2
-2
Hoas.v
src/Hoas.v
+11
-11
Intensional.v
src/Intensional.v
+5
-5
Interps.v
src/Interps.v
+5
-5
Match.v
src/Match.v
+2
-2
MoreDep.v
src/MoreDep.v
+6
-6
Reflection.v
src/Reflection.v
+8
-8
Subset.v
src/Subset.v
+11
-11
Tactics.v
src/Tactics.v
+10
-4
No files found.
Makefile
View file @
1f3d675d
MODULES_NODOC
:=
Axioms
Tactics MoreSpecif DepList
MODULES_NODOC
:=
Tactics MoreSpecif DepList
MODULES_PROSE
:=
Intro
MODULES_PROSE
:=
Intro
MODULES_CODE
:=
StackMachine InductiveTypes Predicates Coinductive Subset
\
MODULES_CODE
:=
StackMachine InductiveTypes Predicates Coinductive Subset
\
MoreDep DataStruct Equality Generic Universes Match Reflection
\
MoreDep DataStruct Equality Generic Universes Match Reflection
\
...
...
src/Axioms.v
deleted
100644 → 0
View file @
e4004e1a
(
*
Copyright
(
c
)
2008
,
Adam
Chlipala
*
*
This
work
is
licensed
under
a
*
Creative
Commons
Attribution
-
Noncommercial
-
No
Derivative
Works
3.0
*
Unported
License
.
*
The
license
text
is
available
at
:
*
http
:
//creativecommons.org/licenses/by-nc-nd/3.0/
*
)
(
*
Additional
axioms
not
in
the
Coq
standard
library
*
)
Set
Implicit
Arguments
.
Axiom
ext_eq
:
forall
(
A
:
Type
)
(
B
:
A
->
Type
)
(
f
g
:
forall
x
,
B
x
)
,
(
forall
x
,
f
x
=
g
x
)
->
f
=
g
.
Theorem
ext_eq_Set
:
forall
(
A
:
Set
)
(
B
:
A
->
Set
)
(
f
g
:
forall
x
,
B
x
)
,
(
forall
x
,
f
x
=
g
x
)
->
f
=
g
.
intros
.
rewrite
(
ext_eq
_
_
_
H
)
;
reflexivity
.
Qed
.
Theorem
ext_eq_forall
:
forall
(
A
:
Type
)
(
f
g
:
A
->
Set
)
,
(
forall
x
,
f
x
=
g
x
)
->
@
eq
Type
(
forall
x
,
f
x
)
(
forall
x
,
g
x
)
.
intros
.
rewrite
(
ext_eq
_
_
_
H
)
;
trivial
.
Qed
.
Ltac
ext_eq
:=
(
apply
ext_eq
||
apply
ext_eq_Set
||
apply
ext_eq_forall
)
;
intro
.
Theorem
eta
:
forall
(
A
B
:
Type
)
(
f
:
A
->
B
)
,
(
fun
x
=>
f
x
)
=
f
.
intros
;
ext_eq
;
trivial
.
Qed
.
src/AxiomsImpred.v
deleted
100644 → 0
View file @
e4004e1a
(
*
Copyright
(
c
)
2008
,
Adam
Chlipala
*
*
This
work
is
licensed
under
a
*
Creative
Commons
Attribution
-
Noncommercial
-
No
Derivative
Works
3.0
*
Unported
License
.
*
The
license
text
is
available
at
:
*
http
:
//creativecommons.org/licenses/by-nc-nd/3.0/
*
)
(
*
Additional
axioms
not
in
the
Coq
standard
library
,
including
those
that
need
impredicativity
*
)
Set
Implicit
Arguments
.
Require
Import
Axioms
.
Export
Axioms
.
Theorem
ext_eq_forall_Set
:
forall
(
A
:
Type
)
(
f
g
:
A
->
Set
)
,
(
forall
x
,
f
x
=
g
x
)
->
@
eq
Set
(
forall
x
,
f
x
)
(
forall
x
,
g
x
)
.
intros
.
rewrite
(
ext_eq
_
_
_
H
)
;
trivial
.
Qed
.
Ltac
ext_eq
:=
(
apply
ext_eq
||
apply
ext_eq_Set
||
apply
ext_eq_forall
||
apply
ext_eq_forall_Set
)
;
intro
.
src/Equality.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
-
201
0
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
201
1
,
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
...
@@ -159,7 +159,9 @@ Section fhlist_map.
...
@@ -159,7 +159,9 @@ Section fhlist_map.
(
*
begin
thide
*
)
(
*
begin
thide
*
)
induction
ls
;
crush
.
induction
ls
;
crush
.
(
**
Part
of
our
single
remaining
subgoal
is
:
(
**
In
Coq
8.2
,
one
subgoal
remains
at
this
point
.
Coq
8.3
has
added
some
tactic
improvements
that
enable
[
crush
]
to
complete
all
of
both
inductive
cases
.
To
introduce
the
basics
of
reasoning
about
equality
,
it
will
be
useful
to
review
what
was
necessary
in
Coq
8.2
Part
of
our
single
remaining
subgoal
is
:
[[
[[
a0
:
a
=
elm
a0
:
a
=
elm
...
@@ -195,18 +197,22 @@ The term "refl_equal ?98" has type "?98 = ?98"
...
@@ -195,18 +197,22 @@ The term "refl_equal ?98" has type "?98 = ?98"
Is
it
time
to
throw
in
the
towel
?
Luckily
,
the
answer
is
%
``
%
#
"#no.#"
#
%
''
%
In
this
chapter
,
we
will
see
several
useful
patterns
for
proving
obligations
like
this
.
Is
it
time
to
throw
in
the
towel
?
Luckily
,
the
answer
is
%
``
%
#
"#no.#"
#
%
''
%
In
this
chapter
,
we
will
see
several
useful
patterns
for
proving
obligations
like
this
.
For
this
particular
example
,
the
solution
is
surprisingly
straightforward
.
[
destruct
]
has
a
simpler
sibling
[
case
]
which
should
behave
identically
for
any
inductive
type
with
one
constructor
of
no
arguments
.
*
)
For
this
particular
example
,
the
solution
is
surprisingly
straightforward
.
[
destruct
]
has
a
simpler
sibling
[
case
]
which
should
behave
identically
for
any
inductive
type
with
one
constructor
of
no
arguments
.
[[
case
a0
.
case
a0
.
(
**
[[
============================
============================
f
a1
=
f
a1
f
a1
=
f
a1
]]
]]
It
seems
that
[
destruct
]
was
trying
to
be
too
smart
for
its
own
good
.
*
)
It
seems
that
[
destruct
]
was
trying
to
be
too
smart
for
its
own
good
.
[[
reflexivity
.
reflexivity
.
]]
*
)
Qed
.
Qed
.
(
*
end
thide
*
)
(
*
end
thide
*
)
...
@@ -605,8 +611,7 @@ Section fhapp'.
...
@@ -605,8 +611,7 @@ Section fhapp'.
(
*
EX
:
Prove
[
fhapp
]
associativity
using
[
JMeq
]
.
*
)
(
*
EX
:
Prove
[
fhapp
]
associativity
using
[
JMeq
]
.
*
)
(
*
begin
thide
*
)
(
*
begin
thide
*
)
Theorem
fhapp_ass
'
:
forall
ls1
ls2
ls3
Theorem
fhapp_ass
'
:
forall
ls1
ls2
ls3
(
hls1
:
fhlist
B
ls1
)
(
hls2
:
fhlist
B
ls2
)
(
hls3
:
fhlist
B
ls3
)
,
(
hls1
:
fhlist
B
ls1
)
(
hls2
:
fhlist
B
ls2
)
(
hls3
:
fhlist
B
ls3
)
,
fhapp
hls1
(
fhapp
hls2
hls3
)
==
fhapp
(
fhapp
hls1
hls2
)
hls3
.
fhapp
hls1
(
fhapp
hls2
hls3
)
==
fhapp
(
fhapp
hls1
hls2
)
hls3
.
induction
ls1
;
crush
.
induction
ls1
;
crush
.
...
@@ -614,16 +619,11 @@ Section fhapp'.
...
@@ -614,16 +619,11 @@ Section fhapp'.
[[
[[
============================
============================
(
a0
,
(
a0
,
fhapp
b
(
fhapp
hls2
hls3
))
==
(
a0
,
fhapp
(
fhapp
b
hls2
)
hls3
)
fhapp
(
B
:=
B
)
(
ls1
:=
ls1
)
(
ls2
:=
ls2
++
ls3
)
b
(
fhapp
(
B
:=
B
)
(
ls1
:=
ls2
)
(
ls2
:=
ls3
)
hls2
hls3
))
==
(
a0
,
fhapp
(
B
:=
B
)
(
ls1
:=
ls1
++
ls2
)
(
ls2
:=
ls3
)
(
fhapp
(
B
:=
B
)
(
ls1
:=
ls1
)
(
ls2
:=
ls2
)
b
hls2
)
hls3
)
]]
]]
It
looks
like
one
rewrite
with
the
inductive
hypothesis
should
be
enough
to
make
the
goal
trivial
.
It
looks
like
one
rewrite
with
the
inductive
hypothesis
should
be
enough
to
make
the
goal
trivial
.
Here
is
what
happens
when
we
try
that
in
Coq
8.2
:
[[
[[
rewrite
IHls1
.
rewrite
IHls1
.
...
@@ -633,6 +633,8 @@ Error: Impossible to unify "fhlist B ((ls1 ++ ?1572) ++ ?1573)" with
...
@@ -633,6 +633,8 @@ Error: Impossible to unify "fhlist B ((ls1 ++ ?1572) ++ ?1573)" with
]]
]]
Coq
8.3
currently
gives
an
error
message
about
an
uncaught
exception
.
Perhaps
that
will
be
fixed
soon
.
In
any
case
,
it
is
educational
to
consider
a
more
explicit
approach
.
We
see
that
[
JMeq
]
is
not
a
silver
bullet
.
We
can
use
it
to
simplify
the
statements
of
equality
facts
,
but
the
Coq
type
-
checker
uses
non
-
trivial
heterogeneous
equality
facts
no
more
readily
than
it
uses
standard
equality
facts
.
Here
,
the
problem
is
that
the
form
[(
e1
,
e2
)]
is
syntactic
sugar
for
an
explicit
application
of
a
constructor
of
an
inductive
type
.
That
application
mentions
the
type
of
each
tuple
element
explicitly
,
and
our
[
rewrite
]
tries
to
change
one
of
those
elements
without
updating
the
corresponding
type
argument
.
We
see
that
[
JMeq
]
is
not
a
silver
bullet
.
We
can
use
it
to
simplify
the
statements
of
equality
facts
,
but
the
Coq
type
-
checker
uses
non
-
trivial
heterogeneous
equality
facts
no
more
readily
than
it
uses
standard
equality
facts
.
Here
,
the
problem
is
that
the
form
[(
e1
,
e2
)]
is
syntactic
sugar
for
an
explicit
application
of
a
constructor
of
an
inductive
type
.
That
application
mentions
the
type
of
each
tuple
element
explicitly
,
and
our
[
rewrite
]
tries
to
change
one
of
those
elements
without
updating
the
corresponding
type
argument
.
We
can
get
around
this
problem
by
another
multiple
use
of
[
generalize
]
.
We
want
to
bring
into
the
goal
the
proper
instance
of
the
inductive
hypothesis
,
and
we
also
want
to
generalize
the
two
relevant
uses
of
[
fhapp
]
.
*
)
We
can
get
around
this
problem
by
another
multiple
use
of
[
generalize
]
.
We
want
to
bring
into
the
goal
the
proper
instance
of
the
inductive
hypothesis
,
and
we
also
want
to
generalize
the
two
relevant
uses
of
[
fhapp
]
.
*
)
...
...
src/Extensional.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
-
201
0
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
201
1
,
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
...
@@ -10,7 +10,7 @@
...
@@ -10,7 +10,7 @@
(
*
begin
hide
*
)
(
*
begin
hide
*
)
Require
Import
String
List
.
Require
Import
String
List
.
Require
Import
Axioms
Tactics
DepList
.
Require
Import
Tactics
DepList
.
Set
Implicit
Arguments
.
Set
Implicit
Arguments
.
(
*
end
hide
*
)
(
*
end
hide
*
)
...
...
src/Hoas.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
-
201
0
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
201
1
,
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
...
@@ -8,9 +8,9 @@
...
@@ -8,9 +8,9 @@
*
)
*
)
(
*
begin
hide
*
)
(
*
begin
hide
*
)
Require
Import
Eqdep
String
List
.
Require
Import
Eqdep
String
List
FunctionalExtensionality
.
Require
Import
Axioms
Tactics
.
Require
Import
Tactics
.
Set
Implicit
Arguments
.
Set
Implicit
Arguments
.
(
*
end
hide
*
)
(
*
end
hide
*
)
...
@@ -727,14 +727,14 @@ Ltac my_crush :=
...
@@ -727,14 +727,14 @@ Ltac my_crush :=
| ?F = ?G =>
| ?F = ?G =>
let ec := equate_conj F G in
let ec := equate_conj F G in
let var := fresh "
var
" in
let var := fresh "
var
" in
assert ec; [ intuition; unfold Exp;
apply ext_eq; intro
var;
assert ec; [ intuition; unfold Exp;
extensionality
var;
assert (H' : F var = G var); try congruence;
assert (H' : F var = G var); try congruence;
match type of H' with
match type of H' with
| ?X = ?Y =>
| ?X = ?Y =>
let X := eval hnf in X in
let X := eval hnf in X in
let Y := eval hnf in Y in
let Y := eval hnf in Y in
change (X = Y) in H'
change (X = Y) in H'
end; injection H'; my_crush'; tauto
end; injection H'; my_crush'; tauto
| intuition; subst ]
| intuition; subst ]
end);
end);
clear H
clear H
...
...
src/Intensional.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
-
2009
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
2009
,
2011
,
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
...
@@ -8,9 +8,9 @@
...
@@ -8,9 +8,9 @@
*
)
*
)
(
*
begin
hide
*
)
(
*
begin
hide
*
)
Require
Import
Arith
Eqdep
List
.
Require
Import
Arith
Eqdep
List
FunctionalExtensionality
.
Require
Import
Axioms
DepList
Tactics
.
Require
Import
DepList
Tactics
.
Set
Implicit
Arguments
.
Set
Implicit
Arguments
.
(
*
end
hide
*
)
(
*
end
hide
*
)
...
@@ -178,7 +178,7 @@ Definition Phoasify t (e : DeBruijn.exp nil t) : Phoas.Exp t :=
...
@@ -178,7 +178,7 @@ Definition Phoasify t (e : DeBruijn.exp nil t) : Phoas.Exp t :=
Theorem
phoasify_sound
:
forall
G
t
(
e
:
DeBruijn
.
exp
G
t
)
s
,
Theorem
phoasify_sound
:
forall
G
t
(
e
:
DeBruijn
.
exp
G
t
)
s
,
Phoas
.
expDenote
(
phoasify
e
s
)
=
DeBruijn
.
expDenote
e
s
.
Phoas
.
expDenote
(
phoasify
e
s
)
=
DeBruijn
.
expDenote
e
s
.
induction
e
;
crush
;
ext_eq
;
crush
.
induction
e
;
crush
;
(
let
x
:=
fresh
in
extensionality
x
)
;
crush
.
Qed
.
Qed
.
(
**
We
can
prove
that
any
output
of
[
Phoasify
]
is
well
-
formed
,
in
a
sense
strong
enough
to
let
us
avoid
asserting
last
chapter
'
s
axiom
.
*
)
(
**
We
can
prove
that
any
output
of
[
Phoasify
]
is
well
-
formed
,
in
a
sense
strong
enough
to
let
us
avoid
asserting
last
chapter
'
s
axiom
.
*
)
...
@@ -420,7 +420,7 @@ Lemma dbify_sound : forall G t (e1 : Phoas.exp _ t) (e2 : Phoas.exp _ t),
...
@@ -420,7 +420,7 @@ Lemma dbify_sound : forall G t (e1 : Phoas.exp _ t) (e2 : Phoas.exp _ t),
->
forall
ts
(
w
:
wf
ts
e1
)
s
,
->
forall
ts
(
w
:
wf
ts
e1
)
s
,
G
=
makeG
'
s
G
=
makeG
'
s
->
DeBruijn
.
expDenote
(
dbify
e1
w
)
s
=
Phoas
.
expDenote
e2
.
->
DeBruijn
.
expDenote
(
dbify
e1
w
)
s
=
Phoas
.
expDenote
e2
.
induction
1
;
crush
;
ext_eq
;
crush
.
induction
1
;
crush
;
(
let
x
:=
fresh
in
extensionality
x
)
;
crush
.
Qed
.
Qed
.
(
**
In
the
usual
way
,
we
wrap
[
dbify_sound
]
into
the
final
soundness
theorem
,
formally
establishing
the
expressive
equivalence
of
PHOAS
and
de
Bruijn
index
terms
.
*
)
(
**
In
the
usual
way
,
we
wrap
[
dbify_sound
]
into
the
final
soundness
theorem
,
formally
establishing
the
expressive
equivalence
of
PHOAS
and
de
Bruijn
index
terms
.
*
)
...
...
src/Interps.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
-
201
0
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
201
1
,
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
...
@@ -8,9 +8,9 @@
...
@@ -8,9 +8,9 @@
*
)
*
)
(
*
begin
hide
*
)
(
*
begin
hide
*
)
Require
Import
String
List
.
Require
Import
String
List
FunctionalExtensionality
.
Require
Import
Axioms
Tactics
.
Require
Import
Tactics
.
Set
Implicit
Arguments
.
Set
Implicit
Arguments
.
(
*
end
hide
*
)
(
*
end
hide
*
)
...
@@ -191,7 +191,7 @@ Module STLC.
...
@@ -191,7 +191,7 @@ Module STLC.
(
*
begin
thide
*
)
(
*
begin
thide
*
)
Lemma
cfold_correct
:
forall
t
(
e
:
exp
_
t
)
,
Lemma
cfold_correct
:
forall
t
(
e
:
exp
_
t
)
,
expDenote
(
cfold
e
)
=
expDenote
e
.
expDenote
(
cfold
e
)
=
expDenote
e
.
induction
e
;
crush
;
try
(
ext_eq
;
crush
)
;
induction
e
;
crush
;
try
(
let
x
:=
fresh
in
extensionality
x
;
crush
)
;
repeat
(
match
goal
with
repeat
(
match
goal
with
|
[
|-
context
[
cfold
?
E
]
]
=>
dep_destruct
(
cfold
E
)
|
[
|-
context
[
cfold
?
E
]
]
=>
dep_destruct
(
cfold
E
)
end
;
crush
)
.
end
;
crush
)
.
...
@@ -484,7 +484,7 @@ Module PSLC.
...
@@ -484,7 +484,7 @@ Module PSLC.
Lemma
cfold_correct
:
forall
t
(
e
:
exp
_
t
)
,
Lemma
cfold_correct
:
forall
t
(
e
:
exp
_
t
)
,
expDenote
(
cfold
e
)
=
expDenote
e
.
expDenote
(
cfold
e
)
=
expDenote
e
.
induction
e
;
crush
;
try
(
ext_eq
;
crush
)
;
induction
e
;
crush
;
try
(
let
x
:=
fresh
in
extensionality
x
;
crush
)
;
repeat
(
match
goal
with
repeat
(
match
goal
with
|
[
|-
context
[
cfold
?
E
]
]
=>
dep_destruct
(
cfold
E
)
|
[
|-
context
[
cfold
?
E
]
]
=>
dep_destruct
(
cfold
E
)
|
[
|-
match
?
E
with
inl
_
=>
_
|
inr
_
=>
_
end
=
_
]
=>
destruct
E
|
[
|-
match
?
E
with
inl
_
=>
_
|
inr
_
=>
_
end
=
_
]
=>
destruct
E
...
...
src/Match.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
-
201
0
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
201
1
,
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
...
@@ -988,7 +988,7 @@ Section t7.
...
@@ -988,7 +988,7 @@ Section t7.
->
P
v2
u2
->
P
v2
u2
->
P
(
f
v1
v2
)
(
g
u1
u2
)
.
->
P
(
f
v1
v2
)
(
g
u1
u2
)
.
Theorem
t
6
:
forall
v1
v2
,
Q
v1
->
Q
v2
->
exists
u1
,
exists
u2
,
P
(
f
v1
v2
)
(
g
u1
u2
)
.
Theorem
t
7
:
forall
v1
v2
,
Q
v1
->
Q
v2
->
exists
u1
,
exists
u2
,
P
(
f
v1
v2
)
(
g
u1
u2
)
.
intros
;
do
2
insterKeep
H1
;
intros
;
do
2
insterKeep
H1
;
repeat
match
goal
with
repeat
match
goal
with
|
[
H
:
ex
_
|-
_
]
=>
destruct
H
|
[
H
:
ex
_
|-
_
]
=>
destruct
H
...
...
src/MoreDep.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
-
201
0
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
201
1
,
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
...
@@ -875,7 +875,7 @@ Section split.
...
@@ -875,7 +875,7 @@ Section split.
(
**
[
split
'
]
is
the
workhorse
behind
[
split
]
.
It
searches
through
the
possible
ways
of
splitting
[
s
]
into
two
pieces
,
checking
the
two
predicates
against
each
such
pair
.
[
split
'
]
progresses
right
-
to
-
left
,
from
splitting
all
of
[
s
]
into
the
first
piece
to
splitting
all
of
[
s
]
into
the
second
piece
.
It
takes
an
extra
argument
,
[
n
]
,
which
specifies
how
far
along
we
are
in
this
search
process
.
*
)
(
**
[
split
'
]
is
the
workhorse
behind
[
split
]
.
It
searches
through
the
possible
ways
of
splitting
[
s
]
into
two
pieces
,
checking
the
two
predicates
against
each
such
pair
.
[
split
'
]
progresses
right
-
to
-
left
,
from
splitting
all
of
[
s
]
into
the
first
piece
to
splitting
all
of
[
s
]
into
the
second
piece
.
It
takes
an
extra
argument
,
[
n
]
,
which
specifies
how
far
along
we
are
in
this
search
process
.
*
)
Definition
split
'
(
n
:
nat
)
:
n
<=
length
s
Definition
split
'
:
forall
n
:
nat
,
n
<=
length
s
->
{
exists
s1
,
exists
s2
,
length
s1
<=
n
/
\
s1
++
s2
=
s
/
\
P1
s1
/
\
P2
s2
}
->
{
exists
s1
,
exists
s2
,
length
s1
<=
n
/
\
s1
++
s2
=
s
/
\
P1
s1
/
\
P2
s2
}
+
{
forall
s1
s2
,
length
s1
<=
n
->
s1
++
s2
=
s
->
~
P1
s1
\
/
~
P2
s2
}.
+
{
forall
s1
s2
,
length
s1
<=
n
->
s1
++
s2
=
s
->
~
P1
s1
\
/
~
P2
s2
}.
refine
(
fix
F
(
n
:
nat
)
:
n
<=
length
s
refine
(
fix
F
(
n
:
nat
)
:
n
<=
length
s
...
@@ -1094,8 +1094,8 @@ Section dec_star.
...
@@ -1094,8 +1094,8 @@ Section dec_star.
(
**
Now
we
come
to
[
dec_star
''
]
itself
.
It
takes
as
an
input
a
natural
[
l
]
that
records
how
much
of
the
string
has
been
searched
so
far
,
as
we
did
for
[
split
'
]
.
The
return
type
expresses
that
[
dec_star
''
]
is
looking
for
an
index
into
[
s
]
that
splits
[
s
]
into
a
nonempty
prefix
and
a
suffix
,
such
that
the
prefix
satisfies
[
P
]
and
the
suffix
satisfies
[
P
'
]
.
*
)
(
**
Now
we
come
to
[
dec_star
''
]
itself
.
It
takes
as
an
input
a
natural
[
l
]
that
records
how
much
of
the
string
has
been
searched
so
far
,
as
we
did
for
[
split
'
]
.
The
return
type
expresses
that
[
dec_star
''
]
is
looking
for
an
index
into
[
s
]
that
splits
[
s
]
into
a
nonempty
prefix
and
a
suffix
,
such
that
the
prefix
satisfies
[
P
]
and
the
suffix
satisfies
[
P
'
]
.
*
)
Definition
dec_star
''
(
l
:
nat
)
Definition
dec_star
''
:
forall
l
:
nat
,
:
{
exists
l
'
,
S
l
'
<=
l
{
exists
l
'
,
S
l
'
<=
l
/
\
P
(
substring
n
(
S
l
'
)
s
)
/
\
P
'
(
substring
(
n
+
S
l
'
)
(
length
s
-
(
n
+
S
l
'
))
s
)
}
/
\
P
(
substring
n
(
S
l
'
)
s
)
/
\
P
'
(
substring
(
n
+
S
l
'
)
(
length
s
-
(
n
+
S
l
'
))
s
)
}
+
{
forall
l
'
,
S
l
'
<=
l
+
{
forall
l
'
,
S
l
'
<=
l
->
~
P
(
substring
n
(
S
l
'
)
s
)
->
~
P
(
substring
n
(
S
l
'
)
s
)
...
@@ -1137,7 +1137,7 @@ Section dec_star.
...
@@ -1137,7 +1137,7 @@ Section dec_star.
(
**
The
work
of
[
dec_star
''
]
is
nested
inside
another
linear
search
by
[
dec_star
'
]
,
which
provides
the
final
functionality
we
need
,
but
for
arbitrary
suffixes
of
[
s
]
,
rather
than
just
for
[
s
]
overall
.
*
)
(
**
The
work
of
[
dec_star
''
]
is
nested
inside
another
linear
search
by
[
dec_star
'
]
,
which
provides
the
final
functionality
we
need
,
but
for
arbitrary
suffixes
of
[
s
]
,
rather
than
just
for
[
s
]
overall
.
*
)
Definition
dec_star
'
(
n
n
'
:
nat
)
:
length
s
-
n
'
<=
n
Definition
dec_star
'
:
forall
n
n
'
:
nat
,
length
s
-
n
'
<=
n
->
{
star
P
(
substring
n
'
(
length
s
-
n
'
)
s
)
}
->
{
star
P
(
substring
n
'
(
length
s
-
n
'
)
s
)
}
+
{~
star
P
(
substring
n
'
(
length
s
-
n
'
)
s
)
}.
+
{~
star
P
(
substring
n
'
(
length
s
-
n
'
)
s
)
}.
refine
(
fix
F
(
n
n
'
:
nat
)
:
length
s
-
n
'
<=
n
refine
(
fix
F
(
n
n
'
:
nat
)
:
length
s
-
n
'
<=
n
...
@@ -1181,7 +1181,7 @@ Hint Resolve app_cong.
...
@@ -1181,7 +1181,7 @@ Hint Resolve app_cong.
(
**
With
these
helper
functions
completed
,
the
implementation
of
our
[
matches
]
function
is
refreshingly
straightforward
.
We
only
need
one
small
piece
of
specific
tactic
work
beyond
what
[
crush
]
does
for
us
.
*
)
(
**
With
these
helper
functions
completed
,
the
implementation
of
our
[
matches
]
function
is
refreshingly
straightforward
.
We
only
need
one
small
piece
of
specific
tactic
work
beyond
what
[
crush
]
does
for
us
.
*
)
Definition
matches
P
(
r
:
regexp
P
)
s
:
{
P
s
}
+
{~
P
s
}.
Definition
matches
:
forall
P
(
r
:
regexp
P
)
s
,
{
P
s
}
+
{~
P
s
}.
refine
(
fix
F
P
(
r
:
regexp
P
)
s
:
{
P
s
}
+
{~
P
s
}
:=
refine
(
fix
F
P
(
r
:
regexp
P
)
s
:
{
P
s
}
+
{~
P
s
}
:=
match
r
with
match
r
with
|
Char
ch
=>
string_dec
s
(
String
ch
""
)
|
Char
ch
=>
string_dec
s
(
String
ch
""
)
...
...
src/Reflection.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
-
201
0
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
201
1
,
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
...
@@ -68,7 +68,7 @@ Local Open Scope partial_scope.
...
@@ -68,7 +68,7 @@ Local Open Scope partial_scope.
(
**
We
bring
into
scope
some
notations
for
the
[
partial
]
type
.
These
overlap
with
some
of
the
notations
we
have
seen
previously
for
specification
types
,
so
they
were
placed
in
a
separate
scope
that
needs
separate
opening
.
*
)
(
**
We
bring
into
scope
some
notations
for
the
[
partial
]
type
.
These
overlap
with
some
of
the
notations
we
have
seen
previously
for
specification
types
,
so
they
were
placed
in
a
separate
scope
that
needs
separate
opening
.
*
)
(
*
begin
thide
*
)
(
*
begin
thide
*
)
Definition
check_even
(
n
:
nat
)
:
[
isEven
n
]
.
Definition
check_even
:
forall
n
:
nat
,
[
isEven
n
]
.
Hint
Constructors
isEven
.
Hint
Constructors
isEven
.
refine
(
fix
F
(
n
:
nat
)
:
[
isEven
n
]
:=
refine
(
fix
F
(
n
:
nat
)
:
[
isEven
n
]
:=
...
@@ -462,9 +462,9 @@ Section my_tauto.
...
@@ -462,9 +462,9 @@ Section my_tauto.
(
**
Now
we
can
write
a
function
[
forward
]
which
implements
deconstruction
of
hypotheses
.
It
has
a
dependent
type
,
in
the
style
of
Chapter
6
,
guaranteeing
correctness
.
The
arguments
to
[
forward
]
are
a
goal
formula
[
f
]
,
a
set
[
known
]
of
atomic
formulas
that
we
may
assume
are
true
,
a
hypothesis
formula
[
hyp
]
,
and
a
success
continuation
[
cont
]
that
we
call
when
we
have
extended
[
known
]
to
hold
new
truths
implied
by
[
hyp
]
.
*
)
(
**
Now
we
can
write
a
function
[
forward
]
which
implements
deconstruction
of
hypotheses
.
It
has
a
dependent
type
,
in
the
style
of
Chapter
6
,
guaranteeing
correctness
.
The
arguments
to
[
forward
]
are
a
goal
formula
[
f
]
,
a
set
[
known
]
of
atomic
formulas
that
we
may
assume
are
true
,
a
hypothesis
formula
[
hyp
]
,
and
a
success
continuation
[
cont
]
that
we
call
when
we
have
extended
[
known
]
to
hold
new
truths
implied
by
[
hyp
]
.
*
)
Definition
forward
(
f
:
formula
)
(
known
:
set
index
)
(
hyp
:
formula
)
Definition
forward
:
forall
(
f
:
formula
)
(
known
:
set
index
)
(
hyp
:
formula
)
(
cont
:
forall
known
'
,
[
allTrue
known
'
->
formulaDenote
atomics
f
])
(
cont
:
forall
known
'
,
[
allTrue
known
'
->
formulaDenote
atomics
f
])
,
:
[
allTrue
known
->
formulaDenote
atomics
hyp
->
formulaDenote
atomics
f
]
.
[
allTrue
known
->
formulaDenote
atomics
hyp
->
formulaDenote
atomics
f
]
.
refine
(
fix
F
(
f
:
formula
)
(
known
:
set
index
)
(
hyp
:
formula
)
refine
(
fix
F
(
f
:
formula
)
(
known
:
set
index
)
(
hyp
:
formula
)
(
cont
:
forall
known
'
,
[
allTrue
known
'
->
formulaDenote
atomics
f
])
(
cont
:
forall
known
'
,
[
allTrue
known
'
->
formulaDenote
atomics
f
])
:
[
allTrue
known
->
formulaDenote
atomics
hyp
->
formulaDenote
atomics
f
]
:=
:
[
allTrue
known
->
formulaDenote
atomics
hyp
->
formulaDenote
atomics
f
]
:=
...
@@ -482,8 +482,8 @@ Section my_tauto.
...
@@ -482,8 +482,8 @@ Section my_tauto.
(
**
A
[
backward
]
function
implements
analysis
of
the
final
goal
.
It
calls
[
forward
]
to
handle
implications
.
*
)
(
**
A
[
backward
]
function
implements
analysis
of
the
final
goal
.
It
calls
[
forward
]
to
handle
implications
.
*
)
Definition
backward
(
known
:
set
index
)
(
f
:
formula
)
Definition
backward
:
forall
(
known
:
set
index
)
(
f
:
formula
)
,
:
[
allTrue
known
->
formulaDenote
atomics
f
]
.
[
allTrue
known
->
formulaDenote
atomics
f
]
.
refine
(
fix
F
(
known
:
set
index
)
(
f
:
formula
)
refine
(
fix
F
(
known
:
set
index
)
(
f
:
formula
)
:
[
allTrue
known
->
formulaDenote
atomics
f
]
:=
:
[
allTrue
known
->
formulaDenote
atomics
f
]
:=
match
f
with
match
f
with
...
@@ -498,7 +498,7 @@ Section my_tauto.
...
@@ -498,7 +498,7 @@ Section my_tauto.
(
**
A
simple
wrapper
around
[
backward
]
gives
us
the
usual
type
of
a
partial
decision
procedure
.
*
)
(
**
A
simple
wrapper
around
[
backward
]
gives
us
the
usual
type
of
a
partial
decision
procedure
.
*
)
Definition
my_tauto
(
f
:
formula
)
:
[
formulaDenote
atomics
f
]
.
Definition
my_tauto
:
forall
f
:
formula
,
[
formulaDenote
atomics
f
]
.
intro
;
refine
(
Reduce
(
backward
nil
f
))
;
crush
.
intro
;
refine
(
Reduce
(
backward
nil
f
))
;
crush
.
Defined
.
Defined
.
End
my_tauto
.
End
my_tauto
.
...
...
src/Subset.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
-
201
0
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
201
1
,
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
...
@@ -226,7 +226,7 @@ let pred_strong3 = function
...
@@ -226,7 +226,7 @@ let pred_strong3 = function
We
have
managed
to
reach
a
type
that
is
,
in
a
formal
sense
,
the
most
expressive
possible
for
[
pred
]
.
Any
other
implementation
of
the
same
type
must
have
the
same
input
-
output
behavior
.
However
,
there
is
still
room
for
improvement
in
making
this
kind
of
code
easier
to
write
.
Here
is
a
version
that
takes
advantage
of
tactic
-
based
theorem
proving
.
We
switch
back
to
passing
a
separate
proof
argument
instead
of
using
a
subset
type
for
the
function
'
s
input
,
because
this
leads
to
cleaner
code
.
*
)
We
have
managed
to
reach
a
type
that
is
,
in
a
formal
sense
,
the
most
expressive
possible
for
[
pred
]
.
Any
other
implementation
of
the
same
type
must
have
the
same
input
-
output
behavior
.
However
,
there
is
still
room
for
improvement
in
making
this
kind
of
code
easier
to
write
.
Here
is
a
version
that
takes
advantage
of
tactic
-
based
theorem
proving
.
We
switch
back
to
passing
a
separate
proof
argument
instead
of
using
a
subset
type
for
the
function
'
s
input
,
because
this
leads
to
cleaner
code
.
*
)
Definition
pred_strong4
(
n
:
nat
)
:
n
>
0
->
{
m
:
nat
|
n
=
S
m
}.
Definition
pred_strong4
:
forall
n
:
nat
,
n
>
0
->
{
m
:
nat
|
n
=
S
m
}.
refine
(
fun
n
=>
refine
(
fun
n
=>
match
n
with
match
n
with
|
O
=>
fun
_
=>
False_rec
_
_
|
O
=>
fun
_
=>
False_rec
_
_
...
@@ -296,7 +296,7 @@ Eval compute in pred_strong4 two_gt0.
...
@@ -296,7 +296,7 @@ Eval compute in pred_strong4 two_gt0.
Notation
"!"
:=
(
False_rec
_
_
)
.
Notation
"!"
:=
(
False_rec
_
_
)
.
Notation
"[ e ]"
:=
(
exist
_
e
_
)
.
Notation
"[ e ]"
:=
(
exist
_
e
_
)
.
Definition
pred_strong5
(
n
:
nat
)
:
n
>
0
->
{
m
:
nat
|
n
=
S
m
}.
Definition
pred_strong5
:
forall
n
:
nat
,
n
>
0
->
{
m
:
nat
|
n
=
S
m
}.
refine
(
fun
n
=>
refine
(
fun
n
=>
match
n
with
match
n
with
|
O
=>
fun
_
=>
!
|
O
=>
fun
_
=>
!
...
@@ -356,7 +356,7 @@ Notation "'Reduce' x" := (if x then Yes else No) (at level 50).
...
@@ -356,7 +356,7 @@ Notation "'Reduce' x" := (if x then Yes else No) (at level 50).
Now
we
can
write
[
eq_nat_dec
]
,
which
compares
two
natural
numbers
,
returning
either
a
proof
of
their
equality
or
a
proof
of
their
inequality
.
*
)
Now
we
can
write
[
eq_nat_dec
]
,
which
compares
two
natural
numbers
,
returning
either
a
proof
of
their
equality
or
a
proof
of
their
inequality
.
*
)
Definition
eq_nat_dec
(
n
m
:
nat
)
:
{
n
=
m
}
+
{
n
<>
m
}.
Definition
eq_nat_dec
:
forall
n
m
:
nat
,
{
n
=
m
}
+
{
n
<>
m
}.
refine
(
fix
f
(
n
m
:
nat
)
:
{
n
=
m
}
+
{
n
<>
m
}
:=
refine
(
fix
f
(
n
m
:
nat
)
:
{
n
=
m
}
+
{
n
<>
m
}
:=
match
n
,
m
with
match
n
,
m
with
|
O
,
O
=>
Yes
|
O
,
O
=>
Yes
...
@@ -528,7 +528,7 @@ Notation "[[ x ]]" := (Found _ x _).
...
@@ -528,7 +528,7 @@ Notation "[[ x ]]" := (Found _ x _).
(
**
Now
our
next
version
of
[
pred
]
is
trivial
to
write
.
*
)
(
**
Now
our
next
version
of
[
pred
]
is
trivial
to
write
.
*
)
Definition
pred_strong7
(
n
:
nat
)
:
{{
m
|
n
=
S
m
}}.
Definition
pred_strong7
:
forall
n
:
nat
,
{{
m
|
n
=
S
m
}}.
refine
(
fun
n
=>
refine
(
fun
n
=>
match
n
with
match
n
with
|
O
=>
??
|
O
=>
??
...
@@ -567,7 +567,7 @@ Notation "[[[ x ]]]" := (inleft _ [x]).
...
@@ -567,7 +567,7 @@ Notation "[[[ x ]]]" := (inleft _ [x]).
(
**
Now
we
are
ready
to
give
the
final
version
of
possibly
-
failing
predecessor
.
The
[
sumor
]
-
based
type
that
we
use
is
maximally
expressive
;
any
implementation
of
the
type
has
the
same
input
-
output
behavior
.
*
)
(
**
Now
we
are
ready
to
give
the
final
version
of
possibly
-
failing
predecessor
.
The
[
sumor
]
-
based
type
that
we
use
is
maximally
expressive
;
any
implementation
of
the
type
has
the
same
input
-
output
behavior
.
*
)
Definition
pred_strong8
(
n
:
nat
)
:
{
m
:
nat
|
n
=
S
m
}
+
{
n
=
0
}.
Definition
pred_strong8
:
forall
n
:
nat
,
{
m
:
nat
|
n
=
S
m
}
+
{
n
=
0
}.
refine
(
fun
n
=>
refine
(
fun
n
=>
match
n
with
match
n
with
|
O
=>
!!
|
O
=>
!!
...
@@ -604,7 +604,7 @@ Notation "x <- e1 ; e2" := (match e1 with
...
@@ -604,7 +604,7 @@ Notation "x <- e1 ; e2" := (match e1 with
This
notation
is
very
helpful
for
composing
richly
-
typed
procedures
.
For
instance
,
here
is
a
very
simple
implementation
of
a
function
to
take
the
predecessors
of
two
naturals
at
once
.
*
)
This
notation
is
very
helpful
for
composing
richly
-
typed
procedures
.
For
instance
,
here
is
a
very
simple
implementation
of
a
function
to
take
the
predecessors
of
two
naturals
at
once
.
*
)
Definition
doublePred
(
n1
n2
:
nat
)
:
{{
p
|
n1
=
S
(
fst
p
)
/
\
n2
=
S
(
snd
p
)
}}.
Definition
doublePred
:
forall
n1
n2
:
nat
,
{{
p
|
n1
=
S
(
fst
p
)
/
\
n2
=
S
(
snd
p
)
}}.
refine
(
fun
n1
n2
=>
refine
(
fun
n1
n2
=>
m1
<-
pred_strong7
n1
;
m1
<-
pred_strong7
n1
;
m2
<-
pred_strong7
n2
;
m2
<-
pred_strong7
n2
;
...
@@ -623,8 +623,8 @@ Notation "x <-- e1 ; e2" := (match e1 with
...
@@ -623,8 +623,8 @@ Notation "x <-- e1 ; e2" := (match e1 with
(
**
printing
*
$
\
times
$
*
)
(
**
printing
*
$
\
times
$
*
)
Definition
doublePred
'
(
n1
n2
:
nat
)
Definition
doublePred
'
:
forall
n1
n2
:
nat
,
:
{
p
:
nat
*
nat
|
n1
=
S
(
fst
p
)
/
\
n2
=
S
(
snd
p
)
}
{
p
:
nat
*
nat
|
n1
=
S
(
fst
p
)
/
\
n2
=
S
(
snd
p
)
}
+
{
n1
=
0
\
/
n2
=
0
}.
+
{
n1
=
0
\
/
n2
=
0
}.
refine
(
fun
n1
n2
=>
refine
(
fun
n1
n2
=>
m1
<--
pred_strong8
n1
;
m1
<--
pred_strong8
n1
;
...
@@ -676,7 +676,7 @@ Notation "e1 ;; e2" := (if e1 then e2 else ??)
...
@@ -676,7 +676,7 @@ Notation "e1 ;; e2" := (if e1 then e2 else ??)
(
**
With
that
notation
defined
,
we
can
implement
a
[
typeCheck
]
function
,
whose
code
is
only
more
complex
than
what
we
would
write
in
ML
because
it
needs
to
include
some
extra
type
annotations
.
Every
[[[
e
]]]
expression
adds
a
[
hasType
]
proof
obligation
,
and
[
crush
]
makes
short
work
of
them
when
we
add
[
hasType
]
'
s
constructors
as
hints
.
*
)
(
**
With
that
notation
defined
,
we
can
implement
a
[
typeCheck
]
function
,
whose
code
is
only
more
complex
than
what
we
would
write
in
ML
because
it
needs
to
include
some
extra
type
annotations
.
Every
[[[
e
]]]
expression
adds
a
[
hasType
]
proof
obligation
,
and
[
crush
]
makes
short
work
of
them
when
we
add
[
hasType
]
'
s
constructors
as
hints
.
*
)
(
*
end
thide
*
)
(
*
end
thide
*
)
Definition
typeCheck
(
e
:
exp
)
:
{{
t
|
hasType
e
t
}}.
Definition
typeCheck
:
forall
e
:
exp
,
{{
t
|
hasType
e
t
}}.
(
*
begin
thide
*
)
(
*
begin
thide
*
)
Hint
Constructors
hasType
.
Hint
Constructors
hasType
.
...
@@ -813,7 +813,7 @@ Qed.
...
@@ -813,7 +813,7 @@ Qed.
(
**
Now
we
can
define
the
type
-
checker
.
Its
type
expresses
that
it
only
fails
on
untypable
expressions
.
*
)
(
**
Now
we
can
define
the
type
-
checker
.
Its
type
expresses
that
it
only
fails
on
untypable
expressions
.
*
)
(
*
end
thide
*
)
(
*
end
thide
*
)
Definition
typeCheck
'
(
e
:
exp
)
:
{
t
:
type
|
hasType
e
t
}
+
{
forall
t
,
~
hasType
e
t
}.
Definition
typeCheck
'
:
forall
e
:
exp
,
{
t
:
type
|
hasType
e
t
}
+
{
forall
t
,
~
hasType
e
t
}.
(
*
begin
thide
*
)
(
*
begin
thide
*
)
Hint
Constructors
hasType
.
Hint
Constructors
hasType
.
(
**
We
register
all
of
the
typing
rules
as
hints
.
*
)
(
**
We
register
all
of
the
typing
rules
as
hints
.
*
)
...
...
src/Tactics.v
View file @
1f3d675d
(
*
Copyright
(
c
)
2008
,
Adam
Chlipala
(
*
Copyright
(
c
)
2008
-
2011
,
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
...
@@ -126,13 +126,19 @@ Ltac un_done :=
...
@@ -126,13 +126,19 @@ Ltac un_done :=
|
[
H
:
done
_
|-
_
]
=>
clear
H
|
[
H
:
done
_
|-
_
]
=>
clear
H
end
.
end
.
Require
Import
JMeq
.
Ltac
crush
'
lemmas
invOne
:=
Ltac
crush
'
lemmas
invOne
:=
let
sintuition
:=
simpl
in
*;
intuition
;
try
subst
;
repeat
(
simplHyp
invOne
;
intuition
;
try
subst
)
;
try
congruence
in
let
sintuition
:=
simpl
in
*;
intuition
;
try
subst
;
repeat
(
simplHyp
invOne
;
intuition
;
try
subst
)
;
try
congruence
in
let
rewriter
:=
autorewrite
with
cpdt
in
*;
let
rewriter
:=
autorewrite
with
cpdt
in
*;
repeat
(
match
goal
with
repeat
(
match
goal
with
|
[
H
:
_
|-
_
]
=>
(
rewrite
H
;
[])
|
[
H
:
?
P
|-
_
]
=>
||
(
rewrite
H
;
[
|
solve
[
crush
'
lemmas
invOne
]
])
match
P
with
||
(
rewrite
H
;
[
|
solve
[
crush
'
lemmas
invOne
]
|
solve
[
crush
'
lemmas
invOne
]
])
|
context
[
JMeq
]
=>
fail
1
|
_
=>
(
rewrite
H
;
[])
||
(
rewrite
H
;
[
|
solve
[
crush
'
lemmas
invOne
]
])
||
(
rewrite
H
;
[
|
solve
[
crush
'
lemmas
invOne
]
|
solve
[
crush
'
lemmas
invOne
]
])
end
end
;
autorewrite
with
cpdt
in
*
)
end
;
autorewrite
with
cpdt
in
*
)
in
(
sintuition
;
rewriter
;
in
(
sintuition
;
rewriter
;
match
lemmas
with
match
lemmas
with
...
...
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