Section operations.
(* Now the 4 arithmetic operations and the square root 			*)
(* can be defined on D.				 			*)
(* Addition, negation, difference and multiplication are exact.		*)
(* Since D is non closed by inverse and square root, these operations	*)
(* are defined with a precision 2^p for a given p > 0.			*)
(* So, there is at this step of the work no function Dinv, but a	*)
(* predicates Dinv who takes 4 arguments : rounding mode, x, y, p.	*)
(* (Dinv MODE x y p) says that y is an approximation of 1/x with	*)
(* p digits, according to the rounding mode MODE			*)
(* That means (in the field R of real numbers):				*)
(*  (Dnum y) has p digits and : 					*)
(*									*)
(* -For MODE=Roundig_sup :  y <= 1/x < Dsucc y				*)
(* -For MODE=Roundig_inf :  Dpred y < 1/x <= y				*)
(* -For MODE=Rounding_nearest : 					*)
(*  	as Rounding_sup if nearer than Rounding_inf			*)
(*      as Rounding_inf in the other case				*)
(* -For MODE=Roundig_zero : as Rounding_sup if x>0,			*)
(*   	       	       	      as Rounding_inf if x<=0.			*)
(*	 					          __		*)
(* (Dsqr MODE x y p) says that y is an approximation of \/ x 		*)
(*   with p digits, according to the rounding mode MODE.		*)
(* That means : 							*)
(* -For MODE=Roundig_sup :  y^2 <= x < (Dsucc y)^2			*)
(* -For MODE=Roundig_inf :  (Dpred y)^2 < x <= y^2			*)
(* -For MODE=Rounding_nearest : 					*)
(*  	as Rounding_sup if nearer than Rounding_inf			*)
(*      as Rounding_inf in the other case				*)
(* -For MODE=Roundig_zero : as Rounding_sup since x>0			*)
(*									*)
(* The square root of a negative number does not exist : 		*)
(* (Dsrq MODE x y p) is alwas false when x <= 0				*)
Definition Dsucc (x : diadic) := Diadic (Dnum x + 1) (Dexp x).
Definition Dpred (x : diadic) := Diadic (Dnum x - 1) (Dexp x).
Definition Dadd (x y : diadic) :=
let nx := Dnum x in
let ny := Dnum y in
let ex := Dexp x in
let ey := Dexp y in
Diadic (two_p (ex - Z.min ex ey) * nx + two_p (ey - Z.min ex ey) * ny)
(Z.min ex ey).
Definition Dopp (x : diadic) := Diadic (- Dnum x) (Dexp x).
Definition Dabs (x : diadic) := Diadic (Z.abs (Dnum x)) (Dexp x).
Definition Dminus (x y : diadic) := Dadd x (Dopp y).
Definition Dmult (x y : diadic) := Diadic (Dnum x * Dnum y) (Dexp x + Dexp y).
(* DLog 0 is -infty. When n<>0, (DLog n)= (Log_of_pos m) iff +2^m is the nearest power of two of n, according to the choosen rounding mode. (DLog n) = (Log_of_neg m) iff -2^m is the nearest power of two of n, according to the choosen rounding mode. *)
(*** ON S'en FOUT Definition DLog := [m:rounding_mode][x:diadic]Cases (Dnum x) of (POS n) => (Log_of_pos (Cases m of Rounding_sup => `(Log_sup_pos n)-(Dexp x)` | Rounding_inf => `(Log_inf_pos n)-(Dexp x)` | Rounding_nearest => `(Log_nearest n)-(Dexp x)` | Rounding_zero => `(Log_inf n)-(Dexp x)) end)` | (NEG n) =>  (Log_of_neg (Cases m of Rounding_sup => `(Log_inf n)-(Dexp x)` | Rounding_inf => `(Log_sup n)-(Dexp x)` | Rounding_nearest => `(Log_nearest n)-(Dexp x)` | Rounding_zero => `(Log_inf n)-(Dexp x)) end)` | ZERO => M_infty end. *****************)
(* (Dproj m x P y) is true when y is the projection of x onto the subset of integers who satisfy P, acording to the rounding mode m *)
Definition Dproj (m : rounding_mode) (x : diadic) (P : diadic -> Prop)
(y : diadic) :=
P y /\
match m with
| Rounding_sup => forall z : diadic, P z -> Dle x z -> Dle y z
| Rounding_inf => forall z : diadic, P z -> Dle z x -> Dle z y
| Rounding_nearest =>
forall z : diadic, P z -> Dle (Dabs (Dminus x y)) (Dabs (Dminus x z))
| Rounding_zero =>
forall z : diadic,
P z ->
IF Dle (Dzero 0) x then Dle z x -> Dle z y else Dle z x -> Dle z y
end.
(* ZROUND "forgets" p digits of n, but with respect to the rounding mode m. In few cases, ZROUND may have one digit more than (N_digits n)-p. Examples :  (ZROUND inf 4 #1111111) = #111 but (ZROUND sup 4 #1111111) = #1000 (ZROUND inf 4 #-1111111) = #-1000 but (ZROUND sup 4 #-1111111) = #-111  *)
intros; elim (Zdiv_rest_correct x p); intros q r Hx Hr1 Hr2; exists q;
rewrite (Zplus_0_r_reverse (q * two_power_pos p));
rewrite Hx; split;
[ apply Zplus_le_compat_l; assumption
| unfold Z.succ in |- *; rewrite Zmult_plus_distr_l; apply Zplus_lt_compat_l;
rewrite Zmult_1_l; assumption ].
Qed.
Definition ZROUND_inf (p : positive) (x : Z) :=
let (x', p) := ZROUND_inf_spec p x in x'.
intros; elim (Zdiv_rest_correct x p); intros q r; elim r;
[ intros Hx Hr; exists q; rewrite Hx; rewrite <- Zplus_0_r_reverse; split;
[ apply Zmult_gt_0_lt_compat_r;
[ compute in |- *; reflexivity | apply Zlt_pred ]
| apply Z.le_refl ]
| intros p0 Hx Hr1 Hr2; exists (Z.succ q); rewrite Hx; split;
[ replace (Z.pred (Z.succ q) * two_power_pos p)%Z with
(q * two_power_pos p + 0)%Z;
[ apply Zplus_lt_compat_l; compute in |- *; reflexivity
| rewrite <- Zpred_succ; rewrite <- Zplus_0_r_reverse; reflexivity ]
| unfold Z.succ in |- *; rewrite Zmult_plus_distr_l;
apply Zplus_le_compat_l; rewrite Zmult_1_l;
apply Zlt_le_weak; assumption ]
| intros p0 Hx Hr1 Hr2; absurd (Datatypes.Gt = Datatypes.Gt);
[ exact Hr1 | reflexivity ] ].
Qed.
Definition ZROUND_sup (p : positive) (x : Z) :=
let (x', p) := ZROUND_sup_spec p x in x'.

Lemma ZROUND_correct :
forall (m : rounding_mode) (p : positive) (x : Z),
{y : Z |
match m with
| Rounding_inf => (y * two_power_pos p <= x < Z.succ y * two_power_pos p)%Z
| Rounding_sup => (Z.pred y * two_power_pos p < x <= y * two_power_pos p)%Z
| Rounding_nearest =>
match (x - ZROUND_inf p x ?= ZROUND_sup p x - x)%Z with
| Datatypes.Eq =>
if Zeven.Zeven_bool (ZROUND_inf p x)
then (y * two_power_pos p <= x < Z.succ y * two_power_pos p)%Z
else (Z.pred y * two_power_pos p < x <= y * two_power_pos p)%Z
| Datatypes.Gt =>
(Z.pred y * two_power_pos p < x <= y * two_power_pos p)%Z
| Datatypes.Lt =>
(y * two_power_pos p <= x < Z.succ y * two_power_pos p)%Z
end
| Rounding_zero =>
match x with
| Zpos _ => (y * two_power_pos p <= x < Z.succ y * two_power_pos p)%Z
| Z0 => y = 0%Z
| Zneg _ => (Z.pred y * two_power_pos p < x <= y * two_power_pos p)%Z
end
end}.