Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
F
flocq
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Flocq
flocq
Commits
551cf217
Commit
551cf217
authored
Sep 14, 2010
by
Guillaume Melquiond
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Removed exponent from Zrounding functions, as it was unneeded (if not harmful) for FTZ.
parent
97b0f3dc
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
50 additions
and
61 deletions
+50
-61
src/Calc/Fcalc_bracket.v
src/Calc/Fcalc_bracket.v
+9
-9
src/Core/Fcore_FTZ.v
src/Core/Fcore_FTZ.v
+9
-9
src/Core/Fcore_generic_fmt.v
src/Core/Fcore_generic_fmt.v
+28
-39
src/Prop/Fprop_mult_error.v
src/Prop/Fprop_mult_error.v
+3
-3
src/Prop/Fprop_plus_error.v
src/Prop/Fprop_plus_error.v
+1
-1
No files found.
src/Calc/Fcalc_bracket.v
View file @
551cf217
...
...
@@ -547,11 +547,11 @@ Qed.
Theorem
inbetween_float_rounding
:
forall
rnd
choice
,
(
forall
x
m
e
l
,
inbetween_int
m
x
l
->
Zrnd
rnd
x
e
=
choice
m
e
l
)
->
(
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
->
rounding
beta
fexp
rnd
x
=
F2R
(
Float
beta
(
choice
m
e
l
)
e
).
rounding
beta
fexp
rnd
x
=
F2R
(
Float
beta
(
choice
m
l
)
e
).
Proof
.
intros
rnd
choice
Hc
x
m
l
e
Hl
.
unfold
rounding
,
F2R
.
simpl
.
...
...
@@ -568,8 +568,8 @@ Theorem inbetween_float_DN :
inbetween_float
m
e
x
l
->
rounding
beta
fexp
ZrndDN
x
=
F2R
(
Float
beta
m
e
).
Proof
.
apply
inbetween_float_rounding
with
(
choice
:=
fun
m
e
l
=>
m
).
intros
x
m
e
l
Hl
.
apply
inbetween_float_rounding
with
(
choice
:=
fun
m
l
=>
m
).
intros
x
m
l
Hl
.
refine
(
Zfloor_imp
m
_
_
).
apply
inbetween_bounds
with
(
2
:=
Hl
).
apply
Z2R_lt
.
...
...
@@ -590,8 +590,8 @@ Theorem inbetween_float_UP :
inbetween_float
m
e
x
l
->
rounding
beta
fexp
ZrndUP
x
=
F2R
(
Float
beta
(
cond_incr
(
round_UP
l
)
m
)
e
).
Proof
.
apply
inbetween_float_rounding
with
(
choice
:=
fun
m
e
l
=>
cond_incr
(
round_UP
l
)
m
).
intros
x
m
e
l
Hl
.
apply
inbetween_float_rounding
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
.
destruct
Hl
'
as
[
Hl
'
|
(
Hl1
,
Hl2
)].
...
...
@@ -623,14 +623,14 @@ Theorem inbetween_float_NE :
inbetween_float
m
e
x
l
->
rounding
beta
fexp
ZrndNE
x
=
F2R
(
Float
beta
(
cond_incr
(
round_NE
(
Zeven
m
)
l
)
m
)
e
).
Proof
.
apply
inbetween_float_rounding
with
(
choice
:=
fun
m
e
l
=>
cond_incr
(
round_NE
(
Zeven
m
)
l
)
m
).
intros
x
m
e
l
Hl
.
apply
inbetween_float_rounding
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
,
ZrndNE
,
ZrndN
,
Znearest
,
mkZrounding2
.
unfold
Zrnd
,
ZrndNE
,
ZrndN
,
Znearest
.
assert
(
Hm
:
Zfloor
x
=
m
).
apply
Zfloor_imp
.
exact
(
conj
(
Rlt_le
_
_
(
proj1
Hx
))
(
proj2
Hx
)).
...
...
src/Core/Fcore_FTZ.v
View file @
551cf217
...
...
@@ -219,13 +219,13 @@ Section FTZ_rounding.
Hypothesis
rnd
:
Zrounding
.
Definition
Zrnd_FTZ
x
e
:=
if
Rle_bool
R1
(
Rabs
x
)
then
Zrnd
rnd
x
e
e
lse
Z0
.
Definition
Zrnd_FTZ
x
:=
if
Rle_bool
R1
(
Rabs
x
)
then
Zrnd
rnd
x
else
Z0
.
Theorem
Z_FTZ_Z2R
:
forall
n
e
,
Zrnd_FTZ
(
Z2R
n
)
e
=
n
.
forall
n
,
Zrnd_FTZ
(
Z2R
n
)
=
n
.
Proof
.
intros
n
e
.
intros
n
.
unfold
Zrnd_FTZ
.
rewrite
Zrnd_Z2R
.
case
Rle_bool_spec
.
...
...
@@ -238,17 +238,17 @@ now case n ; trivial ; simpl ; intros [p|p|].
Qed
.
Theorem
Z_FTZ_monotone
:
forall
x
y
e
,
(
x
<=
y
)
%
R
->
(
Zrnd_FTZ
x
e
<=
Zrnd_FTZ
y
e
)
%
Z
.
forall
x
y
,
(
x
<=
y
)
%
R
->
(
Zrnd_FTZ
x
<=
Zrnd_FTZ
y
)
%
Z
.
Proof
.
intros
x
y
e
Hxy
.
intros
x
y
Hxy
.
unfold
Zrnd_FTZ
.
case
Rle_bool_spec
;
intros
Hx
;
case
Rle_bool_spec
;
intros
Hy
.
4
:
easy
.
(
*
1
<=
|
x
|
*
)
now
apply
Zrnd_monotone
.
rewrite
<-
(
Zrnd_Z2R
rnd
0
e
).
rewrite
<-
(
Zrnd_Z2R
rnd
0
).
apply
Zrnd_monotone
.
apply
Rle_trans
with
(
Z2R
(
-
1
)).
2
:
now
apply
Z2R_le
.
destruct
(
Rabs_le_r_inv
_
_
Hx
)
as
[
Hx1
|
Hx1
].
...
...
@@ -258,7 +258,7 @@ apply Rle_lt_trans with (2 := Hy).
apply
Rle_trans
with
(
1
:=
Hxy
).
apply
RRle_abs
.
(
*
|
x
|
<
1
*
)
rewrite
<-
(
Zrnd_Z2R
rnd
0
e
).
rewrite
<-
(
Zrnd_Z2R
rnd
0
).
apply
Zrnd_monotone
.
apply
Rle_trans
with
(
Z2R
1
).
now
apply
Z2R_le
.
...
...
src/Core/Fcore_generic_fmt.v
View file @
551cf217
...
...
@@ -303,9 +303,9 @@ Qed.
Section
Fcore_generic_rounding_pos
.
Record
Zrounding
:=
mkZrounding
{
Zrnd
:
R
->
Z
->
Z
;
Zrnd_monotone
:
forall
x
y
e
,
(
x
<=
y
)
%
R
->
(
Zrnd
x
e
<=
Zrnd
y
e
)
%
Z
;
Zrnd_Z2R
:
forall
n
e
,
Zrnd
(
Z2R
n
)
e
=
n
Zrnd
:
R
->
Z
;
Zrnd_monotone
:
forall
x
y
,
(
x
<=
y
)
%
R
->
(
Zrnd
x
<=
Zrnd
y
)
%
Z
;
Zrnd_Z2R
:
forall
n
,
Zrnd
(
Z2R
n
)
=
n
}
.
Variable
rnd
:
Zrounding
.
...
...
@@ -314,18 +314,18 @@ Let Zrnd_monotone := Zrnd_monotone rnd.
Let
Zrnd_Z2R
:=
Zrnd_Z2R
rnd
.
Theorem
Zrnd_DN_or_UP
:
forall
x
e
,
Zrnd
x
e
=
Zfloor
x
\
/
Zrnd
x
e
=
Zceil
x
.
forall
x
,
Zrnd
x
=
Zfloor
x
\
/
Zrnd
x
=
Zceil
x
.
Proof
.
intros
x
e
.
destruct
(
Zle_or_lt
(
Zrnd
x
e
)
(
Zfloor
x
))
as
[
Hx
|
Hx
].
intros
x
.
destruct
(
Zle_or_lt
(
Zrnd
x
)
(
Zfloor
x
))
as
[
Hx
|
Hx
].
left
.
apply
Zle_antisym
with
(
1
:=
Hx
).
rewrite
<-
(
Zrnd_Z2R
(
Zfloor
x
)
e
).
rewrite
<-
(
Zrnd_Z2R
(
Zfloor
x
)).
apply
Zrnd_monotone
.
apply
Zfloor_lb
.
right
.
apply
Zle_antisym
.
rewrite
<-
(
Zrnd_Z2R
(
Zceil
x
)
e
).
rewrite
<-
(
Zrnd_Z2R
(
Zceil
x
)).
apply
Zrnd_monotone
.
apply
Zceil_ub
.
rewrite
Zceil_floor_neq
.
...
...
@@ -337,7 +337,7 @@ apply Zlt_irrefl with (1 := Hx).
Qed
.
Definition
rounding
x
:=
F2R
(
Float
beta
(
Zrnd
(
scaled_mantissa
x
)
(
canonic_exponent
x
)
)
(
canonic_exponent
x
)).
F2R
(
Float
beta
(
Zrnd
(
scaled_mantissa
x
))
(
canonic_exponent
x
)).
Theorem
rounding_monotone_pos
:
forall
x
y
,
(
0
<
x
)
%
R
->
(
x
<=
y
)
%
R
->
(
rounding
x
<=
rounding
y
)
%
R
.
...
...
@@ -374,14 +374,14 @@ apply Zrnd_monotone.
apply
Rmult_le_compat_r
.
apply
bpow_ge_0
.
exact
Hxy
.
apply
Rle_trans
with
(
F2R
(
Float
beta
(
Zrnd
(
bpow
(
ey
-
1
)
*
bpow
(
-
fexp
ey
))
(
fexp
ey
)
)
(
fexp
ey
))).
apply
Rle_trans
with
(
F2R
(
Float
beta
(
Zrnd
(
bpow
(
ey
-
1
)
*
bpow
(
-
fexp
ey
)))
(
fexp
ey
))).
rewrite
<-
bpow_add
.
rewrite
<-
(
Z2R_Zpower
beta
(
ey
-
1
+
-
fexp
ey
)).
2
:
omega
.
rewrite
Zrnd_Z2R
.
destruct
(
Zle_or_lt
ex
(
fexp
ex
))
as
[
Hx1
|
Hx1
].
apply
Rle_trans
with
(
F2R
(
Float
beta
1
(
fexp
ex
))).
apply
F2R_le_compat
.
rewrite
<-
(
Zrnd_Z2R
1
(
fexp
ex
)
).
rewrite
<-
(
Zrnd_Z2R
1
).
apply
Zrnd_monotone
.
apply
Rlt_le
.
exact
(
proj2
(
mantissa_small_pos
_
_
Hex
Hx1
)).
...
...
@@ -390,7 +390,7 @@ rewrite Z2R_Zpower. 2: omega.
rewrite
<-
bpow_add
,
Rmult_1_l
.
apply
->
bpow_le
.
omega
.
apply
Rle_trans
with
(
F2R
(
Float
beta
(
Zrnd
(
bpow
ex
*
bpow
(
-
fexp
ex
))
(
fexp
ex
)
)
(
fexp
ex
))).
apply
Rle_trans
with
(
F2R
(
Float
beta
(
Zrnd
(
bpow
ex
*
bpow
(
-
fexp
ex
)))
(
fexp
ex
))).
apply
F2R_le_compat
.
apply
Zrnd_monotone
.
apply
Rmult_le_compat_r
.
...
...
@@ -450,7 +450,7 @@ intros x ex He Hx.
unfold
rounding
,
scaled_mantissa
.
rewrite
(
canonic_exponent_fexp_pos
_
_
Hx
).
unfold
F2R
.
simpl
.
destruct
(
Zrnd_DN_or_UP
(
x
*
bpow
(
-
fexp
ex
))
(
fexp
ex
)
)
as
[
Hr
|
Hr
]
;
rewrite
Hr
.
destruct
(
Zrnd_DN_or_UP
(
x
*
bpow
(
-
fexp
ex
)))
as
[
Hr
|
Hr
]
;
rewrite
Hr
.
(
*
DN
*
)
split
.
replace
(
ex
-
1
)
%
Z
with
(
ex
-
1
+
-
fexp
ex
+
fexp
ex
)
%
Z
by
ring
.
...
...
@@ -509,7 +509,7 @@ intros x ex He Hx.
unfold
rounding
,
scaled_mantissa
.
rewrite
(
canonic_exponent_fexp_pos
_
_
Hx
).
unfold
F2R
.
simpl
.
destruct
(
Zrnd_DN_or_UP
(
x
*
bpow
(
-
fexp
ex
))
(
fexp
ex
)
)
as
[
Hr
|
Hr
]
;
rewrite
Hr
.
destruct
(
Zrnd_DN_or_UP
(
x
*
bpow
(
-
fexp
ex
)))
as
[
Hr
|
Hr
]
;
rewrite
Hr
.
(
*
DN
*
)
left
.
apply
Rmult_eq_0_compat_r
.
...
...
@@ -563,7 +563,7 @@ End Fcore_generic_rounding_pos.
Theorem
rounding_ext
:
forall
rnd1
rnd2
,
(
forall
x
e
,
Zrnd
rnd1
x
e
=
Zrnd
rnd2
x
e
)
->
(
forall
x
,
Zrnd
rnd1
x
=
Zrnd
rnd2
x
)
->
forall
x
,
rounding
rnd1
x
=
rounding
rnd2
x
.
Proof
.
...
...
@@ -576,12 +576,12 @@ Section Zrounding_opp.
Variable
rnd
:
Zrounding
.
Definition
Zrnd_opp
x
e
:=
Zopp
(
Zrnd
rnd
(
-
x
)
e
).
Definition
Zrnd_opp
x
:=
Zopp
(
Zrnd
rnd
(
-
x
)
).
Lemma
Zrnd_opp_le
:
forall
x
y
e
,
(
x
<=
y
)
%
R
->
(
Zrnd_opp
x
e
<=
Zrnd_opp
y
e
)
%
Z
.
forall
x
y
,
(
x
<=
y
)
%
R
->
(
Zrnd_opp
x
<=
Zrnd_opp
y
)
%
Z
.
Proof
.
intros
x
y
e
Hxy
.
intros
x
y
Hxy
.
unfold
Zrnd_opp
.
apply
Zopp_le_cancel
.
rewrite
2
!
Zopp_involutive
.
...
...
@@ -590,9 +590,9 @@ now apply Ropp_le_contravar.
Qed
.
Lemma
Zrnd_opp_Z2R
:
forall
n
e
,
Zrnd_opp
(
Z2R
n
)
e
=
n
.
forall
n
,
Zrnd_opp
(
Z2R
n
)
=
n
.
Proof
.
intros
n
e
.
intros
n
.
unfold
Zrnd_opp
.
rewrite
<-
opp_Z2R
,
Zrnd_Z2R
.
apply
Zopp_involutive
.
...
...
@@ -614,13 +614,9 @@ Qed.
End
Zrounding_opp
.
Definition
mkZrounding2
rnd
(
mono
:
forall
x
y
,
(
x
<=
y
)
%
R
->
(
rnd
x
<=
rnd
y
)
%
Z
)
(
z2r
:
forall
n
,
rnd
(
Z2R
n
)
=
n
)
:=
mkZrounding
(
fun
x
_
=>
rnd
x
)
(
fun
x
y
_
=>
mono
x
y
)
(
fun
n
_
=>
z2r
n
).
Definition
ZrndDN
:=
mkZrounding2
Zfloor
Zfloor_le
Zfloor_Z2R
.
Definition
ZrndUP
:=
mkZrounding2
Zceil
Zceil_le
Zceil_Z2R
.
Definition
ZrndTZ
:=
mkZrounding2
Ztrunc
Ztrunc_le
Ztrunc_Z2R
.
Definition
ZrndDN
:=
mkZrounding
Zfloor
Zfloor_le
Zfloor_Z2R
.
Definition
ZrndUP
:=
mkZrounding
Zceil
Zceil_le
Zceil_Z2R
.
Definition
ZrndTZ
:=
mkZrounding
Ztrunc
Ztrunc_le
Ztrunc_Z2R
.
Theorem
rounding_DN_or_UP
:
forall
rnd
x
,
...
...
@@ -629,7 +625,7 @@ Proof.
intros
rnd
x
.
unfold
rounding
.
unfold
Zrnd
at
2
4.
simpl
.
destruct
(
Zrnd_DN_or_UP
rnd
(
scaled_mantissa
x
)
(
canonic_exponent
x
)
)
as
[
Hx
|
Hx
].
destruct
(
Zrnd_DN_or_UP
rnd
(
scaled_mantissa
x
))
as
[
Hx
|
Hx
].
left
.
now
rewrite
Hx
.
right
.
now
rewrite
Hx
.
Qed
.
...
...
@@ -656,7 +652,7 @@ now apply Ropp_le_contravar.
(
*
.
0
<=
y
*
)
apply
Rle_trans
with
R0
.
apply
F2R_le_0_compat
.
simpl
.
rewrite
<-
(
Zrnd_Z2R
rnd
0
(
canonic_exponent
x
)
).
rewrite
<-
(
Zrnd_Z2R
rnd
0
).
apply
Zrnd_monotone
.
simpl
.
rewrite
<-
(
Rmult_0_l
(
bpow
(
-
fexp
(
projT1
(
ln_beta
beta
x
))))).
...
...
@@ -664,7 +660,7 @@ apply Rmult_le_compat_r.
apply
bpow_ge_0
.
now
apply
Rlt_le
.
apply
F2R_ge_0_compat
.
simpl
.
rewrite
<-
(
Zrnd_Z2R
rnd
0
(
canonic_exponent
y
)
).
rewrite
<-
(
Zrnd_Z2R
rnd
0
).
apply
Zrnd_monotone
.
apply
Rmult_le_pos
.
exact
Hy
.
...
...
@@ -674,7 +670,7 @@ rewrite Hx.
rewrite
rounding_0
.
apply
F2R_ge_0_compat
.
simpl
.
rewrite
<-
(
Zrnd_Z2R
rnd
0
(
canonic_exponent
y
)
).
rewrite
<-
(
Zrnd_Z2R
rnd
0
).
apply
Zrnd_monotone
.
apply
Rmult_le_pos
.
now
rewrite
<-
Hx
.
...
...
@@ -697,7 +693,6 @@ rewrite <- (rounding_generic rnd y Hy).
now
apply
rounding_monotone
.
Qed
.
Theorem
rounding_abs_abs
:
forall
P
:
R
->
R
->
Prop
,
(
forall
rnd
x
,
P
x
(
rounding
rnd
x
)
)
->
...
...
@@ -723,8 +718,6 @@ apply rounding_monotone.
now
apply
Rlt_le
.
Qed
.
Theorem
rounding_monotone_abs_l
:
forall
rnd
x
y
,
generic_format
x
->
(
x
<=
Rabs
y
)
%
R
->
(
x
<=
Rabs
(
rounding
rnd
y
))
%
R
.
Proof
.
...
...
@@ -1170,8 +1163,7 @@ apply Rmult_lt_compat_r with (2 := H1).
now
apply
(
Z2R_lt
0
2
).
Qed
.
Definition
ZrndN
:=
mkZrounding2
Znearest
Znearest_monotone
Znearest_Z2R
.
Definition
ZrndN
:=
mkZrounding
Znearest
Znearest_monotone
Znearest_Z2R
.
Theorem
Znearest_N_strict
:
forall
x
,
...
...
@@ -1349,9 +1341,6 @@ rewrite opp_Z2R.
apply
Rplus_comm
.
Qed
.
Theorem
rounding_N_opp
:
forall
choice
,
forall
x
,
...
...
src/Prop/Fprop_mult_error.v
View file @
551cf217
...
...
@@ -77,10 +77,10 @@ apply Hex.
apply
Hey
.
(
*
*
)
assert
(
Hr
:
((
F2R
(
Float
beta
(
-
(
Ztrunc
(
scaled_mantissa
beta
(
FLX_exp
prec
)
x
)
*
Ztrunc
(
scaled_mantissa
beta
(
FLX_exp
prec
)
y
))
+
Zrnd
rnd
(
scaled_mantissa
beta
(
FLX_exp
prec
)
(
x
*
y
))
(
canonic_exponent
beta
(
FLX_exp
prec
)
(
x
*
y
))
*
Ztrunc
(
scaled_mantissa
beta
(
FLX_exp
prec
)
y
))
+
Zrnd
rnd
(
scaled_mantissa
beta
(
FLX_exp
prec
)
(
x
*
y
))
*
radix_val
beta
^
(
cexp
(
x
*
y
)
%
R
-
(
cexp
x
+
cexp
y
)))
(
cexp
x
+
cexp
y
)))
=
f
-
x
*
y
)
%
R
).
rewrite
Hx
at
7
.
rewrite
Hy
at
7
.
rewrite
Hx
at
6
.
rewrite
Hy
at
6
.
rewrite
<-
mult_F2R
.
simpl
.
unfold
f
,
rounding
,
Rminus
.
...
...
src/Prop/Fprop_plus_error.v
View file @
551cf217
...
...
@@ -30,7 +30,7 @@ rewrite Z2R_Zpower. 2: omega.
rewrite
<-
bpow_add
.
apply
(
f_equal
(
fun
v
=>
Z2R
m
*
bpow
v
)
%
R
).
ring
.
exists
((
Zrnd
rnd
(
Z2R
m
*
bpow
(
e
-
e
'
))
e
'
)
*
Zpower
(
radix_val
beta
)
(
e
'
-
e
))
%
Z
.
exists
((
Zrnd
rnd
(
Z2R
m
*
bpow
(
e
-
e
'
)))
*
Zpower
(
radix_val
beta
)
(
e
'
-
e
))
%
Z
.
unfold
F2R
.
simpl
.
rewrite
mult_Z2R
.
rewrite
Z2R_Zpower
.
2
:
omega
.
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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