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
cfa68f4b
Commit
cfa68f4b
authored
Feb 03, 2017
by
Heiko Becker
Browse files
Implement let-Bindings in Coq and show soundness of let checker
parent
5b919837
Changes
6
Expand all
Hide whitespace changes
Inline
Side-by-side
coq/CertificateChecker.v
View file @
cfa68f4b
...
...
@@ -5,15 +5,15 @@
as
shown
in
the
soundness
theorem
.
**
)
Require
Import
Coq
.
Reals
.
Reals
Coq
.
QArith
.
Qreals
.
Require
Import
Daisy
.
Infra
.
RealSimps
Daisy
.
Infra
.
RationalSimps
Daisy
.
Infra
.
RealRationalProps
.
Require
Import
Daisy
.
IntervalValidation
Daisy
.
ErrorValidation
.
Require
Import
Daisy
.
Infra
.
RealSimps
Daisy
.
Infra
.
RationalSimps
Daisy
.
Infra
.
RealRationalProps
Daisy
.
Infra
.
Ltacs
.
Require
Import
Daisy
.
IntervalValidation
Daisy
.
ErrorValidation
Daisy
.
Environments
.
Require
Export
Coq
.
QArith
.
QArith
.
Require
Export
Daisy
.
Infra
.
ExpressionAbbrevs
.
(
**
Certificate
checking
function
**
)
Definition
CertificateChecker
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
:=
andb
(
validIntervalbounds
e
absenv
P
)
(
validErrorbound
e
absenv
).
andb
(
validIntervalbounds
e
absenv
P
NatSet
.
empty
)
(
validErrorbound
e
absenv
).
(
**
Soundness
proof
for
the
certificate
checker
.
...
...
@@ -22,9 +22,10 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) :=
This
property
is
expressed
by
the
predicate
precondValidForExec
.
**
)
Theorem
Certificate_checking_is_sound
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
P
:
forall
(
cenv
:
env
)
(
vR
:
R
)
(
vF
:
R
),
eval_exp
0
%
R
cenv
P
(
toRExp
e
)
vR
->
eval_exp
(
Q2R
machineEpsilon
)
cenv
P
(
toRExp
e
)
vF
->
forall
(
VarEnv1
VarEnv2
ParamEnv
:
env
)
(
vR
:
R
)
(
vF
:
R
),
approxEnv
VarEnv1
absenv
VarEnv2
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
toRExp
e
)
vR
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv2
ParamEnv
P
(
toRExp
e
)
vF
->
CertificateChecker
e
absenv
P
=
true
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
(
snd
(
absenv
e
)))
%
R
.
(
**
...
...
@@ -32,17 +33,50 @@ Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P:
validator
and
the
error
bound
validator
.
**
)
Proof
.
intros
cenv
vR
vF
eval_real
eval_float
certificate_valid
.
intros
VarEnv1
VarEnv2
ParamEnv
vR
vF
approxC1C2
eval_real
eval_float
certificate_valid
.
unfold
CertificateChecker
in
certificate_valid
.
apply
Is_true_eq_left
in
certificate_valid
.
apply
andb_prop_elim
in
certificate_valid
.
destruct
certificate_valid
as
[
iv_valid
errorbound_valid
].
apply
Is_true_eq_true
in
iv_valid
;
apply
Is_true_eq_true
in
errorbound_valid
.
andb_to_prop
certificate_valid
.
assert
(
exists
iv
err
,
absenv
e
=
(
iv
,
err
))
by
(
destruct
(
absenv
e
);
repeat
eexists
).
destruct
H
as
[
iv
[
err
absenv_eq
]].
assert
(
exists
ivlo
ivhi
,
iv
=
(
ivlo
,
ivhi
))
by
(
destruct
iv
;
repeat
eexists
).
destruct
H
as
[
ivlo
[
ivhi
iv_eq
]].
subst
;
rewrite
absenv_eq
in
*
;
simpl
in
*
.
eapply
(
validErrorbound_sound
e
cenv
absenv
vR
vF
err
P
);
eauto
.
eapply
(
validErrorbound_sound
);
eauto
.
intros
v
v_in_empty
.
rewrite
NatSet
.
mem_spec
in
v_in_empty
.
hnf
in
v_in_empty
.
inversion
v_in_empty
.
Qed
.
Definition
CertificateCheckerCmd
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
:=
andb
(
validIntervalboundsCmd
f
absenv
P
NatSet
.
empty
)
(
validErrorboundCmd
f
absenv
).
Theorem
Certificate_checking_cmds_is_sound
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
P
:
forall
(
VarEnv1
VarEnv2
ParamEnv
:
env
)
outVars
envR
envF
,
approxEnv
VarEnv1
absenv
VarEnv2
->
ssaPrg
Q
f
NatSet
.
empty
outVars
->
bstep
(
toRCmd
f
)
VarEnv1
ParamEnv
P
0
(
Nop
R
)
envR
->
bstep
(
toRCmd
f
)
VarEnv2
ParamEnv
P
(
Q2R
machineEpsilon
)
(
Nop
R
)
envF
->
CertificateCheckerCmd
f
absenv
P
=
true
->
(
Rabs
(
envR
0
%
nat
-
envF
0
%
nat
)
<=
Q2R
(
snd
(
absenv
(
Var
Q
0
))))
%
R
.
(
**
The
proofs
is
a
simple
composition
of
the
soundness
proofs
for
the
range
validator
and
the
error
bound
validator
.
**
)
Proof
.
intros
VarEnv1
VarEnv2
ParamEnv
outVars
envR
envF
approxC1C2
ssa_f
eval_real
eval_float
certificate_valid
.
unfold
CertificateCheckerCmd
in
certificate_valid
.
andb_to_prop
certificate_valid
.
assert
(
exists
iv
err
,
absenv
(
Var
Q
0
)
=
(
iv
,
err
))
by
(
destruct
(
absenv
(
Var
Q
0
));
repeat
eexists
).
destruct
H
as
[
iv
[
err
absenv_eq
]].
assert
(
exists
ivlo
ivhi
,
iv
=
(
ivlo
,
ivhi
))
by
(
destruct
iv
;
repeat
eexists
).
destruct
H
as
[
ivlo
[
ivhi
iv_eq
]].
subst
;
rewrite
absenv_eq
in
*
;
simpl
in
*
.
eapply
(
validErrorboundCmd_sound
);
eauto
.
intros
v
v_in_empty
.
rewrite
NatSet
.
mem_spec
in
v_in_empty
.
hnf
in
v_in_empty
.
inversion
v_in_empty
.
Qed
.
\ No newline at end of file
coq/Commands.v
View file @
cfa68f4b
...
...
@@ -3,7 +3,7 @@
FIXME:
Currently
the
semantics
are
stateful
.
But
daisy
actually
assumes
that
a
variable
may
not
be
verwritten
?
**
)
Require
Import
Coq
.
Reals
.
Reals
.
Require
Im
port
Daisy
.
Expressions
.
Require
Ex
port
Daisy
.
Infra
.
Expression
Abbrev
s
.
(
**
Next
define
what
a
program
is
.
Currently
no
loops
,
only
conditionals
and
assignments
...
...
coq/ErrorBounds.v
View file @
cfa68f4b
...
...
@@ -97,18 +97,20 @@ Qed.
(
**
Copy
-
Paste
proof
with
minor
differences
,
was
easier
then
manipulating
the
evaluations
and
then
applying
the
lemma
**
)
Lemma
subtract_abs_err_bounded
(
e1
:
exp
R
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
R
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
VarEnv
ParamEnv
:
nat
->
R
)
P
(
err1
:
R
)
(
err2
:
R
)
:
eval_exp
0
%
R
VarEnv
ParamEnv
P
e1
e1R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv
ParamEnv
P
e1
e1F
->
eval_exp
0
%
R
VarEnv
ParamEnv
P
e2
e2R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv
ParamEnv
P
e2
e2F
->
eval_exp
0
%
R
VarEnv
ParamEnv
P
(
Binop
Sub
e1
e2
)
vR
->
eval_exp
(
Q2R
machineEpsilon
)
(
updEnv
2
e2F
(
updEnv
1
e1F
VarEnv
))
ParamEnv
P
(
Binop
Sub
(
Var
R
1
)
(
Var
R
2
))
vF
->
(
Rabs
(
e1R
-
e1F
)
<=
err1
)
%
R
->
(
Rabs
(
e2R
-
e2F
)
<=
err2
)
%
R
->
(
Rabs
(
vR
-
vF
)
<=
err1
+
err2
+
((
Rabs
(
e1F
-
e2F
))
*
(
Q2R
machineEpsilon
)))
%
R
.
Lemma
subtract_abs_err_bounded
(
e1
:
exp
Q
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
Q
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
VarEnv1
VarEnv2
ParamEnv
:
nat
->
R
)
P
absenv
:
approxEnv
VarEnv1
absenv
VarEnv2
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
toRExp
e1
)
e1R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv2
ParamEnv
P
(
toRExp
e1
)
e1F
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
toRExp
e2
)
e2R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv2
ParamEnv
P
(
toRExp
e2
)
e2F
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
Binop
Sub
(
toRExp
e1
)
(
toRExp
e2
))
vR
->
eval_exp
(
Q2R
machineEpsilon
)
(
updEnv
2
e2F
(
updEnv
1
e1F
VarEnv2
))
ParamEnv
P
(
Binop
Sub
(
Var
R
1
)
(
Var
R
2
))
vF
->
(
Rabs
(
e1R
-
e1F
)
<=
Q2R
(
snd
(
absenv
e1
)))
%
R
->
(
Rabs
(
e2R
-
e2F
)
<=
Q2R
(
snd
(
absenv
e2
)))
%
R
->
(
Rabs
(
vR
-
vF
)
<=
Q2R
(
snd
(
absenv
e1
))
+
Q2R
(
snd
(
absenv
e2
))
+
((
Rabs
(
e1F
-
e2F
))
*
(
Q2R
machineEpsilon
)))
%
R
.
Proof
.
intros
e1_real
e1_float
e2_real
e2_float
sub_real
sub_float
bound_e1
bound_e2
.
intros
approxCEnv
e1_real
e1_float
e2_real
e2_float
sub_real
sub_float
bound_e1
bound_e2
.
(
*
Prove
that
e1R
and
e2R
are
the
correct
values
and
that
vR
is
e1R
+
e2R
*
)
inversion
sub_real
;
subst
.
rewrite
delta_0_deterministic
in
sub_real
;
auto
.
...
...
@@ -149,16 +151,18 @@ Proof.
eapply
Rmult_le_compat_l
;
[
apply
Rabs_pos
|
auto
].
Qed
.
Lemma
mult_abs_err_bounded
(
e1
:
exp
R
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
R
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
VarEnv
ParamEnv
:
env
)
(
P
:
precond
)
(
err1
:
R
)
(
err2
:
R
)
:
eval_exp
0
%
R
VarEnv
ParamEnv
P
e1
e1R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv
ParamEnv
P
e1
e1F
->
eval_exp
0
%
R
VarEnv
ParamEnv
P
e2
e2R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv
ParamEnv
P
e2
e2F
->
eval_exp
0
%
R
VarEnv
ParamEnv
P
(
Binop
Mult
e1
e2
)
vR
->
eval_exp
(
Q2R
machineEpsilon
)
(
updEnv
2
e2F
(
updEnv
1
e1F
VarEnv
))
ParamEnv
P
(
Binop
Mult
(
Var
R
1
)
(
Var
R
2
))
vF
->
Lemma
mult_abs_err_bounded
(
e1
:
exp
Q
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
Q
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
VarEnv1
VarEnv2
ParamEnv
:
env
)
(
P
:
precond
)
absenv
:
approxEnv
VarEnv1
absenv
VarEnv2
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
toRExp
e1
)
e1R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv2
ParamEnv
P
(
toRExp
e1
)
e1F
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
toRExp
e2
)
e2R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv2
ParamEnv
P
(
toRExp
e2
)
e2F
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
Binop
Mult
(
toRExp
e1
)
(
toRExp
e2
))
vR
->
eval_exp
(
Q2R
machineEpsilon
)
(
updEnv
2
e2F
(
updEnv
1
e1F
VarEnv2
))
ParamEnv
P
(
Binop
Mult
(
Var
R
1
)
(
Var
R
2
))
vF
->
(
Rabs
(
vR
-
vF
)
<=
Rabs
(
e1R
*
e2R
-
e1F
*
e2F
)
+
Rabs
(
e1F
*
e2F
)
*
(
Q2R
machineEpsilon
))
%
R
.
Proof
.
intros
e1_real
e1_float
e2_real
e2_float
mult_real
mult_float
.
intros
approxCEnv
e1_real
e1_float
e2_real
e2_float
mult_real
mult_float
.
(
*
Prove
that
e1R
and
e2R
are
the
correct
values
and
that
vR
is
e1R
*
e2R
*
)
inversion
mult_real
;
subst
.
rewrite
delta_0_deterministic
in
mult_real
;
auto
.
...
...
@@ -193,16 +197,18 @@ Proof.
apply
Rabs_pos
.
Qed
.
Lemma
div_abs_err_bounded
(
e1
:
exp
R
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
R
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
VarEnv
ParamEnv
:
env
)
(
P
:
precond
)
(
err1
:
R
)
(
err2
:
R
)
:
eval_exp
0
%
R
VarEnv
ParamEnv
P
e1
e1R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv
ParamEnv
P
e1
e1F
->
eval_exp
0
%
R
VarEnv
ParamEnv
P
e2
e2R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv
ParamEnv
P
e2
e2F
->
eval_exp
0
%
R
VarEnv
ParamEnv
P
(
Binop
Div
e1
e2
)
vR
->
eval_exp
(
Q2R
machineEpsilon
)
(
updEnv
2
e2F
(
updEnv
1
e1F
VarEnv
))
ParamEnv
P
(
Binop
Div
(
Var
R
1
)
(
Var
R
2
))
vF
->
Lemma
div_abs_err_bounded
(
e1
:
exp
Q
)
(
e1R
:
R
)
(
e1F
:
R
)
(
e2
:
exp
Q
)
(
e2R
:
R
)
(
e2F
:
R
)
(
vR
:
R
)
(
vF
:
R
)
(
VarEnv1
VarEnv2
ParamEnv
:
env
)
(
P
:
precond
)
absenv
:
approxEnv
VarEnv1
absenv
VarEnv2
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
toRExp
e1
)
e1R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv2
ParamEnv
P
(
toRExp
e1
)
e1F
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
toRExp
e2
)
e2R
->
eval_exp
(
Q2R
machineEpsilon
)
VarEnv2
ParamEnv
P
(
toRExp
e2
)
e2F
->
eval_exp
0
%
R
VarEnv1
ParamEnv
P
(
Binop
Div
(
toRExp
e1
)
(
toRExp
e2
))
vR
->
eval_exp
(
Q2R
machineEpsilon
)
(
updEnv
2
e2F
(
updEnv
1
e1F
VarEnv2
))
ParamEnv
P
(
Binop
Div
(
Var
R
1
)
(
Var
R
2
))
vF
->
(
Rabs
(
vR
-
vF
)
<=
Rabs
(
e1R
/
e2R
-
e1F
/
e2F
)
+
Rabs
(
e1F
/
e2F
)
*
(
Q2R
machineEpsilon
))
%
R
.
Proof
.
intros
e1_real
e1_float
e2_real
e2_float
div_real
div_float
.
intros
approxCenv
e1_real
e1_float
e2_real
e2_float
div_real
div_float
.
(
*
Prove
that
e1R
and
e2R
are
the
correct
values
and
that
vR
is
e1R
*
e2R
*
)
inversion
div_real
;
subst
.
rewrite
delta_0_deterministic
in
div_real
;
auto
.
...
...
coq/ErrorValidation.v
View file @
cfa68f4b
This diff is collapsed.
Click to expand it.
coq/IntervalValidation.v
View file @
cfa68f4b
...
...
@@ -7,7 +7,8 @@
**
)
Require
Import
Coq
.
QArith
.
QArith
Coq
.
QArith
.
Qreals
QArith
.
Qminmax
Coq
.
Lists
.
List
Coq
.
micromega
.
Psatz
.
Require
Import
Daisy
.
Infra
.
Abbrevs
Daisy
.
Infra
.
RationalSimps
Daisy
.
Infra
.
RealRationalProps
.
Require
Import
Daisy
.
Infra
.
ExpressionAbbrevs
Daisy
.
IntervalArithQ
Daisy
.
IntervalArith
Daisy
.
Infra
.
RealSimps
.
Require
Import
Daisy
.
Infra
.
Ltacs
Daisy
.
Infra
.
RealSimps
.
Require
Export
Daisy
.
IntervalArithQ
Daisy
.
IntervalArith
Daisy
.
ssaPrgs
.
Import
Lists
.
List
.
ListNotations
.
...
...
@@ -20,14 +21,14 @@ Fixpoint freeVars (V:Type) (f:exp V) : list nat:=
|
Binop
o
f1
f2
=>
(
freeVars
V
f1
)
++
(
freeVars
V
f2
)
end
.
Fixpoint
validIntervalbounds
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
:=
Fixpoint
validIntervalbounds
(
e
:
exp
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
validVars
:=
let
(
intv
,
_
)
:=
absenv
e
in
match
e
with
|
Var
_
v
=>
false
|
Var
_
v
=>
NatSet
.
mem
v
validVars
|
Param
_
v
=>
isSupersetIntv
(
P
v
)
intv
|
Const
n
=>
isSupersetIntv
(
n
,
n
)
intv
|
Unop
o
f
=>
let
rec
:=
validIntervalbounds
f
absenv
P
in
let
rec
:=
validIntervalbounds
f
absenv
P
validVars
in
let
(
iv
,
_
)
:=
absenv
f
in
let
opres
:=
match
o
with
...
...
@@ -44,7 +45,7 @@ Fixpoint validIntervalbounds (e:exp Q) (absenv:analysisResult) (P:precond):=
in
andb
rec
opres
|
Binop
op
f1
f2
=>
let
rec
:=
andb
(
validIntervalbounds
f1
absenv
P
)
(
validIntervalbounds
f2
absenv
P
)
in
let
rec
:=
andb
(
validIntervalbounds
f1
absenv
P
validVars
)
(
validIntervalbounds
f2
absenv
P
validVars
)
in
let
(
iv1
,
_
)
:=
absenv
f1
in
let
(
iv2
,
_
)
:=
absenv
f2
in
let
opres
:=
...
...
@@ -69,8 +70,22 @@ Fixpoint validIntervalbounds (e:exp Q) (absenv:analysisResult) (P:precond):=
andb
rec
opres
end
.
Theorem
ivbounds_approximatesPrecond_sound
f
absenv
P
:
validIntervalbounds
f
absenv
P
=
true
->
Fixpoint
validIntervalboundsCmd
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
validVars
{
struct
f
}
:
bool
:=
match
f
with
|
Let
_
x
e
g
=>
validIntervalbounds
e
absenv
P
validVars
&&
(
Qeq_bool
(
fst
(
fst
(
absenv
e
)))
(
fst
(
fst
(
absenv
(
Var
Q
x
))))
&&
Qeq_bool
(
snd
(
fst
(
absenv
e
)))
(
snd
(
fst
(
absenv
(
Var
Q
x
)))))
&&
validIntervalboundsCmd
g
absenv
P
(
NatSet
.
add
x
validVars
)
|
Ret
_
e
=>
validIntervalbounds
e
absenv
P
validVars
&&
(
Qeq_bool
(
fst
(
fst
(
absenv
e
)))
(
fst
(
fst
(
absenv
(
Var
Q
0
))))
&&
Qeq_bool
(
snd
(
fst
(
absenv
e
)))
(
snd
(
fst
(
absenv
(
Var
Q
0
)))))
|
Nop
_
=>
false
end
.
Theorem
ivbounds_approximatesPrecond_sound
f
absenv
P
V
:
validIntervalbounds
f
absenv
P
V
=
true
->
forall
v
,
In
v
(
freeVars
Q
f
)
->
Is_true
(
isSupersetIntv
(
P
v
)
(
fst
(
absenv
(
Param
Q
v
)))).
Proof
.
...
...
@@ -121,9 +136,9 @@ Qed.
Ltac
env_assert
absenv
e
name
:=
assert
(
exists
iv
err
,
absenv
e
=
(
iv
,
err
))
as
name
by
(
destruct
(
absenv
e
);
repeat
eexists
;
auto
).
Lemma
validBoundsDiv_uneq_zero
e1
e2
absenv
P
ivlo_e2
ivhi_e2
err
:
Lemma
validBoundsDiv_uneq_zero
e1
e2
absenv
P
V
ivlo_e2
ivhi_e2
err
:
absenv
e2
=
((
ivlo_e2
,
ivhi_e2
),
err
)
->
validIntervalbounds
(
Binop
Div
e1
e2
)
absenv
P
=
true
->
validIntervalbounds
(
Binop
Div
e1
e2
)
absenv
P
V
=
true
->
(
ivhi_e2
<
0
)
\
/
(
0
<
ivlo_e2
).
Proof
.
intros
absenv_eq
validBounds
.
...
...
@@ -139,19 +154,24 @@ Proof.
apply
le_neq_bool_to_lt_prop
;
auto
.
Qed
.
Theorem
validIntervalbounds_sound
(
f
:
exp
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
VarEnv
ParamEnv
:
Theorem
validIntervalbounds_sound
(
f
:
exp
Q
)
(
absenv
:
analysisResult
)
(
P
:
precond
)
V
VarEnv
ParamEnv
:
forall
vR
,
(
*
precondValidForExec
P
cenv
->*
)
validIntervalbounds
f
absenv
P
=
true
->
validIntervalbounds
f
absenv
P
V
=
true
->
(
forall
v
,
NatSet
.
mem
v
V
=
true
->
(
Q2R
(
fst
(
fst
(
absenv
(
Var
Q
v
))))
<=
VarEnv
v
<=
Q2R
(
snd
(
fst
(
absenv
(
Var
Q
v
)))))
%
R
)
->
eval_exp
0
%
R
VarEnv
ParamEnv
P
(
toRExp
f
)
vR
->
(
Q2R
(
fst
(
fst
(
absenv
f
)))
<=
vR
<=
Q2R
(
snd
(
fst
(
absenv
f
))))
%
R
.
Proof
.
induction
f
.
-
intros
vR
valid_bounds
eval_f
.
unfold
validIntervalbounds
in
valid_bounds
.
destruct
(
absenv
(
Var
Q
n
));
inversion
valid_bounds
.
-
intros
vR
valid_bounds
eval_f
.
pose
proof
(
ivbounds_approximatesPrecond_sound
(
Param
Q
n
)
absenv
P
valid_bounds
)
as
env_approx_p
.
induction
f
;
intros
vR
valid_bounds
valid_freeVars
eval_f
.
-
unfold
validIntervalbounds
in
valid_bounds
.
env_assert
absenv
(
Var
Q
n
)
absenv_var
.
destruct
absenv_var
as
[
iv
[
err
absenv_var
]].
specialize
(
valid_freeVars
n
).
rewrite
absenv_var
in
*
;
simpl
in
*
.
inversion
eval_f
;
subst
.
apply
valid_freeVars
;
auto
.
-
pose
proof
(
ivbounds_approximatesPrecond_sound
(
Param
Q
n
)
absenv
P
V
valid_bounds
)
as
env_approx_p
.
unfold
validIntervalbounds
in
valid_bounds
.
case_eq
(
absenv
(
Param
Q
n
)).
intros
intv
err
absenv_n
.
...
...
@@ -177,8 +197,7 @@ Proof.
rewrite
delta_0_deterministic
in
*
;
auto
.
rewrite
delta_0_deterministic
in
*
;
auto
.
split
;
lra
.
-
intros
vR
valid_bounds
eval_f
.
unfold
validIntervalbounds
in
valid_bounds
.
-
unfold
validIntervalbounds
in
valid_bounds
.
destruct
(
absenv
(
Const
v
))
as
[
intv
err
];
simpl
.
apply
Is_true_eq_left
in
valid_bounds
.
apply
andb_prop_elim
in
valid_bounds
.
...
...
@@ -195,8 +214,7 @@ Proof.
unfold
Qleb
in
*
.
apply
Qle_bool_iff
in
valid_hi
.
apply
Qle_Rle
in
valid_hi
;
auto
.
-
intros
vR
valid_bounds
eval_f
.
case_eq
(
absenv
(
Unop
u
f
));
intros
intv
err
absenv_unop
.
-
case_eq
(
absenv
(
Unop
u
f
));
intros
intv
err
absenv_unop
.
destruct
intv
as
[
unop_lo
unop_hi
];
simpl
.
unfold
validIntervalbounds
in
valid_bounds
.
rewrite
absenv_unop
in
valid_bounds
.
...
...
@@ -207,7 +225,7 @@ Proof.
destruct
valid_bounds
as
[
valid_rec
valid_unop
].
apply
Is_true_eq_true
in
valid_rec
.
inversion
eval_f
;
subst
.
+
specialize
(
IHf
v1
valid_rec
H2
).
+
specialize
(
IHf
v1
valid_rec
valid_freeVars
H2
).
rewrite
absenv_f
in
IHf
;
simpl
in
IHf
.
(
*
TODO
:
Make
lemma
*
)
unfold
isSupersetIntv
in
valid_unop
.
...
...
@@ -225,7 +243,7 @@ Proof.
*
eapply
Rle_trans
.
Focus
2.
apply
valid_hi
.
rewrite
Q2R_opp
;
lra
.
+
specialize
(
IHf
v1
valid_rec
H3
).
+
specialize
(
IHf
v1
valid_rec
valid_freeVars
H3
).
rewrite
absenv_f
in
IHf
;
simpl
in
IHf
.
apply
andb_prop_elim
in
valid_unop
.
destruct
valid_unop
as
[
valid_unop
nodiv0
].
...
...
@@ -293,7 +311,7 @@ Proof.
rewrite
<-
Q2R0_is_0
in
nodiv0_pos
.
apply
Rlt_Qlt
in
nodiv0_pos
;
apply
Rle_Qle
in
H2
;
lra
.
}
-
intros
vR
valid_bounds
eval_f
;
inversion
eval_f
;
subst
.
-
inversion
eval_f
;
subst
.
rewrite
delta_0_deterministic
in
eval_f
;
auto
.
rewrite
delta_0_deterministic
;
auto
.
simpl
in
valid_bounds
.
...
...
@@ -307,8 +325,8 @@ Proof.
apply
andb_prop_elim
in
valid_rec
.
destruct
valid_rec
as
[
valid_e1
valid_e2
].
apply
Is_true_eq_true
in
valid_e1
;
apply
Is_true_eq_true
in
valid_e2
.
specialize
(
IHf1
v1
valid_e1
H4
);
specialize
(
IHf2
v2
valid_e2
H5
).
specialize
(
IHf1
v1
valid_e1
valid_freeVars
H4
);
specialize
(
IHf2
v2
valid_e2
valid_freeVars
H5
).
rewrite
absenv_f1
in
IHf1
.
rewrite
absenv_f2
in
IHf2
.
destruct
b
;
simpl
in
*
.
...
...
@@ -439,3 +457,131 @@ Proof.
repeat
rewrite
<-
Q2R_mult
in
valid_div_hi
.
rewrite
<-
Q2R_max4
in
valid_div_hi
;
auto
.
}
Qed
.
Theorem
ssaVars_are_sound
(
f
:
cmd
Q
)
freeVars
outVars
(
absenv
:
analysisResult
)
(
v_lo
v_hi
err
:
R
)
VarEnv
ParamEnv
P
TEnv
:
ssaPrg
Q
f
(
freeVars
)
(
outVars
)
->
bstep
(
toRCmd
f
)
VarEnv
ParamEnv
P
0
%
R
(
Nop
R
)
TEnv
->
(
forall
v
,
NatSet
.
mem
v
freeVars
=
true
->
(
Q2R
(
fst
(
fst
(
absenv
(
Var
Q
v
))))
<=
VarEnv
v
<=
Q2R
(
snd
(
fst
(
absenv
(
Var
Q
v
)))))
%
R
)
->
validIntervalboundsCmd
f
absenv
P
(
freeVars
)
=
true
->
forall
v
:
nat
,
NatSet
.
mem
v
outVars
=
true
->
(
Q2R
(
fst
(
fst
(
absenv
(
Var
Q
v
))))
<=
TEnv
v
<=
Q2R
(
snd
(
fst
(
absenv
(
Var
Q
v
)))))
%
R
.
Proof
.
intros
ssa_f
.
revert
VarEnv
.
induction
ssa_f
;
intros
VarEnv
bstep_f
freeVars_sound
validBounds
v
in_outVars
;
unfold
validIntervalbounds
in
validBounds
;
andb_to_prop
validBounds
.
-
(
*
First
rename
auto
-
generated
hyp
names
*
)
rename
L
into
eq_lo
;
rename
R1
into
eq_hi
;
rename
L0
into
validBounds_e
.
inversion
bstep_f
;
subst
.
eapply
IHssa_f
;
eauto
.
+
intros
v1
mem_Vx
.
rewrite
NatSet
.
mem_spec
,
NatSet
.
add_spec
in
mem_Vx
.
unfold
updEnv
.
case_eq
(
v1
=?
x
);
intros
v1_eq_dec
.
*
assert
(
Q2R
(
fst
(
fst
(
absenv
e
)))
<=
v0
<=
Q2R
(
snd
(
fst
(
absenv
e
))))
%
R
as
validIV_e
by
(
eapply
validIntervalbounds_sound
;
eauto
).
rewrite
Nat
.
eqb_eq
in
v1_eq_dec
.
rewrite
v1_eq_dec
.
apply
Qeq_bool_iff
in
eq_lo
.
apply
Qeq_eqR
in
eq_lo
.
apply
Qeq_bool_iff
in
eq_hi
.
apply
Qeq_eqR
in
eq_hi
.
rewrite
<-
eq_lo
,
<-
eq_hi
.
auto
.
*
destruct
mem_Vx
.
{
subst
.
rewrite
Nat
.
eqb_neq
in
v1_eq_dec
.
hnf
in
v1_eq_dec
.
exfalso
.
apply
v1_eq_dec
.
reflexivity
.
}
{
apply
freeVars_sound
.
rewrite
NatSet
.
mem_spec
;
auto
.
}
-
rename
H
into
eq_V_Vterm
.
rewrite
NatSet
.
equal_spec
in
eq_V_Vterm
.
rewrite
NatSet
.
mem_spec
in
in_outVars
.
hnf
in
eq_V_Vterm
.
rewrite
<-
eq_V_Vterm
in
in_outVars
.
rewrite
<-
NatSet
.
mem_spec
in
in_outVars
.
inversion
bstep_f
;
subst
.
unfold
updEnv
.
case_eq
(
v
=?
0
);
intros
v_eq
.
+
assert
(
Q2R
(
fst
(
fst
(
absenv
e
)))
<=
v0
<=
Q2R
(
snd
(
fst
(
absenv
e
))))
%
R
by
(
eapply
validIntervalbounds_sound
;
eauto
).
rename
L0
into
eq_lo
;
rename
R0
into
eq_hi
.
apply
Qeq_bool_iff
in
eq_lo
;
apply
Qeq_eqR
in
eq_lo
.
apply
Qeq_bool_iff
in
eq_hi
;
apply
Qeq_eqR
in
eq_hi
.
rewrite
Nat
.
eqb_eq
in
v_eq
.
subst
.
rewrite
<-
eq_lo
,
<-
eq_hi
.
assumption
.
+
apply
freeVars_sound
;
auto
.
Qed
.
Theorem
validIntervalboundsCmd_sound
(
f
:
cmd
Q
)
(
absenv
:
analysisResult
)
:
forall
VarEnv
ParamEnv
envR
inVars
outVars
elo
ehi
err
P
,
ssaPrg
Q
f
inVars
outVars
->
bstep
(
toRCmd
f
)
VarEnv
ParamEnv
P
0
%
R
(
Nop
R
)
envR
->
(
forall
v
,
NatSet
.
mem
v
inVars
=
true
->
(
Q2R
(
fst
(
fst
(
absenv
(
Var
Q
v
))))
<=
VarEnv
v
<=
Q2R
(
snd
(
fst
(
absenv
(
Var
Q
v
)))))
%
R
)
->
validIntervalboundsCmd
f
absenv
P
inVars
=
true
->
absenv
(
Var
Q
0
%
nat
)
=
((
elo
,
ehi
),
err
)
->
(
Q2R
elo
<=
envR
(
0
%
nat
)
<=
Q2R
ehi
)
%
R
.
Proof
.
induction
f
;
intros
VarEnv
ParamEnv
envR
inVars
outVars
elo
ehi
err
P
ssa_f
eval_f
freeVars_def
valid_bounds_f
absenv_f
.
-
inversion
ssa_f
;
subst
.
inversion
eval_f
;
subst
.
unfold
validIntervalboundsCmd
in
valid_bounds_f
.
andb_to_prop
valid_bounds_f
.
eapply
IHf
;
eauto
.
intros
v0
mem_v0
.
unfold
updEnv
.
case_eq
(
v0
=?
n
);
intros
v0_eq
.
+
assert
(
Q2R
(
fst
(
fst
(
absenv
e
)))
<=
v
<=
Q2R
(
snd
(
fst
(
absenv
e
))))
%
R
by
(
eapply
validIntervalbounds_sound
;
eauto
).
rename
L
into
eq_lo
;
rename
R1
into
eq_hi
.
apply
Qeq_bool_iff
in
eq_lo
;
apply
Qeq_eqR
in
eq_lo
.
apply
Qeq_bool_iff
in
eq_hi
;
apply
Qeq_eqR
in
eq_hi
.
rewrite
Nat
.
eqb_eq
in
v0_eq
.
subst
.
rewrite
<-
eq_lo
,
<-
eq_hi
.
assumption
.
+
apply
freeVars_def
.
rewrite
NatSet
.
mem_spec
.
rewrite
NatSet
.
mem_spec
in
mem_v0
.
rewrite
NatSet
.
add_spec
in
mem_v0
.
destruct
mem_v0
.
*
rewrite
Nat
.
eqb_neq
in
v0_eq
.
exfalso
;
apply
v0_eq
;
auto
.
*
assumption
.
-
unfold
validIntervalboundsCmd
in
valid_bounds_f
.
andb_to_prop
valid_bounds_f
.
inversion
eval_f
;
subst
.
unfold
updEnv
.
assert
(
0
=?
0
=
true
)
as
refl0
by
(
apply
Nat
.
eqb_refl
).
rewrite
refl0
.
assert
(
Q2R
(
fst
(
fst
(
absenv
e
)))
<=
v
<=
Q2R
(
snd
(
fst
(
absenv
e
))))
%
R
by
(
eapply
validIntervalbounds_sound
;
eauto
).
rename
L0
into
eq_lo
;
rename
R0
into
eq_hi
.
apply
Qeq_bool_iff
in
eq_lo
;
apply
Qeq_eqR
in
eq_lo
.
apply
Qeq_bool_iff
in
eq_hi
;
apply
Qeq_eqR
in
eq_hi
.
subst
.
rewrite
absenv_f
in
*
;
simpl
in
*
.
rewrite
<-
eq_lo
,
<-
eq_hi
.
assumption
.
-
unfold
validIntervalboundsCmd
in
valid_bounds_f
.
inversion
valid_bounds_f
.
Qed
.
\ No newline at end of file
coq/ssaPrgs.v
0 → 100644
View file @
cfa68f4b
Require
Import
Coq
.
MSets
.
MSets
Coq
.
Arith
.
PeanoNat
.
Require
Export
Daisy
.
Commands
.
(
**
Module
for
an
ordered
type
with
leibniz
,
based
on
code
from
coq
-
club
code
http:
//coq-club.inria.narkive.com/zptqoou2/how-to-use-msets
**
)
Module
OWL
.
Definition
t
:=
nat
.
Definition
eq
:=
@
eq
t
.
Definition
eq_equiv
:
Equivalence
eq
:=
eq_equivalence
.
Definition
lt
:=
lt
.
Definition
lt_strorder
:
StrictOrder
lt
:=
Nat
.
lt_strorder
.
Instance
lt_compat
:
Proper
(
eq
==>
eq
==>
iff
)
lt
.
Proof
.
now
unfold
eq
;
split
;
subst
.
Qed
.
Definition
compare
:=
Compare_dec
.
nat_compare
.
Lemma
compare_spec
:
forall
x
y
,
CompSpec
eq
lt
x
y
(
compare
x
y
).
Proof
.
intros
;
case_eq
(
compare
x
y
);
constructor
.
now
apply
Compare_dec
.
nat_compare_eq
.
now
apply
Compare_dec
.
nat_compare_Lt_lt
.
now
apply
Compare_dec
.
nat_compare_Gt_gt
.
Qed
.
Definition
eq_dec
:=
Peano_dec
.
eq_nat_dec
.
Definition
eq_leibniz
a
b
(
H
:
eq
a
b
)
:=
H
.
End
OWL
.
Module
NatSet
:=
MakeWithLeibniz
OWL
.
Fixpoint
validVars
(
V
:
Type
)
(
f
:
exp
V
)
Vs
:
bool
:=
match
f
with
|
Const
n
=>
true
|
Var
_
v
=>
NatSet
.
mem
v
Vs
|
Param
_
v
=>
true
|
Unop
o
f1
=>
validVars
V
f1
Vs
|
Binop
o
f1
f2
=>
validVars
V
f1
Vs
&&
validVars
V
f2
Vs
end
.
Inductive
ssaPrg
(
V
:
Type
)
:
(
cmd
V
)
->
(
NatSet
.
t
)
->
(
NatSet
.
t
)
->
Prop
:=
ssaLet
x
e
s
inVars
Vterm
:
validVars
V
e
inVars
=
true
->
NatSet
.
mem
x
inVars
=
false
->
ssaPrg
V
s
(
NatSet
.
add
x
inVars
)
Vterm
->
ssaPrg
V
(
Let
V
x
e
s
)
inVars
Vterm
|
ssaRet
e
inVars
Vterm
:
NatSet
.
equal
inVars
Vterm
=
true
->
ssaPrg
V
(
Ret
V
e
)
inVars
Vterm
.
\ No newline at end of file
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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