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
Toggle navigation
Open sidebar
Flocq
flocq
Commits
4aa79696
Commit
4aa79696
authored
Oct 01, 2010
by
Guillaume Melquiond
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Changed some theorem names.
parent
81b2a74c
Changes
22
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
22 changed files
with
573 additions
and
573 deletions
+573
-573
src/Appli/Fappli_Axpy.v
src/Appli/Fappli_Axpy.v
+9
-9
src/Calc/Fcalc_bracket.v
src/Calc/Fcalc_bracket.v
+19
-19
src/Calc/Fcalc_digits.v
src/Calc/Fcalc_digits.v
+5
-5
src/Calc/Fcalc_div.v
src/Calc/Fcalc_div.v
+2
-2
src/Calc/Fcalc_ops.v
src/Calc/Fcalc_ops.v
+3
-3
src/Calc/Fcalc_round.v
src/Calc/Fcalc_round.v
+5
-5
src/Calc/Fcalc_sqrt.v
src/Calc/Fcalc_sqrt.v
+9
-9
src/Core/Fcore_FIX.v
src/Core/Fcore_FIX.v
+2
-2
src/Core/Fcore_FLT.v
src/Core/Fcore_FLT.v
+7
-7
src/Core/Fcore_FLX.v
src/Core/Fcore_FLX.v
+16
-16
src/Core/Fcore_FTZ.v
src/Core/Fcore_FTZ.v
+18
-18
src/Core/Fcore_Raux.v
src/Core/Fcore_Raux.v
+29
-29
src/Core/Fcore_defs.v
src/Core/Fcore_defs.v
+9
-9
src/Core/Fcore_float_prop.v
src/Core/Fcore_float_prop.v
+11
-11
src/Core/Fcore_generic_fmt.v
src/Core/Fcore_generic_fmt.v
+161
-161
src/Core/Fcore_rnd.v
src/Core/Fcore_rnd.v
+30
-30
src/Core/Fcore_rnd_ne.v
src/Core/Fcore_rnd_ne.v
+46
-46
src/Core/Fcore_ulp.v
src/Core/Fcore_ulp.v
+78
-78
src/Prop/Fprop_div_sqrt_error.v
src/Prop/Fprop_div_sqrt_error.v
+16
-16
src/Prop/Fprop_mult_error.v
src/Prop/Fprop_mult_error.v
+16
-16
src/Prop/Fprop_plus_error.v
src/Prop/Fprop_plus_error.v
+27
-27
src/Prop/Fprop_relative.v
src/Prop/Fprop_relative.v
+55
-55
No files found.
src/Appli/Fappli_Axpy.v
View file @
4aa79696
...
...
@@ -15,17 +15,17 @@ Notation cexp := (canonic_exponent beta (FLX_exp prec)).
Notation
ulp
:=
(
ulp
beta
(
FLX_exp
prec
)).
Definition
MinOrMax
x
f
:=
((
f
=
round
ing
beta
(
FLX_exp
prec
)
Z
rndDN
x
)
\
/
(
f
=
round
ing
beta
(
FLX_exp
prec
)
Z
rndUP
x
)).
((
f
=
round
beta
(
FLX_exp
prec
)
rndDN
x
)
\
/
(
f
=
round
beta
(
FLX_exp
prec
)
rndUP
x
)).
Theorem
MinOrMax_opp
:
forall
x
f
,
MinOrMax
x
f
<->
MinOrMax
(
-
x
)
(
-
f
).
assert
(
forall
x
f
,
MinOrMax
x
f
->
MinOrMax
(
-
x
)
(
-
f
)).
unfold
MinOrMax
;
intros
x
f
[
H
|
H
].
right
.
now
rewrite
H
,
round
ing
_UP_opp
.
now
rewrite
H
,
round_UP_opp
.
left
.
now
rewrite
H
,
round
ing
_DN_opp
.
now
rewrite
H
,
round_DN_opp
.
intros
x
f
;
split
;
intros
H1
.
now
apply
H
.
rewrite
<-
(
Ropp_involutive
x
),
<-
(
Ropp_involutive
f
).
...
...
@@ -37,11 +37,11 @@ Theorem implies_DN_lt_ulp:
forall
x
f
,
format
f
->
(
0
<
f
<=
x
)
%
R
->
(
Rabs
(
f
-
x
)
<
ulp
f
)
%
R
->
(
f
=
round
ing
beta
(
FLX_exp
prec
)
Z
rndDN
x
)
%
R
.
(
f
=
round
beta
(
FLX_exp
prec
)
rndDN
x
)
%
R
.
intros
x
f
Hf
Hxf1
Hxf2
.
apply
sym_eq
.
replace
x
with
(
f
+-
(
f
-
x
))
%
R
by
ring
.
apply
round
ing
_DN_succ
;
trivial
.
apply
round_DN_succ
;
trivial
.
apply
Hxf1
.
replace
(
-
(
f
-
x
))
%
R
with
(
Rabs
(
f
-
x
)).
split
;
trivial
;
apply
Rabs_pos
.
...
...
@@ -66,7 +66,7 @@ right; apply sym_eq.
replace
f
with
((
f
-
ulp
f
)
+
(
ulp
(
f
-
ulp
f
)))
%
R
.
2
:
rewrite
H
;
ring
.
replace
x
with
((
f
-
ulp
f
)
+-
(
f
-
ulp
f
-
x
))
%
R
by
ring
.
apply
round
ing
_UP_succ
;
trivial
.
apply
round_UP_succ
;
trivial
.
apply
Hxf1
.
replace
(
-
(
f
-
x
))
%
R
with
(
Rabs
(
f
-
x
)).
...
...
@@ -104,8 +104,8 @@ Hypothesis Ha: format a.
Hypothesis
Hx
:
format
x
.
Hypothesis
Hy
:
format
y
.
Notation
t
:=
(
round
ing
beta
(
FLX_exp
prec
)
(
Z
rndN
choice
)
(
a
*
x
)).
Notation
u
:=
(
round
ing
beta
(
FLX_exp
prec
)
(
Z
rndN
choice
)
(
t
+
y
)).
Notation
t
:=
(
round
beta
(
FLX_exp
prec
)
(
rndN
choice
)
(
a
*
x
)).
Notation
u
:=
(
round
beta
(
FLX_exp
prec
)
(
rndN
choice
)
(
t
+
y
)).
...
...
src/Calc/Fcalc_bracket.v
View file @
4aa79696
...
...
@@ -161,7 +161,7 @@ apply Rcompare_not_Lt_inv.
rewrite
Rcompare_plus_l
,
Rcompare_mult_r
,
Rcompare_half_l
.
apply
Rcompare_not_Lt
.
change
2
%
R
with
(
Z2R
2
).
rewrite
<-
mult
_Z2R
.
rewrite
<-
Z2R_
mult
.
apply
Z2R_le
.
omega
.
exact
Hstep
.
...
...
@@ -183,7 +183,7 @@ apply Rcompare_Lt_inv.
rewrite
Rcompare_plus_l
,
Rcompare_mult_r
,
Rcompare_half_l
.
apply
Rcompare_Lt
.
change
2
%
R
with
(
Z2R
2
).
rewrite
<-
mult
_Z2R
.
rewrite
<-
Z2R_
mult
.
apply
Z2R_lt
.
omega
.
exact
Hstep
.
...
...
@@ -228,7 +228,7 @@ Lemma middle_odd :
Proof
.
intros
k
Hk
.
rewrite
<-
Hk
.
rewrite
2
!
plus
_
Z2R
,
mult
_Z2R
.
rewrite
2
!
Z2R_
plus
,
Z2R
_
mult
.
simpl
.
field
.
Qed
.
...
...
@@ -259,7 +259,7 @@ rewrite Hl.
rewrite
Rcompare_plus_l
,
Rcompare_mult_r
,
Rcompare_half_r
.
apply
Rcompare_Lt
.
change
2
%
R
with
(
Z2R
2
).
rewrite
<-
mult
_Z2R
.
rewrite
<-
Z2R_
mult
.
apply
Z2R_lt
.
rewrite
<-
Hk
.
apply
Zlt_succ
.
...
...
@@ -282,7 +282,7 @@ apply Rle_lt_trans with (2 := proj1 Hx').
apply
Rcompare_not_Lt_inv
.
rewrite
Rcompare_plus_l
,
Rcompare_mult_r
,
Rcompare_half_r
.
change
2
%
R
with
(
Z2R
2
).
rewrite
<-
mult
_Z2R
.
rewrite
<-
Z2R_
mult
.
apply
Rcompare_not_Lt
.
apply
Z2R_le
.
rewrite
Hk
.
...
...
@@ -301,7 +301,7 @@ apply inbetween_step_not_Eq with (1 := Hx).
omega
.
apply
Rcompare_Eq
.
inversion_clear
Hx
as
[
Hx
'
|
].
rewrite
Hx
'
,
<-
Hk
,
mult
_Z2R
.
rewrite
Hx
'
,
<-
Hk
,
Z2R_
mult
.
simpl
(
Z2R
2
).
field
.
Qed
.
...
...
@@ -524,12 +524,12 @@ now apply Zpower_gt_0.
rewrite
2
!
Hr
.
rewrite
Zmult_plus_distr_l
,
Zmult_1_l
.
unfold
F2R
at
2.
simpl
.
rewrite
plus
_Z2R
,
Rmult_plus_distr_r
.
rewrite
Z2R_
plus
,
Rmult_plus_distr_r
.
apply
new_location_correct
.
apply
bpow_gt_0
.
now
apply
Zpower_gt_1
.
now
apply
Z_mod_lt
.
rewrite
<-
2
!
Rmult_plus_distr_r
,
<-
2
!
plus
_Z2R
.
rewrite
<-
2
!
Rmult_plus_distr_r
,
<-
2
!
Z2R_
plus
.
rewrite
Zmult_comm
,
Zplus_assoc
.
now
rewrite
<-
Z_div_mod_eq
.
Qed
.
...
...
@@ -545,16 +545,16 @@ now apply inbetween_float_new_location.
apply
Zmult_1_r
.
Qed
.
Theorem
inbetween_float_round
ing
:
Theorem
inbetween_float_round
:
forall
rnd
choice
,
(
forall
x
m
l
,
inbetween_int
m
x
l
->
Zrnd
rnd
x
=
choice
m
l
)
->
forall
x
m
l
,
let
e
:=
canonic_exponent
beta
fexp
x
in
inbetween_float
m
e
x
l
->
round
ing
beta
fexp
rnd
x
=
F2R
(
Float
beta
(
choice
m
l
)
e
).
round
beta
fexp
rnd
x
=
F2R
(
Float
beta
(
choice
m
l
)
e
).
Proof
.
intros
rnd
choice
Hc
x
m
l
e
Hl
.
unfold
round
ing
,
F2R
.
simpl
.
unfold
round
,
F2R
.
simpl
.
apply
(
f_equal
(
fun
m
=>
(
Z2R
m
*
bpow
e
)
%
R
)).
apply
Hc
.
apply
inbetween_mult_reg
with
(
bpow
e
).
...
...
@@ -566,9 +566,9 @@ Theorem inbetween_float_DN :
forall
x
m
l
,
let
e
:=
canonic_exponent
beta
fexp
x
in
inbetween_float
m
e
x
l
->
round
ing
beta
fexp
Z
rndDN
x
=
F2R
(
Float
beta
m
e
).
round
beta
fexp
rndDN
x
=
F2R
(
Float
beta
m
e
).
Proof
.
apply
inbetween_float_round
ing
with
(
choice
:=
fun
m
l
=>
m
).
apply
inbetween_float_round
with
(
choice
:=
fun
m
l
=>
m
).
intros
x
m
l
Hl
.
refine
(
Zfloor_imp
m
_
_
).
apply
inbetween_bounds
with
(
2
:=
Hl
).
...
...
@@ -588,9 +588,9 @@ Theorem inbetween_float_UP :
forall
x
m
l
,
let
e
:=
canonic_exponent
beta
fexp
x
in
inbetween_float
m
e
x
l
->
round
ing
beta
fexp
Z
rndUP
x
=
F2R
(
Float
beta
(
cond_incr
(
round_UP
l
)
m
)
e
).
round
beta
fexp
rndUP
x
=
F2R
(
Float
beta
(
cond_incr
(
round_UP
l
)
m
)
e
).
Proof
.
apply
inbetween_float_round
ing
with
(
choice
:=
fun
m
l
=>
cond_incr
(
round_UP
l
)
m
).
apply
inbetween_float_round
with
(
choice
:=
fun
m
l
=>
cond_incr
(
round_UP
l
)
m
).
intros
x
m
l
Hl
.
assert
(
Hl
'
:
l
=
loc_Exact
\
/
(
l
<>
loc_Exact
/
\
round_UP
l
=
true
)).
case
l
;
try
(
now
left
)
;
now
right
;
split
.
...
...
@@ -621,16 +621,16 @@ Theorem inbetween_float_NE :
forall
x
m
l
,
let
e
:=
canonic_exponent
beta
fexp
x
in
inbetween_float
m
e
x
l
->
round
ing
beta
fexp
Z
rndNE
x
=
F2R
(
Float
beta
(
cond_incr
(
round_NE
(
Zeven
m
)
l
)
m
)
e
).
round
beta
fexp
rndNE
x
=
F2R
(
Float
beta
(
cond_incr
(
round_NE
(
Zeven
m
)
l
)
m
)
e
).
Proof
.
apply
inbetween_float_round
ing
with
(
choice
:=
fun
m
l
=>
cond_incr
(
round_NE
(
Zeven
m
)
l
)
m
).
apply
inbetween_float_round
with
(
choice
:=
fun
m
l
=>
cond_incr
(
round_NE
(
Zeven
m
)
l
)
m
).
intros
x
m
l
Hl
.
inversion_clear
Hl
as
[
Hx
|
l
'
Hx
Hl
'
].
(
*
Exact
*
)
rewrite
Hx
.
now
rewrite
Zrnd_Z2R
.
(
*
not
Exact
*
)
unfold
Zrnd
,
Z
rndNE
,
Z
rndN
,
Znearest
.
unfold
Zrnd
,
rndNE
,
rndN
,
Znearest
.
assert
(
Hm
:
Zfloor
x
=
m
).
apply
Zfloor_imp
.
exact
(
conj
(
Rlt_le
_
_
(
proj1
Hx
))
(
proj2
Hx
)).
...
...
@@ -639,7 +639,7 @@ rewrite Hm.
replace
(
Rcompare
(
x
-
Z2R
m
)
(
/
2
))
with
l
'
.
now
case
l
'
.
rewrite
<-
Hl
'
.
rewrite
plus
_Z2R
.
rewrite
Z2R_
plus
.
rewrite
<-
(
Rcompare_plus_r
(
-
Z2R
m
)
x
).
apply
f_equal
.
simpl
(
Z2R
1
).
...
...
src/Calc/Fcalc_digits.v
View file @
4aa79696
...
...
@@ -100,7 +100,7 @@ intros n Hn.
destruct
(
ln_beta
beta
(
Z2R
n
))
as
(
e
,
He
).
simpl
.
specialize
(
He
(
Z2R_neq
_
_
Hn
)).
rewrite
<-
abs_Z2R
in
He
.
rewrite
<-
Z2R_abs
in
He
.
assert
(
Hn
'
:
(
0
<
Zabs
n
)
%
Z
).
destruct
n
;
try
easy
.
now
elim
Hn
.
...
...
@@ -174,7 +174,7 @@ apply <- bpow_le.
apply
Rlt_le
.
apply
Rle_lt_trans
with
(
Rabs
(
Z2R
n
)).
simpl
.
rewrite
<-
abs_Z2R
.
rewrite
<-
Z2R_abs
.
apply
(
Z2R_le
1
).
apply
(
Zlt_le_succ
0
).
revert
H
.
...
...
@@ -192,7 +192,7 @@ Theorem digits_shift :
Proof
.
intros
m
e
Hm
He
.
rewrite
2
!
digits_ln_beta
.
rewrite
mult
_Z2R
.
rewrite
Z2R_
mult
.
rewrite
Z2R_Zpower
with
(
1
:=
He
).
change
(
Z2R
m
*
bpow
e
)
%
R
with
(
F2R
(
Float
beta
m
e
)).
apply
ln_beta_F2R
.
...
...
@@ -281,11 +281,11 @@ apply Rlt_le_trans with (Z2R (x + 1) * Z2R (y + 1))%R.
apply
Rle_lt_trans
with
(
Z2R
(
x
+
y
+
x
*
y
)).
rewrite
<-
(
Rabs_pos_eq
_
(
Rlt_le
_
_
Hxy
)).
apply
Hexy
.
rewrite
<-
mult
_Z2R
.
rewrite
<-
Z2R_
mult
.
apply
Z2R_lt
.
apply
Zplus_lt_reg_r
with
(
-
(
x
+
y
+
x
*
y
+
1
))
%
Z
.
now
ring_simplify
.
rewrite
bpow_
add
.
rewrite
bpow_
plus
.
apply
Rmult_le_compat
;
try
(
apply
(
Z2R_le
0
)
;
omega
).
rewrite
<-
(
Rmult_1_r
(
Z2R
(
x
+
1
))).
change
(
F2R
(
Float
beta
(
x
+
1
)
0
)
<=
bpow
ex
)
%
R
.
...
...
src/Calc/Fcalc_div.v
View file @
4aa79696
...
...
@@ -110,8 +110,8 @@ omega.
now
apply
Zlt_le_weak
.
(
*
.
the
location
is
correctly
computed
*
)
unfold
inbetween_float
,
F2R
.
simpl
.
rewrite
bpow_
add
,
plus
_
Z2R
.
rewrite
Hq
,
plus
_
Z2R
,
mult
_Z2R
.
rewrite
bpow_plus
,
Z2R
_plus
.
rewrite
Hq
,
Z2R_
plus
,
Z2R
_
mult
.
replace
((
Z2R
m2
*
Z2R
q
+
Z2R
r
)
*
(
bpow
e
'
*
bpow
e2
)
/
(
Z2R
m2
*
bpow
e2
))
%
R
with
((
Z2R
q
+
Z2R
r
/
Z2R
m2
)
*
bpow
e
'
)
%
R
.
apply
inbetween_mult_compat
.
...
...
src/Calc/Fcalc_ops.v
View file @
4aa79696
...
...
@@ -49,7 +49,7 @@ Theorem Fopp_F2R :
forall
f1
:
float
beta
,
(
F2R
(
Fopp
f1
)
=
-
F2R
f1
)
%
R
.
unfold
Fopp
,
F2R
;
intros
(
m1
,
e1
).
simpl
;
rewrite
opp_Z2R
;
ring
.
simpl
;
rewrite
Z2R_opp
;
ring
.
Qed
.
Definition
Fabs
(
f1
:
float
beta
)
:=
...
...
@@ -78,7 +78,7 @@ destruct (Falign f1 f2) as ((m1, m2), e).
intros
(
H1
,
H2
).
rewrite
H1
,
H2
.
unfold
F2R
.
simpl
.
rewrite
plus
_Z2R
.
rewrite
Z2R_
plus
.
apply
Rmult_plus_distr_r
.
Qed
.
...
...
@@ -115,7 +115,7 @@ Theorem mult_F2R :
Proof
.
intros
(
m1
,
e1
)
(
m2
,
e2
).
unfold
Fmult
,
F2R
.
simpl
.
rewrite
mult
_Z2R
,
bpow_
add
.
rewrite
Z2R_
mult
,
bpow_
plus
.
ring
.
Qed
.
...
...
src/Calc/Fcalc_round.v
View file @
4aa79696
...
...
@@ -150,20 +150,20 @@ Qed.
Section
round_dir
.
Variable
rnd
:
Zround
ing
.
Variable
rnd
:
Zround
.
Variable
choice
:
Z
->
location
->
Z
.
Hypothesis
choice_valid
:
forall
m
,
choice
m
loc_Exact
=
m
.
Hypothesis
inbetween_float_valid
:
forall
x
m
l
,
let
e
:=
canonic_exponent
beta
fexp
x
in
inbetween_float
beta
m
e
x
l
->
round
ing
beta
fexp
rnd
x
=
F2R
(
Float
beta
(
choice
m
l
)
e
).
round
beta
fexp
rnd
x
=
F2R
(
Float
beta
(
choice
m
l
)
e
).
Theorem
round_any_correct
:
forall
x
m
e
l
,
inbetween_float
beta
m
e
x
l
->
(
e
=
canonic_exponent
beta
fexp
x
\
/
(
l
=
loc_Exact
/
\
format
x
))
->
round
ing
beta
fexp
rnd
x
=
F2R
(
Float
beta
(
choice
m
l
)
e
).
round
beta
fexp
rnd
x
=
F2R
(
Float
beta
(
choice
m
l
)
e
).
Proof
.
intros
x
m
e
l
Hin
[
He
|
(
Hl
,
Hf
)].
rewrite
He
in
Hin
|-
*
.
...
...
@@ -172,7 +172,7 @@ rewrite Hl in Hin.
inversion_clear
Hin
.
rewrite
Hl
,
choice_valid
.
rewrite
<-
H
.
now
apply
round
ing
_generic
.
now
apply
round_generic
.
Qed
.
Theorem
round_trunc_any_correct
:
...
...
@@ -180,7 +180,7 @@ Theorem round_trunc_any_correct :
(
0
<=
x
)
%
R
->
inbetween_float
beta
m
e
x
l
->
(
e
<=
fexp
(
digits
beta
m
+
e
))
%
Z
\
/
l
=
loc_Exact
->
round
ing
beta
fexp
rnd
x
=
let
'
(
m
'
,
e
'
,
l
'
)
:=
truncate
(
m
,
e
,
l
)
in
F2R
(
Float
beta
(
choice
m
'
l
'
)
e
'
).
round
beta
fexp
rnd
x
=
let
'
(
m
'
,
e
'
,
l
'
)
:=
truncate
(
m
,
e
,
l
)
in
F2R
(
Float
beta
(
choice
m
'
l
'
)
e
'
).
Proof
.
intros
x
m
e
l
Hx
Hl
He
.
generalize
(
truncate_correct
x
m
e
l
Hx
Hl
He
).
...
...
src/Calc/Fcalc_sqrt.v
View file @
4aa79696
...
...
@@ -223,7 +223,7 @@ replace (digits beta q * 2)%Z with (digits beta q + digits beta q)%Z by ring.
apply
digits_mult_strong
.
omega
.
omega
.
(
*
.
round
ing
*
)
(
*
.
round
*
)
unfold
inbetween_float
,
F2R
.
simpl
.
rewrite
sqrt_mult
.
2
:
now
apply
(
Z2R_le
0
)
;
apply
Zlt_le_weak
.
...
...
@@ -233,7 +233,7 @@ rewrite He1, Zplus_0_r in Hev. clear He1.
rewrite
Hev
.
replace
(
Zdiv2
(
2
*
e2
))
with
e2
by
now
case
e2
.
replace
(
2
*
e2
)
%
Z
with
(
e2
+
e2
)
%
Z
by
ring
.
rewrite
bpow_
add
.
rewrite
bpow_
plus
.
fold
(
Rsqr
(
bpow
e2
)).
rewrite
sqrt_Rsqr
.
2
:
apply
Rlt_le
;
apply
bpow_gt_0
.
...
...
@@ -242,7 +242,7 @@ apply bpow_gt_0.
rewrite
Hq
.
case
Zeq_bool_spec
;
intros
Hr
'
.
(
*
..
r
=
0
*
)
rewrite
Hr
'
,
Zplus_0_r
,
mult
_Z2R
.
rewrite
Hr
'
,
Zplus_0_r
,
Z2R_
mult
.
fold
(
Rsqr
(
Z2R
q
)).
rewrite
sqrt_Rsqr
.
now
constructor
.
...
...
@@ -253,14 +253,14 @@ constructor.
split
.
(
*
...
bounds
*
)
apply
Rle_lt_trans
with
(
sqrt
(
Z2R
(
q
*
q
))).
rewrite
mult
_Z2R
.
rewrite
Z2R_
mult
.
fold
(
Rsqr
(
Z2R
q
)).
rewrite
sqrt_Rsqr
.
apply
Rle_refl
.
apply
(
Z2R_le
0
).
omega
.
apply
sqrt_lt_1
.
rewrite
mult
_Z2R
.
rewrite
Z2R_
mult
.
apply
Rle_0_sqr
.
rewrite
<-
Hq
.
apply
(
Z2R_le
0
).
...
...
@@ -272,12 +272,12 @@ apply sqrt_lt_1.
rewrite
<-
Hq
.
apply
(
Z2R_le
0
).
now
apply
Zlt_le_weak
.
rewrite
mult
_Z2R
.
rewrite
Z2R_
mult
.
apply
Rle_0_sqr
.
apply
Z2R_lt
.
ring_simplify
.
omega
.
rewrite
mult
_Z2R
.
rewrite
Z2R_
mult
.
fold
(
Rsqr
(
Z2R
(
q
+
1
))).
rewrite
sqrt_Rsqr
.
apply
Rle_refl
.
...
...
@@ -290,7 +290,7 @@ replace ((2 * sqrt (Z2R (q * q + r))) * (2 * sqrt (Z2R (q * q + r))))%R
with
(
4
*
Rsqr
(
sqrt
(
Z2R
(
q
*
q
+
r
))))
%
R
by
(
unfold
Rsqr
;
ring
).
rewrite
Rsqr_sqrt
.
change
4
%
R
with
(
Z2R
4
).
rewrite
<-
plus_Z2R
,
<-
2
!
mult_Z2R
.
rewrite
<-
Z2R_plus
,
<-
2
!
Z2R_mult
.
rewrite
Rcompare_Z2R
.
replace
((
q
+
(
q
+
1
))
*
(
q
+
(
q
+
1
)))
%
Z
with
(
4
*
(
q
*
q
)
+
4
*
q
+
1
)
%
Z
by
ring
.
generalize
(
Zle_cases
r
q
).
...
...
@@ -305,7 +305,7 @@ now apply Zlt_le_weak.
apply
Rmult_le_pos
.
now
apply
(
Z2R_le
0
2
).
apply
sqrt_ge_0
.
rewrite
<-
plus
_Z2R
.
rewrite
<-
Z2R_
plus
.
apply
(
Z2R_le
0
).
omega
.
Qed
.
...
...
src/Core/Fcore_FIX.v
View file @
4aa79696
...
...
@@ -58,9 +58,9 @@ exact FIX_exp_correct.
Qed
.
Theorem
Rnd_NE_pt_FIX
:
round
ing
_pred
(
Rnd_NE_pt
beta
FIX_exp
).
round_pred
(
Rnd_NE_pt
beta
FIX_exp
).
Proof
.
apply
Rnd_NE_pt_round
ing
.
apply
Rnd_NE_pt_round
.
apply
FIX_exp_correct
.
right
.
split
;
easy
.
...
...
src/Core/Fcore_FLT.v
View file @
4aa79696
...
...
@@ -84,7 +84,7 @@ apply lt_Z2R.
rewrite
Z2R_Zpower
.
2
:
now
apply
Zlt_le_weak
.
apply
Rmult_lt_reg_r
with
(
bpow
ex
).
apply
bpow_gt_0
.
rewrite
<-
bpow_
add
.
rewrite
<-
bpow_
plus
.
change
(
F2R
(
Float
beta
(
Zabs
mx
)
ex
)
<
bpow
(
prec
+
ex
))
%
R
.
rewrite
<-
abs_F2R
.
rewrite
<-
Hx
.
...
...
@@ -170,11 +170,11 @@ now apply FLX_format_generic.
Qed
.
Theorem
FLT_round
ing
_FLX
:
forall
rnd
x
,
Theorem
FLT_round_FLX
:
forall
rnd
x
,
(
bpow
(
emin
+
prec
-
1
)
<=
Rabs
x
)
%
R
->
round
ing
beta
FLT_exp
rnd
x
=
round
ing
beta
(
FLX_exp
prec
)
rnd
x
.
round
beta
FLT_exp
rnd
x
=
round
beta
(
FLX_exp
prec
)
rnd
x
.
intros
rnd
x
Hx
.
unfold
round
ing
,
scaled_mantissa
.
unfold
round
,
scaled_mantissa
.
rewrite
->
FLT_canonic_FLX
;
trivial
.
intros
H
;
contradict
Hx
.
rewrite
H
,
Rabs_R0
;
apply
Rlt_not_le
.
...
...
@@ -278,7 +278,7 @@ Qed.
Theorem
generic_NE_pt_FLT
:
forall
x
,
Rnd_NE_pt
beta
FLT_exp
x
(
round
ing
beta
FLT_exp
Z
rndNE
x
).
Rnd_NE_pt
beta
FLT_exp
x
(
round
beta
FLT_exp
rndNE
x
).
Proof
.
intros
x
.
apply
generic_NE_pt
.
...
...
@@ -287,9 +287,9 @@ apply NE_ex_prop_FLT.
Qed
.
Theorem
Rnd_NE_pt_FLT
:
round
ing
_pred
(
Rnd_NE_pt
beta
FLT_exp
).
round_pred
(
Rnd_NE_pt
beta
FLT_exp
).
Proof
.
apply
Rnd_NE_pt_round
ing
.
apply
Rnd_NE_pt_round
.
apply
FLT_exp_correct
.
apply
NE_ex_prop_FLT
.
Qed
.
...
...
src/Core/Fcore_FLX.v
View file @
4aa79696
...
...
@@ -54,7 +54,7 @@ eexists ; repeat split.
apply
lt_Z2R
.
apply
Rmult_lt_reg_r
with
(
bpow
(
e
-
prec
)).
apply
bpow_gt_0
.
rewrite
Z2R_Zpower
,
<-
bpow_
add
.
rewrite
Z2R_Zpower
,
<-
bpow_
plus
.
ring_simplify
(
prec
+
(
e
-
prec
))
%
Z
.
rewrite
<-
H2
.
simpl
.
...
...
@@ -156,14 +156,14 @@ cut (d - 1 < prec)%Z. omega.
apply
<-
(
bpow_lt
beta
).
apply
Rle_lt_trans
with
(
Rabs
(
Z2R
xm
)).
apply
H4
.
rewrite
<-
Z2R_Zpower
,
<-
abs_Z2R
.
rewrite
<-
Z2R_Zpower
,
<-
Z2R_abs
.
now
apply
Z2R_lt
.
now
apply
Zlt_le_weak
.
exists
(
Float
beta
(
xm
*
Zpower
beta
(
prec
-
d
))
(
xe
+
d
-
prec
)).
split
.
unfold
F2R
.
simpl
.
rewrite
mult
_Z2R
,
Z2R_Zpower
.
rewrite
Rmult_assoc
,
<-
bpow_
add
.
rewrite
Z2R_
mult
,
Z2R_Zpower
.
rewrite
Rmult_assoc
,
<-
bpow_
plus
.
rewrite
H1
.
now
ring_simplify
(
prec
-
d
+
(
xe
+
d
-
prec
))
%
Z
.
exact
H5
.
...
...
@@ -172,27 +172,27 @@ split.
apply
le_Z2R
.
apply
Rmult_le_reg_r
with
(
bpow
(
d
-
prec
)).
apply
bpow_gt_0
.
rewrite
abs
_
Z2R
,
mult
_Z2R
,
Rabs_mult
,
2
!
Z2R_Zpower
.
rewrite
<-
bpow_
add
.
rewrite
<-
abs_Z2R
.
rewrite
Z2R_
abs
,
Z2R
_
mult
,
Rabs_mult
,
2
!
Z2R_Zpower
.
rewrite
<-
bpow_
plus
.
rewrite
<-
Z2R_abs
.
rewrite
Rabs_pos_eq
.
rewrite
Rmult_assoc
,
<-
bpow_
add
.
rewrite
Rmult_assoc
,
<-
bpow_
plus
.
ring_simplify
(
prec
-
1
+
(
d
-
prec
))
%
Z
.
ring_simplify
(
prec
-
d
+
(
d
-
prec
))
%
Z
.
now
rewrite
Rmult_1_r
,
abs_Z2R
.
now
rewrite
Rmult_1_r
,
Z2R_abs
.
apply
bpow_ge_0
.
exact
H5
.
omega
.
apply
lt_Z2R
.
rewrite
abs
_
Z2R
,
mult
_Z2R
,
Rabs_mult
.
rewrite
Z2R_
abs
,
Z2R
_
mult
,
Rabs_mult
.
rewrite
2
!
Z2R_Zpower
.
rewrite
<-
abs_Z2R
,
Rabs_pos_eq
.
rewrite
<-
Z2R_abs
,
Rabs_pos_eq
.
apply
Rmult_lt_reg_r
with
(
bpow
(
d
-
prec
)).
apply
bpow_gt_0
.
rewrite
Rmult_assoc
,
<-
2
!
bpow_
add
.
rewrite
Rmult_assoc
,
<-
2
!
bpow_
plus
.
ring_simplify
(
prec
+
(
d
-
prec
))
%
Z
.
ring_simplify
(
prec
-
d
+
(
d
-
prec
))
%
Z
.
now
rewrite
Rmult_1_r
,
abs_Z2R
.
now
rewrite
Rmult_1_r
,
Z2R_abs
.
apply
bpow_ge_0
.
now
apply
Zlt_le_weak
.
exact
H5
.
...
...
@@ -242,7 +242,7 @@ Qed.
Theorem
generic_NE_pt_FLX
:
forall
x
,
Rnd_NE_pt
beta
FLX_exp
x
(
round
ing
beta
FLX_exp
Z
rndNE
x
).
Rnd_NE_pt
beta
FLX_exp
x
(
round
beta
FLX_exp
rndNE
x
).
Proof
.
intros
x
.
apply
generic_NE_pt
.
...
...
@@ -251,9 +251,9 @@ apply NE_ex_prop_FLX.
Qed
.
Theorem
Rnd_NE_pt_FLX
:
round
ing
_pred
(
Rnd_NE_pt
beta
FLX_exp
).
round_pred
(
Rnd_NE_pt
beta
FLX_exp
).
Proof
.
apply
Rnd_NE_pt_round
ing
.
apply
Rnd_NE_pt_round
.
apply
FLX_exp_correct
.
apply
NE_ex_prop_FLX
.
Qed
.
...
...
src/Core/Fcore_FTZ.v
View file @
4aa79696
...
...
@@ -69,7 +69,7 @@ generalize (Zlt_cases (ex - prec) emin).
case
(
Zlt_bool
(
ex
-
prec
)
emin
)
;
intros
H1
.
elim
(
Rlt_not_le
_
_
(
proj2
Hx6
)).
apply
Rle_trans
with
(
bpow
(
prec
-
1
)
*
bpow
emin
)
%
R
.
rewrite
<-
bpow_
add
.
rewrite
<-
bpow_
plus
.
apply
->
bpow_le
.
omega
.
rewrite
Hx1
,
abs_F2R
.
...
...
@@ -132,7 +132,7 @@ apply le_Z2R.
rewrite
Z2R_Zpower
.
apply
Rmult_le_reg_r
with
(
bpow
(
ex
-
prec
)).
apply
bpow_gt_0
.
rewrite
<-
bpow_
add
.
rewrite
<-
bpow_
plus
.
replace
(
prec
-
1
+
(
ex
-
prec
))
%
Z
with
(
ex
-
1
)
%
Z
by
ring
.
change
(
bpow
(
ex
-
1
)
<=
F2R
(
Float
beta
(
Zabs
(
Ztrunc
(
x
*
bpow
(
-
(
ex
-
prec
)))))
(
ex
-
prec
)))
%
R
.
rewrite
<-
abs_F2R
,
<-
Hx2
.
...
...
@@ -143,7 +143,7 @@ apply lt_Z2R.
rewrite
Z2R_Zpower
.
apply
Rmult_lt_reg_r
with
(
bpow
(
ex
-
prec
)).
apply
bpow_gt_0
.
rewrite
<-
bpow_
add
.
rewrite
<-
bpow_
plus
.
replace
(
prec
+
(
ex
-
prec
))
%
Z
with
ex
by
ring
.
change
(
F2R
(
Float
beta
(
Zabs
(
Ztrunc
(
x
*
bpow
(
-
(
ex
-
prec
)))))
(
ex
-
prec
))
<
bpow
ex
)
%
R
.
rewrite
<-
abs_F2R
,
<-
Hx2
.
...
...
@@ -201,7 +201,7 @@ apply bpow_gt_0.
rewrite
H1
,
abs_F2R
in
Hx
.
apply
Rlt_le_trans
with
(
2
:=
Hx
).
replace
(
emin
+
prec
-
1
)
%
Z
with
(
prec
+
(
emin
-
1
))
%
Z
by
ring
.
rewrite
bpow_
add
.
rewrite
bpow_
plus
.
apply
Rmult_lt_compat_r
.
apply
bpow_gt_0
.
rewrite
<-
Z2R_Zpower
.
...
...
@@ -215,9 +215,9 @@ apply Rle_refl.
now
apply
Zlt_le_weak
.
Qed
.
Section
FTZ_round
ing
.
Section
FTZ_round
.
Hypothesis
rnd
:
Zround
ing
.
Hypothesis
rnd
:
Zround
.
Definition
Zrnd_FTZ
x
:=
if
Rle_bool
R1
(
Rabs
x
)
then
Zrnd
rnd
x
else
Z0
.
...
...
@@ -230,7 +230,7 @@ unfold Zrnd_FTZ.
rewrite
Zrnd_Z2R
.
case
Rle_bool_spec
.
easy
.
rewrite
<-
abs_Z2R
.
rewrite
<-
Z2R_abs
.
intros
H
.
generalize
(
lt_Z2R
_
1
H
).
clear
.
...
...
@@ -269,15 +269,15 @@ apply (Rabs_def2 _ _ Hx).
exact
Hy1
.
Qed
.
Definition
ZrFTZ
:=
mkZround
ing
Zrnd_FTZ
Z_FTZ_monotone
Z_FTZ_Z2R
.
Definition
ZrFTZ
:=
mkZround
Zrnd_FTZ
Z_FTZ_monotone
Z_FTZ_Z2R
.
Theorem
FTZ_round
ing
:
Theorem
FTZ_round
:
forall
x
:
R
,
(
bpow
(
emin
+
prec
-
1
)
<=
Rabs
x
)
%
R
->
round
ing
beta
FTZ_exp
ZrFTZ
x
=
round
ing
beta
(
FLX_exp
prec
)
rnd
x
.
round
beta
FTZ_exp
ZrFTZ
x
=
round
beta
(
FLX_exp
prec
)
rnd
x
.
Proof
.
intros
x
Hx
.
unfold
round
ing
,
scaled_mantissa
,
canonic_exponent
.
unfold
round
,
scaled_mantissa
,
canonic_exponent
.
destruct
(
ln_beta
beta
x
)
as
(
ex
,
He
).
simpl
.
unfold
Zrnd_FTZ
.
assert
(
Hx0
:
x
<>
R0
).
...
...
@@ -297,7 +297,7 @@ rewrite Rabs_mult.
rewrite
(
Rabs_pos_eq
(
bpow
(
-
FLX_exp
prec
ex
))).