Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
AVA
FloVer
Commits
5607882d
Commit
5607882d
authored
Apr 05, 2017
by
=
Browse files
Certificate checking Coq development is now finished?
parent
e8c5b014
Changes
11
Hide whitespace changes
Inline
Side-by-side
coq/CertificateChecker.v
View file @
5607882d
...
...
@@ -12,9 +12,11 @@ Require Export Coq.QArith.QArith.
Require
Export
Daisy
.
Infra
.
ExpressionAbbrevs
Daisy
.
Commands
.
(
**
Certificate
checking
function
**
)
Definition
CertificateChecker
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
:=
if
(
validIntervalbounds
e
absenv
P
NatSet
.
empty
)
then
(
validErrorbound
e
(
fun
(
e
:
exp
Q
)
=>
typeExpression
e
)
absenv
NatSet
.
empty
)
Definition
CertificateChecker
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
(
defVars
:
nat
->
option
mType
)
:=
if
(
typeCheck
e
defVars
(
typeMap
defVars
e
))
then
if
(
validIntervalbounds
e
absenv
P
NatSet
.
empty
)
then
(
validErrorbound
e
(
typeMap
defVars
e
)
absenv
NatSet
.
empty
)
else
false
else
false
.
(
**
...
...
@@ -22,16 +24,16 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) :=
Apart
from
assuming
two
executions
,
one
in
R
and
one
on
floats
,
we
assume
that
the
real
valued
execution
respects
the
precondition
.
**
)
Theorem
Certificate_checking_is_sound
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
P
:
Theorem
Certificate_checking_is_sound
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
P
defVars
:
forall
(
E1
E2
:
env
)
(
vR
:
R
)
(
vF
:
R
)
fVars
m
,
approxEnv
E1
absenv
fVars
NatSet
.
empty
E2
->
approxEnv
E1
defVars
absenv
fVars
NatSet
.
empty
E2
->
(
forall
v
,
NatSet
.
mem
v
fVars
=
true
->
exists
vR
,
E1
v
=
Some
(
vR
,
M0
)
/
\
exists
vR
,
E1
v
=
Some
vR
/
\
(
Q2R
(
fst
(
P
v
))
<=
vR
<=
Q2R
(
snd
(
P
v
)))
%
R
)
->
NatSet
.
Subset
(
Expressions
.
usedVars
e
)
fVars
->
eval_exp
E1
(
toREval
(
toRExp
e
))
vR
M0
->
eval_exp
E2
(
toRExp
e
)
vF
m
->
CertificateChecker
e
absenv
P
=
true
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e
))
vR
M0
->
eval_exp
E2
defVars
(
toRExp
e
)
vF
m
->
CertificateChecker
e
absenv
P
defVars
=
true
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
(
snd
(
absenv
e
)))
%
R
.
(
**
The
proofs
is
a
simple
composition
of
the
soundness
proofs
for
the
range
...
...
@@ -47,33 +49,33 @@ Proof.
destruct
iv
as
[
ivlo
ivhi
].
rewrite
absenv_eq
;
simpl
.
eapply
validErrorbound_sound
;
eauto
.
-
admit
.
(
*
eapply
validTypeMap
;
eauto
.
*
)
-
hnf
.
intros
a
in_diff
.
rewrite
NatSet
.
diff_spec
in
in_diff
.
apply
fVars_subset
.
destruct
in_diff
;
auto
.
-
intros
v
m0
v_in_empty
.
-
intros
v
v_in_empty
.
rewrite
NatSet
.
mem_spec
in
v_in_empty
.
inversion
v_in_empty
.
Admitted
.
(
*
Qed
.
*
)
Qed
.
Definition
CertificateCheckerCmd
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
:=
if
(
validIntervalboundsCmd
f
absenv
P
NatSet
.
empty
)
then
(
validErrorboundCmd
f
(
fun
e
=>
typeExpression
e
)
absenv
NatSet
.
empty
)
Definition
CertificateCheckerCmd
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
defVars
:=
if
(
typeCheckCmd
f
defVars
(
typeMapCmd
defVars
f
))
then
if
(
validIntervalboundsCmd
f
absenv
P
NatSet
.
empty
)
then
(
validErrorboundCmd
f
(
typeMapCmd
defVars
f
)
absenv
NatSet
.
empty
)
else
false
else
false
.
Theorem
Certificate_checking_cmds_is_sound
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
P
:
Theorem
Certificate_checking_cmds_is_sound
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
P
defVars
:
forall
(
E1
E2
:
env
)
outVars
vR
vF
fVars
m
,
approxEnv
E1
absenv
fVars
NatSet
.
empty
E2
->
approxEnv
E1
defVars
absenv
fVars
NatSet
.
empty
E2
->
(
forall
v
,
NatSet
.
mem
v
fVars
=
true
->
exists
vR
,
E1
v
=
Some
(
vR
,
M0
)
/
\
exists
vR
,
E1
v
=
Some
vR
/
\
(
Q2R
(
fst
(
P
v
))
<=
vR
<=
Q2R
(
snd
(
P
v
)))
%
R
)
->
NatSet
.
Subset
(
Commands
.
freeVars
f
)
fVars
->
ssa
f
fVars
outVars
->
bstep
(
toREvalCmd
(
toRCmd
f
))
E1
vR
M0
->
bstep
(
toRCmd
f
)
E2
vF
m
->
CertificateCheckerCmd
f
absenv
P
=
true
->
bstep
(
toREvalCmd
(
toRCmd
f
))
E1
(
toREvalVars
defVars
)
vR
M0
->
bstep
(
toRCmd
f
)
E2
defVars
vF
m
->
CertificateCheckerCmd
f
absenv
P
defVars
=
true
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
(
snd
(
absenv
(
getRetExp
f
))))
%
R
.
(
**
The
proofs
is
a
simple
composition
of
the
soundness
proofs
for
the
range
...
...
@@ -90,7 +92,6 @@ Proof.
destruct
iv
as
[
ivlo
ivhi
].
rewrite
absenv_eq
;
simpl
.
eapply
(
validErrorboundCmd_sound
);
eauto
.
-
admit
.
(
*
eapply
typeMapCmdValid
;
eauto
.
*
)
-
instantiate
(
1
:=
outVars
).
eapply
ssa_equal_set
;
try
eauto
.
hnf
.
...
...
@@ -103,7 +104,7 @@ Proof.
rewrite
NatSet
.
diff_spec
in
in_diff
.
destruct
in_diff
.
apply
fVars_subset
;
auto
.
-
intros
v
m1
v_in_empty
.
-
intros
v
v_in_empty
.
rewrite
NatSet
.
mem_spec
in
v_in_empty
.
inversion
v_in_empty
.
Admitted
.
\ No newline at end of file
Qed
.
\ No newline at end of file
coq/Commands.v
View file @
5607882d
...
...
@@ -52,7 +52,8 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
Inductive
bstep
:
cmd
R
->
env
->
(
nat
->
option
mType
)
->
R
->
mType
->
Prop
:=
let_b
m
m
'
x
e
s
E
v
res
defVars
:
eval_exp
E
defVars
e
v
m
->
bstep
s
(
updEnv
x
m
v
E
)
defVars
res
m
'
->
defVars
x
=
Some
m
->
bstep
s
(
updEnv
x
v
E
)
defVars
res
m
'
->
bstep
(
Let
m
x
e
s
)
E
defVars
res
m
'
|
ret_b
m
e
E
v
defVars
:
eval_exp
E
defVars
e
v
m
->
...
...
coq/Environments.v
View file @
5607882d
...
...
@@ -12,24 +12,25 @@ It is necessary to have this relation, since two evaluations of the very same
expression
may
yield
different
values
for
different
machine
epsilons
(
or
environments
that
already
only
approximate
each
other
)
**
)
Inductive
approxEnv
:
env
->
analysisResult
->
NatSet
.
t
->
NatSet
.
t
->
env
->
Prop
:=
Inductive
approxEnv
:
env
->
(
nat
->
option
mType
)
->
analysisResult
->
NatSet
.
t
->
NatSet
.
t
->
env
->
Prop
:=
|
approxRefl
A
:
approxEnv
emptyEnv
A
NatSet
.
empty
NatSet
.
empty
emptyEnv
|
approxUpdFree
E1
E2
A
v1
v2
x
fVars
dVars
m
:
approxEnv
E1
A
fVars
dVars
E2
->
approxEnv
emptyEnv
(
fun
n
=>
None
)
A
NatSet
.
empty
NatSet
.
empty
emptyEnv
|
approxUpdFree
E1
E2
defVars
A
v1
v2
x
fVars
dVars
m
:
approxEnv
E1
defVars
A
fVars
dVars
E2
->
defVars
x
=
Some
m
->
(
Rabs
(
v1
-
v2
)
<=
(
Rabs
v1
)
*
Q2R
(
meps
m
))
%
R
->
NatSet
.
mem
x
(
NatSet
.
union
fVars
dVars
)
=
false
->
approxEnv
(
updEnv
x
M0
v1
E1
)
A
(
NatSet
.
add
x
fVars
)
dVars
(
updEnv
x
m
v2
E2
)
|
approxUpdBound
E1
E2
A
v1
v2
x
fVars
dVars
m
:
approxEnv
E1
A
fVars
dVars
E2
->
approxEnv
(
updEnv
x
v1
E1
)
defVars
A
(
NatSet
.
add
x
fVars
)
dVars
(
updEnv
x
v2
E2
)
|
approxUpdBound
E1
E2
defVars
A
v1
v2
x
fVars
dVars
:
approxEnv
E1
defVars
A
fVars
dVars
E2
->
(
Rabs
(
v1
-
v2
)
<=
Q2R
(
snd
(
A
(
Var
Q
x
))))
%
R
->
NatSet
.
mem
x
(
NatSet
.
union
fVars
dVars
)
=
false
->
approxEnv
(
updEnv
x
M0
v1
E1
)
A
fVars
(
NatSet
.
add
x
dVars
)
(
updEnv
x
m
v2
E2
).
approxEnv
(
updEnv
x
v1
E1
)
defVars
A
fVars
(
NatSet
.
add
x
dVars
)
(
updEnv
x
v2
E2
).
Inductive
approxParams
:
env
->
env
->
Prop
:=
|
approxParamRefl
:
approxParams
emptyEnv
emptyEnv
|
approxParamUpd
E1
E2
m
x
v1
v2
:
approxParams
E1
E2
->
(
Rabs
(
v1
-
v2
)
<=
Q2R
(
meps
m
))
%
R
->
approxParams
(
updEnv
x
M0
v1
E1
)
(
updEnv
x
m
v2
E2
).
(
*
Inductive
approxParams
:
env
->
env
->
Prop
:=
*
)
(
*
|
approxParamRefl
:
*
)
(
*
approxParams
emptyEnv
emptyEnv
*
)
(
*
|
approxParamUpd
E1
E2
m
x
v1
v2
:
*
)
(
*
approxParams
E1
E2
->
*
)
(
*
(
Rabs
(
v1
-
v2
)
<=
Q2R
(
meps
m
))
%
R
->
*
)
(
*
approxParams
(
updEnv
x
M0
v1
E1
)
(
updEnv
x
m
v2
E2
).
*
)
coq/ErrorBounds.v
View file @
5607882d
...
...
@@ -8,7 +8,7 @@ Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealSim
Require
Import
Daisy
.
Environments
Daisy
.
Infra
.
ExpressionAbbrevs
.
Lemma
const_abs_err_bounded
(
n
:
R
)
(
nR
:
R
)
(
nF
:
R
)
(
E1
E2
:
env
)
(
absenv
:
analysisResult
)
(
m
:
mType
)
defVars
:
eval_exp
E1
defVars
(
Const
M0
n
)
nR
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
Const
M0
n
)
nR
M0
->
eval_exp
E2
defVars
(
Const
m
n
)
nF
m
->
(
Rabs
(
nR
-
nF
)
<=
Rabs
n
*
(
Q2R
(
meps
m
)))
%
R
.
Proof
.
...
...
@@ -45,12 +45,12 @@ Qed.
Lemma
add_abs_err_bounded
(
e1
:
exp
Q
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
Q
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
E1
E2
:
env
)
(
err1
err2
:
Q
)
(
m
m1
m2
:
mType
)
defVars
:
eval_exp
E1
defVars
(
toREval
(
toRExp
e1
))
e1R
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e1
))
e1R
M0
->
eval_exp
E2
defVars
(
toRExp
e1
)
e1F
m1
->
eval_exp
E1
defVars
(
toREval
(
toRExp
e2
))
e2R
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e2
))
e2R
M0
->
eval_exp
E2
defVars
(
toRExp
e2
)
e2F
m2
->
eval_exp
E1
defVars
(
toREval
(
Binop
Plus
(
toRExp
e1
)
(
toRExp
e2
)))
vR
M0
->
eval_exp
(
updEnv
2
m2
e2F
(
updEnv
1
m1
e1F
emptyEnv
))
defVars
(
Binop
Plus
(
Var
R
1
)
(
Var
R
2
))
vF
m
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
Binop
Plus
(
toRExp
e1
)
(
toRExp
e2
)))
vR
M0
->
eval_exp
(
updEnv
2
e2F
(
updEnv
1
e1F
emptyEnv
))
(
fun
n
=>
if
(
n
=?
2
)
then
Some
m2
else
if
(
n
=?
1
)
then
Some
m1
else
defVars
n
)
(
Binop
Plus
(
Var
R
1
)
(
Var
R
2
))
vF
m
->
(
Rabs
(
e1R
-
e1F
)
<=
Q2R
err1
)
%
R
->
(
Rabs
(
e2R
-
e2F
)
<=
Q2R
err2
)
%
R
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
err1
+
Q2R
err2
+
(
Rabs
(
e1F
+
e2F
)
*
(
Q2R
(
meps
m
))))
%
R
.
...
...
@@ -110,12 +110,12 @@ Qed.
**
)
Lemma
subtract_abs_err_bounded
(
e1
:
exp
Q
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
Q
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
E1
E2
:
env
)
err1
err2
(
m
m1
m2
:
mType
)
defVars
:
eval_exp
E1
defVars
(
toREval
(
toRExp
e1
))
e1R
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e1
))
e1R
M0
->
eval_exp
E2
defVars
(
toRExp
e1
)
e1F
m1
->
eval_exp
E1
defVars
(
toREval
(
toRExp
e2
))
e2R
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e2
))
e2R
M0
->
eval_exp
E2
defVars
(
toRExp
e2
)
e2F
m2
->
eval_exp
E1
defVars
(
toREval
(
Binop
Sub
(
toRExp
e1
)
(
toRExp
e2
)))
vR
M0
->
eval_exp
(
updEnv
2
m2
e2F
(
updEnv
1
m1
e1F
emptyEnv
))
defVars
(
Binop
Sub
(
Var
R
1
)
(
Var
R
2
))
vF
m
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
Binop
Sub
(
toRExp
e1
)
(
toRExp
e2
)))
vR
M0
->
eval_exp
(
updEnv
2
e2F
(
updEnv
1
e1F
emptyEnv
))
(
fun
n
=>
if
(
n
=?
2
)
then
Some
m2
else
if
(
n
=?
1
)
then
Some
m1
else
defVars
n
)
(
Binop
Sub
(
Var
R
1
)
(
Var
R
2
))
vF
m
->
(
Rabs
(
e1R
-
e1F
)
<=
Q2R
err1
)
%
R
->
(
Rabs
(
e2R
-
e2F
)
<=
Q2R
err2
)
%
R
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
err1
+
Q2R
err2
+
((
Rabs
(
e1F
-
e2F
))
*
(
Q2R
(
meps
m
))))
%
R
.
...
...
@@ -169,12 +169,12 @@ Qed.
Lemma
mult_abs_err_bounded
(
e1
:
exp
Q
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
Q
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
E1
E2
:
env
)
(
m
m1
m2
:
mType
)
defVars
:
eval_exp
E1
defVars
(
toREval
(
toRExp
e1
))
e1R
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e1
))
e1R
M0
->
eval_exp
E2
defVars
(
toRExp
e1
)
e1F
m1
->
eval_exp
E1
defVars
(
toREval
(
toRExp
e2
))
e2R
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e2
))
e2R
M0
->
eval_exp
E2
defVars
(
toRExp
e2
)
e2F
m2
->
eval_exp
E1
defVars
(
toREval
(
Binop
Mult
(
toRExp
e1
)
(
toRExp
e2
)))
vR
M0
->
eval_exp
(
updEnv
2
m2
e2F
(
updEnv
1
m1
e1F
emptyEnv
))
defVars
(
Binop
Mult
(
Var
R
1
)
(
Var
R
2
))
vF
m
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
Binop
Mult
(
toRExp
e1
)
(
toRExp
e2
)))
vR
M0
->
eval_exp
(
updEnv
2
e2F
(
updEnv
1
e1F
emptyEnv
))
(
fun
n
=>
if
(
n
=?
2
)
then
Some
m2
else
if
(
n
=?
1
)
then
Some
m1
else
defVars
n
)
(
Binop
Mult
(
Var
R
1
)
(
Var
R
2
))
vF
m
->
(
Rabs
(
vR
-
vF
)
<=
Rabs
(
e1R
*
e2R
-
e1F
*
e2F
)
+
Rabs
(
e1F
*
e2F
)
*
(
Q2R
(
meps
m
)))
%
R
.
Proof
.
intros
e1_real
e1_float
e2_real
e2_float
mult_real
mult_float
.
...
...
@@ -218,12 +218,12 @@ Qed.
Lemma
div_abs_err_bounded
(
e1
:
exp
Q
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
Q
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
E1
E2
:
env
)
(
m
m1
m2
:
mType
)
defVars
:
eval_exp
E1
defVars
(
toREval
(
toRExp
e1
))
e1R
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e1
))
e1R
M0
->
eval_exp
E2
defVars
(
toRExp
e1
)
e1F
m1
->
eval_exp
E1
defVars
(
toREval
(
toRExp
e2
))
e2R
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e2
))
e2R
M0
->
eval_exp
E2
defVars
(
toRExp
e2
)
e2F
m2
->
eval_exp
E1
defVars
(
toREval
(
Binop
Div
(
toRExp
e1
)
(
toRExp
e2
)))
vR
M0
->
eval_exp
(
updEnv
2
m2
e2F
(
updEnv
1
m1
e1F
emptyEnv
))
defVars
(
Binop
Div
(
Var
R
1
)
(
Var
R
2
))
vF
m
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
Binop
Div
(
toRExp
e1
)
(
toRExp
e2
)))
vR
M0
->
eval_exp
(
updEnv
2
e2F
(
updEnv
1
e1F
emptyEnv
))
(
fun
n
=>
if
(
n
=?
2
)
then
Some
m2
else
if
(
n
=?
1
)
then
Some
m1
else
defVars
n
)
(
Binop
Div
(
Var
R
1
)
(
Var
R
2
))
vF
m
->
(
Rabs
(
vR
-
vF
)
<=
Rabs
(
e1R
/
e2R
-
e1F
/
e2F
)
+
Rabs
(
e1F
/
e2F
)
*
(
Q2R
(
meps
m
)))
%
R
.
Proof
.
intros
e1_real
e1_float
e2_real
e2_float
div_real
div_float
.
...
...
@@ -443,9 +443,9 @@ Proof.
Qed
.
Lemma
round_abs_err_bounded
(
e
:
exp
R
)
(
nR
nF1
nF
:
R
)
(
E1
E2
:
env
)
(
err
:
R
)
(
machineEpsilon
m
:
mType
)
defVars
:
eval_exp
E1
defVars
(
toREval
e
)
nR
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
e
)
nR
M0
->
eval_exp
E2
defVars
e
nF1
m
->
eval_exp
(
updEnv
1
m
nF1
emptyEnv
)
defVars
(
toRExp
(
Downcast
machineEpsilon
(
Var
Q
1
)))
nF
machineEpsilon
->
eval_exp
(
updEnv
1
nF1
emptyEnv
)
(
fun
n
=>
if
n
=?
1
then
Some
m
else
defVars
n
)
(
toRExp
(
Downcast
machineEpsilon
(
Var
Q
1
)))
nF
machineEpsilon
->
(
Rabs
(
nR
-
nF1
)
<=
err
)
%
R
->
(
Rabs
(
nR
-
nF
)
<=
err
+
(
Rabs
nF1
)
*
Q2R
(
meps
machineEpsilon
))
%
R
.
Proof
.
...
...
coq/ErrorValidation.v
View file @
5607882d
...
...
@@ -109,28 +109,28 @@ Qed.
Lemma
validErrorboundCorrectVariable
:
forall
E1
E2
absenv
(
v
:
nat
)
nR
nF
e
nlo
nhi
P
fVars
dVars
m
Gamma
defVars
,
typeCheck
(
Var
Q
v
)
defVars
Gamma
=
true
->
approxEnv
E1
absenv
fVars
dVars
E2
->
eval_exp
E1
defVars
(
toREval
(
toRExp
(
Var
Q
v
)))
nR
M0
->
approxEnv
E1
defVars
absenv
fVars
dVars
E2
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
(
Var
Q
v
)))
nR
M0
->
eval_exp
E2
defVars
(
toRExp
(
Var
Q
v
))
nF
m
->
validIntervalbounds
(
Var
Q
v
)
absenv
P
dVars
=
true
->
validErrorbound
(
Var
Q
v
)
Gamma
absenv
dVars
=
true
->
(
forall
v1
,
NatSet
.
mem
v1
dVars
=
true
->
exists
r
,
E1
v1
=
Some
(
r
,
M0
)
/
\
exists
r
,
E1
v1
=
Some
r
/
\
(
Q2R
(
fst
(
fst
(
absenv
(
Var
Q
v1
))))
<=
r
<=
Q2R
(
snd
(
fst
(
absenv
(
Var
Q
v1
)))))
%
R
)
->
(
forall
v1
,
NatSet
.
mem
v1
fVars
=
true
->
exists
r
,
E1
v1
=
Some
(
r
,
M0
)
/
\
exists
r
,
E1
v1
=
Some
r
/
\
(
Q2R
(
fst
(
P
v1
))
<=
r
<=
Q2R
(
snd
(
P
v1
)))
%
R
)
->
absenv
(
Var
Q
v
)
=
((
nlo
,
nhi
),
e
)
->
(
Rabs
(
nR
-
nF
)
<=
(
Q2R
e
))
%
R
.
Proof
.
intros
*
typing_ok
approxCEnv
eval_real
eval_float
bounds_valid
error_valid
dVars_sound
P_valid
absenv_var
.
simpl
in
eval_real
;
inversion
eval_real
;
inversion
eval_float
;
subst
.
rename
H
2
into
E1_v
;
rename
H
7
into
E2_v
.
rename
H
1
into
E1_v
;
rename
H
6
into
E2_v
.
simpl
in
error_valid
.
rewrite
absenv_var
in
error_valid
;
simpl
in
error_valid
;
subst
.
case_eq
(
Gamma
(
Var
Q
m
v
));
intros
;
rewrite
H
in
error_valid
;
[
|
inversion
error_valid
].
case_eq
(
Gamma
(
Var
Q
v
));
intros
;
rewrite
H
in
error_valid
;
[
|
inversion
error_valid
].
rewrite
<-
andb_lazy_alt
in
error_valid
.
andb_to_prop
error_valid
.
rename
L
into
error_pos
.
...
...
@@ -159,17 +159,17 @@ Proof.
apply
Qle_Rle
in
error_valid
.
eapply
Rle_trans
;
eauto
.
rewrite
Q2R_mult
.
inversion
typing_ok
;
subst
.
rewrite
H
in
H5
;
inversion
H5
;
subst
.
rewrite
H5
in
H1
;
inversion
H1
;
subst
.
rewrite
H
,
H5
in
typing_ok
;
apply
EquivEqBoolEq
in
typing_ok
;
subst
.
clear
H5
H3
.
apply
Rmult_le_compat_r
.
{
apply
inj_eps_posR
.
}
{
rewrite
<-
maxAbs_impl_RmaxAbs
.
apply
contained_leq_maxAbs
.
unfold
contained
;
simpl
.
assert
((
toRExp
(
Var
Q
m
x
))
=
Var
R
m
x
)
by
(
simpl
;
auto
).
rewrite
<-
H
2
in
eval_float
.
pose
proof
(
validIntervalbounds_sound
A
P
(
E
:=
fun
y
:
nat
=>
if
y
=?
x
then
Some
(
nR
,
M0
)
else
E1
y
)
(
vR
:=
nR
)
typing_ok
bounds_valid
(
fVars
:=
(
NatSet
.
add
x
fVars
)))
as
valid_bounds_prf
.
assert
((
toRExp
(
Var
Q
x
))
=
Var
R
x
)
by
(
simpl
;
auto
).
rewrite
<-
H
3
in
eval_float
.
pose
proof
(
validIntervalbounds_sound
(
Var
Q
x
)
A
P
(
E
:=
fun
y
:
nat
=>
if
y
=?
x
then
Some
nR
else
E1
y
)
(
vR
:=
nR
)
defVars
bounds_valid
(
fVars
:=
(
NatSet
.
add
x
fVars
)))
as
valid_bounds_prf
.
rewrite
absenv_var
in
valid_bounds_prf
;
simpl
in
valid_bounds_prf
.
apply
valid_bounds_prf
;
try
auto
.
-
intros
v
v_mem_diff
.
...
...
@@ -180,9 +180,9 @@ Proof.
+
apply
IHapproxCEnv
;
try
auto
.
*
constructor
;
auto
.
*
constructor
;
auto
.
*
intros
v0
m2
mem_dVars
.
specialize
(
dVars_sound
v0
m2
mem_dVars
).
destruct
dVars_sound
as
[
vR0
[
mR0
iv_sound_val
]
]
.
*
intros
v0
mem_dVars
.
specialize
(
dVars_sound
v0
mem_dVars
).
destruct
dVars_sound
as
[
vR0
iv_sound_val
].
case_eq
(
v0
=?
x
);
intros
case_mem
;
rewrite
case_mem
in
iv_sound_val
;
simpl
in
iv_sound_val
.
{
rewrite
Nat
.
eqb_eq
in
case_mem
;
subst
.
...
...
@@ -191,7 +191,7 @@ Proof.
as
x_in_union
by
(
rewrite
NatSet
.
union_spec
;
auto
).
rewrite
<-
NatSet
.
mem_spec
in
x_in_union
;
rewrite
x_in_union
in
*
;
congruence
.
}
{
exists
vR0
,
mR0
;
split
;
auto
;
destruct
iv_sound_val
as
[
E1_v0
iv_sound_val
];
auto
.
}
{
exists
vR0
.
split
;
auto
;
destruct
iv_sound_val
as
[
E1_v0
iv_sound_val
];
auto
.
}
*
intros
v0
v0_fVar
.
assert
(
NatSet
.
mem
v0
(
NatSet
.
add
x
fVars
)
=
true
)
as
v0_in_add
by
(
rewrite
NatSet
.
mem_spec
,
NatSet
.
add_spec
;
rewrite
NatSet
.
mem_spec
in
v0_fVar
;
auto
).
...
...
@@ -237,16 +237,16 @@ Proof.
+
rewrite
<-
NatSet
.
mem_spec
in
v_dVar
.
rewrite
v_dVar
in
case_dVars
.
inversion
case_dVars
.
}
{
rewrite
not_in_add
in
error_valid
;
auto
.
}
*
intros
v0
m2
mem_dVars
.
specialize
(
dVars_sound
v0
m2
).
*
intros
v0
mem_dVars
.
specialize
(
dVars_sound
v0
).
rewrite
absenv_var
in
*
;
simpl
in
*
.
rewrite
NatSet
.
mem_spec
in
mem_dVars
.
assert
(
NatSet
.
In
v0
(
NatSet
.
add
x
dVars
))
as
v0_in_add
.
{
rewrite
NatSet
.
add_spec
.
right
;
auto
.
}
{
rewrite
<-
NatSet
.
mem_spec
in
v0_in_add
.
specialize
(
dVars_sound
v0_in_add
).
destruct
dVars_sound
as
[
vR0
[
mR0
[
val_def
iv_sound_val
]]
]
.
exists
vR0
,
mR0
;
split
;
auto
.
destruct
dVars_sound
as
[
vR0
[
val_def
iv_sound_val
]].
exists
vR0
;
split
;
auto
.
unfold
updEnv
in
val_def
;
simpl
in
val_def
.
case_eq
(
v0
=?
x
);
intros
case_mem
;
rewrite
case_mem
in
val_def
;
simpl
in
val_def
.
...
...
@@ -268,10 +268,10 @@ Proof.
Qed
.
Lemma
validErrorboundCorrectConstant
:
forall
E1
E2
absenv
(
n
:
Q
)
nR
nF
e
nlo
nhi
dVars
m
Gamma
,
eval_exp
E1
(
toREval
(
toRExp
(
Const
m
n
)))
nR
M0
->
eval_exp
E2
(
toRExp
(
Const
m
n
))
nF
m
->
validType
Gamma
(
Const
m
n
)
m
->
forall
E1
E2
absenv
(
n
:
Q
)
nR
nF
e
nlo
nhi
dVars
m
Gamma
defVars
,
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
(
Const
m
n
)))
nR
M0
->
eval_exp
E2
defVars
(
toRExp
(
Const
m
n
))
nF
m
->
typeCheck
(
Const
m
n
)
defVars
Gamma
=
true
->
validErrorbound
(
Const
m
n
)
Gamma
absenv
dVars
=
true
->
(
Q2R
nlo
<=
nR
<=
Q2R
nhi
)
%
R
->
absenv
(
Const
m
n
)
=
((
nlo
,
nhi
),
e
)
->
...
...
@@ -299,20 +299,22 @@ Proof.
-
rewrite
Q2R_mult
in
error_valid
.
rewrite
<-
maxAbs_impl_RmaxAbs
in
error_valid
;
auto
.
inversion
subexpr_ok
;
subst
.
rewrite
H
in
H
6
;
inversio
n
H
6
;
subst
;
auto
.
rewrite
H
in
H
4
.
apply
EquivEqBoolEq
i
n
H
4
;
subst
;
auto
.
Qed
.
Lemma
validErrorboundCorrectAddition
E1
E2
absenv
(
e1
:
exp
Q
)
(
e2
:
exp
Q
)
(
nR
nR1
nR2
nF
nF1
nF2
:
R
)
(
e
err1
err2
:
error
)
(
alo
ahi
e1lo
e1hi
e2lo
e2hi
:
Q
)
dVars
m
m1
m2
Gamma
:
(
alo
ahi
e1lo
e1hi
e2lo
e2hi
:
Q
)
dVars
m
m1
m2
Gamma
defVars
:
m
=
computeJoin
m1
m2
->
eval_exp
E1
(
toREval
(
toRExp
e1
))
nR1
M0
->
eval_exp
E1
(
toREval
(
toRExp
e2
))
nR2
M0
->
eval_exp
E1
(
toREval
(
toRExp
(
Binop
Plus
e1
e2
)))
nR
M0
->
eval_exp
E2
(
toRExp
e1
)
nF1
m1
->
eval_exp
E2
(
toRExp
e2
)
nF2
m2
->
eval_exp
(
updEnv
2
m2
nF2
(
updEnv
1
m1
nF1
emptyEnv
))
(
toRExp
(
Binop
Plus
(
Var
Q
m1
1
)
(
Var
Q
m2
2
)))
nF
m
->
validType
Gamma
(
Binop
Plus
e1
e2
)
m
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e1
))
nR1
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e2
))
nR2
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
(
Binop
Plus
e1
e2
)))
nR
M0
->
eval_exp
E2
defVars
(
toRExp
e1
)
nF1
m1
->
eval_exp
E2
defVars
(
toRExp
e2
)
nF2
m2
->
eval_exp
(
updEnv
2
nF2
(
updEnv
1
nF1
emptyEnv
))
(
fun
n
=>
if
(
n
=?
2
)
then
Some
m2
else
if
(
n
=?
1
)
then
Some
m1
else
defVars
n
)
(
toRExp
(
Binop
Plus
(
Var
Q
1
)
(
Var
Q
2
)))
nF
m
->
typeCheck
(
Binop
Plus
e1
e2
)
defVars
Gamma
=
true
->
validErrorbound
(
Binop
Plus
e1
e2
)
Gamma
absenv
dVars
=
true
->
(
Q2R
e1lo
<=
nR1
<=
Q2R
e1hi
)
%
R
->
(
Q2R
e2lo
<=
nR2
<=
Q2R
e2hi
)
%
R
->
...
...
@@ -333,9 +335,17 @@ Proof.
unfold
validErrorbound
in
valid_error
.
rewrite
absenv_add
,
absenv_e1
,
absenv_e2
in
valid_error
.
case_eq
(
Gamma
(
Binop
Plus
e1
e2
));
intros
;
rewrite
H
in
valid_error
;
[
|
inversion
valid_error
].
inversion
subexpr_ok
;
subst
.
rewrite
H
in
H7
;
inversion
H7
;
subst
.
clear
m4
m5
H3
H4
H7
H6
.
simpl
in
subexpr_ok
;
rewrite
H
in
subexpr_ok
.
case_eq
(
Gamma
e1
);
intros
;
rewrite
H0
in
subexpr_ok
;
[
|
inversion
subexpr_ok
].
case_eq
(
Gamma
e2
);
intros
;
rewrite
H1
in
subexpr_ok
;
[
|
inversion
subexpr_ok
].
andb_to_prop
subexpr_ok
.
apply
EquivEqBoolEq
in
L0
;
subst
.
pose
proof
(
typingSoundnessExp
_
_
R0
e1_float
).
pose
proof
(
typingSoundnessExp
_
_
R
e2_float
).
rewrite
H0
in
H2
;
rewrite
H1
in
H3
;
inversion
H2
;
inversion
H3
;
subst
.
clear
H2
H3
H0
H1
.
andb_to_prop
valid_error
.
rename
R
0
into
valid_error
.
rename
R
2
into
valid_error
.
eapply
Rle_trans
.
apply
Rplus_le_compat_l
.
eapply
Rmult_le_compat_r
.
...
...
@@ -378,15 +388,17 @@ Qed.
Lemma
validErrorboundCorrectSubtraction
E1
E2
absenv
(
e1
:
exp
Q
)
(
e2
:
exp
Q
)
(
nR
nR1
nR2
nF
nF1
nF2
:
R
)
(
e
err1
err2
:
error
)
(
alo
ahi
e1lo
e1hi
e2lo
e2hi
:
Q
)
dVars
(
m
m1
m2
:
mType
)
Gamma
:
(
alo
ahi
e1lo
e1hi
e2lo
e2hi
:
Q
)
dVars
(
m
m1
m2
:
mType
)
Gamma
defVars
:
m
=
computeJoin
m1
m2
->
eval_exp
E1
(
toREval
(
toRExp
e1
))
nR1
M0
->
eval_exp
E1
(
toREval
(
toRExp
e2
))
nR2
M0
->
eval_exp
E1
(
toREval
(
toRExp
(
Binop
Sub
e1
e2
)))
nR
M0
->
eval_exp
E2
(
toRExp
e1
)
nF1
m1
->
eval_exp
E2
(
toRExp
e2
)
nF2
m2
->
eval_exp
(
updEnv
2
m2
nF2
(
updEnv
1
m1
nF1
emptyEnv
))
(
toRExp
(
Binop
Sub
(
Var
Q
m1
1
)
(
Var
Q
m2
2
)))
nF
m
->
validType
Gamma
(
Binop
Sub
e1
e2
)
m
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e1
))
nR1
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e2
))
nR2
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
(
Binop
Sub
e1
e2
)))
nR
M0
->
eval_exp
E2
defVars
(
toRExp
e1
)
nF1
m1
->
eval_exp
E2
defVars
(
toRExp
e2
)
nF2
m2
->
eval_exp
(
updEnv
2
nF2
(
updEnv
1
nF1
emptyEnv
))
(
fun
n
=>
if
(
n
=?
2
)
then
Some
m2
else
if
(
n
=?
1
)
then
Some
m1
else
defVars
n
)
(
toRExp
(
Binop
Sub
(
Var
Q
1
)
(
Var
Q
2
)))
nF
m
->
typeCheck
(
Binop
Sub
e1
e2
)
defVars
Gamma
=
true
->
validErrorbound
(
Binop
Sub
e1
e2
)
Gamma
absenv
dVars
=
true
->
(
Q2R
e1lo
<=
nR1
<=
Q2R
e1hi
)
%
R
->
(
Q2R
e2lo
<=
nR2
<=
Q2R
e2hi
)
%
R
->
...
...
@@ -405,9 +417,17 @@ Proof.
unfold
validErrorbound
in
valid_error
.
rewrite
absenv_sub
,
absenv_e1
,
absenv_e2
in
valid_error
.
case_eq
(
Gamma
(
Binop
Sub
e1
e2
));
intros
;
rewrite
H
in
valid_error
;
[
|
inversion
valid_error
].
inversion
subexpr_ok
;
subst
.
rewrite
H
in
H7
;
inversion
H7
;
subst
.
clear
m4
m5
H3
H4
H7
H6
.
simpl
in
subexpr_ok
;
rewrite
H
in
subexpr_ok
.
case_eq
(
Gamma
e1
);
intros
;
rewrite
H0
in
subexpr_ok
;
[
|
inversion
subexpr_ok
].
case_eq
(
Gamma
e2
);
intros
;
rewrite
H1
in
subexpr_ok
;
[
|
inversion
subexpr_ok
].
andb_to_prop
subexpr_ok
.
apply
EquivEqBoolEq
in
L0
;
subst
.
pose
proof
(
typingSoundnessExp
_
_
R0
e1_float
).
pose
proof
(
typingSoundnessExp
_
_
R
e2_float
).
rewrite
H0
in
H2
;
rewrite
H1
in
H3
;
inversion
H2
;
inversion
H3
;
subst
.
clear
H2
H3
H0
H1
.
andb_to_prop
valid_error
.
rename
R
0
into
valid_error
.
rename
R
2
into
valid_error
.
apply
Qle_bool_iff
in
valid_error
.
apply
Qle_Rle
in
valid_error
.
repeat
rewrite
Q2R_plus
in
valid_error
.
...
...
@@ -455,15 +475,17 @@ Qed.
Lemma
validErrorboundCorrectMult
E1
E2
absenv
(
e1
:
exp
Q
)
(
e2
:
exp
Q
)
(
nR
nR1
nR2
nF
nF1
nF2
:
R
)
(
e
err1
err2
:
error
)
(
alo
ahi
e1lo
e1hi
e2lo
e2hi
:
Q
)
dVars
(
m
m1
m2
:
mType
)
Gamma
:
(
alo
ahi
e1lo
e1hi
e2lo
e2hi
:
Q
)
dVars
(
m
m1
m2
:
mType
)
Gamma
defVars
:
m
=
computeJoin
m1
m2
->
eval_exp
E1
(
toREval
(
toRExp
e1
))
nR1
M0
->
eval_exp
E1
(
toREval
(
toRExp
e2
))
nR2
M0
->
eval_exp
E1
(
toREval
(
toRExp
(
Binop
Mult
e1
e2
)))
nR
M0
->
eval_exp
E2
(
toRExp
e1
)
nF1
m1
->
eval_exp
E2
(
toRExp
e2
)
nF2
m2
->
eval_exp
(
updEnv
2
m2
nF2
(
updEnv
1
m1
nF1
emptyEnv
))
(
toRExp
(
Binop
Mult
(
Var
Q
m1
1
)
(
Var
Q
m2
2
)))
nF
m
->
validType
Gamma
(
Binop
Mult
e1
e2
)
m
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e1
))
nR1
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e2
))
nR2
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
(
Binop
Mult
e1
e2
)))
nR
M0
->
eval_exp
E2
defVars
(
toRExp
e1
)
nF1
m1
->
eval_exp
E2
defVars
(
toRExp
e2
)
nF2
m2
->
eval_exp
(
updEnv
2
nF2
(
updEnv
1
nF1
emptyEnv
))
(
fun
n
=>
if
(
n
=?
2
)
then
Some
m2
else
if
(
n
=?
1
)
then
Some
m1
else
defVars
n
)
(
toRExp
(
Binop
Mult
(
Var
Q
1
)
(
Var
Q
2
)))
nF
m
->
typeCheck
(
Binop
Mult
e1
e2
)
defVars
Gamma
=
true
->
validErrorbound
(
Binop
Mult
e1
e2
)
Gamma
absenv
dVars
=
true
->
(
Q2R
e1lo
<=
nR1
<=
Q2R
e1hi
)
%
R
->
(
Q2R
e2lo
<=
nR2
<=
Q2R
e2hi
)
%
R
->
...
...
@@ -482,9 +504,17 @@ Proof.
unfold
validErrorbound
in
valid_error
.
rewrite
absenv_mult
,
absenv_e1
,
absenv_e2
in
valid_error
.
case_eq
(
Gamma
(
Binop
Mult
e1
e2
));
intros
;
rewrite
H
in
valid_error
;
[
|
inversion
valid_error
].
inversion
subexpr_ok
;
subst
.
rewrite
H
in
H7
;
inversion
H7
;
subst
.
clear
m4
m5
H3
H4
H7
H6
.
simpl
in
subexpr_ok
;
rewrite
H
in
subexpr_ok
.
case_eq
(
Gamma
e1
);
intros
;
rewrite
H0
in
subexpr_ok
;
[
|
inversion
subexpr_ok
].
case_eq
(
Gamma
e2
);
intros
;
rewrite
H1
in
subexpr_ok
;
[
|
inversion
subexpr_ok
].
andb_to_prop
subexpr_ok
.
apply
EquivEqBoolEq
in
L0
;
subst
.
pose
proof
(
typingSoundnessExp
_
_
R0
e1_float
).
pose
proof
(
typingSoundnessExp
_
_
R
e2_float
).
rewrite
H0
in
H2
;
rewrite
H1
in
H3
;
inversion
H2
;
inversion
H3
;
subst
.
clear
H2
H3
H0
H1
.
andb_to_prop
valid_error
.
rename
R
0
into
valid_error
.
rename
R
2
into
valid_error
.
assert
(
0
<=
Q2R
err1
)
%
R
as
err1_pos
by
(
eapply
(
err_always_positive
e1
Gamma
absenv
dVars
);
eauto
).
assert
(
0
<=
Q2R
err2
)
%
R
as
err2_pos
by
(
eapply
(
err_always_positive
e2
Gamma
absenv
dVars
);
eauto
).
clear
R
L1
.
...
...
@@ -985,15 +1015,17 @@ Qed.
Lemma
validErrorboundCorrectDiv
E1
E2
absenv
(
e1
:
exp
Q
)
(
e2
:
exp
Q
)
(
nR
nR1
nR2
nF
nF1
nF2
:
R
)
(
e
err1
err2
:
error
)
(
alo
ahi
e1lo
e1hi
e2lo
e2hi
:
Q
)
dVars
(
m
m1
m2
:
mType
)
Gamma
:
(
alo
ahi
e1lo
e1hi
e2lo
e2hi
:
Q
)
dVars
(
m
m1
m2
:
mType
)
Gamma
defVars
:
m
=
computeJoin
m1
m2
->
eval_exp
E1
(
toREval
(
toRExp
e1
))
nR1
M0
->
eval_exp
E1
(
toREval
(
toRExp
e2
))
nR2
M0
->
eval_exp
E1
(
toREval
(
toRExp
(
Binop
Div
e1
e2
)))
nR
M0
->
eval_exp
E2
(
toRExp
e1
)
nF1
m1
->
eval_exp
E2
(
toRExp
e2
)
nF2
m2
->
eval_exp
(
updEnv
2
m2
nF2
(
updEnv
1
m1
nF1
emptyEnv
))
(
toRExp
(
Binop
Div
(
Var
Q
m1
1
)
(
Var
Q
m2
2
)))
nF
m
->
validType
Gamma
(
Binop
Div
e1
e2
)
m
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e1
))
nR1
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
e2
))
nR2
M0
->
eval_exp
E1
(
toREvalVars
defVars
)
(
toREval
(
toRExp
(
Binop
Div
e1
e2
)))
nR
M0
->
eval_exp
E2
defVars
(
toRExp
e1
)
nF1
m1
->
eval_exp
E2
defVars
(
toRExp
e2
)
nF2
m2
->
eval_exp
(
updEnv
2
nF2
(
updEnv
1
nF1
emptyEnv
))
(
fun
n
=>
if
(
n
=?
2
)
then
Some
m2
else
if
(
n
=?
1
)
then
Some
m1
else
defVars
n
)
(
toRExp
(
Binop
Div
(
Var
Q
1
)
(
Var
Q
2
)))
nF
m
->
typeCheck
(
Binop
Div
e1
e2
)
defVars
Gamma
=
true
->
validErrorbound
(
Binop
Div
e1
e2
)
Gamma
absenv
dVars
=
true
->
(
Q2R
e1lo
<=
nR1
<=
Q2R
e1hi
)
%
R
->
(
Q2R
e2lo
<=
nR2
<=
Q2R
e2hi
)
%
R
->
...
...
@@ -1013,13 +1045,17 @@ Proof.
unfold
validErrorbound
in
valid_error
.
rewrite
absenv_div
,
absenv_e1
,
absenv_e2
in
valid_error
.
case_eq
(
Gamma
(
Binop
Div
e1
e2
));
intros
;
rewrite
H
in
valid_error
;
[
|
inversion
valid_error
].
inversion
subexpr_ok
;
subst
.
rewrite
H
in
H7
;
inversion
H7
;
subst
.
clear
m4
m5
H3
H4
H7
H6
.
rename
H
into
type_binop
.
simpl
in
subexpr_ok
;
rewrite
H
in
subexpr_ok
.
case_eq
(
Gamma
e1
);
intros
;
rewrite
H0
in
subexpr_ok
;
[
|
inversion
subexpr_ok
].
case_eq
(
Gamma
e2
);
intros
;
rewrite
H1
in
subexpr_ok
;
[
|
inversion
subexpr_ok
].
andb_to_prop
subexpr_ok
.
apply
EquivEqBoolEq
in
L0
;
subst
.
pose
proof
(
typingSoundnessExp
_
_
R0
e1_float
).
pose
proof
(
typingSoundnessExp
_
_
R
e2_float
).
rewrite
H0
in
H2
;
rewrite
H1
in
H3
;
inversion
H2
;
inversion
H3
;
subst
.
clear
H2
H3
H0
H1
.
andb_to_prop
valid_error
.
assert
(
validErrorbound
e1
Gamma
absenv
dVars
=
true
)
as
valid_err_e1
by
auto
;
assert
(
validErrorbound
e2
Gamma
absenv
dVars
=
true
)
as
valid_err_e2
by
auto
.
clear
L1
R
.
rename
R1
into
valid_error
.
rename
R3
into
valid_error
.
rename
L0
into
no_div_zero_float
.
assert
(
contained
nR1
(
Q2R
e1lo
,
Q2R
e1hi
))
as
contained_intv1
by
auto
.
pose
proof
(
distance_gives_iv
(
a
:=
nR1
)
_
contained_intv1
err1_bounded
).
...
...
@@ -1050,7 +1086,7 @@ Proof.
(
*
Error
Propagation
proof
*
)