Fcore_FLT.v 6.03 KB
Newer Older
1
(**
2 3 4 5
This file is part of the Flocq formalization of floating-point
arithmetic in Coq: http://flocq.gforge.inria.fr/

Copyright (C) 2010 Sylvie Boldo
6
#<br />#
7 8 9 10 11 12 13 14 15 16 17 18 19
Copyright (C) 2010 Guillaume Melquiond

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
COPYING file for more details.
*)

20
(** * Floating-point format with gradual underflow *)
21 22 23 24 25 26 27 28
Require Import Fcore_Raux.
Require Import Fcore_defs.
Require Import Fcore_rnd.
Require Import Fcore_generic_fmt.
Require Import Fcore_float_prop.
Require Import Fcore_FLX.
Require Import Fcore_FIX.
Require Import Fcore_rnd_ne.
BOLDO Sylvie's avatar
BOLDO Sylvie committed
29 30 31 32 33

Section RND_FLT.

Variable beta : radix.

34
Notation bpow e := (bpow beta e).
BOLDO Sylvie's avatar
BOLDO Sylvie committed
35 36

Variable emin prec : Z.
37 38

Context { prec_gt_0_ : Prec_gt_0 prec }.
BOLDO Sylvie's avatar
BOLDO Sylvie committed
39

40 41 42
(* floating-point format with gradual underflow *)
Definition FLT_format (x : R) :=
  exists f : float beta,
43
  x = F2R f /\ (Zabs (Fnum f) < Zpower beta prec)%Z /\ (emin <= Fexp f)%Z.
BOLDO Sylvie's avatar
BOLDO Sylvie committed
44

45 46
Definition FLT_exp e := Zmax (e - prec) emin.

47
(** Properties of the FLT format *)
48
Global Instance FLT_exp_valid : Valid_exp FLT_exp.
49 50 51
Proof.
intros k.
unfold FLT_exp.
52 53 54
generalize (prec_gt_0 prec).
repeat split ;
  intros ; zify ; omega.
55 56
Qed.

57 58
Theorem generic_format_FLT :
  forall x, FLT_format x -> generic_format beta FLT_exp x.
59
Proof.
60
clear prec_gt_0_.
61 62 63
intros x ((mx, ex), (H1, (H2, H3))).
simpl in H2, H3.
rewrite H1.
64 65
apply generic_format_F2R.
intros Zmx.
66 67 68 69 70
unfold canonic_exponent, FLT_exp.
rewrite ln_beta_F2R with (1 := Zmx).
apply Zmax_lub with (2 := H3).
apply Zplus_le_reg_r with (prec - ex)%Z.
ring_simplify.
71
now apply ln_beta_le_Zpower.
72 73 74 75 76 77
Qed.

Theorem FLT_format_generic :
  forall x, generic_format beta FLT_exp x -> FLT_format x.
Proof.
intros x.
78 79
unfold generic_format.
set (ex := canonic_exponent beta FLT_exp x).
80
set (mx := Ztrunc (scaled_mantissa beta FLT_exp x)).
81 82 83
intros Hx.
rewrite Hx.
eexists ; repeat split ; simpl.
BOLDO Sylvie's avatar
BOLDO Sylvie committed
84
apply lt_Z2R.
85 86
rewrite Z2R_Zpower. 2: now apply Zlt_le_weak.
apply Rmult_lt_reg_r with (bpow ex).
87
apply bpow_gt_0.
88
rewrite <- bpow_plus.
89
change (F2R (Float beta (Zabs mx) ex) < bpow (prec + ex))%R.
90
rewrite F2R_abs.
91 92 93 94 95 96 97 98 99
rewrite <- Hx.
destruct (Req_dec x 0) as [Hx0|Hx0].
rewrite Hx0, Rabs_R0.
apply bpow_gt_0.
unfold canonic_exponent in ex.
destruct (ln_beta beta x) as (ex', He).
simpl in ex.
specialize (He Hx0).
apply Rlt_le_trans with (1 := proj2 He).
100
apply bpow_le.
101 102
cut (ex' - prec <= ex)%Z. omega.
unfold ex, FLT_exp.
103 104
apply Zle_max_l.
apply Zle_max_r.
BOLDO Sylvie's avatar
BOLDO Sylvie committed
105 106
Qed.

107 108 109
Theorem FLT_format_satisfies_any :
  satisfies_any FLT_format.
Proof.
110
refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLT_exp)).
Guillaume Melquiond's avatar
Guillaume Melquiond committed
111
intros x.
112
split.
Guillaume Melquiond's avatar
Guillaume Melquiond committed
113
apply FLT_format_generic.
114
apply generic_format_FLT.
115
Qed.
BOLDO Sylvie's avatar
BOLDO Sylvie committed
116

117
Theorem canonic_exp_FLT_FLX :
118
  forall x, x <> R0 ->
119
  (bpow (emin + prec - 1) <= Rabs x)%R ->
120
  canonic_exponent beta FLT_exp x = canonic_exponent beta (FLX_exp prec) x.
121
Proof.
122 123
intros x Hx0 Hx.
unfold canonic_exponent.
124 125
apply Zmax_left.
destruct (ln_beta beta x) as (ex, He).
126 127 128
unfold FLX_exp. simpl.
specialize (He Hx0).
cut (emin + prec - 1 < ex)%Z. omega.
129
apply (lt_bpow beta).
130 131 132 133
apply Rle_lt_trans with (1 := Hx).
apply He.
Qed.

134
(** Links between FLT and FLX *)
135
Theorem generic_format_FLT_FLX :
Guillaume Melquiond's avatar
Guillaume Melquiond committed
136 137
  forall x : R,
  (bpow (emin + prec - 1) <= Rabs x)%R ->
138 139
  generic_format beta (FLX_exp prec) x ->
  generic_format beta FLT_exp x.
Guillaume Melquiond's avatar
Guillaume Melquiond committed
140
Proof.
141
intros x Hx H.
142 143
destruct (Req_dec x 0) as [Hx0|Hx0].
rewrite Hx0.
144
apply generic_format_0.
145
unfold generic_format, scaled_mantissa.
146
now rewrite canonic_exp_FLT_FLX.
Guillaume Melquiond's avatar
Guillaume Melquiond committed
147 148
Qed.

149
Theorem generic_format_FLX_FLT :
150 151 152
  forall x : R,
  generic_format beta FLT_exp x -> generic_format beta (FLX_exp prec) x.
Proof.
153
clear prec_gt_0_.
154 155
intros x Hx.
unfold generic_format in Hx; rewrite Hx.
156 157
apply generic_format_F2R.
intros _.
158 159 160 161 162
rewrite <- Hx.
unfold canonic_exponent, FLX_exp, FLT_exp.
apply Zle_max_l.
Qed.

163
Theorem round_FLT_FLX : forall rnd x,
164
  (bpow (emin + prec - 1) <= Rabs x)%R ->
165
  round beta FLT_exp rnd x = round beta (FLX_exp prec) rnd x.
166
intros rnd x Hx.
167
unfold round, scaled_mantissa.
168 169 170 171
rewrite canonic_exp_FLT_FLX ; trivial.
contradict Hx.
rewrite Hx, Rabs_R0.
apply Rlt_not_le.
172 173 174
apply bpow_gt_0.
Qed.

175
(** Links between FLT and FIX (underflow) *)
176
Theorem canonic_exp_FLT_FIX :
177 178
  forall x, x <> R0 ->
  (Rabs x < bpow (emin + prec))%R ->
179
  canonic_exponent beta FLT_exp x = canonic_exponent beta (FIX_exp emin) x.
180 181
Proof.
intros x Hx0 Hx.
182 183 184
unfold canonic_exponent.
apply Zmax_right.
unfold FIX_exp.
185 186 187
destruct (ln_beta beta x) as (ex, Hex).
simpl.
cut (ex - 1 < emin + prec)%Z. omega.
188
apply (lt_bpow beta).
189 190 191 192
apply Rle_lt_trans with (2 := Hx).
now apply Hex.
Qed.

193
Theorem generic_format_FIX_FLT :
194 195 196 197
  forall x : R,
  generic_format beta FLT_exp x ->
  generic_format beta (FIX_exp emin) x.
Proof.
198
clear prec_gt_0_.
199 200
intros x Hx.
rewrite Hx.
201 202
apply generic_format_F2R.
intros _.
203 204 205 206
rewrite <- Hx.
apply Zle_max_r.
Qed.

207
Theorem generic_format_FLT_FIX :
208 209
  forall x : R,
  (Rabs x <= bpow (emin + prec))%R ->
210 211
  generic_format beta (FIX_exp emin) x ->
  generic_format beta FLT_exp x.
212 213 214 215
Proof with auto with typeclass_instances.
clear prec_gt_0_.
apply generic_inclusion_le...
intros e He.
216
unfold FIX_exp.
217 218 219
apply Zmax_lub.
omega.
apply Zle_refl.
220 221
Qed.

222
(** FLT is a nice format: it has a monotone exponent... *)
223
Global Instance FLT_exp_monotone : Monotone_exp FLT_exp.
224
Proof.
225
intros ex ey.
226
unfold FLT_exp.
227
zify ; omega.
228 229
Qed.

230
(** and it allows a rounding to nearest, ties to even. *)
231
Hypothesis NE_prop : Zeven beta = false \/ (1 < prec)%Z.
232

233
Global Instance exists_NE_FLT : Exists_NE beta FLT_exp.
234
Proof.
235
destruct NE_prop as [H|H].
236 237 238 239
now left.
right.
intros e.
unfold FLT_exp.
240 241
destruct (Zmax_spec (e - prec) emin) as [(H1,H2)|(H1,H2)] ;
  rewrite H2 ; clear H2.
242 243 244 245 246 247 248 249
generalize (Zmax_spec (e + 1 - prec) emin).
generalize (Zmax_spec (e - prec + 1 - prec) emin).
omega.
generalize (Zmax_spec (e + 1 - prec) emin).
generalize (Zmax_spec (emin + 1 - prec) emin).
omega.
Qed.

BOLDO Sylvie's avatar
BOLDO Sylvie committed
250
End RND_FLT.