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
d73b0ae1
Commit
d73b0ae1
authored
Nov 17, 2008
by
Adam Chlipala
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
CcExp_correct
parent
63f6560a
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
33 additions
and
46 deletions
+33
-46
Intensional.v
src/Intensional.v
+33
-46
No files found.
src/Intensional.v
View file @
d73b0ae1
...
@@ -808,7 +808,7 @@ Fixpoint map_funcs var T1 T2 (f : T1 -> T2) (fs : funcs var T1) {struct fs}
...
@@ -808,7 +808,7 @@ Fixpoint map_funcs var T1 T2 (f : T1 -> T2) (fs : funcs var T1) {struct fs}
|
Abs
_
_
_
e
fs
'
=>
Abs
e
(
fun
x
=>
map_funcs
f
(
fs
'
x
))
|
Abs
_
_
_
e
fs
'
=>
Abs
e
(
fun
x
=>
map_funcs
f
(
fs
'
x
))
end
.
end
.
Definition
Cc
Term
'
t
(
E
:
Source
.
Exp
t
)
(
Hwf
:
wfExp
(
envT
:=
nil
)
tt
(
E
_
))
:
Prog
(
ccType
t
)
:=
Definition
Cc
Exp
'
t
(
E
:
Source
.
Exp
t
)
(
Hwf
:
wfExp
(
envT
:=
nil
)
tt
(
E
_
))
:
Prog
(
ccType
t
)
:=
fun
_
=>
map_funcs
(
fun
f
=>
f
tt
)
(
ccExp
(
E
_
)
(
envT
:=
nil
)
tt
Hwf
)
.
fun
_
=>
map_funcs
(
fun
f
=>
f
tt
)
(
ccExp
(
E
_
)
(
envT
:=
nil
)
tt
Hwf
)
.
...
@@ -953,7 +953,7 @@ Fixpoint lr (t : Source.type) : Source.typeDenote t -> Closed.typeDenote (ccType
...
@@ -953,7 +953,7 @@ Fixpoint lr (t : Source.type) : Source.typeDenote t -> Closed.typeDenote (ccType
->
lr
ran
(
f1
x1
)
(
f2
x2
)
->
lr
ran
(
f1
x1
)
(
f2
x2
)
end
.
end
.
Theorem
cc
Term
_correct
:
forall
t
G
Theorem
cc
Exp
_correct
:
forall
t
G
(
e1
:
Source
.
exp
Source
.
typeDenote
t
)
(
e1
:
Source
.
exp
Source
.
typeDenote
t
)
(
e2
:
Source
.
exp
natvar
t
)
,
(
e2
:
Source
.
exp
natvar
t
)
,
exp_equiv
G
e1
e2
exp_equiv
G
e1
e2
...
@@ -1044,64 +1044,51 @@ Qed.
...
@@ -1044,64 +1044,51 @@ Qed.
(
**
*
Parametric
version
*
)
(
**
*
Parametric
version
*
)
Section
wf
.
Section
wf
.
Variable
result
:
ptype
.
Lemma
Exp_wf
'
:
forall
G
t
(
e1
e2
:
Source
.
exp
natvar
t
)
,
exp_equiv
G
e1
e2
Lemma
Pterm_wf
'
:
forall
G
(
e1
e2
:
pterm
natvar
result
)
,
pterm_equiv
G
e1
e2
->
forall
envT
(
fvs
:
isfree
envT
)
,
->
forall
envT
(
fvs
:
isfree
envT
)
,
(
forall
t
(
v1
v2
:
natvar
t
)
,
In
(
vars
(
v1
,
v2
))
G
(
forall
t
(
v1
v2
:
natvar
t
)
,
In
(
existT
_
_
(
v1
,
v2
))
G
->
lookup_type
v1
fvs
=
Some
t
)
->
lookup_type
v1
fvs
=
Some
t
)
->
wfTerm
fvs
e1
.
->
wfExp
fvs
e1
.
Hint
Extern
3
(
Some
_
=
Some
_
)
=>
contradictory
;
eapply
lookup_bound_contra
;
eauto
.
Hint
Extern
3
(
Some
_
=
Some
_
)
=>
elimtype
False
;
eapply
lookup_bound_contra
;
eauto
.
apply
(
pterm_equiv_mut
induction
1
;
crush
.
(
fun
G
(
e1
e2
:
pterm
natvar
result
)
=>
eapply
H0
.
forall
envT
(
fvs
:
isfree
envT
)
,
eauto
.
(
forall
t
(
v1
v2
:
natvar
t
)
,
In
(
vars
(
v1
,
v2
))
G
->
lookup_type
v1
fvs
=
Some
t
)
apply
H0
with
(
length
envT
)
.
->
wfTerm
(
envT
:=
envT
)
fvs
e1
)
my_crush
.
(
fun
G
t
(
p1
p2
:
pprimop
natvar
result
t
)
=>
eauto
.
forall
envT
(
fvs
:
isfree
envT
)
,
(
forall
t
(
v1
v2
:
natvar
t
)
,
In
(
vars
(
v1
,
v2
))
G
->
lookup_type
v1
fvs
=
Some
t
)
->
wfPrimop
(
envT
:=
envT
)
fvs
p1
))
;
simpler
;
match
goal
with
|
[
envT
:
list
ptype
,
H
:
_
|-
_
]
=>
apply
(
H
(
length
envT
)
(
length
envT
))
;
simpler
end
.
Qed
.
Qed
.
Theorem
Pterm_wf
:
forall
(
E
:
Pterm
resul
t
)
,
Theorem
Exp_wf
:
forall
t
(
E
:
Source
.
Exp
t
)
,
wf
Term
(
envT
:=
nil
)
tt
(
E
_
)
.
wf
Exp
(
envT
:=
nil
)
tt
(
E
_
)
.
intros
;
eapply
Pterm
_wf
'
;
intros
;
eapply
Exp
_wf
'
;
[
apply
Pterm
_equiv
[
apply
Exp
_equiv
|
simpler
]
.
|
crush
]
.
Qed
.
Qed
.
End
wf
.
End
wf
.
Definition
Cc
Term
result
(
E
:
Pterm
result
)
:
Cprog
result
:=
Definition
Cc
Exp
t
(
E
:
Source
.
Exp
t
)
:
Prog
(
ccType
t
)
:=
Cc
Term
'
E
(
Pterm
_wf
E
)
.
Cc
Exp
'
E
(
Exp
_wf
E
)
.
Lemma
map_funcs_correct
:
forall
result
T1
T2
(
f
:
T1
->
T2
)
(
fs
:
cfuncs
ctypeDenote
result
T1
)
k
,
Lemma
map_funcs_correct
:
forall
T1
T2
(
f
:
T1
->
T2
)
(
fs
:
funcs
Closed
.
typeDenote
T1
)
,
cfuncsDenote
(
map_funcs
f
fs
)
k
=
f
(
cfuncsDenote
fs
k
)
.
funcsDenote
(
map_funcs
f
fs
)
=
f
(
funcsDenote
fs
)
.
induction
fs
;
equation
.
induction
fs
;
crush
.
Qed
.
Qed
.
Theorem
Cc
Term_correct
:
forall
result
(
E
:
Pterm
result
)
k
,
Theorem
Cc
Exp_correct
:
forall
(
E
:
Source
.
Exp
Nat
)
,
PtermDenote
E
k
Source
.
ExpDenote
E
=
CprogDenote
(
CcTerm
E
)
k
.
=
ProgDenote
(
CcExp
E
)
.
Hint
Rewrite
map_funcs_correct
:
ltamer
.
Hint
Rewrite
map_funcs_correct
:
cpdt
.
unfold
PtermDenote
,
CprogDenote
,
CcTerm
,
CcTerm
'
,
cprogDenote
;
unfold
Source
.
ExpDenote
,
ProgDenote
,
CcExp
,
CcExp
'
,
progDenote
;
crush
;
simpler
;
apply
(
ccExp_correct
apply
(
ccTerm_correct
(
result
:=
result
)
(
G
:=
nil
)
(
G
:=
nil
)
(
e1
:=
E
_
)
(
e1
:=
E
_
)
(
e2
:=
E
_
)
(
e2
:=
E
_
)
(
Pterm
_equiv
_
_
_
)
(
Exp
_equiv
_
_
_
)
nil
nil
tt
tt
tt
)
;
tt
)
;
crush
.
simpler
.
Qed
.
Qed
.
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