Skip to content
GitLab
Menu
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
43ce2820
Commit
43ce2820
authored
Mar 10, 2017
by
Raphaël Monat
Browse files
Proofs done until validErrorbound_sound included
parent
bd0ba831
Changes
7
Expand all
Hide whitespace changes
Inline
Side-by-side
coq/ErrorBounds.v
View file @
43ce2820
...
...
@@ -58,29 +58,28 @@ Lemma add_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
Proof
.
intros
e1_real
e1_float
e2_real
e2_float
plus_real
plus_float
bound_e1
bound_e2
.
(
*
Prove
that
e1R
and
e2R
are
the
correct
values
and
that
vR
is
e1R
+
e2R
*
)
inversion
plus_real
;
subst
;
assert
(
m3
=
M0
)
by
(
apply
(
ifM0isJoin_l
M0
m3
m4
);
auto
);
assert
(
m4
=
M0
)
by
(
apply
(
ifM0isJoin_r
M0
m3
m4
);
auto
);
subst
;
simpl
(
meps
M0
)
in
H3
;
rewrite
Q2R0_is_0
in
H3
;
auto
.
inversion
plus_real
;
subst
.
destruct
m0
;
destruct
m3
;
inversion
H2
;
simpl
in
H4
;
rewrite
Q2R0_is_0
in
H4
;
auto
.
rewrite
delta_0_deterministic
in
plus_real
;
auto
.
rewrite
(
delta_0_deterministic
(
evalBinop
Plus
v1
v2
)
delta
);
auto
.
unfold
evalBinop
in
*
;
simpl
in
*
.
clear
delta
H
3
.
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
6
e1_real
);
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
7
e2_real
).
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
6
e1_real
)
in
plus_real
.
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
7
e2_real
)
in
plus_real
.
clear
H
6
H
7
v1
v2
.
clear
delta
H
4
.
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
5
e1_real
);
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
6
e2_real
).
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
5
e1_real
)
in
plus_real
.
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
6
e2_real
)
in
plus_real
.
clear
H
5
H
6
v1
v2
.
(
*
Now
unfold
the
float
valued
evaluation
to
get
the
deltas
we
need
for
the
inequality
*
)
inversion
plus_float
;
subst
.
unfold
perturb
;
simpl
.
inversion
H
7
;
subst
;
inversion
H
8
;
subst
.
inversion
H
6
;
subst
;
inversion
H
7
;
subst
.
unfold
updEnv
;
simpl
.
unfold
updEnv
in
H
6
,
H
9
;
simpl
in
*
.
symmetry
in
H
6
,
H
9
.
inversion
H
6
;
inversion
H
9
;
subst
.
unfold
updEnv
in
H
5
,
H
8
;
simpl
in
*
.
symmetry
in
H
5
,
H
8
.
inversion
H
5
;
inversion
H
8
;
subst
.
(
*
We
have
now
obtained
all
necessary
values
from
the
evaluations
-->
remove
them
for
readability
*
)
clear
plus_float
H7
H8
plus_real
e1_real
e1_float
e2_real
e2_float
H
9
H
6
.
clear
plus_float
H7
H8
plus_real
e1_real
e1_float
e2_real
e2_float
H
5
H
8
.
repeat
rewrite
Rmult_plus_distr_l
.
rewrite
Rmult_1_r
.
rewrite
Rsub_eq_Ropp_Rplus
.
...
...
@@ -103,7 +102,7 @@ Proof.
eapply
Rle_trans
.
eapply
Rmult_le_compat_l
.
apply
Rabs_pos
.
apply
H
4
.
apply
H
3
.
apply
Req_le
;
auto
.
Qed
.
...
...
@@ -125,28 +124,27 @@ Proof.
intros
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
;
assert
(
m3
=
M0
)
by
(
apply
(
ifM0isJoin_l
M0
m3
m4
);
auto
);
assert
(
m4
=
M0
)
by
(
apply
(
ifM0isJoin_r
M0
m3
m4
);
auto
);
subst
;
simpl
(
meps
M0
)
in
H3
;
rewrite
Q2R0_is_0
in
H3
;
auto
.
destruct
m0
;
destruct
m3
;
inversion
H2
;
simpl
in
H4
;
rewrite
Q2R0_is_0
in
H4
;
auto
.
rewrite
delta_0_deterministic
in
sub_real
;
auto
.
rewrite
delta_0_deterministic
;
auto
.
unfold
evalBinop
in
*
;
simpl
in
*
.
clear
delta
H
3
.
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
6
e1_real
);
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
7
e2_real
).
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
6
e1_real
)
in
sub_real
.
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
7
e2_real
)
in
sub_real
.
clear
H
6
H
7
v1
v2
.
clear
delta
H
4
.
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
5
e1_real
);
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
6
e2_real
).
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
5
e1_real
)
in
sub_real
.
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
6
e2_real
)
in
sub_real
.
clear
H
5
H
6
v1
v2
.
(
*
Now
unfold
the
float
valued
evaluation
to
get
the
deltas
we
need
for
the
inequality
*
)
inversion
sub_float
;
subst
.
unfold
perturb
;
simpl
.
inversion
H
7
;
subst
;
inversion
H
8
;
subst
.
inversion
H
6
;
subst
;
inversion
H
7
;
subst
.
unfold
updEnv
;
simpl
.
symmetry
in
H
6
,
H
9
.
unfold
updEnv
in
H
6
,
H
9
;
simpl
in
H
6
,
H
9
.
inversion
H
6
;
inversion
H
9
;
subst
.
symmetry
in
H
5
,
H
8
.
unfold
updEnv
in
H
5
,
H
8
;
simpl
in
H
5
,
H
8
.
inversion
H
5
;
inversion
H
8
;
subst
.
(
*
We
have
now
obtained
all
necessary
values
from
the
evaluations
-->
remove
them
for
readability
*
)
clear
sub_float
H7
H8
sub_real
e1_real
e1_float
e2_real
e2_float
H
6
H
9
.
clear
sub_float
H7
H8
sub_real
e1_real
e1_float
e2_real
e2_float
H
5
H
8
.
repeat
rewrite
Rmult_plus_distr_l
.
rewrite
Rmult_1_r
.
repeat
rewrite
Rsub_eq_Ropp_Rplus
.
...
...
@@ -182,27 +180,26 @@ Proof.
intros
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
;
assert
(
m3
=
M0
)
by
(
apply
(
ifM0isJoin_l
M0
m3
m4
);
auto
);
assert
(
m4
=
M0
)
by
(
apply
(
ifM0isJoin_r
M0
m3
m4
);
auto
);
subst
;
simpl
(
meps
M0
)
in
H3
;
rewrite
Q2R0_is_0
in
H3
;
auto
.
destruct
m0
;
destruct
m3
;
inversion
H2
;
simpl
in
H4
;
rewrite
Q2R0_is_0
in
H4
;
auto
.
rewrite
delta_0_deterministic
in
mult_real
;
auto
.
rewrite
delta_0_deterministic
;
auto
.
unfold
evalBinop
in
*
;
simpl
in
*
.
clear
delta
H
3
.
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
6
e1_real
);
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
7
e2_real
).
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
6
e1_real
)
in
mult_real
.
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
7
e2_real
)
in
mult_real
.
clear
H
6
H
7
v1
v2
.
clear
delta
H
4
.
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
5
e1_real
);
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
6
e2_real
).
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
5
e1_real
)
in
mult_real
.
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
6
e2_real
)
in
mult_real
.
clear
H
5
H
6
v1
v2
.
(
*
Now
unfold
the
float
valued
evaluation
to
get
the
deltas
we
need
for
the
inequality
*
)
inversion
mult_float
;
subst
.
unfold
perturb
;
simpl
.
inversion
H
7
;
subst
;
inversion
H
8
;
subst
.
symmetry
in
H
6
,
H
9
;
inversion
H
6
;
subst
;
inversion
H
7
;
subst
.
symmetry
in
H
5
,
H
8
;
unfold
updEnv
in
*
;
simpl
in
*
.
inversion
H
6
;
inversion
H
9
;
subst
.
inversion
H
5
;
inversion
H
8
;
subst
.
(
*
We
have
now
obtained
all
necessary
values
from
the
evaluations
-->
remove
them
for
readability
*
)
clear
mult_float
H7
H8
mult_real
e1_real
e1_float
e2_real
e2_float
H
6
H
9
.
clear
mult_float
H7
H8
mult_real
e1_real
e1_float
e2_real
e2_float
H
5
H
8
.
repeat
rewrite
Rmult_plus_distr_l
.
rewrite
Rmult_1_r
.
rewrite
Rsub_eq_Ropp_Rplus
.
...
...
@@ -232,27 +229,26 @@ Proof.
intros
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
;
assert
(
m3
=
M0
)
by
(
apply
(
ifM0isJoin_l
M0
m3
m4
);
auto
);
assert
(
m4
=
M0
)
by
(
apply
(
ifM0isJoin_r
M0
m3
m4
);
auto
);
subst
;
simpl
(
meps
M0
)
in
H3
;
rewrite
Q2R0_is_0
in
H3
;
auto
.
destruct
m0
;
destruct
m3
;
inversion
H2
;
simpl
in
H4
;
rewrite
Q2R0_is_0
in
H4
;
auto
.
rewrite
delta_0_deterministic
in
div_real
;
auto
.
rewrite
delta_0_deterministic
;
auto
.
unfold
evalBinop
in
*
;
simpl
in
*
.
clear
delta
H
3
.
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
6
e1_real
);
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
7
e2_real
).
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
6
e1_real
)
in
div_real
.
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
7
e2_real
)
in
div_real
.
clear
H
6
H
7
v1
v2
.
clear
delta
H
4
.
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
5
e1_real
);
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
6
e2_real
).
rewrite
(
meps_0_deterministic
(
toRExp
e1
)
H
5
e1_real
)
in
div_real
.
rewrite
(
meps_0_deterministic
(
toRExp
e2
)
H
6
e2_real
)
in
div_real
.
clear
H
5
H
6
v1
v2
.
(
*
Now
unfold
the
float
valued
evaluation
to
get
the
deltas
we
need
for
the
inequality
*
)
inversion
div_float
;
subst
.
unfold
perturb
;
simpl
.
inversion
H
7
;
subst
;
inversion
H
8
;
subst
.
symmetry
in
H
6
,
H
9
;
inversion
H
6
;
subst
;
inversion
H
7
;
subst
.
symmetry
in
H
5
,
H
8
;
unfold
updEnv
in
*
;
simpl
in
*
.
inversion
H
6
;
inversion
H
9
;
subst
.
inversion
H
5
;
inversion
H
8
;
subst
.
(
*
We
have
now
obtained
all
necessary
values
from
the
evaluations
-->
remove
them
for
readability
*
)
clear
div_float
H7
H8
div_real
e1_real
e1_float
e2_real
e2_float
H
6
H
9
.
clear
div_float
H7
H8
div_real
e1_real
e1_float
e2_real
e2_float
H
5
H
8
.
repeat
rewrite
Rmult_plus_distr_l
.
rewrite
Rmult_1_r
.
rewrite
Rsub_eq_Ropp_Rplus
.
...
...
@@ -447,10 +443,10 @@ Proof.
rewrite
Q2R0_is_0
;
auto
.
Qed
.
Lemma
round_abs_err_bounded
(
e
:
exp
R
)
(
nR
nF1
nF
:
R
)
(
E
:
env
)
(
err
:
R
)
(
machineEpsilon
m
:
mType
)
:
eval_exp
E
(
toREval
e
)
nR
M0
->
eval_exp
E
e
nF1
m
->
eval_exp
(
updEnv
1
m
nF1
E
)
(
toRExp
(
Downcast
machineEpsilon
(
Var
Q
m
1
)))
nF
machineEpsilon
->
Lemma
round_abs_err_bounded
(
e
:
exp
R
)
(
nR
nF1
nF
:
R
)
(
E
1
E2
:
env
)
(
err
:
R
)
(
machineEpsilon
m
:
mType
)
:
eval_exp
E
1
(
toREval
e
)
nR
M0
->
eval_exp
E
2
e
nF1
m
->
eval_exp
(
updEnv
1
m
nF1
emptyEnv
)
(
toRExp
(
Downcast
machineEpsilon
(
Var
Q
m
1
)))
nF
machineEpsilon
->
(
Rabs
(
nR
-
nF1
)
<=
err
)
%
R
->
(
Rabs
(
nR
-
nF
)
<=
err
+
(
Rabs
nF1
)
*
Q2R
(
meps
machineEpsilon
))
%
R
.
Proof
.
...
...
coq/ErrorValidation.v
View file @
43ce2820
This diff is collapsed.
Click to expand it.
coq/Expressions.v
View file @
43ce2820
...
...
@@ -235,12 +235,12 @@ Inductive eval_exp (E:env) :(exp R) -> R -> mType -> Prop :=
Rle
(
Rabs
delta
)
(
Q2R
(
meps
m
))
->
eval_exp
E
f1
v1
m
->
eval_exp
E
(
Unop
Inv
f1
)
(
perturb
(
evalUnop
Inv
v1
)
delta
)
m
|
Binop_dist
m
m1
m2
op
f1
f2
v1
v2
delta
:
isJoinOf
m
m1
m2
=
true
->
Rle
(
Rabs
delta
)
(
Q2R
(
meps
m
))
->
|
Binop_dist
m1
m2
op
f1
f2
v1
v2
delta
:
(
*
isJoinOf
m
m1
m2
=
true
->
*
)
Rle
(
Rabs
delta
)
(
Q2R
(
meps
(
computeJoin
m1
m2
)
))
->
eval_exp
E
f1
v1
m1
->
eval_exp
E
f2
v2
m2
->
eval_exp
E
(
Binop
op
f1
f2
)
(
perturb
(
evalBinop
op
v1
v2
)
delta
)
m
eval_exp
E
(
Binop
op
f1
f2
)
(
perturb
(
evalBinop
op
v1
v2
)
delta
)
(
computeJoin
m1
m2
)
|
Downcast_dist
m
m1
f1
v1
delta
:
(
*
Downcast
expression
f1
(
evaluating
to
machine
type
m1
),
to
a
machine
type
m
,
less
precise
than
m1
.
*
)
isMorePrecise
m1
m
=
true
->
...
...
@@ -296,18 +296,27 @@ Proof.
-
inversion
eval_v1
;
inversion
eval_v2
;
subst
;
auto
;
try
repeat
(
repeat
rewrite
delta_0_deterministic
;
simpl
in
*
;
rewrite
Q2R0_is_0
in
*
;
subst
;
auto
);
simpl
.
assert
(
M0
=
M0
)
as
M00
by
auto
.
pose
proof
(
ifM0isJoin_l
M0
m0
m2
M00
H2
);
auto
.
pose
proof
(
ifM0isJoin_r
M0
m0
m2
M00
H2
);
auto
.
pose
proof
(
ifM0isJoin_l
M0
m4
m5
M00
H11
);
auto
.
pose
proof
(
ifM0isJoin_r
M0
m4
m5
M00
H11
);
auto
.
subst
.
destruct
m0
;
destruct
m2
;
inversion
H4
.
destruct
m3
;
destruct
m4
;
inversion
H10
.
simpl
in
*
.
rewrite
(
IHf1
v0
v4
M0
);
auto
.
rewrite
(
IHf2
v5
v3
M0
);
auto
.
rewrite
Q2R0_is_0
in
H2
,
H12
.
rewrite
delta_0_deterministic
;
auto
.
rewrite
delta_0_deterministic
;
auto
.
-
simpl
toREval
in
eval_v1
.
simpl
toREval
in
eval_v2
.
apply
(
IHf
v1
v2
m1
);
auto
.
Qed
.
(
*
Lemma
rnd_0_deterministic
f
E
m
v
:
*
)
(
*
eval_exp
E
(
toREval
(
Downcast
m
f
))
v
M0
<->
*
)
(
*
eval_exp
E
(
toREval
f
)
v
M0
.
*
)
(
*
Proof
.
*
)
(
*
split
;
intros
.
*
)
(
*
-
simpl
in
H
.
auto
.
*
)
(
*
-
simpl
;
auto
.
*
)
(
*
Qed
.
*
)
(
**
...
...
@@ -334,10 +343,11 @@ variables in the Environment.
Lemma
binary_unfolding
b
f1
f2
m
E
vF
:
eval_exp
E
(
Binop
b
f1
f2
)
vF
m
->
exists
vF1
vF2
m1
m2
,
eval_exp
E
f1
vF1
m1
/
\
eval_exp
E
f2
vF2
m2
/
\
eval_exp
(
updEnv
2
m2
vF2
(
updEnv
1
m1
vF1
emptyEnv
))
(
Binop
b
(
Var
R
m1
1
)
(
Var
R
m2
2
))
vF
m
.
m
=
computeJoin
m1
m2
/
\
eval_exp
E
f1
vF1
m1
/
\
eval_exp
E
f2
vF2
m2
/
\
eval_exp
(
updEnv
2
m2
vF2
(
updEnv
1
m1
vF1
emptyEnv
))
(
Binop
b
(
Var
R
m1
1
)
(
Var
R
m2
2
))
vF
m
.
Proof
.
intros
eval_float
.
inversion
eval_float
;
subst
.
...
...
coq/Infra/MachineType.v
View file @
43ce2820
...
...
@@ -272,6 +272,15 @@ Proof.
-
apply
EquivEqBoolEq
in
H
;
auto
.
Qed
.
Lemma
ifM0isJoin
(
m1
:
mType
)
(
m2
:
mType
)
:
isJoinOf
M0
m1
m2
=
true
->
m1
=
M0
/
\
m2
=
M0
.
Proof
.
assert
(
M0
=
M0
)
by
auto
.
intros
;
split
.
-
apply
(
ifM0isJoin_l
M0
m1
m2
);
auto
.
-
apply
(
ifM0isJoin_r
M0
m1
m2
);
auto
.
Qed
.
Lemma
computeJoinIsJoin
(
m1
:
mType
)
(
m2
:
mType
)
:
isJoinOf
(
computeJoin
m1
m2
)
m1
m2
=
true
.
Proof
.
...
...
coq/IntervalValidation.v
View file @
43ce2820
...
...
@@ -476,7 +476,7 @@ Proof.
rewrite
NatSet
.
diff_spec
in
in_diff_e1
.
destruct
in_diff_e1
as
[
in_usedVars
not_dVar
].
split
;
try
auto
.
asser
t
(
m1
=
M0
)
by
(
apply
(
ifM0isJoin_l
M0
m1
m2
);
auto
)
;
subst
;
auto
.
destruc
t
m1
;
destruct
m2
;
inversion
H2
;
subst
;
auto
.
+
assert
(
Q2R
(
fst
(
fst
(
iv2
,
err2
)))
<=
v2
<=
Q2R
(
snd
(
fst
(
iv2
,
err2
))))
%
R
as
valid_bounds_e2
.
*
apply
IHf2
;
try
auto
.
intros
v
in_diff_e2
.
...
...
@@ -484,7 +484,7 @@ Proof.
simpl
.
rewrite
NatSet
.
diff_spec
,
NatSet
.
union_spec
.
rewrite
NatSet
.
diff_spec
in
in_diff_e2
.
destruct
in_diff_e2
;
split
;
auto
.
assert
(
m2
=
M0
)
by
(
apply
(
ifM0isJoin_r
M0
m1
m2
)
;
auto
);
subst
;
auto
.
destruct
m1
;
destruct
m2
;
inversion
H2
;
auto
.
*
destruct
b
;
simpl
in
*
.
{
pose
proof
(
interval_addition_valid
(
iv1
:=
(
Q2R
(
fst
iv1
),
Q2R
(
snd
iv1
)))
(
iv2
:=
(
Q2R
(
fst
iv2
),
Q2R
(
snd
iv2
))))
as
valid_add
.
unfold
validIntervalAdd
in
valid_add
.
...
...
@@ -614,8 +614,10 @@ Proof.
rewrite
<-
Q2R_inv
in
valid_div_hi
;
[
|
auto
].
repeat
rewrite
<-
Q2R_mult
in
valid_div_hi
.
rewrite
<-
Q2R_max4
in
valid_div_hi
;
auto
.
}
}
+
simpl
in
H3
;
rewrite
Q2R0_is_0
in
H3
;
auto
.
+
simpl
in
H3
;
rewrite
Q2R0_is_0
in
H3
;
auto
.
+
destruct
m1
;
destruct
m2
;
inversion
H2
.
simpl
in
H4
;
rewrite
Q2R0_is_0
in
H4
;
auto
.
+
destruct
m1
;
destruct
m2
;
inversion
H2
.
simpl
in
H4
;
rewrite
Q2R0_is_0
in
H4
;
auto
.
-
unfold
validIntervalbounds
in
valid_bounds
.
(
*
simpl
erasure
in
valid_bounds
.
*
)
simpl
in
*
;
destruct
(
absenv
(
Downcast
m
f
));
destruct
(
absenv
f
);
simpl
in
*
.
...
...
coq/Typing.v
View file @
43ce2820
...
...
@@ -95,10 +95,9 @@ Proof.
rewrite
expEqBool_refl
;
simpl
.
rewrite
andb_true_r
.
rewrite
binopEqBool_refl
;
simpl
.
pose
proof
(
IHe1
E
v1
m1
H
7
).
pose
proof
(
IHe2
E
v2
m2
H
8
).
pose
proof
(
IHe1
E
v1
m1
H
6
).
pose
proof
(
IHe2
E
v2
m2
H
7
).
rewrite
H0
,
H1
.
assert
(
m
=
computeJoin
m1
m2
)
by
(
apply
isJoinComputeJoin
;
auto
);
subst
.
auto
.
-
rewrite
expEqBool_refl
.
assert
(
mTypeEqBool
m0
m0
=
true
)
by
(
apply
EquivEqBoolEq
;
auto
).
...
...
@@ -107,6 +106,59 @@ Proof.
rewrite
H1
,
H2
;
auto
.
Qed
.
Lemma
typingVarDet
(
e
:
exp
Q
)
m
m0
v
:
typeExpression
e
(
Var
Q
m
v
)
=
Some
m0
->
m
=
m0
.
Proof
.
revert
e
;
induction
e
;
intros
.
-
simpl
in
H
.
case_eq
(
mTypeEqBool
m1
m
&&
(
n
=?
v
));
intros
;
rewrite
H0
in
H
;
inversion
H
;
auto
.
rewrite
<-
H2
.
apply
andb_true_iff
in
H0
;
destruct
H0
as
[
H0m
H0n
].
apply
EquivEqBoolEq
in
H0m
;
auto
.
-
simpl
in
H
;
inversion
H
.
-
simpl
in
H
;
apply
IHe
;
auto
.
-
simpl
in
H
.
case_eq
(
typeExpression
e1
(
Var
Q
m
v
));
intros
;
rewrite
H0
in
H
;
auto
;
case_eq
(
typeExpression
e2
(
Var
Q
m
v
));
intros
;
rewrite
H1
in
H
;
auto
.
+
case_eq
(
mTypeEqBool
m1
m2
);
intros
;
rewrite
H2
in
H
;
inversion
H
;
auto
.
apply
IHe1
;
auto
.
rewrite
<-
H4
;
auto
.
+
inversion
H
;
subst
;
apply
IHe1
;
auto
.
+
inversion
H
;
subst
;
apply
IHe2
;
auto
.
+
inversion
H
.
-
apply
IHe
.
simpl
in
H
.
auto
.
Qed
.
Lemma
typingConstDet
(
e
:
exp
Q
)
m
m0
v
:
typeExpression
e
(
Const
m
v
)
=
Some
m0
->
m
=
m0
.
Proof
.
revert
e
;
induction
e
;
intros
.
-
simpl
in
H
;
inversion
H
.
-
simpl
in
H
.
case_eq
(
mTypeEqBool
m1
m
&&
Qeq_bool
v0
v
);
intros
;
rewrite
H0
in
H
;
inversion
H
;
auto
.
rewrite
<-
H2
.
apply
andb_true_iff
in
H0
;
destruct
H0
as
[
H0m
H0n
].
apply
EquivEqBoolEq
in
H0m
;
auto
.
-
simpl
in
H
;
apply
IHe
;
auto
.
-
simpl
in
H
.
case_eq
(
typeExpression
e1
(
Const
m
v
));
intros
;
rewrite
H0
in
H
;
auto
;
case_eq
(
typeExpression
e2
(
Const
m
v
));
intros
;
rewrite
H1
in
H
;
auto
.
+
case_eq
(
mTypeEqBool
m1
m2
);
intros
;
rewrite
H2
in
H
;
inversion
H
;
auto
.
apply
IHe1
;
auto
.
rewrite
<-
H4
;
auto
.
+
inversion
H
;
subst
;
apply
IHe1
;
auto
.
+
inversion
H
;
subst
;
apply
IHe2
;
auto
.
+
inversion
H
.
-
apply
IHe
.
simpl
in
H
.
auto
.
Qed
.
Fixpoint
isSubExpression
(
e
'
:
exp
Q
)
(
e
:
exp
Q
)
:=
orb
(
expEqBool
e
e
'
)
(
match
e
with
...
...
@@ -116,7 +168,7 @@ Fixpoint isSubExpression (e':exp Q) (e:exp Q) :=
|
Binop
b
e1
e2
=>
orb
(
isSubExpression
e
'
e1
)
(
isSubExpression
e
'
e2
)
|
Downcast
m
e1
=>
isSubExpression
e
'
e1
end
).
Lemma
typeNotSubExpr
e
e1
:
isSubExpression
e1
e
=
false
->
typeExpression
e
e1
=
None
.
Proof
.
...
...
@@ -149,6 +201,67 @@ Proof.
+
rewrite
orb_false_r
in
H
.
simpl
;
rewrite
H
;
auto
.
Qed
.
Lemma
typedVarIsSubExpr
e
m
v
:
typeExpression
e
(
Var
Q
m
v
)
=
Some
m
->
isSubExpression
(
Var
Q
m
v
)
e
=
true
.
Proof
.
revert
e
;
induction
e
;
intros
;
simpl
in
H
.
-
case_eq
(
mTypeEqBool
m0
m
&&
(
n
=?
v
));
intros
;
rewrite
H0
in
H
;
inversion
H
;
subst
.
simpl
;
rewrite
H0
;
auto
.
-
inversion
H
.
-
apply
IHe
;
auto
.
-
case_eq
(
typeExpression
e1
(
Var
Q
m
v
));
intros
;
case_eq
(
typeExpression
e2
(
Var
Q
m
v
));
intros
;
rewrite
H0
,
H1
in
H
;
inversion
H
;
subst
.
+
clear
H3
.
case_eq
(
mTypeEqBool
m0
m1
);
intros
;
rewrite
H2
in
H
;
inversion
H
;
subst
.
specialize
(
IHe1
H0
).
simpl
;
rewrite
IHe1
;
auto
.
+
specialize
(
IHe1
H0
);
simpl
;
rewrite
IHe1
;
auto
.
+
specialize
(
IHe2
H1
);
simpl
;
rewrite
IHe2
.
apply
orb_true_r
.
-
simpl
;
apply
IHe
;
auto
.
Qed
.
Lemma
typedIsSubExpr
e
f
m
:
typeExpression
e
f
=
Some
m
->
isSubExpression
f
e
=
true
.
Proof
.
revert
e
m
;
induction
e
;
intros
.
-
simpl
in
H
;
destruct
f
;
inversion
H
.
simpl
.
case_eq
(
mTypeEqBool
m
m1
&&
(
n
=?
n0
));
intros
;
rewrite
H0
in
H
;
inversion
H
.
auto
.
-
simpl
in
H
;
destruct
f
;
inversion
H
.
simpl
.
case_eq
(
mTypeEqBool
m
m1
&&
Qeq_bool
v
q
);
intros
;
rewrite
H0
in
H
;
inversion
H
.
auto
.
-
case_eq
(
expEqBool
(
Unop
u
e
)
f
);
intros
;
simpl
in
H
,
H0
;
rewrite
H0
in
H
.
+
destruct
f
;
[
inversion
H0
|
inversion
H0
|
|
inversion
H0
|
inversion
H0
].
simpl
.
rewrite
H0
;
auto
.
+
specialize
(
IHe
_
H
).
simpl
.
rewrite
IHe
.
apply
orb_true_r
.
-
case_eq
(
expEqBool
(
Binop
b
e1
e2
)
f
);
intros
;
simpl
in
H
,
H0
;
rewrite
H0
in
H
.
+
destruct
f
;
inversion
H0
.
rewrite
H0
.
simpl
.
rewrite
H0
.
auto
.
+
simpl
;
rewrite
H0
;
rewrite
orb_false_l
.
case_eq
(
typeExpression
e1
f
);
intros
;
rewrite
H1
in
H
.
*
specialize
(
IHe1
_
H1
).
rewrite
IHe1
;
auto
.
*
case_eq
(
typeExpression
e2
f
);
intros
;
rewrite
H2
in
H
;
inversion
H
;
subst
.
specialize
(
IHe2
_
H2
);
rewrite
IHe2
;
auto
.
apply
orb_true_r
.
-
case_eq
(
expEqBool
(
Downcast
m
e
)
f
);
intros
;
simpl
in
H
,
H0
;
rewrite
H0
in
H
.
+
destruct
f
;
inversion
H0
.
rewrite
H0
;
simpl
;
rewrite
H0
;
auto
.
+
specialize
(
IHe
_
H
).
simpl
.
rewrite
IHe
.
apply
orb_true_r
.
Qed
.
Lemma
typedVarIsUsed
e
m
m0
v
:
typeExpression
e
(
Var
Q
m0
v
)
=
Some
m
->
...
...
@@ -193,31 +306,247 @@ Proof.
Qed
.
Lemma
typingVarDet
(
e
:
exp
Q
)
m
m0
v
:
typeExpression
e
(
Var
Q
m
v
)
=
Some
m0
->
m
=
m0
.
Lemma
binary_type_unfolding
b
e1
e2
f
m
:
expEqBool
(
Binop
b
e1
e2
)
f
=
false
->
typeExpression
(
Binop
b
e1
e2
)
f
=
Some
m
->
(
typeExpression
e1
f
=
Some
m
\
/
typeExpression
e2
f
=
Some
m
).
Proof
.
revert
e
;
induction
e
;
intros
.
-
simpl
in
H
.
case_eq
(
mTypeEqBool
m1
m
&&
(
n
=?
v
));
intros
;
rewrite
H0
in
H
;
inversion
H
;
auto
.
rewrite
<-
H2
.
apply
andb_true_iff
in
H0
;
destruct
H0
as
[
H0m
H0n
].
apply
EquivEqBoolEq
in
H0m
;
auto
.
-
simpl
in
H
;
inversion
H
.
-
simpl
in
H
;
apply
IHe
;
auto
.
-
simpl
in
H
.
case_eq
(
typeExpression
e1
(
Var
Q
m
v
));
intros
;
rewrite
H0
in
H
;
auto
;
case_eq
(
typeExpression
e2
(
Var
Q
m
v
));
intros
;
rewrite
H1
in
H
;
auto
.
+
case_eq
(
mTypeEqBool
m1
m2
);
intros
;
rewrite
H2
in
H
;
inversion
H
;
auto
.
apply
IHe1
;
auto
.
rewrite
<-
H4
;
auto
.
+
inversion
H
;
subst
;
apply
IHe1
;
auto
.
+
inversion
H
;
subst
;
apply
IHe2
;
auto
.
+
inversion
H
.
-
apply
IHe
.
simpl
in
H
.
intros
notEq
typeBinop
.
assert
(
isSubExpression
f
(
Binop
b
e1
e2
)
=
true
)
as
isSubExpr
by
(
eapply
typedIsSubExpr
;
eauto
).
simpl
in
*
.
rewrite
notEq
in
*
.
case_eq
(
typeExpression
e1
f
);
intros
;
rewrite
H
in
typeBinop
.
-
case_eq
(
typeExpression
e2
f
);
intros
;
rewrite
H0
in
typeBinop
.
case_eq
(
mTypeEqBool
m0
m1
);
intros
;
rewrite
H1
in
typeBinop
;
inversion
typeBinop
;
subst
;
auto
.
left
;
auto
.
-
case_eq
(
typeExpression
e2
f
);
intros
;
rewrite
H0
in
typeBinop
.
+
right
;
auto
.
+
inversion
typeBinop
.
Qed
.
Lemma
stupidcase
e
e
'
m
m
'
:
expEqBool
e
e
'
=
true
->
typeExpression
e
e
=
Some
m
->
typeExpression
e
'
e
'
=
Some
m
'
->
m
=
m
'
.
Proof
.
revert
e
e
'
m
m
'
;
induction
e
;
destruct
e
'
;
intros
;
inversion
H
;
simpl
in
*
.
-
case_eq
(
mTypeEqBool
m
m
&&
(
n
=?
n
));
intros
;
case_eq
(
mTypeEqBool
m0
m0
&&
(
n0
=?
n0
));
intros
;
rewrite
H2
in
H0
;
rewrite
H4
in
H1
;
inversion
H0
;
inversion
H1
;
subst
;
auto
.
apply
andb_true_iff
in
H
;
destruct
H
;
apply
EquivEqBoolEq
in
H
;
auto
.
-
case_eq
(
mTypeEqBool
m
m
&&
Qeq_bool
v
v
);
intros
;
case_eq
(
mTypeEqBool
m0
m0
&&
Qeq_bool
q
q
);
intros
;
rewrite
H2
in
H0
;
rewrite
H4
in
H1
;
inversion
H0
;
inversion
H1
;
subst
;
auto
.
apply
andb_true_iff
in
H
;
destruct
H
;
apply
EquivEqBoolEq
in
H
;
auto
.
-
clear
H3
.
pose
proof
(
expEqBool_refl
(
Unop
u
e
));
simpl
in
H2
;
rewrite
H2
in
H0
.
pose
proof
(
expEqBool_refl
(
Unop
u0
e
'
));
simpl
in
H3
;
rewrite
H3
in
H1
.
apply
andb_true_iff
in
H
;
destruct
H
.
eapply
IHe
;
eauto
.
-
clear
H3
.
pose
proof
(
expEqBool_refl
(
Binop
b
e1
e2
));
simpl
in
H2
;
rewrite
H2
in
H0
.
pose
proof
(
expEqBool_refl
(
Binop
b0
e
'1
e
'
2
));
simpl
in
H3
;
rewrite
H3
in
H1
.
case_eq
(
typeExpression
e1
e1
);
intros
;
case_eq
(
typeExpression
e2
e2
);
intros
;
try
rewrite
H4
in
H0
;
try
rewrite
H5
in
H0
;
inversion
H0
.
case_eq
(
typeExpression
e
'1
e
'1
);
intros
;
case_eq
(
typeExpression
e
'
2
e
'
2
);
intros
;
try
rewrite
H6
in
H1
;
try
rewrite
H8
in
H1
;
inversion
H1
.
apply
andb_true_iff
in
H
;
destruct
H
.
apply
andb_true_iff
in
H9
;
destruct
H9
.
specialize
(
IHe1
e
'1
_
_
H9
H4
H6
).
specialize
(
IHe2
e
'
2
_
_
H11
H5
H8
).
subst
.
auto
.
Qed
.
-
clear
H3
.
apply
andb_true_iff
in
H
;
destruct
H
.
apply
EquivEqBoolEq
in
H
;
subst
.
pose
proof
(
expEqBool_refl
(
Downcast
m0
e
));
simpl
in
H
;
rewrite
H
in
H0
.
pose
proof
(
expEqBool_refl
(
Downcast
m0
e
'
));
simpl
in
H3
;
rewrite
H3
in
H1
.
clear
H
H3
.
case_eq
(
typeExpression
e
e
);
intros
;
rewrite
H
in
H0
;
inversion
H0
;
clear
H4
.
case_eq
(
isMorePrecise
m
m0
);
intros
;
rewrite
H3
in
H0
;
inversion
H0
;
subst
;
clear
H0
.
case_eq
(
typeExpression
e
'
e
'
);
intros
;
rewrite
H0
in
H1
;
inversion
H1
;
clear
H5
.
case_eq
(
isMorePrecise
m0
m1
);
intros
;
rewrite
H4
in
H1
;
inversion
H1
;
subst
;
clear
H1
;
auto
.
Qed
.
Lemma
subExprRewriting
e
f1
f2
:
expEqBool
f1
f2
=
true
->
isSubExpression
f1
e
=
true
->
isSubExpression
f2
e
=
true
.
Proof
.
revert
e
;
induction
e
;
intros
.
-
destruct
f1
;
inversion
H0
.
rewrite
H2
.
destruct
f2
;
inversion
H
.
rewrite
H3
.
simpl
.
rewrite
orb_false_r
.
rewrite
orb_false_r
in
H2
.
apply
andb_true_iff
in
H2
;
apply
andb_true_iff
in
H3
;
destruct
H2
,
H3
.
apply
andb_true_iff
;
split
.
+
apply
EquivEqBoolEq
in
H1
;
apply
EquivEqBoolEq
in
H3
;
subst
.
apply
mTypeEqBool_refl
.
+
apply
beq_nat_true
in
H2
.
apply
beq_nat_true
in
H4
;
subst
.
rewrite
<-
beq_nat_refl
;
auto
.
-
destruct
f1
;
inversion
H0
;
rewrite
H2
.
destruct
f2
;
inversion
H
;
rewrite
H3
.
simpl
.
rewrite
orb_false_r
in
*
.
apply
andb_true_iff
in
H2
.
apply
andb_true_iff
in
H3
.
destruct
H2
,
H3
.
apply
andb_true_iff
;
split
.
+
apply
EquivEqBoolEq
in
H1
;
apply
EquivEqBoolEq
in
H3
;
subst
.
apply
mTypeEqBool_refl
.
+
apply
Qeq_bool_iff
in
H2
.
apply
Qeq_bool_iff
in
H4
.
apply
Qeq_bool_iff
;
rewrite
H2
,
H4
;
auto
.
lra
.
-
case_eq
(
expEqBool
(
Unop
u
e
)
f1
);
intros
.
+
assert
(
expEqBool
(
Unop
u
e
)
f2
=
true
)
by
admit
.
simpl
;
simpl
in
H2
;
rewrite
H2
.
auto
.
+
simpl
in
H0
;
simpl
in
H1
;
rewrite
H1
in
H0
.
simpl
in
H0
.
assert
(
expEqBool
(
Unop
u
e
)
f2
=
false
)
by
admit
.
simpl
in
H2
;
simpl
;
rewrite
H2
;
auto
.
-
case_eq
(
expEqBool
(
Binop
b
e1
e2
)
f1
);
intros
.