Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
AVA
FloVer
Commits
ea7e921d
Commit
ea7e921d
authored
Nov 17, 2017
by
Heiko Becker
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
WIP: Port to finite maps in Coq
parent
5beeaad7
Changes
7
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
500 additions
and
722 deletions
+500
-722
coq/CertificateChecker.v
coq/CertificateChecker.v
+45
-52
coq/ErrorValidation.v
coq/ErrorValidation.v
+250
-364
coq/Expressions.v
coq/Expressions.v
+6
-16
coq/FPRangeValidator.v
coq/FPRangeValidator.v
+99
-145
coq/IEEE_connection.v
coq/IEEE_connection.v
+66
-137
coq/Infra/Ltacs.v
coq/Infra/Ltacs.v
+32
-6
coq/daisyParser.v
coq/daisyParser.v
+2
-2
No files found.
coq/CertificateChecker.v
View file @
ea7e921d
...
...
@@ -13,9 +13,11 @@ Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Commands.
(
**
Certificate
checking
function
**
)
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
)
&&
FPRangeValidator
e
absenv
(
typeMap
defVars
e
)
NatSet
.
empty
then
(
validErrorbound
e
(
typeMap
defVars
e
)
absenv
NatSet
.
empty
)
let
tMap
:=
(
typeMap
defVars
e
(
DaisyMap
.
empty
mType
))
in
if
(
typeCheck
e
defVars
tMap
)
then
if
(
validIntervalbounds
e
absenv
P
NatSet
.
empty
)
&&
FPRangeValidator
e
absenv
tMap
NatSet
.
empty
then
(
validErrorbound
e
tMap
absenv
NatSet
.
empty
)
else
false
else
false
.
...
...
@@ -27,19 +29,20 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (def
Theorem
Certificate_checking_is_sound
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
P
defVars
:
forall
(
E1
E2
:
env
),
approxEnv
E1
defVars
absenv
(
usedVars
e
)
NatSet
.
empty
E2
->
(
forall
v
,
NatSet
.
mem
v
(
Expressions
.
usedVars
e
)
=
true
->
(
forall
v
,
NatSet
.
In
v
(
Expressions
.
usedVars
e
)
->
exists
vR
,
E1
v
=
Some
vR
/
\
(
Q2R
(
fst
(
P
v
))
<=
vR
<=
Q2R
(
snd
(
P
v
)))
%
R
)
->
(
forall
v
,
(
v
)
mem
(
usedVars
e
)
=
true
->
(
forall
v
,
NatSet
.
In
v
(
usedVars
e
)
->
exists
m
:
mType
,
defVars
v
=
Some
m
)
->
CertificateChecker
e
absenv
P
defVars
=
true
->
exists
vR
vF
m
,
eval_exp
E1
(
toRMap
defVars
)
(
toREval
(
toRExp
e
))
vR
M0
/
\
eval_exp
E2
defVars
(
toRExp
e
)
vF
m
/
\
(
forall
vF
m
,
eval_exp
E2
defVars
(
toRExp
e
)
vF
m
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
(
snd
(
absenv
e
))))
%
R
.
exists
iv
err
vR
vF
m
,
DaisyMap
.
find
e
absenv
=
Some
(
iv
,
err
)
/
\
eval_exp
E1
(
toRMap
defVars
)
(
toREval
(
toRExp
e
))
vR
M0
/
\
eval_exp
E2
defVars
(
toRExp
e
)
vF
m
/
\
(
forall
vF
m
,
eval_exp
E2
defVars
(
toRExp
e
)
vF
m
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
err
))
%
R
.
(
**
The
proofs
is
a
simple
composition
of
the
soundness
proofs
for
the
range
validator
and
the
error
bound
validator
.
...
...
@@ -49,55 +52,52 @@ Proof.
unfold
CertificateChecker
in
certificate_valid
.
rewrite
<-
andb_lazy_alt
in
certificate_valid
.
andb_to_prop
certificate_valid
.
env_assert
absenv
e
env_e
.
destruct
env_e
as
[
iv
[
err
absenv_eq
]].
destruct
iv
as
[
ivlo
ivhi
].
rewrite
absenv_eq
;
simpl
.
pose
proof
(
NatSetProps
.
empty_union_2
(
Expressions
.
usedVars
e
)
NatSet
.
empty_spec
)
as
union_empty
.
hnf
in
union_empty
.
assert
(
forall
v1
,
(
v1
)
mem
(
Expressions
.
usedVars
e
∪
NatSet
.
empty
)
=
true
->
exists
m0
:
mType
,
defVars
v1
=
Some
m0
).
{
intros
;
eapply
types_defined
.
rewrite
NatSet
.
mem_spec
in
*
.
rewrite
<-
union_empty
;
eauto
.
}
assert
(
dVars_range_valid
NatSet
.
empty
E1
absenv
).
{
unfold
dVars_range_valid
.
intros
;
set_tac
.
}
assert
(
NatSet
.
Subset
(
usedVars
e
--
NatSet
.
empty
)
(
Expressions
.
usedVars
e
)).
{
hnf
;
intros
a
in_empty
.
set_tac
.
}
assert
(
vars_typed
(
usedVars
e
∪
NatSet
.
empty
)
defVars
).
{
unfold
vars_typed
.
intros
;
apply
types_defined
.
set_tac
.
destruct
H1
;
set_tac
.
split
;
try
auto
.
hnf
;
intros
;
set_tac
.
}
rename
R
into
validFPRanges
.
assert
(
forall
v
,
(
v
)
mem
(
NatSet
.
empty
)
=
true
->
exists
vR
:
R
,
E1
v
=
Some
vR
/
\
(
Q2R
(
fst
(
fst
(
absenv
(
Var
Q
v
))))
<=
vR
<=
Q2R
(
snd
(
fst
(
absenv
(
Var
Q
v
)))))
%
R
).
{
intros
v
v_in_empty
.
rewrite
NatSet
.
mem_spec
in
v_in_empty
.
inversion
v_in_empty
.
}
edestruct
validIntervalbounds_sound
as
[
vR
[
eval_real
real_bounds_e
]];
eauto
.
destruct
(
validErrorbound_sound
e
P
(
typeMap
defVars
e
)
L
approxE1E2
H0
eval_real
R0
L1
H1
P_valid
H
absenv_eq
)
as
[[
vF
[
mF
eval_float
]]
err_bounded
];
auto
.
exists
vR
;
exists
vF
;
exists
mF
;
split
;
auto
.
edestruct
(
validIntervalbounds_sound
e
(
A
:=
absenv
)
(
P
:=
P
)
(
fVars
:=
usedVars
e
)
(
dVars
:=
NatSet
.
empty
)
(
Gamma
:=
defVars
)
(
E
:=
E1
))
as
[
iv_e
[
err_e
[
vR
[
map_e
[
eval_real
real_bounds_e
]]]]];
eauto
.
destruct
iv_e
as
[
elo
ehi
].
edestruct
(
validErrorbound_sound
e
(
typeMap
defVars
e
(
DaisyMap
.
empty
mType
))
L
approxE1E2
H0
eval_real
R0
L1
H
P_valid
H1
map_e
)
as
[[
vF
[
mF
eval_float
]]
err_bounded
];
auto
.
exists
(
elo
,
ehi
),
err_e
,
vR
,
vF
,
mF
;
split
;
auto
.
Qed
.
Definition
CertificateCheckerCmd
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
defVars
:=
if
(
typeCheckCmd
f
defVars
(
typeMapCmd
defVars
f
)
&&
validSSA
f
(
freeVars
f
))
let
tMap
:=
typeMapCmd
defVars
f
(
DaisyMap
.
empty
mType
)
in
if
(
typeCheckCmd
f
defVars
tMap
&&
validSSA
f
(
freeVars
f
))
then
if
(
validIntervalboundsCmd
f
absenv
P
NatSet
.
empty
)
&&
FPRangeValidatorCmd
f
absenv
(
typeMapCmd
defVars
f
)
NatSet
.
empty
then
(
validErrorboundCmd
f
(
typeMapCmd
defVars
f
)
absenv
NatSet
.
empty
)
FPRangeValidatorCmd
f
absenv
tMap
NatSet
.
empty
then
(
validErrorboundCmd
f
tMap
absenv
NatSet
.
empty
)
else
false
else
false
.
Theorem
Certificate_checking_cmds_is_sound
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
P
defVars
:
forall
(
E1
E2
:
env
),
approxEnv
E1
defVars
absenv
(
freeVars
f
)
NatSet
.
empty
E2
->
(
forall
v
,
NatSet
.
mem
v
(
freeVars
f
)
=
true
->
(
forall
v
,
NatSet
.
In
v
(
freeVars
f
)
->
exists
vR
,
E1
v
=
Some
vR
/
\
(
Q2R
(
fst
(
P
v
))
<=
vR
<=
Q2R
(
snd
(
P
v
)))
%
R
)
->
(
forall
v
,
(
v
)
mem
(
freeVars
f
)
=
true
->
(
forall
v
,
NatSet
.
In
v
(
freeVars
f
)
->
exists
m
:
mType
,
defVars
v
=
Some
m
)
->
CertificateCheckerCmd
f
absenv
P
defVars
=
true
->
exists
vR
vF
m
,
exists
iv
err
vR
vF
m
,
DaisyMap
.
find
(
getRetExp
f
)
absenv
=
Some
(
iv
,
err
)
/
\
bstep
(
toREvalCmd
(
toRCmd
f
))
E1
(
toRMap
defVars
)
vR
M0
/
\
bstep
(
toRCmd
f
)
E2
defVars
vF
m
/
\
(
forall
vF
m
,
bstep
(
toRCmd
f
)
E2
defVars
vF
m
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
(
snd
(
absenv
(
getRetExp
f
))
))
%
R
).
(
Rabs
(
vR
-
vF
)
<=
Q2R
(
err
))
%
R
).
(
**
The
proofs
is
a
simple
composition
of
the
soundness
proofs
for
the
range
validator
and
the
error
bound
validator
.
...
...
@@ -109,32 +109,25 @@ Proof.
andb_to_prop
certificate_valid
.
apply
validSSA_sound
in
R0
.
destruct
R0
as
[
outVars
ssa_f
].
env_assert
absenv
(
getRetExp
f
)
env_f
.
destruct
env_f
as
[
iv
[
err
absenv_eq
]].
destruct
iv
as
[
ivlo
ivhi
].
assert
(
ssa
f
(
freeVars
f
∪
NatSet
.
empty
)
outVars
)
as
ssa_valid
.
{
eapply
ssa_equal_set
;
try
eauto
.
apply
NatSetProps
.
empty_union_2
.
apply
NatSet
.
empty_spec
.
}
rename
R
into
validFPRanges
.
assert
(
forall
v
,
(
v
)
mem
(
NatSet
.
empty
)
=
true
->
exists
vR
:
R
,
E1
v
=
Some
vR
/
\
(
Q2R
(
fst
(
fst
(
absenv
(
Var
Q
v
))))
<=
vR
<=
Q2R
(
snd
(
fst
(
absenv
(
Var
Q
v
)))))
%
R
)
as
no_dVars_valid
.
{
intros
v
v_in_empty
.
set_tac
.
inversion
v_in_empty
.
}
assert
(
forall
v
,
(
v
)
mem
(
freeVars
f
∪
NatSet
.
empty
)
=
true
->
exists
m
:
mType
,
defVars
v
=
Some
m
)
as
types_valid
.
{
intros
v
v_mem
;
apply
types_defined
.
set_tac
.
rewrite
NatSet
.
union_spec
in
v_mem
.
destruct
v_mem
;
try
auto
.
inversion
H
.
}
assert
(
dVars_range_valid
NatSet
.
empty
E1
absenv
).
{
unfold
dVars_range_valid
.
intros
;
set_tac
.
}
assert
(
vars_typed
(
freeVars
f
∪
NatSet
.
empty
)
defVars
).
{
unfold
vars_typed
.
intros
;
apply
types_defined
.
set_tac
.
destruct
H0
;
set_tac
.
}
assert
(
NatSet
.
Subset
(
freeVars
f
--
NatSet
.
empty
)
(
freeVars
f
))
as
freeVars_contained
by
set_tac
.
edestruct
(
validIntervalboundsCmd_sound
)
as
[
vR
[
eval_real
bounded_real_f
]]
;
eauto
.
rewrite
absenv_eq
;
simpl
.
edestruct
(
validIntervalboundsCmd_sound
)
as
[
iv
[
err
[
vR
[
map_f
[
eval_real
bounded_real_f
]]]]];
eauto
.
destruct
iv
as
[
f_lo
f_hi
].
edestruct
validErrorboundCmd_gives_eval
as
[
vF
[
mF
eval_float
]];
eauto
.
exists
vR
;
exists
vF
;
exists
mF
;
split
;
try
auto
.
split
;
try
auto
.
exists
(
f_lo
,
f_hi
),
err
,
vR
,
vF
,
mF
;
split
;
try
auto
.
split
;
try
auto
;
split
;
try
auto
.
intros
.
eapply
validErrorboundCmd_sound
;
eauto
.
Qed
.
\ No newline at end of file
coq/ErrorValidation.v
View file @
ea7e921d
This diff is collapsed.
Click to expand it.
coq/Expressions.v
View file @
ea7e921d
...
...
@@ -168,29 +168,19 @@ Lemma expEq_trans e f g:
Proof
.
revert
e
f
g
;
induction
e
;
destruct
f
;
intros
g
eq1
eq2
;
destruct
g
;
simpl
in
*
;
try
congruence
;
destruct
g
;
cbn
in
*
;
try
rewrite
Nat
.
eqb_eq
in
*
;
subst
;
try
auto
.
-
andb_to_prop
eq1
;
andb_to_prop
eq2
.
rewrite
mTypeEq_compat_eq
in
L
,
L0
;
subst
.
rewrite
mTypeEq_refl
;
simpl
.
Daisy_compute
;
try
congruence
;
type_conv
;
subst
;
try
auto
.
-
rewrite
mTypeEq_refl
;
simpl
.
rewrite
Qeq_bool_iff
in
*
;
lra
.
-
andb_to_prop
eq1
;
andb_to_prop
eq2
.
rewrite
unopEq_compat_eq
in
*
;
subst
.
-
rewrite
unopEq_compat_eq
in
*
;
subst
.
rewrite
unopEq_refl
;
simpl
.
eapply
IHe
;
eauto
.
-
andb_to_prop
eq1
;
andb_to_prop
eq2
.
rewrite
binopEq_compat_eq
in
*
;
subst
.
-
rewrite
binopEq_compat_eq
in
*
;
subst
.
rewrite
binopEq_refl
;
simpl
.
apply
andb_true_iff
.
split
;
[
eapply
IHe1
;
eauto
|
eapply
IHe2
;
eauto
].
-
andb_to_prop
eq1
;
andb_to_prop
eq2
.
rewrite
mTypeEq_compat_eq
in
*
;
subst
.
rewrite
mTypeEq_refl
;
simpl
.
-
rewrite
mTypeEq_refl
;
simpl
.
eapply
IHe
;
eauto
.
Qed
.
...
...
coq/FPRangeValidator.v
View file @
ea7e921d
...
...
@@ -6,40 +6,40 @@ Require Import Coq.QArith.QArith Coq.QArith.Qreals Coq.Reals.Reals Coq.micromega
Require
Import
Daisy
.
Infra
.
MachineType
Daisy
.
Typing
Daisy
.
Infra
.
RealSimps
Daisy
.
IntervalValidation
Daisy
.
ErrorValidation
Daisy
.
Commands
Daisy
.
Environments
Daisy
.
ssaPrgs
Daisy
.
Infra
.
Ltacs
Daisy
.
Infra
.
RealRationalProps
.
Fixpoint
FPRangeValidator
(
e
:
exp
Q
)
(
A
:
analysisResult
)
typeMap
dVars
{
struct
e
}
:
bool
:=
match
typeMap
e
with
|
Some
m
=>
let
(
iv_e
,
err_e
)
:=
A
e
in
let
iv_e_float
:=
widenIntv
iv_e
err_e
in
let
recRes
:=
match
e
with
|
Binop
b
e1
e2
=>
FPRangeValidator
e
1
A
typeMap
dVars
&&
FPRangeValidator
e2
A
typeMap
dVars
|
Unop
u
e
=>
FPRangeValidator
e
A
typeMap
dVars
|
Downcast
m
e
=>
FPRangeValidator
e
A
typeMap
dVars
|
_
=>
true
end
in
match
e
with
|
Var
_
v
=>
if
NatSet
.
mem
v
dVars
then
tru
e
else
if
(
validValue
(
iv
hi
iv_e_float
)
m
&&
validValue
(
ivlo
iv_e_float
)
m
)
then
(
(
normal
(
iv
lo
iv_e_float
)
m
)
||
(
Qeq_bool
(
iv
lo
iv_e_float
)
0
))
&&
(
normal
(
ivhi
iv_e_float
)
m
||
(
Qeq_bool
(
ivhi
iv_e_float
)
0
))
&&
recRes
else
false
|
_
=>
if
(
validValue
(
ivhi
iv_e_float
)
m
&&
validValue
(
ivlo
iv_e_float
)
m
)
then
((
normal
(
ivlo
iv_e_float
)
m
)
||
(
Qeq_bool
(
ivlo
iv_e_float
)
0
))
&&
(
normal
(
ivhi
iv_e_float
)
m
||
(
Qeq_bool
(
ivhi
iv_e_float
)
0
))
&&
recRes
else
false
end
|
None
=>
false
match
DaisyMap
.
find
e
typeMap
,
DaisyMap
.
find
e
A
with
|
Some
m
,
Some
(
iv_e
,
err_e
)
=>
let
iv_e_float
:=
widenIntv
iv_e
err_e
in
let
recRes
:=
match
e
with
|
Binop
b
e1
e2
=>
FPRangeValidator
e1
A
typeMap
dVars
&&
FPRangeValidator
e
2
A
typeMap
dVars
|
Unop
u
e
=>
FPRangeValidator
e
A
typeMap
dVars
|
Downcast
m
e
=>
FPRangeValidator
e
A
typeMap
dVars
|
_
=>
true
end
in
match
e
with
|
Var
_
v
=>
if
NatSet
.
mem
v
dVars
then
true
els
e
if
(
validValue
(
ivhi
iv_e_float
)
m
&&
validValue
(
iv
lo
iv_e_float
)
m
)
then
((
normal
(
ivlo
iv_e_float
)
m
)
||
(
Qeq_bool
(
ivlo
iv_e_float
)
0
))
&&
(
normal
(
iv
hi
iv_e_float
)
m
||
(
Qeq_bool
(
iv
hi
iv_e_float
)
0
))
&&
recRes
else
false
|
_
=>
if
(
validValue
(
ivhi
iv_e_float
)
m
&&
validValue
(
ivlo
iv_e_float
)
m
)
then
((
normal
(
ivlo
iv_e_float
)
m
)
||
(
Qeq_bool
(
ivlo
iv_e_float
)
0
))
&&
(
normal
(
ivhi
iv_e_float
)
m
||
(
Qeq_bool
(
ivhi
iv_e_float
)
0
))
&&
recRes
else
false
end
|
_
,
_
=>
false
end
.
Fixpoint
FPRangeValidatorCmd
(
f
:
cmd
Q
)
(
A
:
analysisResult
)
typeMap
dVars
:=
...
...
@@ -77,77 +77,54 @@ Theorem FPRangeValidator_sound:
validErrorbound
e
tMap
A
dVars
=
true
->
FPRangeValidator
e
A
tMap
dVars
=
true
->
NatSet
.
Subset
(
NatSet
.
diff
(
usedVars
e
)
dVars
)
fVars
->
(
forall
v
,
NatSet
.
In
v
fVars
->
exists
vR
,
E1
v
=
Some
vR
/
\
Q2R
(
fst
(
P
v
))
<=
vR
<=
Q2R
(
snd
(
P
v
)))
%
R
->
(
forall
v
,
NatSet
.
In
v
fVars
\
/
NatSet
.
In
v
dVars
->
exists
m
,
Gamma
v
=
Some
m
)
->
(
forall
v
,
NatSet
.
In
v
dVars
->
exists
vR
,
E1
v
=
Some
vR
/
\
Q2R
(
fst
(
fst
(
A
(
Var
Q
v
))))
<=
vR
<=
Q2R
(
snd
(
fst
(
A
(
Var
Q
v
)))))
%
R
->
(
forall
v
,
NatSet
.
In
v
dVars
->
exists
vF
m
,
E2
v
=
Some
vF
/
\
tMap
(
Var
Q
v
)
=
Some
m
/
\
validFloatValue
vF
m
)
->
dVars_range_valid
dVars
E1
A
->
fVars_P_sound
fVars
E1
P
->
vars_typed
(
NatSet
.
union
fVars
dVars
)
Gamma
->
(
forall
v
,
NatSet
.
In
v
dVars
->
exists
vF
m
,
E2
v
=
Some
vF
/
\
DaisyMap
.
find
(
Var
Q
v
)
tMap
=
Some
m
/
\
validFloatValue
vF
m
)
->
validFloatValue
v
m
.
Proof
.
intros
*
.
unfold
FPRangeValidator
.
intros
.
destruct
(
A
e
)
as
[
iv_e
err_e
]
eqn
:?
;
destruct
iv_e
as
[
e_lo
e_hi
]
eqn
:?
;
simpl
in
*
.
assert
(
tMap
e
=
Some
m
)
assert
(
DaisyMap
.
find
e
tMap
=
Some
m
)
as
type_e
by
(
eapply
typingSoundnessExp
;
eauto
).
subst
;
simpl
in
*
.
unfold
validFloatValue
.
assert
(
exists
vR
,
eval_exp
E1
(
toRMap
Gamma
)
(
toREval
(
toRExp
e
))
vR
M0
/
\
Q2R
(
fst
(
fst
(
A
e
)))
<=
vR
<=
Q2R
(
snd
(
fst
(
A
e
))))
%
R
as
eval_real_exists
.
{
eapply
validIntervalbounds_sound
;
eauto
.
-
intros
;
apply
H8
.
rewrite
<-
NatSet
.
mem_spec
;
auto
.
-
intros
.
apply
H6
.
rewrite
<-
NatSet
.
mem_spec
;
auto
.
-
intros
.
apply
H7
.
set_tac
.
rewrite
<-
NatSet
.
union_spec
;
auto
.
}
destruct
eval_real_exists
as
[
vR
[
eval_real
vR_bounded
]].
assert
(
Rabs
(
vR
-
v
)
<=
Q2R
(
snd
(
A
e
)))
%
R
.
{
eapply
validErrorbound_sound
;
eauto
.
-
intros
*
v1_dVar
.
apply
H8
;
set_tac
.
-
intros
*
v0_fVar
.
apply
H6
.
rewrite
<-
NatSet
.
mem_spec
;
auto
.
-
intros
*
v1_in_union
.
apply
H7
;
set_tac
.
rewrite
NatSet
.
union_spec
in
v1_in_union
;
auto
.
-
eauto
;
instantiate
(
1
:=
e_hi
).
instantiate
(
1
:=
e_lo
).
rewrite
Heqp
.
reflexivity
.
}
rewrite
Heqp
in
*
;
simpl
in
*
.
edestruct
(
validIntervalbounds_sound
e
(
A
:=
A
)
(
P
:=
P
))
as
[
iv_e
[
err_e
[
vR
[
map_e
[
eval_real
vR_bounded
]]]]];
eauto
.
destruct
iv_e
as
[
e_lo
e_hi
].
assert
(
Rabs
(
vR
-
v
)
<=
Q2R
(
err_e
))
%
R
.
{
eapply
validErrorbound_sound
;
eauto
.
}
destruct
(
distance_gives_iv
(
a
:=
vR
)
v
(
e
:=
Q2R
err_e
)
(
Q2R
e_lo
,
Q2R
e_hi
))
as
[
v_in_errIv
];
try
auto
.
unfold
IVlo
,
IVhi
in
*
;
simpl
in
*
.
simpl
in
*
.
assert
(
Rabs
v
<=
Rabs
(
Q2R
e_hi
+
Q2R
err_e
)
\
/
Rabs
v
<=
Rabs
(
Q2R
e_lo
-
Q2R
err_e
))
%
R
as
abs_bounded
by
(
apply
bounded_inAbs
;
auto
).
destruct
e
;
unfold
validFloatValue
in
*
;
simpl
in
*
;
rewrite
type_e
,
Heqp
in
*
;
simpl
in
*
.
unfold
validFloatValue
in
*
;
cbn
in
*
;
rewrite
type_e
in
*
;
cbn
in
*
.
-
destruct
(
n
mem
dVars
)
eqn
:?
;
simpl
in
*
.
+
destruct
(
H9
n
);
try
set_tac
.
destruct
H12
as
[
m2
[
env_eq
[
map_eq
validVal
]]].
inversion
H0
;
subst
.
rewrite
env_eq
in
H14
;
inversion
H14
;
subst
.
rewrite
map_eq
in
type_e
;
inversion
type_e
;
subst
;
auto
.
+
andb_to_prop
H4
.
+
Daisy_compute
.
prove_fprangeval
m
v
L1
R
.
-
andb_to_prop
H4
.
-
Daisy_compute
.
prove_fprangeval
m
v
L1
R
.
-
andb_to_prop
H4
.
prove_fprangeval
m
v
L1
R
.
-
andb_to_prop
H4
.
prove_fprangeval
m
v
L1
R
.
-
andb_to_prop
H4
.
-
Daisy_compute
;
try
congruence
.
type_conv
;
subst
.
prove_fprangeval
m0
v
L1
R
.
-
Daisy_compute
;
try
congruence
.
type_conv
;
subst
.
prove_fprangeval
(
join
m0
m1
)
v
L1
R
.
-
Daisy_compute
;
try
congruence
.
type_conv
;
subst
.
prove_fprangeval
m
v
L1
R
.
Qed
.
...
...
@@ -162,22 +139,11 @@ Lemma FPRangeValidatorCmd_sound (f:cmd Q):
validErrorboundCmd
f
tMap
A
dVars
=
true
->
FPRangeValidatorCmd
f
A
tMap
dVars
=
true
->
NatSet
.
Subset
(
NatSet
.
diff
(
freeVars
f
)
dVars
)
fVars
->
(
forall
v
,
NatSet
.
In
v
fVars
->
exists
vR
,
E1
v
=
Some
vR
/
\
Q2R
(
fst
(
P
v
))
<=
vR
<=
Q2R
(
snd
(
P
v
)))
%
R
->
(
forall
v
,
NatSet
.
In
v
fVars
\
/
NatSet
.
In
v
dVars
->
exists
m
,
Gamma
v
=
Some
m
)
->
(
forall
v
,
NatSet
.
In
v
dVars
->
exists
vR
,
E1
v
=
Some
vR
/
\
Q2R
(
ivlo
(
fst
(
A
(
Var
Q
v
))))
<=
vR
/
\
vR
<=
Q2R
(
ivhi
(
fst
(
A
(
Var
Q
v
)))))
%
R
->
(
forall
v
,
NatSet
.
In
v
dVars
->
exists
vF
m
,
E2
v
=
Some
vF
/
\
tMap
(
Var
Q
v
)
=
Some
m
/
\
validFloatValue
vF
m
)
->
dVars_range_valid
dVars
E1
A
->
fVars_P_sound
fVars
E1
P
->
vars_typed
(
NatSet
.
union
fVars
dVars
)
Gamma
->
(
forall
v
,
NatSet
.
In
v
dVars
->
exists
vF
m
,
E2
v
=
Some
vF
/
\
DaisyMap
.
find
(
Var
Q
v
)
tMap
=
Some
m
/
\
validFloatValue
vF
m
)
->
validFloatValue
v
m
.
Proof
.
induction
f
;
intros
;
...
...
@@ -187,45 +153,38 @@ Proof.
repeat
match
goal
with
|
H
:
_
=
true
|-
_
=>
andb_to_prop
H
end
.
-
assert
(
tMap
e
=
Some
m
)
-
assert
(
DaisyMap
.
find
e
tMap
=
Some
m
)
by
(
eapply
typingSoundnessExp
;
eauto
).
match_pat
(
ssa
_
_
_
)
(
fun
H
=>
inversion
H
;
subst
;
simpl
in
*
).
destruct
(
A
e
)
as
[
iv_e
err_e
]
eqn
:?
;
destruct
iv_e
as
[
e_lo
e_hi
]
eqn
:?
.
edestruct
(
validErrorbound_sound
e
(
E1
:=
E1
)
(
E2
:=
E2
)
(
fVars
:=
fVars
)
(
dVars
:=
dVars
)
P
(
absenv
:=
A
)
(
nR
:=
v0
)
(
err
:=
err_e
))
as
[[
vF_e
[
m_e
eval_float_e
]]
err_bounded_e
];
eauto
.
Daisy_compute
.
edestruct
(
validIntervalbounds_sound
e
L1
(
Gamma
:=
Gamma
)(
P
:=
P
)
(
A
:=
A
)
(
fVars
:=
fVars
)
(
dVars
:=
dVars
)
(
E
:=
E1
))
as
[
iv_e
[
err_e
[
vR_e
[
map_e
[
eval_e_real
bounded_vR_e
]]]]];
eauto
.
+
set_tac
.
split
;
try
auto
.
rewrite
NatSet
.
remove_spec
,
NatSet
.
union_spec
;
split
;
try
auto
.
hnf
;
intros
;
subst
.
set_tac
.
+
intros
.
apply
H10
;
auto
;
set_tac
.
+
intros
;
apply
H8
;
auto
.
rewrite
<-
NatSet
.
mem_spec
;
auto
.
+
intros
.
apply
H9
;
set_tac
.
rewrite
<-
NatSet
.
union_spec
;
auto
.
+
edestruct
(
validIntervalbounds_sound
e
A
P
(
fVars
:=
fVars
)
(
dVars
:=
dVars
)
E1
);
eauto
.
*
intros
.
apply
H10
;
auto
;
set_tac
.
split
;
try
auto
.
hnf
;
intros
;
subst
;
set_tac
.
+
destr_factorize
.
edestruct
(
validErrorbound_sound
e
(
E1
:=
E1
)
(
E2
:=
E2
)
(
fVars
:=
fVars
)
(
dVars
:=
dVars
)
(
A
:=
A
)
(
P
:=
P
)
tMap
(
nR
:=
v0
)
(
err
:=
err_e
)
(
elo
:=
q
)
(
ehi
:=
q0
))
as
[[
vF_e
[
m_e
eval_float_e
]]
err_bounded_e
];
eauto
.
*
set_tac
.
split
;
try
auto
.
rewrite
NatSet
.
remove_spec
,
NatSet
.
union_spec
;
split
;
try
auto
.
hnf
;
intros
;
subst
.
set_tac
.
*
intros
.
apply
H8
.
rewrite
NatSet
.
mem_spec
in
*
;
auto
.
*
intros
.
instantiate
(
1
:=
Gamma
);
apply
H9
.
set_tac
.
rewrite
NatSet
.
union_spec
in
*
;
auto
.
*
rewrite
H3
in
*
.
destruct
(
tMap
(
Var
Q
n
))
eqn
:?
;
simpl
in
*
;
try
congruence
.
rename
x
into
vR_e
.
destruct
H4
as
[
eval_e_real
bounded_vR_e
].
rewrite
<-
(
meps_0_deterministic
(
toRExp
e
)
eval_e_real
H20
)
in
*
;
try
auto
.
andb_to_prop
R5
.
split
;
try
auto
.
hnf
;
intros
;
subst
;
set_tac
.
*
rewrite
<-
(
meps_0_deterministic
(
toRExp
e
)
eval_e_real
H20
)
in
*
;
try
auto
.
apply
(
IHf
(
updEnv
n
vR_e
E1
)
(
updEnv
n
v1
E2
)
(
updDefVars
n
m
Gamma
)
v
vR
m0
A
tMap
P
fVars
(
NatSet
.
add
n
dVars
)
(
outVars
));
eauto
.
{
apply
approxUpdBound
;
auto
.
{
e
apply
approxUpdBound
;
e
auto
.
simpl
in
*
.
apply
Rle_trans
with
(
r2
:=
Q2R
err_e
);
try
lra
.
rewrite
Heqp
in
*
;
simpl
in
*
.
eapply
err_bounded_e
.
eauto
.
apply
Qle_Rle
.
rewrite
Qeq_bool_iff
in
*
.
rewrite
R1
.
lra
.
}
destruct
i
;
inversion
Heqo0
;
subst
.
rewrite
R2
.
lra
.
}
{
eapply
ssa_equal_set
;
eauto
.
hnf
.
intros
a
;
split
;
intros
in_set
.
-
rewrite
NatSet
.
add_spec
,
NatSet
.
union_spec
;
...
...
@@ -237,8 +196,7 @@ Proof.
{
eapply
(
swap_Gamma_bstep
(
Gamma1
:=
updDefVars
n
M0
(
toRMap
Gamma
)));
eauto
.
eauto
using
Rmap_updVars_comm
.
}
{
set_tac
;
split
.
-
rewrite
NatSet
.
remove_spec
,
NatSet
.
union_spec
.
split
;
try
auto
.
-
split
;
try
auto
.
hnf
;
intros
;
subst
.
apply
H5
;
rewrite
NatSet
.
add_spec
;
auto
.
-
hnf
;
intros
.
...
...
@@ -248,28 +206,25 @@ Proof.
case_eq
(
v2
=?
n
);
intros
v2_eq
.
-
apply
Nat
.
eqb_eq
in
v2_eq
;
subst
.
set_tac
.
exfalso
;
apply
H16
;
set_tac
.
-
apply
H8
;
auto
.
}
{
intros
.
unfold
updDefVars
.
destruct
v2_fVar
as
[
?
|
[
?
?
]];
try
congruence
.
exists
vR_e
,
(
q1
,
q2
),
e1
;
split
;
try
auto
.
split
;
try
auto
.
simpl
;
canonize_hyps
.
rewrite
<-
R4
,
<-
R5
.
auto
.
-
apply
H8
;
try
auto
.
set_tac
.
destruct
v2_fVar
as
[
v2_n
|
[
?
?
]];
try
auto
.
rewrite
Nat
.
eqb_neq
in
v2_eq
;
congruence
.
}
{
unfold
fVars_P_sound
.
intros
.
unfold
updEnv
.
destruct
(
v2
=?
n
)
eqn
:?
;
eauto
.
apply
H9
.
destruct
H4
;
try
auto
.
rewrite
Nat
.
eqb_eq
in
*
;
subst
.
set_tac
.
exfalso
;
apply
H18
;
set_tac
.
}
{
unfold
vars_typed
.
intros
.
unfold
updDefVars
.
destruct
(
v2
=?
n
)
eqn
:?
;
eauto
.
apply
H10
.
rewrite
NatSet
.
union_spec
in
*
.
destruct
H4
;
try
auto
.
rewrite
NatSet
.
add_spec
in
H4
.
rewrite
Nat
.
eqb_neq
in
*
.
destruct
H4
;
subst
;
try
congruence
;
auto
.
}
{
intros
.
unfold
updEnv
.
destruct
(
v2
=?
n
)
eqn
:?
.
-
exists
vR_e
.
rewrite
Nat
.
eqb_eq
in
*
;
subst
.
split
;
try
auto
.
destruct
bounded_vR_e
;
rewrite
Heqp
in
*
;
simpl
in
*
.
split
.
+
apply
Rle_trans
with
(
r2
:=
Q2R
e_lo
);
try
lra
.
apply
Qle_Rle
.
rewrite
Qeq_bool_iff
in
*
;
rewrite
R4
;
lra
.
+
apply
Rle_trans
with
(
r2
:=
Q2R
e_hi
);
try
lra
.
apply
Qle_Rle
;
rewrite
Qeq_bool_iff
in
*
;
rewrite
R3
;
lra
.
-
apply
H10
.
rewrite
Nat
.
eqb_neq
in
*
.
rewrite
NatSet
.
add_spec
in
H4
.
destruct
H4
;
try
auto
;
subst
;
congruence
.
}
{
intros
.
unfold
updEnv
.
type_conv
;
subst
.
destruct
(
v2
=?
n
)
eqn
:?
;
try
rewrite
Nat
.
eqb_eq
in
*
;
...
...
@@ -277,7 +232,6 @@ Proof.
-
exists
v1
;
subst
.
exists
m1
;
repeat
split
;
try
auto
.
eapply
FPRangeValidator_sound
;
eauto
.
set_tac
.
split
;
try
auto
.
rewrite
NatSet
.
remove_spec
,
NatSet
.
union_spec
.
split
;
try
auto
.
hnf
;
intros
;
subst
;
set_tac
.
-
apply
H11
.
...
...
coq/IEEE_connection.v
View file @
ea7e921d
...
...
@@ -265,34 +265,26 @@ Lemma typing_exp_64_bit e:
typeCheck
e
Gamma
tMap
=
true
->
(
forall
v
,
NatSet
.
In
v
(
usedVars
e
)
->
Gamma
v
=
Some
M64
)
->
tMap
e
=
Some
M64
.
DaisyMap
.
find
e
tMap
=
Some
M64
.
Proof
.
induction
e
;
intros
*
noDowncast_e
is64BitEval_e
typecheck_e
types_valid
;
simpl
in
*
;
try
inversion
noDowncast_e
;
subst
.
-
destruct
(
tMap
(
Var
Q
n
));
try
congruence
.
rewrite
types_valid
in
*
;
try
set_tac
.
type_conv
;
subst
;
auto
.
-
destruct
(
tMap
(
Const
M64
v
))
eqn
:?
;
try
congruence
;
type_conv
;
subst
;
auto
.
-
destruct
(
tMap
(
Unop
u
e
))
eqn
:?
;
try
congruence
.
erewrite
IHe
in
*
;
eauto
.
+
andb_to_prop
typecheck_e
;
type_conv
;
subst
;
auto
.
+
destruct
(
tMap
e
);
try
congruence
;
andb_to_prop
typecheck_e
;
auto
.
cbn
in
*
;
try
inversion
noDowncast_e
;
subst
;
Daisy_compute
;
try
congruence
;
type_conv
;
subst
.
-
rewrite
types_valid
in
*
;
try
set_tac
.
-
destruct
m
;
try
congruence
.
-
erewrite
IHe
in
*
;
eauto
.
-
repeat
(
match
goal
with
|
H
:
_
/
\
_
|-
_
=>
destruct
H
end
).
destruct
(
tMap
(
Binop
b
e1
e2
))
eqn
:?
;
try
congruence
;
erewrite
IHe1
in
*
;
eauto
.
+
erewrite
IHe2
in
*
;
eauto
.
*
unfold
join
in
typecheck_e
.
rewrite
isMorePrecise_refl
in
typecheck_e
;
andb_to_prop
typecheck_e
;
type_conv
;
subst
;
auto
.
*
destruct
(
tMap
e2
);
try
congruence
.
andb_to_prop
typecheck_e
;
eauto
.
*
unfold
join
in
*
.
destr_factorize
.
rewrite
<-
isMorePrecise_morePrecise
.
rewrite
isMorePrecise_refl
.
inversion
Heqo0
;
auto
.
*
intros
.