14 files changed, 10487 insertions, 0 deletions

diff --git a/flocq/Core/Fcore.v b/flocq/Core/Fcore.v
new file mode 100644
index 0000000..23ebb39
--- /dev/null
+++ b/flocq/Core/Fcore.v
@@ -0,0 +1,30 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** To ease the import *)
+Require Export Fcore_Raux.
+Require Export Fcore_defs.
+Require Export Fcore_float_prop.
+Require Export Fcore_rnd.
+Require Export Fcore_generic_fmt.
+Require Export Fcore_rnd_ne.
+Require Export Fcore_FIX.
+Require Export Fcore_FLX.
+Require Export Fcore_FLT.
+Require Export Fcore_ulp.
diff --git a/flocq/Core/Fcore_FIX.v b/flocq/Core/Fcore_FIX.v
new file mode 100644
index 0000000..f185ddf
--- /dev/null
+++ b/flocq/Core/Fcore_FIX.v
@@ -0,0 +1,87 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Fixed-point format *)
+Require Import Fcore_Raux.
+Require Import Fcore_defs.
+Require Import Fcore_rnd.
+Require Import Fcore_generic_fmt.
+Require Import Fcore_rnd_ne.
+
+Section RND_FIX.
+
+Variable beta : radix.
+
+Notation bpow := (bpow beta).
+
+Variable emin : Z.
+
+(* fixed-point format with exponent emin *)
+Definition FIX_format (x : R) :=
+  exists f : float beta,
+  x = F2R f /\ (Fexp f = emin)%Z.
+
+Definition FIX_exp (e : Z) := emin.
+
+(** Properties of the FIX format *)
+
+Global Instance FIX_exp_valid : Valid_exp FIX_exp.
+Proof.
+intros k.
+unfold FIX_exp.
+split ; intros H.
+now apply Zlt_le_weak.
+split.
+apply Zle_refl.
+now intros _ _.
+Qed.
+
+Theorem generic_format_FIX :
+  forall x, FIX_format x -> generic_format beta FIX_exp x.
+Proof.
+intros x ((xm, xe), (Hx1, Hx2)).
+rewrite Hx1.
+now apply generic_format_canonic.
+Qed.
+
+Theorem FIX_format_generic :
+  forall x, generic_format beta FIX_exp x -> FIX_format x.
+Proof.
+intros x H.
+rewrite H.
+eexists ; repeat split.
+Qed.
+
+Theorem FIX_format_satisfies_any :
+  satisfies_any FIX_format.
+Proof.
+refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FIX_exp)).
+intros x.
+split.
+apply FIX_format_generic.
+apply generic_format_FIX.
+Qed.
+
+Global Instance FIX_exp_monotone : Monotone_exp FIX_exp.
+Proof.
+intros ex ey H.
+apply Zle_refl.
+Qed.
+
+End RND_FIX.
diff --git a/flocq/Core/Fcore_FLT.v b/flocq/Core/Fcore_FLT.v
new file mode 100644
index 0000000..4ad4797
--- /dev/null
+++ b/flocq/Core/Fcore_FLT.v
@@ -0,0 +1,250 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Floating-point format with gradual underflow *)
+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.
+
+Section RND_FLT.
+
+Variable beta : radix.
+
+Notation bpow e := (bpow beta e).
+
+Variable emin prec : Z.
+
+Context { prec_gt_0_ : Prec_gt_0 prec }.
+
+(* floating-point format with gradual underflow *)
+Definition FLT_format (x : R) :=
+  exists f : float beta,
+  x = F2R f /\ (Zabs (Fnum f) < Zpower beta prec)%Z /\ (emin <= Fexp f)%Z.
+
+Definition FLT_exp e := Zmax (e - prec) emin.
+
+(** Properties of the FLT format *)
+Global Instance FLT_exp_valid : Valid_exp FLT_exp.
+Proof.
+intros k.
+unfold FLT_exp.
+generalize (prec_gt_0 prec).
+repeat split ;
+  intros ; zify ; omega.
+Qed.
+
+Theorem generic_format_FLT :
+  forall x, FLT_format x -> generic_format beta FLT_exp x.
+Proof.
+clear prec_gt_0_.
+intros x ((mx, ex), (H1, (H2, H3))).
+simpl in H2, H3.
+rewrite H1.
+apply generic_format_F2R.
+intros Zmx.
+unfold canonic_exp, 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.
+now apply ln_beta_le_Zpower.
+Qed.
+
+Theorem FLT_format_generic :
+  forall x, generic_format beta FLT_exp x -> FLT_format x.
+Proof.
+intros x.
+unfold generic_format.
+set (ex := canonic_exp beta FLT_exp x).
+set (mx := Ztrunc (scaled_mantissa beta FLT_exp x)).
+intros Hx.
+rewrite Hx.
+eexists ; repeat split ; simpl.
+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_plus.
+change (F2R (Float beta (Zabs mx) ex) < bpow (prec + ex))%R.
+rewrite F2R_Zabs.
+rewrite <- Hx.
+destruct (Req_dec x 0) as [Hx0|Hx0].
+rewrite Hx0, Rabs_R0.
+apply bpow_gt_0.
+unfold canonic_exp in ex.
+destruct (ln_beta beta x) as (ex', He).
+simpl in ex.
+specialize (He Hx0).
+apply Rlt_le_trans with (1 := proj2 He).
+apply bpow_le.
+cut (ex' - prec <= ex)%Z. omega.
+unfold ex, FLT_exp.
+apply Zle_max_l.
+apply Zle_max_r.
+Qed.
+
+Theorem FLT_format_satisfies_any :
+  satisfies_any FLT_format.
+Proof.
+refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLT_exp)).
+intros x.
+split.
+apply FLT_format_generic.
+apply generic_format_FLT.
+Qed.
+
+Theorem canonic_exp_FLT_FLX :
+  forall x, x <> R0 ->
+  (bpow (emin + prec - 1) <= Rabs x)%R ->
+  canonic_exp beta FLT_exp x = canonic_exp beta (FLX_exp prec) x.
+Proof.
+intros x Hx0 Hx.
+unfold canonic_exp.
+apply Zmax_left.
+destruct (ln_beta beta x) as (ex, He).
+unfold FLX_exp. simpl.
+specialize (He Hx0).
+cut (emin + prec - 1 < ex)%Z. omega.
+apply (lt_bpow beta).
+apply Rle_lt_trans with (1 := Hx).
+apply He.
+Qed.
+
+(** Links between FLT and FLX *)
+Theorem generic_format_FLT_FLX :
+  forall x : R,
+  (bpow (emin + prec - 1) <= Rabs x)%R ->
+  generic_format beta (FLX_exp prec) x ->
+  generic_format beta FLT_exp x.
+Proof.
+intros x Hx H.
+destruct (Req_dec x 0) as [Hx0|Hx0].
+rewrite Hx0.
+apply generic_format_0.
+unfold generic_format, scaled_mantissa.
+now rewrite canonic_exp_FLT_FLX.
+Qed.
+
+Theorem generic_format_FLX_FLT :
+  forall x : R,
+  generic_format beta FLT_exp x -> generic_format beta (FLX_exp prec) x.
+Proof.
+clear prec_gt_0_.
+intros x Hx.
+unfold generic_format in Hx; rewrite Hx.
+apply generic_format_F2R.
+intros _.
+rewrite <- Hx.
+unfold canonic_exp, FLX_exp, FLT_exp.
+apply Zle_max_l.
+Qed.
+
+Theorem round_FLT_FLX : forall rnd x,
+  (bpow (emin + prec - 1) <= Rabs x)%R ->
+  round beta FLT_exp rnd x = round beta (FLX_exp prec) rnd x.
+intros rnd x Hx.
+unfold round, scaled_mantissa.
+rewrite canonic_exp_FLT_FLX ; trivial.
+contradict Hx.
+rewrite Hx, Rabs_R0.
+apply Rlt_not_le.
+apply bpow_gt_0.
+Qed.
+
+(** Links between FLT and FIX (underflow) *)
+Theorem canonic_exp_FLT_FIX :
+  forall x, x <> R0 ->
+  (Rabs x < bpow (emin + prec))%R ->
+  canonic_exp beta FLT_exp x = canonic_exp beta (FIX_exp emin) x.
+Proof.
+intros x Hx0 Hx.
+unfold canonic_exp.
+apply Zmax_right.
+unfold FIX_exp.
+destruct (ln_beta beta x) as (ex, Hex).
+simpl.
+cut (ex - 1 < emin + prec)%Z. omega.
+apply (lt_bpow beta).
+apply Rle_lt_trans with (2 := Hx).
+now apply Hex.
+Qed.
+
+Theorem generic_format_FIX_FLT :
+  forall x : R,
+  generic_format beta FLT_exp x ->
+  generic_format beta (FIX_exp emin) x.
+Proof.
+clear prec_gt_0_.
+intros x Hx.
+rewrite Hx.
+apply generic_format_F2R.
+intros _.
+rewrite <- Hx.
+apply Zle_max_r.
+Qed.
+
+Theorem generic_format_FLT_FIX :
+  forall x : R,
+  (Rabs x <= bpow (emin + prec))%R ->
+  generic_format beta (FIX_exp emin) x ->
+  generic_format beta FLT_exp x.
+Proof with auto with typeclass_instances.
+clear prec_gt_0_.
+apply generic_inclusion_le...
+intros e He.
+unfold FIX_exp.
+apply Zmax_lub.
+omega.
+apply Zle_refl.
+Qed.
+
+(** FLT is a nice format: it has a monotone exponent... *)
+Global Instance FLT_exp_monotone : Monotone_exp FLT_exp.
+Proof.
+intros ex ey.
+unfold FLT_exp.
+zify ; omega.
+Qed.
+
+(** and it allows a rounding to nearest, ties to even. *)
+Hypothesis NE_prop : Zeven beta = false \/ (1 < prec)%Z.
+
+Global Instance exists_NE_FLT : Exists_NE beta FLT_exp.
+Proof.
+destruct NE_prop as [H|H].
+now left.
+right.
+intros e.
+unfold FLT_exp.
+destruct (Zmax_spec (e - prec) emin) as [(H1,H2)|(H1,H2)] ;
+  rewrite H2 ; clear H2.
+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.
+
+End RND_FLT.
diff --git a/flocq/Core/Fcore_FLX.v b/flocq/Core/Fcore_FLX.v
new file mode 100644
index 0000000..62ecb6f
--- /dev/null
+++ b/flocq/Core/Fcore_FLX.v
@@ -0,0 +1,233 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Floating-point format without underflow *)
+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_FIX.
+Require Import Fcore_rnd_ne.
+
+Section RND_FLX.
+
+Variable beta : radix.
+
+Notation bpow e := (bpow beta e).
+
+Variable prec : Z.
+
+Class Prec_gt_0 :=
+  prec_gt_0 : (0 < prec)%Z.
+
+Context { prec_gt_0_ : Prec_gt_0 }.
+
+(* unbounded floating-point format *)
+Definition FLX_format (x : R) :=
+  exists f : float beta,
+  x = F2R f /\ (Zabs (Fnum f) < Zpower beta prec)%Z.
+
+Definition FLX_exp (e : Z) := (e - prec)%Z.
+
+(** Properties of the FLX format *)
+
+Global Instance FLX_exp_valid : Valid_exp FLX_exp.
+Proof.
+intros k.
+unfold FLX_exp.
+generalize prec_gt_0.
+repeat split ; intros ; omega.
+Qed.
+
+Theorem FIX_format_FLX :
+  forall x e,
+  (bpow (e - 1) <= Rabs x <= bpow e)%R ->
+  FLX_format x ->
+  FIX_format beta (e - prec) x.
+Proof.
+clear prec_gt_0_.
+intros x e Hx ((xm, xe), (H1, H2)).
+rewrite H1, (F2R_prec_normalize beta xm xe e prec).
+now eexists.
+exact H2.
+now rewrite <- H1.
+Qed.
+
+Theorem FLX_format_generic :
+  forall x, generic_format beta FLX_exp x -> FLX_format x.
+Proof.
+intros x H.
+rewrite H.
+unfold FLX_format.
+eexists ; repeat split.
+simpl.
+apply lt_Z2R.
+rewrite Z2R_abs.
+rewrite <- scaled_mantissa_generic with (1 := H).
+rewrite <- scaled_mantissa_abs.
+apply Rmult_lt_reg_r with (bpow (canonic_exp beta FLX_exp (Rabs x))).
+apply bpow_gt_0.
+rewrite scaled_mantissa_mult_bpow.
+rewrite Z2R_Zpower, <- bpow_plus.
+2: now apply Zlt_le_weak.
+unfold canonic_exp, FLX_exp.
+ring_simplify (prec + (ln_beta beta (Rabs x) - prec))%Z.
+rewrite ln_beta_abs.
+destruct (Req_dec x 0) as [Hx|Hx].
+rewrite Hx, Rabs_R0.
+apply bpow_gt_0.
+destruct (ln_beta beta x) as (ex, Ex).
+now apply Ex.
+Qed.
+
+Theorem generic_format_FLX :
+  forall x, FLX_format x -> generic_format beta FLX_exp x.
+Proof.
+clear prec_gt_0_.
+intros x ((mx,ex),(H1,H2)).
+simpl in H2.
+rewrite H1.
+apply generic_format_F2R.
+intros Zmx.
+unfold canonic_exp, FLX_exp.
+rewrite ln_beta_F2R with (1 := Zmx).
+apply Zplus_le_reg_r with (prec - ex)%Z.
+ring_simplify.
+now apply ln_beta_le_Zpower.
+Qed.
+
+Theorem FLX_format_satisfies_any :
+  satisfies_any FLX_format.
+Proof.
+refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLX_exp)).
+intros x.
+split.
+apply FLX_format_generic.
+apply generic_format_FLX.
+Qed.
+
+Theorem FLX_format_FIX :
+  forall x e,
+  (bpow (e - 1) <= Rabs x <= bpow e)%R ->
+  FIX_format beta (e - prec) x ->
+  FLX_format x.
+Proof with auto with typeclass_instances.
+intros x e Hx Fx.
+apply FLX_format_generic.
+apply generic_format_FIX in Fx.
+revert Fx.
+apply generic_inclusion with (e := e)...
+apply Zle_refl.
+Qed.
+
+(** unbounded floating-point format with normal mantissas *)
+Definition FLXN_format (x : R) :=
+  exists f : float beta,
+  x = F2R f /\ (x <> R0 ->
+  Zpower beta (prec - 1) <= Zabs (Fnum f) < Zpower beta prec)%Z.
+
+Theorem generic_format_FLXN :
+  forall x, FLXN_format x -> generic_format beta FLX_exp x.
+Proof.
+intros x ((xm,ex),(H1,H2)).
+destruct (Req_dec x 0) as [Zx|Zx].
+rewrite Zx.
+apply generic_format_0.
+specialize (H2 Zx).
+apply generic_format_FLX.
+rewrite H1.
+eexists ; repeat split.
+apply H2.
+Qed.
+
+Theorem FLXN_format_generic :
+  forall x, generic_format beta FLX_exp x -> FLXN_format x.
+Proof.
+intros x Hx.
+rewrite Hx.
+simpl.
+eexists ; split. split.
+simpl.
+rewrite <- Hx.
+intros Zx.
+split.
+(* *)
+apply le_Z2R.
+rewrite Z2R_Zpower.
+2: now apply Zlt_0_le_0_pred.
+rewrite Z2R_abs, <- scaled_mantissa_generic with (1 := Hx).
+apply Rmult_le_reg_r with (bpow (canonic_exp beta FLX_exp x)).
+apply bpow_gt_0.
+rewrite <- bpow_plus.
+rewrite <- scaled_mantissa_abs.
+rewrite <- canonic_exp_abs.
+rewrite scaled_mantissa_mult_bpow.
+unfold canonic_exp, FLX_exp.
+rewrite ln_beta_abs.
+ring_simplify (prec - 1 + (ln_beta beta x - prec))%Z.
+destruct (ln_beta beta x) as (ex,Ex).
+now apply Ex.
+(* *)
+apply lt_Z2R.
+rewrite Z2R_Zpower.
+2: now apply Zlt_le_weak.
+rewrite Z2R_abs, <- scaled_mantissa_generic with (1 := Hx).
+apply Rmult_lt_reg_r with (bpow (canonic_exp beta FLX_exp x)).
+apply bpow_gt_0.
+rewrite <- bpow_plus.
+rewrite <- scaled_mantissa_abs.
+rewrite <- canonic_exp_abs.
+rewrite scaled_mantissa_mult_bpow.
+unfold canonic_exp, FLX_exp.
+rewrite ln_beta_abs.
+ring_simplify (prec + (ln_beta beta x - prec))%Z.
+destruct (ln_beta beta x) as (ex,Ex).
+now apply Ex.
+Qed.
+
+Theorem FLXN_format_satisfies_any :
+  satisfies_any FLXN_format.
+Proof.
+refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FLX_exp)).
+split ; intros H.
+now apply FLXN_format_generic.
+now apply generic_format_FLXN.
+Qed.
+
+(** FLX is a nice format: it has a monotone exponent... *)
+Global Instance FLX_exp_monotone : Monotone_exp FLX_exp.
+Proof.
+intros ex ey Hxy.
+now apply Zplus_le_compat_r.
+Qed.
+
+(** and it allows a rounding to nearest, ties to even. *)
+Hypothesis NE_prop : Zeven beta = false \/ (1 < prec)%Z.
+
+Global Instance exists_NE_FLX : Exists_NE beta FLX_exp.
+Proof.
+destruct NE_prop as [H|H].
+now left.
+right.
+unfold FLX_exp.
+split ; omega.
+Qed.
+
+End RND_FLX.
diff --git a/flocq/Core/Fcore_FTZ.v b/flocq/Core/Fcore_FTZ.v
new file mode 100644
index 0000000..5356c11
--- /dev/null
+++ b/flocq/Core/Fcore_FTZ.v
@@ -0,0 +1,330 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Floating-point format with abrupt underflow *)
+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.
+
+Section RND_FTZ.
+
+Variable beta : radix.
+
+Notation bpow e := (bpow beta e).
+
+Variable emin prec : Z.
+
+Context { prec_gt_0_ : Prec_gt_0 prec }.
+
+(* floating-point format with abrupt underflow *)
+Definition FTZ_format (x : R) :=
+  exists f : float beta,
+  x = F2R f /\ (x <> R0 -> Zpower beta (prec - 1) <= Zabs (Fnum f) < Zpower beta prec)%Z /\
+  (emin <= Fexp f)%Z.
+
+Definition FTZ_exp e := if Zlt_bool (e - prec) emin then (emin + prec - 1)%Z else (e - prec)%Z.
+
+(** Properties of the FTZ format *)
+Global Instance FTZ_exp_valid : Valid_exp FTZ_exp.
+Proof.
+intros k.
+unfold FTZ_exp.
+generalize (Zlt_cases (k - prec) emin).
+case (Zlt_bool (k - prec) emin) ; intros H1.
+split ; intros H2.
+omega.
+split.
+generalize (Zlt_cases (emin + prec + 1 - prec) emin).
+case (Zlt_bool (emin + prec + 1 - prec) emin) ; intros H3.
+omega.
+generalize (Zlt_cases (emin + prec - 1 + 1 - prec) emin).
+generalize (prec_gt_0 prec).
+case (Zlt_bool (emin + prec - 1 + 1 - prec) emin) ; omega.
+intros l H3.
+generalize (Zlt_cases (l - prec) emin).
+case (Zlt_bool (l - prec) emin) ; omega.
+split ; intros H2.
+generalize (Zlt_cases (k + 1 - prec) emin).
+case (Zlt_bool (k + 1 - prec) emin) ; omega.
+generalize (prec_gt_0 prec).
+split ; intros ; omega.
+Qed.
+
+Theorem FLXN_format_FTZ :
+  forall x, FTZ_format x -> FLXN_format beta prec x.
+Proof.
+intros x ((xm, xe), (Hx1, (Hx2, Hx3))).
+eexists.
+apply (conj Hx1 Hx2).
+Qed.
+
+Theorem generic_format_FTZ :
+  forall x, FTZ_format x -> generic_format beta FTZ_exp x.
+Proof.
+intros x Hx.
+cut (generic_format beta (FLX_exp prec) x).
+apply generic_inclusion_ln_beta.
+intros Zx.
+destruct Hx as ((xm, xe), (Hx1, (Hx2, Hx3))).
+simpl in Hx2, Hx3.
+specialize (Hx2 Zx).
+assert (Zxm: xm <> Z0).
+contradict Zx.
+rewrite Hx1, Zx.
+apply F2R_0.
+unfold FTZ_exp, FLX_exp.
+rewrite Zlt_bool_false.
+apply Zle_refl.
+rewrite Hx1, ln_beta_F2R with (1 := Zxm).
+cut (prec - 1 < ln_beta beta (Z2R xm))%Z.
+clear -Hx3 ; omega.
+apply ln_beta_gt_Zpower with (1 := Zxm).
+apply Hx2.
+apply generic_format_FLXN.
+now apply FLXN_format_FTZ.
+Qed.
+
+Theorem FTZ_format_generic :
+  forall x, generic_format beta FTZ_exp x -> FTZ_format x.
+Proof.
+intros x Hx.
+destruct (Req_dec x 0) as [Hx3|Hx3].
+exists (Float beta 0 emin).
+split.
+unfold F2R. simpl.
+now rewrite Rmult_0_l.
+split.
+intros H.
+now elim H.
+apply Zle_refl.
+unfold generic_format, scaled_mantissa, canonic_exp, FTZ_exp in Hx.
+destruct (ln_beta beta x) as (ex, Hx4).
+simpl in Hx.
+specialize (Hx4 Hx3).
+generalize (Zlt_cases (ex - prec) emin) Hx. clear Hx.
+case (Zlt_bool (ex - prec) emin) ; intros Hx5 Hx2.
+elim Rlt_not_ge with (1 := proj2 Hx4).
+apply Rle_ge.
+rewrite Hx2, <- F2R_Zabs.
+rewrite <- (Rmult_1_l (bpow ex)).
+unfold F2R. simpl.
+apply Rmult_le_compat.
+now apply (Z2R_le 0 1).
+apply bpow_ge_0.
+apply (Z2R_le 1).
+apply (Zlt_le_succ 0).
+apply lt_Z2R.
+apply Rmult_lt_reg_r with (bpow (emin + prec - 1)).
+apply bpow_gt_0.
+rewrite Rmult_0_l.
+change (0 < F2R (Float beta (Zabs (Ztrunc (x * bpow (- (emin + prec - 1))))) (emin + prec - 1)))%R.
+rewrite F2R_Zabs, <- Hx2.
+now apply Rabs_pos_lt.
+apply bpow_le.
+omega.
+rewrite Hx2.
+eexists ; repeat split ; simpl.
+apply le_Z2R.
+rewrite Z2R_Zpower.
+apply Rmult_le_reg_r with (bpow (ex - prec)).
+apply bpow_gt_0.
+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 F2R_Zabs, <- Hx2.
+apply Hx4.
+apply Zle_minus_le_0.
+now apply (Zlt_le_succ 0).
+apply lt_Z2R.
+rewrite Z2R_Zpower.
+apply Rmult_lt_reg_r with (bpow (ex - prec)).
+apply bpow_gt_0.
+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 F2R_Zabs, <- Hx2.
+apply Hx4.
+now apply Zlt_le_weak.
+now apply Zge_le.
+Qed.
+
+Theorem FTZ_format_satisfies_any :
+  satisfies_any FTZ_format.
+Proof.
+refine (satisfies_any_eq _ _ _ (generic_format_satisfies_any beta FTZ_exp)).
+intros x.
+split.
+apply FTZ_format_generic.
+apply generic_format_FTZ.
+Qed.
+
+Theorem FTZ_format_FLXN :
+  forall x : R,
+  (bpow (emin + prec - 1) <= Rabs x)%R ->
+  FLXN_format beta prec x -> FTZ_format x.
+Proof.
+clear prec_gt_0_.
+intros x Hx Fx.
+apply FTZ_format_generic.
+apply generic_format_FLXN in Fx.
+revert Hx Fx.
+apply generic_inclusion_ge.
+intros e He.
+unfold FTZ_exp.
+rewrite Zlt_bool_false.
+apply Zle_refl.
+omega.
+Qed.
+
+Section FTZ_round.
+
+(** Rounding with FTZ *)
+Variable rnd : R -> Z.
+Context { valid_rnd : Valid_rnd rnd }.
+
+Definition Zrnd_FTZ x :=
+  if Rle_bool R1 (Rabs x) then rnd x else Z0.
+
+Global Instance valid_rnd_FTZ : Valid_rnd Zrnd_FTZ.
+Proof with auto with typeclass_instances.
+split.
+(* *)
+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_le.
+rewrite <- (Zrnd_Z2R rnd 0).
+apply Zrnd_le...
+apply Rle_trans with (Z2R (-1)). 2: now apply Z2R_le.
+destruct (Rabs_ge_inv _ _ Hx) as [Hx1|Hx1].
+exact Hx1.
+elim Rle_not_lt with (1 := Hx1).
+apply Rle_lt_trans with (2 := Hy).
+apply Rle_trans with (1 := Hxy).
+apply RRle_abs.
+(* |x| < 1 *)
+rewrite <- (Zrnd_Z2R rnd 0).
+apply Zrnd_le...
+apply Rle_trans with (Z2R 1).
+now apply Z2R_le.
+destruct (Rabs_ge_inv _ _ Hy) as [Hy1|Hy1].
+elim Rle_not_lt with (1 := Hy1).
+apply Rlt_le_trans with (2 := Hxy).
+apply (Rabs_def2 _ _ Hx).
+exact Hy1.
+(* *)
+intros n.
+unfold Zrnd_FTZ.
+rewrite Zrnd_Z2R...
+case Rle_bool_spec.
+easy.
+rewrite <- Z2R_abs.
+intros H.
+generalize (lt_Z2R _ 1 H).
+clear.
+now case n ; trivial ; simpl ; intros [p|p|].
+Qed.
+
+Theorem round_FTZ_FLX :
+  forall x : R,
+  (bpow (emin + prec - 1) <= Rabs x)%R ->
+  round beta FTZ_exp Zrnd_FTZ x = round beta (FLX_exp prec) rnd x.
+Proof.
+intros x Hx.
+unfold round, scaled_mantissa, canonic_exp.
+destruct (ln_beta beta x) as (ex, He). simpl.
+assert (Hx0: x <> R0).
+intros Hx0.
+apply Rle_not_lt with (1 := Hx).
+rewrite Hx0, Rabs_R0.
+apply bpow_gt_0.
+specialize (He Hx0).
+assert (He': (emin + prec <= ex)%Z).
+apply (bpow_lt_bpow beta).
+apply Rle_lt_trans with (1 := Hx).
+apply He.
+replace (FTZ_exp ex) with (FLX_exp prec ex).
+unfold Zrnd_FTZ.
+rewrite Rle_bool_true.
+apply refl_equal.
+rewrite Rabs_mult.
+rewrite (Rabs_pos_eq (bpow (- FLX_exp prec ex))).
+change R1 with (bpow 0).
+rewrite <- (Zplus_opp_r (FLX_exp prec ex)).
+rewrite bpow_plus.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply Rle_trans with (2 := proj1 He).
+apply bpow_le.
+unfold FLX_exp.
+generalize (prec_gt_0 prec).
+clear -He' ; omega.
+apply bpow_ge_0.
+unfold FLX_exp, FTZ_exp.
+rewrite Zlt_bool_false.
+apply refl_equal.
+clear -He' ; omega.
+Qed.
+
+Theorem round_FTZ_small :
+  forall x : R,
+  (Rabs x < bpow (emin + prec - 1))%R ->
+  round beta FTZ_exp Zrnd_FTZ x = R0.
+Proof with auto with typeclass_instances.
+intros x Hx.
+destruct (Req_dec x 0) as [Hx0|Hx0].
+rewrite Hx0.
+apply round_0...
+unfold round, scaled_mantissa, canonic_exp.
+destruct (ln_beta beta x) as (ex, He). simpl.
+specialize (He Hx0).
+unfold Zrnd_FTZ.
+rewrite Rle_bool_false.
+apply F2R_0.
+rewrite Rabs_mult.
+rewrite (Rabs_pos_eq (bpow (- FTZ_exp ex))).
+change R1 with (bpow 0).
+rewrite <- (Zplus_opp_r (FTZ_exp ex)).
+rewrite bpow_plus.
+apply Rmult_lt_compat_r.
+apply bpow_gt_0.
+apply Rlt_le_trans with (1 := Hx).
+apply bpow_le.
+unfold FTZ_exp.
+generalize (Zlt_cases (ex - prec) emin).
+case Zlt_bool.
+intros _.
+apply Zle_refl.
+intros He'.
+elim Rlt_not_le with (1 := Hx).
+apply Rle_trans with (2 := proj1 He).
+apply bpow_le.
+omega.
+apply bpow_ge_0.
+Qed.
+
+End FTZ_round.
+
+End RND_FTZ.
diff --git a/flocq/Core/Fcore_Raux.v b/flocq/Core/Fcore_Raux.v
new file mode 100644
index 0000000..748e36e
--- /dev/null
+++ b/flocq/Core/Fcore_Raux.v
@@ -0,0 +1,1996 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Missing definitions/lemmas *)
+Require Export Reals.
+Require Export ZArith.
+Require Export Fcore_Zaux.
+
+Section Rmissing.
+
+(** About R *)
+Theorem Rle_0_minus :
+  forall x y, (x <= y)%R -> (0 <= y - x)%R.
+Proof.
+intros.
+apply Rge_le.
+apply Rge_minus.
+now apply Rle_ge.
+Qed.
+
+Theorem Rabs_eq_Rabs :
+  forall x y : R,
+  Rabs x = Rabs y -> x = y \/ x = Ropp y.
+Proof.
+intros x y H.
+unfold Rabs in H.
+destruct (Rcase_abs x) as [_|_].
+assert (H' := f_equal Ropp H).
+rewrite Ropp_involutive in H'.
+rewrite H'.
+destruct (Rcase_abs y) as [_|_].
+left.
+apply Ropp_involutive.
+now right.
+rewrite H.
+now destruct (Rcase_abs y) as [_|_] ; [right|left].
+Qed.
+
+Theorem Rabs_minus_le:
+  forall x y : R,
+  (0 <= y)%R -> (y <= 2*x)%R ->
+  (Rabs (x-y) <= x)%R.
+Proof.
+intros x y Hx Hy.
+unfold Rabs; case (Rcase_abs (x - y)); intros H.
+apply Rplus_le_reg_l with x; ring_simplify; assumption.
+apply Rplus_le_reg_l with (-x)%R; ring_simplify.
+auto with real.
+Qed.
+
+Theorem Rplus_eq_reg_r :
+  forall r r1 r2 : R,
+  (r1 + r = r2 + r)%R -> (r1 = r2)%R.
+Proof.
+intros r r1 r2 H.
+apply Rplus_eq_reg_l with r.
+now rewrite 2!(Rplus_comm r).
+Qed.
+
+Theorem Rplus_le_reg_r :
+  forall r r1 r2 : R,
+  (r1 + r <= r2 + r)%R -> (r1 <= r2)%R.
+Proof.
+intros.
+apply Rplus_le_reg_l with r.
+now rewrite 2!(Rplus_comm r).
+Qed.
+
+Theorem Rmult_lt_reg_r :
+  forall r r1 r2 : R, (0 < r)%R ->
+  (r1 * r < r2 * r)%R -> (r1 < r2)%R.
+Proof.
+intros.
+apply Rmult_lt_reg_l with r.
+exact H.
+now rewrite 2!(Rmult_comm r).
+Qed.
+
+Theorem Rmult_le_reg_r :
+  forall r r1 r2 : R, (0 < r)%R ->
+  (r1 * r <= r2 * r)%R -> (r1 <= r2)%R.
+Proof.
+intros.
+apply Rmult_le_reg_l with r.
+exact H.
+now rewrite 2!(Rmult_comm r).
+Qed.
+
+Theorem Rmult_eq_reg_r :
+  forall r r1 r2 : R, (r1 * r)%R = (r2 * r)%R ->
+  r <> 0%R -> r1 = r2.
+Proof.
+intros r r1 r2 H1 H2.
+apply Rmult_eq_reg_l with r.
+now rewrite 2!(Rmult_comm r).
+exact H2.
+Qed.
+
+Theorem Rmult_minus_distr_r :
+  forall r r1 r2 : R,
+  ((r1 - r2) * r = r1 * r - r2 * r)%R.
+Proof.
+intros r r1 r2.
+rewrite <- 3!(Rmult_comm r).
+apply Rmult_minus_distr_l.
+Qed.
+
+Theorem Rmult_min_distr_r :
+  forall r r1 r2 : R,
+  (0 <= r)%R ->
+  (Rmin r1 r2 * r)%R = Rmin (r1 * r) (r2 * r).
+Proof.
+intros r r1 r2 [Hr|Hr].
+unfold Rmin.
+destruct (Rle_dec r1 r2) as [H1|H1] ;
+  destruct (Rle_dec (r1 * r) (r2 * r)) as [H2|H2] ;
+  try easy.
+apply (f_equal (fun x => Rmult x r)).
+apply Rle_antisym.
+exact H1.
+apply Rmult_le_reg_r with (1 := Hr).
+apply Rlt_le.
+now apply Rnot_le_lt.
+apply Rle_antisym.
+apply Rmult_le_compat_r.
+now apply Rlt_le.
+apply Rlt_le.
+now apply Rnot_le_lt.
+exact H2.
+rewrite <- Hr.
+rewrite 3!Rmult_0_r.
+unfold Rmin.
+destruct (Rle_dec 0 0) as [H0|H0].
+easy.
+elim H0.
+apply Rle_refl.
+Qed.
+
+Theorem Rmult_min_distr_l :
+  forall r r1 r2 : R,
+  (0 <= r)%R ->
+  (r * Rmin r1 r2)%R = Rmin (r * r1) (r * r2).
+Proof.
+intros r r1 r2 Hr.
+rewrite 3!(Rmult_comm r).
+now apply Rmult_min_distr_r.
+Qed.
+
+Theorem exp_le :
+  forall x y : R,
+  (x <= y)%R -> (exp x <= exp y)%R.
+Proof.
+intros x y [H|H].
+apply Rlt_le.
+now apply exp_increasing.
+rewrite H.
+apply Rle_refl.
+Qed.
+
+Theorem Rinv_lt :
+  forall x y,
+  (0 < x)%R -> (x < y)%R -> (/y < /x)%R.
+Proof.
+intros x y Hx Hxy.
+apply Rinv_lt_contravar.
+apply Rmult_lt_0_compat.
+exact Hx.
+now apply Rlt_trans with x.
+exact Hxy.
+Qed.
+
+Theorem Rinv_le :
+  forall x y,
+  (0 < x)%R -> (x <= y)%R -> (/y <= /x)%R.
+Proof.
+intros x y Hx Hxy.
+apply Rle_Rinv.
+exact Hx.
+now apply Rlt_le_trans with x.
+exact Hxy.
+Qed.
+
+Theorem sqrt_ge_0 :
+  forall x : R,
+  (0 <= sqrt x)%R.
+Proof.
+intros x.
+unfold sqrt.
+destruct (Rcase_abs x) as [_|H].
+apply Rle_refl.
+apply Rsqrt_positivity.
+Qed.
+
+Theorem Rabs_le :
+  forall x y,
+  (-y <= x <= y)%R -> (Rabs x <= y)%R.
+Proof.
+intros x y (Hyx,Hxy).
+unfold Rabs.
+case Rcase_abs ; intros Hx.
+apply Ropp_le_cancel.
+now rewrite Ropp_involutive.
+exact Hxy.
+Qed.
+
+Theorem Rabs_le_inv :
+  forall x y,
+  (Rabs x <= y)%R -> (-y <= x <= y)%R.
+Proof.
+intros x y Hxy.
+split.
+apply Rle_trans with (- Rabs x)%R.
+now apply Ropp_le_contravar.
+apply Ropp_le_cancel.
+rewrite Ropp_involutive, <- Rabs_Ropp.
+apply RRle_abs.
+apply Rle_trans with (2 := Hxy).
+apply RRle_abs.
+Qed.
+
+Theorem Rabs_ge :
+  forall x y,
+  (y <= -x \/ x <= y)%R -> (x <= Rabs y)%R.
+Proof.
+intros x y [Hyx|Hxy].
+apply Rle_trans with (-y)%R.
+apply Ropp_le_cancel.
+now rewrite Ropp_involutive.
+rewrite <- Rabs_Ropp.
+apply RRle_abs.
+apply Rle_trans with (1 := Hxy).
+apply RRle_abs.
+Qed.
+
+Theorem Rabs_ge_inv :
+  forall x y,
+  (x <= Rabs y)%R -> (y <= -x \/ x <= y)%R.
+Proof.
+intros x y.
+unfold Rabs.
+case Rcase_abs ; intros Hy Hxy.
+left.
+apply Ropp_le_cancel.
+now rewrite Ropp_involutive.
+now right.
+Qed.
+
+Theorem Rabs_lt :
+  forall x y,
+  (-y < x < y)%R -> (Rabs x < y)%R.
+Proof.
+intros x y (Hyx,Hxy).
+now apply Rabs_def1.
+Qed.
+
+Theorem Rabs_lt_inv :
+  forall x y,
+  (Rabs x < y)%R -> (-y < x < y)%R.
+Proof.
+intros x y H.
+now split ; eapply Rabs_def2.
+Qed.
+
+Theorem Rabs_gt :
+  forall x y,
+  (y < -x \/ x < y)%R -> (x < Rabs y)%R.
+Proof.
+intros x y [Hyx|Hxy].
+rewrite <- Rabs_Ropp.
+apply Rlt_le_trans with (Ropp y).
+apply Ropp_lt_cancel.
+now rewrite Ropp_involutive.
+apply RRle_abs.
+apply Rlt_le_trans with (1 := Hxy).
+apply RRle_abs.
+Qed.
+
+Theorem Rabs_gt_inv :
+  forall x y,
+  (x < Rabs y)%R -> (y < -x \/ x < y)%R.
+Proof.
+intros x y.
+unfold Rabs.
+case Rcase_abs ; intros Hy Hxy.
+left.
+apply Ropp_lt_cancel.
+now rewrite Ropp_involutive.
+now right.
+Qed.
+
+End Rmissing.
+
+Section Z2R.
+
+(** Z2R function (Z -> R) *)
+Fixpoint P2R (p : positive) :=
+  match p with
+  | xH => 1%R
+  | xO xH => 2%R
+  | xO t => (2 * P2R t)%R
+  | xI xH => 3%R
+  | xI t => (1 + 2 * P2R t)%R
+  end.
+
+Definition Z2R n :=
+  match n with
+  | Zpos p => P2R p
+  | Zneg p => Ropp (P2R p)
+  | Z0 => R0
+  end.
+
+Theorem P2R_INR :
+  forall n, P2R n = INR (nat_of_P n).
+Proof.
+induction n ; simpl ; try (
+  rewrite IHn ;
+  rewrite <- (mult_INR 2) ;
+  rewrite <- (nat_of_P_mult_morphism 2) ;
+  change (2 * n)%positive with (xO n)).
+(* xI *)
+rewrite (Rplus_comm 1).
+change (nat_of_P (xO n)) with (Pmult_nat n 2).
+case n ; intros ; simpl ; try apply refl_equal.
+case (Pmult_nat p 4) ; intros ; try apply refl_equal.
+rewrite Rplus_0_l.
+apply refl_equal.
+apply Rplus_comm.
+(* xO *)
+case n ; intros ; apply refl_equal.
+(* xH *)
+apply refl_equal.
+Qed.
+
+Theorem Z2R_IZR :
+  forall n, Z2R n = IZR n.
+Proof.
+intro.
+case n ; intros ; simpl.
+apply refl_equal.
+apply P2R_INR.
+apply Ropp_eq_compat.
+apply P2R_INR.
+Qed.
+
+Theorem Z2R_opp :
+  forall n, Z2R (-n) = (- Z2R n)%R.
+Proof.
+intros.
+repeat rewrite Z2R_IZR.
+apply Ropp_Ropp_IZR.
+Qed.
+
+Theorem Z2R_plus :
+  forall m n, (Z2R (m + n) = Z2R m + Z2R n)%R.
+Proof.
+intros.
+repeat rewrite Z2R_IZR.
+apply plus_IZR.
+Qed.
+
+Theorem minus_IZR :
+  forall n m : Z,
+  IZR (n - m) = (IZR n - IZR m)%R.
+Proof.
+intros.
+unfold Zminus.
+rewrite plus_IZR.
+rewrite Ropp_Ropp_IZR.
+apply refl_equal.
+Qed.
+
+Theorem Z2R_minus :
+  forall m n, (Z2R (m - n) = Z2R m - Z2R n)%R.
+Proof.
+intros.
+repeat rewrite Z2R_IZR.
+apply minus_IZR.
+Qed.
+
+Theorem Z2R_mult :
+  forall m n, (Z2R (m * n) = Z2R m * Z2R n)%R.
+Proof.
+intros.
+repeat rewrite Z2R_IZR.
+apply mult_IZR.
+Qed.
+
+Theorem le_Z2R :
+  forall m n, (Z2R m <= Z2R n)%R -> (m <= n)%Z.
+Proof.
+intros m n.
+repeat rewrite Z2R_IZR.
+apply le_IZR.
+Qed.
+
+Theorem Z2R_le :
+  forall m n, (m <= n)%Z -> (Z2R m <= Z2R n)%R.
+Proof.
+intros m n.
+repeat rewrite Z2R_IZR.
+apply IZR_le.
+Qed.
+
+Theorem lt_Z2R :
+  forall m n, (Z2R m < Z2R n)%R -> (m < n)%Z.
+Proof.
+intros m n.
+repeat rewrite Z2R_IZR.
+apply lt_IZR.
+Qed.
+
+Theorem Z2R_lt :
+  forall m n, (m < n)%Z -> (Z2R m < Z2R n)%R.
+Proof.
+intros m n.
+repeat rewrite Z2R_IZR.
+apply IZR_lt.
+Qed.
+
+Theorem Z2R_le_lt :
+  forall m n p, (m <= n < p)%Z -> (Z2R m <= Z2R n < Z2R p)%R.
+Proof.
+intros m n p (H1, H2).
+split.
+now apply Z2R_le.
+now apply Z2R_lt.
+Qed.
+
+Theorem le_lt_Z2R :
+  forall m n p, (Z2R m <= Z2R n < Z2R p)%R -> (m <= n < p)%Z.
+Proof.
+intros m n p (H1, H2).
+split.
+now apply le_Z2R.
+now apply lt_Z2R.
+Qed.
+
+Theorem eq_Z2R :
+  forall m n, (Z2R m = Z2R n)%R -> (m = n)%Z.
+Proof.
+intros m n H.
+apply eq_IZR.
+now rewrite <- 2!Z2R_IZR.
+Qed.
+
+Theorem neq_Z2R :
+  forall m n, (Z2R m <> Z2R n)%R -> (m <> n)%Z.
+Proof.
+intros m n H H'.
+apply H.
+now apply f_equal.
+Qed.
+
+Theorem Z2R_neq :
+  forall m n, (m <> n)%Z -> (Z2R m <> Z2R n)%R.
+Proof.
+intros m n.
+repeat rewrite Z2R_IZR.
+apply IZR_neq.
+Qed.
+
+Theorem Z2R_abs :
+  forall z, Z2R (Zabs z) = Rabs (Z2R z).
+Proof.
+intros.
+repeat rewrite Z2R_IZR.
+now rewrite Rabs_Zabs.
+Qed.
+
+End Z2R.
+
+(** Decidable comparison on reals *)
+Section Rcompare.
+
+Definition Rcompare x y :=
+  match total_order_T x y with
+  | inleft (left _) => Lt
+  | inleft (right _) => Eq
+  | inright _ => Gt
+  end.
+
+Inductive Rcompare_prop (x y : R) : comparison -> Prop :=
+  | Rcompare_Lt_ : (x < y)%R -> Rcompare_prop x y Lt
+  | Rcompare_Eq_ : x = y -> Rcompare_prop x y Eq
+  | Rcompare_Gt_ : (y < x)%R -> Rcompare_prop x y Gt.
+
+Theorem Rcompare_spec :
+  forall x y, Rcompare_prop x y (Rcompare x y).
+Proof.
+intros x y.
+unfold Rcompare.
+now destruct (total_order_T x y) as [[H|H]|H] ; constructor.
+Qed.
+
+Global Opaque Rcompare.
+
+Theorem Rcompare_Lt :
+  forall x y,
+  (x < y)%R -> Rcompare x y = Lt.
+Proof.
+intros x y H.
+case Rcompare_spec ; intro H'.
+easy.
+rewrite H' in H.
+elim (Rlt_irrefl _ H).
+elim (Rlt_irrefl x).
+now apply Rlt_trans with y.
+Qed.
+
+Theorem Rcompare_Lt_inv :
+  forall x y,
+  Rcompare x y = Lt -> (x < y)%R.
+Proof.
+intros x y.
+now case Rcompare_spec.
+Qed.
+
+Theorem Rcompare_not_Lt :
+  forall x y,
+  (y <= x)%R -> Rcompare x y <> Lt.
+Proof.
+intros x y H1 H2.
+apply Rle_not_lt with (1 := H1).
+now apply Rcompare_Lt_inv.
+Qed.
+
+Theorem Rcompare_not_Lt_inv :
+  forall x y,
+  Rcompare x y <> Lt -> (y <= x)%R.
+Proof.
+intros x y H.
+apply Rnot_lt_le.
+contradict H.
+now apply Rcompare_Lt.
+Qed.
+
+Theorem Rcompare_Eq :
+  forall x y,
+  x = y -> Rcompare x y = Eq.
+Proof.
+intros x y H.
+rewrite H.
+now case Rcompare_spec ; intro H' ; try elim (Rlt_irrefl _ H').
+Qed.
+
+Theorem Rcompare_Eq_inv :
+  forall x y,
+  Rcompare x y = Eq -> x = y.
+Proof.
+intros x y.
+now case Rcompare_spec.
+Qed.
+
+Theorem Rcompare_Gt :
+  forall x y,
+  (y < x)%R -> Rcompare x y = Gt.
+Proof.
+intros x y H.
+case Rcompare_spec ; intro H'.
+elim (Rlt_irrefl x).
+now apply Rlt_trans with y.
+rewrite H' in H.
+elim (Rlt_irrefl _ H).
+easy.
+Qed.
+
+Theorem Rcompare_Gt_inv :
+  forall x y,
+  Rcompare x y = Gt -> (y < x)%R.
+Proof.
+intros x y.
+now case Rcompare_spec.
+Qed.
+
+Theorem Rcompare_not_Gt :
+  forall x y,
+  (x <= y)%R -> Rcompare x y <> Gt.
+Proof.
+intros x y H1 H2.
+apply Rle_not_lt with (1 := H1).
+now apply Rcompare_Gt_inv.
+Qed.
+
+Theorem Rcompare_not_Gt_inv :
+  forall x y,
+  Rcompare x y <> Gt -> (x <= y)%R.
+Proof.
+intros x y H.
+apply Rnot_lt_le.
+contradict H.
+now apply Rcompare_Gt.
+Qed.
+
+Theorem Rcompare_Z2R :
+  forall x y, Rcompare (Z2R x) (Z2R y) = Zcompare x y.
+Proof.
+intros x y.
+case Rcompare_spec ; intros H ; apply sym_eq.
+apply Zcompare_Lt.
+now apply lt_Z2R.
+apply Zcompare_Eq.
+now apply eq_Z2R.
+apply Zcompare_Gt.
+now apply lt_Z2R.
+Qed.
+
+Theorem Rcompare_sym :
+  forall x y,
+  Rcompare x y = CompOpp (Rcompare y x).
+Proof.
+intros x y.
+destruct (Rcompare_spec y x) as [H|H|H].
+now apply Rcompare_Gt.
+now apply Rcompare_Eq.
+now apply Rcompare_Lt.
+Qed.
+
+Theorem Rcompare_plus_r :
+  forall z x y,
+  Rcompare (x + z) (y + z) = Rcompare x y.
+Proof.
+intros z x y.
+destruct (Rcompare_spec x y) as [H|H|H].
+apply Rcompare_Lt.
+now apply Rplus_lt_compat_r.
+apply Rcompare_Eq.
+now rewrite H.
+apply Rcompare_Gt.
+now apply Rplus_lt_compat_r.
+Qed.
+
+Theorem Rcompare_plus_l :
+  forall z x y,
+  Rcompare (z + x) (z + y) = Rcompare x y.
+Proof.
+intros z x y.
+rewrite 2!(Rplus_comm z).
+apply Rcompare_plus_r.
+Qed.
+
+Theorem Rcompare_mult_r :
+  forall z x y,
+  (0 < z)%R ->
+  Rcompare (x * z) (y * z) = Rcompare x y.
+Proof.
+intros z x y Hz.
+destruct (Rcompare_spec x y) as [H|H|H].
+apply Rcompare_Lt.
+now apply Rmult_lt_compat_r.
+apply Rcompare_Eq.
+now rewrite H.
+apply Rcompare_Gt.
+now apply Rmult_lt_compat_r.
+Qed.
+
+Theorem Rcompare_mult_l :
+  forall z x y,
+  (0 < z)%R ->
+  Rcompare (z * x) (z * y) = Rcompare x y.
+Proof.
+intros z x y.
+rewrite 2!(Rmult_comm z).
+apply Rcompare_mult_r.
+Qed.
+
+Theorem Rcompare_middle :
+  forall x d u,
+  Rcompare (x - d) (u - x) = Rcompare x ((d + u) / 2).
+Proof.
+intros x d u.
+rewrite <- (Rcompare_plus_r (- x / 2 - d / 2) x).
+rewrite <- (Rcompare_mult_r (/2) (x - d)).
+field_simplify (x + (- x / 2 - d / 2))%R.
+now field_simplify ((d + u) / 2 + (- x / 2 - d / 2))%R.
+apply Rinv_0_lt_compat.
+now apply (Z2R_lt 0 2).
+Qed.
+
+Theorem Rcompare_half_l :
+  forall x y, Rcompare (x / 2) y = Rcompare x (2 * y).
+Proof.
+intros x y.
+rewrite <- (Rcompare_mult_r 2%R).
+unfold Rdiv.
+rewrite Rmult_assoc, Rinv_l, Rmult_1_r.
+now rewrite Rmult_comm.
+now apply (Z2R_neq 2 0).
+now apply (Z2R_lt 0 2).
+Qed.
+
+Theorem Rcompare_half_r :
+  forall x y, Rcompare x (y / 2) = Rcompare (2 * x) y.
+Proof.
+intros x y.
+rewrite <- (Rcompare_mult_r 2%R).
+unfold Rdiv.
+rewrite Rmult_assoc, Rinv_l, Rmult_1_r.
+now rewrite Rmult_comm.
+now apply (Z2R_neq 2 0).
+now apply (Z2R_lt 0 2).
+Qed.
+
+Theorem Rcompare_sqr :
+  forall x y,
+  (0 <= x)%R -> (0 <= y)%R ->
+  Rcompare (x * x) (y * y) = Rcompare x y.
+Proof.
+intros x y Hx Hy.
+destruct (Rcompare_spec x y) as [H|H|H].
+apply Rcompare_Lt.
+now apply Rsqr_incrst_1.
+rewrite H.
+now apply Rcompare_Eq.
+apply Rcompare_Gt.
+now apply Rsqr_incrst_1.
+Qed.
+
+Theorem Rmin_compare :
+  forall x y,
+  Rmin x y = match Rcompare x y with Lt => x | Eq => x | Gt => y end.
+Proof.
+intros x y.
+unfold Rmin.
+destruct (Rle_dec x y) as [[Hx|Hx]|Hx].
+now rewrite Rcompare_Lt.
+now rewrite Rcompare_Eq.
+rewrite Rcompare_Gt.
+easy.
+now apply Rnot_le_lt.
+Qed.
+
+End Rcompare.
+
+Section Rle_bool.
+
+Definition Rle_bool x y :=
+  match Rcompare x y with
+  | Gt => false
+  | _ => true
+  end.
+
+Inductive Rle_bool_prop (x y : R) : bool -> Prop :=
+  | Rle_bool_true_ : (x <= y)%R -> Rle_bool_prop x y true
+  | Rle_bool_false_ : (y < x)%R -> Rle_bool_prop x y false.
+
+Theorem Rle_bool_spec :
+  forall x y, Rle_bool_prop x y (Rle_bool x y).
+Proof.
+intros x y.
+unfold Rle_bool.
+case Rcompare_spec ; constructor.
+now apply Rlt_le.
+rewrite H.
+apply Rle_refl.
+exact H.
+Qed.
+
+Theorem Rle_bool_true :
+  forall x y,
+  (x <= y)%R -> Rle_bool x y = true.
+Proof.
+intros x y Hxy.
+case Rle_bool_spec ; intros H.
+apply refl_equal.
+elim (Rlt_irrefl x).
+now apply Rle_lt_trans with y.
+Qed.
+
+Theorem Rle_bool_false :
+  forall x y,
+  (y < x)%R -> Rle_bool x y = false.
+Proof.
+intros x y Hxy.
+case Rle_bool_spec ; intros H.
+elim (Rlt_irrefl x).
+now apply Rle_lt_trans with y.
+apply refl_equal.
+Qed.
+
+End Rle_bool.
+
+Section Rlt_bool.
+
+Definition Rlt_bool x y :=
+  match Rcompare x y with
+  | Lt => true
+  | _ => false
+  end.
+
+Inductive Rlt_bool_prop (x y : R) : bool -> Prop :=
+  | Rlt_bool_true_ : (x < y)%R -> Rlt_bool_prop x y true
+  | Rlt_bool_false_ : (y <= x)%R -> Rlt_bool_prop x y false.
+
+Theorem Rlt_bool_spec :
+  forall x y, Rlt_bool_prop x y (Rlt_bool x y).
+Proof.
+intros x y.
+unfold Rlt_bool.
+case Rcompare_spec ; constructor.
+exact H.
+rewrite H.
+apply Rle_refl.
+now apply Rlt_le.
+Qed.
+
+Theorem negb_Rlt_bool :
+  forall x y,
+  negb (Rle_bool x y) = Rlt_bool y x.
+Proof.
+intros x y.
+unfold Rlt_bool, Rle_bool.
+rewrite Rcompare_sym.
+now case Rcompare.
+Qed.
+
+Theorem negb_Rle_bool :
+  forall x y,
+  negb (Rlt_bool x y) = Rle_bool y x.
+Proof.
+intros x y.
+unfold Rlt_bool, Rle_bool.
+rewrite Rcompare_sym.
+now case Rcompare.
+Qed.
+
+Theorem Rlt_bool_true :
+  forall x y,
+  (x < y)%R -> Rlt_bool x y = true.
+Proof.
+intros x y Hxy.
+rewrite <- negb_Rlt_bool.
+now rewrite Rle_bool_false.
+Qed.
+
+Theorem Rlt_bool_false :
+  forall x y,
+  (y <= x)%R -> Rlt_bool x y = false.
+Proof.
+intros x y Hxy.
+rewrite <- negb_Rlt_bool.
+now rewrite Rle_bool_true.
+Qed.
+
+End Rlt_bool.
+
+Section Req_bool.
+
+Definition Req_bool x y :=
+  match Rcompare x y with
+  | Eq => true
+  | _ => false
+  end.
+
+Inductive Req_bool_prop (x y : R) : bool -> Prop :=
+  | Req_bool_true_ : (x = y)%R -> Req_bool_prop x y true
+  | Req_bool_false_ : (x <> y)%R -> Req_bool_prop x y false.
+
+Theorem Req_bool_spec :
+  forall x y, Req_bool_prop x y (Req_bool x y).
+Proof.
+intros x y.
+unfold Req_bool.
+case Rcompare_spec ; constructor.
+now apply Rlt_not_eq.
+easy.
+now apply Rgt_not_eq.
+Qed.
+
+Theorem Req_bool_true :
+  forall x y,
+  (x = y)%R -> Req_bool x y = true.
+Proof.
+intros x y Hxy.
+case Req_bool_spec ; intros H.
+apply refl_equal.
+contradict H.
+exact Hxy.
+Qed.
+
+Theorem Req_bool_false :
+  forall x y,
+  (x <> y)%R -> Req_bool x y = false.
+Proof.
+intros x y Hxy.
+case Req_bool_spec ; intros H.
+contradict Hxy.
+exact H.
+apply refl_equal.
+Qed.
+
+End Req_bool.
+
+Section Floor_Ceil.
+
+(** Zfloor and Zceil *)
+Definition Zfloor (x : R) := (up x - 1)%Z.
+
+Theorem Zfloor_lb :
+  forall x : R,
+  (Z2R (Zfloor x) <= x)%R.
+Proof.
+intros x.
+unfold Zfloor.
+rewrite Z2R_minus.
+simpl.
+rewrite Z2R_IZR.
+apply Rplus_le_reg_r with (1 - x)%R.
+ring_simplify.
+exact (proj2 (archimed x)).
+Qed.
+
+Theorem Zfloor_ub :
+  forall x : R,
+  (x < Z2R (Zfloor x) + 1)%R.
+Proof.
+intros x.
+unfold Zfloor.
+rewrite Z2R_minus.
+unfold Rminus.
+rewrite Rplus_assoc.
+rewrite Rplus_opp_l, Rplus_0_r.
+rewrite Z2R_IZR.
+exact (proj1 (archimed x)).
+Qed.
+
+Theorem Zfloor_lub :
+  forall n x,
+  (Z2R n <= x)%R ->
+  (n <= Zfloor x)%Z.
+Proof.
+intros n x Hnx.
+apply Zlt_succ_le.
+apply lt_Z2R.
+apply Rle_lt_trans with (1 := Hnx).
+unfold Zsucc.
+rewrite Z2R_plus.
+apply Zfloor_ub.
+Qed.
+
+Theorem Zfloor_imp :
+  forall n x,
+  (Z2R n <= x < Z2R (n + 1))%R ->
+  Zfloor x = n.
+Proof.
+intros n x Hnx.
+apply Zle_antisym.
+apply Zlt_succ_le.
+apply lt_Z2R.
+apply Rle_lt_trans with (2 := proj2 Hnx).
+apply Zfloor_lb.
+now apply Zfloor_lub.
+Qed.
+
+Theorem Zfloor_Z2R :
+  forall n,
+  Zfloor (Z2R n) = n.
+Proof.
+intros n.
+apply Zfloor_imp.
+split.
+apply Rle_refl.
+apply Z2R_lt.
+apply Zlt_succ.
+Qed.
+
+Theorem Zfloor_le :
+  forall x y, (x <= y)%R ->
+  (Zfloor x <= Zfloor y)%Z.
+Proof.
+intros x y Hxy.
+apply Zfloor_lub.
+apply Rle_trans with (2 := Hxy).
+apply Zfloor_lb.
+Qed.
+
+Definition Zceil (x : R) := (- Zfloor (- x))%Z.
+
+Theorem Zceil_ub :
+  forall x : R,
+  (x <= Z2R (Zceil x))%R.
+Proof.
+intros x.
+unfold Zceil.
+rewrite Z2R_opp.
+apply Ropp_le_cancel.
+rewrite Ropp_involutive.
+apply Zfloor_lb.
+Qed.
+
+Theorem Zceil_glb :
+  forall n x,
+  (x <= Z2R n)%R ->
+  (Zceil x <= n)%Z.
+Proof.
+intros n x Hnx.
+unfold Zceil.
+apply Zopp_le_cancel.
+rewrite Zopp_involutive.
+apply Zfloor_lub.
+rewrite Z2R_opp.
+now apply Ropp_le_contravar.
+Qed.
+
+Theorem Zceil_imp :
+  forall n x,
+  (Z2R (n - 1) < x <= Z2R n)%R ->
+  Zceil x = n.
+Proof.
+intros n x Hnx.
+unfold Zceil.
+rewrite <- (Zopp_involutive n).
+apply f_equal.
+apply Zfloor_imp.
+split.
+rewrite Z2R_opp.
+now apply Ropp_le_contravar.
+rewrite <- (Zopp_involutive 1).
+rewrite <- Zopp_plus_distr.
+rewrite Z2R_opp.
+now apply Ropp_lt_contravar.
+Qed.
+
+Theorem Zceil_Z2R :
+  forall n,
+  Zceil (Z2R n) = n.
+Proof.
+intros n.
+unfold Zceil.
+rewrite <- Z2R_opp, Zfloor_Z2R.
+apply Zopp_involutive.
+Qed.
+
+Theorem Zceil_le :
+  forall x y, (x <= y)%R ->
+  (Zceil x <= Zceil y)%Z.
+Proof.
+intros x y Hxy.
+apply Zceil_glb.
+apply Rle_trans with (1 := Hxy).
+apply Zceil_ub.
+Qed.
+
+Theorem Zceil_floor_neq :
+  forall x : R,
+  (Z2R (Zfloor x) <> x)%R ->
+  (Zceil x = Zfloor x + 1)%Z.
+Proof.
+intros x Hx.
+apply Zceil_imp.
+split.
+ring_simplify (Zfloor x + 1 - 1)%Z.
+apply Rnot_le_lt.
+intros H.
+apply Hx.
+apply Rle_antisym.
+apply Zfloor_lb.
+exact H.
+apply Rlt_le.
+rewrite Z2R_plus.
+apply Zfloor_ub.
+Qed.
+
+Definition Ztrunc x := if Rlt_bool x 0 then Zceil x else Zfloor x.
+
+Theorem Ztrunc_Z2R :
+  forall n,
+  Ztrunc (Z2R n) = n.
+Proof.
+intros n.
+unfold Ztrunc.
+case Rlt_bool_spec ; intro H.
+apply Zceil_Z2R.
+apply Zfloor_Z2R.
+Qed.
+
+Theorem Ztrunc_floor :
+  forall x,
+  (0 <= x)%R ->
+  Ztrunc x = Zfloor x.
+Proof.
+intros x Hx.
+unfold Ztrunc.
+case Rlt_bool_spec ; intro H.
+elim Rlt_irrefl with x.
+now apply Rlt_le_trans with R0.
+apply refl_equal.
+Qed.
+
+Theorem Ztrunc_ceil :
+  forall x,
+  (x <= 0)%R ->
+  Ztrunc x = Zceil x.
+Proof.
+intros x Hx.
+unfold Ztrunc.
+case Rlt_bool_spec ; intro H.
+apply refl_equal.
+rewrite (Rle_antisym _ _ Hx H).
+fold (Z2R 0).
+rewrite Zceil_Z2R.
+apply Zfloor_Z2R.
+Qed.
+
+Theorem Ztrunc_le :
+  forall x y, (x <= y)%R ->
+  (Ztrunc x <= Ztrunc y)%Z.
+Proof.
+intros x y Hxy.
+unfold Ztrunc at 1.
+case Rlt_bool_spec ; intro Hx.
+unfold Ztrunc.
+case Rlt_bool_spec ; intro Hy.
+now apply Zceil_le.
+apply Zle_trans with 0%Z.
+apply Zceil_glb.
+now apply Rlt_le.
+now apply Zfloor_lub.
+rewrite Ztrunc_floor.
+now apply Zfloor_le.
+now apply Rle_trans with x.
+Qed.
+
+Theorem Ztrunc_opp :
+  forall x,
+  Ztrunc (- x) = Zopp (Ztrunc x).
+Proof.
+intros x.
+unfold Ztrunc at 2.
+case Rlt_bool_spec ; intros Hx.
+rewrite Ztrunc_floor.
+apply sym_eq.
+apply Zopp_involutive.
+rewrite <- Ropp_0.
+apply Ropp_le_contravar.
+now apply Rlt_le.
+rewrite Ztrunc_ceil.
+unfold Zceil.
+now rewrite Ropp_involutive.
+rewrite <- Ropp_0.
+now apply Ropp_le_contravar.
+Qed.
+
+Theorem Ztrunc_abs :
+  forall x,
+  Ztrunc (Rabs x) = Zabs (Ztrunc x).
+Proof.
+intros x.
+rewrite Ztrunc_floor. 2: apply Rabs_pos.
+unfold Ztrunc.
+case Rlt_bool_spec ; intro H.
+rewrite Rabs_left with (1 := H).
+rewrite Zabs_non_eq.
+apply sym_eq.
+apply Zopp_involutive.
+apply Zceil_glb.
+now apply Rlt_le.
+rewrite Rabs_pos_eq with (1 := H).
+apply sym_eq.
+apply Zabs_eq.
+now apply Zfloor_lub.
+Qed.
+
+Theorem Ztrunc_lub :
+  forall n x,
+  (Z2R n <= Rabs x)%R ->
+  (n <= Zabs (Ztrunc x))%Z.
+Proof.
+intros n x H.
+rewrite <- Ztrunc_abs.
+rewrite Ztrunc_floor. 2: apply Rabs_pos.
+now apply Zfloor_lub.
+Qed.
+
+Definition Zaway x := if Rlt_bool x 0 then Zfloor x else Zceil x.
+
+Theorem Zaway_Z2R :
+  forall n,
+  Zaway (Z2R n) = n.
+Proof.
+intros n.
+unfold Zaway.
+case Rlt_bool_spec ; intro H.
+apply Zfloor_Z2R.
+apply Zceil_Z2R.
+Qed.
+
+Theorem Zaway_ceil :
+  forall x,
+  (0 <= x)%R ->
+  Zaway x = Zceil x.
+Proof.
+intros x Hx.
+unfold Zaway.
+case Rlt_bool_spec ; intro H.
+elim Rlt_irrefl with x.
+now apply Rlt_le_trans with R0.
+apply refl_equal.
+Qed.
+
+Theorem Zaway_floor :
+  forall x,
+  (x <= 0)%R ->
+  Zaway x = Zfloor x.
+Proof.
+intros x Hx.
+unfold Zaway.
+case Rlt_bool_spec ; intro H.
+apply refl_equal.
+rewrite (Rle_antisym _ _ Hx H).
+fold (Z2R 0).
+rewrite Zfloor_Z2R.
+apply Zceil_Z2R.
+Qed.
+
+Theorem Zaway_le :
+  forall x y, (x <= y)%R ->
+  (Zaway x <= Zaway y)%Z.
+Proof.
+intros x y Hxy.
+unfold Zaway at 1.
+case Rlt_bool_spec ; intro Hx.
+unfold Zaway.
+case Rlt_bool_spec ; intro Hy.
+now apply Zfloor_le.
+apply le_Z2R.
+apply Rle_trans with 0%R.
+apply Rlt_le.
+apply Rle_lt_trans with (2 := Hx).
+apply Zfloor_lb.
+apply Rle_trans with (1 := Hy).
+apply Zceil_ub.
+rewrite Zaway_ceil.
+now apply Zceil_le.
+now apply Rle_trans with x.
+Qed.
+
+Theorem Zaway_opp :
+  forall x,
+  Zaway (- x) = Zopp (Zaway x).
+Proof.
+intros x.
+unfold Zaway at 2.
+case Rlt_bool_spec ; intro H.
+rewrite Zaway_ceil.
+unfold Zceil.
+now rewrite Ropp_involutive.
+apply Rlt_le.
+now apply Ropp_0_gt_lt_contravar.
+rewrite Zaway_floor.
+apply sym_eq.
+apply Zopp_involutive.
+rewrite <- Ropp_0.
+now apply Ropp_le_contravar.
+Qed.
+
+Theorem Zaway_abs :
+  forall x,
+  Zaway (Rabs x) = Zabs (Zaway x).
+Proof.
+intros x.
+rewrite Zaway_ceil. 2: apply Rabs_pos.
+unfold Zaway.
+case Rlt_bool_spec ; intro H.
+rewrite Rabs_left with (1 := H).
+rewrite Zabs_non_eq.
+apply (f_equal (fun v => - Zfloor v)%Z).
+apply Ropp_involutive.
+apply le_Z2R.
+apply Rlt_le.
+apply Rle_lt_trans with (2 := H).
+apply Zfloor_lb.
+rewrite Rabs_pos_eq with (1 := H).
+apply sym_eq.
+apply Zabs_eq.
+apply le_Z2R.
+apply Rle_trans with (1 := H).
+apply Zceil_ub.
+Qed.
+
+End Floor_Ceil.
+
+Section Zdiv_Rdiv.
+
+Theorem Zfloor_div :
+  forall x y,
+  y <> Z0 ->
+  Zfloor (Z2R x / Z2R y) = (x / y)%Z.
+Proof.
+intros x y Zy.
+generalize (Z_div_mod_eq_full x y Zy).
+intros Hx.
+rewrite Hx at 1.
+assert (Zy': Z2R y <> R0).
+contradict Zy.
+now apply eq_Z2R.
+unfold Rdiv.
+rewrite Z2R_plus, Rmult_plus_distr_r, Z2R_mult.
+replace (Z2R y * Z2R (x / y) * / Z2R y)%R with (Z2R (x / y)) by now field.
+apply Zfloor_imp.
+rewrite Z2R_plus.
+assert (0 <= Z2R (x mod y) * / Z2R y < 1)%R.
+(* *)
+assert (forall x' y', (0 < y')%Z -> 0 <= Z2R (x' mod y') * / Z2R y' < 1)%R.
+(* . *)
+clear.
+intros x y Hy.
+split.
+apply Rmult_le_pos.
+apply (Z2R_le 0).
+refine (proj1 (Z_mod_lt _ _ _)).
+now apply Zlt_gt.
+apply Rlt_le.
+apply Rinv_0_lt_compat.
+now apply (Z2R_lt 0).
+apply Rmult_lt_reg_r with (Z2R y).
+now apply (Z2R_lt 0).
+rewrite Rmult_1_l, Rmult_assoc, Rinv_l, Rmult_1_r.
+apply Z2R_lt.
+eapply Z_mod_lt.
+now apply Zlt_gt.
+apply Rgt_not_eq.
+now apply (Z2R_lt 0).
+(* . *)
+destruct (Z_lt_le_dec y 0) as [Hy|Hy].
+rewrite <- Rmult_opp_opp.
+rewrite Ropp_inv_permute with (1 := Zy').
+rewrite <- 2!Z2R_opp.
+rewrite <- Zmod_opp_opp.
+apply H.
+clear -Hy. omega.
+apply H.
+clear -Zy Hy. omega.
+(* *)
+split.
+pattern (Z2R (x / y)) at 1 ; rewrite <- Rplus_0_r.
+apply Rplus_le_compat_l.
+apply H.
+apply Rplus_lt_compat_l.
+apply H.
+Qed.
+
+End Zdiv_Rdiv.
+
+Section pow.
+
+Variable r : radix.
+
+Theorem radix_pos : (0 < Z2R r)%R.
+Proof.
+destruct r as (v, Hr). simpl.
+apply (Z2R_lt 0).
+apply Zlt_le_trans with 2%Z.
+easy.
+now apply Zle_bool_imp_le.
+Qed.
+
+(** Well-used function called bpow for computing the power function #&beta;#^e *)
+Definition bpow e :=
+  match e with
+  | Zpos p => Z2R (Zpower_pos r p)
+  | Zneg p => Rinv (Z2R (Zpower_pos r p))
+  | Z0 => R1
+  end.
+
+Theorem Z2R_Zpower_pos :
+  forall n m,
+  Z2R (Zpower_pos n m) = powerRZ (Z2R n) (Zpos m).
+Proof.
+intros.
+rewrite Zpower_pos_nat.
+simpl.
+induction (nat_of_P m).
+apply refl_equal.
+unfold Zpower_nat.
+simpl.
+rewrite Z2R_mult.
+apply Rmult_eq_compat_l.
+exact IHn0.
+Qed.
+
+Theorem bpow_powerRZ :
+  forall e,
+  bpow e = powerRZ (Z2R r) e.
+Proof.
+destruct e ; unfold bpow.
+reflexivity.
+now rewrite Z2R_Zpower_pos.
+now rewrite Z2R_Zpower_pos.
+Qed.
+
+Theorem  bpow_ge_0 :
+  forall e : Z, (0 <= bpow e)%R.
+Proof.
+intros.
+rewrite bpow_powerRZ.
+apply powerRZ_le.
+apply radix_pos.
+Qed.
+
+Theorem bpow_gt_0 :
+  forall e : Z, (0 < bpow e)%R.
+Proof.
+intros.
+rewrite bpow_powerRZ.
+apply powerRZ_lt.
+apply radix_pos.
+Qed.
+
+Theorem bpow_plus :
+  forall e1 e2 : Z, (bpow (e1 + e2) = bpow e1 * bpow e2)%R.
+Proof.
+intros.
+repeat rewrite bpow_powerRZ.
+apply powerRZ_add.
+apply Rgt_not_eq.
+apply radix_pos.
+Qed.
+
+Theorem bpow_1 :
+  bpow 1 = Z2R r.
+Proof.
+unfold bpow, Zpower_pos. simpl.
+now rewrite Zmult_1_r.
+Qed.
+
+Theorem bpow_plus1 :
+  forall e : Z, (bpow (e + 1) = Z2R r * bpow e)%R.
+Proof.
+intros.
+rewrite <- bpow_1.
+rewrite <- bpow_plus.
+now rewrite Zplus_comm.
+Qed.
+
+Theorem bpow_opp :
+  forall e : Z, (bpow (-e) = /bpow e)%R.
+Proof.
+intros e; destruct e.
+simpl; now rewrite Rinv_1.
+now replace (-Zpos p)%Z with (Zneg p) by reflexivity.
+replace (-Zneg p)%Z with (Zpos p) by reflexivity.
+simpl; rewrite Rinv_involutive; trivial.
+generalize (bpow_gt_0 (Zpos p)).
+simpl; auto with real.
+Qed.
+
+Theorem Z2R_Zpower_nat :
+  forall e : nat,
+  Z2R (Zpower_nat r e) = bpow (Z_of_nat e).
+Proof.
+intros [|e].
+split.
+rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ.
+rewrite <- Zpower_pos_nat.
+now rewrite <- Zpos_eq_Z_of_nat_o_nat_of_P.
+Qed.
+
+Theorem Z2R_Zpower :
+  forall e : Z,
+  (0 <= e)%Z ->
+  Z2R (Zpower r e) = bpow e.
+Proof.
+intros [|e|e] H.
+split.
+split.
+now elim H.
+Qed.
+
+Theorem bpow_lt :
+  forall e1 e2 : Z,
+  (e1 < e2)%Z -> (bpow e1 < bpow e2)%R.
+Proof.
+intros e1 e2 H.
+replace e2 with (e1 + (e2 - e1))%Z by ring.
+rewrite <- (Rmult_1_r (bpow e1)).
+rewrite bpow_plus.
+apply Rmult_lt_compat_l.
+apply bpow_gt_0.
+assert (0 < e2 - e1)%Z by omega.
+destruct (e2 - e1)%Z ; try discriminate H0.
+clear.
+rewrite <- Z2R_Zpower by easy.
+apply (Z2R_lt 1).
+now apply Zpower_gt_1.
+Qed.
+
+Theorem lt_bpow :
+  forall e1 e2 : Z,
+  (bpow e1 < bpow e2)%R -> (e1 < e2)%Z.
+Proof.
+intros e1 e2 H.
+apply Zgt_lt.
+apply Znot_le_gt.
+intros H'.
+apply Rlt_not_le with (1 := H).
+destruct (Zle_lt_or_eq _ _ H').
+apply Rlt_le.
+now apply bpow_lt.
+rewrite H0.
+apply Rle_refl.
+Qed.
+
+Theorem bpow_le :
+  forall e1 e2 : Z,
+  (e1 <= e2)%Z -> (bpow e1 <= bpow e2)%R.
+Proof.
+intros e1 e2 H.
+apply Rnot_lt_le.
+intros H'.
+apply Zle_not_gt with (1 := H).
+apply Zlt_gt.
+now apply lt_bpow.
+Qed.
+
+Theorem le_bpow :
+  forall e1 e2 : Z,
+  (bpow e1 <= bpow e2)%R -> (e1 <= e2)%Z.
+Proof.
+intros e1 e2 H.
+apply Znot_gt_le.
+intros H'.
+apply Rle_not_lt with (1 := H).
+apply bpow_lt.
+now apply Zgt_lt.
+Qed.
+
+Theorem bpow_inj :
+  forall e1 e2 : Z,
+  bpow e1 = bpow e2 -> e1 = e2.
+Proof.
+intros.
+apply Zle_antisym.
+apply le_bpow.
+now apply Req_le.
+apply le_bpow.
+now apply Req_le.
+Qed.
+
+Theorem bpow_exp :
+  forall e : Z,
+  bpow e = exp (Z2R e * ln (Z2R r)).
+Proof.
+(* positive case *)
+assert (forall e, bpow (Zpos e) = exp (Z2R (Zpos e) * ln (Z2R r))).
+intros e.
+unfold bpow.
+rewrite Zpower_pos_nat.
+unfold Z2R at 2.
+rewrite P2R_INR.
+induction (nat_of_P e).
+rewrite Rmult_0_l.
+now rewrite exp_0.
+rewrite Zpower_nat_S.
+rewrite S_INR.
+rewrite Rmult_plus_distr_r.
+rewrite exp_plus.
+rewrite Rmult_1_l.
+rewrite exp_ln.
+rewrite <- IHn.
+rewrite <- Z2R_mult.
+now rewrite Zmult_comm.
+apply radix_pos.
+(* general case *)
+intros [|e|e].
+rewrite Rmult_0_l.
+now rewrite exp_0.
+apply H.
+unfold bpow.
+change (Z2R (Zpower_pos r e)) with (bpow (Zpos e)).
+rewrite H.
+rewrite <- exp_Ropp.
+rewrite <- Ropp_mult_distr_l_reverse.
+now rewrite <- Z2R_opp.
+Qed.
+
+(** Another well-used function for having the logarithm of a real number x to the base #&beta;# *)
+Record ln_beta_prop x := {
+  ln_beta_val :> Z ;
+   _ : (x <> 0)%R -> (bpow (ln_beta_val - 1)%Z <= Rabs x < bpow ln_beta_val)%R
+}.
+
+Definition ln_beta :
+  forall x : R, ln_beta_prop x.
+Proof.
+intros x.
+set (fact := ln (Z2R r)).
+(* . *)
+assert (0 < fact)%R.
+apply exp_lt_inv.
+rewrite exp_0.
+unfold fact.
+rewrite exp_ln.
+apply (Z2R_lt 1).
+apply radix_gt_1.
+apply radix_pos.
+(* . *)
+exists (Zfloor (ln (Rabs x) / fact) + 1)%Z.
+intros Hx'.
+generalize (Rabs_pos_lt _ Hx'). clear Hx'.
+generalize (Rabs x). clear x.
+intros x Hx.
+rewrite 2!bpow_exp.
+fold fact.
+pattern x at 2 3 ; replace x with (exp (ln x * / fact * fact)).
+split.
+rewrite Z2R_minus.
+apply exp_le.
+apply Rmult_le_compat_r.
+now apply Rlt_le.
+unfold Rminus.
+rewrite Z2R_plus.
+rewrite Rplus_assoc.
+rewrite Rplus_opp_r, Rplus_0_r.
+apply Zfloor_lb.
+apply exp_increasing.
+apply Rmult_lt_compat_r.
+exact H.
+rewrite Z2R_plus.
+apply Zfloor_ub.
+rewrite Rmult_assoc.
+rewrite Rinv_l.
+rewrite Rmult_1_r.
+now apply exp_ln.
+now apply Rgt_not_eq.
+Qed.
+
+Theorem bpow_lt_bpow :
+  forall e1 e2,
+  (bpow (e1 - 1) < bpow e2)%R ->
+  (e1 <= e2)%Z.
+Proof.
+intros e1 e2 He.
+rewrite (Zsucc_pred e1).
+apply Zlt_le_succ.
+now apply lt_bpow.
+Qed.
+
+Theorem bpow_unique :
+  forall x e1 e2,
+  (bpow (e1 - 1) <= x < bpow e1)%R ->
+  (bpow (e2 - 1) <= x < bpow e2)%R ->
+  e1 = e2.
+Proof.
+intros x e1 e2 (H1a,H1b) (H2a,H2b).
+apply Zle_antisym ;
+  apply bpow_lt_bpow ;
+  apply Rle_lt_trans with x ;
+  assumption.
+Qed.
+
+Theorem ln_beta_unique :
+  forall (x : R) (e : Z),
+  (bpow (e - 1) <= Rabs x < bpow e)%R ->
+  ln_beta x = e :> Z.
+Proof.
+intros x e1 He.
+destruct (Req_dec x 0) as [Hx|Hx].
+elim Rle_not_lt with (1 := proj1 He).
+rewrite Hx, Rabs_R0.
+apply bpow_gt_0.
+destruct (ln_beta x) as (e2, Hx2).
+simpl.
+apply bpow_unique with (2 := He).
+now apply Hx2.
+Qed.
+
+Theorem ln_beta_opp :
+  forall x,
+  ln_beta (-x) = ln_beta x :> Z.
+Proof.
+intros x.
+destruct (Req_dec x 0) as [Hx|Hx].
+now rewrite Hx, Ropp_0.
+destruct (ln_beta x) as (e, He).
+simpl.
+specialize (He Hx).
+apply ln_beta_unique.
+now rewrite Rabs_Ropp.
+Qed.
+
+Theorem ln_beta_abs :
+  forall x,
+  ln_beta (Rabs x) = ln_beta x :> Z.
+Proof.
+intros x.
+unfold Rabs.
+case Rcase_abs ; intros _.
+apply ln_beta_opp.
+apply refl_equal.
+Qed.
+
+Theorem ln_beta_unique_pos :
+  forall (x : R) (e : Z),
+  (bpow (e - 1) <= x < bpow e)%R ->
+  ln_beta x = e :> Z.
+Proof.
+intros x e1 He1.
+rewrite <- ln_beta_abs.
+apply ln_beta_unique.
+rewrite 2!Rabs_pos_eq.
+exact He1.
+apply Rle_trans with (2 := proj1 He1).
+apply bpow_ge_0.
+apply Rabs_pos.
+Qed.
+
+Theorem ln_beta_le_abs :
+  forall x y,
+  (x <> 0)%R -> (Rabs x <= Rabs y)%R ->
+  (ln_beta x <= ln_beta y)%Z.
+Proof.
+intros x y H0x Hxy.
+destruct (ln_beta x) as (ex, Hx).
+destruct (ln_beta y) as (ey, Hy).
+simpl.
+apply bpow_lt_bpow.
+specialize (Hx H0x).
+apply Rle_lt_trans with (1 := proj1 Hx).
+apply Rle_lt_trans with (1 := Hxy).
+apply Hy.
+intros Hy'.
+apply Rlt_not_le with (1 := Rabs_pos_lt _ H0x).
+apply Rle_trans with (1 := Hxy).
+rewrite Hy', Rabs_R0.
+apply Rle_refl.
+Qed.
+
+Theorem ln_beta_le :
+  forall x y,
+  (0 < x)%R -> (x <= y)%R ->
+  (ln_beta x <= ln_beta y)%Z.
+Proof.
+intros x y H0x Hxy.
+apply ln_beta_le_abs.
+now apply Rgt_not_eq.
+rewrite 2!Rabs_pos_eq.
+exact Hxy.
+apply Rle_trans with (2 := Hxy).
+now apply Rlt_le.
+now apply Rlt_le.
+Qed.
+
+Theorem ln_beta_bpow :
+  forall e, (ln_beta (bpow e) = e + 1 :> Z)%Z.
+Proof.
+intros e.
+apply ln_beta_unique.
+rewrite Rabs_right.
+replace (e + 1 - 1)%Z with e by ring.
+split.
+apply Rle_refl.
+apply bpow_lt.
+apply Zlt_succ.
+apply Rle_ge.
+apply bpow_ge_0.
+Qed.
+
+Theorem ln_beta_mult_bpow :
+  forall x e, x <> R0 ->
+  (ln_beta (x * bpow e) = ln_beta x + e :>Z)%Z.
+Proof.
+intros x e Zx.
+destruct (ln_beta x) as (ex, Ex) ; simpl.
+specialize (Ex Zx).
+apply ln_beta_unique.
+rewrite Rabs_mult.
+rewrite (Rabs_pos_eq (bpow e)) by apply bpow_ge_0.
+split.
+replace (ex + e - 1)%Z with (ex - 1 + e)%Z by ring.
+rewrite bpow_plus.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply Ex.
+rewrite bpow_plus.
+apply Rmult_lt_compat_r.
+apply bpow_gt_0.
+apply Ex.
+Qed.
+
+Theorem ln_beta_le_bpow :
+  forall x e,
+  x <> R0 ->
+  (Rabs x < bpow e)%R ->
+  (ln_beta x <= e)%Z.
+Proof.
+intros x e Zx Hx.
+destruct (ln_beta x) as (ex, Ex) ; simpl.
+specialize (Ex Zx).
+apply bpow_lt_bpow.
+now apply Rle_lt_trans with (Rabs x).
+Qed.
+
+Theorem ln_beta_gt_bpow :
+  forall x e,
+  (bpow e <= Rabs x)%R ->
+  (e < ln_beta x)%Z.
+Proof.
+intros x e Hx.
+destruct (ln_beta x) as (ex, Ex) ; simpl.
+apply lt_bpow.
+apply Rle_lt_trans with (1 := Hx).
+apply Ex.
+intros Zx.
+apply Rle_not_lt with (1 := Hx).
+rewrite Zx, Rabs_R0.
+apply bpow_gt_0.
+Qed.
+
+Theorem bpow_ln_beta_gt :
+  forall x,
+  (Rabs x < bpow (ln_beta x))%R.
+Proof.
+intros x.
+destruct (Req_dec x 0) as [Zx|Zx].
+rewrite Zx, Rabs_R0.
+apply bpow_gt_0.
+destruct (ln_beta x) as (ex, Ex) ; simpl.
+now apply Ex.
+Qed.
+
+Theorem ln_beta_le_Zpower :
+  forall m e,
+  m <> Z0 ->
+  (Zabs m < Zpower r e)%Z->
+  (ln_beta (Z2R m) <= e)%Z.
+Proof.
+intros m e Zm Hm.
+apply ln_beta_le_bpow.
+exact (Z2R_neq m 0 Zm).
+destruct (Zle_or_lt 0 e).
+rewrite <- Z2R_abs, <- Z2R_Zpower with (1 := H).
+now apply Z2R_lt.
+elim Zm.
+cut (Zabs m < 0)%Z.
+now case m.
+clear -Hm H.
+now destruct e.
+Qed.
+
+Theorem ln_beta_gt_Zpower :
+  forall m e,
+  m <> Z0 ->
+  (Zpower r e <= Zabs m)%Z ->
+  (e < ln_beta (Z2R m))%Z.
+Proof.
+intros m e Zm Hm.
+apply ln_beta_gt_bpow.
+rewrite <- Z2R_abs.
+destruct (Zle_or_lt 0 e).
+rewrite <- Z2R_Zpower with (1 := H).
+now apply Z2R_le.
+apply Rle_trans with (bpow 0).
+apply bpow_le.
+now apply Zlt_le_weak.
+apply (Z2R_le 1).
+clear -Zm.
+zify ; omega.
+Qed.
+
+End pow.
+
+Section Bool.
+
+Theorem eqb_sym :
+  forall x y, Bool.eqb x y = Bool.eqb y x.
+Proof.
+now intros [|] [|].
+Qed.
+
+Theorem eqb_false :
+  forall x y, x = negb y -> Bool.eqb x y = false.
+Proof.
+now intros [|] [|].
+Qed.
+
+Theorem eqb_true :
+  forall x y, x = y -> Bool.eqb x y = true.
+Proof.
+now intros [|] [|].
+Qed.
+
+End Bool.
+
+Section cond_Ropp.
+
+Definition cond_Ropp (b : bool) m := if b then Ropp m else m.
+
+Theorem Z2R_cond_Zopp :
+  forall b m,
+  Z2R (cond_Zopp b m) = cond_Ropp b (Z2R m).
+Proof.
+intros [|] m.
+apply Z2R_opp.
+apply refl_equal.
+Qed.
+
+Theorem abs_cond_Ropp :
+  forall b m,
+  Rabs (cond_Ropp b m) = Rabs m.
+Proof.
+intros [|] m.
+apply Rabs_Ropp.
+apply refl_equal.
+Qed.
+
+Theorem cond_Ropp_Rlt_bool :
+  forall m,
+  cond_Ropp (Rlt_bool m 0) m = Rabs m.
+Proof.
+intros m.
+apply sym_eq.
+case Rlt_bool_spec ; intros Hm.
+now apply Rabs_left.
+now apply Rabs_pos_eq.
+Qed.
+
+Theorem cond_Ropp_involutive :
+  forall b x,
+  cond_Ropp b (cond_Ropp b x) = x.
+Proof.
+intros [|] x.
+apply Ropp_involutive.
+apply refl_equal.
+Qed.
+
+Theorem cond_Ropp_even_function :
+  forall {A : Type} (f : R -> A),
+  (forall x, f (Ropp x) = f x) ->
+  forall b x, f (cond_Ropp b x) = f x.
+Proof.
+now intros A f Hf [|] x ; simpl.
+Qed.
+
+Theorem cond_Ropp_odd_function :
+  forall (f : R -> R),
+  (forall x, f (Ropp x) = Ropp (f x)) ->
+  forall b x, f (cond_Ropp b x) = cond_Ropp b (f x).
+Proof.
+now intros f Hf [|] x ; simpl.
+Qed.
+
+Theorem cond_Ropp_inj :
+  forall b x y,
+  cond_Ropp b x = cond_Ropp b y -> x = y.
+Proof.
+intros b x y H.
+rewrite <- (cond_Ropp_involutive b x), H.
+apply cond_Ropp_involutive.
+Qed.
+
+Theorem cond_Ropp_mult_l :
+  forall b x y,
+  cond_Ropp b (x * y) = (cond_Ropp b x * y)%R.
+Proof.
+intros [|] x y.
+apply sym_eq.
+apply Ropp_mult_distr_l_reverse.
+apply refl_equal.
+Qed.
+
+Theorem cond_Ropp_mult_r :
+  forall b x y,
+  cond_Ropp b (x * y) = (x * cond_Ropp b y)%R.
+Proof.
+intros [|] x y.
+apply sym_eq.
+apply Ropp_mult_distr_r_reverse.
+apply refl_equal.
+Qed.
+
+Theorem cond_Ropp_plus :
+  forall b x y,
+  cond_Ropp b (x + y) = (cond_Ropp b x + cond_Ropp b y)%R.
+Proof.
+intros [|] x y.
+apply Ropp_plus_distr.
+apply refl_equal.
+Qed.
+
+End cond_Ropp.
diff --git a/flocq/Core/Fcore_Zaux.v b/flocq/Core/Fcore_Zaux.v
new file mode 100644
index 0000000..af0d837
--- /dev/null
+++ b/flocq/Core/Fcore_Zaux.v
@@ -0,0 +1,774 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2011 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.
+*)
+
+Require Import ZArith.
+Require Import ZOdiv.
+
+Section Zmissing.
+
+(** About Z *)
+Theorem Zopp_le_cancel :
+  forall x y : Z,
+  (-y <= -x)%Z -> Zle x y.
+Proof.
+intros x y Hxy.
+apply Zplus_le_reg_r with (-x - y)%Z.
+now ring_simplify.
+Qed.
+
+Theorem Zgt_not_eq :
+  forall x y : Z,
+  (y < x)%Z -> (x <> y)%Z.
+Proof.
+intros x y H Hn.
+apply Zlt_irrefl with x.
+now rewrite Hn at 1.
+Qed.
+
+End Zmissing.
+
+Section Proof_Irrelevance.
+
+Scheme eq_dep_elim := Induction for eq Sort Type.
+
+Definition eqbool_dep P (h1 : P true) b :=
+  match b return P b -> Prop with
+  | true => fun (h2 : P true) => h1 = h2
+  | false => fun (h2 : P false) => False
+  end.
+
+Lemma eqbool_irrelevance : forall (b : bool) (h1 h2 : b = true), h1 = h2.
+Proof.
+assert (forall (h : true = true), refl_equal true = h).
+apply (eq_dep_elim bool true (eqbool_dep _ _) (refl_equal _)).
+intros b.
+case b.
+intros h1 h2.
+now rewrite <- (H h1).
+intros h.
+discriminate h.
+Qed.
+
+End Proof_Irrelevance.
+
+Section Even_Odd.
+
+(** Zeven, used for rounding to nearest, ties to even *)
+Definition Zeven (n : Z) :=
+  match n with
+  | Zpos (xO _) => true
+  | Zneg (xO _) => true
+  | Z0 => true
+  | _ => false
+  end.
+
+Theorem Zeven_mult :
+  forall x y, Zeven (x * y) = orb (Zeven x) (Zeven y).
+Proof.
+now intros [|[xp|xp|]|[xp|xp|]] [|[yp|yp|]|[yp|yp|]].
+Qed.
+
+Theorem Zeven_opp :
+  forall x, Zeven (- x) = Zeven x.
+Proof.
+now intros [|[n|n|]|[n|n|]].
+Qed.
+
+Theorem Zeven_ex :
+  forall x, exists p, x = (2 * p + if Zeven x then 0 else 1)%Z.
+Proof.
+intros [|[n|n|]|[n|n|]].
+now exists Z0.
+now exists (Zpos n).
+now exists (Zpos n).
+now exists Z0.
+exists (Zneg n - 1)%Z.
+change (2 * Zneg n - 1 = 2 * (Zneg n - 1) + 1)%Z.
+ring.
+now exists (Zneg n).
+now exists (-1)%Z.
+Qed.
+
+Theorem Zeven_2xp1 :
+  forall n, Zeven (2 * n + 1) = false.
+Proof.
+intros n.
+destruct (Zeven_ex (2 * n + 1)) as (p, Hp).
+revert Hp.
+case (Zeven (2 * n + 1)) ; try easy.
+intros H.
+apply False_ind.
+omega.
+Qed.
+
+Theorem Zeven_plus :
+  forall x y, Zeven (x + y) = Bool.eqb (Zeven x) (Zeven y).
+Proof.
+intros x y.
+destruct (Zeven_ex x) as (px, Hx).
+rewrite Hx at 1.
+destruct (Zeven_ex y) as (py, Hy).
+rewrite Hy at 1.
+replace (2 * px + (if Zeven x then 0 else 1) + (2 * py + (if Zeven y then 0 else 1)))%Z
+  with (2 * (px + py) + ((if Zeven x then 0 else 1) + (if Zeven y then 0 else 1)))%Z by ring.
+case (Zeven x) ; case (Zeven y).
+rewrite Zplus_0_r.
+now rewrite Zeven_mult.
+apply Zeven_2xp1.
+apply Zeven_2xp1.
+replace (2 * (px + py) + (1 + 1))%Z with (2 * (px + py + 1))%Z by ring.
+now rewrite Zeven_mult.
+Qed.
+
+End Even_Odd.
+
+Section Zpower.
+
+Theorem Zpower_plus :
+  forall n k1 k2, (0 <= k1)%Z -> (0 <= k2)%Z ->
+  Zpower n (k1 + k2) = (Zpower n k1 * Zpower n k2)%Z.
+Proof.
+intros n k1 k2 H1 H2.
+now apply Zpower_exp ; apply Zle_ge.
+Qed.
+
+Theorem Zpower_Zpower_nat :
+  forall b e, (0 <= e)%Z ->
+  Zpower b e = Zpower_nat b (Zabs_nat e).
+Proof.
+intros b [|e|e] He.
+apply refl_equal.
+apply Zpower_pos_nat.
+elim He.
+apply refl_equal.
+Qed.
+
+Theorem Zpower_nat_S :
+  forall b e,
+  Zpower_nat b (S e) = (b * Zpower_nat b e)%Z.
+Proof.
+intros b e.
+rewrite (Zpower_nat_is_exp 1 e).
+apply (f_equal (fun x => x * _)%Z).
+apply Zmult_1_r.
+Qed.
+
+Theorem Zpower_pos_gt_0 :
+  forall b p, (0 < b)%Z ->
+  (0 < Zpower_pos b p)%Z.
+Proof.
+intros b p Hb.
+rewrite Zpower_pos_nat.
+induction (nat_of_P p).
+easy.
+rewrite Zpower_nat_S.
+now apply Zmult_lt_0_compat.
+Qed.
+
+Theorem Zeven_Zpower :
+  forall b e, (0 < e)%Z ->
+  Zeven (Zpower b e) = Zeven b.
+Proof.
+intros b e He.
+case_eq (Zeven b) ; intros Hb.
+(* b even *)
+replace e with (e - 1 + 1)%Z by ring.
+rewrite Zpower_exp.
+rewrite Zeven_mult.
+replace (Zeven (b ^ 1)) with true.
+apply Bool.orb_true_r.
+unfold Zpower, Zpower_pos. simpl.
+now rewrite Zmult_1_r.
+omega.
+discriminate.
+(* b odd *)
+rewrite Zpower_Zpower_nat.
+induction (Zabs_nat e).
+easy.
+unfold Zpower_nat. simpl.
+rewrite Zeven_mult.
+now rewrite Hb.
+now apply Zlt_le_weak.
+Qed.
+
+Theorem Zeven_Zpower_odd :
+  forall b e, (0 <= e)%Z -> Zeven b = false ->
+  Zeven (Zpower b e) = false.
+Proof.
+intros b e He Hb.
+destruct (Z_le_lt_eq_dec _ _ He) as [He'|He'].
+rewrite <- Hb.
+now apply Zeven_Zpower.
+now rewrite <- He'.
+Qed.
+
+(** The radix must be greater than 1 *)
+Record radix := { radix_val :> Z ; radix_prop : Zle_bool 2 radix_val = true }.
+
+Theorem radix_val_inj :
+  forall r1 r2, radix_val r1 = radix_val r2 -> r1 = r2.
+Proof.
+intros (r1, H1) (r2, H2) H.
+simpl in H.
+revert H1.
+rewrite H.
+intros H1.
+apply f_equal.
+apply eqbool_irrelevance.
+Qed.
+
+Variable r : radix.
+
+Theorem radix_gt_0 : (0 < r)%Z.
+Proof.
+apply Zlt_le_trans with 2%Z.
+easy.
+apply Zle_bool_imp_le.
+apply r.
+Qed.
+
+Theorem radix_gt_1 : (1 < r)%Z.
+Proof.
+destruct r as (v, Hr). simpl.
+apply Zlt_le_trans with 2%Z.
+easy.
+now apply Zle_bool_imp_le.
+Qed.
+
+Theorem Zpower_gt_1 :
+  forall p,
+  (0 < p)%Z ->
+  (1 < Zpower r p)%Z.
+Proof.
+intros [|p|p] Hp ; try easy.
+simpl.
+rewrite Zpower_pos_nat.
+generalize (lt_O_nat_of_P p).
+induction (nat_of_P p).
+easy.
+intros _.
+rewrite Zpower_nat_S.
+assert (0 < Zpower_nat r n)%Z.
+clear.
+induction n.
+easy.
+rewrite Zpower_nat_S.
+apply Zmult_lt_0_compat with (2 := IHn).
+apply radix_gt_0.
+apply Zle_lt_trans with (1 * Zpower_nat r n)%Z.
+rewrite Zmult_1_l.
+now apply (Zlt_le_succ 0).
+apply Zmult_lt_compat_r with (1 := H).
+apply radix_gt_1.
+Qed.
+
+Theorem Zpower_gt_0 :
+  forall p,
+  (0 <= p)%Z ->
+  (0 < Zpower r p)%Z.
+Proof.
+intros p Hp.
+rewrite Zpower_Zpower_nat with (1 := Hp).
+induction (Zabs_nat p).
+easy.
+rewrite Zpower_nat_S.
+apply Zmult_lt_0_compat with (2 := IHn).
+apply radix_gt_0.
+Qed.
+
+Theorem Zpower_ge_0 :
+  forall e,
+  (0 <= Zpower r e)%Z.
+Proof.
+intros [|e|e] ; try easy.
+apply Zlt_le_weak.
+now apply Zpower_gt_0.
+Qed.
+
+Theorem Zpower_le :
+  forall e1 e2, (e1 <= e2)%Z ->
+  (Zpower r e1 <= Zpower r e2)%Z.
+Proof.
+intros e1 e2 He.
+destruct (Zle_or_lt 0 e1)%Z as [H1|H1].
+replace e2 with (e2 - e1 + e1)%Z by ring.
+rewrite Zpower_plus with (2 := H1).
+rewrite <- (Zmult_1_l (r ^ e1)) at 1.
+apply Zmult_le_compat_r.
+apply (Zlt_le_succ 0).
+apply Zpower_gt_0.
+now apply Zle_minus_le_0.
+apply Zpower_ge_0.
+now apply Zle_minus_le_0.
+clear He.
+destruct e1 as [|e1|e1] ; try easy.
+apply Zpower_ge_0.
+Qed.
+
+Theorem Zpower_lt :
+  forall e1 e2, (0 <= e2)%Z -> (e1 < e2)%Z ->
+  (Zpower r e1 < Zpower r e2)%Z.
+Proof.
+intros e1 e2 He2 He.
+destruct (Zle_or_lt 0 e1)%Z as [H1|H1].
+replace e2 with (e2 - e1 + e1)%Z by ring.
+rewrite Zpower_plus with (2 := H1).
+rewrite Zmult_comm.
+rewrite <- (Zmult_1_r (r ^ e1)) at 1.
+apply Zmult_lt_compat2.
+split.
+now apply Zpower_gt_0.
+apply Zle_refl.
+split.
+easy.
+apply Zpower_gt_1.
+clear -He ; omega.
+apply Zle_minus_le_0.
+now apply Zlt_le_weak.
+revert H1.
+clear -He2.
+destruct e1 ; try easy.
+intros _.
+now apply Zpower_gt_0.
+Qed.
+
+Theorem Zpower_lt_Zpower :
+  forall e1 e2,
+  (Zpower r (e1 - 1) < Zpower r e2)%Z ->
+  (e1 <= e2)%Z.
+Proof.
+intros e1 e2 He.
+apply Znot_gt_le.
+intros H.
+apply Zlt_not_le with (1 := He).
+apply Zpower_le.
+clear -H ; omega.
+Qed.
+
+End Zpower.
+
+Section Div_Mod.
+
+Theorem Zmod_mod_mult :
+  forall n a b, (0 < a)%Z -> (0 <= b)%Z ->
+  Zmod (Zmod n (a * b)) b = Zmod n b.
+Proof.
+intros n a [|b|b] Ha Hb.
+now rewrite 2!Zmod_0_r.
+rewrite (Zmod_eq n (a * Zpos b)).
+rewrite Zmult_assoc.
+unfold Zminus.
+rewrite Zopp_mult_distr_l.
+apply Z_mod_plus.
+easy.
+apply Zmult_gt_0_compat.
+now apply Zlt_gt.
+easy.
+now elim Hb.
+Qed.
+
+Theorem ZOmod_eq :
+  forall a b,
+  ZOmod a b = (a - ZOdiv a b * b)%Z.
+Proof.
+intros a b.
+rewrite (ZO_div_mod_eq a b) at 2.
+ring.
+Qed.
+
+Theorem ZOmod_mod_mult :
+  forall n a b,
+  ZOmod (ZOmod n (a * b)) b = ZOmod n b.
+Proof.
+intros n a b.
+assert (ZOmod n (a * b) = n + - (ZOdiv n (a * b) * a) * b)%Z.
+rewrite <- Zopp_mult_distr_l.
+rewrite <- Zmult_assoc.
+apply ZOmod_eq.
+rewrite H.
+apply ZO_mod_plus.
+rewrite <- H.
+apply ZOmod_sgn2.
+Qed.
+
+Theorem Zdiv_mod_mult :
+  forall n a b, (0 <= a)%Z -> (0 <= b)%Z ->
+  (Zdiv (Zmod n (a * b)) a) = Zmod (Zdiv n a) b.
+Proof.
+intros n a b Ha Hb.
+destruct (Zle_lt_or_eq _ _ Ha) as [Ha'|Ha'].
+destruct (Zle_lt_or_eq _ _ Hb) as [Hb'|Hb'].
+rewrite (Zmod_eq n (a * b)).
+rewrite (Zmult_comm a b) at 2.
+rewrite Zmult_assoc.
+unfold Zminus.
+rewrite Zopp_mult_distr_l.
+rewrite Z_div_plus by now apply Zlt_gt.
+rewrite <- Zdiv_Zdiv by easy.
+apply sym_eq.
+apply Zmod_eq.
+now apply Zlt_gt.
+now apply Zmult_gt_0_compat ; apply Zlt_gt.
+rewrite <- Hb'.
+rewrite Zmult_0_r, 2!Zmod_0_r.
+apply Zdiv_0_l.
+rewrite <- Ha'.
+now rewrite 2!Zdiv_0_r, Zmod_0_l.
+Qed.
+
+Theorem ZOdiv_mod_mult :
+  forall n a b,
+  (ZOdiv (ZOmod n (a * b)) a) = ZOmod (ZOdiv n a) b.
+Proof.
+intros n a b.
+destruct (Z_eq_dec a 0) as [Za|Za].
+rewrite Za.
+now rewrite 2!ZOdiv_0_r, ZOmod_0_l.
+assert (ZOmod n (a * b) = n + - (ZOdiv (ZOdiv n a) b * b) * a)%Z.
+rewrite (ZOmod_eq n (a * b)) at 1.
+rewrite ZOdiv_ZOdiv.
+ring.
+rewrite H.
+rewrite ZO_div_plus with (2 := Za).
+apply sym_eq.
+apply ZOmod_eq.
+rewrite <- H.
+apply ZOmod_sgn2.
+Qed.
+
+Theorem ZOdiv_small_abs :
+  forall a b,
+  (Zabs a < b)%Z -> ZOdiv a b = Z0.
+Proof.
+intros a b Ha.
+destruct (Zle_or_lt 0 a) as [H|H].
+apply ZOdiv_small.
+split.
+exact H.
+now rewrite Zabs_eq in Ha.
+apply Zopp_inj.
+rewrite <- ZOdiv_opp_l, Zopp_0.
+apply ZOdiv_small.
+generalize (Zabs_non_eq a).
+omega.
+Qed.
+
+Theorem ZOmod_small_abs :
+  forall a b,
+  (Zabs a < b)%Z -> ZOmod a b = a.
+Proof.
+intros a b Ha.
+destruct (Zle_or_lt 0 a) as [H|H].
+apply ZOmod_small.
+split.
+exact H.
+now rewrite Zabs_eq in Ha.
+apply Zopp_inj.
+rewrite <- ZOmod_opp_l.
+apply ZOmod_small.
+generalize (Zabs_non_eq a).
+omega.
+Qed.
+
+Theorem ZOdiv_plus :
+  forall a b c, (0 <= a * b)%Z ->
+  (ZOdiv (a + b) c = ZOdiv a c + ZOdiv b c + ZOdiv (ZOmod a c + ZOmod b c) c)%Z.
+Proof.
+intros a b c Hab.
+destruct (Z_eq_dec c 0) as [Zc|Zc].
+now rewrite Zc, 4!ZOdiv_0_r.
+apply Zmult_reg_r with (1 := Zc).
+rewrite 2!Zmult_plus_distr_l.
+assert (forall d, ZOdiv d c * c = d - ZOmod d c)%Z.
+intros d.
+rewrite ZOmod_eq.
+ring.
+rewrite 4!H.
+rewrite <- ZOplus_mod with (1 := Hab).
+ring.
+Qed.
+
+End Div_Mod.
+
+Section Same_sign.
+
+Theorem Zsame_sign_trans :
+  forall v u w, v <> Z0 ->
+  (0 <= u * v)%Z -> (0 <= v * w)%Z -> (0 <= u * w)%Z.
+Proof.
+intros [|v|v] [|u|u] [|w|w] Zv Huv Hvw ; try easy ; now elim Zv.
+Qed.
+
+Theorem Zsame_sign_trans_weak :
+  forall v u w, (v = Z0 -> w = Z0) ->
+  (0 <= u * v)%Z -> (0 <= v * w)%Z -> (0 <= u * w)%Z.
+Proof.
+intros [|v|v] [|u|u] [|w|w] Zv Huv Hvw ; try easy ; now discriminate Zv.
+Qed.
+
+Theorem Zsame_sign_imp :
+  forall u v,
+  (0 < u -> 0 <= v)%Z ->
+  (0 < -u -> 0 <= -v)%Z ->
+  (0 <= u * v)%Z.
+Proof.
+intros [|u|u] v Hp Hn.
+easy.
+apply Zmult_le_0_compat.
+easy.
+now apply Hp.
+replace (Zneg u * v)%Z with (Zpos u * (-v))%Z.
+apply Zmult_le_0_compat.
+easy.
+now apply Hn.
+rewrite <- Zopp_mult_distr_r.
+apply Zopp_mult_distr_l.
+Qed.
+
+Theorem Zsame_sign_odiv :
+  forall u v, (0 <= v)%Z ->
+  (0 <= u * ZOdiv u v)%Z.
+Proof.
+intros u v Hv.
+apply Zsame_sign_imp ; intros Hu.
+apply ZO_div_pos with (2 := Hv).
+now apply Zlt_le_weak.
+rewrite <- ZOdiv_opp_l.
+apply ZO_div_pos with (2 := Hv).
+now apply Zlt_le_weak.
+Qed.
+
+End Same_sign.
+
+(** Boolean comparisons *)
+
+Section Zeq_bool.
+
+Inductive Zeq_bool_prop (x y : Z) : bool -> Prop :=
+  | Zeq_bool_true_ : x = y -> Zeq_bool_prop x y true
+  | Zeq_bool_false_ : x <> y -> Zeq_bool_prop x y false.
+
+Theorem Zeq_bool_spec :
+  forall x y, Zeq_bool_prop x y (Zeq_bool x y).
+Proof.
+intros x y.
+generalize (Zeq_is_eq_bool x y).
+case (Zeq_bool x y) ; intros (H1, H2) ; constructor.
+now apply H2.
+intros H.
+specialize (H1 H).
+discriminate H1.
+Qed.
+
+Theorem Zeq_bool_true :
+  forall x y, x = y -> Zeq_bool x y = true.
+Proof.
+intros x y.
+apply -> Zeq_is_eq_bool.
+Qed.
+
+Theorem Zeq_bool_false :
+  forall x y, x <> y -> Zeq_bool x y = false.
+Proof.
+intros x y.
+generalize (proj2 (Zeq_is_eq_bool x y)).
+case Zeq_bool.
+intros He Hn.
+elim Hn.
+now apply He.
+now intros _ _.
+Qed.
+
+End Zeq_bool.
+
+Section Zle_bool.
+
+Inductive Zle_bool_prop (x y : Z) : bool -> Prop :=
+  | Zle_bool_true_ : (x <= y)%Z -> Zle_bool_prop x y true
+  | Zle_bool_false_ : (y < x)%Z -> Zle_bool_prop x y false.
+
+Theorem Zle_bool_spec :
+  forall x y, Zle_bool_prop x y (Zle_bool x y).
+Proof.
+intros x y.
+generalize (Zle_is_le_bool x y).
+case Zle_bool ; intros (H1, H2) ; constructor.
+now apply H2.
+destruct (Zle_or_lt x y) as [H|H].
+now specialize (H1 H).
+exact H.
+Qed.
+
+Theorem Zle_bool_true :
+  forall x y : Z,
+  (x <= y)%Z -> Zle_bool x y = true.
+Proof.
+intros x y.
+apply (proj1 (Zle_is_le_bool x y)).
+Qed.
+
+Theorem Zle_bool_false :
+  forall x y : Z,
+  (y < x)%Z -> Zle_bool x y = false.
+Proof.
+intros x y Hxy.
+generalize (Zle_cases x y).
+case Zle_bool ; intros H.
+elim (Zlt_irrefl x).
+now apply Zle_lt_trans with y.
+apply refl_equal.
+Qed.
+
+End Zle_bool.
+
+Section Zlt_bool.
+
+Inductive Zlt_bool_prop (x y : Z) : bool -> Prop :=
+  | Zlt_bool_true_ : (x < y)%Z -> Zlt_bool_prop x y true
+  | Zlt_bool_false_ : (y <= x)%Z -> Zlt_bool_prop x y false.
+
+Theorem Zlt_bool_spec :
+  forall x y, Zlt_bool_prop x y (Zlt_bool x y).
+Proof.
+intros x y.
+generalize (Zlt_is_lt_bool x y).
+case Zlt_bool ; intros (H1, H2) ; constructor.
+now apply H2.
+destruct (Zle_or_lt y x) as [H|H].
+exact H.
+now specialize (H1 H).
+Qed.
+
+Theorem Zlt_bool_true :
+  forall x y : Z,
+  (x < y)%Z -> Zlt_bool x y = true.
+Proof.
+intros x y.
+apply (proj1 (Zlt_is_lt_bool x y)).
+Qed.
+
+Theorem Zlt_bool_false :
+  forall x y : Z,
+  (y <= x)%Z -> Zlt_bool x y = false.
+Proof.
+intros x y Hxy.
+generalize (Zlt_cases x y).
+case Zlt_bool ; intros H.
+elim (Zlt_irrefl x).
+now apply Zlt_le_trans with y.
+apply refl_equal.
+Qed.
+
+Theorem negb_Zle_bool :
+  forall x y : Z,
+  negb (Zle_bool x y) = Zlt_bool y x.
+Proof.
+intros x y.
+case Zle_bool_spec ; intros H.
+now rewrite Zlt_bool_false.
+now rewrite Zlt_bool_true.
+Qed.
+
+Theorem negb_Zlt_bool :
+  forall x y : Z,
+  negb (Zlt_bool x y) = Zle_bool y x.
+Proof.
+intros x y.
+case Zlt_bool_spec ; intros H.
+now rewrite Zle_bool_false.
+now rewrite Zle_bool_true.
+Qed.
+
+End Zlt_bool.
+
+Section Zcompare.
+
+Inductive Zcompare_prop (x y : Z) : comparison -> Prop :=
+  | Zcompare_Lt_ : (x < y)%Z -> Zcompare_prop x y Lt
+  | Zcompare_Eq_ : x = y -> Zcompare_prop x y Eq
+  | Zcompare_Gt_ : (y < x)%Z -> Zcompare_prop x y Gt.
+
+Theorem Zcompare_spec :
+  forall x y, Zcompare_prop x y (Zcompare x y).
+Proof.
+intros x y.
+destruct (Z_dec x y) as [[H|H]|H].
+generalize (Zlt_compare _ _ H).
+case (Zcompare x y) ; try easy.
+now constructor.
+generalize (Zgt_compare _ _ H).
+case (Zcompare x y) ; try easy.
+constructor.
+now apply Zgt_lt.
+generalize (proj2 (Zcompare_Eq_iff_eq _ _) H).
+case (Zcompare x y) ; try easy.
+now constructor.
+Qed.
+
+Theorem Zcompare_Lt :
+  forall x y,
+  (x < y)%Z -> Zcompare x y = Lt.
+Proof.
+easy.
+Qed.
+
+Theorem Zcompare_Eq :
+  forall x y,
+  (x = y)%Z -> Zcompare x y = Eq.
+Proof.
+intros x y.
+apply <- Zcompare_Eq_iff_eq.
+Qed.
+
+Theorem Zcompare_Gt :
+  forall x y,
+  (y < x)%Z -> Zcompare x y = Gt.
+Proof.
+intros x y.
+apply Zlt_gt.
+Qed.
+
+End Zcompare.
+
+Section cond_Zopp.
+
+Definition cond_Zopp (b : bool) m := if b then Zopp m else m.
+
+Theorem abs_cond_Zopp :
+  forall b m,
+  Zabs (cond_Zopp b m) = Zabs m.
+Proof.
+intros [|] m.
+apply Zabs_Zopp.
+apply refl_equal.
+Qed.
+
+Theorem cond_Zopp_Zlt_bool :
+  forall m,
+  cond_Zopp (Zlt_bool m 0) m = Zabs m.
+Proof.
+intros m.
+apply sym_eq.
+case Zlt_bool_spec ; intros Hm.
+apply Zabs_non_eq.
+now apply Zlt_le_weak.
+now apply Zabs_eq.
+Qed.
+
+End cond_Zopp.
diff --git a/flocq/Core/Fcore_defs.v b/flocq/Core/Fcore_defs.v
new file mode 100644
index 0000000..fda3a85
--- /dev/null
+++ b/flocq/Core/Fcore_defs.v
@@ -0,0 +1,101 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Basic definitions: float and rounding property *)
+Require Import Fcore_Raux.
+
+Section Def.
+
+(** Definition of a floating-point number *)
+Record float (beta : radix) := Float { Fnum : Z ; Fexp : Z }.
+
+Implicit Arguments Fnum [[beta]].
+Implicit Arguments Fexp [[beta]].
+
+Variable beta : radix.
+
+Definition F2R (f : float beta) :=
+  (Z2R (Fnum f) * bpow beta (Fexp f))%R.
+
+(** Requirements on a rounding mode *)
+Definition round_pred_total (P : R -> R -> Prop) :=
+  forall x, exists f, P x f.
+
+Definition round_pred_monotone (P : R -> R -> Prop) :=
+  forall x y f g, P x f -> P y g -> (x <= y)%R -> (f <= g)%R.
+
+Definition round_pred (P : R -> R -> Prop) :=
+  round_pred_total P /\
+  round_pred_monotone P.
+
+End Def.
+
+Implicit Arguments Fnum [[beta]].
+Implicit Arguments Fexp [[beta]].
+Implicit Arguments F2R [[beta]].
+
+Section RND.
+
+(** property of being a round toward -inf *)
+Definition Rnd_DN_pt (F : R -> Prop) (x f : R) :=
+  F f /\ (f <= x)%R /\
+  forall g : R, F g -> (g <= x)%R -> (g <= f)%R.
+
+Definition Rnd_DN (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_DN_pt F x (rnd x).
+
+(** property of being a round toward +inf *)
+Definition Rnd_UP_pt (F : R -> Prop) (x f : R) :=
+  F f /\ (x <= f)%R /\
+  forall g : R, F g -> (x <= g)%R -> (f <= g)%R.
+
+Definition Rnd_UP (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_UP_pt F x (rnd x).
+
+(** property of being a round toward zero *)
+Definition Rnd_ZR_pt (F : R -> Prop) (x f : R) :=
+  ( (0 <= x)%R -> Rnd_DN_pt F x f ) /\
+  ( (x <= 0)%R -> Rnd_UP_pt F x f ).
+
+Definition Rnd_ZR (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_ZR_pt F x (rnd x).
+
+(** property of being a round to nearest *)
+Definition Rnd_N_pt (F : R -> Prop) (x f : R) :=
+  F f /\
+  forall g : R, F g -> (Rabs (f - x) <= Rabs (g - x))%R.
+
+Definition Rnd_N (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_N_pt F x (rnd x).
+
+Definition Rnd_NG_pt (F : R -> Prop) (P : R -> R -> Prop) (x f : R) :=
+  Rnd_N_pt F x f /\
+  ( P x f \/ forall f2 : R, Rnd_N_pt F x f2 -> f2 = f ).
+
+Definition Rnd_NG (F : R -> Prop) (P : R -> R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_NG_pt F P x (rnd x).
+
+Definition Rnd_NA_pt (F : R -> Prop) (x f : R) :=
+  Rnd_N_pt F x f /\
+  forall f2 : R, Rnd_N_pt F x f2 -> (Rabs f2 <= Rabs f)%R.
+
+Definition Rnd_NA (F : R -> Prop) (rnd : R -> R) :=
+  forall x : R, Rnd_NA_pt F x (rnd x).
+
+End RND.
diff --git a/flocq/Core/Fcore_digits.v b/flocq/Core/Fcore_digits.v
new file mode 100644
index 0000000..2ae076e
--- /dev/null
+++ b/flocq/Core/Fcore_digits.v
@@ -0,0 +1,899 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2011 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.
+*)
+
+Require Import ZArith.
+Require Import Fcore_Zaux.
+Require Import ZOdiv.
+
+(** Computes the number of bits (radix 2) of a positive integer.
+
+It serves as an upper bound on the number of digits to ensure termination.
+*)
+
+Fixpoint digits2_Pnat (n : positive) : nat :=
+  match n with
+  | xH => O
+  | xO p => S (digits2_Pnat p)
+  | xI p => S (digits2_Pnat p)
+  end.
+
+Theorem digits2_Pnat_correct :
+  forall n,
+  let d := digits2_Pnat n in
+  (Zpower_nat 2 d <= Zpos n < Zpower_nat 2 (S d))%Z.
+Proof.
+intros n d. unfold d. clear.
+assert (Hp: forall m, (Zpower_nat 2 (S m) = 2 * Zpower_nat 2 m)%Z) by easy.
+induction n ; simpl.
+rewrite Zpos_xI, 2!Hp.
+omega.
+rewrite (Zpos_xO n), 2!Hp.
+omega.
+now split.
+Qed.
+
+Section Fcore_digits.
+
+Variable beta : radix.
+
+Definition Zdigit n k := ZOmod (ZOdiv n (Zpower beta k)) beta.
+
+Theorem Zdigit_lt :
+  forall n k,
+  (k < 0)%Z ->
+  Zdigit n k = Z0.
+Proof.
+intros n [|k|k] Hk ; try easy.
+now case n.
+Qed.
+
+Theorem Zdigit_0 :
+  forall k, Zdigit 0 k = Z0.
+Proof.
+intros k.
+unfold Zdigit.
+rewrite ZOdiv_0_l.
+apply ZOmod_0_l.
+Qed.
+
+Theorem Zdigit_opp :
+  forall n k,
+  Zdigit (-n) k = Zopp (Zdigit n k).
+Proof.
+intros n k.
+unfold Zdigit.
+rewrite ZOdiv_opp_l.
+apply ZOmod_opp_l.
+Qed.
+
+Theorem Zdigit_ge_Zpower_pos :
+  forall e n,
+  (0 <= n < Zpower beta e)%Z ->
+  forall k, (e <= k)%Z -> Zdigit n k = Z0.
+Proof.
+intros e n Hn k Hk.
+unfold Zdigit.
+rewrite ZOdiv_small.
+apply ZOmod_0_l.
+split.
+apply Hn.
+apply Zlt_le_trans with (1 := proj2 Hn).
+replace k with (e + (k - e))%Z by ring.
+rewrite Zpower_plus.
+rewrite <- (Zmult_1_r (beta ^ e)) at 1.
+apply Zmult_le_compat_l.
+apply (Zlt_le_succ 0).
+apply Zpower_gt_0.
+now apply Zle_minus_le_0.
+apply Zlt_le_weak.
+now apply Zle_lt_trans with n.
+generalize (Zle_lt_trans _ _ _ (proj1 Hn) (proj2 Hn)).
+clear.
+now destruct e as [|e|e].
+now apply Zle_minus_le_0.
+Qed.
+
+Theorem Zdigit_ge_Zpower :
+  forall e n,
+  (Zabs n < Zpower beta e)%Z ->
+  forall k, (e <= k)%Z -> Zdigit n k = Z0.
+Proof.
+intros e [|n|n] Hn k.
+easy.
+apply Zdigit_ge_Zpower_pos.
+now split.
+intros He.
+change (Zneg n) with (Zopp (Zpos n)).
+rewrite Zdigit_opp.
+rewrite Zdigit_ge_Zpower_pos with (2 := He).
+apply Zopp_0.
+now split.
+Qed.
+
+Theorem Zdigit_not_0_pos :
+  forall e n, (0 <= e)%Z ->
+  (Zpower beta e <= n < Zpower beta (e + 1))%Z ->
+  Zdigit n e <> Z0.
+Proof.
+intros e n He (Hn1,Hn2).
+unfold Zdigit.
+rewrite <- ZOdiv_mod_mult.
+rewrite ZOmod_small.
+intros H.
+apply Zle_not_lt with (1 := Hn1).
+rewrite (ZO_div_mod_eq n (beta ^ e)).
+rewrite H, Zmult_0_r, Zplus_0_l.
+apply ZOmod_lt_pos_pos.
+apply Zle_trans with (2 := Hn1).
+apply Zpower_ge_0.
+now apply Zpower_gt_0.
+split.
+apply Zle_trans with (2 := Hn1).
+apply Zpower_ge_0.
+replace (beta ^ e * beta)%Z with (beta ^ (e + 1))%Z.
+exact Hn2.
+rewrite <- (Zmult_1_r beta) at 3.
+now apply (Zpower_plus beta e 1).
+Qed.
+
+Theorem Zdigit_not_0 :
+  forall e n, (0 <= e)%Z ->
+  (Zpower beta e <= Zabs n < Zpower beta (e + 1))%Z ->
+  Zdigit n e <> Z0.
+Proof.
+intros e n He Hn.
+destruct (Zle_or_lt 0 n) as [Hn'|Hn'].
+rewrite (Zabs_eq _ Hn') in Hn.
+now apply Zdigit_not_0_pos.
+intros H.
+rewrite (Zabs_non_eq n) in Hn by now apply Zlt_le_weak.
+apply (Zdigit_not_0_pos _ _ He Hn).
+now rewrite Zdigit_opp, H.
+Qed.
+
+Theorem Zdigit_mul_pow :
+  forall n k k', (0 <= k')%Z ->
+  Zdigit (n * Zpower beta k') k = Zdigit n (k - k').
+Proof.
+intros n k k' Hk'.
+destruct (Zle_or_lt k' k) as [H|H].
+revert k H.
+pattern k' ; apply Zlt_0_ind with (2 := Hk').
+clear k' Hk'.
+intros k' IHk' Hk' k H.
+unfold Zdigit.
+apply (f_equal (fun x => ZOmod x beta)).
+pattern k at 1 ; replace k with (k - k' + k')%Z by ring.
+rewrite Zpower_plus with (2 := Hk').
+apply ZOdiv_mult_cancel_r.
+apply Zgt_not_eq.
+now apply Zpower_gt_0.
+now apply Zle_minus_le_0.
+destruct (Zle_or_lt 0 k) as [H0|H0].
+rewrite (Zdigit_lt n) by omega.
+unfold Zdigit.
+replace k' with (k' - k + k)%Z by ring.
+rewrite Zpower_plus with (2 := H0).
+rewrite Zmult_assoc, ZO_div_mult.
+replace (k' - k)%Z with (k' - k - 1 + 1)%Z by ring.
+rewrite Zpower_exp by omega.
+rewrite Zmult_assoc.
+change (Zpower beta 1) with (beta * 1)%Z.
+rewrite Zmult_1_r.
+apply ZO_mod_mult.
+apply Zgt_not_eq.
+now apply Zpower_gt_0.
+apply Zle_minus_le_0.
+now apply Zlt_le_weak.
+rewrite Zdigit_lt with (1 := H0).
+apply sym_eq.
+apply Zdigit_lt.
+omega.
+Qed.
+
+Theorem Zdigit_div_pow :
+  forall n k k', (0 <= k)%Z -> (0 <= k')%Z ->
+  Zdigit (ZOdiv n (Zpower beta k')) k = Zdigit n (k + k').
+Proof.
+intros n k k' Hk Hk'.
+unfold Zdigit.
+rewrite ZOdiv_ZOdiv.
+rewrite Zplus_comm.
+now rewrite Zpower_plus.
+Qed.
+
+Theorem Zdigit_mod_pow :
+  forall n k k', (k < k')%Z ->
+  Zdigit (ZOmod n (Zpower beta k')) k = Zdigit n k.
+Proof.
+intros n k k' Hk.
+destruct (Zle_or_lt 0 k) as [H|H].
+unfold Zdigit.
+rewrite <- 2!ZOdiv_mod_mult.
+apply (f_equal (fun x => ZOdiv x (beta ^ k))).
+replace k' with (k + 1 + (k' - (k + 1)))%Z by ring.
+rewrite Zpower_exp by omega.
+rewrite Zmult_comm.
+rewrite Zpower_plus by easy.
+change (Zpower beta 1) with (beta * 1)%Z.
+rewrite Zmult_1_r.
+apply ZOmod_mod_mult.
+now rewrite 2!Zdigit_lt.
+Qed.
+
+Theorem Zdigit_mod_pow_out :
+  forall n k k', (0 <= k' <= k)%Z ->
+  Zdigit (ZOmod n (Zpower beta k')) k = Z0.
+Proof.
+intros n k k' Hk.
+unfold Zdigit.
+rewrite ZOdiv_small_abs.
+apply ZOmod_0_l.
+apply Zlt_le_trans with (Zpower beta k').
+rewrite <- (Zabs_eq (beta ^ k')) at 2 by apply Zpower_ge_0.
+apply ZOmod_lt.
+apply Zgt_not_eq.
+now apply Zpower_gt_0.
+now apply Zpower_le.
+Qed.
+
+Fixpoint Zsum_digit f k :=
+  match k with
+  | O => Z0
+  | S k => (Zsum_digit f k + f (Z_of_nat k) * Zpower beta (Z_of_nat k))%Z
+  end.
+
+Theorem Zsum_digit_digit :
+  forall n k,
+  Zsum_digit (Zdigit n) k = ZOmod n (Zpower beta (Z_of_nat k)).
+Proof.
+intros n.
+induction k.
+apply sym_eq.
+apply ZOmod_1_r.
+simpl Zsum_digit.
+rewrite IHk.
+unfold Zdigit.
+rewrite <- ZOdiv_mod_mult.
+rewrite <- (ZOmod_mod_mult n beta).
+rewrite Zmult_comm.
+replace (beta ^ Z_of_nat k * beta)%Z with (Zpower beta (Z_of_nat (S k))).
+rewrite Zplus_comm, Zmult_comm.
+apply sym_eq.
+apply ZO_div_mod_eq.
+rewrite inj_S.
+rewrite <- (Zmult_1_r beta) at 3.
+apply Zpower_plus.
+apply Zle_0_nat.
+easy.
+Qed.
+
+Theorem Zpower_gt_id :
+  forall n, (n < Zpower beta n)%Z.
+Proof.
+intros [|n|n] ; try easy.
+simpl.
+rewrite Zpower_pos_nat.
+rewrite Zpos_eq_Z_of_nat_o_nat_of_P.
+induction (nat_of_P n).
+easy.
+rewrite inj_S.
+change (Zpower_nat beta (S n0)) with (beta * Zpower_nat beta n0)%Z.
+unfold Zsucc.
+apply Zlt_le_trans with (beta * (Z_of_nat n0 + 1))%Z.
+clear.
+apply Zlt_0_minus_lt.
+replace (beta * (Z_of_nat n0 + 1) - (Z_of_nat n0 + 1))%Z with ((beta - 1) * (Z_of_nat n0 + 1))%Z by ring.
+apply Zmult_lt_0_compat.
+cut (2 <= beta)%Z. omega.
+apply Zle_bool_imp_le.
+apply beta.
+apply (Zle_lt_succ 0).
+apply Zle_0_nat.
+apply Zmult_le_compat_l.
+now apply Zlt_le_succ.
+apply Zle_trans with 2%Z.
+easy.
+apply Zle_bool_imp_le.
+apply beta.
+Qed.
+
+Theorem Zdigit_ext :
+  forall n1 n2,
+  (forall k, (0 <= k)%Z -> Zdigit n1 k = Zdigit n2 k) ->
+  n1 = n2.
+Proof.
+intros n1 n2 H.
+rewrite <- (ZOmod_small_abs n1 (Zpower beta (Zmax (Zabs n1) (Zabs n2)))).
+rewrite <- (ZOmod_small_abs n2 (Zpower beta (Zmax (Zabs n1) (Zabs n2)))) at 2.
+replace (Zmax (Zabs n1) (Zabs n2)) with (Z_of_nat (Zabs_nat (Zmax (Zabs n1) (Zabs n2)))).
+rewrite <- 2!Zsum_digit_digit.
+induction (Zabs_nat (Zmax (Zabs n1) (Zabs n2))).
+easy.
+simpl.
+rewrite H, IHn.
+apply refl_equal.
+apply Zle_0_nat.
+rewrite inj_Zabs_nat.
+apply Zabs_eq.
+apply Zle_trans with (Zabs n1).
+apply Zabs_pos.
+apply Zle_max_l.
+apply Zlt_le_trans with (Zpower beta (Zabs n2)).
+apply Zpower_gt_id.
+apply Zpower_le.
+apply Zle_max_r.
+apply Zlt_le_trans with (Zpower beta (Zabs n1)).
+apply Zpower_gt_id.
+apply Zpower_le.
+apply Zle_max_l.
+Qed.
+
+Theorem ZOmod_plus_pow_digit :
+  forall u v n, (0 <= u * v)%Z ->
+  (forall k, (0 <= k < n)%Z -> Zdigit u k = Z0 \/ Zdigit v k = Z0) ->
+  ZOmod (u + v) (Zpower beta n) = (ZOmod u (Zpower beta n) + ZOmod v (Zpower beta n))%Z.
+Proof.
+intros u v n Huv Hd.
+destruct (Zle_or_lt 0 n) as [Hn|Hn].
+rewrite ZOplus_mod with (1 := Huv).
+apply ZOmod_small_abs.
+generalize (Zle_refl n).
+pattern n at -2 ; rewrite <- Zabs_eq with (1 := Hn).
+rewrite <- (inj_Zabs_nat n).
+induction (Zabs_nat n) as [|p IHp].
+now rewrite 2!ZOmod_1_r.
+rewrite <- 2!Zsum_digit_digit.
+simpl Zsum_digit.
+rewrite inj_S.
+intros Hn'.
+replace (Zsum_digit (Zdigit u) p + Zdigit u (Z_of_nat p) * beta ^ Z_of_nat p +
+  (Zsum_digit (Zdigit v) p + Zdigit v (Z_of_nat p) * beta ^ Z_of_nat p))%Z with
+  (Zsum_digit (Zdigit u) p + Zsum_digit (Zdigit v) p +
+  (Zdigit u (Z_of_nat p) + Zdigit v (Z_of_nat p)) * beta ^ Z_of_nat p)%Z by ring.
+apply (Zle_lt_trans _ _ _ (Zabs_triangle _ _)).
+replace (beta ^ Zsucc (Z_of_nat p))%Z with (beta ^ Z_of_nat p + (beta - 1) * beta ^ Z_of_nat p)%Z.
+apply Zplus_lt_le_compat.
+rewrite 2!Zsum_digit_digit.
+apply IHp.
+now apply Zle_succ_le.
+rewrite Zabs_Zmult.
+rewrite (Zabs_eq (beta ^ Z_of_nat p)) by apply Zpower_ge_0.
+apply Zmult_le_compat_r. 2: apply Zpower_ge_0.
+apply Zlt_succ_le.
+assert (forall u v, Zabs (Zdigit u v) < Zsucc (beta -  1))%Z.
+clear ; intros n k.
+assert (0 < beta)%Z.
+apply Zlt_le_trans with 2%Z.
+apply refl_equal.
+apply Zle_bool_imp_le.
+apply beta.
+replace (Zsucc (beta - 1)) with (Zabs beta).
+apply ZOmod_lt.
+now apply Zgt_not_eq.
+rewrite Zabs_eq.
+apply Zsucc_pred.
+now apply Zlt_le_weak.
+assert (0 <= Z_of_nat p < n)%Z.
+split.
+apply Zle_0_nat.
+apply Zgt_lt.
+now apply Zle_succ_gt.
+destruct (Hd (Z_of_nat p) H0) as [K|K] ; rewrite K.
+apply H.
+rewrite Zplus_0_r.
+apply H.
+unfold Zsucc.
+ring_simplify.
+rewrite Zpower_plus.
+change (beta ^1)%Z with (beta * 1)%Z.
+now rewrite Zmult_1_r.
+apply Zle_0_nat.
+easy.
+destruct n as [|n|n] ; try easy.
+now rewrite 3!ZOmod_0_r.
+Qed.
+
+Theorem ZOdiv_plus_pow_digit :
+  forall u v n, (0 <= u * v)%Z ->
+  (forall k, (0 <= k < n)%Z -> Zdigit u k = Z0 \/ Zdigit v k = Z0) ->
+  ZOdiv (u + v) (Zpower beta n) = (ZOdiv u (Zpower beta n) + ZOdiv v (Zpower beta n))%Z.
+Proof.
+intros u v n Huv Hd.
+rewrite <- (Zplus_0_r (ZOdiv u (Zpower beta n) + ZOdiv v (Zpower beta n))).
+rewrite ZOdiv_plus with (1 := Huv).
+rewrite <- ZOmod_plus_pow_digit by assumption.
+apply f_equal.
+destruct (Zle_or_lt 0 n) as [Hn|Hn].
+apply ZOdiv_small_abs.
+rewrite <- Zabs_eq.
+apply ZOmod_lt.
+apply Zgt_not_eq.
+now apply Zpower_gt_0.
+apply Zpower_ge_0.
+clear -Hn.
+destruct n as [|n|n] ; try easy.
+apply ZOdiv_0_r.
+Qed.
+
+Theorem Zdigit_plus :
+  forall u v, (0 <= u * v)%Z ->
+  (forall k, (0 <= k)%Z -> Zdigit u k = Z0 \/ Zdigit v k = Z0) ->
+  forall k,
+  Zdigit (u + v) k = (Zdigit u k + Zdigit v k)%Z.
+Proof.
+intros u v Huv Hd k.
+destruct (Zle_or_lt 0 k) as [Hk|Hk].
+unfold Zdigit.
+rewrite ZOdiv_plus_pow_digit with (1 := Huv).
+rewrite <- (Zmult_1_r beta) at 3 5 7.
+change (beta * 1)%Z with (beta ^1)%Z.
+apply ZOmod_plus_pow_digit.
+apply Zsame_sign_trans_weak with v.
+intros Zv ; rewrite Zv.
+apply ZOdiv_0_l.
+rewrite Zmult_comm.
+apply Zsame_sign_trans_weak with u.
+intros Zu ; rewrite Zu.
+apply ZOdiv_0_l.
+now rewrite Zmult_comm.
+apply Zsame_sign_odiv.
+apply Zpower_ge_0.
+apply Zsame_sign_odiv.
+apply Zpower_ge_0.
+intros k' (Hk1,Hk2).
+rewrite 2!Zdigit_div_pow by assumption.
+apply Hd.
+now apply Zplus_le_0_compat.
+intros k' (Hk1,Hk2).
+now apply Hd.
+now rewrite 3!Zdigit_lt.
+Qed.
+
+Definition Zscale n k :=
+  if Zle_bool 0 k then (n * Zpower beta k)%Z else ZOdiv n (Zpower beta (-k)).
+
+Theorem Zdigit_scale :
+  forall n k k', (0 <= k')%Z ->
+  Zdigit (Zscale n k) k' = Zdigit n (k' - k).
+Proof.
+intros n k k' Hk'.
+unfold Zscale.
+case Zle_bool_spec ; intros Hk.
+now apply Zdigit_mul_pow.
+apply Zdigit_div_pow with (1 := Hk').
+omega.
+Qed.
+
+Theorem Zscale_0 :
+  forall k,
+  Zscale 0 k = Z0.
+Proof.
+intros k.
+unfold Zscale.
+case Zle_bool.
+apply Zmult_0_l.
+apply ZOdiv_0_l.
+Qed.
+
+Theorem Zsame_sign_scale :
+  forall n k,
+  (0 <= n * Zscale n k)%Z.
+Proof.
+intros n k.
+unfold Zscale.
+case Zle_bool_spec ; intros Hk.
+rewrite Zmult_assoc.
+apply Zmult_le_0_compat.
+apply Zsame_sign_imp ; apply Zlt_le_weak.
+apply Zpower_ge_0.
+apply Zsame_sign_odiv.
+apply Zpower_ge_0.
+Qed.
+
+Theorem Zscale_mul_pow :
+  forall n k k', (0 <= k)%Z ->
+  Zscale (n * Zpower beta k) k' = Zscale n (k + k').
+Proof.
+intros n k k' Hk.
+unfold Zscale.
+case Zle_bool_spec ; intros Hk'.
+rewrite Zle_bool_true.
+rewrite <- Zmult_assoc.
+apply f_equal.
+now rewrite Zpower_plus.
+now apply Zplus_le_0_compat.
+case Zle_bool_spec ; intros Hk''.
+pattern k at 1 ; replace k with (k + k' + -k')%Z by ring.
+assert (0 <= -k')%Z by omega.
+rewrite Zpower_plus by easy.
+rewrite Zmult_assoc, ZO_div_mult.
+apply refl_equal.
+apply Zgt_not_eq.
+now apply Zpower_gt_0.
+replace (-k')%Z with (-(k+k') + k)%Z by ring.
+rewrite Zpower_plus with (2 := Hk).
+apply ZOdiv_mult_cancel_r.
+apply Zgt_not_eq.
+now apply Zpower_gt_0.
+omega.
+Qed.
+
+Theorem Zscale_scale :
+  forall n k k', (0 <= k)%Z ->
+  Zscale (Zscale n k) k' = Zscale n (k + k').
+Proof.
+intros n k k' Hk.
+unfold Zscale at 2.
+rewrite Zle_bool_true with (1 := Hk).
+now apply Zscale_mul_pow.
+Qed.
+
+Definition Zslice n k1 k2 :=
+  if Zle_bool 0 k2 then ZOmod (Zscale n (-k1)) (Zpower beta k2) else Z0.
+
+Theorem Zdigit_slice :
+  forall n k1 k2 k, (0 <= k < k2)%Z ->
+  Zdigit (Zslice n k1 k2) k = Zdigit n (k1 + k).
+Proof.
+intros n k1 k2 k Hk.
+unfold Zslice.
+rewrite Zle_bool_true.
+rewrite Zdigit_mod_pow by apply Hk.
+rewrite Zdigit_scale by apply Hk.
+unfold Zminus.
+now rewrite Zopp_involutive, Zplus_comm.
+omega.
+Qed.
+
+Theorem Zdigit_slice_out :
+  forall n k1 k2 k, (k2 <= k)%Z ->
+  Zdigit (Zslice n k1 k2) k = Z0.
+Proof.
+intros n k1 k2 k Hk.
+unfold Zslice.
+case Zle_bool_spec ; intros Hk2.
+apply Zdigit_mod_pow_out.
+now split.
+apply Zdigit_0.
+Qed.
+
+Theorem Zslice_0 :
+  forall k k',
+  Zslice 0 k k' = Z0.
+Proof.
+intros k k'.
+unfold Zslice.
+case Zle_bool.
+rewrite Zscale_0.
+apply ZOmod_0_l.
+apply refl_equal.
+Qed.
+
+Theorem Zsame_sign_slice :
+  forall n k k',
+  (0 <= n * Zslice n k k')%Z.
+Proof.
+intros n k k'.
+unfold Zslice.
+case Zle_bool.
+apply Zsame_sign_trans_weak with (Zscale n (-k)).
+intros H ; rewrite H.
+apply ZOmod_0_l.
+apply Zsame_sign_scale.
+rewrite Zmult_comm.
+apply ZOmod_sgn2.
+now rewrite Zmult_0_r.
+Qed.
+
+Theorem Zslice_slice :
+  forall n k1 k2 k1' k2', (0 <= k1' <= k2)%Z ->
+  Zslice (Zslice n k1 k2) k1' k2' = Zslice n (k1 + k1') (Zmin (k2 - k1') k2').
+Proof.
+intros n k1 k2 k1' k2' Hk1'.
+destruct (Zle_or_lt 0 k2') as [Hk2'|Hk2'].
+apply Zdigit_ext.
+intros k Hk.
+destruct (Zle_or_lt (Zmin (k2 - k1') k2') k) as [Hk'|Hk'].
+rewrite (Zdigit_slice_out n (k1 + k1')) with (1 := Hk').
+destruct (Zle_or_lt k2' k) as [Hk''|Hk''].
+now apply Zdigit_slice_out.
+rewrite Zdigit_slice by now split.
+apply Zdigit_slice_out.
+zify ; omega.
+rewrite Zdigit_slice by (zify ; omega).
+rewrite (Zdigit_slice n (k1 + k1')) by now split.
+rewrite Zdigit_slice.
+now rewrite Zplus_assoc.
+zify ; omega.
+unfold Zslice.
+rewrite Zmin_r.
+now rewrite Zle_bool_false.
+omega.
+Qed.
+
+Theorem Zslice_mul_pow :
+  forall n k k1 k2, (0 <= k)%Z ->
+  Zslice (n * Zpower beta k) k1 k2 = Zslice n (k1 - k) k2.
+Proof.
+intros n k k1 k2 Hk.
+unfold Zslice.
+case Zle_bool_spec ; intros Hk2.
+2: apply refl_equal.
+rewrite Zscale_mul_pow with (1 := Hk).
+now replace (- (k1 - k))%Z with (k + -k1)%Z by ring.
+Qed.
+
+Theorem Zslice_div_pow :
+  forall n k k1 k2, (0 <= k)%Z -> (0 <= k1)%Z ->
+  Zslice (ZOdiv n (Zpower beta k)) k1 k2 = Zslice n (k1 + k) k2.
+Proof.
+intros n k k1 k2 Hk Hk1.
+unfold Zslice.
+case Zle_bool_spec ; intros Hk2.
+2: apply refl_equal.
+apply (f_equal (fun x => ZOmod x (beta ^ k2))).
+unfold Zscale.
+case Zle_bool_spec ; intros Hk1'.
+replace k1 with Z0 by omega.
+case Zle_bool_spec ; intros Hk'.
+replace k with Z0 by omega.
+simpl.
+now rewrite ZOdiv_1_r.
+rewrite Zopp_involutive.
+apply Zmult_1_r.
+rewrite Zle_bool_false by omega.
+rewrite 2!Zopp_involutive, Zplus_comm.
+rewrite Zpower_plus by assumption.
+apply ZOdiv_ZOdiv.
+Qed.
+
+Theorem Zslice_scale :
+  forall n k k1 k2, (0 <= k1)%Z ->
+  Zslice (Zscale n k) k1 k2 = Zslice n (k1 - k) k2.
+Proof.
+intros n k k1 k2 Hk1.
+unfold Zscale.
+case Zle_bool_spec; intros Hk.
+now apply Zslice_mul_pow.
+apply Zslice_div_pow with (2 := Hk1).
+omega.
+Qed.
+
+Theorem Zslice_div_pow_scale :
+  forall n k k1 k2, (0 <= k)%Z ->
+  Zslice (ZOdiv n (Zpower beta k)) k1 k2 = Zscale (Zslice n k (k1 + k2)) (-k1).
+Proof.
+intros n k k1 k2 Hk.
+apply Zdigit_ext.
+intros k' Hk'.
+rewrite Zdigit_scale with (1 := Hk').
+unfold Zminus.
+rewrite (Zplus_comm k'), Zopp_involutive.
+destruct (Zle_or_lt k2 k') as [Hk2|Hk2].
+rewrite Zdigit_slice_out with (1 := Hk2).
+apply sym_eq.
+apply Zdigit_slice_out.
+now apply Zplus_le_compat_l.
+rewrite Zdigit_slice by now split.
+destruct (Zle_or_lt 0 (k1 + k')) as [Hk1'|Hk1'].
+rewrite Zdigit_slice by omega.
+rewrite Zdigit_div_pow by assumption.
+apply f_equal.
+ring.
+now rewrite 2!Zdigit_lt.
+Qed.
+
+Theorem Zplus_slice :
+  forall n k l1 l2, (0 <= l1)%Z -> (0 <= l2)%Z ->
+  (Zslice n k l1 + Zscale (Zslice n (k + l1) l2) l1)%Z = Zslice n k (l1 + l2).
+Proof.
+intros n k1 l1 l2 Hl1 Hl2.
+clear Hl1.
+apply Zdigit_ext.
+intros k Hk.
+rewrite Zdigit_plus.
+rewrite Zdigit_scale with (1 := Hk).
+destruct (Zle_or_lt (l1 + l2) k) as [Hk2|Hk2].
+rewrite Zdigit_slice_out with (1 := Hk2).
+now rewrite 2!Zdigit_slice_out by omega.
+rewrite Zdigit_slice with (1 := conj Hk Hk2).
+destruct (Zle_or_lt l1 k) as [Hk1|Hk1].
+rewrite Zdigit_slice_out with (1 := Hk1).
+rewrite Zdigit_slice by omega.
+simpl ; apply f_equal.
+ring.
+rewrite Zdigit_slice with (1 := conj Hk Hk1).
+rewrite (Zdigit_lt _ (k - l1)) by omega.
+apply Zplus_0_r.
+rewrite Zmult_comm.
+apply Zsame_sign_trans_weak with n.
+intros H ; rewrite H.
+apply Zslice_0.
+rewrite Zmult_comm.
+apply Zsame_sign_trans_weak with (Zslice n (k1 + l1) l2).
+intros H ; rewrite H.
+apply Zscale_0.
+apply Zsame_sign_slice.
+apply Zsame_sign_scale.
+apply Zsame_sign_slice.
+clear k Hk ; intros k Hk.
+rewrite Zdigit_scale with (1 := Hk).
+destruct (Zle_or_lt l1 k) as [Hk1|Hk1].
+left.
+now apply Zdigit_slice_out.
+right.
+apply Zdigit_lt.
+omega.
+Qed.
+
+Section digits_aux.
+
+Variable p : Z.
+Hypothesis Hp : (0 <= p)%Z.
+
+Fixpoint Zdigits_aux (nb pow : Z) (n : nat) { struct n } : Z :=
+  match n with
+  | O => nb
+  | S n => if Zlt_bool p pow then nb else Zdigits_aux (nb + 1) (Zmult beta pow) n
+  end.
+
+End digits_aux.
+(** Number of digits of an integer *)
+Definition Zdigits n :=
+  match n with
+  | Z0 => Z0
+  | Zneg p => Zdigits_aux (Zpos p) 1 beta (digits2_Pnat p)
+  | Zpos p => Zdigits_aux n 1 beta (digits2_Pnat p)
+  end.
+
+Theorem Zdigits_correct :
+  forall n,
+  (Zpower beta (Zdigits n - 1) <= Zabs n < Zpower beta (Zdigits n))%Z.
+Proof.
+cut (forall p, Zpower beta (Zdigits (Zpos p) - 1) <= Zpos p < Zpower beta (Zdigits (Zpos p)))%Z.
+intros H [|n|n] ; try exact (H n).
+now split.
+intros n.
+simpl.
+(* *)
+assert (U: (Zpos n < Zpower beta (Z_of_nat (S (digits2_Pnat n))))%Z).
+apply Zlt_le_trans with (1 := proj2 (digits2_Pnat_correct n)).
+rewrite Zpower_Zpower_nat.
+rewrite Zabs_nat_Z_of_nat.
+induction (S (digits2_Pnat n)).
+easy.
+rewrite 2!(Zpower_nat_S).
+apply Zmult_le_compat with (2 := IHn0).
+apply Zle_bool_imp_le.
+apply beta.
+easy.
+rewrite <- (Zabs_nat_Z_of_nat n0).
+rewrite <- Zpower_Zpower_nat.
+apply (Zpower_ge_0 (Build_radix 2 (refl_equal true))).
+apply Zle_0_nat.
+apply Zle_0_nat.
+(* *)
+revert U.
+rewrite inj_S.
+unfold Zsucc.
+generalize (digits2_Pnat n).
+intros u U.
+pattern (radix_val beta) at 2 4 ; replace (radix_val beta) with (Zpower beta 1) by apply Zmult_1_r.
+assert (V: (Zpower beta (1 - 1) <= Zpos n)%Z).
+now apply (Zlt_le_succ 0).
+generalize (conj V U).
+clear.
+generalize (Zle_refl 1).
+generalize 1%Z at 2 3 5 6 7 9 10.
+(* *)
+induction u.
+easy.
+rewrite inj_S; unfold Zsucc.
+simpl Zdigits_aux.
+intros v Hv U.
+case Zlt_bool_spec ; intros K.
+now split.
+pattern (radix_val beta) at 2 5 ; replace (radix_val beta) with (Zpower beta 1) by apply Zmult_1_r.
+rewrite <- Zpower_plus.
+rewrite Zplus_comm.
+apply IHu.
+clear -Hv ; omega.
+split.
+now ring_simplify (1 + v - 1)%Z.
+now rewrite Zplus_assoc.
+easy.
+apply Zle_succ_le with (1 := Hv).
+Qed.
+
+Theorem Zdigits_abs :
+  forall n, Zdigits (Zabs n) = Zdigits n.
+Proof.
+now intros [|n|n].
+Qed.
+
+Theorem Zdigits_gt_0 :
+  forall n, n <> Z0 -> (0 < Zdigits n)%Z.
+Proof.
+intros n Zn.
+rewrite <- (Zdigits_abs n).
+assert (Hn: (0 < Zabs n)%Z).
+destruct n ; try easy.
+now elim Zn.
+destruct (Zabs n) as [|p|p] ; try easy ; clear.
+simpl.
+generalize 1%Z (radix_val beta) (refl_equal Lt : (0 < 1)%Z).
+induction (digits2_Pnat p).
+easy.
+simpl.
+intros.
+case Zlt_bool.
+exact H.
+apply IHn.
+now apply Zlt_lt_succ.
+Qed.
+
+Theorem Zdigits_ge_0 :
+  forall n, (0 <= Zdigits n)%Z.
+Proof.
+intros n.
+destruct (Z_eq_dec n 0) as [H|H].
+now rewrite H.
+apply Zlt_le_weak.
+now apply Zdigits_gt_0.
+Qed.
+
+Theorem Zdigit_out :
+  forall n k, (Zdigits n <= k)%Z ->
+  Zdigit n k = Z0.
+Proof.
+intros n k Hk.
+apply Zdigit_ge_Zpower with (2 := Hk).
+apply Zdigits_correct.
+Qed.
+
+Theorem Zdigit_digits :
+  forall n, n <> Z0 ->
+  Zdigit n (Zdigits n - 1) <> Z0.
+Proof.
+intros n Zn.
+apply Zdigit_not_0.
+apply Zlt_0_le_0_pred.
+now apply Zdigits_gt_0.
+ring_simplify (Zdigits n - 1 + 1)%Z.
+apply Zdigits_correct.
+Qed.
+
+Theorem Zdigits_slice :
+  forall n k l, (0 <= l)%Z ->
+  (Zdigits (Zslice n k l) <= l)%Z.
+Proof.
+intros n k l Hl.
+unfold Zslice.
+rewrite Zle_bool_true with (1 := Hl).
+destruct (Zdigits_correct (ZOmod (Zscale n (- k)) (Zpower beta l))) as (H1,H2).
+apply Zpower_lt_Zpower with beta.
+apply Zle_lt_trans with (1 := H1).
+rewrite <- (Zabs_eq (beta ^ l)) at 2 by apply Zpower_ge_0.
+apply ZOmod_lt.
+apply Zgt_not_eq.
+now apply Zpower_gt_0.
+Qed.
+
+End Fcore_digits.
diff --git a/flocq/Core/Fcore_float_prop.v b/flocq/Core/Fcore_float_prop.v
new file mode 100644
index 0000000..746f7a6
--- /dev/null
+++ b/flocq/Core/Fcore_float_prop.v
@@ -0,0 +1,488 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Basic properties of floating-point formats: lemmas about mantissa, exponent... *)
+Require Import Fcore_Raux.
+Require Import Fcore_defs.
+
+Section Float_prop.
+
+Variable beta : radix.
+
+Notation bpow e := (bpow beta e).
+
+Theorem Rcompare_F2R :
+  forall e m1 m2 : Z,
+  Rcompare (F2R (Float beta m1 e)) (F2R (Float beta m2 e)) = Zcompare m1 m2.
+Proof.
+intros e m1 m2.
+unfold F2R. simpl.
+rewrite Rcompare_mult_r.
+apply Rcompare_Z2R.
+apply bpow_gt_0.
+Qed.
+
+(** Basic facts *)
+Theorem F2R_le_reg :
+  forall e m1 m2 : Z,
+  (F2R (Float beta m1 e) <= F2R (Float beta m2 e))%R ->
+  (m1 <= m2)%Z.
+Proof.
+intros e m1 m2 H.
+apply le_Z2R.
+apply Rmult_le_reg_r with (bpow e).
+apply bpow_gt_0.
+exact H.
+Qed.
+
+Theorem F2R_le_compat :
+  forall m1 m2 e : Z,
+  (m1 <= m2)%Z ->
+  (F2R (Float beta m1 e) <= F2R (Float beta m2 e))%R.
+Proof.
+intros m1 m2 e H.
+unfold F2R. simpl.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+now apply Z2R_le.
+Qed.
+
+Theorem F2R_lt_reg :
+  forall e m1 m2 : Z,
+  (F2R (Float beta m1 e) < F2R (Float beta m2 e))%R ->
+  (m1 < m2)%Z.
+Proof.
+intros e m1 m2 H.
+apply lt_Z2R.
+apply Rmult_lt_reg_r with (bpow e).
+apply bpow_gt_0.
+exact H.
+Qed.
+
+Theorem F2R_lt_compat :
+  forall e m1 m2 : Z,
+  (m1 < m2)%Z ->
+  (F2R (Float beta m1 e) < F2R (Float beta m2 e))%R.
+Proof.
+intros e m1 m2 H.
+unfold F2R. simpl.
+apply Rmult_lt_compat_r.
+apply bpow_gt_0.
+now apply Z2R_lt.
+Qed.
+
+Theorem F2R_eq_compat :
+  forall e m1 m2 : Z,
+  (m1 = m2)%Z ->
+  (F2R (Float beta m1 e) = F2R (Float beta m2 e))%R.
+Proof.
+intros e m1 m2 H.
+now apply (f_equal (fun m => F2R (Float beta m e))).
+Qed.
+
+Theorem F2R_eq_reg :
+  forall e m1 m2 : Z,
+  F2R (Float beta m1 e) = F2R (Float beta m2 e) ->
+  m1 = m2.
+Proof.
+intros e m1 m2 H.
+apply Zle_antisym ;
+  apply F2R_le_reg with e ;
+  rewrite H ;
+  apply Rle_refl.
+Qed.
+
+Theorem F2R_Zabs:
+  forall m e : Z,
+   F2R (Float beta (Zabs m) e) = Rabs (F2R (Float beta m e)).
+Proof.
+intros m e.
+unfold F2R.
+rewrite Rabs_mult.
+rewrite <- Z2R_abs.
+simpl.
+apply f_equal.
+apply sym_eq; apply Rabs_right.
+apply Rle_ge.
+apply bpow_ge_0.
+Qed.
+
+Theorem F2R_Zopp :
+  forall m e : Z,
+  F2R (Float beta (Zopp m) e) = Ropp (F2R (Float beta m e)).
+Proof.
+intros m e.
+unfold F2R. simpl.
+rewrite <- Ropp_mult_distr_l_reverse.
+now rewrite Z2R_opp.
+Qed.
+
+(** Sign facts *)
+Theorem F2R_0 :
+  forall e : Z,
+  F2R (Float beta 0 e) = R0.
+Proof.
+intros e.
+unfold F2R. simpl.
+apply Rmult_0_l.
+Qed.
+
+Theorem F2R_eq_0_reg :
+  forall m e : Z,
+  F2R (Float beta m e) = R0 ->
+  m = Z0.
+Proof.
+intros m e H.
+apply F2R_eq_reg with e.
+now rewrite F2R_0.
+Qed.
+
+Theorem F2R_ge_0_reg :
+  forall m e : Z,
+  (0 <= F2R (Float beta m e))%R ->
+  (0 <= m)%Z.
+Proof.
+intros m e H.
+apply F2R_le_reg with e.
+now rewrite F2R_0.
+Qed.
+
+Theorem F2R_le_0_reg :
+  forall m e : Z,
+  (F2R (Float beta m e) <= 0)%R ->
+  (m <= 0)%Z.
+Proof.
+intros m e H.
+apply F2R_le_reg with e.
+now rewrite F2R_0.
+Qed.
+
+Theorem F2R_gt_0_reg :
+  forall m e : Z,
+  (0 < F2R (Float beta m e))%R ->
+  (0 < m)%Z.
+Proof.
+intros m e H.
+apply F2R_lt_reg with e.
+now rewrite F2R_0.
+Qed.
+
+Theorem F2R_lt_0_reg :
+  forall m e : Z,
+  (F2R (Float beta m e) < 0)%R ->
+  (m < 0)%Z.
+Proof.
+intros m e H.
+apply F2R_lt_reg with e.
+now rewrite F2R_0.
+Qed.
+
+Theorem F2R_ge_0_compat :
+  forall f : float beta,
+  (0 <= Fnum f)%Z ->
+  (0 <= F2R f)%R.
+Proof.
+intros f H.
+rewrite <- F2R_0 with (Fexp f).
+now apply F2R_le_compat.
+Qed.
+
+Theorem F2R_le_0_compat :
+  forall f : float beta,
+  (Fnum f <= 0)%Z ->
+  (F2R f <= 0)%R.
+Proof.
+intros f H.
+rewrite <- F2R_0 with (Fexp f).
+now apply F2R_le_compat.
+Qed.
+
+Theorem F2R_gt_0_compat :
+  forall f : float beta,
+  (0 < Fnum f)%Z ->
+  (0 < F2R f)%R.
+Proof.
+intros f H.
+rewrite <- F2R_0 with (Fexp f).
+now apply F2R_lt_compat.
+Qed.
+
+Theorem F2R_lt_0_compat :
+  forall f : float beta,
+  (Fnum f < 0)%Z ->
+  (F2R f < 0)%R.
+Proof.
+intros f H.
+rewrite <- F2R_0 with (Fexp f).
+now apply F2R_lt_compat.
+Qed.
+
+(** Floats and bpow *)
+Theorem F2R_bpow :
+  forall e : Z,
+  F2R (Float beta 1 e) = bpow e.
+Proof.
+intros e.
+unfold F2R. simpl.
+apply Rmult_1_l.
+Qed.
+
+Theorem bpow_le_F2R :
+  forall m e : Z,
+  (0 < m)%Z ->
+  (bpow e <= F2R (Float beta m e))%R.
+Proof.
+intros m e H.
+rewrite <- F2R_bpow.
+apply F2R_le_compat.
+now apply (Zlt_le_succ 0).
+Qed.
+
+Theorem F2R_p1_le_bpow :
+  forall m e1 e2 : Z,
+  (0 < m)%Z ->
+  (F2R (Float beta m e1) < bpow e2)%R ->
+  (F2R (Float beta (m + 1) e1) <= bpow e2)%R.
+Proof.
+intros m e1 e2 Hm.
+intros H.
+assert (He : (e1 <= e2)%Z).
+(* . *)
+apply (le_bpow beta).
+apply Rle_trans with (F2R (Float beta m e1)).
+unfold F2R. simpl.
+rewrite <- (Rmult_1_l (bpow e1)) at 1.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply (Z2R_le 1).
+now apply (Zlt_le_succ 0).
+now apply Rlt_le.
+(* . *)
+revert H.
+replace e2 with (e2 - e1 + e1)%Z by ring.
+rewrite bpow_plus.
+unfold F2R. simpl.
+rewrite <- (Z2R_Zpower beta (e2 - e1)).
+intros H.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply Rmult_lt_reg_r in H.
+apply Z2R_le.
+apply Zlt_le_succ.
+now apply lt_Z2R.
+apply bpow_gt_0.
+now apply Zle_minus_le_0.
+Qed.
+
+Theorem bpow_le_F2R_m1 :
+  forall m e1 e2 : Z,
+  (1 < m)%Z ->
+  (bpow e2 < F2R (Float beta m e1))%R ->
+  (bpow e2 <= F2R (Float beta (m - 1) e1))%R.
+Proof.
+intros m e1 e2 Hm.
+case (Zle_or_lt e1 e2); intros He.
+replace e2 with (e2 - e1 + e1)%Z by ring.
+rewrite bpow_plus.
+unfold F2R. simpl.
+rewrite <- (Z2R_Zpower beta (e2 - e1)).
+intros H.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply Rmult_lt_reg_r in H.
+apply Z2R_le.
+rewrite (Zpred_succ (Zpower _ _)).
+apply Zplus_le_compat_r.
+apply Zlt_le_succ.
+now apply lt_Z2R.
+apply bpow_gt_0.
+now apply Zle_minus_le_0.
+intros H.
+apply Rle_trans with (1*bpow e1)%R.
+rewrite Rmult_1_l.
+apply bpow_le.
+now apply Zlt_le_weak.
+unfold F2R. simpl.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+replace 1%R with (Z2R 1) by reflexivity.
+apply Z2R_le.
+omega.
+Qed.
+
+Theorem F2R_lt_bpow :
+  forall f : float beta, forall e',
+  (Zabs (Fnum f) < Zpower beta (e' - Fexp f))%Z ->
+  (Rabs (F2R f) < bpow e')%R.
+Proof.
+intros (m, e) e' Hm.
+rewrite <- F2R_Zabs.
+destruct (Zle_or_lt e e') as [He|He].
+unfold F2R. simpl.
+apply Rmult_lt_reg_r with (bpow (-e)).
+apply bpow_gt_0.
+rewrite Rmult_assoc, <- 2!bpow_plus, Zplus_opp_r, Rmult_1_r.
+rewrite <-Z2R_Zpower. 2: now apply Zle_left.
+now apply Z2R_lt.
+elim Zlt_not_le with (1 := Hm).
+simpl.
+cut (e' - e < 0)%Z. 2: omega.
+clear.
+case (e' - e)%Z ; try easy.
+intros p _.
+apply Zabs_pos.
+Qed.
+
+Theorem F2R_change_exp :
+  forall e' m e : Z,
+  (e' <= e)%Z ->
+  F2R (Float beta m e) = F2R (Float beta (m * Zpower beta (e - e')) e').
+Proof.
+intros e' m e He.
+unfold F2R. simpl.
+rewrite Z2R_mult, Z2R_Zpower, Rmult_assoc.
+apply f_equal.
+pattern e at 1 ; replace e with (e - e' + e')%Z by ring.
+apply bpow_plus.
+now apply Zle_minus_le_0.
+Qed.
+
+Theorem F2R_prec_normalize :
+  forall m e e' p : Z,
+  (Zabs m < Zpower beta p)%Z ->
+  (bpow (e' - 1)%Z <= Rabs (F2R (Float beta m e)))%R ->
+  F2R (Float beta m e) = F2R (Float beta (m * Zpower beta (e - e' + p)) (e' - p)).
+Proof.
+intros m e e' p Hm Hf.
+assert (Hp: (0 <= p)%Z).
+destruct p ; try easy.
+now elim (Zle_not_lt _ _ (Zabs_pos m)).
+(* . *)
+replace (e - e' + p)%Z with (e - (e' - p))%Z by ring.
+apply F2R_change_exp.
+cut (e' - 1 < e + p)%Z. omega.
+apply (lt_bpow beta).
+apply Rle_lt_trans with (1 := Hf).
+rewrite <- F2R_Zabs, Zplus_comm, bpow_plus.
+apply Rmult_lt_compat_r.
+apply bpow_gt_0.
+rewrite <- Z2R_Zpower.
+now apply Z2R_lt.
+exact Hp.
+Qed.
+
+(** Floats and ln_beta *)
+Theorem ln_beta_F2R_bounds :
+  forall x m e, (0 < m)%Z ->
+  (F2R (Float beta m e) <= x < F2R (Float beta (m + 1) e))%R ->
+  ln_beta beta x = ln_beta beta (F2R (Float beta m e)) :> Z.
+Proof.
+intros x m e Hp (Hx,Hx2).
+destruct (ln_beta beta (F2R (Float beta m e))) as (ex, He).
+simpl.
+apply ln_beta_unique.
+assert (Hp1: (0 < F2R (Float beta m e))%R).
+now apply F2R_gt_0_compat.
+specialize (He (Rgt_not_eq _ _ Hp1)).
+rewrite Rabs_pos_eq in He. 2: now apply Rlt_le.
+destruct He as (He1, He2).
+assert (Hx1: (0 < x)%R).
+now apply Rlt_le_trans with (2 := Hx).
+rewrite Rabs_pos_eq. 2: now apply Rlt_le.
+split.
+now apply Rle_trans with (1 := He1).
+apply Rlt_le_trans with (1 := Hx2).
+now apply F2R_p1_le_bpow.
+Qed.
+
+Theorem ln_beta_F2R :
+  forall m e : Z,
+  m <> Z0 ->
+  (ln_beta beta (F2R (Float beta m e)) = ln_beta beta (Z2R m) + e :> Z)%Z.
+Proof.
+intros m e H.
+unfold F2R ; simpl.
+apply ln_beta_mult_bpow.
+exact (Z2R_neq m 0 H).
+Qed.
+
+Theorem float_distribution_pos :
+  forall m1 e1 m2 e2 : Z,
+  (0 < m1)%Z ->
+  (F2R (Float beta m1 e1) < F2R (Float beta m2 e2) < F2R (Float beta (m1 + 1) e1))%R ->
+  (e2 < e1)%Z /\ (e1 + ln_beta beta (Z2R m1) = e2 + ln_beta beta (Z2R m2))%Z.
+Proof.
+intros m1 e1 m2 e2 Hp1 (H12, H21).
+assert (He: (e2 < e1)%Z).
+(* . *)
+apply Znot_ge_lt.
+intros H0.
+elim Rlt_not_le with (1 := H21).
+apply Zge_le in H0.
+apply (F2R_change_exp e1 m2 e2) in H0.
+rewrite H0.
+apply F2R_le_compat.
+apply Zlt_le_succ.
+apply (F2R_lt_reg e1).
+now rewrite <- H0.
+(* . *)
+split.
+exact He.
+rewrite (Zplus_comm e1), (Zplus_comm e2).
+assert (Hp2: (0 < m2)%Z).
+apply (F2R_gt_0_reg m2 e2).
+apply Rlt_trans with (2 := H12).
+now apply F2R_gt_0_compat.
+rewrite <- 2!ln_beta_F2R.
+destruct (ln_beta beta (F2R (Float beta m1 e1))) as (e1', H1).
+simpl.
+apply sym_eq.
+apply ln_beta_unique.
+assert (H2 : (bpow (e1' - 1) <= F2R (Float beta m1 e1) < bpow e1')%R).
+rewrite <- (Zabs_eq m1), F2R_Zabs.
+apply H1.
+apply Rgt_not_eq.
+apply Rlt_gt.
+now apply F2R_gt_0_compat.
+now apply Zlt_le_weak.
+clear H1.
+rewrite <- F2R_Zabs, Zabs_eq.
+split.
+apply Rlt_le.
+apply Rle_lt_trans with (2 := H12).
+apply H2.
+apply Rlt_le_trans with (1 := H21).
+now apply F2R_p1_le_bpow.
+now apply Zlt_le_weak.
+apply sym_not_eq.
+now apply Zlt_not_eq.
+apply sym_not_eq.
+now apply Zlt_not_eq.
+Qed.
+
+Theorem F2R_cond_Zopp :
+  forall b m e,
+  F2R (Float beta (cond_Zopp b m) e) = cond_Ropp b (F2R (Float beta m e)).
+Proof.
+intros [|] m e ; unfold F2R ; simpl.
+now rewrite Z2R_opp, Ropp_mult_distr_l_reverse.
+apply refl_equal.
+Qed.
+
+End Float_prop.
diff --git a/flocq/Core/Fcore_generic_fmt.v b/flocq/Core/Fcore_generic_fmt.v
new file mode 100644
index 0000000..b1db47c
--- /dev/null
+++ b/flocq/Core/Fcore_generic_fmt.v
@@ -0,0 +1,2232 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * What is a real number belonging to a format, and many properties. *)
+Require Import Fcore_Raux.
+Require Import Fcore_defs.
+Require Import Fcore_rnd.
+Require Import Fcore_float_prop.
+
+Section Generic.
+
+Variable beta : radix.
+
+Notation bpow e := (bpow beta e).
+
+Section Format.
+
+Variable fexp : Z -> Z.
+
+(** To be a good fexp *)
+
+Class Valid_exp :=
+  valid_exp :
+  forall k : Z,
+  ( (fexp k < k)%Z -> (fexp (k + 1) <= k)%Z ) /\
+  ( (k <= fexp k)%Z ->
+    (fexp (fexp k + 1) <= fexp k)%Z /\
+    forall l : Z, (l <= fexp k)%Z -> fexp l = fexp k ).
+
+Context { valid_exp_ : Valid_exp }.
+
+Theorem valid_exp_large :
+  forall k l,
+  (fexp k < k)%Z -> (k <= l)%Z ->
+  (fexp l < l)%Z.
+Proof.
+intros k l Hk H.
+apply Znot_ge_lt.
+intros Hl.
+apply Zge_le in Hl.
+assert (H' := proj2 (proj2 (valid_exp l) Hl) k).
+omega.
+Qed.
+
+Theorem valid_exp_large' :
+  forall k l,
+  (fexp k < k)%Z -> (l <= k)%Z ->
+  (fexp l < k)%Z.
+Proof.
+intros k l Hk H.
+apply Znot_ge_lt.
+intros H'.
+apply Zge_le in H'.
+assert (Hl := Zle_trans _ _ _ H H').
+apply valid_exp in Hl.
+assert (H1 := proj2 Hl k H').
+omega.
+Qed.
+
+Definition canonic_exp x :=
+  fexp (ln_beta beta x).
+
+Definition canonic (f : float beta) :=
+  Fexp f = canonic_exp (F2R f).
+
+Definition scaled_mantissa x :=
+  (x * bpow (- canonic_exp x))%R.
+
+Definition generic_format (x : R) :=
+  x = F2R (Float beta (Ztrunc (scaled_mantissa x)) (canonic_exp x)).
+
+(** Basic facts *)
+Theorem generic_format_0 :
+  generic_format 0.
+Proof.
+unfold generic_format, scaled_mantissa.
+rewrite Rmult_0_l.
+change (Ztrunc 0) with (Ztrunc (Z2R 0)).
+now rewrite Ztrunc_Z2R, F2R_0.
+Qed.
+
+Theorem canonic_exp_opp :
+  forall x,
+  canonic_exp (-x) = canonic_exp x.
+Proof.
+intros x.
+unfold canonic_exp.
+now rewrite ln_beta_opp.
+Qed.
+
+Theorem canonic_exp_abs :
+  forall x,
+  canonic_exp (Rabs x) = canonic_exp x.
+Proof.
+intros x.
+unfold canonic_exp.
+now rewrite ln_beta_abs.
+Qed.
+
+Theorem generic_format_bpow :
+  forall e, (fexp (e + 1) <= e)%Z ->
+  generic_format (bpow e).
+Proof.
+intros e H.
+unfold generic_format, scaled_mantissa, canonic_exp.
+rewrite ln_beta_bpow.
+rewrite <- bpow_plus.
+rewrite <- (Z2R_Zpower beta (e + - fexp (e + 1))).
+rewrite Ztrunc_Z2R.
+rewrite <- F2R_bpow.
+rewrite F2R_change_exp with (1 := H).
+now rewrite Zmult_1_l.
+now apply Zle_minus_le_0.
+Qed.
+
+Theorem generic_format_bpow' :
+  forall e, (fexp e <= e)%Z ->
+  generic_format (bpow e).
+Proof.
+intros e He.
+apply generic_format_bpow.
+destruct (Zle_lt_or_eq _ _ He).
+now apply valid_exp.
+rewrite <- H.
+apply valid_exp_.
+rewrite H.
+apply Zle_refl.
+Qed.
+
+Theorem generic_format_F2R :
+  forall m e,
+  ( m <> 0 -> canonic_exp (F2R (Float beta m e)) <= e )%Z ->
+  generic_format (F2R (Float beta m e)).
+Proof.
+intros m e.
+destruct (Z_eq_dec m 0) as [Zm|Zm].
+intros _.
+rewrite Zm, F2R_0.
+apply generic_format_0.
+unfold generic_format, scaled_mantissa.
+set (e' := canonic_exp (F2R (Float beta m e))).
+intros He.
+specialize (He Zm).
+unfold F2R at 3. simpl.
+rewrite  F2R_change_exp with (1 := He).
+apply F2R_eq_compat.
+rewrite Rmult_assoc, <- bpow_plus, <- Z2R_Zpower, <- Z2R_mult.
+now rewrite Ztrunc_Z2R.
+now apply Zle_left.
+Qed.
+
+Theorem canonic_opp :
+  forall m e,
+  canonic (Float beta m e) ->
+  canonic (Float beta (-m) e).
+Proof.
+intros m e H.
+unfold canonic.
+now rewrite F2R_Zopp, canonic_exp_opp.
+Qed.
+
+Theorem canonic_unicity :
+  forall f1 f2,
+  canonic f1 ->
+  canonic f2 ->
+  F2R f1 = F2R f2 ->
+  f1 = f2.
+Proof.
+intros (m1, e1) (m2, e2).
+unfold canonic. simpl.
+intros H1 H2 H.
+rewrite H in H1.
+rewrite <- H2 in H1. clear H2.
+rewrite H1 in H |- *.
+apply (f_equal (fun m => Float beta m e2)).
+apply F2R_eq_reg with (1 := H).
+Qed.
+
+Theorem scaled_mantissa_generic :
+  forall x,
+  generic_format x ->
+  scaled_mantissa x = Z2R (Ztrunc (scaled_mantissa x)).
+Proof.
+intros x Hx.
+unfold scaled_mantissa.
+pattern x at 1 3 ; rewrite Hx.
+unfold F2R. simpl.
+rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
+now rewrite Ztrunc_Z2R.
+Qed.
+
+Theorem scaled_mantissa_mult_bpow :
+  forall x,
+  (scaled_mantissa x * bpow (canonic_exp x))%R = x.
+Proof.
+intros x.
+unfold scaled_mantissa.
+rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_l.
+apply Rmult_1_r.
+Qed.
+
+Theorem scaled_mantissa_0 :
+  scaled_mantissa 0 = R0.
+Proof.
+apply Rmult_0_l.
+Qed.
+
+Theorem scaled_mantissa_opp :
+  forall x,
+  scaled_mantissa (-x) = (-scaled_mantissa x)%R.
+Proof.
+intros x.
+unfold scaled_mantissa.
+rewrite canonic_exp_opp.
+now rewrite Ropp_mult_distr_l_reverse.
+Qed.
+
+Theorem scaled_mantissa_abs :
+  forall x,
+  scaled_mantissa (Rabs x) = Rabs (scaled_mantissa x).
+Proof.
+intros x.
+unfold scaled_mantissa.
+rewrite canonic_exp_abs, Rabs_mult.
+apply f_equal.
+apply sym_eq.
+apply Rabs_pos_eq.
+apply bpow_ge_0.
+Qed.
+
+Theorem generic_format_opp :
+  forall x, generic_format x -> generic_format (-x).
+Proof.
+intros x Hx.
+unfold generic_format.
+rewrite scaled_mantissa_opp, canonic_exp_opp.
+rewrite Ztrunc_opp.
+rewrite F2R_Zopp.
+now apply f_equal.
+Qed.
+
+Theorem generic_format_abs :
+  forall x, generic_format x -> generic_format (Rabs x).
+Proof.
+intros x Hx.
+unfold generic_format.
+rewrite scaled_mantissa_abs, canonic_exp_abs.
+rewrite Ztrunc_abs.
+rewrite F2R_Zabs.
+now apply f_equal.
+Qed.
+
+Theorem generic_format_abs_inv :
+  forall x, generic_format (Rabs x) -> generic_format x.
+Proof.
+intros x.
+unfold generic_format, Rabs.
+case Rcase_abs ; intros _.
+rewrite scaled_mantissa_opp, canonic_exp_opp, Ztrunc_opp.
+intros H.
+rewrite <- (Ropp_involutive x) at 1.
+rewrite H, F2R_Zopp.
+apply Ropp_involutive.
+easy.
+Qed.
+
+Theorem canonic_exp_fexp :
+  forall x ex,
+  (bpow (ex - 1) <= Rabs x < bpow ex)%R ->
+  canonic_exp x = fexp ex.
+Proof.
+intros x ex Hx.
+unfold canonic_exp.
+now rewrite ln_beta_unique with (1 := Hx).
+Qed.
+
+Theorem canonic_exp_fexp_pos :
+  forall x ex,
+  (bpow (ex - 1) <= x < bpow ex)%R ->
+  canonic_exp x = fexp ex.
+Proof.
+intros x ex Hx.
+apply canonic_exp_fexp.
+rewrite Rabs_pos_eq.
+exact Hx.
+apply Rle_trans with (2 := proj1 Hx).
+apply bpow_ge_0.
+Qed.
+
+(** Properties when the real number is "small" (kind of subnormal) *)
+Theorem mantissa_small_pos :
+  forall x ex,
+  (bpow (ex - 1) <= x < bpow ex)%R ->
+  (ex <= fexp ex)%Z ->
+  (0 < x * bpow (- fexp ex) < 1)%R.
+Proof.
+intros x ex Hx He.
+split.
+apply Rmult_lt_0_compat.
+apply Rlt_le_trans with (2 := proj1 Hx).
+apply bpow_gt_0.
+apply bpow_gt_0.
+apply Rmult_lt_reg_r with (bpow (fexp ex)).
+apply bpow_gt_0.
+rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_l.
+rewrite Rmult_1_r, Rmult_1_l.
+apply Rlt_le_trans with (1 := proj2 Hx).
+now apply bpow_le.
+Qed.
+
+Theorem scaled_mantissa_small :
+  forall x ex,
+  (Rabs x < bpow ex)%R ->
+  (ex <= fexp ex)%Z ->
+  (Rabs (scaled_mantissa x) < 1)%R.
+Proof.
+intros x ex Ex He.
+destruct (Req_dec x 0) as [Zx|Zx].
+rewrite Zx, scaled_mantissa_0, Rabs_R0.
+now apply (Z2R_lt 0 1).
+rewrite <- scaled_mantissa_abs.
+unfold scaled_mantissa.
+rewrite canonic_exp_abs.
+unfold canonic_exp.
+destruct (ln_beta beta x) as (ex', Ex').
+simpl.
+specialize (Ex' Zx).
+apply (mantissa_small_pos _ _ Ex').
+assert (ex' <= fexp ex)%Z.
+apply Zle_trans with (2 := He).
+apply bpow_lt_bpow with beta.
+now apply Rle_lt_trans with (2 := Ex).
+now rewrite (proj2 (proj2 (valid_exp _) He)).
+Qed.
+
+Theorem abs_scaled_mantissa_lt_bpow :
+  forall x,
+  (Rabs (scaled_mantissa x) < bpow (ln_beta beta x - canonic_exp x))%R.
+Proof.
+intros x.
+destruct (Req_dec x 0) as [Zx|Zx].
+rewrite Zx, scaled_mantissa_0, Rabs_R0.
+apply bpow_gt_0.
+apply Rlt_le_trans with (1 := bpow_ln_beta_gt beta _).
+apply bpow_le.
+unfold scaled_mantissa.
+rewrite ln_beta_mult_bpow with (1 := Zx).
+apply Zle_refl.
+Qed.
+
+Theorem ln_beta_generic_gt :
+  forall x, (x <> 0)%R ->
+  generic_format x ->
+  (canonic_exp x < ln_beta beta x)%Z.
+Proof.
+intros x Zx Gx.
+apply Znot_ge_lt.
+unfold canonic_exp.
+destruct (ln_beta beta x) as (ex,Ex) ; simpl.
+specialize (Ex Zx).
+intros H.
+apply Zge_le in H.
+generalize (scaled_mantissa_small x ex (proj2 Ex) H).
+contradict Zx.
+rewrite Gx.
+replace (Ztrunc (scaled_mantissa x)) with Z0.
+apply F2R_0.
+cut (Zabs (Ztrunc (scaled_mantissa x)) < 1)%Z.
+clear ; zify ; omega.
+apply lt_Z2R.
+rewrite Z2R_abs.
+now rewrite <- scaled_mantissa_generic.
+Qed.
+
+Theorem mantissa_DN_small_pos :
+  forall x ex,
+  (bpow (ex - 1) <= x < bpow ex)%R ->
+  (ex <= fexp ex)%Z ->
+  Zfloor (x * bpow (- fexp ex)) = Z0.
+Proof.
+intros x ex Hx He.
+apply Zfloor_imp. simpl.
+assert (H := mantissa_small_pos x ex Hx He).
+split ; try apply Rlt_le ; apply H.
+Qed.
+
+Theorem mantissa_UP_small_pos :
+  forall x ex,
+  (bpow (ex - 1) <= x < bpow ex)%R ->
+  (ex <= fexp ex)%Z ->
+  Zceil (x * bpow (- fexp ex)) = 1%Z.
+Proof.
+intros x ex Hx He.
+apply Zceil_imp. simpl.
+assert (H := mantissa_small_pos x ex Hx He).
+split ; try apply Rlt_le ; apply H.
+Qed.
+
+(** Generic facts about any format *)
+Theorem generic_format_discrete :
+  forall x m,
+  let e := canonic_exp x in
+  (F2R (Float beta m e) < x < F2R (Float beta (m + 1) e))%R ->
+  ~ generic_format x.
+Proof.
+intros x m e (Hx,Hx2) Hf.
+apply Rlt_not_le with (1 := Hx2). clear Hx2.
+rewrite Hf.
+fold e.
+apply F2R_le_compat.
+apply Zlt_le_succ.
+apply lt_Z2R.
+rewrite <- scaled_mantissa_generic with (1 := Hf).
+apply Rmult_lt_reg_r with (bpow e).
+apply bpow_gt_0.
+now rewrite scaled_mantissa_mult_bpow.
+Qed.
+
+Theorem generic_format_canonic :
+  forall f, canonic f ->
+  generic_format (F2R f).
+Proof.
+intros (m, e) Hf.
+unfold canonic in Hf. simpl in Hf.
+unfold generic_format, scaled_mantissa.
+rewrite <- Hf.
+apply F2R_eq_compat.
+unfold F2R. simpl.
+rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
+now rewrite Ztrunc_Z2R.
+Qed.
+
+Theorem generic_format_ge_bpow :
+  forall emin,
+  ( forall e, (emin <= fexp e)%Z ) ->
+  forall x,
+  (0 < x)%R ->
+  generic_format x ->
+  (bpow emin <= x)%R.
+Proof.
+intros emin Emin x Hx Fx.
+rewrite Fx.
+apply Rle_trans with (bpow (fexp (ln_beta beta x))).
+now apply bpow_le.
+apply bpow_le_F2R.
+apply F2R_gt_0_reg with beta (canonic_exp x).
+now rewrite <- Fx.
+Qed.
+
+Theorem abs_lt_bpow_prec:
+  forall prec,
+  (forall e, (e - prec <= fexp e)%Z) ->
+  (* OK with FLX, FLT and FTZ *)
+  forall x,
+  (Rabs x < bpow (prec + canonic_exp x))%R.
+intros prec Hp x.
+case (Req_dec x 0); intros Hxz.
+rewrite Hxz, Rabs_R0.
+apply bpow_gt_0.
+unfold canonic_exp.
+destruct (ln_beta beta x) as (ex,Ex) ; simpl.
+specialize (Ex Hxz).
+apply Rlt_le_trans with (1 := proj2 Ex).
+apply bpow_le.
+specialize (Hp ex).
+omega.
+Qed.
+
+Theorem generic_format_bpow_inv' :
+  forall e,
+  generic_format (bpow e) ->
+  (fexp (e + 1) <= e)%Z.
+Proof.
+intros e He.
+apply Znot_gt_le.
+contradict He.
+unfold generic_format, scaled_mantissa, canonic_exp, F2R. simpl.
+rewrite ln_beta_bpow, <- bpow_plus.
+apply Rgt_not_eq.
+rewrite Ztrunc_floor.
+2: apply bpow_ge_0.
+rewrite Zfloor_imp with (n := Z0).
+rewrite Rmult_0_l.
+apply bpow_gt_0.
+split.
+apply bpow_ge_0.
+apply (bpow_lt _ _ 0).
+clear -He ; omega.
+Qed.
+
+Theorem generic_format_bpow_inv :
+  forall e,
+  generic_format (bpow e) ->
+  (fexp e <= e)%Z.
+Proof.
+intros e He.
+apply generic_format_bpow_inv' in He.
+assert (H := valid_exp_large' (e + 1) e).
+omega.
+Qed.
+
+Section Fcore_generic_round_pos.
+
+(** Rounding functions: R -> Z *)
+
+Variable rnd : R -> Z.
+
+Class Valid_rnd := {
+  Zrnd_le : forall x y, (x <= y)%R -> (rnd x <= rnd y)%Z ;
+  Zrnd_Z2R : forall n, rnd (Z2R n) = n
+}.
+
+Context { valid_rnd : Valid_rnd }.
+
+Theorem Zrnd_DN_or_UP :
+  forall x, rnd x = Zfloor x \/ rnd x = Zceil x.
+Proof.
+intros x.
+destruct (Zle_or_lt (rnd x) (Zfloor x)) as [Hx|Hx].
+left.
+apply Zle_antisym with (1 := Hx).
+rewrite <- (Zrnd_Z2R (Zfloor x)).
+apply Zrnd_le.
+apply Zfloor_lb.
+right.
+apply Zle_antisym.
+rewrite <- (Zrnd_Z2R (Zceil x)).
+apply Zrnd_le.
+apply Zceil_ub.
+rewrite Zceil_floor_neq.
+omega.
+intros H.
+rewrite <- H in Hx.
+rewrite Zfloor_Z2R, Zrnd_Z2R in Hx.
+apply Zlt_irrefl with (1 := Hx).
+Qed.
+
+Theorem Zrnd_ZR_or_AW :
+  forall x, rnd x = Ztrunc x \/ rnd x = Zaway x.
+Proof.
+intros x.
+unfold Ztrunc, Zaway.
+destruct (Zrnd_DN_or_UP x) as [Hx|Hx] ;
+  case Rlt_bool.
+now right.
+now left.
+now left.
+now right.
+Qed.
+
+(** the most useful one: R -> F *)
+Definition round x :=
+  F2R (Float beta (rnd (scaled_mantissa x)) (canonic_exp x)).
+
+Theorem round_le_pos :
+  forall x y, (0 < x)%R -> (x <= y)%R -> (round x <= round y)%R.
+Proof.
+intros x y Hx Hxy.
+unfold round, scaled_mantissa, canonic_exp.
+destruct (ln_beta beta x) as (ex, Hex). simpl.
+destruct (ln_beta beta y) as (ey, Hey). simpl.
+specialize (Hex (Rgt_not_eq _ _ Hx)).
+specialize (Hey (Rgt_not_eq _ _ (Rlt_le_trans _ _ _ Hx Hxy))).
+rewrite Rabs_pos_eq in Hex.
+2: now apply Rlt_le.
+rewrite Rabs_pos_eq in Hey.
+2: apply Rle_trans with (2:=Hxy); now apply Rlt_le.
+assert (He: (ex <= ey)%Z).
+cut (ex - 1 < ey)%Z. omega.
+apply (lt_bpow beta).
+apply Rle_lt_trans with (1 := proj1 Hex).
+apply Rle_lt_trans with (1 := Hxy).
+apply Hey.
+destruct (Zle_or_lt ey (fexp ey)) as [Hy1|Hy1].
+rewrite (proj2 (proj2 (valid_exp ey) Hy1) ex).
+apply F2R_le_compat.
+apply Zrnd_le.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+exact Hxy.
+now apply Zle_trans with ey.
+destruct (Zle_lt_or_eq _ _ He) as [He'|He'].
+destruct (Zle_or_lt ey (fexp ex)) as [Hx2|Hx2].
+rewrite (proj2 (proj2 (valid_exp ex) (Zle_trans _ _ _ He Hx2)) ey Hx2).
+apply F2R_le_compat.
+apply Zrnd_le.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+exact Hxy.
+apply Rle_trans with (F2R (Float beta (rnd (bpow (ey - 1) * bpow (- fexp ey))) (fexp ey))).
+rewrite <- bpow_plus.
+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).
+apply Zrnd_le.
+apply Rlt_le.
+exact (proj2 (mantissa_small_pos _ _ Hex Hx1)).
+unfold F2R. simpl.
+rewrite Z2R_Zpower. 2: omega.
+rewrite <- bpow_plus, Rmult_1_l.
+apply bpow_le.
+omega.
+apply Rle_trans with (F2R (Float beta (rnd (bpow ex * bpow (- fexp ex))) (fexp ex))).
+apply F2R_le_compat.
+apply Zrnd_le.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply Rlt_le.
+apply Hex.
+rewrite <- bpow_plus.
+rewrite <- Z2R_Zpower. 2: omega.
+rewrite Zrnd_Z2R.
+unfold F2R. simpl.
+rewrite 2!Z2R_Zpower ; try omega.
+rewrite <- 2!bpow_plus.
+apply bpow_le.
+omega.
+apply F2R_le_compat.
+apply Zrnd_le.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply Hey.
+rewrite He'.
+apply F2R_le_compat.
+apply Zrnd_le.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+exact Hxy.
+Qed.
+
+Theorem round_generic :
+  forall x,
+  generic_format x ->
+  round x = x.
+Proof.
+intros x Hx.
+unfold round.
+rewrite scaled_mantissa_generic with (1 := Hx).
+rewrite Zrnd_Z2R.
+now apply sym_eq.
+Qed.
+
+Theorem round_0 :
+  round 0 = R0.
+Proof.
+unfold round, scaled_mantissa.
+rewrite Rmult_0_l.
+fold (Z2R 0).
+rewrite Zrnd_Z2R.
+apply F2R_0.
+Qed.
+
+Theorem round_bounded_large_pos :
+  forall x ex,
+  (fexp ex < ex)%Z ->
+  (bpow (ex - 1) <= x < bpow ex)%R ->
+  (bpow (ex - 1) <= round x <= bpow ex)%R.
+Proof.
+intros x ex He Hx.
+unfold round, scaled_mantissa.
+rewrite (canonic_exp_fexp_pos _ _ Hx).
+unfold F2R. simpl.
+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.
+rewrite bpow_plus.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+assert (Hf: Z2R (Zpower beta (ex - 1 - fexp ex)) = bpow (ex - 1 + - fexp ex)).
+apply Z2R_Zpower.
+omega.
+rewrite <- Hf.
+apply Z2R_le.
+apply Zfloor_lub.
+rewrite Hf.
+rewrite bpow_plus.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply Hx.
+apply Rle_trans with (2 := Rlt_le _ _ (proj2 Hx)).
+apply Rmult_le_reg_r with (bpow (- fexp ex)).
+apply bpow_gt_0.
+rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
+apply Zfloor_lb.
+(* UP *)
+split.
+apply Rle_trans with (1 := proj1 Hx).
+apply Rmult_le_reg_r with (bpow (- fexp ex)).
+apply bpow_gt_0.
+rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
+apply Zceil_ub.
+pattern ex at 3 ; replace ex with (ex - fexp ex + fexp ex)%Z by ring.
+rewrite bpow_plus.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+assert (Hf: Z2R (Zpower beta (ex - fexp ex)) = bpow (ex - fexp ex)).
+apply Z2R_Zpower.
+omega.
+rewrite <- Hf.
+apply Z2R_le.
+apply Zceil_glb.
+rewrite Hf.
+unfold Zminus.
+rewrite bpow_plus.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply Rlt_le.
+apply Hx.
+Qed.
+
+Theorem round_bounded_small_pos :
+  forall x ex,
+  (ex <= fexp ex)%Z ->
+  (bpow (ex - 1) <= x < bpow ex)%R ->
+  round x = R0 \/ round x = bpow (fexp ex).
+Proof.
+intros x ex He Hx.
+unfold round, scaled_mantissa.
+rewrite (canonic_exp_fexp_pos _ _ Hx).
+unfold F2R. simpl.
+destruct (Zrnd_DN_or_UP (x * bpow (-fexp ex))) as [Hr|Hr] ; rewrite Hr.
+(* DN *)
+left.
+apply Rmult_eq_0_compat_r.
+apply (@f_equal _ _ Z2R _ Z0).
+apply Zfloor_imp.
+refine (let H := _ in conj (Rlt_le _ _ (proj1 H)) (proj2 H)).
+now apply mantissa_small_pos.
+(* UP *)
+right.
+pattern (bpow (fexp ex)) at 2 ; rewrite <- Rmult_1_l.
+apply (f_equal (fun m => (m * bpow (fexp ex))%R)).
+apply (@f_equal _ _ Z2R _ 1%Z).
+apply Zceil_imp.
+refine (let H := _ in conj (proj1 H) (Rlt_le _ _ (proj2 H))).
+now apply mantissa_small_pos.
+Qed.
+
+Theorem generic_format_round_pos :
+  forall x,
+  (0 < x)%R ->
+  generic_format (round x).
+Proof.
+intros x Hx0.
+destruct (ln_beta beta x) as (ex, Hex).
+specialize (Hex (Rgt_not_eq _ _ Hx0)).
+rewrite Rabs_pos_eq in Hex. 2: now apply Rlt_le.
+destruct (Zle_or_lt ex (fexp ex)) as [He|He].
+(* small *)
+destruct (round_bounded_small_pos _ _ He Hex) as [Hr|Hr] ; rewrite Hr.
+apply generic_format_0.
+apply generic_format_bpow.
+now apply valid_exp.
+(* large *)
+generalize (round_bounded_large_pos _ _ He Hex).
+intros (Hr1, Hr2).
+destruct (Rle_or_lt (bpow ex) (round x)) as [Hr|Hr].
+rewrite <- (Rle_antisym _ _ Hr Hr2).
+apply generic_format_bpow.
+now apply valid_exp.
+assert (Hr' := conj Hr1 Hr).
+unfold generic_format, scaled_mantissa.
+rewrite (canonic_exp_fexp_pos _ _ Hr').
+unfold round, scaled_mantissa.
+rewrite (canonic_exp_fexp_pos _ _ Hex).
+unfold F2R at 3. simpl.
+rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
+now rewrite Ztrunc_Z2R.
+Qed.
+
+End Fcore_generic_round_pos.
+
+Theorem round_ext :
+  forall rnd1 rnd2,
+  ( forall x, rnd1 x = rnd2 x ) ->
+  forall x,
+  round rnd1 x = round rnd2 x.
+Proof.
+intros rnd1 rnd2 Hext x.
+unfold round.
+now rewrite Hext.
+Qed.
+
+Section Zround_opp.
+
+Variable rnd : R -> Z.
+Context { valid_rnd : Valid_rnd rnd }.
+
+Definition Zrnd_opp x := Zopp (rnd (-x)).
+
+Global Instance valid_rnd_opp : Valid_rnd Zrnd_opp.
+Proof with auto with typeclass_instances.
+split.
+(* *)
+intros x y Hxy.
+unfold Zrnd_opp.
+apply Zopp_le_cancel.
+rewrite 2!Zopp_involutive.
+apply Zrnd_le...
+now apply Ropp_le_contravar.
+(* *)
+intros n.
+unfold Zrnd_opp.
+rewrite <- Z2R_opp, Zrnd_Z2R...
+apply Zopp_involutive.
+Qed.
+
+Theorem round_opp :
+  forall x,
+  round rnd (- x) = Ropp (round Zrnd_opp x).
+Proof.
+intros x.
+unfold round.
+rewrite <- F2R_Zopp, canonic_exp_opp, scaled_mantissa_opp.
+apply F2R_eq_compat.
+apply sym_eq.
+exact (Zopp_involutive _).
+Qed.
+
+End Zround_opp.
+
+(** IEEE-754 roundings: up, down and to zero *)
+
+Global Instance valid_rnd_DN : Valid_rnd Zfloor.
+Proof.
+split.
+apply Zfloor_le.
+apply Zfloor_Z2R.
+Qed.
+
+Global Instance valid_rnd_UP : Valid_rnd Zceil.
+Proof.
+split.
+apply Zceil_le.
+apply Zceil_Z2R.
+Qed.
+
+Global Instance valid_rnd_ZR : Valid_rnd Ztrunc.
+Proof.
+split.
+apply Ztrunc_le.
+apply Ztrunc_Z2R.
+Qed.
+
+Global Instance valid_rnd_AW : Valid_rnd Zaway.
+Proof.
+split.
+apply Zaway_le.
+apply Zaway_Z2R.
+Qed.
+
+Section monotone.
+
+Variable rnd : R -> Z.
+Context { valid_rnd : Valid_rnd rnd }.
+
+Theorem round_DN_or_UP :
+  forall x,
+  round rnd x = round Zfloor x \/ round rnd x = round Zceil x.
+Proof.
+intros x.
+unfold round.
+destruct (Zrnd_DN_or_UP rnd (scaled_mantissa x)) as [Hx|Hx].
+left. now rewrite Hx.
+right. now rewrite Hx.
+Qed.
+
+Theorem round_ZR_or_AW :
+  forall x,
+  round rnd x = round Ztrunc x \/ round rnd x = round Zaway x.
+Proof.
+intros x.
+unfold round.
+destruct (Zrnd_ZR_or_AW rnd (scaled_mantissa x)) as [Hx|Hx].
+left. now rewrite Hx.
+right. now rewrite Hx.
+Qed.
+
+Theorem round_le :
+  forall x y, (x <= y)%R -> (round rnd x <= round rnd y)%R.
+Proof with auto with typeclass_instances.
+intros x y Hxy.
+destruct (total_order_T x 0) as [[Hx|Hx]|Hx].
+3: now apply round_le_pos.
+(* x < 0 *)
+unfold round.
+destruct (Rlt_or_le y 0) as [Hy|Hy].
+(* . y < 0 *)
+rewrite <- (Ropp_involutive x), <- (Ropp_involutive y).
+rewrite (scaled_mantissa_opp (-x)), (scaled_mantissa_opp (-y)).
+rewrite (canonic_exp_opp (-x)), (canonic_exp_opp (-y)).
+apply Ropp_le_cancel.
+rewrite <- 2!F2R_Zopp.
+apply (round_le_pos (Zrnd_opp rnd) (-y) (-x)).
+rewrite <- Ropp_0.
+now apply Ropp_lt_contravar.
+now apply Ropp_le_contravar.
+(* . 0 <= y *)
+apply Rle_trans with R0.
+apply F2R_le_0_compat. simpl.
+rewrite <- (Zrnd_Z2R rnd 0).
+apply Zrnd_le...
+simpl.
+rewrite <- (Rmult_0_l (bpow (- fexp (ln_beta beta x)))).
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+now apply Rlt_le.
+apply F2R_ge_0_compat. simpl.
+rewrite <- (Zrnd_Z2R rnd 0).
+apply Zrnd_le...
+apply Rmult_le_pos.
+exact Hy.
+apply bpow_ge_0.
+(* x = 0 *)
+rewrite Hx.
+rewrite round_0...
+apply F2R_ge_0_compat.
+simpl.
+rewrite <- (Zrnd_Z2R rnd 0).
+apply Zrnd_le...
+apply Rmult_le_pos.
+now rewrite <- Hx.
+apply bpow_ge_0.
+Qed.
+
+Theorem round_ge_generic :
+  forall x y, generic_format x -> (x <= y)%R -> (x <= round rnd y)%R.
+Proof.
+intros x y Hx Hxy.
+rewrite <- (round_generic rnd x Hx).
+now apply round_le.
+Qed.
+
+Theorem round_le_generic :
+  forall x y, generic_format y -> (x <= y)%R -> (round rnd x <= y)%R.
+Proof.
+intros x y Hy Hxy.
+rewrite <- (round_generic rnd y Hy).
+now apply round_le.
+Qed.
+
+End monotone.
+
+Theorem round_abs_abs' :
+  forall P : R -> R -> Prop,
+  ( forall rnd (Hr : Valid_rnd rnd) x, (0 <= x)%R -> P x (round rnd x) ) ->
+  forall rnd {Hr : Valid_rnd rnd} x, P (Rabs x) (Rabs (round rnd x)).
+Proof with auto with typeclass_instances.
+intros P HP rnd Hr x.
+destruct (Rle_or_lt 0 x) as [Hx|Hx].
+(* . *)
+rewrite 2!Rabs_pos_eq.
+now apply HP.
+rewrite <- (round_0 rnd).
+now apply round_le.
+exact Hx.
+(* . *)
+rewrite (Rabs_left _ Hx).
+rewrite Rabs_left1.
+pattern x at 2 ; rewrite <- Ropp_involutive.
+rewrite round_opp.
+rewrite Ropp_involutive.
+apply HP...
+rewrite <- Ropp_0.
+apply Ropp_le_contravar.
+now apply Rlt_le.
+rewrite <- (round_0 rnd).
+apply round_le...
+now apply Rlt_le.
+Qed.
+
+(* TODO: remove *)
+Theorem round_abs_abs :
+  forall P : R -> R -> Prop,
+  ( forall rnd (Hr : Valid_rnd rnd) x, P x (round rnd x) ) ->
+  forall rnd {Hr : Valid_rnd rnd} x, P (Rabs x) (Rabs (round rnd x)).
+Proof.
+intros P HP.
+apply round_abs_abs'.
+intros.
+now apply HP.
+Qed.
+
+Theorem round_bounded_large :
+  forall rnd {Hr : Valid_rnd rnd} x ex,
+  (fexp ex < ex)%Z ->
+  (bpow (ex - 1) <= Rabs x < bpow ex)%R ->
+  (bpow (ex - 1) <= Rabs (round rnd x) <= bpow ex)%R.
+Proof with auto with typeclass_instances.
+intros rnd Hr x ex He.
+apply round_abs_abs...
+clear rnd Hr x.
+intros rnd' Hr x.
+apply round_bounded_large_pos...
+Qed.
+
+Section monotone_abs.
+
+Variable rnd : R -> Z.
+Context { valid_rnd : Valid_rnd rnd }.
+
+Theorem abs_round_ge_generic :
+  forall x y, generic_format x -> (x <= Rabs y)%R -> (x <= Rabs (round rnd y))%R.
+Proof with auto with typeclass_instances.
+intros x y.
+apply round_abs_abs...
+clear rnd valid_rnd y.
+intros rnd' Hrnd y Hy.
+apply round_ge_generic...
+Qed.
+
+Theorem abs_round_le_generic :
+  forall x y, generic_format y -> (Rabs x <= y)%R -> (Rabs (round rnd x) <= y)%R.
+Proof with auto with typeclass_instances.
+intros x y.
+apply round_abs_abs...
+clear rnd valid_rnd x.
+intros rnd' Hrnd x Hx.
+apply round_le_generic...
+Qed.
+
+End monotone_abs.
+
+Theorem round_DN_opp :
+  forall x,
+  round Zfloor (-x) = (- round Zceil x)%R.
+Proof.
+intros x.
+unfold round.
+rewrite scaled_mantissa_opp.
+rewrite <- F2R_Zopp.
+unfold Zceil.
+rewrite Zopp_involutive.
+now rewrite canonic_exp_opp.
+Qed.
+
+Theorem round_UP_opp :
+  forall x,
+  round Zceil (-x) = (- round Zfloor x)%R.
+Proof.
+intros x.
+unfold round.
+rewrite scaled_mantissa_opp.
+rewrite <- F2R_Zopp.
+unfold Zceil.
+rewrite Ropp_involutive.
+now rewrite canonic_exp_opp.
+Qed.
+
+Theorem round_ZR_opp :
+  forall x,
+  round Ztrunc (- x) = Ropp (round Ztrunc x).
+Proof.
+intros x.
+unfold round.
+rewrite scaled_mantissa_opp, canonic_exp_opp, Ztrunc_opp.
+apply F2R_Zopp.
+Qed.
+
+Theorem round_ZR_abs :
+  forall x,
+  round Ztrunc (Rabs x) = Rabs (round Ztrunc x).
+Proof with auto with typeclass_instances.
+intros x.
+apply sym_eq.
+unfold Rabs at 2.
+destruct (Rcase_abs x) as [Hx|Hx].
+rewrite round_ZR_opp.
+apply Rabs_left1.
+rewrite <- (round_0 Ztrunc).
+apply round_le...
+now apply Rlt_le.
+apply Rabs_pos_eq.
+rewrite <- (round_0 Ztrunc).
+apply round_le...
+now apply Rge_le.
+Qed.
+
+Theorem round_AW_opp :
+  forall x,
+  round Zaway (- x) = Ropp (round Zaway x).
+Proof.
+intros x.
+unfold round.
+rewrite scaled_mantissa_opp, canonic_exp_opp, Zaway_opp.
+apply F2R_Zopp.
+Qed.
+
+Theorem round_AW_abs :
+  forall x,
+  round Zaway (Rabs x) = Rabs (round Zaway x).
+Proof with auto with typeclass_instances.
+intros x.
+apply sym_eq.
+unfold Rabs at 2.
+destruct (Rcase_abs x) as [Hx|Hx].
+rewrite round_AW_opp.
+apply Rabs_left1.
+rewrite <- (round_0 Zaway).
+apply round_le...
+now apply Rlt_le.
+apply Rabs_pos_eq.
+rewrite <- (round_0 Zaway).
+apply round_le...
+now apply Rge_le.
+Qed.
+
+Theorem round_ZR_pos :
+  forall x,
+  (0 <= x)%R ->
+  round Ztrunc x = round Zfloor x.
+Proof.
+intros x Hx.
+unfold round, Ztrunc.
+case Rlt_bool_spec.
+intros H.
+elim Rlt_not_le with (1 := H).
+rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+apply Rmult_le_compat_r with (2 := Hx).
+apply bpow_ge_0.
+easy.
+Qed.
+
+Theorem round_ZR_neg :
+  forall x,
+  (x <= 0)%R ->
+  round Ztrunc x = round Zceil x.
+Proof.
+intros x Hx.
+unfold round, Ztrunc.
+case Rlt_bool_spec.
+easy.
+intros [H|H].
+elim Rlt_not_le with (1 := H).
+rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+apply Rmult_le_compat_r with (2 := Hx).
+apply bpow_ge_0.
+rewrite <- H.
+change R0 with (Z2R 0).
+now rewrite Zfloor_Z2R, Zceil_Z2R.
+Qed.
+
+Theorem round_AW_pos :
+  forall x,
+  (0 <= x)%R ->
+  round Zaway x = round Zceil x.
+Proof.
+intros x Hx.
+unfold round, Zaway.
+case Rlt_bool_spec.
+intros H.
+elim Rlt_not_le with (1 := H).
+rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+apply Rmult_le_compat_r with (2 := Hx).
+apply bpow_ge_0.
+easy.
+Qed.
+
+Theorem round_AW_neg :
+  forall x,
+  (x <= 0)%R ->
+  round Zaway x = round Zfloor x.
+Proof.
+intros x Hx.
+unfold round, Zaway.
+case Rlt_bool_spec.
+easy.
+intros [H|H].
+elim Rlt_not_le with (1 := H).
+rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+apply Rmult_le_compat_r with (2 := Hx).
+apply bpow_ge_0.
+rewrite <- H.
+change R0 with (Z2R 0).
+now rewrite Zfloor_Z2R, Zceil_Z2R.
+Qed.
+
+Theorem generic_format_round :
+  forall rnd { Hr : Valid_rnd rnd } x,
+  generic_format (round rnd x).
+Proof with auto with typeclass_instances.
+intros rnd Zrnd x.
+destruct (total_order_T x 0) as [[Hx|Hx]|Hx].
+rewrite <- (Ropp_involutive x).
+destruct (round_DN_or_UP rnd (- - x)) as [Hr|Hr] ; rewrite Hr.
+rewrite round_DN_opp.
+apply generic_format_opp.
+apply generic_format_round_pos...
+now apply Ropp_0_gt_lt_contravar.
+rewrite round_UP_opp.
+apply generic_format_opp.
+apply generic_format_round_pos...
+now apply Ropp_0_gt_lt_contravar.
+rewrite Hx.
+rewrite round_0...
+apply generic_format_0.
+now apply generic_format_round_pos.
+Qed.
+
+Theorem round_DN_pt :
+  forall x,
+  Rnd_DN_pt generic_format x (round Zfloor x).
+Proof with auto with typeclass_instances.
+intros x.
+split.
+apply generic_format_round...
+split.
+pattern x at 2 ; rewrite <- scaled_mantissa_mult_bpow.
+unfold round, F2R. simpl.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+apply Zfloor_lb.
+intros g Hg Hgx.
+apply round_ge_generic...
+Qed.
+
+Theorem generic_format_satisfies_any :
+  satisfies_any generic_format.
+Proof.
+split.
+(* symmetric set *)
+exact generic_format_0.
+exact generic_format_opp.
+(* round down *)
+intros x.
+eexists.
+apply round_DN_pt.
+Qed.
+
+Theorem round_UP_pt :
+  forall x,
+  Rnd_UP_pt generic_format x (round Zceil x).
+Proof.
+intros x.
+rewrite <- (Ropp_involutive x).
+rewrite round_UP_opp.
+apply Rnd_DN_UP_pt_sym.
+apply generic_format_opp.
+apply round_DN_pt.
+Qed.
+
+Theorem round_ZR_pt :
+  forall x,
+  Rnd_ZR_pt generic_format x (round Ztrunc x).
+Proof.
+intros x.
+split ; intros Hx.
+rewrite round_ZR_pos with (1 := Hx).
+apply round_DN_pt.
+rewrite round_ZR_neg with (1 := Hx).
+apply round_UP_pt.
+Qed.
+
+Theorem round_DN_small_pos :
+  forall x ex,
+  (bpow (ex - 1) <= x < bpow ex)%R ->
+  (ex <= fexp ex)%Z ->
+  round Zfloor x = R0.
+Proof.
+intros x ex Hx He.
+rewrite <- (F2R_0 beta (canonic_exp x)).
+rewrite <- mantissa_DN_small_pos with (1 := Hx) (2 := He).
+now rewrite <- canonic_exp_fexp_pos with (1 := Hx).
+Qed.
+
+Theorem round_UP_small_pos :
+  forall x ex,
+  (bpow (ex - 1) <= x < bpow ex)%R ->
+  (ex <= fexp ex)%Z ->
+  round Zceil x = (bpow (fexp ex)).
+Proof.
+intros x ex Hx He.
+rewrite <- F2R_bpow.
+rewrite <- mantissa_UP_small_pos with (1 := Hx) (2 := He).
+now rewrite <- canonic_exp_fexp_pos with (1 := Hx).
+Qed.
+
+Theorem generic_format_EM :
+  forall x,
+  generic_format x \/ ~generic_format x.
+Proof with auto with typeclass_instances.
+intros x.
+destruct (Req_dec (round Zfloor x) x) as [Hx|Hx].
+left.
+rewrite <- Hx.
+apply generic_format_round...
+right.
+intros H.
+apply Hx.
+apply round_generic...
+Qed.
+
+Section round_large.
+
+Variable rnd : R -> Z.
+Context { valid_rnd : Valid_rnd rnd }.
+
+Theorem round_large_pos_ge_pow :
+  forall x e,
+  (0 < round rnd x)%R ->
+  (bpow e <= x)%R ->
+  (bpow e <= round rnd x)%R.
+Proof.
+intros x e Hd Hex.
+destruct (ln_beta beta x) as (ex, He).
+assert (Hx: (0 < x)%R).
+apply Rlt_le_trans with (2 := Hex).
+apply bpow_gt_0.
+specialize (He (Rgt_not_eq _ _ Hx)).
+rewrite Rabs_pos_eq in He. 2: now apply Rlt_le.
+apply Rle_trans with (bpow (ex - 1)).
+apply bpow_le.
+cut (e < ex)%Z. omega.
+apply (lt_bpow beta).
+now apply Rle_lt_trans with (2 := proj2 He).
+destruct (Zle_or_lt ex (fexp ex)).
+destruct (round_bounded_small_pos rnd x ex H He) as [Hr|Hr].
+rewrite Hr in Hd.
+elim Rlt_irrefl with (1 := Hd).
+rewrite Hr.
+apply bpow_le.
+omega.
+apply (round_bounded_large_pos rnd x ex H He).
+Qed.
+
+End round_large.
+
+Theorem ln_beta_round_ZR :
+  forall x,
+  (round Ztrunc x <> 0)%R ->
+  (ln_beta beta (round Ztrunc x) = ln_beta beta x :> Z).
+Proof with auto with typeclass_instances.
+intros x Zr.
+destruct (Req_dec x 0) as [Zx|Zx].
+rewrite Zx, round_0...
+apply ln_beta_unique.
+destruct (ln_beta beta x) as (ex, Ex) ; simpl.
+specialize (Ex Zx).
+rewrite <- round_ZR_abs.
+split.
+apply round_large_pos_ge_pow...
+rewrite round_ZR_abs.
+now apply Rabs_pos_lt.
+apply Ex.
+apply Rle_lt_trans with (2 := proj2 Ex).
+rewrite round_ZR_pos.
+apply round_DN_pt.
+apply Rabs_pos.
+Qed.
+
+Theorem ln_beta_round :
+  forall rnd {Hrnd : Valid_rnd rnd} x,
+  (round rnd x <> 0)%R ->
+  (ln_beta beta (round rnd x) = ln_beta beta x :> Z) \/
+  Rabs (round rnd x) = bpow (Zmax (ln_beta beta x) (fexp (ln_beta beta x))).
+Proof with auto with typeclass_instances.
+intros rnd Hrnd x.
+destruct (round_ZR_or_AW rnd x) as [Hr|Hr] ; rewrite Hr ; clear Hr rnd Hrnd.
+left.
+now apply ln_beta_round_ZR.
+intros Zr.
+destruct (Req_dec x 0) as [Zx|Zx].
+rewrite Zx, round_0...
+destruct (ln_beta beta x) as (ex, Ex) ; simpl.
+specialize (Ex Zx).
+rewrite <- ln_beta_abs.
+rewrite <- round_AW_abs.
+destruct (Zle_or_lt ex (fexp ex)) as [He|He].
+right.
+rewrite Zmax_r with (1 := He).
+rewrite round_AW_pos with (1 := Rabs_pos _).
+now apply round_UP_small_pos.
+destruct (round_bounded_large_pos Zaway _ ex He Ex) as (H1,[H2|H2]).
+left.
+apply ln_beta_unique.
+rewrite <- round_AW_abs, Rabs_Rabsolu.
+now split.
+right.
+now rewrite Zmax_l with (1 := Zlt_le_weak _ _ He).
+Qed.
+
+Theorem ln_beta_round_DN :
+  forall x,
+  (0 < round Zfloor x)%R ->
+  (ln_beta beta (round Zfloor x) = ln_beta beta x :> Z).
+Proof.
+intros x Hd.
+assert (0 < x)%R.
+apply Rlt_le_trans with (1 := Hd).
+apply round_DN_pt.
+revert Hd.
+rewrite <- round_ZR_pos.
+intros Hd.
+apply ln_beta_round_ZR.
+now apply Rgt_not_eq.
+now apply Rlt_le.
+Qed.
+
+(* TODO: remove *)
+Theorem canonic_exp_DN :
+  forall x,
+  (0 < round Zfloor x)%R ->
+  canonic_exp (round Zfloor x) = canonic_exp x.
+Proof.
+intros x Hd.
+apply (f_equal fexp).
+now apply ln_beta_round_DN.
+Qed.
+
+Theorem scaled_mantissa_DN :
+  forall x,
+  (0 < round Zfloor x)%R ->
+  scaled_mantissa (round Zfloor x) = Z2R (Zfloor (scaled_mantissa x)).
+Proof.
+intros x Hd.
+unfold scaled_mantissa.
+rewrite canonic_exp_DN with (1 := Hd).
+unfold round, F2R. simpl.
+now rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
+Qed.
+
+Theorem generic_N_pt_DN_or_UP :
+  forall x f,
+  Rnd_N_pt generic_format x f ->
+  f = round Zfloor x \/ f = round Zceil x.
+Proof.
+intros x f Hxf.
+destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf).
+left.
+apply Rnd_DN_pt_unicity with (1 := H).
+apply round_DN_pt.
+right.
+apply Rnd_UP_pt_unicity with (1 := H).
+apply round_UP_pt.
+Qed.
+
+Section not_FTZ.
+
+Class Exp_not_FTZ :=
+  exp_not_FTZ : forall e, (fexp (fexp e + 1) <= fexp e)%Z.
+
+Context { exp_not_FTZ_ : Exp_not_FTZ }.
+
+Theorem subnormal_exponent :
+  forall e x,
+  (e <= fexp e)%Z ->
+  generic_format x ->
+  x = F2R (Float beta (Ztrunc (x * bpow (- fexp e))) (fexp e)).
+Proof.
+intros e x He Hx.
+pattern x at 2 ; rewrite Hx.
+unfold F2R at 2. simpl.
+rewrite Rmult_assoc, <- bpow_plus.
+assert (H: Z2R (Zpower beta (canonic_exp x + - fexp e)) = bpow (canonic_exp x + - fexp e)).
+apply Z2R_Zpower.
+unfold canonic_exp.
+set (ex := ln_beta beta x).
+generalize (exp_not_FTZ ex).
+generalize (proj2 (proj2 (valid_exp _) He) (fexp ex + 1)%Z).
+omega.
+rewrite <- H.
+rewrite <- Z2R_mult, Ztrunc_Z2R.
+unfold F2R. simpl.
+rewrite Z2R_mult.
+rewrite H.
+rewrite Rmult_assoc, <- bpow_plus.
+now ring_simplify (canonic_exp x + - fexp e + fexp e)%Z.
+Qed.
+
+End not_FTZ.
+
+Section monotone_exp.
+
+Class Monotone_exp :=
+  monotone_exp : forall ex ey, (ex <= ey)%Z -> (fexp ex <= fexp ey)%Z.
+
+Context { monotone_exp_ : Monotone_exp }.
+
+Global Instance monotone_exp_not_FTZ : Exp_not_FTZ.
+Proof.
+intros e.
+destruct (Z_lt_le_dec (fexp e) e) as [He|He].
+apply monotone_exp.
+now apply Zlt_le_succ.
+now apply valid_exp.
+Qed.
+
+Lemma canonic_exp_le_bpow :
+  forall (x : R) (e : Z),
+  x <> R0 ->
+  (Rabs x < bpow e)%R ->
+  (canonic_exp x <= fexp e)%Z.
+Proof.
+intros x e Zx Hx.
+apply monotone_exp.
+now apply ln_beta_le_bpow.
+Qed.
+
+Lemma canonic_exp_ge_bpow :
+  forall (x : R) (e : Z),
+  (bpow (e - 1) <= Rabs x)%R ->
+  (fexp e <= canonic_exp x)%Z.
+Proof.
+intros x e Hx.
+apply monotone_exp.
+rewrite (Zsucc_pred e).
+apply Zlt_le_succ.
+now apply ln_beta_gt_bpow.
+Qed.
+
+Variable rnd : R -> Z.
+Context { valid_rnd : Valid_rnd rnd }.
+
+Theorem ln_beta_round_ge :
+  forall x,
+  round rnd x <> R0 ->
+  (ln_beta beta x <= ln_beta beta (round rnd x))%Z.
+Proof with auto with typeclass_instances.
+intros x.
+destruct (round_ZR_or_AW rnd x) as [H|H] ; rewrite H ; clear H ; intros Zr.
+rewrite ln_beta_round_ZR with (1 := Zr).
+apply Zle_refl.
+apply ln_beta_le_abs.
+contradict Zr.
+rewrite Zr.
+apply round_0...
+rewrite <- round_AW_abs.
+rewrite round_AW_pos.
+apply round_UP_pt.
+apply Rabs_pos.
+Qed.
+
+Theorem canonic_exp_round_ge :
+  forall x,
+  round rnd x <> R0 ->
+  (canonic_exp x <= canonic_exp (round rnd x))%Z.
+Proof with auto with typeclass_instances.
+intros x Zr.
+unfold canonic_exp.
+apply monotone_exp.
+now apply ln_beta_round_ge.
+Qed.
+
+End monotone_exp.
+
+Section Znearest.
+
+(** Roundings to nearest: when in the middle, use the choice function *)
+Variable choice : Z -> bool.
+
+Definition Znearest x :=
+  match Rcompare (x - Z2R (Zfloor x)) (/2) with
+  | Lt => Zfloor x
+  | Eq => if choice (Zfloor x) then Zceil x else Zfloor x
+  | Gt => Zceil x
+  end.
+
+Theorem Znearest_DN_or_UP :
+  forall x,
+  Znearest x = Zfloor x \/ Znearest x = Zceil x.
+Proof.
+intros x.
+unfold Znearest.
+case Rcompare_spec ; intros _.
+now left.
+case choice.
+now right.
+now left.
+now right.
+Qed.
+
+Theorem Znearest_ge_floor :
+  forall x,
+  (Zfloor x <= Znearest x)%Z.
+Proof.
+intros x.
+destruct (Znearest_DN_or_UP x) as [Hx|Hx] ; rewrite Hx.
+apply Zle_refl.
+apply le_Z2R.
+apply Rle_trans with x.
+apply Zfloor_lb.
+apply Zceil_ub.
+Qed.
+
+Theorem Znearest_le_ceil :
+  forall x,
+  (Znearest x <= Zceil x)%Z.
+Proof.
+intros x.
+destruct (Znearest_DN_or_UP x) as [Hx|Hx] ; rewrite Hx.
+apply le_Z2R.
+apply Rle_trans with x.
+apply Zfloor_lb.
+apply Zceil_ub.
+apply Zle_refl.
+Qed.
+
+Global Instance valid_rnd_N : Valid_rnd Znearest.
+Proof.
+split.
+(* *)
+intros x y Hxy.
+destruct (Rle_or_lt (Z2R (Zceil x)) y) as [H|H].
+apply Zle_trans with (1 := Znearest_le_ceil x).
+apply Zle_trans with (2 := Znearest_ge_floor y).
+now apply Zfloor_lub.
+(* . *)
+assert (Hf: Zfloor y = Zfloor x).
+apply Zfloor_imp.
+split.
+apply Rle_trans with (2 := Zfloor_lb y).
+apply Z2R_le.
+now apply Zfloor_le.
+apply Rlt_le_trans with (1 := H).
+apply Z2R_le.
+apply Zceil_glb.
+apply Rlt_le.
+rewrite Z2R_plus.
+apply Zfloor_ub.
+(* . *)
+unfold Znearest at 1.
+case Rcompare_spec ; intro Hx.
+(* .. *)
+rewrite <- Hf.
+apply Znearest_ge_floor.
+(* .. *)
+unfold Znearest.
+rewrite Hf.
+case Rcompare_spec ; intro Hy.
+elim Rlt_not_le with (1 := Hy).
+rewrite <- Hx.
+now apply Rplus_le_compat_r.
+replace y with x.
+apply Zle_refl.
+apply Rplus_eq_reg_l with (- Z2R (Zfloor x))%R.
+rewrite 2!(Rplus_comm (- (Z2R (Zfloor x)))).
+change (x - Z2R (Zfloor x) = y - Z2R (Zfloor x))%R.
+now rewrite Hy.
+apply Zle_trans with (Zceil x).
+case choice.
+apply Zle_refl.
+apply le_Z2R.
+apply Rle_trans with x.
+apply Zfloor_lb.
+apply Zceil_ub.
+now apply Zceil_le.
+(* .. *)
+unfold Znearest.
+rewrite Hf.
+rewrite Rcompare_Gt.
+now apply Zceil_le.
+apply Rlt_le_trans with (1 := Hx).
+now apply Rplus_le_compat_r.
+(* *)
+intros n.
+unfold Znearest.
+rewrite Zfloor_Z2R.
+rewrite Rcompare_Lt.
+easy.
+unfold Rminus.
+rewrite Rplus_opp_r.
+apply Rinv_0_lt_compat.
+now apply (Z2R_lt 0 2).
+Qed.
+
+Theorem Rcompare_floor_ceil_mid :
+  forall x,
+  Z2R (Zfloor x) <> x ->
+  Rcompare (x - Z2R (Zfloor x)) (/ 2) = Rcompare (x - Z2R (Zfloor x)) (Z2R (Zceil x) - x).
+Proof.
+intros x Hx.
+rewrite Zceil_floor_neq with (1 := Hx).
+rewrite Z2R_plus. simpl.
+destruct (Rcompare_spec (x - Z2R (Zfloor x)) (/ 2)) as [H1|H1|H1] ; apply sym_eq.
+(* . *)
+apply Rcompare_Lt.
+apply Rplus_lt_reg_r with (x - Z2R (Zfloor x))%R.
+replace (x - Z2R (Zfloor x) + (x - Z2R (Zfloor x)))%R with ((x - Z2R (Zfloor x)) * 2)%R by ring.
+replace (x - Z2R (Zfloor x) + (Z2R (Zfloor x) + 1 - x))%R with (/2 * 2)%R by field.
+apply Rmult_lt_compat_r with (2 := H1).
+now apply (Z2R_lt 0 2).
+(* . *)
+apply Rcompare_Eq.
+replace (Z2R (Zfloor x) + 1 - x)%R with (1 - (x - Z2R (Zfloor x)))%R by ring.
+rewrite H1.
+field.
+(* . *)
+apply Rcompare_Gt.
+apply Rplus_lt_reg_r with (x - Z2R (Zfloor x))%R.
+replace (x - Z2R (Zfloor x) + (x - Z2R (Zfloor x)))%R with ((x - Z2R (Zfloor x)) * 2)%R by ring.
+replace (x - Z2R (Zfloor x) + (Z2R (Zfloor x) + 1 - x))%R with (/2 * 2)%R by field.
+apply Rmult_lt_compat_r with (2 := H1).
+now apply (Z2R_lt 0 2).
+Qed.
+
+Theorem Rcompare_ceil_floor_mid :
+  forall x,
+  Z2R (Zfloor x) <> x ->
+  Rcompare (Z2R (Zceil x) - x) (/ 2) = Rcompare (Z2R (Zceil x) - x) (x - Z2R (Zfloor x)).
+Proof.
+intros x Hx.
+rewrite Zceil_floor_neq with (1 := Hx).
+rewrite Z2R_plus. simpl.
+destruct (Rcompare_spec (Z2R (Zfloor x) + 1 - x) (/ 2)) as [H1|H1|H1] ; apply sym_eq.
+(* . *)
+apply Rcompare_Lt.
+apply Rplus_lt_reg_r with (Z2R (Zfloor x) + 1 - x)%R.
+replace (Z2R (Zfloor x) + 1 - x + (Z2R (Zfloor x) + 1 - x))%R with ((Z2R (Zfloor x) + 1 - x) * 2)%R by ring.
+replace (Z2R (Zfloor x) + 1 - x + (x - Z2R (Zfloor x)))%R with (/2 * 2)%R by field.
+apply Rmult_lt_compat_r with (2 := H1).
+now apply (Z2R_lt 0 2).
+(* . *)
+apply Rcompare_Eq.
+replace (x - Z2R (Zfloor x))%R with (1 - (Z2R (Zfloor x) + 1 - x))%R by ring.
+rewrite H1.
+field.
+(* . *)
+apply Rcompare_Gt.
+apply Rplus_lt_reg_r with (Z2R (Zfloor x) + 1 - x)%R.
+replace (Z2R (Zfloor x) + 1 - x + (Z2R (Zfloor x) + 1 - x))%R with ((Z2R (Zfloor x) + 1 - x) * 2)%R by ring.
+replace (Z2R (Zfloor x) + 1 - x + (x - Z2R (Zfloor x)))%R with (/2 * 2)%R by field.
+apply Rmult_lt_compat_r with (2 := H1).
+now apply (Z2R_lt 0 2).
+Qed.
+
+Theorem Znearest_N_strict :
+  forall x,
+  (x - Z2R (Zfloor x) <> /2)%R ->
+  (Rabs (x - Z2R (Znearest x)) < /2)%R.
+Proof.
+intros x Hx.
+unfold Znearest.
+case Rcompare_spec ; intros H.
+rewrite Rabs_pos_eq.
+exact H.
+apply Rle_0_minus.
+apply Zfloor_lb.
+now elim Hx.
+rewrite Rabs_left1.
+rewrite Ropp_minus_distr.
+rewrite Zceil_floor_neq.
+rewrite Z2R_plus.
+simpl.
+apply Ropp_lt_cancel.
+apply Rplus_lt_reg_r with R1.
+replace (1 + -/2)%R with (/2)%R by field.
+now replace (1 + - (Z2R (Zfloor x) + 1 - x))%R with (x - Z2R (Zfloor x))%R by ring.
+apply Rlt_not_eq.
+apply Rplus_lt_reg_r with (- Z2R (Zfloor x))%R.
+apply Rlt_trans with (/2)%R.
+rewrite Rplus_opp_l.
+apply Rinv_0_lt_compat.
+now apply (Z2R_lt 0 2).
+now rewrite <- (Rplus_comm x).
+apply Rle_minus.
+apply Zceil_ub.
+Qed.
+
+Theorem Znearest_N :
+  forall x,
+  (Rabs (x - Z2R (Znearest x)) <= /2)%R.
+Proof.
+intros x.
+destruct (Req_dec (x - Z2R (Zfloor x)) (/2)) as [Hx|Hx].
+assert (K: (Rabs (/2) <= /2)%R).
+apply Req_le.
+apply Rabs_pos_eq.
+apply Rlt_le.
+apply Rinv_0_lt_compat.
+now apply (Z2R_lt 0 2).
+destruct (Znearest_DN_or_UP x) as [H|H] ; rewrite H ; clear H.
+now rewrite Hx.
+rewrite Zceil_floor_neq.
+rewrite Z2R_plus.
+simpl.
+replace (x - (Z2R (Zfloor x) + 1))%R with (x - Z2R (Zfloor x) - 1)%R by ring.
+rewrite Hx.
+rewrite Rabs_minus_sym.
+now replace (1 - /2)%R with (/2)%R by field.
+apply Rlt_not_eq.
+apply Rplus_lt_reg_r with (- Z2R (Zfloor x))%R.
+rewrite Rplus_opp_l, Rplus_comm.
+fold (x - Z2R (Zfloor x))%R.
+rewrite Hx.
+apply Rinv_0_lt_compat.
+now apply (Z2R_lt 0 2).
+apply Rlt_le.
+now apply Znearest_N_strict.
+Qed.
+
+Theorem Znearest_imp :
+  forall x n,
+  (Rabs (x - Z2R n) < /2)%R ->
+  Znearest x = n.
+Proof.
+intros x n Hd.
+cut (Zabs (Znearest x - n) < 1)%Z.
+clear ; zify ; omega.
+apply lt_Z2R.
+rewrite Z2R_abs, Z2R_minus.
+replace (Z2R (Znearest x) - Z2R n)%R with (- (x - Z2R (Znearest x)) + (x - Z2R n))%R by ring.
+apply Rle_lt_trans with (1 := Rabs_triang _ _).
+simpl.
+replace R1 with (/2 + /2)%R by field.
+apply Rplus_le_lt_compat with (2 := Hd).
+rewrite Rabs_Ropp.
+apply Znearest_N.
+Qed.
+
+Theorem round_N_pt :
+  forall x,
+  Rnd_N_pt generic_format x (round Znearest x).
+Proof.
+intros x.
+set (d := round Zfloor x).
+set (u := round Zceil x).
+set (mx := scaled_mantissa x).
+set (bx := bpow (canonic_exp x)).
+(* . *)
+assert (H: (Rabs (round Znearest x - x) <= Rmin (x - d) (u - x))%R).
+pattern x at -1 ; rewrite <- scaled_mantissa_mult_bpow.
+unfold d, u, round, F2R. simpl.
+fold mx bx.
+rewrite <- 3!Rmult_minus_distr_r.
+rewrite Rabs_mult, (Rabs_pos_eq bx). 2: apply bpow_ge_0.
+rewrite <- Rmult_min_distr_r. 2: apply bpow_ge_0.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+unfold Znearest.
+destruct (Req_dec (Z2R (Zfloor mx)) mx) as [Hm|Hm].
+(* .. *)
+rewrite Hm.
+unfold Rminus at 2.
+rewrite Rplus_opp_r.
+rewrite Rcompare_Lt.
+rewrite Hm.
+unfold Rminus at -3.
+rewrite Rplus_opp_r.
+rewrite Rabs_R0.
+unfold Rmin.
+destruct (Rle_dec 0 (Z2R (Zceil mx) - mx)) as [H|H].
+apply Rle_refl.
+apply Rle_0_minus.
+apply Zceil_ub.
+apply Rinv_0_lt_compat.
+now apply (Z2R_lt 0 2).
+(* .. *)
+rewrite Rcompare_floor_ceil_mid with (1 := Hm).
+rewrite Rmin_compare.
+assert (H: (Rabs (mx - Z2R (Zfloor mx)) <= mx - Z2R (Zfloor mx))%R).
+rewrite Rabs_pos_eq.
+apply Rle_refl.
+apply Rle_0_minus.
+apply Zfloor_lb.
+case Rcompare_spec ; intros Hm'.
+now rewrite Rabs_minus_sym.
+case choice.
+rewrite <- Hm'.
+exact H.
+now rewrite Rabs_minus_sym.
+rewrite Rabs_pos_eq.
+apply Rle_refl.
+apply Rle_0_minus.
+apply Zceil_ub.
+(* . *)
+apply Rnd_DN_UP_pt_N with d u.
+apply generic_format_round.
+auto with typeclass_instances.
+now apply round_DN_pt.
+now apply round_UP_pt.
+apply Rle_trans with (1 := H).
+apply Rmin_l.
+apply Rle_trans with (1 := H).
+apply Rmin_r.
+Qed.
+
+Theorem round_N_middle :
+  forall x,
+  (x - round Zfloor x = round Zceil x - x)%R ->
+  round Znearest x = if choice (Zfloor (scaled_mantissa x)) then round Zceil x else round Zfloor x.
+Proof.
+intros x.
+pattern x at 1 4 ; rewrite <- scaled_mantissa_mult_bpow.
+unfold round, Znearest, F2R. simpl.
+destruct (Req_dec (Z2R (Zfloor (scaled_mantissa x))) (scaled_mantissa x)) as [Fx|Fx].
+(* *)
+intros _.
+rewrite <- Fx.
+rewrite Zceil_Z2R, Zfloor_Z2R.
+set (m := Zfloor (scaled_mantissa x)).
+now case (Rcompare (Z2R m - Z2R m) (/ 2)) ; case (choice m).
+(* *)
+intros H.
+rewrite Rcompare_floor_ceil_mid with (1 := Fx).
+rewrite Rcompare_Eq.
+now case choice.
+apply Rmult_eq_reg_r with (bpow (canonic_exp x)).
+now rewrite 2!Rmult_minus_distr_r.
+apply Rgt_not_eq.
+apply bpow_gt_0.
+Qed.
+
+End Znearest.
+
+Section rndNA.
+
+Global Instance valid_rnd_NA : Valid_rnd (Znearest (Zle_bool 0)) := valid_rnd_N _.
+
+Theorem round_NA_pt :
+  forall x,
+  Rnd_NA_pt generic_format x (round (Znearest (Zle_bool 0)) x).
+Proof.
+intros x.
+generalize (round_N_pt (Zle_bool 0) x).
+set (f := round (Znearest (Zle_bool 0)) x).
+intros Rxf.
+destruct (Req_dec (x - round Zfloor x) (round Zceil x - x)) as [Hm|Hm].
+(* *)
+apply Rnd_NA_N_pt.
+exact generic_format_0.
+exact Rxf.
+destruct (Rle_or_lt 0 x) as [Hx|Hx].
+(* . *)
+rewrite Rabs_pos_eq with (1 := Hx).
+rewrite Rabs_pos_eq.
+unfold f.
+rewrite round_N_middle with (1 := Hm).
+rewrite Zle_bool_true.
+apply (round_UP_pt x).
+apply Zfloor_lub.
+apply Rmult_le_pos with (1 := Hx).
+apply bpow_ge_0.
+apply Rnd_N_pt_pos with (2 := Hx) (3 := Rxf).
+exact generic_format_0.
+(* . *)
+rewrite Rabs_left with (1 := Hx).
+rewrite Rabs_left1.
+apply Ropp_le_contravar.
+unfold f.
+rewrite round_N_middle with (1 := Hm).
+rewrite Zle_bool_false.
+apply (round_DN_pt x).
+apply lt_Z2R.
+apply Rle_lt_trans with (scaled_mantissa x).
+apply Zfloor_lb.
+simpl.
+rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
+apply Rmult_lt_compat_r with (2 := Hx).
+apply bpow_gt_0.
+apply Rnd_N_pt_neg with (3 := Rxf).
+exact generic_format_0.
+now apply Rlt_le.
+(* *)
+split.
+apply Rxf.
+intros g Rxg.
+rewrite Rnd_N_pt_unicity with (3 := Hm) (4 := Rxf) (5 := Rxg).
+apply Rle_refl.
+apply round_DN_pt.
+apply round_UP_pt.
+Qed.
+
+End rndNA.
+
+Section rndN_opp.
+
+Theorem Znearest_opp :
+  forall choice x,
+  Znearest choice (- x) = (- Znearest (fun t => negb (choice (- (t + 1))%Z)) x)%Z.
+Proof with auto with typeclass_instances.
+intros choice x.
+destruct (Req_dec (Z2R (Zfloor x)) x) as [Hx|Hx].
+rewrite <- Hx.
+rewrite <- Z2R_opp.
+rewrite 2!Zrnd_Z2R...
+unfold Znearest.
+replace (- x - Z2R (Zfloor (-x)))%R with (Z2R (Zceil x) - x)%R.
+rewrite Rcompare_ceil_floor_mid with (1 := Hx).
+rewrite Rcompare_floor_ceil_mid with (1 := Hx).
+rewrite Rcompare_sym.
+rewrite <- Zceil_floor_neq with (1 := Hx).
+unfold Zceil.
+rewrite Ropp_involutive.
+case Rcompare ; simpl ; trivial.
+rewrite Zopp_involutive.
+case (choice (Zfloor (- x))) ; simpl ; trivial.
+now rewrite Zopp_involutive.
+now rewrite Zopp_involutive.
+unfold Zceil.
+rewrite Z2R_opp.
+apply Rplus_comm.
+Qed.
+
+Theorem round_N_opp :
+  forall choice,
+  forall x,
+  round (Znearest choice) (-x) = (- round (Znearest (fun t => negb (choice (- (t + 1))%Z))) x)%R.
+Proof.
+intros choice x.
+unfold round, F2R. simpl.
+rewrite canonic_exp_opp.
+rewrite scaled_mantissa_opp.
+rewrite Znearest_opp.
+rewrite Z2R_opp.
+now rewrite Ropp_mult_distr_l_reverse.
+Qed.
+
+End rndN_opp.
+
+End Format.
+
+(** Inclusion of a format into an extended format *)
+Section Inclusion.
+
+Variables fexp1 fexp2 : Z -> Z.
+
+Context { valid_exp1 : Valid_exp fexp1 }.
+Context { valid_exp2 : Valid_exp fexp2 }.
+
+Theorem generic_inclusion_ln_beta :
+  forall x,
+  ( x <> R0 -> (fexp2 (ln_beta beta x) <= fexp1 (ln_beta beta x))%Z ) ->
+  generic_format fexp1 x ->
+  generic_format fexp2 x.
+Proof.
+intros x He Fx.
+rewrite Fx.
+apply generic_format_F2R.
+intros Zx.
+rewrite <- Fx.
+apply He.
+contradict Zx.
+rewrite Zx, scaled_mantissa_0.
+apply (Ztrunc_Z2R 0).
+Qed.
+
+Theorem generic_inclusion_lt_ge :
+  forall e1 e2,
+  ( forall e, (e1 < e <= e2)%Z -> (fexp2 e <= fexp1 e)%Z ) ->
+  forall x,
+  (bpow e1 <= Rabs x < bpow e2)%R ->
+  generic_format fexp1 x ->
+  generic_format fexp2 x.
+Proof.
+intros e1 e2 He x (Hx1,Hx2).
+apply generic_inclusion_ln_beta.
+intros Zx.
+apply He.
+split.
+now apply ln_beta_gt_bpow.
+now apply ln_beta_le_bpow.
+Qed.
+
+Theorem generic_inclusion :
+  forall e,
+  (fexp2 e <= fexp1 e)%Z ->
+  forall x,
+  (bpow (e - 1) <= Rabs x <= bpow e)%R ->
+  generic_format fexp1 x ->
+  generic_format fexp2 x.
+Proof with auto with typeclass_instances.
+intros e He x (Hx1,[Hx2|Hx2]).
+apply generic_inclusion_ln_beta.
+now rewrite ln_beta_unique with (1 := conj Hx1 Hx2).
+intros Fx.
+apply generic_format_abs_inv.
+rewrite Hx2.
+apply generic_format_bpow'...
+apply Zle_trans with (1 := He).
+apply generic_format_bpow_inv...
+rewrite <- Hx2.
+now apply generic_format_abs.
+Qed.
+
+Theorem generic_inclusion_le_ge :
+  forall e1 e2,
+  (e1 < e2)%Z ->
+  ( forall e, (e1 < e <= e2)%Z -> (fexp2 e <= fexp1 e)%Z ) ->
+  forall x,
+  (bpow e1 <= Rabs x <= bpow e2)%R ->
+  generic_format fexp1 x ->
+  generic_format fexp2 x.
+Proof.
+intros e1 e2 He' He x (Hx1,[Hx2|Hx2]).
+(* *)
+apply generic_inclusion_ln_beta.
+intros Zx.
+apply He.
+split.
+now apply ln_beta_gt_bpow.
+now apply ln_beta_le_bpow.
+(* *)
+apply generic_inclusion with (e := e2).
+apply He.
+split.
+apply He'.
+apply Zle_refl.
+rewrite Hx2.
+split.
+apply bpow_le.
+apply Zle_pred.
+apply Rle_refl.
+Qed.
+
+Theorem generic_inclusion_le :
+  forall e2,
+  ( forall e, (e <= e2)%Z -> (fexp2 e <= fexp1 e)%Z ) ->
+  forall x,
+  (Rabs x <= bpow e2)%R ->
+  generic_format fexp1 x ->
+  generic_format fexp2 x.
+Proof.
+intros e2 He x [Hx|Hx].
+apply generic_inclusion_ln_beta.
+intros Zx.
+apply He.
+now apply ln_beta_le_bpow.
+apply generic_inclusion with (e := e2).
+apply He.
+apply Zle_refl.
+rewrite Hx.
+split.
+apply bpow_le.
+apply Zle_pred.
+apply Rle_refl.
+Qed.
+
+Theorem generic_inclusion_ge :
+  forall e1,
+  ( forall e, (e1 < e)%Z -> (fexp2 e <= fexp1 e)%Z ) ->
+  forall x,
+  (bpow e1 <= Rabs x)%R ->
+  generic_format fexp1 x ->
+  generic_format fexp2 x.
+Proof.
+intros e1 He x Hx.
+apply generic_inclusion_ln_beta.
+intros Zx.
+apply He.
+now apply ln_beta_gt_bpow.
+Qed.
+
+Variable rnd : R -> Z.
+Context { valid_rnd : Valid_rnd rnd }.
+
+Theorem generic_round_generic :
+  forall x,
+  generic_format fexp1 x ->
+  generic_format fexp1 (round fexp2 rnd x).
+Proof with auto with typeclass_instances.
+intros x Gx.
+apply generic_format_abs_inv.
+apply generic_format_abs in Gx.
+revert rnd valid_rnd x Gx.
+refine (round_abs_abs' _ (fun x y => generic_format fexp1 x -> generic_format fexp1 y) _).
+intros rnd valid_rnd x [Hx|Hx] Gx.
+(* x > 0 *)
+generalize (ln_beta_generic_gt _ x (Rgt_not_eq _ _ Hx) Gx).
+unfold canonic_exp.
+destruct (ln_beta beta x) as (ex,Ex) ; simpl.
+specialize (Ex (Rgt_not_eq _ _ Hx)).
+intros He'.
+rewrite Rabs_pos_eq in Ex by now apply Rlt_le.
+destruct (Zle_or_lt ex (fexp2 ex)) as [He|He].
+(* - x near 0 for fexp2 *)
+destruct (round_bounded_small_pos fexp2 rnd x ex He Ex) as [Hr|Hr].
+rewrite Hr.
+apply generic_format_0.
+rewrite Hr.
+apply generic_format_bpow'...
+apply Zlt_le_weak.
+apply valid_exp_large with ex...
+(* - x large for fexp2 *)
+destruct (Zle_or_lt (canonic_exp fexp2 x) (canonic_exp fexp1 x)) as [He''|He''].
+(* - - round fexp2 x is representable for fexp1 *)
+rewrite round_generic...
+rewrite Gx.
+apply generic_format_F2R.
+fold (round fexp1 Ztrunc x).
+intros Zx.
+unfold canonic_exp at 1.
+rewrite ln_beta_round_ZR...
+contradict Zx.
+apply F2R_eq_0_reg with (1 := Zx).
+(* - - round fexp2 x has too many digits for fexp1 *)
+destruct (round_bounded_large_pos fexp2 rnd x ex He Ex) as (Hr1,[Hr2|Hr2]).
+apply generic_format_F2R.
+intros Zx.
+fold (round fexp2 rnd x).
+unfold canonic_exp at 1.
+rewrite ln_beta_unique_pos with (1 := conj Hr1 Hr2).
+rewrite <- ln_beta_unique_pos with (1 := Ex).
+now apply Zlt_le_weak.
+rewrite Hr2.
+apply generic_format_bpow'...
+now apply Zlt_le_weak.
+(* x = 0 *)
+rewrite <- Hx, round_0...
+apply generic_format_0.
+Qed.
+
+End Inclusion.
+
+End Generic.
+
+Notation ZnearestA := (Znearest (Zle_bool 0)).
+
+(** Notations for backward-compatibility with Flocq 1.4. *)
+Notation rndDN := Zfloor (only parsing).
+Notation rndUP := Zceil (only parsing).
+Notation rndZR := Ztrunc (only parsing).
+Notation rndNA := ZnearestA (only parsing).
diff --git a/flocq/Core/Fcore_rnd.v b/flocq/Core/Fcore_rnd.v
new file mode 100644
index 0000000..6b4d807
--- /dev/null
+++ b/flocq/Core/Fcore_rnd.v
@@ -0,0 +1,1394 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Roundings: properties and/or functions *)
+Require Import Fcore_Raux.
+Require Import Fcore_defs.
+
+Section RND_prop.
+
+Open Scope R_scope.
+
+Theorem round_val_of_pred :
+  forall rnd : R -> R -> Prop,
+  round_pred rnd ->
+  forall x, { f : R | rnd x f }.
+Proof.
+intros rnd (H1,H2) x.
+specialize (H1 x).
+(* . *)
+assert (H3 : bound (rnd x)).
+destruct H1 as (f, H1).
+exists f.
+intros g Hg.
+now apply H2 with (3 := Rle_refl x).
+(* . *)
+exists (projT1 (completeness _ H3 H1)).
+destruct completeness as (f1, (H4, H5)).
+simpl.
+destruct H1 as (f2, H1).
+assert (f1 = f2).
+apply Rle_antisym.
+apply H5.
+intros f3 H.
+now apply H2 with (3 := Rle_refl x).
+now apply H4.
+now rewrite H.
+Qed.
+
+Theorem round_fun_of_pred :
+  forall rnd : R -> R -> Prop,
+  round_pred rnd ->
+  { f : R -> R | forall x, rnd x (f x) }.
+Proof.
+intros rnd H.
+exists (fun x => projT1 (round_val_of_pred rnd H x)).
+intros x.
+now destruct round_val_of_pred as (f, H1).
+Qed.
+
+Theorem round_unicity :
+  forall rnd : R -> R -> Prop,
+  round_pred_monotone rnd ->
+  forall x f1 f2,
+  rnd x f1 ->
+  rnd x f2 ->
+  f1 = f2.
+Proof.
+intros rnd Hr x f1 f2 H1 H2.
+apply Rle_antisym.
+now apply Hr with (3 := Rle_refl x).
+now apply Hr with (3 := Rle_refl x).
+Qed.
+
+Theorem Rnd_DN_pt_monotone :
+  forall F : R -> Prop,
+  round_pred_monotone (Rnd_DN_pt F).
+Proof.
+intros F x y f g (Hx1,(Hx2,_)) (Hy1,(_,Hy2)) Hxy.
+apply Hy2.
+apply Hx1.
+now apply Rle_trans with (2 := Hxy).
+Qed.
+
+Theorem Rnd_DN_pt_unicity :
+  forall F : R -> Prop,
+  forall x f1 f2 : R,
+  Rnd_DN_pt F x f1 -> Rnd_DN_pt F x f2 ->
+  f1 = f2.
+Proof.
+intros F.
+apply round_unicity.
+apply Rnd_DN_pt_monotone.
+Qed.
+
+Theorem Rnd_DN_unicity :
+  forall F : R -> Prop,
+  forall rnd1 rnd2 : R -> R,
+  Rnd_DN F rnd1 -> Rnd_DN F rnd2 ->
+  forall x, rnd1 x = rnd2 x.
+Proof.
+intros F rnd1 rnd2 H1 H2 x.
+now eapply Rnd_DN_pt_unicity.
+Qed.
+
+Theorem Rnd_UP_pt_monotone :
+  forall F : R -> Prop,
+  round_pred_monotone (Rnd_UP_pt F).
+Proof.
+intros F x y f g (Hx1,(_,Hx2)) (Hy1,(Hy2,_)) Hxy.
+apply Hx2.
+apply Hy1.
+now apply Rle_trans with (1 := Hxy).
+Qed.
+
+Theorem Rnd_UP_pt_unicity :
+  forall F : R -> Prop,
+  forall x f1 f2 : R,
+  Rnd_UP_pt F x f1 -> Rnd_UP_pt F x f2 ->
+  f1 = f2.
+Proof.
+intros F.
+apply round_unicity.
+apply Rnd_UP_pt_monotone.
+Qed.
+
+Theorem Rnd_UP_unicity :
+  forall F : R -> Prop,
+  forall rnd1 rnd2 : R -> R,
+  Rnd_UP F rnd1 -> Rnd_UP F rnd2 ->
+  forall x, rnd1 x = rnd2 x.
+Proof.
+intros F rnd1 rnd2 H1 H2 x.
+now eapply Rnd_UP_pt_unicity.
+Qed.
+
+Theorem Rnd_DN_UP_pt_sym :
+  forall F : R -> Prop,
+  ( forall x, F x -> F (- x) ) ->
+  forall x f : R,
+  Rnd_DN_pt F x f -> Rnd_UP_pt F (-x) (-f).
+Proof.
+intros F HF x f H.
+repeat split.
+apply HF.
+apply H.
+apply Ropp_le_contravar.
+apply H.
+intros g Hg.
+rewrite <- (Ropp_involutive g).
+intros Hxg.
+apply Ropp_le_contravar.
+apply H.
+now apply HF.
+now apply Ropp_le_cancel.
+Qed.
+
+Theorem Rnd_UP_DN_pt_sym :
+  forall F : R -> Prop,
+  ( forall x, F x -> F (- x) ) ->
+  forall x f : R,
+  Rnd_UP_pt F x f -> Rnd_DN_pt F (-x) (-f).
+Proof.
+intros F HF x f H.
+repeat split.
+apply HF.
+apply H.
+apply Ropp_le_contravar.
+apply H.
+intros g Hg.
+rewrite <- (Ropp_involutive g).
+intros Hxg.
+apply Ropp_le_contravar.
+apply H.
+now apply HF.
+now apply Ropp_le_cancel.
+Qed.
+
+Theorem Rnd_DN_UP_sym :
+  forall F : R -> Prop,
+  ( forall x, F x -> F (- x) ) ->
+  forall rnd1 rnd2 : R -> R,
+  Rnd_DN F rnd1 -> Rnd_UP F rnd2 ->
+  forall x, rnd1 (- x) = - rnd2 x.
+Proof.
+intros F HF rnd1 rnd2 H1 H2 x.
+rewrite <- (Ropp_involutive (rnd1 (-x))).
+apply f_equal.
+apply (Rnd_UP_unicity F (fun x => - rnd1 (-x))) ; trivial.
+intros y.
+pattern y at 1 ; rewrite <- Ropp_involutive.
+apply Rnd_DN_UP_pt_sym.
+apply HF.
+apply H1.
+Qed.
+
+Theorem Rnd_DN_UP_pt_split :
+  forall F : R -> Prop,
+  forall x d u,
+  Rnd_DN_pt F x d ->
+  Rnd_UP_pt F x u ->
+  forall f, F f ->
+  (f <= d) \/ (u <= f).
+Proof.
+intros F x d u Hd Hu f Hf.
+destruct (Rle_or_lt f x).
+left.
+now apply Hd.
+right.
+assert (H' := Rlt_le _ _ H).
+now apply Hu.
+Qed.
+
+Theorem Rnd_DN_pt_refl :
+  forall F : R -> Prop,
+  forall x : R, F x ->
+  Rnd_DN_pt F x x.
+Proof.
+intros F x Hx.
+repeat split.
+exact Hx.
+apply Rle_refl.
+now intros.
+Qed.
+
+Theorem Rnd_DN_pt_idempotent :
+  forall F : R -> Prop,
+  forall x f : R,
+  Rnd_DN_pt F x f -> F x ->
+  f = x.
+Proof.
+intros F x f (_,(Hx1,Hx2)) Hx.
+apply Rle_antisym.
+exact Hx1.
+apply Hx2.
+exact Hx.
+apply Rle_refl.
+Qed.
+
+Theorem Rnd_UP_pt_refl :
+  forall F : R -> Prop,
+  forall x : R, F x ->
+  Rnd_UP_pt F x x.
+Proof.
+intros F x Hx.
+repeat split.
+exact Hx.
+apply Rle_refl.
+now intros.
+Qed.
+
+Theorem Rnd_UP_pt_idempotent :
+  forall F : R -> Prop,
+  forall x f : R,
+  Rnd_UP_pt F x f -> F x ->
+  f = x.
+Proof.
+intros F x f (_,(Hx1,Hx2)) Hx.
+apply Rle_antisym.
+apply Hx2.
+exact Hx.
+apply Rle_refl.
+exact Hx1.
+Qed.
+
+Theorem Only_DN_or_UP :
+  forall F : R -> Prop,
+  forall x fd fu f : R,
+  Rnd_DN_pt F x fd -> Rnd_UP_pt F x fu ->
+  F f -> (fd <= f <= fu)%R ->
+  f = fd \/ f = fu.
+Proof.
+intros F x fd fu f Hd Hu Hf ([Hdf|Hdf], Hfu).
+2 : now left.
+destruct Hfu.
+2 : now right.
+destruct (Rle_or_lt x f).
+elim Rlt_not_le with (1 := H).
+now apply Hu.
+elim Rlt_not_le with (1 := Hdf).
+apply Hd ; auto with real.
+Qed.
+
+Theorem Rnd_ZR_abs :
+  forall (F : R -> Prop) (rnd: R-> R),
+  Rnd_ZR F rnd ->
+  forall x : R,  (Rabs (rnd x) <= Rabs x)%R.
+Proof.
+intros F rnd H x.
+assert (F 0%R).
+replace 0%R with (rnd 0%R).
+eapply H.
+apply Rle_refl.
+destruct (H 0%R) as (H1, H2).
+apply Rle_antisym.
+apply H1.
+apply Rle_refl.
+apply H2.
+apply Rle_refl.
+(* . *)
+destruct (Rle_or_lt 0 x).
+(* positive *)
+rewrite Rabs_right.
+rewrite Rabs_right; auto with real.
+now apply (proj1 (H x)).
+apply Rle_ge.
+now apply (proj1 (H x)).
+(* negative *)
+rewrite Rabs_left1.
+rewrite Rabs_left1 ; auto with real.
+apply Ropp_le_contravar.
+apply (proj2 (H x)).
+auto with real.
+apply (proj2 (H x)) ; auto with real.
+Qed.
+
+Theorem Rnd_ZR_pt_monotone :
+  forall F : R -> Prop, F 0 ->
+  round_pred_monotone (Rnd_ZR_pt F).
+Proof.
+intros F F0 x y f g (Hx1, Hx2) (Hy1, Hy2) Hxy.
+destruct (Rle_or_lt 0 x) as [Hx|Hx].
+(* . *)
+apply Hy1.
+now apply Rle_trans with x.
+now apply Hx1.
+apply Rle_trans with (2 := Hxy).
+now apply Hx1.
+(* . *)
+apply Rlt_le in Hx.
+destruct (Rle_or_lt 0 y) as [Hy|Hy].
+apply Rle_trans with 0.
+now apply Hx2.
+now apply Hy1.
+apply Rlt_le in Hy.
+apply Hx2.
+exact Hx.
+now apply Hy2.
+apply Rle_trans with (1 := Hxy).
+now apply Hy2.
+Qed.
+
+Theorem Rnd_N_pt_DN_or_UP :
+  forall F : R -> Prop,
+  forall x f : R,
+  Rnd_N_pt F x f ->
+  Rnd_DN_pt F x f \/ Rnd_UP_pt F x f.
+Proof.
+intros F x f (Hf1,Hf2).
+destruct (Rle_or_lt x f) as [Hxf|Hxf].
+(* . *)
+right.
+repeat split ; try assumption.
+intros g Hg Hxg.
+specialize (Hf2 g Hg).
+rewrite 2!Rabs_pos_eq in Hf2.
+now apply Rplus_le_reg_r with (-x)%R.
+now apply Rle_0_minus.
+now apply Rle_0_minus.
+(* . *)
+left.
+repeat split ; try assumption.
+now apply Rlt_le.
+intros g Hg Hxg.
+specialize (Hf2 g Hg).
+rewrite 2!Rabs_left1 in Hf2.
+generalize (Ropp_le_cancel _ _ Hf2).
+intros H.
+now apply Rplus_le_reg_r with (-x)%R.
+now apply Rle_minus.
+apply Rlt_le.
+now apply Rlt_minus.
+Qed.
+
+Theorem Rnd_N_pt_DN_or_UP_eq :
+  forall F : R -> Prop,
+  forall x fd fu f : R,
+  Rnd_DN_pt F x fd -> Rnd_UP_pt F x fu ->
+  Rnd_N_pt F x f ->
+  f = fd \/ f = fu.
+Proof.
+intros F x fd fu f Hd Hu Hf.
+destruct (Rnd_N_pt_DN_or_UP F x f Hf) as [H|H].
+left.
+apply Rnd_DN_pt_unicity with (1 := H) (2 := Hd).
+right.
+apply Rnd_UP_pt_unicity with (1 := H) (2 := Hu).
+Qed.
+
+Theorem Rnd_N_pt_sym :
+  forall F : R -> Prop,
+  ( forall x, F x -> F (- x) ) ->
+  forall x f : R,
+  Rnd_N_pt F (-x) (-f) -> Rnd_N_pt F x f.
+Proof.
+intros F HF x f (H1,H2).
+rewrite <- (Ropp_involutive f).
+repeat split.
+apply HF.
+apply H1.
+intros g H3.
+rewrite Ropp_involutive.
+replace (f - x)%R with (-(-f - -x))%R by ring.
+replace (g - x)%R with (-(-g - -x))%R by ring.
+rewrite 2!Rabs_Ropp.
+apply H2.
+now apply HF.
+Qed.
+
+Theorem Rnd_N_pt_monotone :
+  forall F : R -> Prop,
+  forall x y f g : R,
+  Rnd_N_pt F x f -> Rnd_N_pt F y g ->
+  x < y -> f <= g.
+Proof.
+intros F x y f g (Hf,Hx) (Hg,Hy) Hxy.
+apply Rnot_lt_le.
+intros Hgf.
+assert (Hfgx := Hx g Hg).
+assert (Hgfy := Hy f Hf).
+clear F Hf Hg Hx Hy.
+destruct (Rle_or_lt x g) as [Hxg|Hgx].
+(* x <= g < f *)
+apply Rle_not_lt with (1 := Hfgx).
+rewrite 2!Rabs_pos_eq.
+now apply Rplus_lt_compat_r.
+apply Rle_0_minus.
+apply Rlt_le.
+now apply Rle_lt_trans with (1 := Hxg).
+now apply Rle_0_minus.
+assert (Hgy := Rlt_trans _ _ _ Hgx Hxy).
+destruct (Rle_or_lt f y) as [Hfy|Hyf].
+(* g < f <= y *)
+apply Rle_not_lt with (1 := Hgfy).
+rewrite (Rabs_left (g - y)).
+2: now apply Rlt_minus.
+rewrite Rabs_left1.
+apply Ropp_lt_contravar.
+now apply Rplus_lt_compat_r.
+now apply Rle_minus.
+(* g < x < y < f *)
+rewrite Rabs_left, Rabs_pos_eq, Ropp_minus_distr in Hgfy.
+rewrite Rabs_pos_eq, Rabs_left, Ropp_minus_distr in Hfgx.
+apply Rle_not_lt with (1 := Rplus_le_compat _ _ _ _ Hfgx Hgfy).
+apply Rminus_lt.
+ring_simplify.
+apply Rlt_minus.
+apply Rmult_lt_compat_l.
+now apply (Z2R_lt 0 2).
+exact Hxy.
+now apply Rlt_minus.
+apply Rle_0_minus.
+apply Rlt_le.
+now apply Rlt_trans with (1 := Hxy).
+apply Rle_0_minus.
+now apply Rlt_le.
+now apply Rlt_minus.
+Qed.
+
+Theorem Rnd_N_pt_unicity :
+  forall F : R -> Prop,
+  forall x d u f1 f2 : R,
+  Rnd_DN_pt F x d ->
+  Rnd_UP_pt F x u ->
+  x - d <> u - x ->
+  Rnd_N_pt F x f1 ->
+  Rnd_N_pt F x f2 ->
+  f1 = f2.
+Proof.
+intros F x d u f1 f2 Hd Hu Hdu.
+assert (forall f1 f2, Rnd_N_pt F x f1 -> Rnd_N_pt F x f2 -> f1 < f2 -> False).
+clear f1 f2. intros f1 f2 Hf1 Hf2 H12.
+destruct (Rnd_N_pt_DN_or_UP F x f1 Hf1) as [Hd1|Hu1] ;
+  destruct (Rnd_N_pt_DN_or_UP F x f2 Hf2) as [Hd2|Hu2].
+apply Rlt_not_eq with (1 := H12).
+now apply Rnd_DN_pt_unicity with (1 := Hd1).
+apply Hdu.
+rewrite Rnd_DN_pt_unicity with (1 := Hd) (2 := Hd1).
+rewrite Rnd_UP_pt_unicity with (1 := Hu) (2 := Hu2).
+rewrite <- (Rabs_pos_eq (x - f1)).
+rewrite <- (Rabs_pos_eq (f2 - x)).
+rewrite Rabs_minus_sym.
+apply Rle_antisym.
+apply Hf1. apply Hf2.
+apply Hf2. apply Hf1.
+apply Rle_0_minus.
+apply Hu2.
+apply Rle_0_minus.
+apply Hd1.
+apply Rlt_not_le with (1 := H12).
+apply Rle_trans with x.
+apply Hd2.
+apply Hu1.
+apply Rgt_not_eq with (1 := H12).
+now apply Rnd_UP_pt_unicity with (1 := Hu2).
+intros Hf1 Hf2.
+now apply Rle_antisym ; apply Rnot_lt_le ; refine (H _ _ _ _).
+Qed.
+
+Theorem Rnd_N_pt_refl :
+  forall F : R -> Prop,
+  forall x : R, F x ->
+  Rnd_N_pt F x x.
+Proof.
+intros F x Hx.
+repeat split.
+exact Hx.
+intros g _.
+unfold Rminus at 1.
+rewrite Rplus_opp_r, Rabs_R0.
+apply Rabs_pos.
+Qed.
+
+Theorem Rnd_N_pt_idempotent :
+  forall F : R -> Prop,
+  forall x f : R,
+  Rnd_N_pt F x f -> F x ->
+  f = x.
+Proof.
+intros F x f (_,Hf) Hx.
+apply Rminus_diag_uniq.
+destruct (Req_dec (f - x) 0) as [H|H].
+exact H.
+elim Rabs_no_R0 with (1 := H).
+apply Rle_antisym.
+replace 0 with (Rabs (x - x)).
+now apply Hf.
+unfold Rminus.
+rewrite Rplus_opp_r.
+apply Rabs_R0.
+apply Rabs_pos.
+Qed.
+
+Theorem Rnd_N_pt_0 :
+  forall F : R -> Prop,
+  F 0 ->
+  Rnd_N_pt F 0 0.
+Proof.
+intros F HF.
+split.
+exact HF.
+intros g _.
+rewrite 2!Rminus_0_r, Rabs_R0.
+apply Rabs_pos.
+Qed.
+
+Theorem Rnd_N_pt_pos :
+  forall F : R -> Prop, F 0 ->
+  forall x f, 0 <= x ->
+  Rnd_N_pt F x f ->
+  0 <= f.
+Proof.
+intros F HF x f [Hx|Hx] Hxf.
+eapply Rnd_N_pt_monotone ; try eassumption.
+now apply Rnd_N_pt_0.
+right.
+apply sym_eq.
+apply Rnd_N_pt_idempotent with F.
+now rewrite Hx.
+exact HF.
+Qed.
+
+Theorem Rnd_N_pt_neg :
+  forall F : R -> Prop, F 0 ->
+  forall x f, x <= 0 ->
+  Rnd_N_pt F x f ->
+  f <= 0.
+Proof.
+intros F HF x f [Hx|Hx] Hxf.
+eapply Rnd_N_pt_monotone ; try eassumption.
+now apply Rnd_N_pt_0.
+right.
+apply Rnd_N_pt_idempotent with F.
+now rewrite <- Hx.
+exact HF.
+Qed.
+
+Theorem Rnd_N_pt_abs :
+  forall F : R -> Prop,
+  F 0 ->
+  ( forall x, F x -> F (- x) ) ->
+  forall x f : R,
+  Rnd_N_pt F x f -> Rnd_N_pt F (Rabs x) (Rabs f).
+Proof.
+intros F HF0 HF x f Hxf.
+unfold Rabs at 1.
+destruct (Rcase_abs x) as [Hx|Hx].
+rewrite Rabs_left1.
+apply Rnd_N_pt_sym.
+exact HF.
+now rewrite 2!Ropp_involutive.
+apply Rnd_N_pt_neg with (3 := Hxf).
+exact HF0.
+now apply Rlt_le.
+rewrite Rabs_pos_eq.
+exact Hxf.
+apply Rnd_N_pt_pos with (3 := Hxf).
+exact HF0.
+now apply Rge_le.
+Qed.
+
+Theorem Rnd_DN_UP_pt_N :
+  forall F : R -> Prop,
+  forall x d u f : R,
+  F f ->
+  Rnd_DN_pt F x d ->
+  Rnd_UP_pt F x u ->
+  (Rabs (f - x) <= x - d)%R ->
+  (Rabs (f - x) <= u - x)%R ->
+  Rnd_N_pt F x f.
+Proof.
+intros F x d u f Hf Hxd Hxu Hd Hu.
+split.
+exact Hf.
+intros g Hg.
+destruct (Rnd_DN_UP_pt_split F x d u Hxd Hxu g Hg) as [Hgd|Hgu].
+(* g <= d *)
+apply Rle_trans with (1 := Hd).
+rewrite Rabs_left1.
+rewrite Ropp_minus_distr.
+apply Rplus_le_compat_l.
+now apply Ropp_le_contravar.
+apply Rle_minus.
+apply Rle_trans with (1 := Hgd).
+apply Hxd.
+(* u <= g *)
+apply Rle_trans with (1 := Hu).
+rewrite Rabs_pos_eq.
+now apply Rplus_le_compat_r.
+apply Rle_0_minus.
+apply Rle_trans with (2 := Hgu).
+apply Hxu.
+Qed.
+
+Theorem Rnd_DN_pt_N :
+  forall F : R -> Prop,
+  forall x d u : R,
+  Rnd_DN_pt F x d ->
+  Rnd_UP_pt F x u ->
+  (x - d <= u - x)%R ->
+  Rnd_N_pt F x d.
+Proof.
+intros F x d u Hd Hu Hx.
+assert (Hdx: (Rabs (d - x) = x - d)%R).
+rewrite Rabs_minus_sym.
+apply Rabs_pos_eq.
+apply Rle_0_minus.
+apply Hd.
+apply Rnd_DN_UP_pt_N with (2 := Hd) (3 := Hu).
+apply Hd.
+rewrite Hdx.
+apply Rle_refl.
+now rewrite Hdx.
+Qed.
+
+Theorem Rnd_UP_pt_N :
+  forall F : R -> Prop,
+  forall x d u : R,
+  Rnd_DN_pt F x d ->
+  Rnd_UP_pt F x u ->
+  (u - x <= x - d)%R ->
+  Rnd_N_pt F x u.
+Proof.
+intros F x d u Hd Hu Hx.
+assert (Hux: (Rabs (u - x) = u - x)%R).
+apply Rabs_pos_eq.
+apply Rle_0_minus.
+apply Hu.
+apply Rnd_DN_UP_pt_N with (2 := Hd) (3 := Hu).
+apply Hu.
+now rewrite Hux.
+rewrite Hux.
+apply Rle_refl.
+Qed.
+
+Definition Rnd_NG_pt_unicity_prop F P :=
+  forall x d u,
+  Rnd_DN_pt F x d -> Rnd_N_pt F x d ->
+  Rnd_UP_pt F x u -> Rnd_N_pt F x u ->
+  P x d -> P x u -> d = u.
+
+Theorem Rnd_NG_pt_unicity :
+  forall (F : R -> Prop) (P : R -> R -> Prop),
+  Rnd_NG_pt_unicity_prop F P ->
+  forall x f1 f2 : R,
+  Rnd_NG_pt F P x f1 -> Rnd_NG_pt F P x f2 ->
+  f1 = f2.
+Proof.
+intros F P HP x f1 f2 (H1a,H1b) (H2a,H2b).
+destruct H1b as [H1b|H1b].
+destruct H2b as [H2b|H2b].
+destruct (Rnd_N_pt_DN_or_UP _ _ _ H1a) as [H1c|H1c] ;
+  destruct (Rnd_N_pt_DN_or_UP _ _ _ H2a) as [H2c|H2c].
+eapply Rnd_DN_pt_unicity ; eassumption.
+now apply (HP x f1 f2).
+apply sym_eq.
+now apply (HP x f2 f1 H2c H2a H1c H1a).
+eapply Rnd_UP_pt_unicity ; eassumption.
+now apply H2b.
+apply sym_eq.
+now apply H1b.
+Qed.
+
+Theorem Rnd_NG_pt_monotone :
+  forall (F : R -> Prop) (P : R -> R -> Prop),
+  Rnd_NG_pt_unicity_prop F P ->
+  round_pred_monotone (Rnd_NG_pt F P).
+Proof.
+intros F P HP x y f g (Hf,Hx) (Hg,Hy) [Hxy|Hxy].
+now apply Rnd_N_pt_monotone with F x y.
+apply Req_le.
+rewrite <- Hxy in Hg, Hy.
+eapply Rnd_NG_pt_unicity ; try split ; eassumption.
+Qed.
+
+Theorem Rnd_NG_pt_refl :
+  forall (F : R -> Prop) (P : R -> R -> Prop),
+  forall x, F x -> Rnd_NG_pt F P x x.
+Proof.
+intros F P x Hx.
+split.
+now apply Rnd_N_pt_refl.
+right.
+intros f2 Hf2.
+now apply Rnd_N_pt_idempotent with F.
+Qed.
+
+Theorem Rnd_NG_pt_sym :
+  forall (F : R -> Prop) (P : R -> R -> Prop),
+  ( forall x, F x -> F (-x) ) ->
+  ( forall x f, P x f -> P (-x) (-f) ) ->
+  forall x f : R,
+  Rnd_NG_pt F P (-x) (-f) -> Rnd_NG_pt F P x f.
+Proof.
+intros F P HF HP x f (H1,H2).
+split.
+now apply Rnd_N_pt_sym.
+destruct H2 as [H2|H2].
+left.
+rewrite <- (Ropp_involutive x), <- (Ropp_involutive f).
+now apply HP.
+right.
+intros f2 Hxf2.
+rewrite <- (Ropp_involutive f).
+rewrite <- H2 with (-f2).
+apply sym_eq.
+apply Ropp_involutive.
+apply Rnd_N_pt_sym.
+exact HF.
+now rewrite 2!Ropp_involutive.
+Qed.
+
+Theorem Rnd_NG_unicity :
+  forall (F : R -> Prop) (P : R -> R -> Prop),
+  Rnd_NG_pt_unicity_prop F P ->
+  forall rnd1 rnd2 : R -> R,
+  Rnd_NG F P rnd1 -> Rnd_NG F P rnd2 ->
+  forall x, rnd1 x = rnd2 x.
+Proof.
+intros F P HP rnd1 rnd2 H1 H2 x.
+now apply Rnd_NG_pt_unicity with F P x.
+Qed.
+
+Theorem Rnd_NA_NG_pt :
+  forall F : R -> Prop,
+  F 0 ->
+  forall x f,
+  Rnd_NA_pt F x f <-> Rnd_NG_pt F (fun x f => Rabs x <= Rabs f) x f.
+Proof.
+intros F HF x f.
+destruct (Rle_or_lt 0 x) as [Hx|Hx].
+(* *)
+split ; intros (H1, H2).
+(* . *)
+assert (Hf := Rnd_N_pt_pos F HF x f Hx H1).
+split.
+exact H1.
+destruct (Rnd_N_pt_DN_or_UP _ _ _ H1) as [H3|H3].
+(* . . *)
+right.
+intros f2 Hxf2.
+specialize (H2 _ Hxf2).
+destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H4|H4].
+eapply Rnd_DN_pt_unicity ; eassumption.
+apply Rle_antisym.
+rewrite Rabs_pos_eq with (1 := Hf) in H2.
+rewrite Rabs_pos_eq in H2.
+exact H2.
+now apply Rnd_N_pt_pos with F x.
+apply Rle_trans with x.
+apply H3.
+apply H4.
+(* . . *)
+left.
+rewrite Rabs_pos_eq with (1 := Hf).
+rewrite Rabs_pos_eq with (1 := Hx).
+apply H3.
+(* . *)
+split.
+exact H1.
+intros f2 Hxf2.
+destruct H2 as [H2|H2].
+assert (Hf := Rnd_N_pt_pos F HF x f Hx H1).
+assert (Hf2 := Rnd_N_pt_pos F HF x f2 Hx Hxf2).
+rewrite 2!Rabs_pos_eq ; trivial.
+rewrite 2!Rabs_pos_eq in H2 ; trivial.
+destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H3|H3].
+apply Rle_trans with (2 := H2).
+apply H3.
+apply H3.
+apply H1.
+apply H2.
+rewrite (H2 _ Hxf2).
+apply Rle_refl.
+(* *)
+assert (Hx' := Rlt_le _ _ Hx).
+clear Hx. rename Hx' into Hx.
+split ; intros (H1, H2).
+(* . *)
+assert (Hf := Rnd_N_pt_neg F HF x f Hx H1).
+split.
+exact H1.
+destruct (Rnd_N_pt_DN_or_UP _ _ _ H1) as [H3|H3].
+(* . . *)
+left.
+rewrite Rabs_left1 with (1 := Hf).
+rewrite Rabs_left1 with (1 := Hx).
+apply Ropp_le_contravar.
+apply H3.
+(* . . *)
+right.
+intros f2 Hxf2.
+specialize (H2 _ Hxf2).
+destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H4|H4].
+apply Rle_antisym.
+apply Rle_trans with x.
+apply H4.
+apply H3.
+rewrite Rabs_left1 with (1 := Hf) in H2.
+rewrite Rabs_left1 in H2.
+now apply Ropp_le_cancel.
+now apply Rnd_N_pt_neg with F x.
+eapply Rnd_UP_pt_unicity ; eassumption.
+(* . *)
+split.
+exact H1.
+intros f2 Hxf2.
+destruct H2 as [H2|H2].
+assert (Hf := Rnd_N_pt_neg F HF x f Hx H1).
+assert (Hf2 := Rnd_N_pt_neg F HF x f2 Hx Hxf2).
+rewrite 2!Rabs_left1 ; trivial.
+rewrite 2!Rabs_left1 in H2 ; trivial.
+apply Ropp_le_contravar.
+apply Ropp_le_cancel in H2.
+destruct (Rnd_N_pt_DN_or_UP _ _ _ Hxf2) as [H3|H3].
+apply H3.
+apply H1.
+apply H2.
+apply Rle_trans with (1 := H2).
+apply H3.
+rewrite (H2 _ Hxf2).
+apply Rle_refl.
+Qed.
+
+Theorem Rnd_NA_pt_unicity_prop :
+  forall F : R -> Prop,
+  F 0 ->
+  Rnd_NG_pt_unicity_prop F (fun a b => (Rabs a <= Rabs b)%R).
+Proof.
+intros F HF x d u Hxd1 Hxd2 Hxu1 Hxu2 Hd Hu.
+apply Rle_antisym.
+apply Rle_trans with x.
+apply Hxd1.
+apply Hxu1.
+destruct (Rle_or_lt 0 x) as [Hx|Hx].
+apply Hxu1.
+apply Hxd1.
+rewrite Rabs_pos_eq with (1 := Hx) in Hd.
+rewrite Rabs_pos_eq in Hd.
+exact Hd.
+now apply Hxd1.
+apply Hxd1.
+apply Hxu1.
+rewrite Rabs_left with (1 := Hx) in Hu.
+rewrite Rabs_left1 in Hu.
+now apply Ropp_le_cancel.
+apply Hxu1.
+apply HF.
+now apply Rlt_le.
+Qed.
+
+Theorem Rnd_NA_pt_unicity :
+  forall F : R -> Prop,
+  F 0 ->
+  forall x f1 f2 : R,
+  Rnd_NA_pt F x f1 -> Rnd_NA_pt F x f2 ->
+  f1 = f2.
+Proof.
+intros F HF x f1 f2 H1 H2.
+apply (Rnd_NG_pt_unicity F _ (Rnd_NA_pt_unicity_prop F HF) x).
+now apply -> Rnd_NA_NG_pt.
+now apply -> Rnd_NA_NG_pt.
+Qed.
+
+Theorem Rnd_NA_N_pt :
+  forall F : R -> Prop,
+  F 0 ->
+  forall x f : R,
+  Rnd_N_pt F x f ->
+  (Rabs x <= Rabs f)%R ->
+  Rnd_NA_pt F x f.
+Proof.
+intros F HF x f Rxf Hxf.
+split.
+apply Rxf.
+intros g Rxg.
+destruct (Rabs_eq_Rabs (f - x) (g - x)) as [H|H].
+apply Rle_antisym.
+apply Rxf.
+apply Rxg.
+apply Rxg.
+apply Rxf.
+(* *)
+replace g with f.
+apply Rle_refl.
+apply Rplus_eq_reg_r with (1 := H).
+(* *)
+assert (g = 2 * x - f)%R.
+replace (2 * x - f)%R with (x - (f - x))%R by ring.
+rewrite H.
+ring.
+destruct (Rle_lt_dec 0 x) as [Hx|Hx].
+(* . *)
+revert Hxf.
+rewrite Rabs_pos_eq with (1 := Hx).
+rewrite 2!Rabs_pos_eq ; try ( apply (Rnd_N_pt_pos F HF x) ; assumption ).
+intros Hxf.
+rewrite H0.
+apply Rplus_le_reg_r with f.
+ring_simplify.
+apply Rmult_le_compat_l with (2 := Hxf).
+now apply (Z2R_le 0 2).
+(* . *)
+revert Hxf.
+apply Rlt_le in Hx.
+rewrite Rabs_left1 with (1 := Hx).
+rewrite 2!Rabs_left1 ; try ( apply (Rnd_N_pt_neg F HF x) ; assumption ).
+intros Hxf.
+rewrite H0.
+apply Ropp_le_contravar.
+apply Rplus_le_reg_r with f.
+ring_simplify.
+apply Rmult_le_compat_l.
+now apply (Z2R_le 0 2).
+now apply Ropp_le_cancel.
+Qed.
+
+Theorem Rnd_NA_unicity :
+  forall (F : R -> Prop),
+  F 0 ->
+  forall rnd1 rnd2 : R -> R,
+  Rnd_NA F rnd1 -> Rnd_NA F rnd2 ->
+  forall x, rnd1 x = rnd2 x.
+Proof.
+intros F HF rnd1 rnd2 H1 H2 x.
+now apply Rnd_NA_pt_unicity with F x.
+Qed.
+
+Theorem Rnd_NA_pt_monotone :
+  forall F : R -> Prop,
+  F 0 ->
+  round_pred_monotone (Rnd_NA_pt F).
+Proof.
+intros F HF x y f g Hxf Hyg Hxy.
+apply (Rnd_NG_pt_monotone F _ (Rnd_NA_pt_unicity_prop F HF) x y).
+now apply -> Rnd_NA_NG_pt.
+now apply -> Rnd_NA_NG_pt.
+exact Hxy.
+Qed.
+
+Theorem Rnd_NA_pt_refl :
+  forall F : R -> Prop,
+  forall x : R, F x ->
+  Rnd_NA_pt F x x.
+Proof.
+intros F x Hx.
+split.
+now apply Rnd_N_pt_refl.
+intros f Hxf.
+apply Req_le.
+apply f_equal.
+now apply Rnd_N_pt_idempotent with (1 := Hxf).
+Qed.
+
+Theorem Rnd_NA_pt_idempotent :
+  forall F : R -> Prop,
+  forall x f : R,
+  Rnd_NA_pt F x f -> F x ->
+  f = x.
+Proof.
+intros F x f (Hf,_) Hx.
+now apply Rnd_N_pt_idempotent with F.
+Qed.
+
+Theorem round_pred_ge_0 :
+  forall P : R -> R -> Prop,
+  round_pred_monotone P ->
+  P 0 0 ->
+  forall x f, P x f -> 0 <= x -> 0 <= f.
+Proof.
+intros P HP HP0 x f Hxf Hx.
+now apply (HP 0 x).
+Qed.
+
+Theorem round_pred_gt_0 :
+  forall P : R -> R -> Prop,
+  round_pred_monotone P ->
+  P 0 0 ->
+  forall x f, P x f -> 0 < f -> 0 < x.
+Proof.
+intros P HP HP0 x f Hxf Hf.
+apply Rnot_le_lt.
+intros Hx.
+apply Rlt_not_le with (1 := Hf).
+now apply (HP x 0).
+Qed.
+
+Theorem round_pred_le_0 :
+  forall P : R -> R -> Prop,
+  round_pred_monotone P ->
+  P 0 0 ->
+  forall x f, P x f -> x <= 0 -> f <= 0.
+Proof.
+intros P HP HP0 x f Hxf Hx.
+now apply (HP x 0).
+Qed.
+
+Theorem round_pred_lt_0 :
+  forall P : R -> R -> Prop,
+  round_pred_monotone P ->
+  P 0 0 ->
+  forall x f, P x f -> f < 0 -> x < 0.
+Proof.
+intros P HP HP0 x f Hxf Hf.
+apply Rnot_le_lt.
+intros Hx.
+apply Rlt_not_le with (1 := Hf).
+now apply (HP 0 x).
+Qed.
+
+Theorem Rnd_DN_pt_equiv_format :
+  forall F1 F2 : R -> Prop,
+  forall a b : R,
+  F1 a ->
+  ( forall x, a <= x <= b -> (F1 x <-> F2 x) ) ->
+  forall x f, a <= x <= b -> Rnd_DN_pt F1 x f -> Rnd_DN_pt F2 x f.
+Proof.
+intros F1 F2 a b Ha HF x f Hx (H1, (H2, H3)).
+split.
+apply -> HF.
+exact H1.
+split.
+now apply H3.
+now apply Rle_trans with (1 := H2).
+split.
+exact H2.
+intros k Hk Hl.
+destruct (Rlt_or_le k a) as [H|H].
+apply Rlt_le.
+apply Rlt_le_trans with (1 := H).
+now apply H3.
+apply H3.
+apply <- HF.
+exact Hk.
+split.
+exact H.
+now apply Rle_trans with (1 := Hl).
+exact Hl.
+Qed.
+
+Theorem Rnd_UP_pt_equiv_format :
+  forall F1 F2 : R -> Prop,
+  forall a b : R,
+  F1 b ->
+  ( forall x, a <= x <= b -> (F1 x <-> F2 x) ) ->
+  forall x f, a <= x <= b -> Rnd_UP_pt F1 x f -> Rnd_UP_pt F2 x f.
+Proof.
+intros F1 F2 a b Hb HF x f Hx (H1, (H2, H3)).
+split.
+apply -> HF.
+exact H1.
+split.
+now apply Rle_trans with (2 := H2).
+now apply H3.
+split.
+exact H2.
+intros k Hk Hl.
+destruct (Rle_or_lt k b) as [H|H].
+apply H3.
+apply <- HF.
+exact Hk.
+split.
+now apply Rle_trans with (2 := Hl).
+exact H.
+exact Hl.
+apply Rlt_le.
+apply Rle_lt_trans with (2 := H).
+now apply H3.
+Qed.
+
+(** ensures a real number can always be rounded *)
+Inductive satisfies_any (F : R -> Prop) :=
+  Satisfies_any :
+    F 0 -> ( forall x : R, F x -> F (-x) ) ->
+    round_pred_total (Rnd_DN_pt F) -> satisfies_any F.
+
+Theorem satisfies_any_eq :
+  forall F1 F2 : R -> Prop,
+  ( forall x, F1 x <-> F2 x ) ->
+  satisfies_any F1 ->
+  satisfies_any F2.
+Proof.
+intros F1 F2 Heq (Hzero, Hsym, Hrnd).
+split.
+now apply -> Heq.
+intros x Hx.
+apply -> Heq.
+apply Hsym.
+now apply <- Heq.
+intros x.
+destruct (Hrnd x) as (f, (H1, (H2, H3))).
+exists f.
+split.
+now apply -> Heq.
+split.
+exact H2.
+intros g Hg Hgx.
+apply H3.
+now apply <- Heq.
+exact Hgx.
+Qed.
+
+Theorem satisfies_any_imp_DN :
+  forall F : R -> Prop,
+  satisfies_any F ->
+  round_pred (Rnd_DN_pt F).
+Proof.
+intros F (_,_,Hrnd).
+split.
+apply Hrnd.
+apply Rnd_DN_pt_monotone.
+Qed.
+
+Theorem satisfies_any_imp_UP :
+  forall F : R -> Prop,
+  satisfies_any F ->
+  round_pred (Rnd_UP_pt F).
+Proof.
+intros F Hany.
+split.
+intros x.
+destruct (proj1 (satisfies_any_imp_DN F Hany) (-x)) as (f, Hf).
+exists (-f).
+rewrite <- (Ropp_involutive x).
+apply Rnd_DN_UP_pt_sym.
+apply Hany.
+exact Hf.
+apply Rnd_UP_pt_monotone.
+Qed.
+
+Theorem satisfies_any_imp_ZR :
+  forall F : R -> Prop,
+  satisfies_any F ->
+  round_pred (Rnd_ZR_pt F).
+Proof.
+intros F Hany.
+split.
+intros x.
+destruct (Rle_or_lt 0 x) as [Hx|Hx].
+(* positive *)
+destruct (proj1 (satisfies_any_imp_DN F Hany) x) as (f, Hf).
+exists f.
+split.
+now intros _.
+intros Hx'.
+(* zero *)
+assert (x = 0).
+now apply Rle_antisym.
+rewrite H in Hf |- *.
+clear H Hx Hx'.
+rewrite Rnd_DN_pt_idempotent with (1 := Hf).
+apply Rnd_UP_pt_refl.
+apply Hany.
+apply Hany.
+(* negative *)
+destruct (proj1 (satisfies_any_imp_UP F Hany) x) as (f, Hf).
+exists f.
+split.
+intros Hx'.
+elim (Rlt_irrefl 0).
+now apply Rle_lt_trans with x.
+now intros _.
+(* . *)
+apply Rnd_ZR_pt_monotone.
+apply Hany.
+Qed.
+
+Definition NG_existence_prop (F : R -> Prop) (P : R -> R -> Prop) :=
+  forall x d u, ~F x -> Rnd_DN_pt F x d -> Rnd_UP_pt F x u -> P x u \/ P x d.
+
+Theorem satisfies_any_imp_NG :
+  forall (F : R -> Prop) (P : R -> R -> Prop),
+  satisfies_any F ->
+  NG_existence_prop F P ->
+  round_pred_total (Rnd_NG_pt F P).
+Proof.
+intros F P Hany HP x.
+destruct (proj1 (satisfies_any_imp_DN F Hany) x) as (d, Hd).
+destruct (proj1 (satisfies_any_imp_UP F Hany) x) as (u, Hu).
+destruct (total_order_T (Rabs (u - x)) (Rabs (d - x))) as [[H|H]|H].
+(* |up(x) - x| < |dn(x) - x| *)
+exists u.
+split.
+(* - . *)
+split.
+apply Hu.
+intros g Hg.
+destruct (Rle_or_lt x g) as [Hxg|Hxg].
+rewrite 2!Rabs_pos_eq.
+apply Rplus_le_compat_r.
+now apply Hu.
+now apply Rle_0_minus.
+apply Rle_0_minus.
+apply Hu.
+apply Rlt_le in Hxg.
+apply Rlt_le.
+apply Rlt_le_trans with (1 := H).
+do 2 rewrite <- (Rabs_minus_sym x).
+rewrite 2!Rabs_pos_eq.
+apply Rplus_le_compat_l.
+apply Ropp_le_contravar.
+now apply Hd.
+now apply Rle_0_minus.
+apply Rle_0_minus.
+apply Hd.
+(* - . *)
+right.
+intros f Hf.
+destruct (Rnd_N_pt_DN_or_UP_eq F x _ _ _ Hd Hu Hf) as [K|K] ; rewrite K.
+elim Rlt_not_le with (1 := H).
+rewrite <- K.
+apply Hf.
+apply Hu.
+apply refl_equal.
+(* |up(x) - x| = |dn(x) - x| *)
+destruct (Req_dec x d) as [He|Hne].
+(* - x = d = u *)
+exists x.
+split.
+apply Rnd_N_pt_refl.
+rewrite He.
+apply Hd.
+right.
+intros.
+apply Rnd_N_pt_idempotent with (1 := H0).
+rewrite He.
+apply Hd.
+assert (Hf : ~F x).
+intros Hf.
+apply Hne.
+apply sym_eq.
+now apply Rnd_DN_pt_idempotent with (1 := Hd).
+destruct (HP x _ _ Hf Hd Hu) as [H'|H'].
+(* - u >> d *)
+exists u.
+split.
+split.
+apply Hu.
+intros g Hg.
+destruct (Rle_or_lt x g) as [Hxg|Hxg].
+rewrite 2!Rabs_pos_eq.
+apply Rplus_le_compat_r.
+now apply Hu.
+now apply Rle_0_minus.
+apply Rle_0_minus.
+apply Hu.
+apply Rlt_le in Hxg.
+rewrite H.
+rewrite 2!Rabs_left1.
+apply Ropp_le_contravar.
+apply Rplus_le_compat_r.
+now apply Hd.
+now apply Rle_minus.
+apply Rle_minus.
+apply Hd.
+now left.
+(* - d >> u *)
+exists d.
+split.
+split.
+apply Hd.
+intros g Hg.
+destruct (Rle_or_lt x g) as [Hxg|Hxg].
+rewrite <- H.
+rewrite 2!Rabs_pos_eq.
+apply Rplus_le_compat_r.
+now apply Hu.
+now apply Rle_0_minus.
+apply Rle_0_minus.
+apply Hu.
+apply Rlt_le in Hxg.
+rewrite 2!Rabs_left1.
+apply Ropp_le_contravar.
+apply Rplus_le_compat_r.
+now apply Hd.
+now apply Rle_minus.
+apply Rle_minus.
+apply Hd.
+now left.
+(* |up(x) - x| > |dn(x) - x| *)
+exists d.
+split.
+split.
+apply Hd.
+intros g Hg.
+destruct (Rle_or_lt x g) as [Hxg|Hxg].
+apply Rlt_le.
+apply Rlt_le_trans with (1 := H).
+rewrite 2!Rabs_pos_eq.
+apply Rplus_le_compat_r.
+now apply Hu.
+now apply Rle_0_minus.
+apply Rle_0_minus.
+apply Hu.
+apply Rlt_le in Hxg.
+rewrite 2!Rabs_left1.
+apply Ropp_le_contravar.
+apply Rplus_le_compat_r.
+now apply Hd.
+now apply Rle_minus.
+apply Rle_minus.
+apply Hd.
+right.
+intros f Hf.
+destruct (Rnd_N_pt_DN_or_UP_eq F x _ _ _ Hd Hu Hf) as [K|K] ; rewrite K.
+apply refl_equal.
+elim Rlt_not_le with (1 := H).
+rewrite <- K.
+apply Hf.
+apply Hd.
+Qed.
+
+Theorem satisfies_any_imp_NA :
+  forall F : R -> Prop,
+  satisfies_any F ->
+  round_pred (Rnd_NA_pt F).
+Proof.
+intros F Hany.
+split.
+assert (H : round_pred_total (Rnd_NG_pt F (fun a b => (Rabs a <= Rabs b)%R))).
+apply satisfies_any_imp_NG.
+apply Hany.
+intros x d u Hf Hd Hu.
+destruct (Rle_lt_dec 0 x) as [Hx|Hx].
+left.
+rewrite Rabs_pos_eq with (1 := Hx).
+rewrite Rabs_pos_eq.
+apply Hu.
+apply Rle_trans with (1 := Hx).
+apply Hu.
+right.
+rewrite Rabs_left with (1 := Hx).
+rewrite Rabs_left1.
+apply Ropp_le_contravar.
+apply Hd.
+apply Rlt_le in Hx.
+apply Rle_trans with (2 := Hx).
+apply Hd.
+intros x.
+destruct (H x) as (f, Hf).
+exists f.
+apply <- Rnd_NA_NG_pt.
+apply Hf.
+apply Hany.
+apply Rnd_NA_pt_monotone.
+apply Hany.
+Qed.
+
+End RND_prop.
diff --git a/flocq/Core/Fcore_rnd_ne.v b/flocq/Core/Fcore_rnd_ne.v
new file mode 100644
index 0000000..0b0776e
--- /dev/null
+++ b/flocq/Core/Fcore_rnd_ne.v
@@ -0,0 +1,531 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Rounding to nearest, ties to even: existence, unicity... *)
+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_ulp.
+
+Notation ZnearestE := (Znearest (fun x => negb (Zeven x))).
+
+Section Fcore_rnd_NE.
+
+Variable beta : radix.
+
+Notation bpow e := (bpow beta e).
+
+Variable fexp : Z -> Z.
+
+Context { valid_exp : Valid_exp fexp }.
+
+Notation format := (generic_format beta fexp).
+Notation canonic := (canonic beta fexp).
+
+Definition NE_prop (_ : R) f :=
+  exists g : float beta, f = F2R g /\ canonic g /\ Zeven (Fnum g) = true.
+
+Definition Rnd_NE_pt :=
+  Rnd_NG_pt format NE_prop.
+
+Definition DN_UP_parity_pos_prop :=
+  forall x xd xu,
+  (0 < x)%R ->
+  ~ format x ->
+  canonic xd ->
+  canonic xu ->
+  F2R xd = round beta fexp Zfloor x ->
+  F2R xu = round beta fexp Zceil x ->
+  Zeven (Fnum xu) = negb (Zeven (Fnum xd)).
+
+Definition DN_UP_parity_prop :=
+  forall x xd xu,
+  ~ format x ->
+  canonic xd ->
+  canonic xu ->
+  F2R xd = round beta fexp Zfloor x ->
+  F2R xu = round beta fexp Zceil x ->
+  Zeven (Fnum xu) = negb (Zeven (Fnum xd)).
+
+Lemma DN_UP_parity_aux :
+  DN_UP_parity_pos_prop ->
+  DN_UP_parity_prop.
+Proof.
+intros Hpos x xd xu Hfx Hd Hu Hxd Hxu.
+destruct (total_order_T 0 x) as [[Hx|Hx]|Hx].
+(* . *)
+exact (Hpos x xd xu Hx Hfx Hd Hu Hxd Hxu).
+elim Hfx.
+rewrite <- Hx.
+apply generic_format_0.
+(* . *)
+assert (Hx': (0 < -x)%R).
+apply Ropp_lt_cancel.
+now rewrite Ropp_involutive, Ropp_0.
+destruct xd as (md, ed).
+destruct xu as (mu, eu).
+simpl.
+rewrite <- (Bool.negb_involutive (Zeven mu)).
+apply f_equal.
+apply sym_eq.
+rewrite <- (Zeven_opp mu), <- (Zeven_opp md).
+change (Zeven (Fnum (Float beta (-md) ed)) = negb (Zeven (Fnum (Float beta (-mu) eu)))).
+apply (Hpos (-x)%R _ _ Hx').
+intros H.
+apply Hfx.
+rewrite <- Ropp_involutive.
+now apply generic_format_opp.
+now apply canonic_opp.
+now apply canonic_opp.
+rewrite round_DN_opp, F2R_Zopp.
+now apply f_equal.
+rewrite round_UP_opp, F2R_Zopp.
+now apply f_equal.
+Qed.
+
+Class Exists_NE :=
+  exists_NE : Zeven beta = false \/ forall e,
+  ((fexp e < e)%Z -> (fexp (e + 1) < e)%Z) /\ ((e <= fexp e)%Z -> fexp (fexp e + 1) = fexp e).
+
+Context { exists_NE_ : Exists_NE }.
+
+Theorem DN_UP_parity_generic_pos :
+  DN_UP_parity_pos_prop.
+Proof with auto with typeclass_instances.
+intros x xd xu H0x Hfx Hd Hu Hxd Hxu.
+destruct (ln_beta beta x) as (ex, Hexa).
+specialize (Hexa (Rgt_not_eq _ _ H0x)).
+generalize Hexa. intros Hex.
+rewrite (Rabs_pos_eq _ (Rlt_le _ _ H0x)) in Hex.
+destruct (Zle_or_lt ex (fexp ex)) as [Hxe|Hxe].
+(* small x *)
+assert (Hd3 : Fnum xd = Z0).
+apply F2R_eq_0_reg with beta (Fexp xd).
+change (F2R xd = R0).
+rewrite Hxd.
+apply round_DN_small_pos with (1 := Hex) (2 := Hxe).
+assert (Hu3 : xu = Float beta (1 * Zpower beta (fexp ex - fexp (fexp ex + 1))) (fexp (fexp ex + 1))).
+apply canonic_unicity with (1 := Hu).
+apply (f_equal fexp).
+rewrite <- F2R_change_exp.
+now rewrite F2R_bpow, ln_beta_bpow.
+now apply valid_exp.
+rewrite <- F2R_change_exp.
+rewrite F2R_bpow.
+apply sym_eq.
+rewrite Hxu.
+apply sym_eq.
+apply round_UP_small_pos with (1 := Hex) (2 := Hxe).
+now apply valid_exp.
+rewrite Hd3, Hu3.
+rewrite Zmult_1_l.
+simpl.
+destruct exists_NE_ as [H|H].
+apply Zeven_Zpower_odd with (2 := H).
+apply Zle_minus_le_0.
+now apply valid_exp.
+rewrite (proj2 (H ex)).
+now rewrite Zminus_diag.
+exact Hxe.
+(* large x *)
+assert (Hd4: (bpow (ex - 1) <= Rabs (F2R xd) < bpow ex)%R).
+rewrite Rabs_pos_eq.
+rewrite Hxd.
+split.
+apply (round_DN_pt beta fexp x).
+apply generic_format_bpow.
+ring_simplify (ex - 1 + 1)%Z.
+omega.
+apply Hex.
+apply Rle_lt_trans with (2 := proj2 Hex).
+apply (round_DN_pt beta fexp x).
+rewrite Hxd.
+apply (round_DN_pt beta fexp x).
+apply generic_format_0.
+now apply Rlt_le.
+assert (Hxe2 : (fexp (ex + 1) <= ex)%Z) by now apply valid_exp.
+assert (Hud: (F2R xu = F2R xd + ulp beta fexp x)%R).
+rewrite Hxu, Hxd.
+now apply ulp_DN_UP.
+destruct (total_order_T (bpow ex) (F2R xu)) as [[Hu2|Hu2]|Hu2].
+(* - xu > bpow ex  *)
+elim (Rlt_not_le _ _ Hu2).
+rewrite Hxu.
+apply round_bounded_large_pos...
+(* - xu = bpow ex *)
+assert (Hu3: xu = Float beta (1 * Zpower beta (ex - fexp (ex + 1))) (fexp (ex + 1))).
+apply canonic_unicity with (1 := Hu).
+apply (f_equal fexp).
+rewrite <- F2R_change_exp.
+now rewrite F2R_bpow, ln_beta_bpow.
+now apply valid_exp.
+rewrite <- Hu2.
+apply sym_eq.
+rewrite <- F2R_change_exp.
+apply F2R_bpow.
+exact Hxe2.
+assert (Hd3: xd = Float beta (Zpower beta (ex - fexp ex) - 1) (fexp ex)).
+assert (H: F2R xd = F2R (Float beta (Zpower beta (ex - fexp ex) - 1) (fexp ex))).
+unfold F2R. simpl.
+rewrite Z2R_minus.
+unfold Rminus.
+rewrite Rmult_plus_distr_r.
+rewrite Z2R_Zpower, <- bpow_plus.
+ring_simplify (ex - fexp ex + fexp ex)%Z.
+rewrite Hu2, Hud.
+unfold ulp, canonic_exp.
+rewrite ln_beta_unique with beta x ex.
+unfold F2R.
+simpl. ring.
+rewrite Rabs_pos_eq.
+exact Hex.
+now apply Rlt_le.
+apply Zle_minus_le_0.
+now apply Zlt_le_weak.
+apply canonic_unicity with (1 := Hd) (3 := H).
+apply (f_equal fexp).
+rewrite <- H.
+apply sym_eq.
+now apply ln_beta_unique.
+rewrite Hd3, Hu3.
+unfold Fnum.
+rewrite Zeven_mult. simpl.
+unfold Zminus at 2.
+rewrite Zeven_plus.
+rewrite eqb_sym. simpl.
+fold (negb (Zeven (beta ^ (ex - fexp ex)))).
+rewrite Bool.negb_involutive.
+rewrite (Zeven_Zpower beta (ex - fexp ex)). 2: omega.
+destruct exists_NE_.
+rewrite H.
+apply Zeven_Zpower_odd with (2 := H).
+now apply Zle_minus_le_0.
+apply Zeven_Zpower.
+specialize (H ex).
+omega.
+(* - xu < bpow ex *)
+revert Hud.
+unfold ulp, F2R.
+rewrite Hd, Hu.
+unfold canonic_exp.
+rewrite ln_beta_unique with beta (F2R xu) ex.
+rewrite ln_beta_unique with (1 := Hd4).
+rewrite ln_beta_unique with (1 := Hexa).
+intros H.
+replace (Fnum xu) with (Fnum xd + 1)%Z.
+rewrite Zeven_plus.
+now apply eqb_sym.
+apply sym_eq.
+apply eq_Z2R.
+rewrite Z2R_plus.
+apply Rmult_eq_reg_r with (bpow (fexp ex)).
+rewrite H.
+simpl. ring.
+apply Rgt_not_eq.
+apply bpow_gt_0.
+rewrite Rabs_pos_eq.
+split.
+apply Rle_trans with (1 := proj1 Hex).
+rewrite Hxu.
+apply (round_UP_pt beta fexp x).
+exact Hu2.
+apply Rlt_le.
+apply Rlt_le_trans with (1 := H0x).
+rewrite Hxu.
+apply (round_UP_pt beta fexp x).
+Qed.
+
+Theorem DN_UP_parity_generic :
+  DN_UP_parity_prop.
+Proof.
+apply DN_UP_parity_aux.
+apply DN_UP_parity_generic_pos.
+Qed.
+
+Theorem Rnd_NE_pt_total :
+  round_pred_total Rnd_NE_pt.
+Proof.
+apply satisfies_any_imp_NG.
+now apply generic_format_satisfies_any.
+intros x d u Hf Hd Hu.
+generalize (proj1 Hd).
+unfold generic_format.
+set (ed := canonic_exp beta fexp d).
+set (md := Ztrunc (scaled_mantissa beta fexp d)).
+intros Hd1.
+case_eq (Zeven md) ; [ intros He | intros Ho ].
+right.
+exists (Float beta md ed).
+unfold Fcore_generic_fmt.canonic.
+rewrite <- Hd1.
+now repeat split.
+left.
+generalize (proj1 Hu).
+unfold generic_format.
+set (eu := canonic_exp beta fexp u).
+set (mu := Ztrunc (scaled_mantissa beta fexp u)).
+intros Hu1.
+rewrite Hu1.
+eexists ; repeat split.
+unfold Fcore_generic_fmt.canonic.
+now rewrite <- Hu1.
+rewrite (DN_UP_parity_generic x (Float beta md ed) (Float beta mu eu)).
+simpl.
+now rewrite Ho.
+exact Hf.
+unfold Fcore_generic_fmt.canonic.
+now rewrite <- Hd1.
+unfold Fcore_generic_fmt.canonic.
+now rewrite <- Hu1.
+rewrite <- Hd1.
+apply Rnd_DN_pt_unicity with (1 := Hd).
+now apply round_DN_pt.
+rewrite <- Hu1.
+apply Rnd_UP_pt_unicity with (1 := Hu).
+now apply round_UP_pt.
+Qed.
+
+Theorem Rnd_NE_pt_monotone :
+  round_pred_monotone Rnd_NE_pt.
+Proof.
+apply Rnd_NG_pt_monotone.
+intros x d u Hd Hdn Hu Hun (cd, (Hd1, Hd2)) (cu, (Hu1, Hu2)).
+destruct (Req_dec x d) as [Hx|Hx].
+rewrite <- Hx.
+apply sym_eq.
+apply Rnd_UP_pt_idempotent with (1 := Hu).
+rewrite Hx.
+apply Hd.
+rewrite (DN_UP_parity_aux DN_UP_parity_generic_pos x cd cu) in Hu2 ; try easy.
+now rewrite (proj2 Hd2) in Hu2.
+intros Hf.
+apply Hx.
+apply sym_eq.
+now apply Rnd_DN_pt_idempotent with (1 := Hd).
+rewrite <- Hd1.
+apply Rnd_DN_pt_unicity with (1 := Hd).
+now apply round_DN_pt.
+rewrite <- Hu1.
+apply Rnd_UP_pt_unicity with (1 := Hu).
+now apply round_UP_pt.
+Qed.
+
+Theorem Rnd_NE_pt_round :
+  round_pred Rnd_NE_pt.
+split.
+apply Rnd_NE_pt_total.
+apply Rnd_NE_pt_monotone.
+Qed.
+
+Lemma round_NE_pt_pos :
+  forall x,
+  (0 < x)%R ->
+  Rnd_NE_pt x (round beta fexp ZnearestE x).
+Proof with auto with typeclass_instances.
+intros x Hx.
+split.
+now apply round_N_pt.
+unfold NE_prop.
+set (mx := scaled_mantissa beta fexp x).
+set (xr := round beta fexp ZnearestE x).
+destruct (Req_dec (mx - Z2R (Zfloor mx)) (/2)) as [Hm|Hm].
+(* midpoint *)
+left.
+exists (Float beta (Ztrunc (scaled_mantissa beta fexp xr)) (canonic_exp beta fexp xr)).
+split.
+apply round_N_pt...
+split.
+unfold Fcore_generic_fmt.canonic. simpl.
+apply f_equal.
+apply round_N_pt...
+simpl.
+unfold xr, round, Znearest.
+fold mx.
+rewrite Hm.
+rewrite Rcompare_Eq. 2: apply refl_equal.
+case_eq (Zeven (Zfloor mx)) ; intros Hmx.
+(* . even floor *)
+change (Zeven (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zfloor x))) = true).
+destruct (Rle_or_lt (round beta fexp Zfloor x) 0) as [Hr|Hr].
+rewrite (Rle_antisym _ _ Hr).
+unfold scaled_mantissa.
+rewrite Rmult_0_l.
+change R0 with (Z2R 0).
+now rewrite (Ztrunc_Z2R 0).
+rewrite <- (round_0 beta fexp Zfloor).
+apply round_le...
+now apply Rlt_le.
+rewrite scaled_mantissa_DN...
+now rewrite Ztrunc_Z2R.
+(* . odd floor *)
+change (Zeven (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zceil x))) = true).
+destruct (ln_beta beta x) as (ex, Hex).
+specialize (Hex (Rgt_not_eq _ _ Hx)).
+rewrite (Rabs_pos_eq _ (Rlt_le _ _ Hx)) in Hex.
+destruct (Z_lt_le_dec (fexp ex) ex) as [He|He].
+(* .. large pos *)
+assert (Hu := round_bounded_large_pos _ _ Zceil _ _ He Hex).
+assert (Hfc: Zceil mx = (Zfloor mx + 1)%Z).
+apply Zceil_floor_neq.
+intros H.
+rewrite H in Hm.
+unfold Rminus in Hm.
+rewrite Rplus_opp_r in Hm.
+elim (Rlt_irrefl 0).
+rewrite Hm at 2.
+apply Rinv_0_lt_compat.
+now apply (Z2R_lt 0 2).
+destruct (proj2 Hu) as [Hu'|Hu'].
+(* ... u <> bpow *)
+unfold scaled_mantissa.
+rewrite canonic_exp_fexp_pos with (1 := conj (proj1 Hu) Hu').
+unfold round, F2R. simpl.
+rewrite canonic_exp_fexp_pos with (1 := Hex).
+rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
+rewrite Ztrunc_Z2R.
+fold mx.
+rewrite Hfc.
+now rewrite Zeven_plus, Hmx.
+(* ... u = bpow *)
+rewrite Hu'.
+unfold scaled_mantissa, canonic_exp.
+rewrite ln_beta_bpow.
+rewrite <- bpow_plus, <- Z2R_Zpower.
+rewrite Ztrunc_Z2R.
+case_eq (Zeven beta) ; intros Hr.
+destruct exists_NE_ as [Hs|Hs].
+now rewrite Hs in Hr.
+destruct (Hs ex) as (H,_).
+rewrite Zeven_Zpower.
+exact Hr.
+omega.
+assert (Zeven (Zfloor mx) = true). 2: now rewrite H in Hmx.
+replace (Zfloor mx) with (Zceil mx + -1)%Z by omega.
+rewrite Zeven_plus.
+apply eqb_true.
+unfold mx.
+replace (Zceil (scaled_mantissa beta fexp x)) with (Zpower beta (ex - fexp ex)).
+rewrite Zeven_Zpower_odd with (2 := Hr).
+easy.
+omega.
+apply eq_Z2R.
+rewrite Z2R_Zpower. 2: omega.
+apply Rmult_eq_reg_r with (bpow (fexp ex)).
+unfold Zminus.
+rewrite bpow_plus.
+rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_l, Rmult_1_r.
+pattern (fexp ex) ; rewrite <- canonic_exp_fexp_pos with (1 := Hex).
+now apply sym_eq.
+apply Rgt_not_eq.
+apply bpow_gt_0.
+generalize (proj1 (valid_exp ex) He).
+omega.
+(* .. small pos *)
+assert (Zeven (Zfloor mx) = true). 2: now rewrite H in Hmx.
+unfold mx, scaled_mantissa.
+rewrite canonic_exp_fexp_pos with (1 := Hex).
+now rewrite mantissa_DN_small_pos.
+(* not midpoint *)
+right.
+intros g Hg.
+destruct (Req_dec x g) as [Hxg|Hxg].
+rewrite <- Hxg.
+apply sym_eq.
+apply round_generic...
+rewrite Hxg.
+apply Hg.
+set (d := round beta fexp Zfloor x).
+set (u := round beta fexp Zceil x).
+apply Rnd_N_pt_unicity with (d := d) (u := u) (4 := Hg).
+now apply round_DN_pt.
+now apply round_UP_pt.
+2: now apply round_N_pt.
+rewrite <- (scaled_mantissa_mult_bpow beta fexp x).
+unfold d, u, round, F2R. simpl. fold mx.
+rewrite <- 2!Rmult_minus_distr_r.
+intros H.
+apply Rmult_eq_reg_r in H.
+apply Hm.
+apply Rcompare_Eq_inv.
+rewrite Rcompare_floor_ceil_mid.
+now apply Rcompare_Eq.
+contradict Hxg.
+apply sym_eq.
+apply Rnd_N_pt_idempotent with (1 := Hg).
+rewrite <- (scaled_mantissa_mult_bpow beta fexp x).
+fold mx.
+rewrite <- Hxg.
+change (Z2R (Zfloor mx) * bpow (canonic_exp beta fexp x))%R with d.
+now eapply round_DN_pt.
+apply Rgt_not_eq.
+apply bpow_gt_0.
+Qed.
+
+Theorem round_NE_opp :
+  forall x,
+  round beta fexp ZnearestE (-x) = (- round beta fexp ZnearestE x)%R.
+Proof.
+intros x.
+unfold round. simpl.
+rewrite scaled_mantissa_opp, canonic_exp_opp.
+rewrite Znearest_opp.
+rewrite <- F2R_Zopp.
+apply (f_equal (fun v => F2R (Float beta (-v) _))).
+set (m := scaled_mantissa beta fexp x).
+unfold Znearest.
+case Rcompare ; trivial.
+apply (f_equal (fun (b : bool) => if b then Zceil m else Zfloor m)).
+rewrite Bool.negb_involutive.
+rewrite Zeven_opp.
+rewrite Zeven_plus.
+now rewrite eqb_sym.
+Qed.
+
+Theorem round_NE_pt :
+  forall x,
+  Rnd_NE_pt x (round beta fexp ZnearestE x).
+Proof with auto with typeclass_instances.
+intros x.
+destruct (total_order_T x 0) as [[Hx|Hx]|Hx].
+apply Rnd_NG_pt_sym.
+apply generic_format_opp.
+unfold NE_prop.
+intros _ f ((mg,eg),(H1,(H2,H3))).
+exists (Float beta (- mg) eg).
+repeat split.
+rewrite H1.
+now rewrite F2R_Zopp.
+now apply canonic_opp.
+simpl.
+now rewrite Zeven_opp.
+rewrite <- round_NE_opp.
+apply round_NE_pt_pos.
+now apply Ropp_0_gt_lt_contravar.
+rewrite Hx, round_0...
+apply Rnd_NG_pt_refl.
+apply generic_format_0.
+now apply round_NE_pt_pos.
+Qed.
+
+End Fcore_rnd_NE.
+
+(** Notations for backward-compatibility with Flocq 1.4. *)
+Notation rndNE := ZnearestE (only parsing).
diff --git a/flocq/Core/Fcore_ulp.v b/flocq/Core/Fcore_ulp.v
new file mode 100644
index 0000000..492fac6
--- /dev/null
+++ b/flocq/Core/Fcore_ulp.v
@@ -0,0 +1,1142 @@
+(**
+This file is part of the Flocq formalization of floating-point
+arithmetic in Coq: http://flocq.gforge.inria.fr/
+
+Copyright (C) 2010-2011 Sylvie Boldo
+#<br />#
+Copyright (C) 2010-2011 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.
+*)
+
+(** * Unit in the Last Place: our definition using fexp and its properties, successor and predecessor *)
+Require Import Fcore_Raux.
+Require Import Fcore_defs.
+Require Import Fcore_rnd.
+Require Import Fcore_generic_fmt.
+Require Import Fcore_float_prop.
+
+Section Fcore_ulp.
+
+Variable beta : radix.
+
+Notation bpow e := (bpow beta e).
+
+Variable fexp : Z -> Z.
+
+Context { valid_exp : Valid_exp fexp }.
+
+Definition ulp x := bpow (canonic_exp beta fexp x).
+
+Notation F := (generic_format beta fexp).
+
+Theorem ulp_opp :
+  forall x, ulp (- x) = ulp x.
+Proof.
+intros x.
+unfold ulp.
+now rewrite canonic_exp_opp.
+Qed.
+
+Theorem ulp_abs :
+  forall x, ulp (Rabs x) = ulp x.
+Proof.
+intros x.
+unfold ulp.
+now rewrite canonic_exp_abs.
+Qed.
+
+Theorem ulp_le_id:
+  forall x,
+    (0 < x)%R ->
+    F x ->
+    (ulp x <= x)%R.
+Proof.
+intros x Zx Fx.
+rewrite <- (Rmult_1_l (ulp x)).
+pattern x at 2; rewrite Fx.
+unfold F2R, ulp; simpl.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+replace 1%R with (Z2R (Zsucc 0)) by reflexivity.
+apply Z2R_le.
+apply Zlt_le_succ.
+apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+now rewrite <- Fx.
+Qed.
+
+Theorem ulp_le_abs:
+  forall x,
+    (x <> 0)%R ->
+    F x ->
+    (ulp x <= Rabs x)%R.
+Proof.
+intros x Zx Fx.
+rewrite <- ulp_abs.
+apply ulp_le_id.
+now apply Rabs_pos_lt.
+now apply generic_format_abs.
+Qed.
+
+Theorem ulp_DN_UP :
+  forall x, ~ F x ->
+  round beta fexp Zceil x = (round beta fexp Zfloor x + ulp x)%R.
+Proof.
+intros x Fx.
+unfold round, ulp. simpl.
+unfold F2R. simpl.
+rewrite Zceil_floor_neq.
+rewrite Z2R_plus. simpl.
+ring.
+intros H.
+apply Fx.
+unfold generic_format, F2R. simpl.
+rewrite <- H.
+rewrite Ztrunc_Z2R.
+rewrite H.
+now rewrite scaled_mantissa_mult_bpow.
+Qed.
+
+(** The successor of x is x + ulp x *)
+Theorem succ_le_bpow :
+  forall x e, (0 < x)%R -> F x ->
+  (x < bpow e)%R ->
+  (x + ulp x <= bpow e)%R.
+Proof.
+intros x e Zx Fx Hx.
+pattern x at 1 ; rewrite Fx.
+unfold ulp, F2R. simpl.
+pattern (bpow (canonic_exp beta fexp x)) at 2 ; rewrite <- Rmult_1_l.
+rewrite <- Rmult_plus_distr_r.
+change 1%R with (Z2R 1).
+rewrite <- Z2R_plus.
+change (F2R (Float beta (Ztrunc (scaled_mantissa beta fexp x) + 1) (canonic_exp beta fexp x)) <= bpow e)%R.
+apply F2R_p1_le_bpow.
+apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+now rewrite <- Fx.
+now rewrite <- Fx.
+Qed.
+
+Theorem ln_beta_succ :
+  forall x, (0 < x)%R -> F x ->
+  forall eps, (0 <= eps < ulp x)%R ->
+  ln_beta beta (x + eps) = ln_beta beta x :> Z.
+Proof.
+intros x Zx Fx eps Heps.
+destruct (ln_beta beta x) as (ex, He).
+simpl.
+specialize (He (Rgt_not_eq _ _ Zx)).
+apply ln_beta_unique.
+rewrite Rabs_pos_eq.
+rewrite Rabs_pos_eq in He.
+split.
+apply Rle_trans with (1 := proj1 He).
+pattern x at 1 ; rewrite <- Rplus_0_r.
+now apply Rplus_le_compat_l.
+apply Rlt_le_trans with (x + ulp x)%R.
+now apply Rplus_lt_compat_l.
+pattern x at 1 ; rewrite Fx.
+unfold ulp, F2R. simpl.
+pattern (bpow (canonic_exp beta fexp x)) at 2 ; rewrite <- Rmult_1_l.
+rewrite <- Rmult_plus_distr_r.
+change 1%R with (Z2R 1).
+rewrite <- Z2R_plus.
+change (F2R (Float beta (Ztrunc (scaled_mantissa beta fexp x) + 1) (canonic_exp beta fexp x)) <= bpow ex)%R.
+apply F2R_p1_le_bpow.
+apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+now rewrite <- Fx.
+now rewrite <- Fx.
+now apply Rlt_le.
+apply Rplus_le_le_0_compat.
+now apply Rlt_le.
+apply Heps.
+Qed.
+
+Theorem round_DN_succ :
+  forall x, (0 < x)%R -> F x ->
+  forall eps, (0 <= eps < ulp x)%R ->
+  round beta fexp Zfloor (x + eps) = x.
+Proof.
+intros x Zx Fx eps Heps.
+pattern x at 2 ; rewrite Fx.
+unfold round.
+unfold scaled_mantissa. simpl.
+unfold canonic_exp at 1 2.
+rewrite ln_beta_succ ; trivial.
+apply (f_equal (fun m => F2R (Float beta m _))).
+rewrite Ztrunc_floor.
+apply Zfloor_imp.
+split.
+apply (Rle_trans _ _ _ (Zfloor_lb _)).
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+pattern x at 1 ; rewrite <- Rplus_0_r.
+now apply Rplus_le_compat_l.
+apply Rlt_le_trans with ((x + ulp x) * bpow (- canonic_exp beta fexp x))%R.
+apply Rmult_lt_compat_r.
+apply bpow_gt_0.
+now apply Rplus_lt_compat_l.
+rewrite Rmult_plus_distr_r.
+rewrite Z2R_plus.
+apply Rplus_le_compat.
+pattern x at 1 3 ; rewrite Fx.
+unfold F2R. simpl.
+rewrite Rmult_assoc.
+rewrite <- bpow_plus.
+rewrite Zplus_opp_r.
+rewrite Rmult_1_r.
+rewrite Zfloor_Z2R.
+apply Rle_refl.
+unfold ulp.
+rewrite <- bpow_plus.
+rewrite Zplus_opp_r.
+apply Rle_refl.
+apply Rmult_le_pos.
+now apply Rlt_le.
+apply bpow_ge_0.
+Qed.
+
+Theorem generic_format_succ :
+  forall x, (0 < x)%R -> F x ->
+  F (x + ulp x).
+Proof.
+intros x Zx Fx.
+destruct (ln_beta beta x) as (ex, Ex).
+specialize (Ex (Rgt_not_eq _ _ Zx)).
+assert (Ex' := Ex).
+rewrite Rabs_pos_eq in Ex'.
+destruct (succ_le_bpow x ex) ; try easy.
+unfold generic_format, scaled_mantissa, canonic_exp.
+rewrite ln_beta_unique with beta (x + ulp x)%R ex.
+pattern x at 1 3 ; rewrite Fx.
+unfold ulp, scaled_mantissa.
+rewrite canonic_exp_fexp with (1 := Ex).
+unfold F2R. simpl.
+rewrite Rmult_plus_distr_r.
+rewrite Rmult_assoc.
+rewrite <- bpow_plus, Zplus_opp_r, Rmult_1_r.
+change (bpow 0) with (Z2R 1).
+rewrite <- Z2R_plus.
+rewrite Ztrunc_Z2R.
+rewrite Z2R_plus.
+rewrite Rmult_plus_distr_r.
+now rewrite Rmult_1_l.
+rewrite Rabs_pos_eq.
+split.
+apply Rle_trans with (1 := proj1 Ex').
+pattern x at 1 ; rewrite <- Rplus_0_r.
+apply Rplus_le_compat_l.
+apply bpow_ge_0.
+exact H.
+apply Rplus_le_le_0_compat.
+now apply Rlt_le.
+apply bpow_ge_0.
+rewrite H.
+apply generic_format_bpow.
+apply valid_exp.
+destruct (Zle_or_lt ex (fexp ex)) ; trivial.
+elim Rlt_not_le with (1 := Zx).
+rewrite Fx.
+replace (Ztrunc (scaled_mantissa beta fexp x)) with Z0.
+rewrite F2R_0.
+apply Rle_refl.
+unfold scaled_mantissa.
+rewrite canonic_exp_fexp with (1 := Ex).
+destruct (mantissa_small_pos beta fexp x ex) ; trivial.
+rewrite Ztrunc_floor.
+apply sym_eq.
+apply Zfloor_imp.
+split.
+now apply Rlt_le.
+exact H2.
+now apply Rlt_le.
+now apply Rlt_le.
+Qed.
+
+Theorem round_UP_succ :
+  forall x, (0 < x)%R -> F x ->
+  forall eps, (0 < eps <= ulp x)%R ->
+  round beta fexp Zceil (x + eps) = (x + ulp x)%R.
+Proof with auto with typeclass_instances.
+intros x Zx Fx eps (Heps1,[Heps2|Heps2]).
+assert (Heps: (0 <= eps < ulp x)%R).
+split.
+now apply Rlt_le.
+exact Heps2.
+assert (Hd := round_DN_succ x Zx Fx eps Heps).
+rewrite ulp_DN_UP.
+rewrite Hd.
+unfold ulp, canonic_exp.
+now rewrite ln_beta_succ.
+intros Fs.
+rewrite round_generic in Hd...
+apply Rgt_not_eq with (2 := Hd).
+pattern x at 2 ; rewrite <- Rplus_0_r.
+now apply Rplus_lt_compat_l.
+rewrite Heps2.
+apply round_generic...
+now apply generic_format_succ.
+Qed.
+
+Theorem succ_le_lt:
+  forall x y,
+  F x -> F y ->
+  (0 < x < y)%R ->
+  (x + ulp x <= y)%R.
+Proof with auto with typeclass_instances.
+intros x y Hx Hy H.
+case (Rle_or_lt (ulp x) (y-x)); intros H1.
+apply Rplus_le_reg_r with (-x)%R.
+now ring_simplify (x+ulp x + -x)%R.
+replace y with (x+(y-x))%R by ring.
+absurd (x < y)%R.
+2: apply H.
+apply Rle_not_lt; apply Req_le.
+rewrite <- round_DN_succ with (eps:=(y-x)%R); try easy.
+ring_simplify (x+(y-x))%R.
+apply sym_eq.
+apply round_generic...
+split; trivial.
+apply Rlt_le; now apply Rlt_Rminus.
+Qed.
+
+(** Error of a rounding, expressed in number of ulps *)
+Theorem ulp_error :
+  forall rnd { Zrnd : Valid_rnd rnd } x,
+  (Rabs (round beta fexp rnd x - x) < ulp x)%R.
+Proof with auto with typeclass_instances.
+intros rnd Zrnd x.
+destruct (generic_format_EM beta fexp x) as [Hx|Hx].
+(* x = rnd x *)
+rewrite round_generic...
+unfold Rminus.
+rewrite Rplus_opp_r, Rabs_R0.
+apply bpow_gt_0.
+(* x <> rnd x *)
+destruct (round_DN_or_UP beta fexp rnd x) as [H|H] ; rewrite H ; clear H.
+(* . *)
+rewrite Rabs_left1.
+rewrite Ropp_minus_distr.
+apply Rplus_lt_reg_r with (round beta fexp Zfloor x).
+rewrite <- ulp_DN_UP with (1 := Hx).
+ring_simplify.
+assert (Hu: (x <= round beta fexp Zceil x)%R).
+apply round_UP_pt...
+destruct Hu as [Hu|Hu].
+exact Hu.
+elim Hx.
+rewrite Hu.
+apply generic_format_round...
+apply Rle_minus.
+apply round_DN_pt...
+(* . *)
+rewrite Rabs_pos_eq.
+rewrite ulp_DN_UP with (1 := Hx).
+apply Rplus_lt_reg_r with (x - ulp x)%R.
+ring_simplify.
+assert (Hd: (round beta fexp Zfloor x <= x)%R).
+apply round_DN_pt...
+destruct Hd as [Hd|Hd].
+exact Hd.
+elim Hx.
+rewrite <- Hd.
+apply generic_format_round...
+apply Rle_0_minus.
+apply round_UP_pt...
+Qed.
+
+Theorem ulp_half_error :
+  forall choice x,
+  (Rabs (round beta fexp (Znearest choice) x - x) <= /2 * ulp x)%R.
+Proof with auto with typeclass_instances.
+intros choice x.
+destruct (generic_format_EM beta fexp x) as [Hx|Hx].
+(* x = rnd x *)
+rewrite round_generic...
+unfold Rminus.
+rewrite Rplus_opp_r, Rabs_R0.
+apply Rmult_le_pos.
+apply Rlt_le.
+apply Rinv_0_lt_compat.
+now apply (Z2R_lt 0 2).
+apply bpow_ge_0.
+(* x <> rnd x *)
+set (d := round beta fexp Zfloor x).
+destruct (round_N_pt beta fexp choice x) as (Hr1, Hr2).
+destruct (Rle_or_lt (x - d) (d + ulp x - x)) as [H|H].
+(* . rnd(x) = rndd(x) *)
+apply Rle_trans with (Rabs (d - x)).
+apply Hr2.
+apply (round_DN_pt beta fexp x).
+rewrite Rabs_left1.
+rewrite Ropp_minus_distr.
+apply Rmult_le_reg_r with 2%R.
+now apply (Z2R_lt 0 2).
+apply Rplus_le_reg_r with (d - x)%R.
+ring_simplify.
+apply Rle_trans with (1 := H).
+right. field.
+apply Rle_minus.
+apply (round_DN_pt beta fexp x).
+(* . rnd(x) = rndu(x) *)
+assert (Hu: (d + ulp x)%R = round beta fexp Zceil x).
+unfold d.
+now rewrite <- ulp_DN_UP.
+apply Rle_trans with (Rabs (d + ulp x - x)).
+apply Hr2.
+rewrite Hu.
+apply (round_UP_pt beta fexp x).
+rewrite Rabs_pos_eq.
+apply Rmult_le_reg_r with 2%R.
+now apply (Z2R_lt 0 2).
+apply Rplus_le_reg_r with (- (d + ulp x - x))%R.
+ring_simplify.
+apply Rlt_le.
+apply Rlt_le_trans with (1 := H).
+right. field.
+apply Rle_0_minus.
+rewrite Hu.
+apply (round_UP_pt beta fexp x).
+Qed.
+
+Theorem ulp_le :
+  forall { Hm : Monotone_exp fexp },
+  forall x y: R,
+  (0 < x)%R -> (x <= y)%R ->
+  (ulp x <= ulp y)%R.
+Proof.
+intros Hm x y Hx Hxy.
+apply bpow_le.
+apply Hm.
+now apply ln_beta_le.
+Qed.
+
+Theorem ulp_bpow :
+  forall e, ulp (bpow e) = bpow (fexp (e + 1)).
+intros e.
+unfold ulp.
+apply f_equal.
+apply canonic_exp_fexp.
+rewrite Rabs_pos_eq.
+split.
+ring_simplify (e + 1 - 1)%Z.
+apply Rle_refl.
+apply bpow_lt.
+apply Zlt_succ.
+apply bpow_ge_0.
+Qed.
+
+Theorem ulp_DN :
+  forall x,
+  (0 < round beta fexp Zfloor x)%R ->
+  ulp (round beta fexp Zfloor x) = ulp x.
+Proof.
+intros x Hd.
+unfold ulp.
+now rewrite canonic_exp_DN with (2 := Hd).
+Qed.
+
+Theorem ulp_error_f :
+  forall { Hm : Monotone_exp fexp } rnd { Zrnd : Valid_rnd rnd } x,
+  (round beta fexp rnd x <> 0)%R ->
+  (Rabs (round beta fexp rnd x - x) < ulp (round beta fexp rnd x))%R.
+Proof with auto with typeclass_instances.
+intros Hm rnd Zrnd x Hfx.
+case (round_DN_or_UP beta fexp rnd x); intros Hx.
+(* *)
+case (Rle_or_lt 0 (round beta fexp Zfloor x)).
+intros H; destruct H.
+rewrite Hx at 2.
+rewrite ulp_DN; trivial.
+apply ulp_error...
+rewrite Hx in Hfx; contradict Hfx; auto with real.
+intros H.
+apply Rlt_le_trans with (1:=ulp_error _ _).
+rewrite <- (ulp_opp x), <- (ulp_opp (round beta fexp rnd x)).
+apply ulp_le; trivial.
+apply Ropp_0_gt_lt_contravar; apply Rlt_gt.
+case (Rle_or_lt 0 x); trivial.
+intros H1; contradict H.
+apply Rle_not_lt.
+apply round_ge_generic...
+apply generic_format_0.
+apply Ropp_le_contravar; rewrite Hx.
+apply (round_DN_pt beta fexp x).
+(* *)
+rewrite Hx; case (Rle_or_lt 0 (round beta fexp Zceil x)).
+intros H; destruct H.
+apply Rlt_le_trans with (1:=ulp_error _ _).
+apply ulp_le; trivial.
+case (Rle_or_lt x 0); trivial.
+intros H1; contradict H.
+apply Rle_not_lt.
+apply round_le_generic...
+apply generic_format_0.
+apply round_UP_pt...
+rewrite Hx in Hfx; contradict Hfx; auto with real.
+intros H.
+rewrite <- (ulp_opp (round beta fexp Zceil x)).
+rewrite <- round_DN_opp.
+rewrite ulp_DN; trivial.
+replace (round beta fexp Zceil x - x)%R with (-((round beta fexp Zfloor (-x) - (-x))))%R.
+rewrite Rabs_Ropp.
+apply ulp_error...
+rewrite round_DN_opp; ring.
+rewrite round_DN_opp; apply Ropp_0_gt_lt_contravar; apply Rlt_gt; assumption.
+Qed.
+
+Theorem ulp_half_error_f :
+  forall { Hm : Monotone_exp fexp },
+  forall choice x,
+  (round beta fexp (Znearest choice) x <> 0)%R ->
+  (Rabs (round beta fexp (Znearest choice) x - x) <= /2 * ulp (round beta fexp (Znearest choice) x))%R.
+Proof with auto with typeclass_instances.
+intros Hm choice x Hfx.
+case (round_DN_or_UP beta fexp (Znearest choice) x); intros Hx.
+(* *)
+case (Rle_or_lt 0 (round beta fexp Zfloor x)).
+intros H; destruct H.
+rewrite Hx at 2.
+rewrite ulp_DN; trivial.
+apply ulp_half_error.
+rewrite Hx in Hfx; contradict Hfx; auto with real.
+intros H.
+apply Rle_trans with (1:=ulp_half_error _ _).
+apply Rmult_le_compat_l.
+auto with real.
+rewrite <- (ulp_opp x), <- (ulp_opp (round beta fexp (Znearest choice) x)).
+apply ulp_le; trivial.
+apply Ropp_0_gt_lt_contravar; apply Rlt_gt.
+case (Rle_or_lt 0 x); trivial.
+intros H1; contradict H.
+apply Rle_not_lt.
+apply round_ge_generic...
+apply generic_format_0.
+apply Ropp_le_contravar; rewrite Hx.
+apply (round_DN_pt beta fexp x).
+(* *)
+case (Rle_or_lt 0 (round beta fexp Zceil x)).
+intros H; destruct H.
+apply Rle_trans with (1:=ulp_half_error _ _).
+apply Rmult_le_compat_l.
+auto with real.
+apply ulp_le; trivial.
+case (Rle_or_lt x 0); trivial.
+intros H1; contradict H.
+apply Rle_not_lt.
+apply round_le_generic...
+apply generic_format_0.
+rewrite Hx; apply (round_UP_pt beta fexp x).
+rewrite Hx in Hfx; contradict Hfx; auto with real.
+intros H.
+rewrite Hx at 2; rewrite <- (ulp_opp (round beta fexp Zceil x)).
+rewrite <- round_DN_opp.
+rewrite ulp_DN; trivial.
+pattern x at 1 2; rewrite <- Ropp_involutive.
+rewrite round_N_opp.
+unfold Rminus.
+rewrite <- Ropp_plus_distr, Rabs_Ropp.
+apply ulp_half_error.
+rewrite round_DN_opp; apply Ropp_0_gt_lt_contravar; apply Rlt_gt; assumption.
+Qed.
+
+(** Predecessor *)
+Definition pred x :=
+  if Req_bool x (bpow (ln_beta beta x - 1)) then
+    (x - bpow (fexp (ln_beta beta x - 1)))%R
+  else
+    (x - ulp x)%R.
+
+Theorem pred_ge_bpow :
+  forall x e,  F x ->
+  x <> ulp x ->
+  (bpow e < x)%R ->
+  (bpow e <= x - ulp x)%R.
+Proof.
+intros x e Fx Hx' Hx.
+(* *)
+assert (1 <= Ztrunc (scaled_mantissa beta fexp x))%Z.
+assert (0 <  Ztrunc (scaled_mantissa beta fexp x))%Z.
+apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+rewrite <- Fx.
+apply Rle_lt_trans with (2:=Hx).
+apply bpow_ge_0.
+omega.
+case (Zle_lt_or_eq _ _ H); intros Hm.
+(* *)
+pattern x at 1 ; rewrite Fx.
+unfold ulp, F2R. simpl.
+pattern (bpow (canonic_exp beta fexp x)) at 2 ; rewrite <- Rmult_1_l.
+rewrite <- Rmult_minus_distr_r.
+change 1%R with (Z2R 1).
+rewrite <- Z2R_minus.
+change (bpow e <= F2R (Float beta (Ztrunc (scaled_mantissa beta fexp x) - 1) (canonic_exp beta fexp x)))%R.
+apply bpow_le_F2R_m1; trivial.
+now rewrite <- Fx.
+(* *)
+contradict Hx'.
+pattern x at 1; rewrite Fx.
+rewrite  <- Hm.
+unfold ulp, F2R; simpl.
+now rewrite Rmult_1_l.
+Qed.
+
+Lemma generic_format_pred_1:
+  forall x, (0 < x)%R -> F x ->
+  x <> bpow (ln_beta beta x - 1) ->
+  F (x - ulp x).
+Proof.
+intros x Zx Fx Hx.
+destruct (ln_beta beta x) as (ex, Ex).
+simpl in Hx.
+specialize (Ex (Rgt_not_eq _ _ Zx)).
+assert (Ex' : (bpow (ex - 1) < x < bpow ex)%R).
+rewrite Rabs_pos_eq in Ex.
+destruct Ex as (H,H'); destruct H; split; trivial.
+contradict Hx; easy.
+now apply Rlt_le.
+unfold generic_format, scaled_mantissa, canonic_exp.
+rewrite ln_beta_unique with beta (x - ulp x)%R ex.
+pattern x at 1 3 ; rewrite Fx.
+unfold ulp, scaled_mantissa.
+rewrite canonic_exp_fexp with (1 := Ex).
+unfold F2R. simpl.
+rewrite Rmult_minus_distr_r.
+rewrite Rmult_assoc.
+rewrite <- bpow_plus, Zplus_opp_r, Rmult_1_r.
+change (bpow 0) with (Z2R 1).
+rewrite <- Z2R_minus.
+rewrite Ztrunc_Z2R.
+rewrite Z2R_minus.
+rewrite Rmult_minus_distr_r.
+now rewrite Rmult_1_l.
+rewrite Rabs_pos_eq.
+split.
+apply pred_ge_bpow; trivial.
+unfold ulp; intro H.
+assert (ex-1 < canonic_exp beta fexp x  < ex)%Z.
+split ; apply (lt_bpow beta) ; rewrite <- H ; easy.
+clear -H0. omega.
+apply Ex'.
+apply Rle_lt_trans with (2 := proj2 Ex').
+pattern x at 3 ; rewrite <- Rplus_0_r.
+apply Rplus_le_compat_l.
+rewrite <-Ropp_0.
+apply Ropp_le_contravar.
+apply bpow_ge_0.
+apply Rle_0_minus.
+pattern x at 2; rewrite Fx.
+unfold ulp, F2R; simpl.
+pattern (bpow (canonic_exp beta fexp x)) at 1; rewrite <- Rmult_1_l.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+replace 1%R with (Z2R 1) by reflexivity.
+apply Z2R_le.
+assert (0 <  Ztrunc (scaled_mantissa beta fexp x))%Z.
+apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+rewrite <- Fx.
+apply Rle_lt_trans with (2:=proj1 Ex').
+apply bpow_ge_0.
+omega.
+Qed.
+
+Lemma generic_format_pred_2 :
+  forall x, (0 < x)%R -> F x ->
+  let e := ln_beta_val beta x (ln_beta beta x) in
+  x =  bpow (e - 1) ->
+  F (x - bpow (fexp (e - 1))).
+Proof.
+intros x Zx Fx e Hx.
+pose (f:=(x - bpow (fexp (e - 1)))%R).
+fold f.
+assert (He:(fexp (e-1) <= e-1)%Z).
+apply generic_format_bpow_inv with beta; trivial.
+rewrite <- Hx; assumption.
+case (Zle_lt_or_eq _ _ He); clear He; intros He.
+assert (f = F2R (Float beta (Zpower beta (e-1-(fexp (e-1))) -1) (fexp (e-1))))%R.
+unfold f; rewrite Hx.
+unfold F2R; simpl.
+rewrite Z2R_minus, Z2R_Zpower.
+rewrite Rmult_minus_distr_r, Rmult_1_l.
+rewrite <- bpow_plus.
+now replace (e - 1 - fexp (e - 1) + fexp (e - 1))%Z with (e-1)%Z by ring.
+omega.
+rewrite H.
+apply generic_format_F2R.
+intros _.
+apply Zeq_le.
+apply canonic_exp_fexp.
+rewrite <- H.
+unfold f; rewrite Hx.
+rewrite Rabs_right.
+split.
+apply Rplus_le_reg_l with (bpow (fexp (e-1))).
+ring_simplify.
+apply Rle_trans with (bpow (e - 2) + bpow (e - 2))%R.
+apply Rplus_le_compat ; apply bpow_le ; omega.
+apply Rle_trans with (2*bpow (e - 2))%R;[right; ring|idtac].
+apply Rle_trans with (bpow 1*bpow (e - 2))%R.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+replace 2%R with (Z2R 2) by reflexivity.
+replace (bpow 1) with (Z2R beta).
+apply Z2R_le.
+apply <- Zle_is_le_bool.
+now destruct beta.
+simpl.
+unfold Zpower_pos; simpl.
+now rewrite Zmult_1_r.
+rewrite <- bpow_plus.
+replace (1+(e-2))%Z with (e-1)%Z by ring.
+now right.
+rewrite <- Rplus_0_r.
+apply Rplus_lt_compat_l.
+rewrite <- Ropp_0.
+apply Ropp_lt_contravar.
+apply bpow_gt_0.
+apply Rle_ge; apply Rle_0_minus.
+apply bpow_le.
+omega.
+replace f with 0%R.
+apply generic_format_0.
+unfold f.
+rewrite Hx, He.
+ring.
+Qed.
+
+Theorem generic_format_pred :
+  forall x, (0 < x)%R -> F x ->
+  F (pred x).
+Proof.
+intros x Zx Fx.
+unfold pred.
+case Req_bool_spec; intros H.
+now apply generic_format_pred_2.
+now apply generic_format_pred_1.
+Qed.
+
+Theorem generic_format_plus_ulp :
+  forall { monotone_exp : Monotone_exp fexp },
+  forall x, (x <> 0)%R ->
+  F x -> F (x + ulp x).
+Proof with auto with typeclass_instances.
+intros monotone_exp x Zx Fx.
+destruct (Rtotal_order x 0) as [Hx|[Hx|Hx]].
+rewrite <- Ropp_involutive.
+apply generic_format_opp.
+rewrite Ropp_plus_distr, <- ulp_opp.
+apply generic_format_opp in Fx.
+destruct (Req_dec (-x) (bpow (ln_beta beta (-x) - 1))) as [Hx'|Hx'].
+rewrite Hx' in Fx |- *.
+apply generic_format_bpow_inv' in Fx...
+unfold ulp, canonic_exp.
+rewrite ln_beta_bpow.
+revert Fx.
+generalize (ln_beta_val _ _ (ln_beta beta (-x)) - 1)%Z.
+clear -monotone_exp valid_exp.
+intros e He.
+destruct (Zle_lt_or_eq _ _ He) as [He1|He1].
+assert (He2 : e = (e - fexp (e + 1) + fexp (e + 1))%Z) by ring.
+rewrite He2 at 1.
+rewrite bpow_plus.
+assert (Hb := Z2R_Zpower beta _ (Zle_minus_le_0 _ _ He)).
+match goal with |- F (?a * ?b + - ?b) =>
+  replace (a * b + -b)%R with ((a - 1) * b)%R by ring end.
+rewrite <- Hb.
+rewrite <- (Z2R_minus _ 1).
+change (F (F2R (Float beta (Zpower beta (e - fexp (e + 1)) - 1) (fexp (e + 1))))).
+apply generic_format_F2R.
+intros Zb.
+unfold canonic_exp.
+rewrite ln_beta_F2R with (1 := Zb).
+rewrite (ln_beta_unique beta _ (e - fexp (e + 1))).
+apply monotone_exp.
+rewrite <- He2.
+apply Zle_succ.
+rewrite Rabs_pos_eq.
+rewrite Z2R_minus, Hb.
+split.
+apply Rplus_le_reg_r with (- bpow (e - fexp (e + 1) - 1) + Z2R 1)%R.
+apply Rmult_le_reg_r with (bpow (-(e - fexp (e+1) - 1))).
+apply bpow_gt_0.
+ring_simplify.
+apply Rle_trans with R1.
+rewrite Rmult_1_l.
+apply (bpow_le _ _ 0).
+clear -He1 ; omega.
+rewrite Ropp_mult_distr_l_reverse.
+rewrite <- 2!bpow_plus.
+ring_simplify (e - fexp (e + 1) - 1 + - (e - fexp (e + 1) - 1))%Z.
+ring_simplify (- (e - fexp (e + 1) - 1) + (e - fexp (e + 1)))%Z.
+rewrite bpow_1.
+rewrite <- (Z2R_plus (-1) _).
+apply (Z2R_le 1).
+generalize (Zle_bool_imp_le _ _ (radix_prop beta)).
+clear ; omega.
+rewrite <- (Rplus_0_r (bpow (e - fexp (e + 1)))) at 2.
+apply Rplus_lt_compat_l.
+now apply (Z2R_lt (-1) 0).
+rewrite Z2R_minus.
+apply Rle_0_minus.
+rewrite Hb.
+apply (bpow_le _ 0).
+now apply Zle_minus_le_0.
+rewrite He1, Rplus_opp_r.
+apply generic_format_0.
+apply generic_format_pred_1 ; try easy.
+rewrite <- Ropp_0.
+now apply Ropp_lt_contravar.
+now elim Zx.
+now apply generic_format_succ.
+Qed.
+
+Theorem generic_format_minus_ulp :
+  forall { monotone_exp : Monotone_exp fexp },
+  forall x, (x <> 0)%R ->
+  F x -> F (x - ulp x).
+Proof.
+intros monotone_exp x Zx Fx.
+replace (x - ulp x)%R with (-(-x + ulp x))%R by ring.
+apply generic_format_opp.
+rewrite <- ulp_opp.
+apply generic_format_plus_ulp.
+contradict Zx.
+rewrite <- (Ropp_involutive x), Zx.
+apply Ropp_0.
+now apply generic_format_opp.
+Qed.
+
+Lemma pred_plus_ulp_1 :
+  forall x, (0 < x)%R -> F x ->
+  x <> bpow (ln_beta beta x - 1) ->
+  ((x - ulp x) + ulp (x-ulp x) = x)%R.
+Proof.
+intros x Zx Fx Hx.
+replace (ulp (x - ulp x)) with (ulp x).
+ring.
+unfold ulp at 1 2; apply f_equal.
+unfold canonic_exp; apply f_equal.
+destruct (ln_beta beta x) as (ex, Hex).
+simpl in *.
+assert (x <> 0)%R by auto with real.
+specialize (Hex H).
+apply sym_eq.
+apply ln_beta_unique.
+rewrite Rabs_right.
+rewrite Rabs_right in Hex.
+2: apply Rle_ge; apply Rlt_le; easy.
+split.
+destruct Hex as ([H1|H1],H2).
+apply pred_ge_bpow; trivial.
+unfold ulp; intros H3.
+assert (ex-1 < canonic_exp beta fexp x  < ex)%Z.
+split ; apply (lt_bpow beta) ; rewrite <- H3 ; easy.
+omega.
+contradict Hx; auto with real.
+apply Rle_lt_trans with (2:=proj2 Hex).
+rewrite <- Rplus_0_r.
+apply Rplus_le_compat_l.
+rewrite <- Ropp_0.
+apply Ropp_le_contravar.
+apply bpow_ge_0.
+apply Rle_ge.
+apply Rle_0_minus.
+pattern x at 2; rewrite Fx.
+unfold ulp, F2R; simpl.
+pattern (bpow (canonic_exp beta fexp x)) at 1; rewrite <- Rmult_1_l.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+replace 1%R with (Z2R (Zsucc 0)) by reflexivity.
+apply Z2R_le.
+apply Zlt_le_succ.
+apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+now rewrite <- Fx.
+Qed.
+
+Lemma pred_plus_ulp_2 :
+  forall x, (0 < x)%R -> F x ->
+  let e := ln_beta_val beta x (ln_beta beta x) in
+  x =  bpow (e - 1) ->
+  (x - bpow (fexp (e-1)) <> 0)%R ->
+  ((x - bpow (fexp (e-1))) + ulp (x - bpow (fexp (e-1))) = x)%R.
+Proof.
+intros x Zx Fx e Hxe Zp.
+replace (ulp (x - bpow (fexp (e - 1)))) with (bpow (fexp (e - 1))).
+ring.
+assert (He:(fexp (e-1) <= e-1)%Z).
+apply generic_format_bpow_inv with beta; trivial.
+rewrite <- Hxe; assumption.
+case (Zle_lt_or_eq _ _ He); clear He; intros He.
+(* *)
+unfold ulp; apply f_equal.
+unfold canonic_exp; apply f_equal.
+apply sym_eq.
+apply ln_beta_unique.
+rewrite Rabs_right.
+split.
+apply Rplus_le_reg_l with (bpow (fexp (e-1))).
+ring_simplify.
+apply Rle_trans with (bpow (e - 2) + bpow (e - 2))%R.
+apply Rplus_le_compat; apply bpow_le; omega.
+apply Rle_trans with (2*bpow (e - 2))%R;[right; ring|idtac].
+apply Rle_trans with (bpow 1*bpow (e - 2))%R.
+apply Rmult_le_compat_r.
+apply bpow_ge_0.
+replace 2%R with (Z2R 2) by reflexivity.
+replace (bpow 1) with (Z2R beta).
+apply Z2R_le.
+apply <- Zle_is_le_bool.
+now destruct beta.
+simpl.
+unfold Zpower_pos; simpl.
+now rewrite Zmult_1_r.
+rewrite <- bpow_plus.
+replace (1+(e-2))%Z with (e-1)%Z by ring.
+now right.
+rewrite <- Rplus_0_r, Hxe.
+apply Rplus_lt_compat_l.
+rewrite <- Ropp_0.
+apply Ropp_lt_contravar.
+apply bpow_gt_0.
+apply Rle_ge; apply Rle_0_minus.
+rewrite Hxe.
+apply bpow_le.
+omega.
+(* *)
+contradict Zp.
+rewrite Hxe, He; ring.
+Qed.
+
+Theorem pred_plus_ulp :
+  forall x, (0 < x)%R -> F x ->
+  (pred x <> 0)%R ->
+  (pred x + ulp (pred x) = x)%R.
+Proof.
+intros x Zx Fx.
+unfold pred.
+case Req_bool_spec; intros H Zp.
+now apply pred_plus_ulp_2.
+now apply pred_plus_ulp_1.
+Qed.
+
+Theorem pred_lt_id :
+  forall x,
+  (pred x < x)%R.
+Proof.
+intros.
+unfold pred.
+case Req_bool_spec; intros H.
+(* *)
+rewrite <- Rplus_0_r.
+apply Rplus_lt_compat_l.
+rewrite <- Ropp_0.
+apply Ropp_lt_contravar.
+apply bpow_gt_0.
+(* *)
+rewrite <- Rplus_0_r.
+apply Rplus_lt_compat_l.
+rewrite <- Ropp_0.
+apply Ropp_lt_contravar.
+apply bpow_gt_0.
+Qed.
+
+Theorem pred_ge_0 :
+  forall x,
+  (0 < x)%R -> F x -> (0 <= pred x)%R.
+intros x Zx Fx.
+unfold pred.
+case Req_bool_spec; intros H.
+(* *)
+apply Rle_0_minus.
+rewrite H.
+apply bpow_le.
+destruct (ln_beta beta x) as (ex,Ex) ; simpl.
+rewrite ln_beta_bpow.
+ring_simplify (ex - 1 + 1 - 1)%Z.
+apply generic_format_bpow_inv with beta; trivial.
+simpl in H.
+rewrite <- H; assumption.
+apply Rle_0_minus.
+now apply ulp_le_id.
+Qed.
+
+Theorem round_UP_pred :
+  forall x, (0 < pred x)%R -> F x ->
+  forall eps, (0 < eps <= ulp (pred x) )%R ->
+  round beta fexp Zceil (pred x + eps) = x.
+Proof.
+intros x Hx Fx eps Heps.
+rewrite round_UP_succ; trivial.
+apply pred_plus_ulp; trivial.
+apply Rlt_trans with (1:=Hx).
+apply pred_lt_id.
+now apply Rgt_not_eq.
+apply generic_format_pred; trivial.
+apply Rlt_trans with (1:=Hx).
+apply pred_lt_id.
+Qed.
+
+Theorem round_DN_pred :
+  forall x, (0 < pred x)%R -> F x ->
+  forall eps, (0 < eps <= ulp (pred x))%R ->
+  round beta fexp Zfloor (x - eps) = pred x.
+Proof.
+intros x Hpx Fx eps Heps.
+assert (Hx:(0 < x)%R).
+apply Rlt_trans with (1:=Hpx).
+apply pred_lt_id.
+replace (x-eps)%R with (pred x + (ulp (pred x)-eps))%R.
+2: pattern x at 3; rewrite <- (pred_plus_ulp x); trivial.
+2: ring.
+2: now apply Rgt_not_eq.
+rewrite round_DN_succ; trivial.
+now apply generic_format_pred.
+split.
+apply Rle_0_minus.
+now apply Heps.
+rewrite <- Rplus_0_r.
+apply Rplus_lt_compat_l.
+rewrite <- Ropp_0.
+apply Ropp_lt_contravar.
+now apply Heps.
+Qed.
+
+Lemma le_pred_lt_aux :
+  forall x y,
+  F x -> F y ->
+  (0 < x < y)%R ->
+  (x <= pred y)%R.
+Proof with auto with typeclass_instances.
+intros x y Hx Hy H.
+assert (Zy:(0 < y)%R).
+apply Rlt_trans with (1:=proj1 H).
+apply H.
+(* *)
+assert (Zp: (0 < pred y)%R).
+assert (Zp:(0 <= pred y)%R).
+apply pred_ge_0 ; trivial.
+destruct Zp; trivial.
+generalize H0.
+unfold pred.
+destruct (ln_beta beta y) as (ey,Hey); simpl.
+case Req_bool_spec; intros Hy2.
+(* . *)
+intros Hy3.
+assert (ey-1 = fexp (ey -1))%Z.
+apply bpow_inj with beta.
+rewrite <- Hy2, <- Rplus_0_l, Hy3.
+ring.
+assert (Zx: (x <> 0)%R).
+now apply Rgt_not_eq.
+destruct (ln_beta beta x) as (ex,Hex).
+specialize (Hex Zx).
+assert (ex <= ey)%Z.
+apply bpow_lt_bpow with beta.
+apply Rle_lt_trans with (1:=proj1 Hex).
+apply Rlt_trans with (Rabs y).
+rewrite 2!Rabs_right.
+apply H.
+now apply Rgt_ge.
+now apply Rgt_ge.
+apply Hey.
+now apply Rgt_not_eq.
+case (Zle_lt_or_eq _ _ H2); intros Hexy.
+assert (fexp ex = fexp (ey-1))%Z.
+apply valid_exp.
+omega.
+rewrite <- H1.
+omega.
+absurd (0 < Ztrunc (scaled_mantissa beta fexp x) < 1)%Z.
+omega.
+split.
+apply F2R_gt_0_reg with beta (canonic_exp beta fexp x).
+now rewrite <- Hx.
+apply lt_Z2R.
+apply Rmult_lt_reg_r with (bpow (canonic_exp beta fexp x)).
+apply bpow_gt_0.
+replace (Z2R (Ztrunc (scaled_mantissa beta fexp x)) *
+ bpow (canonic_exp beta fexp x))%R with x.
+rewrite Rmult_1_l.
+unfold canonic_exp.
+rewrite ln_beta_unique with beta x ex.
+rewrite H3,<-H1, <- Hy2.
+apply H.
+exact Hex.
+absurd (y <= x)%R.
+now apply Rlt_not_le.
+rewrite Rabs_right in Hex.
+apply Rle_trans with (2:=proj1 Hex).
+rewrite Hexy, Hy2.
+now apply Rle_refl.
+now apply Rgt_ge.
+(* . *)
+intros Hy3.
+assert (y = bpow (fexp ey))%R.
+apply Rminus_diag_uniq.
+rewrite Hy3.
+unfold ulp, canonic_exp.
+rewrite (ln_beta_unique beta y ey); trivial.
+apply Hey.
+now apply Rgt_not_eq.
+contradict Hy2.
+rewrite H1.
+apply f_equal.
+apply Zplus_reg_l with 1%Z.
+ring_simplify.
+apply trans_eq with (ln_beta beta y).
+apply sym_eq; apply ln_beta_unique.
+rewrite H1, Rabs_right.
+split.
+apply bpow_le.
+omega.
+apply bpow_lt.
+omega.
+apply Rle_ge; apply bpow_ge_0.
+apply ln_beta_unique.
+apply Hey.
+now apply Rgt_not_eq.
+(* *)
+case (Rle_or_lt (ulp (pred y)) (y-x)); intros H1.
+(* . *)
+apply Rplus_le_reg_r with (-x + ulp (pred y))%R.
+ring_simplify (x+(-x+ulp (pred y)))%R.
+apply Rle_trans with (1:=H1).
+rewrite <- (pred_plus_ulp y) at 1; trivial.
+apply Req_le; ring.
+now apply Rgt_not_eq.
+(* . *)
+replace x with (y-(y-x))%R by ring.
+rewrite <- round_DN_pred with (eps:=(y-x)%R); try easy.
+ring_simplify (y-(y-x))%R.
+apply Req_le.
+apply sym_eq.
+apply round_generic...
+split; trivial.
+now apply Rlt_Rminus.
+now apply Rlt_le.
+Qed.
+
+Theorem le_pred_lt :
+  forall x y,
+  F x -> F y ->
+  (0 < y)%R ->
+  (x < y)%R ->
+  (x <= pred y)%R.
+Proof.
+intros x y Fx Fy Hy Hxy.
+destruct (Rle_or_lt x 0) as [Hx|Hx].
+apply Rle_trans with (1 := Hx).
+now apply pred_ge_0.
+apply le_pred_lt_aux ; try easy.
+now split.
+Qed.
+
+End Fcore_ulp.