Section Double_round.
Variable beta : radix.
Notation bpow e := (bpow beta e).
Notation mag x := (mag beta x).
Definition round_round_eq fexp1 fexp2 choice1 choice2 x :=
round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)
= round beta fexp1 (Znearest choice1) x.
(** A little tactic to simplify terms of the form [bpow a * bpow b]. *)
Ltac bpow_simplify :=
(* bpow ex * bpow ey ~~> bpow (ex + ey) *)
repeat
match goal with
| |- context [(Raux.bpow _ _ * Raux.bpow _ _)] =>
rewrite <- bpow_plus
| |- context [(?X1 * Raux.bpow _ _ * Raux.bpow _ _)] =>
rewrite (Rmult_assoc X1); rewrite <- bpow_plus
| |- context [(?X1 * (?X2 * Raux.bpow _ _) * Raux.bpow _ _)] =>
rewrite <- (Rmult_assoc X1 X2); rewrite (Rmult_assoc (X1 * X2));
rewrite <- bpow_plus
end;
(* ring_simplify arguments of bpow *)
repeat
match goal with
| |- context [(Raux.bpow _ ?X)] =>
progress ring_simplify X
end;
(* bpow 0 ~~> 1 *)
change (Raux.bpow _ 0) with 1;
repeat
match goal with
| |- context [(_ * 1)] =>
rewrite Rmult_1_r
end.
Definition midp (fexp : Z -> Z) (x : R) :=
round beta fexp Zfloor x + / 2 * ulp beta fexp x.
Definition midp' (fexp : Z -> Z) (x : R) :=
round beta fexp Zceil x - / 2 * ulp beta fexp x.

Lemma round_round_gt_mid :
forall (fexp1 fexp2 : Z -> Z),
Valid_exp fexp1 -> Valid_exp fexp2 ->
forall (choice1 choice2 : Z -> bool),
forall x,
0 < x ->
(fexp2 (mag x) <= fexp1 (mag x))%Z ->
(fexp1 (mag x) <= mag x)%Z ->
midp' fexp1 x < x ->
((fexp2 (mag x) <= fexp1 (mag x) - 1)%Z ->
midp' fexp1 x + / 2 * ulp beta fexp2 x < x) ->
round_round_eq fexp1 fexp2 choice1 choice2 x.