Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
AVA
FloVer
Commits
e0ab9274
Commit
e0ab9274
authored
Feb 28, 2017
by
Raphaël Monat
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'certificates' of gitlab.mpi-sws.org:AVA/daisy into certificates
parents
72fd75f2
f28f4bb9
Changes
40
Hide whitespace changes
Inline
Side-by-side
Showing
40 changed files
with
1957 additions
and
1362 deletions
+1957
-1362
coq/Commands.v
coq/Commands.v
+13
-5
coq/ErrorValidation.v
coq/ErrorValidation.v
+1
-1
coq/Expressions.v
coq/Expressions.v
+15
-17
coq/Infra/Abbrevs.v
coq/Infra/Abbrevs.v
+4
-4
coq/Infra/Ltacs.v
coq/Infra/Ltacs.v
+4
-0
coq/ssaPrgs.v
coq/ssaPrgs.v
+96
-169
hol4/AbbrevsScript.sml
hol4/AbbrevsScript.sml
+17
-6
hol4/CertificateCheckerScript.sml
hol4/CertificateCheckerScript.sml
+1
-1
hol4/CommandsScript.sml
hol4/CommandsScript.sml
+1
-1
hol4/EnvironmentsScript.sml
hol4/EnvironmentsScript.sml
+1
-1
hol4/ErrorBoundsScript.sml
hol4/ErrorBoundsScript.sml
+2
-2
hol4/ErrorValidationScript.sml
hol4/ErrorValidationScript.sml
+1
-1
hol4/ExpressionAbbrevsScript.sml
hol4/ExpressionAbbrevsScript.sml
+1
-1
hol4/ExpressionsScript.sml
hol4/ExpressionsScript.sml
+76
-41
hol4/Holmakefile
hol4/Holmakefile
+2
-2
hol4/Infra/Holmakefile
hol4/Infra/Holmakefile
+0
-0
hol4/Infra/miscScript.sml
hol4/Infra/miscScript.sml
+0
-0
hol4/Infra/preamble.sml
hol4/Infra/preamble.sml
+0
-0
hol4/IntervalArithScript.sml
hol4/IntervalArithScript.sml
+1
-1
hol4/IntervalValidationScript.sml
hol4/IntervalValidationScript.sml
+1
-1
src/main/scala/daisy/Context.scala
src/main/scala/daisy/Context.scala
+15
-6
src/main/scala/daisy/InfoPhase.scala
src/main/scala/daisy/InfoPhase.scala
+10
-17
src/main/scala/daisy/analysis/DynamicPhase.scala
src/main/scala/daisy/analysis/DynamicPhase.scala
+1
-1
src/main/scala/daisy/analysis/RangeErrorPhase.scala
src/main/scala/daisy/analysis/RangeErrorPhase.scala
+31
-22
src/main/scala/daisy/analysis/RangePhase.scala
src/main/scala/daisy/analysis/RangePhase.scala
+1
-1
src/main/scala/daisy/analysis/SpecsProcessingPhase.scala
src/main/scala/daisy/analysis/SpecsProcessingPhase.scala
+2
-2
src/main/scala/daisy/backend/CertificatePhase.scala
src/main/scala/daisy/backend/CertificatePhase.scala
+80
-75
src/main/scala/daisy/backend/CodeGenerationPhase.scala
src/main/scala/daisy/backend/CodeGenerationPhase.scala
+1
-1
src/main/scala/daisy/lang/TreeOps.scala
src/main/scala/daisy/lang/TreeOps.scala
+15
-1
src/main/scala/daisy/solvers/Solver.scala
src/main/scala/daisy/solvers/Solver.scala
+2
-2
src/main/scala/daisy/utils/DynamicEvaluators.scala
src/main/scala/daisy/utils/DynamicEvaluators.scala
+149
-0
src/main/scala/daisy/utils/ErrorFunctions.scala
src/main/scala/daisy/utils/ErrorFunctions.scala
+0
-867
src/main/scala/daisy/utils/FinitePrecision.scala
src/main/scala/daisy/utils/FinitePrecision.scala
+62
-24
src/main/scala/daisy/utils/IntervalSubdivision.scala
src/main/scala/daisy/utils/IntervalSubdivision.scala
+341
-0
src/main/scala/daisy/utils/RangeEvaluators.scala
src/main/scala/daisy/utils/RangeEvaluators.scala
+94
-0
src/main/scala/daisy/utils/Rational.scala
src/main/scala/daisy/utils/Rational.scala
+4
-0
src/main/scala/daisy/utils/RoundoffEvaluators.scala
src/main/scala/daisy/utils/RoundoffEvaluators.scala
+316
-0
src/test/resources/AbsErrorRegressionFunctions.scala
src/test/resources/AbsErrorRegressionFunctions.scala
+35
-0
src/test/scala/regression/AbsErrorAnalysisRegressionTest.scala
...est/scala/regression/AbsErrorAnalysisRegressionTest.scala
+336
-89
src/test/scala/regression/FixedpointCodegenRegressionTest.scala
...st/scala/regression/FixedpointCodegenRegressionTest.scala
+225
-0
No files found.
coq/Commands.v
View file @
e0ab9274
...
...
@@ -7,8 +7,8 @@ Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Infra.NatSet.
(
**
Next
define
what
a
program
is
.
Currently
no
loops
,
o
nly
conditionals
and
assignments
Final
return
statement
Currently
no
loops
,
o
r
conditionals
.
Only
assignments
and
return
statement
**
)
Inductive
cmd
(
V
:
Type
)
:
Type
:=
Let:
mType
->
nat
->
exp
V
->
cmd
V
->
cmd
V
...
...
@@ -43,7 +43,8 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
*
)
(
**
Analogously
define
Big
Step
semantics
for
the
Daisy
language
Define
big
step
semantics
for
the
Daisy
language
,
terminating
on
a
"returned"
result
value
**
)
Inductive
bstep
:
cmd
R
->
env
->
R
->
mType
->
Prop
:=
let_b
m
m1
x
e
s
E
v
res
:
...
...
@@ -55,12 +56,19 @@ Inductive bstep : cmd R -> env -> R -> mType -> Prop :=
eval_exp
E
e
v
m
->
bstep
(
Ret
e
)
E
v
m
.
(
**
The
free
variables
of
a
command
are
all
used
variables
of
expressions
without
the
let
bound
variables
**
)
Fixpoint
freeVars
V
(
f
:
cmd
V
)
:
NatSet
.
t
:=
match
f
with
|
Let
_
x
e1
g
=>
NatSet
.
remove
x
(
NatSet
.
union
(
Expressions
.
free
Vars
e1
)
(
freeVars
g
))
|
Ret
e
=>
Expressions
.
free
Vars
e
|
Let
_
x
e1
g
=>
NatSet
.
remove
x
(
NatSet
.
union
(
Expressions
.
used
Vars
e1
)
(
freeVars
g
))
|
Ret
e
=>
Expressions
.
used
Vars
e
end
.
(
**
The
defined
variables
of
a
command
are
all
let
bound
variables
**
)
Fixpoint
definedVars
V
(
f
:
cmd
V
)
:
NatSet
.
t
:=
match
f
with
|
Let
_
x
_
g
=>
NatSet
.
add
x
(
definedVars
g
)
...
...
coq/ErrorValidation.v
View file @
e0ab9274
...
...
@@ -141,7 +141,7 @@ Proof.
apply
Rmult_le_compat_r
.
{
apply
mEps_geq_zero
.
}
{
rewrite
<-
maxAbs_impl_RmaxAbs
.
apply
contained_leq_maxAbs
_val
.
apply
contained_leq_maxAbs
.
unfold
contained
;
simpl
.
pose
proof
(
validIntervalbounds_sound
(
Var
Q
x
)
A
P
(
E
:=
fun
y
:
nat
=>
if
y
=?
x
then
Some
nR
else
E1
y
)
(
vR
:=
nR
)
bounds_valid
(
fVars
:=
(
NatSet
.
add
x
fVars
)))
as
valid_bounds_prf
.
rewrite
absenv_var
in
valid_bounds_prf
;
simpl
in
valid_bounds_prf
.
...
...
coq/Expressions.v
View file @
e0ab9274
(
**
Formalization
of
the
base
expression
language
for
the
daisy
framework
Required
in
all
files
,
since
we
will
always
reason
about
expressions
.
Formalization
of
the
base
expression
language
for
the
daisy
framework
**
)
Require
Import
Coq
.
Reals
.
Reals
Coq
.
micromega
.
Psatz
Coq
.
QArith
.
QArith
Coq
.
QArith
.
Qreals
.
Require
Import
Daisy
.
Infra
.
RealRationalProps
.
...
...
@@ -136,12 +135,9 @@ Definition perturb (r:R) (e:R) :=
(
**
Define
expression
evaluation
relation
parametric
by
an
"error"
epsilon
.
This
value
will
be
used
later
to
express
float
computations
using
a
perturbation
of
the
real
valued
computation
by
(
1
+
delta
),
where
|
delta
|
<=
machine
epsilon
.
It
is
important
that
variables
are
not
perturbed
when
loading
from
an
environment
.
This
is
the
case
,
since
loading
a
float
value
should
not
increase
an
additional
error
.
Unary
negation
is
special
!
We
do
not
have
a
new
error
here
since
IEE
754
gives
us
a
sign
bit
The
result
value
expresses
float
computations
according
to
the
IEEE
standard
,
using
a
perturbation
of
the
real
valued
computation
by
(
1
+
delta
),
where
|
delta
|
<=
machine
epsilon
.
**
)
Inductive
eval_exp
(
E
:
env
)
:
(
exp
R
)
->
R
->
mType
->
Prop
:=
|
Var_load
m
m1
x
v
:
...
...
@@ -172,17 +168,21 @@ Inductive eval_exp (E:env) :(exp R) -> R -> mType -> Prop :=
eval_exp
E
f1
v1
m1
->
eval_exp
E
(
Downcast
m
f1
)
(
perturb
v1
delta
)
m
.
Fixpoint
freeVars
(
V
:
Type
)
(
e
:
exp
V
)
:
NatSet
.
t
:=
(
**
Define
the
set
of
"used"
variables
of
an
expression
to
be
the
set
of
variables
occuring
in
it
**
)
Fixpoint
usedVars
(
V
:
Type
)
(
e
:
exp
V
)
:
NatSet
.
t
:=
match
e
with
|
Var
_
_
x
=>
NatSet
.
singleton
x
|
Unop
u
e1
=>
free
Vars
e1
|
Binop
b
e1
e2
=>
NatSet
.
union
(
free
Vars
e1
)
(
free
Vars
e2
)
|
Downcast
_
e1
=>
free
Vars
e1
|
Unop
u
e1
=>
used
Vars
e1
|
Binop
b
e1
e2
=>
NatSet
.
union
(
used
Vars
e1
)
(
used
Vars
e2
)
|
Downcast
_
e1
=>
used
Vars
e1
|
_
=>
NatSet
.
empty
end
.
(
**
If
|
delta
|
<=
0
then
perturb
v
delta
is
exactly
v
.
If
|
delta
|
<=
0
then
perturb
v
delta
is
exactly
v
.
**
)
Lemma
delta_0_deterministic
(
v
:
R
)
(
delta
:
R
)
:
(
Rabs
delta
<=
0
)
%
R
->
...
...
@@ -249,8 +249,7 @@ Qed.
Helping
lemma
.
Needed
in
soundness
proof
.
For
each
evaluation
of
using
an
arbitrary
epsilon
,
we
can
replace
it
by
evaluating
the
subexpressions
and
then
binding
the
result
values
to
different
variables
in
the
Eironment
.
This
relies
on
the
property
that
variables
are
not
perturbed
as
opposed
to
parameters
variables
in
the
Environment
.
**
)
Lemma
binary_unfolding
b
f1
f2
m
E
vF
:
eval_exp
E
(
Binop
b
f1
f2
)
vF
m
->
...
...
@@ -302,7 +301,6 @@ Proof.
(
*
auto
.
*
)
Qed
.
(
**
Using
the
parametric
expressions
,
define
boolean
expressions
for
conditionals
**
)
...
...
@@ -311,7 +309,7 @@ Inductive bexp (V:Type) : Type :=
|
less
:
exp
V
->
exp
V
->
bexp
V
.
(
**
Define
evaluation
of
boolean
s
for
real
s
Define
evaluation
of
boolean
expression
s
**
)
(
*
Inductive
bval
(
E
:
env
)
:
(
bexp
R
)
->
Prop
->
Prop
:=
*
)
(
*
leq_eval
(
f1
:
exp
R
)
(
f2
:
exp
R
)
(
v1
:
R
)
(
v2
:
R
)
:
*
)
...
...
coq/Infra/Abbrevs.v
View file @
e0ab9274
...
...
@@ -17,7 +17,6 @@ define them to automatically unfold upon simplification.
**
)
Definition
interval
:
Type
:=
R
*
R
.
Definition
err
:
Type
:=
R
.
Definition
ann
:
Type
:=
interval
*
err
.
Definition
mkInterval
(
ivlo
:
R
)
(
ivhi
:
R
)
:=
(
ivlo
,
ivhi
).
Definition
IVlo
(
intv
:
interval
)
:=
fst
intv
.
Definition
IVhi
(
intv
:
interval
)
:=
snd
intv
.
...
...
@@ -37,9 +36,6 @@ Arguments mkIntv _ _/.
Arguments
ivlo
_
/
.
Arguments
ivhi
_
/
.
Ltac
iv_assert
iv
name
:=
assert
(
exists
ivlo
ivhi
,
iv
=
(
ivlo
,
ivhi
))
as
name
by
(
destruct
iv
;
repeat
eexists
;
auto
).
(
**
Later
we
will
argue
about
program
preconditions
.
Define
a
precondition
to
be
a
function
mapping
numbers
(
resp
.
variables
)
to
intervals
.
...
...
@@ -50,6 +46,10 @@ Definition precond :Type := nat -> intv.
Abbreviation
for
the
type
of
a
variable
environment
,
which
should
be
a
partial
function
**
)
Definition
env
:=
nat
->
option
(
R
*
mType
).
(
**
The
empty
environment
must
return
NONE
for
every
variable
**
)
Definition
emptyEnv
:
env
:=
fun
_
=>
None
.
(
**
...
...
coq/Infra/Ltacs.v
View file @
e0ab9274
...
...
@@ -2,6 +2,10 @@
Require
Import
Coq
.
Bool
.
Bool
Coq
.
Reals
.
Reals
.
Require
Import
Daisy
.
Infra
.
RealSimps
Daisy
.
Infra
.
NatSet
.
Ltac
iv_assert
iv
name
:=
assert
(
exists
ivlo
ivhi
,
iv
=
(
ivlo
,
ivhi
))
as
name
by
(
destruct
iv
;
repeat
eexists
;
auto
).
(
**
Automatic
translation
and
destruction
of
conjuctinos
with
andb
into
Props
**
)
Ltac
andb_to_prop
H
:=
apply
Is_true_eq_left
in
H
;
...
...
coq/ssaPrgs.v
View file @
e0ab9274
(
**
We
define
a
pseudo
SSA
predicate
.
The
formalization
is
similar
to
the
renamedApart
property
in
the
LVC
framework
by
Schneider
,
Smolka
and
Hack
http:
//dblp.org/rec/conf/itp/SchneiderSH15
Our
predicate
is
not
as
fully
fledged
as
theirs
,
but
we
especially
borrow
the
idea
of
annotating
the
program
with
the
predicate
with
the
set
of
free
and
defined
variables
**
)
Require
Import
Coq
.
QArith
.
QArith
Coq
.
QArith
.
Qreals
Coq
.
Reals
.
Reals
.
Require
Import
Coq
.
micromega
.
Psatz
.
Require
Import
Daisy
.
Infra
.
RealRationalProps
Daisy
.
Infra
.
Ltacs
.
Require
Export
Daisy
.
Commands
.
Fixpoint
validVars
(
V
:
Type
)
(
f
:
exp
V
)
Vs
:
bool
:=
match
f
with
|
Const
n
=>
true
|
Var
_
_
v
=>
NatSet
.
mem
v
Vs
|
Unop
o
f1
=>
validVars
f1
Vs
|
Binop
o
f1
f2
=>
validVars
f1
Vs
&&
validVars
f2
Vs
|
Downcast
_
f1
=>
validVars
f1
Vs
end
.
Lemma
validVars_subset_freeVars
T
(
e
:
exp
T
)
V
:
validVars
e
V
=
true
->
NatSet
.
Subset
(
Expressions
.
freeVars
e
)
V
.
Proof
.
revert
V
;
induction
e
;
simpl
;
intros
V
valid_V
;
try
auto
.
-
rewrite
NatSet
.
mem_spec
in
valid_V
.
hnf
.
intros
;
rewrite
NatSet
.
singleton_spec
in
*
;
subst
;
auto
.
-
hnf
;
intros
a
in_empty
;
inversion
in_empty
.
-
andb_to_prop
valid_V
.
hnf
;
intros
a
in_union
.
rewrite
NatSet
.
union_spec
in
in_union
.
destruct
in_union
as
[
in_e1
|
in_e2
].
+
specialize
(
IHe1
V
L
a
in_e1
);
auto
.
+
specialize
(
IHe2
V
R
a
in_e2
);
auto
.
Qed
.
Lemma
validVars_add
V
(
f
:
exp
V
)
Vs
n
:
validVars
f
Vs
=
true
->
validVars
f
(
NatSet
.
add
n
Vs
)
=
true
.
Lemma
validVars_add
V
(
e
:
exp
V
)
Vs
n
:
NatSet
.
Subset
(
usedVars
e
)
Vs
->
NatSet
.
Subset
(
usedVars
e
)
(
NatSet
.
add
n
Vs
).
Proof
.
induction
f
;
try
auto
.
-
intros
valid_var
.
unfold
validVars
in
*
;
simpl
in
*
.
rewrite
NatSet
.
mem_spec
in
*
.
induction
e
;
try
auto
.
-
intros
valid_subset
.
hnf
.
intros
a
in_singleton
.
specialize
(
valid_subset
a
in_singleton
).
rewrite
NatSet
.
add_spec
;
right
;
auto
.
-
intros
vars_binop
.
simpl
in
*
.
apply
Is_true_eq_left
in
vars_binop
.
apply
Is_true_eq_true
.
apply
andb_prop_intro
.
apply
andb_prop_elim
in
vars_binop
.
destruct
vars_binop
;
split
;
apply
Is_true_eq_left
.
+
apply
IHf1
.
apply
Is_true_eq_true
;
auto
.
+
apply
IHf2
.
apply
Is_true_eq_true
;
auto
.
Qed
.
Inductive
ssaPrg
(
V
:
Type
)
:
(
cmd
V
)
->
(
NatSet
.
t
)
->
(
NatSet
.
t
)
->
Prop
:=
ssaLet
m
x
e
s
inVars
Vterm
:
validVars
e
inVars
=
true
->
NatSet
.
mem
x
inVars
=
false
->
ssaPrg
s
(
NatSet
.
add
x
inVars
)
Vterm
->
ssaPrg
(
Let
m
x
e
s
)
inVars
Vterm
|
ssaRet
e
inVars
Vterm
:
validVars
e
inVars
=
true
->
NatSet
.
equal
inVars
(
NatSet
.
remove
0
%
nat
Vterm
)
=
true
->
ssaPrg
(
Ret
e
)
inVars
Vterm
.
Lemma
validVars_valid_subset
(
V
:
Type
)
(
e
:
exp
V
)
inVars
:
validVars
e
inVars
=
true
->
NatSet
.
Subset
(
Expressions
.
freeVars
e
)
inVars
.
Proof
.
induction
e
;
intros
vars_valid
;
unfold
validVars
in
*
;
simpl
in
*
;
try
auto
.
-
rewrite
NatSet
.
mem_spec
in
vars_valid
.
hnf
.
intros
;
rewrite
NatSet
.
singleton_spec
in
*
;
subst
;
auto
.
-
hnf
;
intros
a
in_empty
;
inversion
in_empty
.
-
hnf
;
intros
a
in_union
;
rewrite
NatSet
.
union_spec
in
in_union
.
rewrite
andb_true_iff
in
vars_valid
.
destruct
vars_valid
.
destruct
in_union
as
[
in_e1
|
in_e2
].
+
apply
IHe1
;
auto
.
+
apply
IHe2
;
auto
.
intros
a
in_empty
.
inversion
in_empty
.
-
simpl
;
intros
in_vars
.
intros
a
in_union
.
rewrite
NatSet
.
union_spec
in
in_union
.
destruct
in_union
.
+
apply
IHe1
;
try
auto
.
hnf
;
intros
.
apply
in_vars
.
rewrite
NatSet
.
union_spec
;
auto
.
+
apply
IHe2
;
try
auto
.
hnf
;
intros
.
apply
in_vars
.
rewrite
NatSet
.
union_spec
;
auto
.
Qed
.
Lemma
validVars_non_stuck
(
e
:
exp
Q
)
inVars
(
E
E
'
:
env
)
:
vali
dVars
e
inVars
=
true
->
E
'
=
toREvalEnv
E
->
(
forall
v
,
NatSet
.
In
v
(
Expressions
.
freeVars
e
)
->
exists
r
m
,
E
'
v
=
Some
(
r
,
m
))
%
R
->
exists
vR
,
eval_exp
E
'
(
toREval
(
toRExp
e
))
vR
M0
.
Lemma
validVars_non_stuck
(
e
:
exp
Q
)
inVars
E
:
NatSet
.
Subset
(
use
dVars
e
)
inVars
->
(
forall
v
,
NatSet
.
In
v
(
usedVars
e
)
->
exists
r
,
(
toREvalEnv
E
)
v
=
Some
(
r
,
M0
))
%
R
->
exists
vR
,
eval_exp
(
toREvalEnv
E
)
(
toREval
(
toRExp
e
))
vR
M0
.
Proof
.
revert
inVars
E
;
induction
e
;
intros
inVars
E
vars_valid
EnvR
fVars_live
.
revert
inVars
E
;
induction
e
;
intros
inVars
E
vars_valid
fVars_live
.
-
simpl
in
*
.
assert
(
NatSet
.
In
n
(
NatSet
.
singleton
n
))
as
in_n
by
(
rewrite
NatSet
.
singleton_spec
;
auto
).
specialize
(
fVars_live
n
in_n
).
destruct
fVars_live
as
[
vR
[
m1
E_def
]].
rewrite
EnvR
in
E_def
.
remember
(
E
n
)
as
en
.
destruct
en
as
[[
r
mr
]
|
p
].
+
unfold
toREvalEnv
in
E_def
.
rewrite
<-
Heqen
in
E_def
.
inversion
E_def
.
subst
.
exists
vR
.
pose
proof
(
isMorePrecise_refl
M0
).
eapply
(
Var_load
(
toREvalEnv
E
)
M0
n
);
eauto
.
unfold
toREvalEnv
.
rewrite
<-
Heqen
.
auto
.
+
unfold
toREvalEnv
in
E_def
.
rewrite
<-
Heqen
in
E_def
.
inversion
E_def
.
destruct
fVars_live
as
[
vR
E_def
].
exists
vR
;
constructor
;
auto
.
-
exists
(
perturb
(
Q2R
v
)
0
);
constructor
.
simpl
;
rewrite
Rabs_R0
;
rewrite
Q2R0_is_0
;
lra
.
-
assert
(
exists
vR
,
eval_exp
E
'
(
toREval
(
toRExp
e
))
vR
M0
)
simpl
(
meps
M0
)
;
rewrite
Rabs_R0
;
rewrite
Q2R0_is_0
;
lra
.
-
assert
(
exists
vR
,
eval_exp
(
toREvalEnv
E
)
(
toREval
(
toRExp
e
))
vR
M0
)
as
eval_e_def
by
(
eapply
IHe
;
eauto
).
destruct
eval_e_def
as
[
ve
eval_e_def
].
case_eq
u
;
intros
;
subst
.
+
exists
(
evalUnop
Neg
ve
);
e
constructor
;
e
auto
.
+
exists
(
perturb
(
evalUnop
Inv
ve
)
0
);
e
constructor
;
e
auto
.
simpl
.
rewrite
Q2R0_is_0
.
rewrite
Rabs_R0
;
lra
.
-
andb_to_prop
vars_valid
;
simpl
in
*
.
assert
(
exists
vR1
,
eval_exp
E
'
(
toREval
(
toRExp
e1
))
vR1
M0
)
as
eval_e1_def
.
+
exists
(
evalUnop
Neg
ve
);
constructor
;
auto
.
+
exists
(
perturb
(
evalUnop
Inv
ve
)
0
);
constructor
;
auto
.
simpl
(
meps
M0
);
rewrite
Q2R0_is_0
;
rewrite
Rabs_R0
;
lra
.
-
repeat
rewrite
NatSet
.
subset_spec
in
*
;
simpl
in
*
.
assert
(
exists
vR1
,
eval_exp
(
toREvalEnv
E
)
(
toREval
(
toRExp
e1
))
vR1
M0
)
as
eval_e1_def
.
+
eapply
IHe1
;
eauto
.
intros
.
destruct
(
fVars_live
v
)
as
[
vR
E_def
];
try
eauto
.
apply
NatSet
.
union_spec
;
auto
.
+
assert
(
exists
vR2
,
eval_exp
E
'
(
toREval
(
toRExp
e2
))
vR2
M0
)
as
eval_e2_def
.
*
eapply
IHe2
;
eauto
.
intros
.
*
hnf
;
intros
.
apply
vars_valid
.
rewrite
NatSet
.
union_spec
;
auto
.
*
intros
.
destruct
(
fVars_live
v
)
as
[
vR
E_def
];
try
eauto
.
apply
NatSet
.
union_spec
;
auto
.
+
assert
(
exists
vR2
,
eval_exp
(
toREvalEnv
E
)
(
toREval
(
toRExp
e2
))
vR2
M0
)
as
eval_e2_def
.
*
eapply
IHe2
;
eauto
.
{
hnf
;
intros
.
apply
vars_valid
.
rewrite
NatSet
.
union_spec
;
auto
.
}
{
intros
.
destruct
(
fVars_live
v
)
as
[
vR
E_def
];
try
eauto
.
apply
NatSet
.
union_spec
;
auto
.
}
*
destruct
eval_e1_def
as
[
vR1
eval_e1_def
];
destruct
eval_e2_def
as
[
vR2
eval_e2_def
].
exists
(
perturb
(
evalBinop
b
vR1
vR2
)
0
);
econstructor
;
eauto
.
auto
.
simpl
.
rewrite
Q2R0_is_0
.
rewrite
Rabs_R0
;
lra
.
-
assert
(
exists
vR
,
eval_exp
E
'
(
toREval
(
toRExp
e
))
vR
M0
)
as
eval_r_def
by
(
eapply
IHe
;
eauto
).
-
assert
(
exists
vR
,
eval_exp
(
toREvalEnv
E
)
(
toREval
(
toRExp
e
))
vR
M0
)
as
eval_r_def
by
(
eapply
IHe
;
eauto
).
destruct
eval_r_def
as
[
vr
eval_r_def
].
exists
vr
.
simpl
toREval
.
auto
.
Qed
.
Lemma
validVars_equal_set
V
(
e
:
exp
V
)
vars
vars
'
:
NatSet
.
Equal
vars
vars
'
->
validVars
e
vars
=
true
->
validVars
e
vars
'
=
true
.
Proof
.
revert
vars
vars
'
.
induction
e
;
intros
vars
vars
'
eq_set
valid_vars
;
simpl
in
*
;
auto
.
-
rewrite
NatSet
.
mem_spec
in
*
.
rewrite
<-
eq_set
;
auto
.
-
eapply
IHe
;
eauto
.
-
apply
Is_true_eq_true
.
apply
andb_prop_intro
.
andb_to_prop
valid_vars
.
split
;
apply
Is_true_eq_left
.
+
eapply
IHe1
;
eauto
.
+
eapply
IHe2
;
eauto
.
-
eapply
IHe
;
eauto
.
Qed
.
Inductive
ssaPrg
(
V
:
Type
)
:
(
cmd
V
)
->
(
NatSet
.
t
)
->
(
NatSet
.
t
)
->
Prop
:=
ssaLet
m
x
e
s
inVars
Vterm
:
NatSet
.
Subset
(
usedVars
e
)
inVars
->
NatSet
.
mem
x
inVars
=
false
->
ssaPrg
s
(
NatSet
.
add
x
inVars
)
Vterm
->
ssaPrg
(
Let
m
x
e
s
)
inVars
Vterm
|
ssaRet
e
inVars
Vterm
:
NatSet
.
Subset
(
usedVars
e
)
inVars
->
NatSet
.
Equal
inVars
Vterm
->
ssaPrg
(
Ret
e
)
inVars
Vterm
.
Lemma
ssa_subset_freeVars
V
(
f
:
cmd
V
)
inVars
outVars
:
ssaPrg
f
inVars
outVars
->
NatSet
.
Subset
(
Commands
.
freeVars
f
)
inVars
.
Proof
.
intros
ssa_f
;
induction
ssa_f
.
-
simpl
in
*
.
apply
validVars_subset_freeVars
in
H
.
hnf
;
intros
a
in_fVars
.
-
simpl
in
*
.
hnf
;
intros
a
in_fVars
.
rewrite
NatSet
.
remove_spec
,
NatSet
.
union_spec
in
in_fVars
.
destruct
in_fVars
as
[
in_union
not_eq
].
destruct
in_union
;
try
auto
.
...
...
@@ -169,7 +114,6 @@ Proof.
destruct
IHssa_f
;
subst
;
try
auto
.
exfalso
;
apply
not_eq
;
auto
.
-
hnf
;
intros
.
apply
validVars_subset_freeVars
in
H
.
simpl
in
H1
.
apply
H
;
auto
.
Qed
.
...
...
@@ -184,8 +128,7 @@ Proof.
revert
set_eq
;
revert
inVars
'
.
induction
ssa_f
.
-
constructor
.
+
eapply
validVars_equal_set
;
eauto
.
symmetry
;
auto
.
+
rewrite
set_eq
;
auto
.
+
case_eq
(
NatSet
.
mem
x
inVars
'
);
intros
case_mem
;
try
auto
.
rewrite
NatSet
.
mem_spec
in
case_mem
.
rewrite
set_eq
in
case_mem
.
...
...
@@ -194,21 +137,16 @@ Proof.
+
apply
IHssa_f
;
auto
.
apply
NatSetProps
.
Dec
.
F
.
add_m
;
auto
.
-
constructor
.
+
eapply
validVars_equal_set
;
eauto
.
symmetry
;
auto
.
+
rewrite
NatSet
.
equal_spec
in
*
.
hnf
.
intros
a
;
split
.
*
intros
in_primed
.
rewrite
<-
H0
.
rewrite
<-
set_eq
.
auto
.
*
intros
in_rem
.
rewrite
set_eq
.
rewrite
H0
;
auto
.
+
rewrite
set_eq
;
auto
.
+
rewrite
set_eq
;
auto
.
Qed
.
Fixpoint
validSSA
(
f
:
cmd
Q
)
(
inVars
:
NatSet
.
t
)
:=
match
f
with
|
Let
m
x
e
g
=>
andb
(
andb
(
negb
(
NatSet
.
mem
x
inVars
))
(
vali
dVars
e
inVars
))
(
validSSA
g
(
NatSet
.
add
x
inVars
))
|
Ret
e
=>
validVars
e
inVars
&&
(
negb
(
NatSet
.
mem
0
%
nat
inVars
))
andb
(
andb
(
negb
(
NatSet
.
mem
x
inVars
))
(
NatSet
.
subset
(
use
dVars
e
)
inVars
))
(
validSSA
g
(
NatSet
.
add
x
inVars
))
|
Ret
e
=>
NatSet
.
subset
(
usedVars
e
)
inVars
end
.
Lemma
validSSA_sound
f
inVars
:
...
...
@@ -223,32 +161,14 @@ Proof.
destruct
IHf
as
[
outVars
IHf
].
exists
outVars
.
constructor
;
eauto
.
rewrite
negb_true_iff
in
L0
.
auto
.
+
rewrite
<-
NatSet
.
subset_spec
;
auto
.
+
rewrite
negb_true_iff
in
L0
.
auto
.
-
intros
inVars
validSSA_ret
.
simpl
in
*
.
exists
(
NatSet
.
add
0
%
nat
inVars
).
andb_to_prop
validSSA_ret
.
exists
inVars
.
constructor
;
auto
.
rewrite
negb_true_iff
in
R
.
hnf
in
R
.
rewrite
NatSet
.
equal_spec
.
hnf
.
intros
a
.
rewrite
NatSet
.
remove_spec
,
NatSet
.
add_spec
.
split
.
+
intros
in_inVars
.
case_eq
(
a
=?
0
%
nat
).
*
intros
a_zero
.
rewrite
Nat
.
eqb_eq
in
a_zero
.
rewrite
a_zero
in
in_inVars
.
rewrite
<-
NatSet
.
mem_spec
in
in_inVars
.
rewrite
in_inVars
in
R
.
inversion
R
.
*
intros
a_neq_zero
.
apply
beq_nat_false
in
a_neq_zero
.
split
;
auto
.
+
intros
in_add_rem
.
destruct
in_add_rem
as
[
[
a_zero
|
a_inVars
]
a_neq_zero
];
try
auto
.
exfalso
;
eauto
.
+
rewrite
<-
NatSet
.
subset_spec
;
auto
.
+
hnf
;
intros
;
split
;
auto
.
Qed
.
Lemma
ssa_shadowing_free
m
x
y
v
v
'
e
f
inVars
outVars
E
:
...
...
@@ -341,7 +261,7 @@ revert E1 E2 vR.
Qed
.
Lemma
dummy_bind_ok
e
v
x
v
'
inVars
E
:
vali
dVars
e
inVars
=
true
->
NatSet
.
Subset
(
use
dVars
e
)
inVars
->
NatSet
.
mem
x
inVars
=
false
->
eval_exp
E
(
toREval
(
toRExp
e
))
v
M0
->
eval_exp
(
updEnv
x
M0
v
'
E
)
(
toREval
(
toRExp
e
))
v
M0
.
...
...
@@ -355,25 +275,32 @@ Proof.
intros
n_eq_x
.
rewrite
Nat
.
eqb_eq
in
n_eq_x
.
subst
;
simpl
in
*
.
rewrite
x_not_free
in
valid_vars
;
inversion
valid_vars
.
hnf
in
valid_vars
.
assert
(
NatSet
.
mem
x
(
NatSet
.
singleton
x
)
=
true
)
as
in_singleton
by
(
rewrite
NatSet
.
mem_spec
,
NatSet
.
singleton_spec
;
auto
).
rewrite
NatSet
.
mem_spec
in
*
.
specialize
(
valid_vars
x
in_singleton
).
rewrite
<-
NatSet
.
mem_spec
in
valid_vars
.
rewrite
valid_vars
in
*
;
congruence
.
+
econstructor
.
auto
.
rewrite
H
;
auto
.
-
inversion
eval_e
;
subst
;
constructor
;
auto
.
-
inversion
eval_e
;
subst
;
econstructor
;
eauto
.
-
simpl
in
valid_vars
.
apply
Is_true_eq_left
in
valid_vars
.
apply
andb_prop_elim
in
valid_vars
.
destruct
valid_vars
.
inversion
eval_e
;
subst
;
econstructor
;
eauto
;
assert
(
M0
=
M0
)
as
M00
by
auto
;
pose
proof
(
ifM0isJoin_l
M0
m1
m2
M00
H
4
);
pose
proof
(
ifM0isJoin_r
M0
m1
m2
M00
H
4
);
pose
proof
(
ifM0isJoin_l
M0
m1
m2
M00
H
2
);
pose
proof
(
ifM0isJoin_r
M0
m1
m2
M00
H
2
);
subst
.
+
eapply
IHe1
;
eauto
.
apply
Is_true_eq_true
;
auto
.
hnf
;
intros
a
in_e1
.
apply
valid_vars
;
rewrite
NatSet
.
union_spec
;
auto
.
+
eapply
IHe2
;
eauto
.
apply
Is_true_eq_true
;
auto
.
hnf
;
intros
a
in_e2
.
apply
valid_vars
;
rewrite
NatSet
.
union_spec
;
auto
.
-
apply
(
IHe
v1
x
v2
inVars
E
);
auto
.
Qed
.
...
...
@@ -507,7 +434,7 @@ Admitted.
Lemma
stepwise_substitution
x
e
v
f
E
vR
inVars
outVars
:
ssaPrg
(
toREvalCmd
(
toRCmd
f
))
inVars
outVars
->
NatSet
.
In
x
inVars
->
vali
dVars
e
inVars
=
true
->
NatSet
.
Subset
(
use
dVars
e
)
inVars
->
eval_exp
(
toREvalEnv
E
)
(
toREval
(
toRExp
e
))
v
M0
->
bstep
(
toREvalCmd
(
toRCmd
f
))
(
updEnv
x
M0
v
(
toREvalEnv
E
))
vR
M0
<->
bstep
(
toREvalCmd
(
toRCmd
(
map_subst
f
x
e
)))
(
toREvalEnv
E
)
vR
M0
.
...
...
hol4/
a
bbrevsScript.sml
→
hol4/
A
bbrevsScript.sml
View file @
e0ab9274
(*
*
This file contains some type abbreviations, to ease writing.
**)
open
preamble
open
realTheory
realLib
open
realTheory
realLib
sptreeTheory
val
_
=
new_theory
"
a
bbrevs"
;
val
_
=
new_theory
"
A
bbrevs"
;
(*
*
For the moment we need only one interval type in HOL, since we do not have the
problem of computability as we have it in Coq
...
...
@@ -10,8 +13,6 @@ val _ = type_abbrev("interval", ``:real#real``);
val
IVlo_def
=
Define
`IVlo
(
iv
:
interval
)
=
FST
iv`
;
val
IVhi_def
=
Define
`IVhi
(
iv
:
interval
)
=
SND
iv`
;
val
_
=
type_abbrev
(
"ann"
,
``:interval
#real
``
);
(*
*
Later we will argue about program preconditions.
Define a precondition to be a function mapping numbers (resp. variables) to intervals.
...
...
@@ -19,15 +20,25 @@ Define a precondition to be a function mapping numbers (resp. variables) to inte
val
_
=
type_abbrev
(
"precond"
,
``:num
->
interval``
);
(*
*
Abbreviation
s
for the
environment types
Abbreviation for the
type of a variable environment, which should be a partial function
**)
val
_
=
type_abbrev
(
"env"
,
``:num
->
real
option``
);
(*
*
Define environment update function as abbreviation.
The empty environment must return NONE for every variable
**)
val
emptyEnv_def
=
Define
`
emptyEnv
(
x
:
num
)
=
NONE`
;
(*
*
Define environment update function as abbreviation, for variable environments
**)
val
updEnv_def
=
Define
`
updEnv
(
x
:
num
)
(
v
:
real
)
(
E
:
env
)
(
y
:
num
)
:
real
option
=
if
y
=
x
then
SOME
v
else
E
y`
;