Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
F
FloVer
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
5
Issues
5
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
AVA
FloVer
Commits
313ac660
Commit
313ac660
authored
May 15, 2018
by
Heiko Becker
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix Fixed-Point implementation by properly implementing type join for fixed-points
parent
c6efd235
Changes
19
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
19 changed files
with
1773 additions
and
941 deletions
+1773
-941
coq/AffineValidation.v
coq/AffineValidation.v
+62
-57
coq/CertificateChecker.v
coq/CertificateChecker.v
+25
-21
coq/Commands.v
coq/Commands.v
+12
-12
coq/ErrorBounds.v
coq/ErrorBounds.v
+129
-106
coq/ErrorValidation.v
coq/ErrorValidation.v
+530
-249
coq/ErrorValidationAA.v
coq/ErrorValidationAA.v
+11
-11
coq/Expressions.v
coq/Expressions.v
+3
-3
coq/FPRangeValidator.v
coq/FPRangeValidator.v
+72
-24
coq/IEEE_connection.v
coq/IEEE_connection.v
+156
-149
coq/Infra/ExpressionAbbrevs.v
coq/Infra/ExpressionAbbrevs.v
+117
-12
coq/Infra/MachineType.v
coq/Infra/MachineType.v
+24
-0
coq/IntervalValidation.v
coq/IntervalValidation.v
+26
-34
coq/OrderedExpressions.v
coq/OrderedExpressions.v
+101
-99
coq/RealRangeArith.v
coq/RealRangeArith.v
+31
-30
coq/RealRangeValidator.v
coq/RealRangeValidator.v
+8
-8
coq/RoundoffErrorValidator.v
coq/RoundoffErrorValidator.v
+15
-12
coq/Typing.v
coq/Typing.v
+445
-108
coq/floverParser.v
coq/floverParser.v
+4
-4
coq/ssaPrgs.v
coq/ssaPrgs.v
+2
-2
No files found.
coq/AffineValidation.v
View file @
313ac660
...
@@ -57,8 +57,8 @@ Proof.
...
@@ -57,8 +57,8 @@ Proof.
destruct
e5
.
destruct
e5
.
+
apply
Ndec
.
Pcompare_Peqb
in
e8
.
+
apply
Ndec
.
Pcompare_Peqb
in
e8
.
congruence
.
congruence
.
+
apply
N
dec
.
Pcompare_Peqb
in
Heq
.
+
apply
N
at
.
compare_eq
in
Heq
;
subst
.
congruence
.
rewrite
Nat
.
eqb_refl
in
H
;
congruence
.
Qed
.
Qed
.
Lemma
usedVars_toREval_toRExp_compat
e
:
Lemma
usedVars_toREval_toRExp_compat
e
:
...
@@ -69,10 +69,10 @@ Proof.
...
@@ -69,10 +69,10 @@ Proof.
-
now
rewrite
IHe1
,
IHe2
,
IHe3
.
-
now
rewrite
IHe1
,
IHe2
,
IHe3
.
Qed
.
Qed
.
Lemma
validRanges_eq_compat
(
e1
:
expr
Q
)
e2
A
E
Gamma
:
Lemma
validRanges_eq_compat
(
e1
:
expr
Q
)
e2
A
E
Gamma
fBits
:
Q_orderedExps
.
eq
e1
e2
->
Q_orderedExps
.
eq
e1
e2
->
validRanges
e1
A
E
Gamma
->
validRanges
e1
A
E
Gamma
fBits
->
validRanges
e2
A
E
Gamma
.
validRanges
e2
A
E
Gamma
fBits
.
Proof
.
Proof
.
intros
Heq
.
intros
Heq
.
unfold
Q_orderedExps
.
eq
in
Heq
.
unfold
Q_orderedExps
.
eq
in
Heq
.
...
@@ -104,8 +104,8 @@ Proof.
...
@@ -104,8 +104,8 @@ Proof.
destruct
e3
.
destruct
e3
.
+
apply
Ndec
.
Pcompare_Peqb
in
e6
.
+
apply
Ndec
.
Pcompare_Peqb
in
e6
.
congruence
.
congruence
.
+
apply
N
dec
.
Pcompare_Peqb
in
Heq
.
+
apply
N
at
.
compare_eq
in
Heq
;
subst
.
congruence
.
rewrite
Nat
.
eqb_refl
in
H
;
congruence
.
-
intros
valid1
;
destruct
valid1
as
[
validsub1
validr1
].
-
intros
valid1
;
destruct
valid1
as
[
validsub1
validr1
].
specialize
(
IHc
Heq
validsub1
).
specialize
(
IHc
Heq
validsub1
).
split
;
auto
.
split
;
auto
.
...
@@ -229,8 +229,8 @@ Proof.
...
@@ -229,8 +229,8 @@ Proof.
destruct
e5
.
destruct
e5
.
+
apply
Ndec
.
Pcompare_Peqb
in
e8
.
+
apply
Ndec
.
Pcompare_Peqb
in
e8
.
congruence
.
congruence
.
+
apply
N
dec
.
Pcompare_Peqb
in
Heq
.
+
apply
N
at
.
compare_eq
in
Heq
;
subst
.
congruence
.
rewrite
Nat
.
eqb_refl
in
*
;
congruence
.
Qed
.
Qed
.
Definition
updateExpMapIncr
e
new_af
noise
(
emap
:
expressionsAffine
)
intv
incr
:=
Definition
updateExpMapIncr
e
new_af
noise
(
emap
:
expressionsAffine
)
intv
incr
:=
...
@@ -745,15 +745,15 @@ Proof.
...
@@ -745,15 +745,15 @@ Proof.
congruence
.
congruence
.
Qed
.
Qed
.
Lemma
validAffineBounds_validRanges
e
(
A
:
analysisResult
)
E
Gamma
:
Lemma
validAffineBounds_validRanges
e
(
A
:
analysisResult
)
E
Gamma
fBits
:
(
exists
map
af
vR
aiv
aerr
,
(
exists
map
af
vR
aiv
aerr
,
FloverMap
.
find
e
A
=
Some
(
aiv
,
aerr
)
/
\
FloverMap
.
find
e
A
=
Some
(
aiv
,
aerr
)
/
\
isSupersetIntv
(
toIntv
af
)
aiv
=
true
/
\
isSupersetIntv
(
toIntv
af
)
aiv
=
true
/
\
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
e
))
vR
REAL
/
\
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
e
))
vR
REAL
/
\
af_evals
(
afQ2R
af
)
vR
map
)
->
af_evals
(
afQ2R
af
)
vR
map
)
->
exists
iv
err
vR
,
exists
iv
err
vR
,
FloverMap
.
find
e
A
=
Some
(
iv
,
err
)
/
\
FloverMap
.
find
e
A
=
Some
(
iv
,
err
)
/
\
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
e
))
vR
REAL
/
\
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
e
))
vR
REAL
/
\
(
Q2R
(
fst
iv
)
<=
vR
<=
Q2R
(
snd
iv
))
%
R
.
(
Q2R
(
fst
iv
)
<=
vR
<=
Q2R
(
snd
iv
))
%
R
.
Proof
.
Proof
.
intros
sound_affine
.
intros
sound_affine
.
...
@@ -773,7 +773,7 @@ Proof.
...
@@ -773,7 +773,7 @@ Proof.
split
;
eauto
using
Rle_trans
.
split
;
eauto
using
Rle_trans
.
Qed
.
Qed
.
Definition
checked_expressions
(
A
:
analysisResult
)
E
Gamma
fVars
dVars
e
iexpmap
inoise
map1
:=
Definition
checked_expressions
(
A
:
analysisResult
)
E
Gamma
f
Bits
f
Vars
dVars
e
iexpmap
inoise
map1
:=
exists
af
vR
aiv
aerr
,
exists
af
vR
aiv
aerr
,
NatSet
.
Subset
(
usedVars
e
)
(
NatSet
.
union
fVars
dVars
)
/
\
NatSet
.
Subset
(
usedVars
e
)
(
NatSet
.
union
fVars
dVars
)
/
\
FloverMap
.
find
e
A
=
Some
(
aiv
,
aerr
)
/
\
FloverMap
.
find
e
A
=
Some
(
aiv
,
aerr
)
/
\
...
@@ -781,17 +781,17 @@ Definition checked_expressions (A: analysisResult) E Gamma fVars dVars e iexpmap
...
@@ -781,17 +781,17 @@ Definition checked_expressions (A: analysisResult) E Gamma fVars dVars e iexpmap
FloverMap
.
find
e
iexpmap
=
Some
af
/
\
FloverMap
.
find
e
iexpmap
=
Some
af
/
\
fresh
inoise
af
/
\
fresh
inoise
af
/
\
(
forall
n
,
(
n
>=
inoise
)
%
nat
->
map1
n
=
None
)
/
\
(
forall
n
,
(
n
>=
inoise
)
%
nat
->
map1
n
=
None
)
/
\
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
e
))
vR
REAL
/
\
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
e
))
vR
REAL
/
\
validRanges
e
A
E
Gamma
/
\
validRanges
e
A
E
Gamma
fBits
/
\
af_evals
(
afQ2R
af
)
vR
map1
.
af_evals
(
afQ2R
af
)
vR
map1
.
Lemma
checked_expressions_contained
A
E
Gamma
fVars
dVars
e
expmap1
expmap2
map1
map2
noise1
noise2
:
Lemma
checked_expressions_contained
A
E
Gamma
f
Bits
f
Vars
dVars
e
expmap1
expmap2
map1
map2
noise1
noise2
:
contained_map
map1
map2
->
contained_map
map1
map2
->
contained_flover_map
expmap1
expmap2
->
contained_flover_map
expmap1
expmap2
->
(
noise2
>=
noise1
)
%
nat
->
(
noise2
>=
noise1
)
%
nat
->
(
forall
n
:
nat
,
(
n
>=
noise2
)
%
nat
->
map2
n
=
None
)
->
(
forall
n
:
nat
,
(
n
>=
noise2
)
%
nat
->
map2
n
=
None
)
->
checked_expressions
A
E
Gamma
fVars
dVars
e
expmap1
noise1
map1
->
checked_expressions
A
E
Gamma
f
Bits
f
Vars
dVars
e
expmap1
noise1
map1
->
checked_expressions
A
E
Gamma
fVars
dVars
e
expmap2
noise2
map2
.
checked_expressions
A
E
Gamma
f
Bits
f
Vars
dVars
e
expmap2
noise2
map2
.
Proof
.
Proof
.
intros
cont
contf
Hnoise
Hvalidmap
checked1
.
intros
cont
contf
Hnoise
Hvalidmap
checked1
.
unfold
checked_expressions
in
checked1
|-*
.
unfold
checked_expressions
in
checked1
|-*
.
...
@@ -800,10 +800,10 @@ Proof.
...
@@ -800,10 +800,10 @@ Proof.
intuition
;
eauto
using
fresh_monotonic
,
af_evals_map_extension
.
intuition
;
eauto
using
fresh_monotonic
,
af_evals_map_extension
.
Qed
.
Qed
.
Lemma
checked_expressions_flover_map_add_compat
A
E
Gamma
fVars
dVars
e
e
'
af
expmap
noise
map
:
Lemma
checked_expressions_flover_map_add_compat
A
E
Gamma
f
Bits
f
Vars
dVars
e
e
'
af
expmap
noise
map
:
Q_orderedExps
.
exprCompare
e
e
'
<>
Eq
->
Q_orderedExps
.
exprCompare
e
e
'
<>
Eq
->
checked_expressions
A
E
Gamma
fVars
dVars
e
'
expmap
noise
map
->
checked_expressions
A
E
Gamma
f
Bits
f
Vars
dVars
e
'
expmap
noise
map
->
checked_expressions
A
E
Gamma
fVars
dVars
e
'
(
FloverMap
.
add
e
af
expmap
)
noise
map
.
checked_expressions
A
E
Gamma
f
Bits
f
Vars
dVars
e
'
(
FloverMap
.
add
e
af
expmap
)
noise
map
.
Proof
.
Proof
.
intros
Hneq
checked1
.
intros
Hneq
checked1
.
unfold
checked_expressions
in
checked1
|-*
.
unfold
checked_expressions
in
checked1
|-*
.
...
@@ -814,9 +814,9 @@ Proof.
...
@@ -814,9 +814,9 @@ Proof.
Qed
.
Qed
.
Lemma
validAffineBounds_sound
(
e
:
expr
Q
)
(
A
:
analysisResult
)
(
P
:
precond
)
Lemma
validAffineBounds_sound
(
e
:
expr
Q
)
(
A
:
analysisResult
)
(
P
:
precond
)
fVars
dVars
(
E
:
env
)
Gamma
exprAfs
noise
iexpmap
inoise
map1
:
fVars
dVars
(
E
:
env
)
Gamma
fBits
exprAfs
noise
iexpmap
inoise
map1
:
(
forall
e
,
(
exists
af
,
FloverMap
.
find
e
iexpmap
=
Some
af
)
->
(
forall
e
,
(
exists
af
,
FloverMap
.
find
e
iexpmap
=
Some
af
)
->
checked_expressions
A
E
Gamma
fVars
dVars
e
iexpmap
inoise
map1
)
->
checked_expressions
A
E
Gamma
f
Bits
f
Vars
dVars
e
iexpmap
inoise
map1
)
->
(
inoise
>
0
)
%
nat
->
(
inoise
>
0
)
%
nat
->
(
forall
n
,
(
n
>=
inoise
)
%
nat
->
map1
n
=
None
)
->
(
forall
n
,
(
n
>=
inoise
)
%
nat
->
map1
n
=
None
)
->
validAffineBounds
e
A
P
dVars
iexpmap
inoise
=
Some
(
exprAfs
,
noise
)
->
validAffineBounds
e
A
P
dVars
iexpmap
inoise
=
Some
(
exprAfs
,
noise
)
->
...
@@ -833,12 +833,12 @@ Lemma validAffineBounds_sound (e: expr Q) (A: analysisResult) (P: precond)
...
@@ -833,12 +833,12 @@ Lemma validAffineBounds_sound (e: expr Q) (A: analysisResult) (P: precond)
fresh
noise
af
/
\
fresh
noise
af
/
\
(
forall
n
,
(
n
>=
noise
)
%
nat
->
map2
n
=
None
)
/
\
(
forall
n
,
(
n
>=
noise
)
%
nat
->
map2
n
=
None
)
/
\
(
noise
>=
inoise
)
%
nat
/
\
(
noise
>=
inoise
)
%
nat
/
\
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
e
))
vR
REAL
/
\
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
e
))
vR
REAL
/
\
validRanges
e
A
E
Gamma
/
\
validRanges
e
A
E
Gamma
fBits
/
\
af_evals
(
afQ2R
af
)
vR
map2
/
\
af_evals
(
afQ2R
af
)
vR
map2
/
\
(
forall
e
,
FloverMap
.
find
e
iexpmap
=
None
->
(
forall
e
,
FloverMap
.
find
e
iexpmap
=
None
->
(
exists
af
,
FloverMap
.
find
e
exprAfs
=
Some
af
)
->
(
exists
af
,
FloverMap
.
find
e
exprAfs
=
Some
af
)
->
checked_expressions
A
E
Gamma
fVars
dVars
e
exprAfs
noise
map2
).
checked_expressions
A
E
Gamma
f
Bits
f
Vars
dVars
e
exprAfs
noise
map2
).
Proof
.
Proof
.
revert
noise
exprAfs
inoise
iexpmap
map1
.
revert
noise
exprAfs
inoise
iexpmap
map1
.
induction
e
;
induction
e
;
...
@@ -885,7 +885,7 @@ Proof.
...
@@ -885,7 +885,7 @@ Proof.
specialize
(
fVarsSound
H
'
)
as
[
vR
[
eMap
interval_containment
]].
specialize
(
fVarsSound
H
'
)
as
[
vR
[
eMap
interval_containment
]].
assert
(
FloverMap
.
find
(
Var
Q
n
)
(
FloverMap
.
add
(
Var
Q
n
)
(
fromIntv
(
P
n
)
inoise
)
iexpmap
)
=
Some
(
fromIntv
(
P
n
)
inoise
))
as
Hfind
assert
(
FloverMap
.
find
(
Var
Q
n
)
(
FloverMap
.
add
(
Var
Q
n
)
(
fromIntv
(
P
n
)
inoise
)
iexpmap
)
=
Some
(
fromIntv
(
P
n
)
inoise
))
as
Hfind
by
(
rewrite
FloverMapFacts
.
P
.
F
.
add_eq_o
;
try
auto
;
apply
Q_orderedExps
.
exprCompare_refl
).
by
(
rewrite
FloverMapFacts
.
P
.
F
.
add_eq_o
;
try
auto
;
apply
Q_orderedExps
.
exprCompare_refl
).
assert
(
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
(
Var
Q
n
)))
vR
REAL
)
as
Heeval
assert
(
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
(
Var
Q
n
)))
vR
REAL
)
as
Heeval
by
(
constructor
;
auto
;
simpl
;
rewrite
varsTyped
;
reflexivity
).
by
(
constructor
;
auto
;
simpl
;
rewrite
varsTyped
;
reflexivity
).
destruct
(
Qeq_bool
(
ivlo
(
P
n
))
(
ivhi
(
P
n
)))
eqn
:
Heq
.
destruct
(
Qeq_bool
(
ivlo
(
P
n
))
(
ivhi
(
P
n
)))
eqn
:
Heq
.
*
assert
(
af_evals
(
afQ2R
(
fromIntv
(
P
n
)
inoise
))
vR
map1
)
as
Hevals
.
*
assert
(
af_evals
(
afQ2R
(
fromIntv
(
P
n
)
inoise
))
vR
map1
)
as
Hevals
.
...
@@ -1137,7 +1137,7 @@ Proof.
...
@@ -1137,7 +1137,7 @@ Proof.
assert
(
FloverMap
.
find
(
elt
:=
affine_form
Q
)
(
Const
m
v
)
(
FloverMap
.
add
(
Const
m
v
)
(
fromIntv
(
v
,
v
)
noise
)
iexpmap
)
=
Some
(
fromIntv
(
v
,
v
)
noise
))
assert
(
FloverMap
.
find
(
elt
:=
affine_form
Q
)
(
Const
m
v
)
(
FloverMap
.
add
(
Const
m
v
)
(
fromIntv
(
v
,
v
)
noise
)
iexpmap
)
=
Some
(
fromIntv
(
v
,
v
)
noise
))
by
(
rewrite
FloverMapFacts
.
P
.
F
.
add_eq_o
;
try
auto
;
by
(
rewrite
FloverMapFacts
.
P
.
F
.
add_eq_o
;
try
auto
;
apply
Q_orderedExps
.
exprCompare_refl
).
apply
Q_orderedExps
.
exprCompare_refl
).
assert
(
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
(
Const
m
v
)))
(
perturb
(
Q2R
v
)
REAL
0
)
REAL
)
assert
(
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
(
Const
m
v
)))
(
perturb
(
Q2R
v
)
REAL
0
)
REAL
)
by
(
constructor
;
simpl
;
rewrite
Rabs_R0
;
lra
).
by
(
constructor
;
simpl
;
rewrite
Rabs_R0
;
lra
).
exists
map1
,
(
fromIntv
(
v
,
v
)
noise
),
(
perturb
(
Q2R
v
)
REAL
0
),
i
,
e
.
exists
map1
,
(
fromIntv
(
v
,
v
)
noise
),
(
perturb
(
Q2R
v
)
REAL
0
),
i
,
e
.
repeat
split
;
auto
.
repeat
split
;
auto
.
...
@@ -1373,10 +1373,11 @@ Proof.
...
@@ -1373,10 +1373,11 @@ Proof.
apply
plus_aff_sound
;
auto
.
apply
plus_aff_sound
;
auto
.
eauto
using
af_evals_map_extension
.
eauto
using
af_evals_map_extension
.
}
}
assert
(
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
(
Binop
Plus
e1
e2
)))
assert
(
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
(
Binop
Plus
e1
e2
)))
(
perturb
(
evalBinop
Plus
vR1
vR2
)
REAL
0
)
REAL
)
(
perturb
(
evalBinop
Plus
vR1
vR2
)
REAL
0
)
REAL
).
by
(
replace
REAL
with
(
join
REAL
REAL
)
by
trivial
;
{
eapply
Binop_dist
'
with
(
delta
:=
0
%
R
);
eauto
;
try
congruence
.
apply
Binop_dist
;
try
rewrite
Rabs_R0
;
simpl
;
auto
;
try
lra
;
congruence
).
-
rewrite
Rabs_R0
;
cbn
;
lra
.
-
intros
;
cbn
in
*
;
contradiction
.
}
exists
ihmap2
,
(
AffineArithQ
.
plus_aff
af1
af2
),
(
perturb
(
evalBinop
Plus
vR1
vR2
)
REAL
0
)
%
R
,
aiv
,
aerr
.
exists
ihmap2
,
(
AffineArithQ
.
plus_aff
af1
af2
),
(
perturb
(
evalBinop
Plus
vR1
vR2
)
REAL
0
)
%
R
,
aiv
,
aerr
.
rewrite
plus_0_r
.
rewrite
plus_0_r
.
repeat
split
;
eauto
using
AffineArithQ
.
plus_aff_preserves_fresh
,
fresh_monotonic
.
repeat
split
;
eauto
using
AffineArithQ
.
plus_aff_preserves_fresh
,
fresh_monotonic
.
...
@@ -1461,9 +1462,10 @@ Proof.
...
@@ -1461,9 +1462,10 @@ Proof.
unfold
AffineArithQ
.
negate_aff
.
unfold
AffineArithQ
.
negate_aff
.
now
apply
AffineArithQ
.
fresh_mult_aff_const
.
now
apply
AffineArithQ
.
fresh_mult_aff_const
.
}
}
assert
(
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
(
Binop
Sub
e1
e2
)))
(
perturb
(
evalBinop
Sub
vR1
vR2
)
REAL
0
)
REAL
)
assert
(
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
(
Binop
Sub
e1
e2
)))
(
perturb
(
evalBinop
Sub
vR1
vR2
)
REAL
0
)
REAL
).
by
(
replace
REAL
with
(
join
REAL
REAL
)
by
trivial
;
apply
Binop_dist
;
{
eapply
Binop_dist
'
with
(
delta
:=
0
%
R
);
eauto
;
try
congruence
.
try
rewrite
Rabs_R0
;
simpl
;
auto
;
try
lra
;
congruence
).
-
rewrite
Rabs_R0
;
cbn
;
lra
.
-
intros
;
cbn
in
*
;
contradiction
.
}
exists
ihmap2
,
(
AffineArithQ
.
subtract_aff
af1
af2
),
(
perturb
(
evalBinop
Sub
vR1
vR2
)
REAL
0
)
%
R
,
aiv
,
aerr
.
exists
ihmap2
,
(
AffineArithQ
.
subtract_aff
af1
af2
),
(
perturb
(
evalBinop
Sub
vR1
vR2
)
REAL
0
)
%
R
,
aiv
,
aerr
.
repeat
split
;
auto
.
repeat
split
;
auto
.
*
etransitivity
;
try
exact
ihcont1
.
*
etransitivity
;
try
exact
ihcont1
.
...
@@ -1556,9 +1558,10 @@ Proof.
...
@@ -1556,9 +1558,10 @@ Proof.
apply
AffineArithQ
.
mult_aff_aux_preserves_fresh
;
apply
AffineArithQ
.
mult_aff_aux_preserves_fresh
;
apply
fresh_inc
;
now
rewrite
afQ2R_fresh
.
apply
fresh_inc
;
now
rewrite
afQ2R_fresh
.
}
}
assert
(
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
(
Binop
Mult
e1
e2
)))
(
perturb
(
evalBinop
Mult
vR1
vR2
)
REAL
0
)
REAL
)
assert
(
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
(
Binop
Mult
e1
e2
)))
(
perturb
(
evalBinop
Mult
vR1
vR2
)
REAL
0
)
REAL
).
by
(
replace
REAL
with
(
join
REAL
REAL
)
by
trivial
;
{
eapply
Binop_dist
'
with
(
delta
:=
0
%
R
);
eauto
;
try
congruence
.
apply
Binop_dist
;
try
rewrite
Rabs_R0
;
simpl
;
auto
;
try
lra
;
congruence
).
-
rewrite
Rabs_R0
;
cbn
;
lra
.
-
intros
;
cbn
in
*
;
contradiction
.
}
assert
(
af_evals
(
afQ2R
(
AffineArithQ
.
mult_aff
af1
af2
subnoise2
))
(
perturb
(
evalBinop
Mult
vR1
vR2
)
REAL
0
)
(
updMap
ihmap2
subnoise2
qMult
))
by
assert
(
af_evals
(
afQ2R
(
AffineArithQ
.
mult_aff
af1
af2
subnoise2
))
(
perturb
(
evalBinop
Mult
vR1
vR2
)
REAL
0
)
(
updMap
ihmap2
subnoise2
qMult
))
by
(
unfold
perturb
;
simpl
evalBinop
;
rewrite
afQ2R_mult_aff
;
assumption
).
(
unfold
perturb
;
simpl
evalBinop
;
rewrite
afQ2R_mult_aff
;
assumption
).
assert
(
forall
n
:
nat
,
(
n
>=
subnoise2
+
1
)
%
nat
->
updMap
ihmap2
subnoise2
qMult
n
=
None
).
assert
(
forall
n
:
nat
,
(
n
>=
subnoise2
+
1
)
%
nat
->
updMap
ihmap2
subnoise2
qMult
n
=
None
).
...
@@ -1712,11 +1715,11 @@ Proof.
...
@@ -1712,11 +1715,11 @@ Proof.
apply
Hsubvalidmap2
.
apply
Hsubvalidmap2
.
lia
.
lia
.
}
}
assert
(
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
(
Binop
Div
e1
e2
)))
(
perturb
(
evalBinop
Div
vR1
vR2
)
REAL
0
)
REAL
)
assert
(
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
(
Binop
Div
e1
e2
)))
(
perturb
(
evalBinop
Div
vR1
vR2
)
REAL
0
)
REAL
).
by
(
replace
REAL
with
(
join
REAL
REAL
)
by
trivial
;
{
eapply
Binop_dist
'
with
(
delta
:=
0
%
R
);
eauto
;
try
congruence
.
apply
Binop_dist
;
try
rewrite
Rabs_R0
;
simpl
;
auto
;
try
lra
;
-
rewrite
Rabs_R0
;
cbn
;
lra
.
intros
_
;
-
intros
_
;
eauto
using
above_below_nonzero
.
eauto
using
above_below_nonzero
).
-
intros
;
cbn
in
*
;
contradiction
.
}
assert
(
af_evals
(
afQ2R
(
AffineArithQ
.
divide_aff
af1
af2
subnoise2
))
(
perturb
(
evalBinop
Div
vR1
vR2
)
REAL
0
)
(
updMap
(
updMap
ihmap2
subnoise2
qInv
)
(
subnoise2
+
1
)
qMult
))
assert
(
af_evals
(
afQ2R
(
AffineArithQ
.
divide_aff
af1
af2
subnoise2
))
(
perturb
(
evalBinop
Div
vR1
vR2
)
REAL
0
)
(
updMap
(
updMap
ihmap2
subnoise2
qInv
)
(
subnoise2
+
1
)
qMult
))
by
(
unfold
perturb
;
simpl
evalBinop
;
rewrite
afQ2R_divide_aff
;
auto
).
by
(
unfold
perturb
;
simpl
evalBinop
;
rewrite
afQ2R_divide_aff
;
auto
).
exists
(
updMap
(
updMap
ihmap2
subnoise2
qInv
)
(
subnoise2
+
1
)
qMult
),
exists
(
updMap
(
updMap
ihmap2
subnoise2
qInv
)
(
subnoise2
+
1
)
qMult
),
...
@@ -1954,9 +1957,10 @@ Proof.
...
@@ -1954,9 +1957,10 @@ Proof.
apply
Hsubmapvalid3
.
apply
Hsubmapvalid3
.
lia
.
lia
.
}
}
assert
(
eval_expr
E
(
toRMap
Gamma
)
(
toREval
(
toRExp
(
Fma
e1
e2
e3
)))
(
perturb
(
evalFma
vR1
vR2
vR3
)
REAL
0
)
REAL
)
assert
(
eval_expr
E
(
toRMap
Gamma
)
fBits
(
toREval
(
toRExp
(
Fma
e1
e2
e3
)))
(
perturb
(
evalFma
vR1
vR2
vR3
)
REAL
0
)
REAL
).
by
(
replace
REAL
with
(
join3
REAL
REAL
REAL
)
by
trivial
;
{
eapply
Fma_dist
'
;
eauto
;
try
congruence
.
apply
Fma_dist
;
try
rewrite
Rabs_R0
;
auto
;
simpl
;
lra
).
-
rewrite
Rabs_R0
;
cbn
;
lra
.
-
intros
.
cbn
in
*
.
contradiction
.
}
assert
(
af_evals
(
afQ2R
(
AffineArithQ
.
plus_aff
af1
(
AffineArithQ
.
mult_aff
af2
af3
subnoise3
)))
(
perturb
(
evalFma
vR1
vR2
vR3
)
REAL
0
)
(
updMap
ihmap3
subnoise3
qMult
)).
assert
(
af_evals
(
afQ2R
(
AffineArithQ
.
plus_aff
af1
(
AffineArithQ
.
mult_aff
af2
af3
subnoise3
)))
(
perturb
(
evalFma
vR1
vR2
vR3
)
REAL
0
)
(
updMap
ihmap3
subnoise3
qMult
)).
{
{
unfold
perturb
.
unfold
perturb
.
...
@@ -2142,6 +2146,7 @@ Proof.
...
@@ -2142,6 +2146,7 @@ Proof.
*
rewrite
FloverMapFacts
.
P
.
F
.
add_neq_o
in
Hsome
;
auto
.
*
rewrite
FloverMapFacts
.
P
.
F
.
add_neq_o
in
Hsome
;
auto
.
apply
checked_expressions_flover_map_add_compat
;
auto
.
apply
checked_expressions_flover_map_add_compat
;
auto
.
apply
visitedSubexpr
;
eauto
.
apply
visitedSubexpr
;
eauto
.
Unshelve
.
all
:
exact
0
%
nat
.
Qed
.
Qed
.
Fixpoint
validAffineBoundsCmd
(
c
:
cmd
Q
)
(
A
:
analysisResult
)
(
P
:
precond
)
(
validVars
:
NatSet
.
t
)
Fixpoint
validAffineBoundsCmd
(
c
:
cmd
Q
)
(
A
:
analysisResult
)
(
P
:
precond
)
(
validVars
:
NatSet
.
t
)
...
@@ -2164,24 +2169,24 @@ Fixpoint validAffineBoundsCmd (c: cmd Q) (A: analysisResult) (P: precond) (valid
...
@@ -2164,24 +2169,24 @@ Fixpoint validAffineBoundsCmd (c: cmd Q) (A: analysisResult) (P: precond) (valid
|
Ret
e
=>
validAffineBounds
e
A
P
validVars
exprsAf
currentMaxNoise
|
Ret
e
=>
validAffineBounds
e
A
P
validVars
exprsAf
currentMaxNoise
end
.
end
.
Lemma
eval_expr_ssa_extension
(
e
:
expr
R
)
(
e
'
:
expr
Q
)
E
Gamma
vR
vR
'
m
n
c
fVars
dVars
outVars
:
Lemma
eval_expr_ssa_extension
(
e
:
expr
R
)
(
e
'
:
expr
Q
)
E
Gamma
fBits
vR
vR
'
m
n
c
fVars
dVars
outVars
:
ssa
(
Let
m
n
e
'
c
)
(
fVars
∪
dVars
)
outVars
->
ssa
(
Let
m
n
e
'
c
)
(
fVars
∪
dVars
)
outVars
->
NatSet
.
Subset
(
usedVars
e
)
(
fVars
∪
dVars
)
->
NatSet
.
Subset
(
usedVars
e
)
(
fVars
∪
dVars
)
->
~
(
n
∈
fVars
∪
dVars
)
->
~
(
n
∈
fVars
∪
dVars
)
->
eval_expr
E
Gamma
e
vR
REAL
->
eval_expr
E
Gamma
fBits
e
vR
REAL
->
eval_expr
(
updEnv
n
vR
'
E
)
(
updDefVars
n
REAL
Gamma
)
e
vR
REAL
.
eval_expr
(
updEnv
n
vR
'
E
)
(
updDefVars
n
REAL
Gamma
)
fBits
e
vR
REAL
.
Proof
.
Proof
.
intros
Hssa
Hsub
Hnotin
Heval
.
intros
Hssa
Hsub
Hnotin
Heval
.
eapply
eval_expr_ignore_bind
;
[
auto
|
].
eapply
eval_expr_ignore_bind
;
[
auto
|
].
edestruct
ssa_inv_let
;
eauto
.
edestruct
ssa_inv_let
;
eauto
.
Qed
.
Qed
.
Lemma
validRanges_ssa_extension
(
e
:
expr
Q
)
(
e
'
:
expr
Q
)
A
E
Gamma
vR
'
m
n
c
fVars
dVars
outVars
:
Lemma
validRanges_ssa_extension
(
e
:
expr
Q
)
(
e
'
:
expr
Q
)
A
E
Gamma
fBits
vR
'
m
n
c
fVars
dVars
outVars
:
ssa
(
Let
m
n
e
'
c
)
(
fVars
∪
dVars
)
outVars
->
ssa
(
Let
m
n
e
'
c
)
(
fVars
∪
dVars
)
outVars
->
NatSet
.
Subset
(
usedVars
e
)
(
fVars
∪
dVars
)
->
NatSet
.
Subset
(
usedVars
e
)
(
fVars
∪
dVars
)
->
~
(
n
∈
fVars
∪
dVars
)
->
~
(
n
∈
fVars
∪
dVars
)
->
validRanges
e
A
E
Gamma
->
validRanges
e
A
E
Gamma
fBits
->
validRanges
e
A
(
updEnv
n
vR
'
E
)
(
updDefVars
n
REAL
Gamma
).
validRanges
e
A
(
updEnv
n
vR
'
E
)
(
updDefVars
n
REAL
Gamma
)
fBits
.
Proof
.
Proof
.
intros
Hssa
Hsub
Hnotin
Hranges
.
intros
Hssa
Hsub
Hnotin
Hranges
.
induction
e
.
induction
e
.
...
@@ -2251,10 +2256,10 @@ Proof.
...
@@ -2251,10 +2256,10 @@ Proof.
rewrite
usedVars_toREval_toRExp_compat
;
auto
.
rewrite
usedVars_toREval_toRExp_compat
;
auto
.
Qed
.
Qed
.
Lemma
validAffineBoundsCmd_sound
(
c
:
cmd
Q
)
(
A
:
analysisResult
)
(
P
:
precond
)
Lemma
validAffineBoundsCmd_sound
(
c
:
cmd
Q
)
(
A
:
analysisResult
)
(
P
:
precond
)
fBits
fVars
dVars
outVars
(
E
:
env
)
Gamma
exprAfs
noise
iexpmap
inoise
map1
:
fVars
dVars
outVars
(
E
:
env
)
Gamma
exprAfs
noise
iexpmap
inoise
map1
:
(
forall
e
,
(
exists
af
,
FloverMap
.
find
e
iexpmap
=
Some
af
)
->
(
forall
e
,
(
exists
af
,
FloverMap
.
find
e
iexpmap
=
Some
af
)
->
checked_expressions
A
E
Gamma
fVars
dVars
e
iexpmap
inoise
map1
)
->
checked_expressions
A
E
Gamma
f
Bits
f
Vars
dVars
e
iexpmap
inoise
map1
)
->
(
inoise
>
0
)
%
nat
->
(
inoise
>
0
)
%
nat
->
(
forall
n
,
(
n
>=
inoise
)
%
nat
->
map1
n
=
None
)
->
(
forall
n
,
(
n
>=
inoise
)
%
nat
->
map1
n
=
None
)
->
validAffineBoundsCmd
c
A
P
dVars
iexpmap
inoise
=
Some
(
exprAfs
,
noise
)
->
validAffineBoundsCmd
c
A
P
dVars
iexpmap
inoise
=
Some
(
exprAfs
,
noise
)
->
...
@@ -2272,12 +2277,12 @@ Lemma validAffineBoundsCmd_sound (c: cmd Q) (A: analysisResult) (P: precond)
...
@@ -2272,12 +2277,12 @@ Lemma validAffineBoundsCmd_sound (c: cmd Q) (A: analysisResult) (P: precond)
fresh
noise
af
/
\
fresh
noise
af
/
\
(
forall
n
,
(
n
>=
noise
)
%
nat
->
map2
n
=
None
)
/
\
(
forall
n
,
(
n
>=
noise
)
%
nat
->
map2
n
=
None
)
/
\
(
noise
>=
inoise
)
%
nat
/
\
(
noise
>=
inoise
)
%
nat
/
\
bstep
(
toREvalCmd
(
toRCmd
c
))
E
(
toRMap
Gamma
)
vR
REAL
/
\
bstep
(
toREvalCmd
(
toRCmd
c
))
E
(
toRMap
Gamma
)
fBits
vR
REAL
/
\
validRangesCmd
c
A
E
Gamma
/
\
validRangesCmd
c
A
E
Gamma
fBits
/
\
af_evals
(
afQ2R
af
)
vR
map2
/
\
af_evals
(
afQ2R
af
)
vR
map2
/
\
(
forall
e
,
FloverMap
.
find
e
iexpmap
=
None
->
(
forall
e
,
FloverMap
.
find
e
iexpmap
=
None
->
(
exists
af
,
FloverMap
.
find
e
exprAfs
=
Some
af
)
->
(
exists
af
,
FloverMap
.
find
e
exprAfs
=
Some
af
)
->
exists
E
'
Gamma
'
dVars
,
checked_expressions
A
E
'
Gamma
'
fVars
dVars
e
exprAfs
noise
map2
).
exists
E
'
Gamma
'
dVars
,
checked_expressions
A
E
'
Gamma
'
f
Bits
f
Vars
dVars
e
exprAfs
noise
map2
).
Proof
.
Proof
.
revert
E
Gamma
dVars
iexpmap
inoise
exprAfs
noise
map1
.
revert
E
Gamma
dVars
iexpmap
inoise
exprAfs
noise
map1
.
induction
c
;
intros
*
visitedExpr
Hnoise
Hmapvalid
valid_bounds_cmd
induction
c
;
intros
*
visitedExpr
Hnoise
Hmapvalid
valid_bounds_cmd
...
...
coq/CertificateChecker.v
View file @
313ac660
...
@@ -12,9 +12,10 @@ From Flover
...
@@ -12,9 +12,10 @@ From Flover
Require
Export
Infra
.
ExpressionAbbrevs
Flover
.
Commands
Coq
.
QArith
.
QArith
.
Require
Export
Infra
.
ExpressionAbbrevs
Flover
.
Commands
Coq
.
QArith
.
QArith
.
(
**
Certificate
checking
function
**
)
(
**
Certificate
checking
function
**
)
Definition
CertificateChecker
(
e
:
expr
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
(
defVars
:
nat
->
option
mType
)
:=
Definition
CertificateChecker
(
e
:
expr
Q
)
(
absenv
:
analysisResult
)
let
tMap
:=
(
typeMap
defVars
e
(
FloverMap
.
empty
mType
))
in
(
P
:
precond
)
(
defVars
:
nat
->
option
mType
)
(
fBits
:
FloverMap
.
t
nat
)
:=
if
(
typeCheck
e
defVars
tMap
)
let
tMap
:=
(
typeMap
defVars
e
(
FloverMap
.
empty
mType
)
fBits
)
in
if
(
typeCheck
e
defVars
tMap
fBits
)
then
then
if
RangeValidator
e
absenv
P
NatSet
.
empty
&&
FPRangeValidator
e
absenv
tMap
NatSet
.
empty
if
RangeValidator
e
absenv
P
NatSet
.
empty
&&
FPRangeValidator
e
absenv
tMap
NatSet
.
empty
then
RoundoffErrorValidator
e
tMap
absenv
NatSet
.
empty
then
RoundoffErrorValidator
e
tMap
absenv
NatSet
.
empty
...
@@ -26,7 +27,8 @@ Definition CertificateChecker (e:expr Q) (absenv:analysisResult) (P:precond) (de
...
@@ -26,7 +27,8 @@ Definition CertificateChecker (e:expr Q) (absenv:analysisResult) (P:precond) (de
Apart
from
assuming
two
executions
,
one
in
R
and
one
on
floats
,
we
assume
that
Apart
from
assuming
two
executions
,
one
in
R
and
one
on
floats
,
we
assume
that
the
real
valued
execution
respects
the
precondition
.
the
real
valued
execution
respects
the
precondition
.
**
)
**
)
Theorem
Certificate_checking_is_sound
(
e
:
expr
Q
)
(
absenv
:
analysisResult
)
P
defVars
:
Theorem
Certificate_checking_is_sound
(
e
:
expr
Q
)
(
absenv
:
analysisResult
)
P
defVars
fBits
:
forall
(
E1
E2
:
env
),
forall
(
E1
E2
:
env
),
approxEnv
E1
defVars
absenv
(
usedVars
e
)
NatSet
.
empty
E2
->
approxEnv
E1
defVars
absenv
(
usedVars
e
)
NatSet
.
empty
E2
->
(
forall
v
,
NatSet
.
In
v
(
Expressions
.
usedVars
e
)
->
(
forall
v
,
NatSet
.
In
v
(
Expressions
.
usedVars
e
)
->
...
@@ -35,13 +37,13 @@ Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P defVa
...
@@ -35,13 +37,13 @@ Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P defVa
(
forall
v
,
NatSet
.
In
v
(
usedVars
e
)
->
(
forall
v
,
NatSet
.
In
v
(
usedVars
e
)
->
exists
m
:
mType
,
exists
m
:
mType
,
defVars
v
=
Some
m
)
->
defVars
v
=
Some
m
)
->
CertificateChecker
e
absenv
P
defVars
=
true
->
CertificateChecker
e
absenv
P
defVars
fBits
=
true
->
exists
iv
err
vR
vF
m
,
exists
iv
err
vR
vF
m
,
FloverMap
.
find
e
absenv
=
Some
(
iv
,
err
)
/
\
FloverMap
.
find
e
absenv
=
Some
(
iv
,
err
)
/
\
eval_expr
E1
(
toRMap
defVars
)
(
toREval
(
toRExp
e
))
vR
REAL
/
\
eval_expr
E1
(
toRMap
defVars
)
(
toR
BMap
fBits
)
(
toR
Eval
(
toRExp
e
))
vR
REAL
/
\
eval_expr
E2
defVars
(
toRExp
e
)
vF
m
/
\
eval_expr
E2
defVars
(
toR
BMap
fBits
)
(
toR
Exp
e
)
vF
m
/
\
(
forall
vF
m
,
(
forall
vF
m
,
eval_expr
E2
defVars
(
toRExp
e
)
vF
m
->
eval_expr
E2
defVars
(
toR
BMap
fBits
)
(
toR
Exp
e
)
vF
m
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
err
))
%
R
.
(
Rabs
(
vR
-
vF
)
<=
Q2R
err
))
%
R
.
(
**
(
**
The
proofs
is
a
simple
composition
of
the
soundness
proofs
for
the
range
The
proofs
is
a
simple
composition
of
the
soundness
proofs
for
the
range
...
@@ -68,19 +70,20 @@ Proof.
...
@@ -68,19 +70,20 @@ Proof.
{
unfold
vars_typed
.
intros
;
apply
types_defined
.
set_tac
.
destruct
H1
;
set_tac
.
{
unfold
vars_typed
.
intros
;
apply
types_defined
.
set_tac
.
destruct
H1
;
set_tac
.
split
;
try
auto
.
hnf
;
intros
;
set_tac
.
}
split
;
try
auto
.
hnf
;
intros
;
set_tac
.
}
rename
R
into
validFPRanges
.
rename
R
into
validFPRanges
.
assert
(
validRanges
e
absenv
E1
defVars
)
as
valid_e
.
assert
(
validRanges
e
absenv
E1
defVars
(
toRBMap
fBits
)
)
as
valid_e
.
{
eapply
(
RangeValidator_sound
e
(
dVars
:=
NatSet
.
empty
)
(
A
:=
absenv
)
(
P
:=
P
)
(
Gamma
:=
defVars
)
(
E
:=
E1
));
{
eapply
(
RangeValidator_sound
e
(
dVars
:=
NatSet
.
empty
)
(
A
:=
absenv
)
(
P
:=
P
)
(
Gamma
:=
defVars
)
(
E
:=
E1
));
auto
.
}
auto
.
}
pose
proof
(
validRanges_single
_
_
_
_
valid_e
)
as
valid_single
;
pose
proof
(
validRanges_single
_
_
_
_
_
valid_e
)
as
valid_single
;
destruct
valid_single
as
[
iv_e
[
err_e
[
vR
[
map_e
[
eval_real
real_bounds_e
]]]]].
destruct
valid_single
as
[
iv_e
[
err_e
[
vR
[
map_e
[
eval_real
real_bounds_e
]]]]].
destruct
iv_e
as
[
elo
ehi
].
destruct
iv_e
as
[
elo
ehi
].
edestruct
(
RoundoffErrorValidator_sound
e
(
typeMap
defVars
e
(
FloverMap
.
empty
mType
))
L
approxE1E2
H0
eval_real
R0
valid_e
H1
map_e
)
as
[[
vF
[
mF
eval_float
]]
err_bounded
];
auto
.
edestruct
(
RoundoffErrorValidator_sound
e
(
typeMap
defVars
e
(
FloverMap
.
empty
mType
)
fBits
)
L
approxE1E2
H0
eval_real
R0
valid_e
H1
map_e
)
as
[[
vF
[
mF
eval_float
]]
err_bounded
];
auto
.
exists
(
elo
,
ehi
),
err_e
,
vR
,
vF
,
mF
;
split
;
auto
.
exists
(
elo
,
ehi
),
err_e
,
vR
,
vF
,
mF
;
split
;
auto
.
Qed
.
Qed
.
Definition
CertificateCheckerCmd
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
defVars
:=
Definition
CertificateCheckerCmd
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
let
tMap
:=
typeMapCmd
defVars
f
(
FloverMap
.
empty
mType
)
in
defVars
fBits
:=
if
(
typeCheckCmd
f
defVars
tMap
&&
validSSA
f
(
freeVars
f
))
let
tMap
:=
typeMapCmd
defVars
f
(
FloverMap
.
empty
mType
)
fBits
in
if
(
typeCheckCmd
f
defVars
tMap
fBits
&&
validSSA
f
(
freeVars
f
))
then
then
if
(
RangeValidatorCmd
f
absenv
P
NatSet
.
empty
)
&&
if
(
RangeValidatorCmd
f
absenv
P
NatSet
.
empty
)
&&
FPRangeValidatorCmd
f
absenv
tMap
NatSet
.
empty
FPRangeValidatorCmd
f
absenv
tMap
NatSet
.
empty
...
@@ -88,7 +91,8 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) d
...
@@ -88,7 +91,8 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) d
else
false
else
false
else
false
.
else
false
.
Theorem
Certificate_checking_cmds_is_sound
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
P
defVars
:
Theorem
Certificate_checking_cmds_is_sound
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
P
defVars
fBits
:
forall
(
E1
E2
:
env
),
forall
(
E1
E2
:
env
),
approxEnv
E1
defVars
absenv
(
freeVars
f
)
NatSet
.
empty
E2
->
approxEnv
E1
defVars
absenv
(
freeVars
f
)
NatSet
.
empty
E2
->
(
forall
v
,
NatSet
.
In
v
(
freeVars
f
)
->
(
forall
v
,
NatSet
.
In
v
(
freeVars
f
)
->
...
@@ -97,13 +101,13 @@ Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P d
...
@@ -97,13 +101,13 @@ Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P d
(
forall
v
,
NatSet
.
In
v
(
freeVars
f
)
->
(
forall
v
,
NatSet
.
In
v
(
freeVars
f
)
->
exists
m
:
mType
,
exists
m
:
mType
,
defVars
v
=
Some
m
)
->
defVars
v
=
Some
m
)
->
CertificateCheckerCmd
f
absenv
P
defVars
=
true
->
CertificateCheckerCmd
f
absenv
P
defVars
fBits
=
true
->
exists
iv
err
vR
vF
m
,
exists
iv
err
vR
vF
m
,
FloverMap
.
find
(
getRetExp
f
)
absenv
=
Some
(
iv
,
err
)
/
\
FloverMap
.
find
(
getRetExp
f
)
absenv
=
Some
(
iv
,
err
)
/
\
bstep
(
toREvalCmd
(
toRCmd
f
))
E1
(
toRMap
defVars
)
vR
REAL
/
\
bstep
(
toREvalCmd
(
toRCmd
f
))
E1
(
toRMap
defVars
)
(
toRBMap
fBits
)
vR
REAL
/
\
bstep
(
toRCmd
f
)
E2
defVars
vF
m
/
\
bstep
(
toRCmd
f
)
E2
defVars
(
toRBMap
fBits
)
vF
m
/
\
(
forall
vF
m
,
(
forall
vF
m
,
bstep
(
toRCmd
f
)
E2
defVars
vF
m
->
bstep
(
toRCmd
f
)
E2
defVars
(
toRBMap
fBits
)
vF
m
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
(
err
))
%
R
).
(
Rabs
(
vR
-
vF
)
<=
Q2R
(
err
))
%
R
).
(
**
(
**
The
proofs
is
a
simple
composition
of
the
soundness
proofs
for
the
range
The
proofs
is
a
simple
composition
of
the
soundness
proofs
for
the
range
...
@@ -129,11 +133,11 @@ Proof.
...
@@ -129,11 +133,11 @@ Proof.
destruct
H0
;
set_tac
.
}
destruct
H0
;
set_tac
.
}
assert
(
NatSet
.
Subset
(
freeVars
f
--
NatSet
.
empty
)
(
freeVars
f
))
assert
(
NatSet
.
Subset
(
freeVars
f
--
NatSet
.
empty
)
(
freeVars
f
))
as
freeVars_contained
by
set_tac
.
as
freeVars_contained
by
set_tac
.
assert
(
validRangesCmd
f
absenv
E1
defVars
)
as
valid_f
.
assert
(
validRangesCmd
f
absenv
E1
defVars
(
toRBMap
fBits
)
)
as
valid_f
.
{
eapply
RangeValidatorCmd_sound
;
eauto
.
{
eapply
RangeValidatorCmd_sound
;
eauto
.
unfold
affine_dVars_range_valid
;
intros
.
unfold
affine_dVars_range_valid
;
intros
.
set_tac
.
}
set_tac
.
}
pose
proof
(
validRangesCmd_single
_
_
_
_
valid_f
)
as
valid_single
.
pose
proof
(
validRangesCmd_single
_
_
_
_
_
valid_f
)
as
valid_single
.
destruct
valid_single
as
[
iv
[
err
[
vR
[
map_f
[
eval_real
bounded_real_f
]]]]].
destruct
valid_single
as
[
iv
[
err
[
vR
[
map_f
[
eval_real
bounded_real_f
]]]]].
destruct
iv
as
[
f_lo
f_hi
].
destruct
iv
as
[
f_lo
f_hi
].
edestruct
(
RoundoffErrorValidatorCmd_sound
)
as
[[
vF
[
mF
eval_float
]]
?
];
eauto
.
edestruct
(
RoundoffErrorValidatorCmd_sound
)
as
[[
vF
[
mF
eval_float
]]
?
];
eauto
.
...
...
coq/Commands.v
View file @
313ac660
...
@@ -49,14 +49,14 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
...
@@ -49,14 +49,14 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
Define
big
step
semantics
for
the
Flover
language
,
terminating
on
a
"returned"
Define
big
step
semantics
for
the
Flover
language
,
terminating
on
a
"returned"
result
value
result
value
**
)
**
)
Inductive
bstep
:
cmd
R
->
env
->
(
nat
->
option
mType
)
->
R
->
mType
->
Prop
:=
Inductive
bstep
:
cmd
R
->
env
->
(
nat
->
option
mType
)
->
(
expr
R
->
option
nat
)
->
R
->
mType
->
Prop
:=
let_b
m
m
'
x
e
s
E
v
res
defVars
:
let_b
m
m
'
x
e
s
E
v
res
defVars
fBits
: